ewenharrison / finalfit
1
#' Produce an odds ratio table and plot
2
#'
3
#' Produce an odds ratio table and plot from a \code{glm()} or
4
#' \code{lme4::glmer()} model.
5
#'
6
#' @param .data Data frame.
7
#' @param dependent Character vector of length 1:  name of depdendent variable
8
#'   (must have 2 levels).
9
#' @param explanatory Character vector of any length: name(s) of explanatory
10
#'   variables.
11
#' @param random_effect Character vector of length 1, name of random effect variable.
12
#' @param factorlist Option to provide output directly from
13
#'   \code{\link{summary_factorlist}()}.
14
#' @param glmfit Option to provide output directly from \code{\link{glmmulti}()}
15
#'   and \code{\link{glmmixed}()}.
16
#' @param confint_type One of \code{c("profile", "default")} for GLM models or
17
#'   \code{c("default", "Wald", "profile", "boot")} for \code{glmer}
18
#'   models. Note "default" == "Wald".
19
#' @param remove_ref Logical. Remove reference level for factors.    
20
#' @param breaks Manually specify x-axis breaks in format \code{c(0.1, 1, 10)}.
21
#' @param column_space Adjust table column spacing.
22
#' @param dependent_label Main label for plot.
23
#' @param prefix Plots are titled by default with the dependent variable. This
24
#'   adds text before that label.
25
#' @param suffix Plots are titled with the dependent variable. This adds text
26
#'   after that label.
27
#' @param table_text_size Alter font size of table text.
28
#' @param title_text_size Alter font size of title text.
29
#' @param plot_opts A list of arguments to be appended to the ggplot call by
30
#'   "+".
31
#' @param table_opts A list of arguments to be appended to the ggplot table call
32
#'   by "+".
33
#' @param ... Other parameters.
34
#' @return Returns a table and plot produced in \code{ggplot2}.
35
#'
36
#' @family finalfit plot functions
37
#' @export
38
#' @importFrom utils globalVariables
39
#' @import ggplot2
40
#' 
41
#' @examples
42
#' library(finalfit)
43
#' library(dplyr)
44
#' library(ggplot2)
45
#'
46
#' # OR plot
47
#' data(colon_s)
48
#' explanatory = c("age.factor", "sex.factor", "obstruct.factor", "perfor.factor")
49
#' dependent = "mort_5yr"
50
#' colon_s %>%
51
#' 	 or_plot(dependent, explanatory)
52
#'
53
#' colon_s %>%
54
#'   or_plot(dependent, explanatory, table_text_size=4, title_text_size=14,
55
#'     plot_opts=list(xlab("OR, 95% CI"), theme(axis.title = element_text(size=12))))
56

57

58
or_plot = function(.data, dependent, explanatory, random_effect=NULL, 
59
									 factorlist=NULL, glmfit=NULL,
60
									 confint_type = NULL, remove_ref = FALSE,
61
									 breaks=NULL, column_space=c(-0.5, 0, 0.5),
62
									 dependent_label = NULL,
63
									 prefix = "", suffix = ": OR (95% CI, p-value)",
64
									 table_text_size = 5,
65
									 title_text_size = 18,
66
									 plot_opts = NULL, table_opts = NULL, ...){
67
	
68 1
	requireNamespace("ggplot2")
69
	
70
	# Generate or format factorlist object
71 1
	if(!is.null(factorlist)){
72 0
		if(is.null(factorlist$Total)) stop("summary_factorlist function must include total_col=TRUE")
73 0
		if(is.null(factorlist$fit_id)) stop("summary_factorlist function must include fit_id=TRUE")
74
	}
75
	
76 1
	if(is.null(factorlist)){
77 1
		factorlist = summary_factorlist(.data, dependent, explanatory, total_col=TRUE, fit_id=TRUE)
78
	}
79
	
80 1
	if(remove_ref){
81 1
		factorlist = factorlist %>%  
82 1
			dplyr::mutate(label = ifelse(label == "", NA, label)) %>% 
83 1
			tidyr::fill(label) %>% 
84 1
			dplyr::group_by(label) %>%
85 1
			dplyr::filter(dplyr::row_number() != 1 | 
86 1
											dplyr::n() > 2 |
87 1
											levels %in% c("Mean (SD)", "Median (IQR)")
88
			)%>% 
89 1
			rm_duplicate_labels()
90
	}
91
	
92 1
	if(is.null(breaks)){
93 1
		breaks = scales::pretty_breaks()
94
	}
95
	
96
	# Confidence intervals, default to "profile" for glm and "Wald" for glmer
97 1
	if(is.null(confint_type) && is.null(random_effect)){
98 1
		confint_type = "profile"
99 1
	} else if(is.null(confint_type) && (!is.null(random_effect) | class(glmfit) == "glmerMod")){
100 0
		confint_type = "default"
101
	}
102
	
103
	# Generate or format glm
104 1
	if(is.null(glmfit) && is.null(random_effect)){
105 1
		glmfit = glmmulti(.data, dependent, explanatory)
106 1
		glmfit_df_c = fit2df(glmfit, condense = TRUE, estimate_suffix = " (multivariable)",
107 1
												 confint_type = confint_type, ...)
108 1
	} else if(is.null(glmfit) && !is.null(random_effect)){
109 0
		glmfit = glmmixed(.data, dependent, explanatory, random_effect)
110 0
		glmfit_df_c = fit2df(glmfit, condense = TRUE, estimate_suffix = " (multilevel)",
111 0
												 confint_type = confint_type, ...)
112
	}
113 1
	if(!is.null(glmfit) && is.null(random_effect)){
114 1
		glmfit_df_c = fit2df(glmfit, condense = TRUE, estimate_suffix = " (multivariable)",
115 1
												 confint_type = confint_type, estimate_name = "OR", exp = TRUE, ...)
116 1
	} else if(!is.null(glmfit) && !is.null(random_effect)){
117 0
		glmfit_df_c = fit2df(glmfit, condense = TRUE, estimate_suffix = " (multilevel)",
118 0
												 confint_type = confint_type, estimate_name = "OR", exp = TRUE, ...)
119
	}
120
	
121 1
	glmfit_df = fit2df(glmfit, condense = FALSE, confint_type = confint_type,  estimate_name = "OR", exp = TRUE, ...)
122
	
123
	# Merge
124 1
	df.out = finalfit_merge(factorlist, glmfit_df_c)
125 1
	df.out = finalfit_merge(df.out, glmfit_df, ref_symbol = "1.0")
126
	
127
	# Remove proportions from total column and make continuous explanatory reflect dataset
128 1
	df.out$Total = stringr::str_remove(df.out$Total, " \\(.*\\)") %>% 
129 1
		as.numeric()
130 1
	df.out$Total[which(df.out$levels %in% c("Mean (SD)", "Median (IQR)"))] = dim(.data)[1]
131
	
132
	# For continuous variables, remove level label
133 1
	df.out$levels[which(df.out$levels %in% c("Mean (SD)", "Median (IQR)"))] = "-"
134
	
135
	# Remove unwanted lines, where there are more variables in model than wish to display.
136
	# These not named in factorlist, creating this problem. Interactions don't show on plot.
137 1
	if (any(
138 1
		is.na(df.out$label)
139
	)
140
	){
141 0
		remove_rows = which(is.na(df.out$label)) # This row doesn't work when is.na == FALSE, hence if()
142 0
		df.out = df.out[-remove_rows,]
143
	} else {
144 1
		df.out
145
	}
146
	
147
	# Fix order
148 1
	df.out$levels = as.character(df.out$levels)
149 1
	df.out$fit_id = factor(df.out$fit_id, levels = df.out$fit_id[order(-df.out$index)])
150
	
151
	# Plot
152 1
	g1 = ggplot(df.out, aes(x = as.numeric(OR), xmin = as.numeric(L95), xmax  = as.numeric(U95),
153 1
													y = fit_id))+
154 1
		geom_point(aes(size = Total), shape=22, fill="darkblue")+
155 1
		geom_errorbarh(height=0.2) +
156 1
		geom_vline(xintercept = 1, linetype = "longdash", colour = "black")+
157 1
		scale_x_continuous(trans="log10", breaks= breaks)+
158 1
		xlab("Odds ratio (95% CI, log scale)")+
159 1
		theme_classic(14)+
160 1
		theme(axis.title.x = element_text(),
161 1
					axis.title.y = element_blank(),
162 1
					axis.text.y = element_blank(),
163 1
					axis.line.y = element_blank(),
164 1
					axis.ticks.y = element_blank(),
165 1
					legend.position="none")
166
	
167 1
	t1 = ggplot(df.out, aes(x = as.numeric(OR), y = fit_id))+
168 1
		annotate("text", x = column_space[1], y = df.out$fit_id, label=df.out[,2], hjust=0, size=table_text_size)+
169 1
		annotate("text", x = column_space[2], y = df.out$fit_id, label=df.out[,3], hjust=1, size=table_text_size)+
170 1
		annotate("text", x = column_space[3], y = df.out$fit_id, label=df.out[,8], hjust=1, size=table_text_size)+
171 1
		theme_classic(14)+
172 1
		theme(axis.title.x = element_text(colour = "white"),
173 1
					axis.text.x = element_text(colour = "white"),
174 1
					axis.title.y = element_blank(),
175 1
					axis.text.y = element_blank(),
176 1
					axis.ticks.y = element_blank(),
177 1
					line = element_blank())
178
	
179
	# Add optional arguments
180 1
	g1 = g1 + plot_opts
181 1
	t1 = t1 + table_opts
182
	
183
	# Add dependent name label
184 1
	title = 	plot_title(.data, dependent, dependent_label = dependent_label, prefix = prefix, suffix = suffix)
185
	
186 1
	gridExtra::grid.arrange(t1, g1, ncol=2, widths = c(3,2),
187 1
													top=grid::textGrob(title, x=0.02, y=0.2,
188 1
																						 gp=grid::gpar(fontsize=title_text_size), just="left"))
189
}

Read our documentation on viewing source code .

Loading