1
|
|
#' Compare bootstrapped distributions
|
2
|
|
#'
|
3
|
|
#' Not usually called directly. Included in \code{\link{boot_predict}}. Usually used in combination with A function that takes the output from \code{\link{summary_factorlist}(...,
|
4
|
|
#' fit_id=TRUE)} and merges with any number of model dataframes, usually
|
5
|
|
#' produced with a model wrapper followed by the \code{\link{fit2df}()} function
|
6
|
|
#' (see examples).
|
7
|
|
#'
|
8
|
|
#' @param bs.out Output from \code{boot::boot},
|
9
|
|
#' @param confint_sep String separating lower and upper confidence interval
|
10
|
|
#' @param condense Logical. FALSE gives numeric values, usually for plotting.
|
11
|
|
#' TRUE gives table for final output.
|
12
|
|
#' @param compare_name Name to be given to comparison metric.
|
13
|
|
#' @param comparison Either "difference" or "ratio".
|
14
|
|
#' @param ref_symbol Reference level symbol
|
15
|
|
#' @param digits Rounding for estimate values and p-values, default c(2,3).
|
16
|
|
#' @return A dataframe of first differences or ratios for boostrapped distributions of a metric of interest.
|
17
|
|
#'
|
18
|
|
#' \code{finalfit} predict functions
|
19
|
|
#'
|
20
|
|
#' @seealso \code{\link{boot_predict}} \code{\link{finalfit_newdata}}
|
21
|
|
#' @export
|
22
|
|
#'
|
23
|
|
#' @examples
|
24
|
|
#' # See boot_predict.
|
25
|
|
|
26
|
|
boot_compare = function(bs.out, confint_sep = " to ", comparison = "difference", condense=TRUE,
|
27
|
|
compare_name = NULL, digits = c(2, 3), ref_symbol = 1){
|
28
|
|
|
29
|
1
|
if(is.null(compare_name)){
|
30
|
1
|
compare_name = paste0(toupper(substring(comparison, 1, 1)), substring(comparison, 2))
|
31
|
|
}
|
32
|
|
|
33
|
1
|
bs_1 = bs.out$t[,1]
|
34
|
1
|
bs_c = bs.out$t[,-1]
|
35
|
|
|
36
|
1
|
if(comparison == "difference"){
|
37
|
1
|
estimate = bs_c - bs_1
|
38
|
1
|
null_ref = 0
|
39
|
1
|
}else if(comparison == "ratio"){
|
40
|
1
|
estimate = bs_c / bs_1
|
41
|
1
|
null_ref = 1
|
42
|
|
}
|
43
|
|
|
44
|
1
|
if(is.null(dim(estimate))) estimate = matrix(estimate, ncol=1) #allow single vector to pass to apply
|
45
|
|
|
46
|
1
|
estimate_centre = apply(estimate, 2, median)
|
47
|
1
|
estimate_conf.low = apply(estimate, 2, quantile, probs = c(0.025))
|
48
|
1
|
estimate_conf.high = apply(estimate, 2, quantile, probs = c(0.975))
|
49
|
1
|
estimate_p1 = apply(estimate, 2, function(x) mean(x < null_ref ))
|
50
|
1
|
estimate_p2 = apply(estimate, 2, function(x) mean(x > null_ref ))
|
51
|
1
|
estimate_p3 = apply(estimate, 2, function(x) mean(x == null_ref ))
|
52
|
1
|
estimate_p = apply(rbind(estimate_p1, estimate_p2), 2, min)
|
53
|
1
|
estimate_p = ifelse(estimate_p3==1, 1, estimate_p)
|
54
|
1
|
estimate_p = apply(rbind(estimate_p*2, 1), 2, min) #two-tailed, max 1
|
55
|
|
|
56
|
1
|
if(!condense){
|
57
|
1
|
df.out = data.frame(estimate_centre, estimate_conf.low, estimate_conf.high, estimate_p,
|
58
|
1
|
stringsAsFactors=FALSE)
|
59
|
1
|
colnames(df.out) = c(comparison, paste0(comparison, "_conf.low"),
|
60
|
1
|
paste0(comparison, "_conf.high"), paste0(comparison, "_p"))
|
61
|
1
|
df.out = rbind(null_ref, df.out)
|
62
|
1
|
}else if(condense){
|
63
|
1
|
estimate_centre = round_tidy(estimate_centre, digits[1])
|
64
|
1
|
estimate_conf.low = round_tidy(estimate_conf.low, digits[1])
|
65
|
1
|
estimate_conf.high = round_tidy(estimate_conf.high, digits[1])
|
66
|
1
|
estimate_p = p_tidy(estimate_p, digits[2])
|
67
|
1
|
df.out = paste0(estimate_centre, " (", estimate_conf.low, confint_sep,
|
68
|
1
|
estimate_conf.high, ", p", estimate_p, ")")
|
69
|
1
|
df.out = c(ref_symbol, df.out)
|
70
|
1
|
df.out = data.frame(df.out)
|
71
|
1
|
colnames(df.out) = compare_name
|
72
|
|
}
|
73
|
1
|
return(df.out)
|
74
|
|
}
|