1
#' Generate common metrics for regression model results
2
#'
3
#' @param .data Model output.
4
#'
5
#' @return Model metrics vector for output.
6
#' @export
7
#' 
8
#' @importFrom stats AIC
9
#'
10
#' @examples
11
#' library(finalfit)
12
#'
13
#' # glm
14
#' fit = glm(mort_5yr ~  age.factor + sex.factor + obstruct.factor + perfor.factor,
15
#'   data=colon_s, family="binomial")
16
#' fit %>%
17
#'   ff_metrics()
18
#'
19
#' # glmlist
20
#' explanatory = c("age.factor", "sex.factor", "obstruct.factor", "perfor.factor")
21
#' dependent = "mort_5yr"
22
#' colon_s %>%
23
#'   glmmulti(dependent, explanatory) %>%
24
#'   ff_metrics()
25
#'
26
#' # glmerMod
27
#' explanatory = c("age.factor", "sex.factor", "obstruct.factor", "perfor.factor")
28
#' random_effect = "hospital"
29
#' dependent = "mort_5yr"
30
#' colon_s %>%
31
#'   glmmixed(dependent, explanatory, random_effect) %>%
32
#'   ff_metrics()
33
#'
34
#' # lm
35
#' fit = lm(nodes ~  age.factor + sex.factor + obstruct.factor + perfor.factor,
36
#'   data=colon_s)
37
#' fit %>%
38
#'   ff_metrics()
39
#'
40
#' # lmerMod
41
#' explanatory = c("age.factor", "sex.factor", "obstruct.factor", "perfor.factor")
42
#' random_effect = "hospital"
43
#' dependent = "nodes"
44
#'
45
#' colon_s %>%
46
#'   lmmixed(dependent, explanatory, random_effect) %>%
47
#'   ff_metrics()
48
#'
49
#' # coxphlist
50
#' explanatory = c("age.factor", "sex.factor", "obstruct.factor", "perfor.factor")
51
#' dependent = "Surv(time, status)"
52
#'
53
#'
54
#' colon_s %>%
55
#'   coxphmulti(dependent, explanatory) %>%
56
#'   ff_metrics()
57
#'
58
#' # coxph
59
#' fit = survival::coxph(survival::Surv(time, status) ~ age.factor + sex.factor +
60
#'   obstruct.factor + perfor.factor,
61
#'   data = colon_s)
62
#'
63
#' fit %>%
64
#'   ff_metrics()
65

66
ff_metrics <- function(.data){
67 1
	 if (any(class(.data) %in% c("lmlist", "glmlist", "coxphlist")) && length(.data)>1){
68 0
	 	stop("Metrics only generated for single models: multiple models supplied to function")
69
	 }
70 1
	UseMethod("ff_metrics")
71
}
72

73
#' @export
74
#' @rdname ff_metrics
75
#' @method ff_metrics lm
76
ff_metrics.lm <- function(.data){
77 1
	x = .data
78 1
	n_model = dim(x$model)[1]
79 1
	n_missing = length(summary(x)$na.action)
80 1
	n_data = n_model+n_missing
81 1
	n_model = dim(x$model)[1]
82 1
	loglik = round(logLik(x), 2)
83 1
	aic = round(AIC(x), 1)
84 1
	r.squared = signif(summary(x)$r.squared, 2)
85 1
	adj.r.squared = signif(summary(x)$adj.r.squared, 2)
86 1
	metrics.out = paste0(
87 1
		"Number in dataframe = ", n_data,
88 1
		", Number in model = ", n_model,
89 1
		", Missing = ", n_missing,
90 1
		", Log-likelihood = ", loglik,
91 1
		", AIC = ", aic,
92 1
		", R-squared = ", r.squared,
93 1
		", Adjusted R-squared = ", adj.r.squared) %>% 
94 1
		as.data.frame(stringsAsFactors = FALSE) %>% 
95 1
		unname()
96 1
	class(metrics.out) = c("data.frame.ff", class(metrics.out))
97 1
	return(metrics.out)
98
}
99

100
#' @export
101
#' @rdname ff_metrics
102
#' @method ff_metrics lmlist
103
ff_metrics.lmlist <- function(.data){
104 1
	x = .data[[1]]
105 1
	n_model = dim(x$model)[1]
106 1
	n_missing = length(summary(x)$na.action)
107 1
	n_data = n_model+n_missing
108 1
	n_model = dim(x$model)[1]
109 1
	loglik = round(logLik(x), 2)
110 1
	aic = round(AIC(x), 1)
111 1
	r.squared = signif(summary(x)$r.squared, 2)
112 1
	adj.r.squared = signif(summary(x)$adj.r.squared, 2)
113 1
	metrics.out = paste0(
114 1
		"Number in dataframe = ", n_data,
115 1
		", Number in model = ", n_model,
116 1
		", Missing = ", n_missing,
117 1
		", Log-likelihood = ", loglik,
118 1
		", AIC = ", aic,
119 1
		", R-squared = ", r.squared,
120 1
		", Adjusted R-squared = ", adj.r.squared) %>% 
121 1
		as.data.frame(stringsAsFactors = FALSE) %>% 
122 1
		unname()
123 1
	class(metrics.out) = c("data.frame.ff", class(metrics.out))
124 1
	return(metrics.out)
125
}
126

127
#' @export
128
#' @rdname ff_metrics
129
#' @method ff_metrics glm
130
ff_metrics.glm <- function(.data){
131 1
	x = .data
132 1
	n_data = dim(x$data)[1]
133 1
	n_model = dim(x$model)[1]
134 1
	aic = round(x$aic, 1)
135 1
	auc = round(pROC::roc(x$y, x$fitted)$auc[1], 3)
136 1
	h_l = metrics_hoslem(x$y, x$fitted)
137 1
	metrics.out = paste0(
138 1
		"Number in dataframe = ", n_data,
139 1
		", Number in model = ", n_model,
140 1
		", Missing = ", n_data-n_model,
141 1
		", AIC = ", aic,
142 1
		", C-statistic = ", auc,
143 1
		", H&L = ", h_l) %>% 
144 1
		as.data.frame(stringsAsFactors = FALSE) %>% 
145 1
		unname()
146 1
	class(metrics.out) = c("data.frame.ff", class(metrics.out))
147 1
	return(metrics.out)
148
}
149

150
#' @export
151
#' @rdname ff_metrics
152
#' @method ff_metrics glmlist
153
ff_metrics.glmlist <- function(.data){
154 1
	x = .data[[1]]
155 1
	n_data = dim(x$data)[1]
156 1
	n_model = dim(x$model)[1]
157 1
	aic = round(x$aic, 1)
158 1
	auc = round(pROC::roc(x$y, x$fitted)$auc[1], 3)
159 1
	h_l = metrics_hoslem(x$y, x$fitted)
160 1
	metrics.out = paste0(
161 1
		"Number in dataframe = ", n_data,
162 1
		", Number in model = ", n_model,
163 1
		", Missing = ", n_data-n_model,
164 1
		", AIC = ", aic,
165 1
		", C-statistic = ", auc,
166 1
		", H&L = ", h_l) %>% 
167 1
		as.data.frame(stringsAsFactors = FALSE) %>% 
168 1
		unname()
169 1
	class(metrics.out) = c("data.frame.ff", class(metrics.out))
170 1
	return(metrics.out)
171
}
172

173
#' @export
174
#' @rdname ff_metrics
175
#' @method ff_metrics lmerMod
176
ff_metrics.lmerMod <- function(.data){
177 1
	x = .data
178 1
	n_model = length(x@resp$mu)
179 1
	n_groups = summary(x)$ngrps
180 1
	loglik = round(summary(x)$logLik, 2)
181 1
	aic = round(summary(x)$AICtab[[1]], 1)
182 1
	metrics.out = paste0(
183 1
		"Number in model = ", n_model,
184 1
		", Number of groups = ", paste(n_groups, collapse="/"),
185 1
		", Log likelihood = ", loglik,
186 1
		", REML criterion = ", aic) %>% 
187 1
		as.data.frame(stringsAsFactors = FALSE) %>% 
188 1
		unname()
189 1
	class(metrics.out) = c("data.frame.ff", class(metrics.out))
190 1
	return(metrics.out)
191
}
192

193
#' @export
194
#' @rdname ff_metrics
195
#' @method ff_metrics glmerMod
196
ff_metrics.glmerMod <- function(.data){
197 1
	x = .data
198 1
	n_model = length(x@resp$mu)
199 1
	n_groups = summary(x)$ngrps
200 1
	aic = round(summary(x)$AICtab[[1]], 1)
201 1
	auc = round(pROC::roc(x@resp$y, x@resp$mu)$auc[1], 3)
202 1
	metrics.out = paste0(
203 1
		"Number in model = ", n_model,
204 1
		", Number of groups = ", paste(n_groups, collapse="/"),
205 1
		", AIC = ", aic,
206 1
		", C-statistic = ", auc) %>% 
207 1
		as.data.frame(stringsAsFactors = FALSE) %>% 
208 1
		unname()
209 1
	class(metrics.out) = c("data.frame.ff", class(metrics.out))
210 1
	return(metrics.out)
211
}
212

213
#' @export
214
#' @rdname ff_metrics
215
#' @method ff_metrics coxph
216
ff_metrics.coxph <- function(.data){
217 1
	x = .data
218 1
	n_model = x$n
219 1
	n_missing = length(x$na.action)
220 1
	n_data = n_model+n_missing
221 1
	n_event = x$nevent
222 1
	concordance = summary(x)$concordance
223 1
	r.squared = summary(x)$rsq
224 1
	logtest = summary(x)$logtest
225 1
	metrics.out = paste0(
226 1
		"Number in dataframe = ", n_data,
227 1
		", Number in model = ", n_model,
228 1
		", Missing = ", n_missing,
229 1
		", Number of events = ", n_event,
230 1
		", Concordance = ", paste0(round_tidy(concordance[1], 3), " (SE = ",
231 1
															 round_tidy(concordance[2], 3), ")"),
232 1
		", R-squared = ", paste0(round_tidy(r.squared[1], 3), "( Max possible = ",
233 1
														 round_tidy(r.squared[2], 3), ")"),
234 1
		", Likelihood ratio test = ", paste0(round_tidy(logtest[1], 3), " (df = ",
235 1
																				 round(logtest[2], 0), ", p = ",
236 1
																				 round_tidy(logtest[3], 3), ")")
237

238
	) %>% 
239 1
		as.data.frame(stringsAsFactors = FALSE) %>% 
240 1
		unname()
241 1
	class(metrics.out) = c("data.frame.ff", class(metrics.out))
242 1
	return(metrics.out)
243
}
244

245
#' @export
246
#' @rdname ff_metrics
247
#' @method ff_metrics coxphlist
248
ff_metrics.coxphlist <- function(.data){
249 0
	x = .data[[1]]
250 0
	n_model = x$n
251 0
	n_missing = length(x$na.action)
252 0
	n_data = n_model+n_missing
253 0
	n_event = x$nevent
254 0
	concordance = summary(x)$concordance
255 0
	r.squared = summary(x)$rsq
256 0
	logtest = summary(x)$logtest
257 0
	metrics.out = paste0(
258 0
		"Number in dataframe = ", n_data,
259 0
		", Number in model = ", n_model,
260 0
		", Missing = ", n_missing,
261 0
		", Number of events = ", n_event,
262 0
		", Concordance = ", paste0(round_tidy(concordance[1], 3), " (SE = ",
263 0
															 round_tidy(concordance[2], 3), ")"),
264 0
		", R-squared = ", paste0(round_tidy(r.squared[1], 3), "( Max possible = ",
265 0
														 round_tidy(r.squared[2], 3), ")"),
266 0
		", Likelihood ratio test = ", paste0(round_tidy(logtest[1], 3), " (df = ",
267 0
																				 round_tidy(logtest[2], 0), ", p = ",
268 0
																				 round_tidy(logtest[3], 3), ")")
269

270
	) %>% 
271 0
		as.data.frame(stringsAsFactors = FALSE) %>% 
272 0
		unname()
273 0
	class(metrics.out) = c("data.frame.ff", class(metrics.out))
274 0
	return(metrics.out)
275
}

Read our documentation on viewing source code .

Loading