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

54
coefficient_plot = function(.data, dependent, explanatory, random_effect = NULL,
55
														factorlist=NULL, lmfit=NULL,
56
														confint_type = "default", remove_ref = FALSE,
57
														breaks=NULL, column_space=c(-0.5, -0.1, 0.5),
58
														dependent_label = NULL,
59
														prefix = "", suffix = ": Coefficient, 95% CI, p-value)",
60
														table_text_size = 5,
61
														title_text_size = 18,
62
														plot_opts = NULL, table_opts = NULL, ...){
63
	
64 1
	requireNamespace("ggplot2")
65
	
66
	# Generate or format factorlist object
67 1
	if(!is.null(factorlist)){
68 0
		if(is.null(factorlist$Total)) stop("summary_factorlist function must include total_col=TRUE")
69 0
		if(is.null(factorlist$fit_id)) stop("summary_factorlist function must include fit_id=TRUE")
70
	}
71
	
72 1
	if(is.null(factorlist)){
73 1
		factorlist = summary_factorlist(.data, dependent, explanatory, total_col=TRUE, fit_id=TRUE)
74
	}
75
	
76
	# For continuous variables, remove level label
77 1
	drop = grepl("Mean \\(SD\\)|Median \\(IQR\\)", factorlist$levels)
78 1
	factorlist$levels[drop] = "-"
79
	
80 1
	if(remove_ref){
81 0
		factorlist = factorlist %>%  
82 0
			dplyr::mutate(label = ifelse(label == "", NA, label)) %>% 
83 0
			tidyr::fill(label) %>% 
84 0
			dplyr::group_by(label) %>%
85 0
			dplyr::filter(dplyr::row_number() != 1 | 
86 0
											dplyr::n() > 2 |
87 0
											levels %in% c("Mean (SD)", "Median (IQR)")
88
			)%>% 
89 0
			rm_duplicate_labels()
90
	}
91
	
92 1
	if(is.null(breaks)){
93 1
		breaks = scales::pretty_breaks()
94
	}
95
	
96
	# Generate or format lm
97 1
	if(is.null(lmfit) && is.null(random_effect)){
98 1
		lmfit = lmmulti(.data, dependent, explanatory)
99 1
		lmfit_df_c = fit2df(lmfit, condense = TRUE, estimate_suffix = " (multivariable)",
100 1
												 confint_type = confint_type, ...)
101 1
	} else if(is.null(lmfit) && !is.null(random_effect)){
102 0
		lmfit = lmmixed(.data, dependent, explanatory, random_effect)
103 0
		lmfit_df_c = fit2df(lmfit, condense = TRUE, estimate_suffix = " (multilevel)",
104 0
												 confint_type = confint_type, ...)
105
	}
106
	
107 1
	lmfit_df = fit2df(lmfit, condense = FALSE, confint_type = confint_type,  ...)
108

109
	# Merge
110 1
	df.out = finalfit_merge(factorlist, lmfit_df_c)
111 1
	df.out = finalfit_merge(df.out, lmfit_df, ref_symbol = "0")
112
	
113
	# Fill in total for continuous variables (NA by default)
114 1
	df.out$Total[is.na(df.out$Total)] = dim(.data)[1]
115 1
	df.out$Total = as.numeric(df.out$Total)
116
	
117
	# Remove unwanted lines, where there are more variables in model than wish to display.
118
	# These not named in factorlist, creating this problem. Interactions don't show on plot.
119 1
	if (any(
120 1
		is.na(df.out$label)
121
	)
122
	){
123 0
		remove_rows = which(is.na(df.out$label)) # This row doesn't work when is.na == FALSE, hence if()
124 0
		df.out = df.out[-remove_rows,]
125
	} else {
126 1
		df.out
127
	}
128
	
129
	# Fix order
130 1
	df.out$levels = as.character(df.out$levels)
131 1
	df.out$fit_id = factor(df.out$fit_id, levels = df.out$fit_id[order(-df.out$index)])
132
	
133
	# Plot
134 1
	g1 = ggplot(df.out, aes(x = as.numeric(Coefficient), xmin = as.numeric(L95), xmax  = as.numeric(U95),
135 1
													y = fit_id))+
136 1
		geom_point(aes(size = Total), shape=22, fill="darkblue")+
137 1
		geom_errorbarh(height=0.2) +
138 1
		geom_vline(xintercept = 0, linetype = "longdash", colour = "black")+
139 1
		scale_x_continuous(breaks= breaks)+
140 1
		xlab("Coefficient (95% CI)")+
141 1
		theme_classic(14)+
142 1
		theme(axis.title.x = element_text(),
143 1
					axis.title.y = element_blank(),
144 1
					axis.text.y = element_blank(),
145 1
					axis.line.y = element_blank(),
146 1
					axis.ticks.y = element_blank(),
147 1
					legend.position="none")
148
	
149 1
	t1 = ggplot(df.out, aes(x = as.numeric(Coefficient), y = fit_id))+
150 1
		annotate("text", x = column_space[1], y = df.out$fit_id, label=df.out[,2], hjust=0, size=table_text_size)+
151 1
		annotate("text", x = column_space[2], y = df.out$fit_id, label=df.out[,3], hjust=1, size=table_text_size)+
152 1
		annotate("text", x = column_space[3], y = df.out$fit_id, label=df.out[,8], hjust=1, size=table_text_size)+
153 1
		theme_classic(14)+
154 1
		theme(axis.title.x = element_text(colour = "white"),
155 1
					axis.text.x = element_text(colour = "white"),
156 1
					axis.title.y = element_blank(),
157 1
					axis.text.y = element_blank(),
158 1
					axis.ticks.y = element_blank(),
159 1
					line = element_blank())
160
	
161
	# Add optional arguments
162 1
	g1 = g1 + plot_opts
163 1
	t1 = t1 + table_opts
164
	
165
	# Add dependent name label
166 1
	title = 	plot_title(.data, dependent, dependent_label = dependent_label, prefix = prefix, suffix = suffix)
167
	
168 1
	gridExtra::grid.arrange(t1, g1, ncol=2, widths = c(3,2),
169 1
													top=grid::textGrob(title, x=0.02, y=0.2,
170 1
																						 gp=grid::gpar(fontsize=title_text_size), just="left"))
171
}

Read our documentation on viewing source code .

Loading