#singleProp_bootPlot = function(image, ggtheme, theme, ...) { singleProp_parBootPlot = function(df, obs_stat, dotHist = "dotplot", alt = "notequal"){ phat <- obs_stat boot <- df # which tail of the distro should be used to calculate a p-val? if (alt == "less"){ ptail <- "lt" caption <- "One-sided: p-val is proportion of\n results \u2264 observed value" } else if (alt == "greater"){ ptail <- "rt" caption <- "One-sided: p-val is proportion of\n results \u2265 observed value" } else { ptail <- boot %>% dplyr::summarize(lt = mean(stat < phat), rt = mean(stat > phat)) %>% dplyr::mutate(pt = dplyr::if_else(rt < lt, "rt", "lt")) %>% dplyr::pull(pt) if (ptail == "lt") caption <- "Two-sided: p-val is 2\u00D7 proportion of\n results \u2264 observed value" else caption <- "Two-sided: p-val is 2\u00D7 proportion of\n results \u2265 observed value" } if(dotHist == "dotplot"){ ndist <- dplyr::n_distinct(boot$stat) # bin width, also used for scaling dots when not binning bw <- boot %>% dplyr::summarize(min = min(stat), max = max(stat)) %>% #mutate(bw = (max - min) / 30 * (1 + 3*.Machine$double.eps)) %>% dplyr::mutate(bw = (max - min) / 30 ) %>% dplyr::pull(bw) if (ndist <= 30){ # don't bin unless there are more than 30 unique values boot <- boot %>% dplyr::mutate(x.bin = stat) } else { if(ptail == "lt"){ boot <- boot %>% dplyr::mutate(x.bin = phat - ( (phat - stat) %/% bw ) * bw) } else { boot <- boot %>% dplyr::mutate(x.bin = phat + ( (stat - phat) %/% bw ) * bw) } } # color the dots in the tail that will be used to calculate the p-val # put vertical line at value of phat boot <- boot %>% dplyr::mutate(extreme = (ptail == "lt" & stat <= phat) | (ptail == "rt" & stat >= phat)) # dotplot based on tjebo answer from: # https://stackoverflow.com/questions/53697235/ggplot-dotplot-what-is-the-proper-use-of-geom-dotplot boot <- boot %>% dplyr::group_by(x.bin) %>% dplyr::mutate(y = seq_along(x.bin)) labht <- boot %>% dplyr::ungroup() %>% dplyr::summarize(labht = max(y)) %>% dplyr::pull() lab_ht <- max(labht - 1, 3) bigx <- boot %>% dplyr::ungroup() %>% dplyr::summarize(bigx = max(x.bin)) %>% dplyr::pull() littlex <- boot %>% dplyr::ungroup() %>% dplyr::summarize(littlex = min(x.bin)) %>% dplyr::pull() # do not show legend p <- ggplot2::ggplot(boot) + ggforce::geom_ellipse(aes(x0 = x.bin, y0 = y, a = bw/3, b = 0.5, angle = 0, fill = extreme, color = extreme), show.legend = FALSE) + ggplot2::geom_vline(xintercept = phat, linetype = "dashed", color = "red") + ggplot2::scale_fill_manual(values = c("black", "#ff8c8c")) + ggplot2::scale_color_manual(values = c("black", "#ff8c8c")) + ggplot2::annotate("text", x = phat, y = lab_ht, label = "Observed\nProportion", color = "red") + ggplot2::theme_minimal() + ggplot2::ylab("count") + ggplot2::xlab("proportion") + ggplot2::ylim(0, lab_ht + 3) + ggplot2::xlim(min(littlex - bw, phat - bw), max(bigx + bw, phat + bw)) + ggplot2::coord_equal(ratio = bw*2/3) + ggplot2::labs(caption = caption) + ggplot2::theme(text = element_text(size = 14), plot.caption = element_text(color = "red", hjust = 0)) } else { closed <- dplyr::if_else(ptail == "lt", "right", "left") boot <- boot %>% dplyr::mutate(extreme = (ptail == "lt" & stat <= phat) | (ptail == "rt" & stat >= phat)) p <- ggplot2::ggplot(data=boot, aes(x=stat, fill = extreme)) + ggplot2::geom_histogram(boundary = phat, closed = closed, show.legend = FALSE) + ggplot2::geom_vline(xintercept=obs_stat, linetype='dashed', color = "red") + ggplot2::scale_fill_manual(values = c("black", "#ff8c8c")) + ggplot2::theme_minimal() + ggplot2::xlab("proportion") + ggplot2::ylab("count") + ggplot2::labs(caption = caption) + ggplot2::theme(text = element_text(size = 14), plot.caption = element_text(color = "red", hjust = 0)) yMax <- ggplot2::layer_scales(p)$y$range$range[2] # upper y-limit p <- p + ggplot2::annotate("text", x = phat, y = yMax, vjust = "top", label = "Observed\nProportion", color = "red") } return(p) } singleProp_bootPlot = function(df, obs_stat, dotHist = "dotplot", confLevel = 95, ciType = "bootperc", plotCI = TRUE) { #if (is.null(image$state)) # return(FALSE) #df <- image$state[["df"]] #obs_stat = image$state[["obs_stat"]] #dotHist = image$state[["dotHist"]] #confLevel <- image$state[["confLevel"]] #ciType <- image$state[["ciType"]] phat <- obs_stat boot <- df # We've already computed these, but it's fast anyway #ciList <- private$.computeCI(boot) ciList <- singleProp_computeCI(boot, obs_stat, confLevel, ciType) cil <- ciList$cil ciu <- ciList$ciu if(ciType == "bootperc"){ caption <- paste0("CI limits (dashed) are ", round((100-confLevel)/2,1), "% and ", round(100 - (100-confLevel)/2,1), "%", "\n percentiles of bootstrap proportions") } else { se <- ciList$se zcrit <- ciList$zcrit caption <- paste0("CI (dashed) is calculated using SE of bootstrap proportions", "\n (SE = ", round(se, 3), ", z* = ", round(zcrit, 3), ")") } if(dotHist == "dotplot"){ ndist <- dplyr::n_distinct(boot$stat) # bin width, also used for scaling dots when not binning bw <- boot %>% dplyr::summarize(min = min(stat), max = max(stat)) %>% dplyr::mutate(bw = (max - min) / 30 ) %>% dplyr::pull(bw) if (ndist <= 30){ # don't bin unless there are more than 30 unique values boot <- boot %>% dplyr::mutate(x.bin = stat) # no adjustment to position of ci on plot cila <- cil ciua <- ciu } else { boot <- boot %>% dplyr::mutate(x.bin = phat + ( (stat - bw/2 - phat) %/% bw ) * bw) # adjust limits of CI (round) just like we did with other x positions cila <- phat + ( (cil - bw/2 - phat) %/% bw ) * bw ciua <- phat + ( (ciu - bw/2 - phat) %/% bw ) * bw } boot <- boot %>% dplyr::group_by(x.bin) %>% dplyr::mutate(y = seq_along(x.bin)) if(plotCI){ p <- ggplot2::ggplot(boot) + ggforce::geom_ellipse(aes(x0 = x.bin, y0 = y, a = bw/3, b = 0.5, angle = 0), show.legend = FALSE) + ggplot2::geom_vline(xintercept = cila, linetype = "dashed", color = "red") + ggplot2::geom_vline(xintercept = ciua, linetype = "dashed", color = "red") + ggplot2::theme_minimal() + ggplot2::ylab("count") + ggplot2::xlab("proportion") + ggplot2::coord_equal(ratio = bw*2/3) + ggplot2::labs(caption = caption) + ggplot2::theme(text = element_text(size = 14), plot.caption = element_text(color = "red", hjust = 0)) } else { p <- ggplot2::ggplot(boot) + ggforce::geom_ellipse(aes(x0 = x.bin, y0 = y, a = bw/3, b = 0.5, angle = 0), show.legend = FALSE) + ggplot2::theme_minimal() + ggplot2::ylab("count") + ggplot2::xlab("proportion") + ggplot2::coord_equal(ratio = bw*2/3) + ggplot2::theme(text = element_text(size = 14)) } } else { if(plotCI){ p <- ggplot2::ggplot(data=boot, aes(x=stat)) + ggplot2::geom_histogram(center = phat, show.legend = FALSE) + ggplot2::geom_vline(xintercept = cil, linetype = "dashed", color = "red") + ggplot2::geom_vline(xintercept = ciu, linetype = "dashed", color = "red") + ggplot2::theme_minimal() + ggplot2::xlab("proportion") + ggplot2::ylab("count") + ggplot2::labs(caption = caption) + ggplot2::theme(text = element_text(size = 14), plot.caption = element_text(color = "red", hjust = 0)) } else { p <- ggplot2::ggplot(data=boot, aes(x=stat)) + ggplot2::geom_histogram(center = phat, show.legend = FALSE) + ggplot2::theme_minimal() + ggplot2::xlab("proportion") + ggplot2::ylab("count") + ggplot2::labs(caption = caption) + ggplot2::theme(text = element_text(size = 14)) } } return(p) } singleProp_computeCI = function(boot, obs_stat, confLevel = 95, ciType = "bootperc") { confLevel <- confLevel/100 if(ciType == "bootperc"){ ci <- boot %>% dplyr::summarize(cil = quantile(stat, (1 - confLevel)/2), ciu = quantile(stat, 1 - (1 - confLevel)/2)) se <- NULL zcrit <- NULL } else { zcrit <- qnorm(1 - (1 - confLevel)/2) se <- boot %>% dplyr::summarize(se = sd(stat)) %>% dplyr::pull() ci <- tibble::tibble(cil = obs_stat - zcrit * se, ciu = obs_stat + zcrit * se) } cil <- ci %>% dplyr::pull(cil) ciu <- ci %>% dplyr::pull(ciu) cil <- max(cil, 0) # for proportion don't want CI to extend beyon [0,1] ciu <- min(ciu, 1) simres <- list(obsProp = obs_stat, cil = cil, ciu = ciu, se = se, zcrit = zcrit) return(simres) } twoProp_bootPlot = function(df, obs_stat, dotHist = "dotplot", confLevel = 95, ciType = "bootperc"){ dp <- obs_stat boot <- df ciList <- twoProp_computeCI(boot, obs_stat, confLevel, ciType) cil <- ciList$cil ciu <- ciList$ciu if(ciType == "bootperc"){ caption <- paste0("CI limits (dashed) are ", round((100-confLevel)/2,1), "% and ", round(100 - (100-confLevel)/2,1), "%", "\n percentiles of bootstrap differences") } else { se <- ciList$se zcrit <- ciList$zcrit caption <- paste0("CI (dashed) is calculated using SE of bootstrap differences", "\n (SE = ", round(se, 3), ", z* = ", round(zcrit, 3), ")") } if(dotHist == "dotplot"){ ndist <- dplyr::n_distinct(boot$stat) # bin width, also used for scaling dots when not binning bw <- boot %>% dplyr::summarize(min = min(stat), max = max(stat)) %>% dplyr::mutate(bw = (max - min) / 30 ) %>% dplyr::pull(bw) if (ndist <= 30){ # don't bin unless there are more than 30 unique values boot <- boot %>% dplyr::mutate(x.bin = stat) # no adjustment to position of ci on plot cila <- cil ciua <- ciu } else { boot <- boot %>% dplyr::mutate(x.bin = dp + ( (stat - bw/2 - dp) %/% bw ) * bw) # adjust limits of CI (round) just like we did with other x positions cila <- dp + ( (cil - bw/2 - dp) %/% bw ) * bw ciua <- dp + ( (ciu - bw/2 - dp) %/% bw ) * bw } boot <- boot %>% dplyr::group_by(x.bin) %>% dplyr::mutate(y = seq_along(x.bin)) p <- ggplot2::ggplot(boot) + ggforce::geom_ellipse(aes(x0 = x.bin, y0 = y, a = bw/3, b = 0.5, angle = 0), show.legend = FALSE) + ggplot2::geom_vline(xintercept = cila, linetype = "dashed", color = "red") + ggplot2::geom_vline(xintercept = ciua, linetype = "dashed", color = "red") + ggplot2::theme_minimal() + ggplot2::ylab("count") + ggplot2::xlab("difference (group 1 - group 2)") + ggplot2::coord_equal(ratio = bw*2/3) + ggplot2::labs(caption = caption) + ggplot2::theme(text = element_text(size = 14), plot.caption = element_text(color = "red", hjust = 0)) } else { p <- ggplot2::ggplot(data=boot, aes(x=stat)) + ggplot2::geom_histogram(center = dp, show.legend = FALSE) + ggplot2::geom_vline(xintercept = cil, linetype = "dashed", color = "red") + ggplot2::geom_vline(xintercept = ciu, linetype = "dashed", color = "red") + ggplot2::theme_minimal() + ggplot2::xlab("difference (group 1 - group 2)") + ggplot2::ylab("count") + ggplot2::labs(caption = caption) + ggplot2::theme(text = element_text(size = 14), plot.caption = element_text(color = "red", hjust = 0)) } return(p) } twoProp_computeCI = function(boot, obs_stat, confLevel = 95, ciType = "bootperc") { confLevel <- confLevel/100 if(ciType == "bootperc"){ ci <- boot %>% dplyr::summarize(cil = quantile(stat, (1 - confLevel)/2), ciu = quantile(stat, 1 - (1 - confLevel)/2)) se <- NULL zcrit <- NULL } else { zcrit <- qnorm(1 - (1 - confLevel)/2) se <- boot %>% dplyr::summarize(se = sd(stat)) %>% dplyr::pull() ci <- tibble::tibble(cil = obs_stat - zcrit * se, ciu = obs_stat + zcrit * se) } cil <- ci %>% dplyr::pull(cil) ciu <- ci %>% dplyr::pull(ciu) #cil <- max(cil, 0) # for proportion don't want CI to extend beyon [0,1] #ciu <- min(ciu, 1) simres <- list(obsProp = obs_stat, cil = cil, ciu = ciu, se = se, zcrit = zcrit) return(simres) } singleMean_bootPlot = function(df, obs_stat, dotHist = "dotplot", confLevel = 95, ciType = "bootperc", plotCI = TRUE) { # if (is.null(image$state)) # return(FALSE) # # df <- image$state[["df"]] # # obs_stat <- image$state[["obs_stat"]] # # dotHist = image$state[["dotHist"]] # # confLevel <- image$state[["confLevel"]] # # ciType <- image$state[["ciType"]] xbar <- obs_stat boot <- df # We've already computed these, but it's fast anyway #ciList <- private$.computeCI(boot, xbar) ciList <- singleMean_computeCI(boot, xbar, confLevel, ciType) cil <- ciList$cil ciu <- ciList$ciu if(ciType == "bootperc"){ caption <- paste0("CI limits (dashed) are ", round((100-confLevel)/2,1), "% and ", round(100 - (100-confLevel)/2,1), "%", "\n percentiles of bootstrap means") } else { se <- ciList$se zcrit <- ciList$zcrit caption <- paste0("CI (dashed) is calculated using SE of bootstrap means", "\n (SE = ", round(se, 3), ", z* = ", round(zcrit, 3), ")") } if(dotHist == "dotplot"){ ndist <- dplyr::n_distinct(boot$stat) # bin width, also used for scaling dots when not binning bw <- boot %>% dplyr::summarize(min = min(stat), max = max(stat)) %>% dplyr::mutate(bw = (max - min) / 30 ) %>% dplyr::pull(bw) if (ndist <= 30){ # don't bin unless there are more than 30 unique values boot <- boot %>% dplyr::mutate(x.bin = stat) # no adjustment to position of ci on plot cila <- cil ciua <- ciu } else { boot <- boot %>% dplyr::mutate(x.bin = xbar + ( (stat - bw/2 - xbar) %/% bw ) * bw) # adjust limits of CI (round) just like we did with other x positions cila <- xbar + ( (cil - bw/2 - xbar) %/% bw ) * bw ciua <- xbar + ( (ciu - bw/2 - xbar) %/% bw ) * bw } boot <- boot %>% dplyr::group_by(x.bin) %>% dplyr::mutate(y = seq_along(x.bin)) p <- ggplot2::ggplot(boot) + ggforce::geom_ellipse(aes(x0 = x.bin, y0 = y, a = bw/3, b = 0.5, angle = 0), show.legend = FALSE) + ggplot2::geom_vline(xintercept = cila, linetype = "dashed", color = "red") + ggplot2::geom_vline(xintercept = ciua, linetype = "dashed", color = "red") + ggplot2::theme_minimal() + ggplot2::ylab("count") + ggplot2::xlab("mean") + ggplot2::coord_equal(ratio = bw*2/3) + ggplot2::labs(caption = caption) + ggplot2::theme(text = element_text(size = 14), plot.caption = element_text(color = "red", hjust = 0)) } else { p <- ggplot2::ggplot(data=boot, aes(x=stat)) + ggplot2::geom_histogram(center = xbar, show.legend = FALSE) + ggplot2::geom_vline(xintercept = cil, linetype = "dashed", color = "red") + ggplot2::geom_vline(xintercept = ciu, linetype = "dashed", color = "red") + ggplot2::theme_minimal() + ggplot2::xlab("mean") + ggplot2::ylab("count") + ggplot2::labs(caption = caption) + ggplot2::theme(text = element_text(size = 14), plot.caption = element_text(color = "red", hjust = 0)) } return(p) } singleMean_computeCI = function(boot, xbar, confLevel = 95, ciType = "bootperc") { confLevel <- confLevel/100 ciType <- ciType obs_stat <- xbar if(ciType == "bootperc"){ ci <- boot %>% dplyr::summarize(cil = quantile(stat, (1 - confLevel)/2), ciu = quantile(stat, 1 - (1 - confLevel)/2)) se <- NULL zcrit <- NULL } else { zcrit <- qnorm(1 - (1 - confLevel)/2) se <- boot %>% dplyr::summarize(se = sd(stat)) %>% dplyr::pull() ci <- tibble::tibble(cil = obs_stat - zcrit * se, ciu = obs_stat + zcrit * se) } cil <- ci %>% dplyr::pull(cil) ciu <- ci %>% dplyr::pull(ciu) simres <- list(obsMean = obs_stat, cil = cil, ciu = ciu, se = se, zcrit = zcrit) return(simres) } difMean_bootPlot = function(df, obs_stat, dotHist = "dotplot", confLevel = 95, ciType = "bootperc", plotCI = TRUE) { # if (is.null(image$state)) # return(FALSE) # # df <- image$state[["df"]] # # obs_stat <- image$state[["obs_stat"]] # # dotHist = image$state[["dotHist"]] # # confLevel <- image$state[["confLevel"]] # # ciType <- image$state[["ciType"]] dxbar <- obs_stat boot <- df # We've already computed these, but it's fast anyway #ciList <- private$.computeCI(boot, xbar) ciList <- difMean_computeCI(boot, dxbar, confLevel, ciType) cil <- ciList$cil ciu <- ciList$ciu if(ciType == "bootperc"){ caption <- paste0("CI limits (dashed) are ", round((100-confLevel)/2,1), "% and ", round(100 - (100-confLevel)/2,1), "%", "\n percentiles of bootstrap differences") } else { se <- ciList$se zcrit <- ciList$zcrit caption <- paste0("CI (dashed) is calculated using SE of bootstrap differences", "\n (SE = ", round(se, 3), ", z* = ", round(zcrit, 3), ")") } if(dotHist == "dotplot"){ ndist <- dplyr::n_distinct(boot$stat) # bin width, also used for scaling dots when not binning bw <- boot %>% dplyr::summarize(min = min(stat), max = max(stat)) %>% dplyr::mutate(bw = (max - min) / 30 ) %>% dplyr::pull(bw) if (ndist <= 30){ # don't bin unless there are more than 30 unique values boot <- boot %>% dplyr::mutate(x.bin = stat) # no adjustment to position of ci on plot cila <- cil ciua <- ciu } else { boot <- boot %>% dplyr::mutate(x.bin = dxbar + ( (stat - bw/2 - dxbar) %/% bw ) * bw) # adjust limits of CI (round) just like we did with other x positions cila <- dxbar + ( (cil - bw/2 - dxbar) %/% bw ) * bw ciua <- dxbar + ( (ciu - bw/2 - dxbar) %/% bw ) * bw } boot <- boot %>% dplyr::group_by(x.bin) %>% dplyr::mutate(y = seq_along(x.bin)) p <- ggplot2::ggplot(boot) + ggforce::geom_ellipse(aes(x0 = x.bin, y0 = y, a = bw/3, b = 0.5, angle = 0), show.legend = FALSE) + ggplot2::geom_vline(xintercept = cila, linetype = "dashed", color = "red") + ggplot2::geom_vline(xintercept = ciua, linetype = "dashed", color = "red") + ggplot2::theme_minimal() + ggplot2::ylab("count") + ggplot2::xlab("difference in bootstrap means") + ggplot2::coord_equal(ratio = bw*2/3) + ggplot2::labs(caption = caption) + ggplot2::theme(text = element_text(size = 14), plot.caption = element_text(color = "red", hjust = 0)) } else { p <- ggplot2::ggplot(data=boot, aes(x=stat)) + ggplot2::geom_histogram(center = dxbar, show.legend = FALSE) + ggplot2::geom_vline(xintercept = cil, linetype = "dashed", color = "red") + ggplot2::geom_vline(xintercept = ciu, linetype = "dashed", color = "red") + ggplot2::theme_minimal() + ggplot2::xlab("difference in bootstrap means") + ggplot2::ylab("count") + ggplot2::labs(caption = caption) + ggplot2::theme(text = element_text(size = 14), plot.caption = element_text(color = "red", hjust = 0)) } return(p) } difMean_computeCI = function(boot, dxbar, confLevel = 95, ciType = "bootperc") { confLevel <- confLevel/100 ciType <- ciType obs_stat <- dxbar if(ciType == "bootperc"){ ci <- boot %>% dplyr::summarize(cil = quantile(stat, (1 - confLevel)/2), ciu = quantile(stat, 1 - (1 - confLevel)/2)) se <- NULL zcrit <- NULL } else { zcrit <- qnorm(1 - (1 - confLevel)/2) se <- boot %>% dplyr::summarize(se = sd(stat)) %>% dplyr::pull() ci <- tibble::tibble(cil = obs_stat - zcrit * se, ciu = obs_stat + zcrit * se) } cil <- ci %>% dplyr::pull(cil) ciu <- ci %>% dplyr::pull(ciu) simres <- list(obsMean = obs_stat, cil = cil, ciu = ciu, se = se, zcrit = zcrit) return(simres) }