Tidied up documentation after merging #55

R/autoplot.multisimsum.R

@@ -10,6 +10,7 @@
 #' @param top Should the legend for a nested loop plot be on the top side of the plot? Defaults to `TRUE`.
 #' @param density.legend Should the legend for density and hexbin plots be included? Defaults to `TRUE`.
 #' @param zoom A numeric value between 0 and 1 signalling that a zip plot should _zoom_ on the top x% of the plot (to ease interpretation). Defaults to 1, where the whole zip plot is displayed.
+#' @param zip_ci_colours A string with (1) a hex code to use for plotting coverage probability and its Monte Carlo confidence intervals (the default, with value `zip_ci_colours = "yellow"`), (2) a string vector of two hex codes denoting optimal coverage (first element) and over/under coverage (second element) or (3) a vector of three hex codes denoting optimal coverage (first), undercoverage (second), and overcoverage (third).
 #' @param ... Not used.
 #'
 #' @return A `ggplot` object.
@@ -29,7 +30,7 @@
 #' autoplot(ms, par = "trt", type = "lolly", stats = "cover")
 #' autoplot(ms, par = "trt", type = "zip")
 #' autoplot(ms, par = "trt", type = "est_ba")
-autoplot.multisimsum <- function(object, par, type = "forest", stats = "nsim", target = NULL, fitted = TRUE, scales = "fixed", top = TRUE, density.legend = TRUE, zoom = 1, ...) {
+autoplot.multisimsum <- function(object, par, type = "forest", stats = "nsim", target = NULL, fitted = TRUE, scales = "fixed", top = TRUE, density.legend = TRUE, zoom = 1, zip_ci_colours = "yellow", ...) {
   ### Manipulate object to make it a simsum-like object
   object[["summ"]] <- object[["summ"]][object[["summ"]][[object[["par"]]]] == par, ]
   object[["true"]] <- object[["true"]][par]
@@ -44,7 +45,7 @@ autoplot.multisimsum <- function(object, par, type = "forest", stats = "nsim", t
   }
 
   # Call autoplot.simsum on the subset of results for a given parameter:
-  plot <- autoplot(object = object, type = type, stats = stats, target = target, fitted = fitted, scales = scales, top = top, density.legend = density.legend, zoom = zoom, ...)
+  plot <- autoplot(object = object, type = type, stats = stats, target = target, fitted = fitted, scales = scales, top = top, density.legend = density.legend, zoom = zoom, zip_ci_colours = zip_ci_colours, ...)
 
   # Add title with parameter of interest
   plot <- plot +

R/autoplot.simsum.R

@@ -10,7 +10,7 @@
 #' @param top Should the legend for a nested loop plot be on the top side of the plot? Defaults to `TRUE`.
 #' @param density.legend Should the legend for density and hexbin plots be included? Defaults to `TRUE`.
 #' @param zoom A numeric value between 0 and 1 signalling that a zip plot should _zoom_ on the top x% of the plot (to ease interpretation). Defaults to 1, where the whole zip plot is displayed.
-#' @param zip_ci_colors a string with a hex code if the CI intervals of the CI of the zipper plot are to be shown with one colour regardless of coverage, a list of 2 hex codes for optimal coverage (first) and over/under coverage (second) or a lsit of 3 hex codes for optimal coverage (first), uncercoverage(second) and overcoverage (third). Defaults to "yellow"
+#' @param zip_ci_colours A string with (1) a hex code to use for plotting coverage probability and its Monte Carlo confidence intervals (the default, with value `zip_ci_colours = "yellow"`), (2) a string vector of two hex codes denoting optimal coverage (first element) and over/under coverage (second element) or (3) a vector of three hex codes denoting optimal coverage (first), undercoverage (second), and overcoverage (third).
 #' @param ... Not used.
 #'
 #' @return A `ggplot` object.
@@ -36,7 +36,7 @@
 #'   methodvar = "model", by = c("baseline", "ss", "esigma")
 #' )
 #' autoplot(s1, stats = "bias", type = "nlp")
-autoplot.simsum <- function(object, type = "forest", stats = "nsim", target = NULL, fitted = TRUE, scales = "fixed", top = TRUE, density.legend = TRUE, zoom = 1, zip_ci_colors = "yellow", ...) {
+autoplot.simsum <- function(object, type = "forest", stats = "nsim", target = NULL, fitted = TRUE, scales = "fixed", top = TRUE, density.legend = TRUE, zoom = 1, zip_ci_colours = "yellow", ...) {
   # object <- s.nlp.subset
   # type <- "nlp"
   # stats <- "bias"
@@ -118,7 +118,7 @@ autoplot.simsum <- function(object, type = "forest", stats = "nsim", target = NU
   plot <- switch(type,
     "forest" = .forest_plot(data = df, methodvar = object$methodvar, by = object$by, stats = stats, ci = ci, target = target, scales = scales),
     "lolly" = .lolly_plot(data = df, methodvar = object$methodvar, by = object$by, stats = stats, ci = ci, target = target, scales = scales),
-    "zip" = .zip_plot(data = object$x, estvarname = object$estvarname, se = object$se, true = object$true, methodvar = object$methodvar, by = object$by, ci.limits = object$ci.limits, df = object$df, control = object$control, summ = object$summ, zoom = zoom, zip_ci_colors = zip_ci_colors), # zip for coverage
+    "zip" = .zip_plot(data = object$x, estvarname = object$estvarname, se = object$se, true = object$true, methodvar = object$methodvar, by = object$by, ci.limits = object$ci.limits, df = object$df, control = object$control, summ = object$summ, zoom = zoom, zip_ci_colours = zip_ci_colours), # zip for coverage
     "est" = .vs_plot(data = object$x, b = object$estvarname, methodvar = object$methodvar, by = object$by, fitted = fitted, scales = scales, ba = FALSE),
     "se" = .vs_plot(data = object$x, b = object$se, methodvar = object$methodvar, by = object$by, fitted = fitted, scales = scales, ba = FALSE),
     "est_ba" = .vs_plot(data = object$x, b = object$estvarname, methodvar = object$methodvar, by = object$by, fitted = fitted, scales = scales, ba = TRUE),

R/autoplot.summary.multisimsum.R

@@ -18,6 +18,6 @@
 #'
 #' library(ggplot2)
 #' autoplot(sms, par = "trt")
-autoplot.summary.multisimsum <- function(object, par, type = "forest", stats = "nsim", target = NULL, fitted = TRUE, scales = "fixed", top = TRUE, density.legend = TRUE, zoom = 1, ...) {
-  autoplot.multisimsum(object = object, par = par, type = type, stats = stats, target = target, fitted = fitted, scales = scales, top = top, density.legend = density.legend, zoom = zoom)
+autoplot.summary.multisimsum <- function(object, par, type = "forest", stats = "nsim", target = NULL, fitted = TRUE, scales = "fixed", top = TRUE, density.legend = TRUE, zoom = 1, zip_ci_colours = "yellow", ...) {
+  autoplot.multisimsum(object = object, par = par, type = type, stats = stats, target = target, fitted = fitted, scales = scales, top = top, density.legend = density.legend, zoom = zoom, zip_ci_colours = zip_ci_colours)
 }

R/autoplot.summary.simsum.R

@@ -17,6 +17,6 @@
 #' library(ggplot2)
 #' autoplot(ss)
 #' autoplot(ss, type = "lolly")
-autoplot.summary.simsum <- function(object, type = "forest", stats = "nsim", target = NULL, fitted = TRUE, scales = "fixed", top = TRUE, density.legend = TRUE, zoom = 1, ...) {
-  autoplot.simsum(object = object, type = type, stats = stats, target = target, fitted = fitted, scales = scales, top = top, density.legend = density.legend, zoom = zoom)
+autoplot.summary.simsum <- function(object, type = "forest", stats = "nsim", target = NULL, fitted = TRUE, scales = "fixed", top = TRUE, density.legend = TRUE, zoom = 1, zip_ci_colours = "yellow", ...) {
+  autoplot.simsum(object = object, type = type, stats = stats, target = target, fitted = fitted, scales = scales, top = top, density.legend = density.legend, zoom = zoom, zip_ci_colours = zip_ci_colours)
 }

R/plot-types.R

@@ -76,7 +76,7 @@
 
 ### Zip plot
 #' @keywords internal
-.zip_plot <- function(data, estvarname, se, true, methodvar, by, ci.limits, df, control, summ, zoom, zip_ci_colors) {
+.zip_plot <- function(data, estvarname, se, true, methodvar, by, ci.limits, df, control, summ, zoom, zip_ci_colours) {
   ### Extract overall coverage
   summ <- summ[summ$stat == "cover", ]
   summ$cover <- summ$est
@@ -139,34 +139,35 @@
   ylab <- ifelse(is.null(df), "Fractional centile of |z-score|", "Fractional centile of |t-score|")
 
   ### Define CI lines colors
-  if (length(zip_ci_colors) == 2) {
-  	data$line_color_lower <- ifelse(data$cover_lower <= 0.95 & 0.95 <= data$cover_upper, zip_ci_colors[1], zip_ci_colors[2])
-  	data$line_color_upper <- ifelse(data$cover_lower <= 0.95 & 0.95 <= data$cover_upper, zip_ci_colors[1], zip_ci_colors[2])
-  } else if (length(zip_ci_colors) == 3) {
-  	data$line_color_lower <- ifelse(data$cover_lower > 0.95 & data$cover_upper > 0.95, zip_ci_colors[3],
-  																	ifelse(data$cover_lower < 0.95 & data$cover_upper < 0.95, zip_ci_colors[2],
-  																				 ifelse(data$cover_lower <= 0.95 & 0.95 <= data$cover_upper, zip_ci_colors[1], NA)))
-
-  	data$line_color_upper <- ifelse(data$cover_lower > 0.95 & data$cover_upper > 0.95, zip_ci_colors[3],
-  																	ifelse(data$cover_lower < 0.95 & data$cover_upper < 0.95, zip_ci_colors[2],
-  																				 ifelse(data$cover_lower <= 0.95 & 0.95 <= data$cover_upper, zip_ci_colors[1], NA)))
+  if (length(zip_ci_colours) == 2) {
+    data$line_color_lower <- ifelse(data$cover_lower <= control$level & control$level <= data$cover_upper, zip_ci_colours[1], zip_ci_colours[2])
+    data$line_color_upper <- ifelse(data$cover_lower <= control$level & control$level <= data$cover_upper, zip_ci_colours[1], zip_ci_colours[2])
+  } else if (length(zip_ci_colours) == 3) {
+    data$line_color_lower <- ifelse(data$cover_lower > control$level & data$cover_upper > control$level, zip_ci_colours[3],
+      ifelse(data$cover_lower < control$level & data$cover_upper < control$level, zip_ci_colours[2],
+        ifelse(data$cover_lower <= control$level & control$level <= data$cover_upper, zip_ci_colours[1], NA)
+      )
+    )
+
+    data$line_color_upper <- ifelse(data$cover_lower > control$level & data$cover_upper > control$level, zip_ci_colours[3],
+      ifelse(data$cover_lower < control$level & data$cover_upper < control$level, zip_ci_colours[2],
+        ifelse(data$cover_lower <= control$level & control$level <= data$cover_upper, zip_ci_colours[1], NA)
+      )
+    )
   } else {
-  	data$line_color_lower <- zip_ci_colors[1]
-  	data$line_color_upper <- zip_ci_colors[1]
+    data$line_color_lower <- zip_ci_colours
+    data$line_color_upper <- zip_ci_colours
   }
 
-
-
-
   ### Build plot
   gg <- ggplot2::ggplot(data, ggplot2::aes(y = rank, x = lower, color = covering)) +
-  	ggplot2::geom_segment(ggplot2::aes(yend = rank, xend = upper)) +
-  	ggplot2::geom_vline(xintercept = true, color = "black", linetype = "dashed") +
-  	ggplot2::geom_hline(ggplot2::aes(yintercept = cover_lower), color = data$line_color_lower, linetype = "dashed", size = 1) +
-  	ggplot2::geom_hline(ggplot2::aes(yintercept = 0.95), color = "black", linetype = "dashed") +
-  	ggplot2::geom_hline(ggplot2::aes(yintercept = cover_upper), color = data$line_color_upper, linetype = "dashed", size = 1) +
-  	ggplot2::labs(y = ylab, x = paste0(100 * control$level, "% confidence intervals"), color = "") +
-  	theme(legend.position = "bottom")
+    ggplot2::geom_segment(ggplot2::aes(yend = rank, xend = upper)) +
+    ggplot2::geom_vline(xintercept = true, color = "black", linetype = "dashed") +
+    ggplot2::geom_hline(ggplot2::aes(yintercept = cover_lower), color = data$line_color_lower, linetype = "dashed", size = 1) +
+    ggplot2::geom_hline(ggplot2::aes(yintercept = 0.95), color = "black", linetype = "dashed") +
+    ggplot2::geom_hline(ggplot2::aes(yintercept = cover_upper), color = data$line_color_upper, linetype = "dashed", size = 1) +
+    ggplot2::labs(y = ylab, x = paste0(100 * control$level, "% confidence intervals"), color = "") +
+    theme(legend.position = "bottom")
 
   ### If 'by', use facet_grid; facet_wrap otherwise
   if (!is.null(by) & !is.null(methodvar)) {

testing.R

@@ -17,3 +17,18 @@ s.nlp.subset <- rsimsum::simsum(
 
 # But this is not okay:
 autoplot(s.nlp.subset, stats = "bias", type = "nlp")
+
+#
+data("MIsim", package = "rsimsum")
+s <- simsum(data = MIsim, estvarname = "b", true = 0.5, se = "se", methodvar = "method", ref = "CC", x = TRUE)
+
+data("frailty", package = "rsimsum")
+ms <- multisimsum(
+  data = frailty,
+  par = "par", true = c(trt = -0.50, fv = 0.75),
+  estvarname = "b", se = "se", methodvar = "model",
+  by = "fv_dist",
+  x = TRUE
+)
+ms
+autoplot(ms, par = "trt", type = "zip", zip_ci_colours = c("green", "red"))