ewenharrison / finalfit
1
#' Extract model fit results to dataframe (generic): \code{finalfit} model
2
#' extractors
3
#'
4
#' Takes output from \code{finalfit} model wrappers and extracts to a dataframe,
5
#' convenient for further processing in preparation for final results table.
6
#'
7
#' \code{fit2df} is a generic (S3) function for model extract.
8
#'
9
#' @param .data Output from \code{finalfit} model wrappers.
10
#' @param condense Logical: when true, effect estimates, confidence intervals
11
#'   and p-values are pasted conveniently together in single cell.
12
#' @param metrics Logical: when true, useful model metrics are extracted.
13
#' @param remove_intercept Logical: remove the results for the intercept term.
14
#' @param explanatory_name Name for this column in output
15
#' @param estimate_name Name for this column in output
16
#' @param estimate_suffix Appeneded to estimate name
17
#' @param p_name Name given to p-value estimate
18
#' @param digits Number of digits to round to (1) estimate, (2) confidence
19
#'   interval limits, (3) p-value.
20
#' @param exp Currently GLM only. Exponentiate coefficients and confidence
21
#'   intervals. Defaults to TRUE.
22
#' @param confint_type One of \code{c("profile", "default")} for GLM models
23
#'   (\code{\link[MASS]{confint.glm}}) or \code{c("profile", "Wald", "boot")}
24
#'   for \code{glmer/lmer} models (\code{\link[lme4]{confint.merMod}}.). Not
25
#'   implemented for \code{lm, coxph or coxphlist}.
26
#' @param confint_level The confidence level required.
27
#' @param confint_sep String to separate confidence intervals, typically "-" or
28
#'   " to ".
29
#' @param ... Other arguments: \code{X}: Design matrix from stanfit modelling.
30
#'   Details documented else where.
31
#'
32
#' @return A dataframe of model parameters. When \code{metrics=TRUE} output is a
33
#'   list of two dataframes, one is model parameters, one is model metrics.
34
#'   length two
35
#'
36
#' @family finalfit model extractors
37
#'
38
#' @export
39
#'
40
#' @examples
41
#' library(finalfit)
42
#' library(dplyr)
43
#' library(survival)
44

45
#' # glm
46
#' fit = glm(mort_5yr ~  age.factor + sex.factor + obstruct.factor + perfor.factor,
47
#'   data=colon_s, family="binomial")
48
#' fit %>%
49
#'   fit2df(estimate_suffix=" (multivariable)")
50
#'
51
#' # glmlist
52
#' explanatory = c("age.factor", "sex.factor", "obstruct.factor", "perfor.factor")
53
#' dependent = "mort_5yr"
54
#' colon_s %>%
55
#'   glmmulti(dependent, explanatory) %>%
56
#'   fit2df(estimate_suffix=" (univariable)")
57
#'
58
#' # glmerMod
59
#' explanatory = c("age.factor", "sex.factor", "obstruct.factor", "perfor.factor")
60
#' random_effect = "hospital"
61
#' dependent = "mort_5yr"
62
#' colon_s %>%
63
#'   glmmixed(dependent, explanatory, random_effect) %>%
64
#'   fit2df(estimate_suffix=" (multilevel)")
65
#'
66
#' # glmboot
67
#' ## Note number of draws set to 100 just for speed in this example
68
#' explanatory = c("age.factor", "sex.factor", "obstruct.factor", "perfor.factor")
69
#' dependent = "mort_5yr"
70
#' colon_s %>%
71
#'   glmmulti_boot(dependent, explanatory,  R = 100) %>%
72
#'   fit2df(estimate_suffix=" (multivariable (BS CIs))")
73
#'
74
#' # lm
75
#' fit = lm(nodes ~  age.factor + sex.factor + obstruct.factor + perfor.factor,
76
#'   data=colon_s)
77
#' fit %>%
78
#'   fit2df(estimate_suffix=" (multivariable)")
79
#'
80
#' # lmerMod
81
#' explanatory = c("age.factor", "sex.factor", "obstruct.factor", "perfor.factor")
82
#' random_effect = "hospital"
83
#' dependent = "nodes"
84
#'
85
#' colon_s %>%
86
#'   lmmixed(dependent, explanatory, random_effect) %>%
87
#'   fit2df(estimate_suffix=" (multilevel")
88
#'
89
#' # coxphlist
90
#' explanatory = c("age.factor", "sex.factor", "obstruct.factor", "perfor.factor")
91
#' dependent = "Surv(time, status)"
92
#'
93
#' colon_s %>%
94
#'   coxphuni(dependent, explanatory) %>%
95
#'   fit2df(estimate_suffix=" (univariable)")
96
#'
97
#' colon_s %>%
98
#'   coxphmulti(dependent, explanatory) %>%
99
#'   fit2df(estimate_suffix=" (multivariable)")
100
#'
101
#' # coxph
102
#' fit = coxph(Surv(time, status) ~ age.factor + sex.factor + obstruct.factor + perfor.factor,
103
#'   data = colon_s)
104
#'
105
#' fit %>%
106
#'   fit2df(estimate_suffix=" (multivariable)")
107
#' 	
108
#' # crr: competing risks
109
#' melanoma = boot::melanoma
110
#' melanoma = melanoma %>% 
111
#'   mutate(
112
#'     status_crr = ifelse(status == 2, 0, # "still alive"
113
#'       ifelse(status == 1, 1, # "died of melanoma"
114
#'       2)), # "died of other causes" 
115
#'     sex = factor(sex),
116
#'     ulcer = factor(ulcer)
117
#'   )
118
#'
119
#' dependent = c("Surv(time, status_crr)")
120
#' explanatory = c("sex", "age", "ulcer")
121
#' melanoma %>% 
122
#'   summary_factorlist(dependent, explanatory, column = TRUE, fit_id = TRUE) %>% 
123
#'   ff_merge(
124
#'     melanoma %>% 
125
#'       crrmulti(dependent, explanatory) %>% 
126
#'       fit2df(estimate_suffix = " (competing risks)")
127
#'   ) %>% 
128
#' select(-fit_id, -index) %>% 
129
#' dependent_label(melanoma, dependent)
130

131
fit2df <- function(...){
132 1
	UseMethod("fit2df")
133
}
134

135

136

137
#' Extract \code{glm::lm} model fit results to dataframe: \code{finalfit} model extracters
138
#'
139
#' \code{fit2df.lm} is the model extract method for \code{\link[stats]{lm}}.
140
#'
141
#' @rdname fit2df
142
#' @method fit2df lm
143
#' @export
144
#'
145

146
fit2df.lm <- function(.data, condense=TRUE, metrics=FALSE, remove_intercept=TRUE,
147
											explanatory_name = "explanatory",
148
											estimate_name = "Coefficient",
149
											estimate_suffix = "",
150
											p_name = "p",
151
											digits=c(2,2,3),
152
											confint_level = 0.95,
153
											confint_sep = " to ", ...){
154
	
155 1
	df.out = extract_fit(.data=.data, explanatory_name=explanatory_name,
156 1
											 estimate_name=estimate_name, estimate_suffix=estimate_suffix,
157 1
											 p_name=p_name, digits=digits,)
158
	
159 1
	if (condense){
160 1
		df.out = condense_fit(df.out, explanatory_name=explanatory_name,
161 1
													estimate_name=estimate_name, estimate_suffix=estimate_suffix,
162 1
													p_name=p_name, digits=digits, confint_sep=confint_sep)
163
	}
164
	
165 1
	if (remove_intercept){
166 1
		df.out = remove_intercept(df.out)
167
	}
168
	
169
	# Extract model metrics
170 1
	if (metrics){
171 1
		metrics.out = ff_metrics(.data)
172 1
		return(list(df.out, metrics.out))
173
	} else {
174 1
		return(df.out)
175
	}
176
}
177

178
#' Extract \code{lmuni} and \code{lmmulti} model fit results to dataframe:
179
#' \code{finalfit} model extracters
180
#'
181
#' \code{fit2df.lmlist} is the model extract method for \code{lmuni} and
182
#' \code{lmmulti}.
183
#'
184
#' @rdname fit2df
185
#' @method fit2df lmlist
186
#' @export
187

188
fit2df.lmlist <- function(.data, condense=TRUE, metrics=FALSE, remove_intercept=TRUE,
189
													explanatory_name = "explanatory",
190
													estimate_name = "Coefficient",
191
													estimate_suffix = "",
192
													p_name = "p", digits=c(2,2,3),
193
													confint_level = 0.95,
194
													confint_sep = " to ", ...){
195
	
196 1
	if (all(metrics, length(.data)>1)){
197 0
		stop("Metrics only generated for single models: multiple models supplied to function")
198
	}
199
	
200 1
	df.out = .data %>% 
201 1
		purrr::map_dfr(extract_fit, explanatory_name=explanatory_name,
202 1
									 estimate_name=estimate_name, estimate_suffix=estimate_suffix,
203 1
									 p_name=p_name,  confint_level=confint_level)
204
	
205 1
	if (condense){
206 1
		df.out = condense_fit(df.out, explanatory_name=explanatory_name,
207 1
													estimate_name=estimate_name, estimate_suffix=estimate_suffix,
208 1
													p_name=p_name, digits=digits, confint_sep=confint_sep)
209
	}
210
	
211 1
	if (remove_intercept){
212 1
		df.out = remove_intercept(df.out)
213
	}
214
	
215
	# Extract model metrics
216 1
	if (metrics){
217 1
		metrics.out = ff_metrics(.data)
218 1
		return(list(df.out, metrics.out))
219
	} else {
220 1
		return(df.out)
221
	}
222
}
223

224

225
#' Extract \code{glm} model fit results to dataframe: \code{finalfit} model
226
#' extracters
227
#'
228
#' \code{fit2df.glm} is the model extract method for standard
229
#' \code{\link[stats]{glm}} models, which have not used \code{finalfit} model
230
#' wrappers.
231
#'
232
#' @rdname fit2df
233
#' @method fit2df glm
234
#' @export
235
#'
236
fit2df.glm <- function(.data, condense=TRUE, metrics=FALSE, remove_intercept=TRUE,
237
											 explanatory_name = "explanatory",
238
											 estimate_name = "OR",
239
											 estimate_suffix = "",
240
											 p_name = "p",
241
											 digits=c(2,2,3),
242
											 exp = TRUE,
243
											 confint_type = "profile",
244
											 confint_level = 0.95,
245
											 confint_sep = "-", ...){
246
	
247 1
	df.out = extract_fit(.data = .data, explanatory_name = explanatory_name,
248 1
											 estimate_name = estimate_name, estimate_suffix = estimate_suffix,
249 1
											 exp = exp, 
250 1
											 confint_type = confint_type,
251 1
											 confint_level = confint_level,
252 1
											 p_name=p_name)
253
	
254 1
	if (condense){
255 1
		df.out = condense_fit(df.out, explanatory_name = explanatory_name,
256 1
													estimate_name = estimate_name, estimate_suffix = estimate_suffix,
257 1
													p_name = p_name, digits = digits, confint_sep = confint_sep)
258
	}
259
	
260 1
	if (remove_intercept){
261 1
		df.out = remove_intercept(df.out)
262
	}
263
	
264
	# Extract model metrics
265 1
	if (metrics){
266 1
		metrics.out = ff_metrics(.data)
267 1
		return(list(df.out, metrics.out))
268
	} else {
269 1
		return(df.out)
270
	}
271
}
272

273
#' Extract \code{glmboot} model fit results to dataframe: \code{finalfit} model extracters
274
#'
275
#' \code{fit2df.glmboot} is the model extract method for \code{\link{glmmulti_boot}} models.
276
#'
277
#' @rdname fit2df
278
#' @method fit2df glmboot
279
#' @export
280

281
fit2df.glmboot = function(.data, condense=TRUE, metrics=FALSE, remove_intercept=TRUE,
282
													explanatory_name = "explanatory",
283
													estimate_name = "OR",
284
													estimate_suffix = "",
285
													p_name = "p",
286
													digits=c(2,2,3),
287
													confint_sep = "-", ...){
288 1
	if(metrics) warning("Metrics not currently available for this model")
289
	
290 1
	x = .data
291 1
	d.estimate = digits[1]
292 1
	d.confint = digits[2]
293 1
	d.p = digits[3]
294
	
295 1
	R = dim(x$t)[1]
296
	
297 1
	df.out = data.frame(
298 1
		explanatory = names(x$t0),
299 1
		estimate = exp(x$t0))
300 1
	for (i in 1:dim(df.out)[1]){
301 1
		df.out$L95[i] = exp(sort(x$t[,i]))[floor(R*0.025)]
302 1
		df.out$U95[i] = exp(sort(x$t[,i]))[floor((R*0.975)+1)]
303 1
		df.out$p[i] = ifelse(x$t0[i] >= 0, mean(x$t[,i]<0)*2, mean(x$t[,i]>0)*2)
304
	}
305 1
	df.out$estimate = round(df.out$estimate, d.estimate)
306 1
	df.out$L95 = round(df.out$L95, d.confint)
307 1
	df.out$U95 = round(df.out$U95, d.confint)
308 1
	df.out$p = round(df.out$p, d.p)
309 1
	colnames(df.out) = c(explanatory_name, paste0(estimate_name, estimate_suffix), "L95", "U95", p_name)
310
	
311 1
	if (condense){
312 1
		df.out = condense_fit(df.out, explanatory_name=explanatory_name,
313 1
													estimate_name=estimate_name, estimate_suffix=estimate_suffix,
314 1
													p_name=p_name, digits=digits, confint_sep=confint_sep)
315
	}
316
	
317 1
	if (remove_intercept){
318 1
		df.out = remove_intercept(df.out)
319
	}
320
	
321 1
	return(df.out)
322
}
323

324
#' Extract \code{glmuni} and \code{glmmulti} model fit results to dataframe: \code{finalfit} model extracters
325
#'
326
#' \code{fit2df.glmlist} is the model extract method for \code{glmuni} and \code{glmmulti}.
327
#'
328
#' @rdname fit2df
329
#' @method fit2df glmlist
330
#' @export
331

332
fit2df.glmlist <- function(.data, condense=TRUE, metrics=FALSE, remove_intercept=TRUE,
333
													 explanatory_name = "explanatory",
334
													 estimate_name = "OR",
335
													 estimate_suffix = "",
336
													 p_name = "p",
337
													 digits=c(2,2,3),
338
													 exp = TRUE, 
339
													 confint_type = "profile",
340
													 confint_level = 0.95,
341
													 confint_sep = "-", ...){
342
	
343 1
	if (all(metrics, length(.data)>1)){
344 0
		stop("Metrics only generated for single models: multiple models supplied to function")
345
	}
346
	
347 1
	df.out = .data %>% 
348 1
		purrr::map_dfr(extract_fit, explanatory_name = explanatory_name,
349 1
									 estimate_name = estimate_name, estimate_suffix = estimate_suffix,
350 1
									 p_name = p_name, exp = exp, 
351 1
									 confint_type = confint_type,
352 1
									 confint_level = confint_level,
353 1
									 digits=digits)
354
	
355 1
	if (condense){
356 1
		df.out = condense_fit(.data=df.out, explanatory_name=explanatory_name,
357 1
													estimate_name=estimate_name, estimate_suffix=estimate_suffix,
358 1
													p_name=p_name, digits=digits, confint_sep=confint_sep)
359
	}
360
	
361 1
	if (remove_intercept){
362 1
		df.out = remove_intercept(df.out)
363
	}
364
	
365
	# Extract model metrics
366 1
	if (metrics){
367 1
		metrics.out = ff_metrics(.data)
368 1
		return(list(df.out, metrics.out))
369
	} else {
370 1
		return(df.out)
371
	}
372
}
373

374

375
#' Extract \code{svyglmuni} and \code{svyglmmulti} model fit results to dataframe: \code{finalfit} model extracters
376
#'
377
#' \code{fit2df.svyglmlist} is the model extract method for \code{svyglmuni} and \code{svyglmmulti}.
378
#'
379
#' @rdname fit2df
380
#' @method fit2df svyglmlist
381
#' @export
382

383
fit2df.svyglmlist <- function(.data, condense=TRUE, metrics=FALSE, remove_intercept=TRUE,
384
													 explanatory_name = "explanatory",
385
													 estimate_name = "Coefficient",
386
													 estimate_suffix = "",
387
													 p_name = "p",
388
													 digits=c(2,2,3),
389
													 exp = FALSE, 
390
													 confint_type = "profile",
391
													 confint_level = 0.95,
392
													 confint_sep = "-", ...){
393
	
394 1
	if (metrics && length(.data)>1){
395 0
		stop("Metrics only generated for single models: multiple models supplied to function")
396
	}
397
	
398 1
	df.out = .data %>% 
399 1
		purrr::map_dfr(extract_fit, explanatory_name = explanatory_name,
400 1
									 estimate_name = estimate_name, estimate_suffix = estimate_suffix,
401 1
									 p_name = p_name, exp = exp, 
402 1
									 confint_type = confint_type,
403 1
									 confint_level = confint_level,
404 1
									 digits=digits)
405
	
406 1
	if (condense){
407 1
		df.out = condense_fit(.data=df.out, explanatory_name=explanatory_name,
408 1
													estimate_name=estimate_name, estimate_suffix=estimate_suffix,
409 1
													p_name=p_name, digits=digits, confint_sep=confint_sep)
410
	}
411
	
412 1
	if (remove_intercept){
413 1
		df.out = remove_intercept(df.out)
414
	}
415
	
416
	# Extract model metrics
417 1
	if (metrics){
418 0
		metrics.out = ff_metrics(.data)
419 0
		return(list(df.out, metrics.out))
420
	} else {
421 1
		return(df.out)
422
	}
423
}
424

425

426
#' Extract \code{lmerMod} model fit results to dataframe: \code{finalfit} model
427
#' extracters
428
#'
429
#' \code{fit2df.lmerMod} is the model extract method for standard
430
#' \code{lme4::\link[lme4]{lmer}} models and for the
431
#' \code{finalfit::\link{lmmixed}} model wrapper.
432
#'
433
#' @rdname fit2df
434
#' @method fit2df lmerMod
435
#' @export
436

437
fit2df.lmerMod = function(.data, condense=TRUE, metrics=FALSE, remove_intercept=TRUE,
438
													explanatory_name = "explanatory",
439
													estimate_name = "Coefficient",
440
													estimate_suffix = "",
441
													p_name = "p",
442
													digits=c(2,2,3),
443
													confint_type = "Wald",
444
													confint_level = 0.95,
445
													confint_sep = "-", ...){
446
	
447 1
	df.out = extract_fit(.data=.data, explanatory_name=explanatory_name,
448 1
											 estimate_name=estimate_name, estimate_suffix=estimate_suffix,
449 1
											 p_name=p_name, confint_type = confint_type, confint_level = confint_level)
450
	
451 1
	if (condense){
452 1
		df.out = condense_fit(df.out, explanatory_name=explanatory_name,
453 1
													estimate_name=estimate_name, estimate_suffix=estimate_suffix,
454 1
													p_name=p_name, digits=digits, confint_sep=confint_sep)
455
	}
456
	
457 1
	if (remove_intercept){
458 1
		df.out = remove_intercept(df.out)
459
	}
460
	
461
	# Extract model metrics
462 1
	if (metrics){
463 1
		metrics.out = ff_metrics(.data)
464 1
		return(list(df.out, metrics.out))
465
	} else {
466 1
		return(df.out)
467
	}
468
}
469

470
#' Extract \code{glmerMod} model fit results to dataframe: \code{finalfit} model
471
#' extracters
472
#'
473
#' \code{fit2df.glmerMod} is the model extract method for standard
474
#' \code{lme4::\link[lme4]{glmer}} models and for the
475
#' \code{finalfit::\link{glmmixed}} model wrapper.
476
#'
477
#' @rdname fit2df
478
#' @method fit2df glmerMod
479
#' @export
480

481
fit2df.glmerMod = function(.data, condense=TRUE, metrics=FALSE, remove_intercept=TRUE,
482
													 explanatory_name = "explanatory",
483
													 estimate_name = "OR",
484
													 estimate_suffix = "",
485
													 p_name = "p",
486
													 digits=c(2,2,3),
487
													 exp = TRUE,
488
													 confint_type = "Wald",
489
													 confint_level = 0.95,
490
													 confint_sep = "-", ...){
491
	
492 1
	df.out = extract_fit(.data=.data, explanatory_name=explanatory_name,
493 1
											 estimate_name=estimate_name, estimate_suffix=estimate_suffix,
494 1
											 p_name=p_name, confint_type = confint_type,
495 1
											 confint_level = confint_level)
496
	
497 1
	if (condense){
498 1
		df.out = condense_fit(df.out, explanatory_name=explanatory_name,
499 1
													estimate_name=estimate_name, estimate_suffix=estimate_suffix,
500 1
													p_name=p_name, digits=digits, confint_sep=confint_sep)
501
	}
502
	
503 1
	if (remove_intercept){
504 1
		df.out = remove_intercept(df.out)
505
	}
506
	
507
	
508
	# Extract model metrics
509 1
	if (metrics){
510 1
		metrics.out = ff_metrics(.data)
511 1
		return(list(df.out, metrics.out))
512
	} else {
513 1
		return(df.out)
514
	}
515
}
516

517
#' Extract \code{survival::coxph} model fit results to dataframe: \code{finalfit} model extracters
518
#'
519
#' \code{fit2df.coxph} is the model extract method for \code{survival::\link[survival]{coxph}}.
520
#'
521
#' @rdname fit2df
522
#' @method fit2df coxph
523
#' @export
524
#'
525
fit2df.coxph <- function(.data, condense=TRUE, metrics=FALSE,
526
												 explanatory_name = "explanatory",
527
												 estimate_name = "HR",
528
												 estimate_suffix = "",
529
												 p_name = "p",
530
												 digits=c(2,2,3),
531
												 confint_sep = "-", ...){
532
	
533 1
	df.out = extract_fit(.data=.data, explanatory_name=explanatory_name,
534 1
											 estimate_name=estimate_name, estimate_suffix=estimate_suffix,
535 1
											 p_name=p_name)
536
	
537 1
	if (condense){
538 1
		df.out = condense_fit(.data=df.out, explanatory_name=explanatory_name,
539 1
													estimate_name=estimate_name, estimate_suffix=estimate_suffix,
540 1
													p_name=p_name, digits=digits, confint_sep=confint_sep)
541
	}
542
	# Extract model metrics
543 1
	if (metrics){
544 1
		metrics.out = ff_metrics(.data)
545 1
		return(list(df.out, metrics.out))
546
	} else {
547 1
		return(df.out)
548
	}
549
}
550

551
#' Extract \code{coxphuni} and \code{coxphmulti} model fit results to dataframe: \code{finalfit} model extracters
552
#'
553
#' \code{fit2df.coxphlist} is the model extract method for \code{coxphuni} and \code{coxphmulti}.
554
#'
555
#' @rdname fit2df
556
#' @method fit2df coxphlist
557
#' @export
558

559
fit2df.coxphlist <- function(.data, condense=TRUE, metrics=FALSE,
560
														 explanatory_name = "explanatory",
561
														 estimate_name = "HR",
562
														 estimate_suffix = "",
563
														 p_name = "p",
564
														 digits=c(2,2,3),
565
														 confint_sep = "-", ...){
566
	#if(metrics) warning("Metrics not currently available for this model")
567
	
568 1
	df.out = .data %>% 
569 1
		purrr::map_dfr(extract_fit, explanatory_name=explanatory_name,
570 1
									 estimate_name=estimate_name, estimate_suffix=estimate_suffix,
571 1
									 p_name=p_name, digits=digits)
572
	
573 1
	if (condense){
574 1
		df.out = condense_fit(.data=df.out, explanatory_name=explanatory_name,
575 1
													estimate_name=estimate_name, estimate_suffix=estimate_suffix,
576 1
													p_name=p_name, digits=digits, confint_sep=confint_sep)
577
	}
578
	
579
	# Extract model metrics
580 1
	if (metrics){
581 0
		metrics.out = ff_metrics(.data)
582 0
		return(list(df.out, metrics.out))
583
	} else {
584 1
		return(df.out)
585
	}
586
}
587

588

589
#' Extract \code{cmprsk::crr} model fit results to dataframe: \code{finalfit} model extracters
590
#'
591
#' \code{fit2df.crr} is the model extract method for \code{cmprsk::\link[cmprsk]{crr}}.
592
#'
593
#' @rdname fit2df
594
#' @method fit2df crr
595
#' @export
596
#'
597
fit2df.crr <- function(.data, condense=TRUE, metrics=FALSE,
598
												 explanatory_name = "explanatory",
599
												 estimate_name = "HR",
600
												 estimate_suffix = "",
601
												 p_name = "p",
602
												 digits=c(2,2,3),
603
												 confint_sep = "-", ...){
604
	
605 1
	df.out = extract_fit(.data=.data, explanatory_name=explanatory_name,
606 1
											 estimate_name=estimate_name, estimate_suffix=estimate_suffix,
607 1
											 p_name=p_name)
608
	
609 1
	if (condense){
610 1
		df.out = condense_fit(.data=df.out, explanatory_name=explanatory_name,
611 1
													estimate_name=estimate_name, estimate_suffix=estimate_suffix,
612 1
													p_name=p_name, digits=digits, confint_sep=confint_sep)
613
	}
614
	# Extract model metrics
615 1
	if (metrics){
616 0
		metrics.out = ff_metrics(.data)
617 0
		return(list(df.out, metrics.out))
618
	} else {
619 1
		return(df.out)
620
	}
621
}
622

623

624
#' Extract \code{coxme::coxme} model fit results to dataframe: \code{finalfit} model extracters
625
#'
626
#' \code{fit2df.coxme} is the model extract method for \code{eoxme::\link[coxme]{coxme}}.
627
#'
628
#' @rdname fit2df
629
#' @method fit2df coxme
630
#' @export
631
#'
632
fit2df.coxme <- function(.data, condense=TRUE, metrics=FALSE,
633
											 explanatory_name = "explanatory",
634
											 estimate_name = "HR",
635
											 estimate_suffix = "",
636
											 p_name = "p",
637
											 digits=c(2,2,3),
638
											 confint_sep = "-", ...){
639
	
640 0
	df.out = extract_fit(.data=.data, explanatory_name=explanatory_name,
641 0
											 estimate_name=estimate_name, estimate_suffix=estimate_suffix,
642 0
											 p_name=p_name)
643
	
644 0
	if (condense){
645 0
		df.out = condense_fit(.data=df.out, explanatory_name=explanatory_name,
646 0
													estimate_name=estimate_name, estimate_suffix=estimate_suffix,
647 0
													p_name=p_name, digits=digits, confint_sep=confint_sep)
648
	}
649
	# Extract model metrics
650 0
	if (metrics){
651 0
		metrics.out = ff_metrics(.data)
652 0
		return(list(df.out, metrics.out))
653
	} else {
654 0
		return(df.out)
655
	}
656
}
657

658

659

660

661
#' Extract \code{crruni} and \code{crrmulti} model fit results to dataframe:
662
#' \code{finalfit} model extracters
663
#'
664
#' \code{fit2df.crr} is the model extract method for
665
#' \code{crruni} and \code{crrmulti}.
666
#'
667
#' @rdname fit2df
668
#' @method fit2df crrlist
669
#' @export
670
#' 
671
fit2df.crrlist <- function(.data, condense=TRUE, metrics=FALSE,
672
											 explanatory_name = "explanatory",
673
											 estimate_name = "HR",
674
											 estimate_suffix = "",
675
											 p_name = "p",
676
											 digits=c(2,2,3),
677
											 confint_sep = "-", ...){
678
	
679 1
	df.out = .data %>% 
680 1
		purrr::map_dfr(extract_fit, explanatory_name=explanatory_name,
681 1
									 estimate_name=estimate_name, estimate_suffix=estimate_suffix,
682 1
									 p_name=p_name, digits=digits)
683

684
	
685 1
	if (condense){
686 1
		df.out = condense_fit(.data=df.out, explanatory_name=explanatory_name,
687 1
													estimate_name=estimate_name, estimate_suffix=estimate_suffix,
688 1
													p_name=p_name, digits=digits, confint_sep=confint_sep)
689
	}
690
	# Extract model metrics
691 1
	if (metrics){
692 0
		metrics.out = ff_metrics(.data)
693 0
		return(list(df.out, metrics.out))
694
	} else {
695 1
		return(df.out)
696
	}
697
}
698

699
#' Extract \code{stanfit} model fit results to dataframe: \code{finalfit} model
700
#' extracters
701
#'
702
#' \code{fit2df.stanfit} is the model extract method for our standard Bayesian
703
#' hierarchical binomial logistic regression models. These models will be fully
704
#' documented separately. However this should work for a single or multilevel
705
#' Bayesian logistic regression done in Stan, as long as the fixed effects are
706
#' specified in the parameters block as a vector named \code{beta}, of length
707
#' \code{P}, where \code{P} is the number of fixed effect parameters. e.g.
708
#' parameters{ vector[P] beta; }
709
#'
710
#' @rdname fit2df
711
#' @method fit2df stanfit
712
#' @export
713
#'
714
fit2df.stanfit = function(.data, condense=TRUE, metrics=FALSE, remove_intercept=TRUE,
715
													explanatory_name = "explanatory",
716
													estimate_name = "OR",
717
													estimate_suffix = "",
718
													p_name = "p",
719
													digits=c(2,2,3),
720
													confint_sep = "-", ...){
721 0
	args = list(...)
722

723 0
	if(is.null(args$X)) stop("Must include design matrix from Stan procedure, e.g. X=X")
724

725 0
	df.out = extract_fit(.data=.data, explanatory_name=explanatory_name,
726 0
											 estimate_name=estimate_name, estimate_suffix=estimate_suffix,
727 0
											 p_name=p_name, digits=digits, X=args$X)
728

729 0
	if (condense){
730 0
		df.out = condense_fit(df.out, explanatory_name=explanatory_name,
731 0
													estimate_name=estimate_name, estimate_suffix=estimate_suffix,
732 0
													p_name=p_name, digits=digits, confint_sep=confint_sep)
733
	}
734

735 0
	if (remove_intercept){
736 0
		df.out = remove_intercept(df.out)
737
	}
738

739
	# Extract model metrics
740
	## This needs an ff_metrics() method
741 0
	if (metrics){
742
		# n_data = dim(x$data)[1] # no equivalent here
743 0
		n_model = dim(args$X)[1]
744
		# aic = round(x$aic, 1) # add WAIC later?
745
		# auc = round(roc(x$y, x$fitted)$auc[1], 3) # Add predicted mu later?
746 0
		metrics.out = paste0(
747
			#	"Number in dataframe = ", n_data,
748 0
			", Number in model = ", n_model)
749
		#	", Missing = ", n_data-n_model,
750
		#	", AIC = ", aic,
751
		#	", C-statistic = ", auc)
752
	}
753

754 0
	if (metrics){
755 0
		return(list(df.out, metrics.out))
756
	} else {
757 0
		return(df.out)
758
	}
759 0
	return(df.out)
760
}
761

762
#' Extract \code{mice} pooled fit results to dataframe: \code{finalfit} model
763
#' extracters
764
#'
765
#' \code{fit2df.mipo} is the model extract method for the \code{mipo} object
766
#' created using \code{mice::pool}.
767
#'
768
#' @rdname fit2df
769
#' @method fit2df mipo
770
#' @export
771
#' 
772
fit2df.mipo <- function(.data, condense=TRUE, metrics=FALSE, remove_intercept=TRUE,
773
												explanatory_name = "explanatory",
774
												estimate_name = "Coefficient",
775
												estimate_suffix = "",
776
												p_name = "p",
777
												digits=c(2,2,3),
778
												exp = FALSE,
779
												confint_level = 0.95,
780
												confint_sep = "-", ...){
781
	
782 0
	df.out = summary_mipo(.data, conf.int = TRUE, 
783 0
															 conf.level = confint_level, 
784 0
															 exponentiate = exp) %>% 
785 0
		dplyr::select(explanatory_name = term, estimate, `2.5 %`, `97.5 %`, p.value)
786 0
	colnames(df.out) = c(explanatory_name, estimate_name, "L95", "U95", "p")
787
	
788 0
	if (condense){
789 0
		df.out = condense_fit(df.out, explanatory_name = explanatory_name,
790 0
													estimate_name = estimate_name, estimate_suffix = estimate_suffix,
791 0
													p_name = p_name, digits = digits, confint_sep = confint_sep)
792
	}
793
	
794 0
	if (remove_intercept){
795 0
		df.out = remove_intercept(df.out)
796
	}
797
	
798
	# Extract model metrics
799
	## Not implemented for mipo
800
	# if (metrics){
801
	#   metrics.out = ff_metrics(.data)
802
	#   return(list(df.out, metrics.out))
803
	# } else {
804
	#   return(df.out)
805
	# }
806 0
	return(df.out)
807
}

Read our documentation on viewing source code .

Loading