Nothing
#' Plot method for the imputed data contained in the objects of class \code{missingHE}
#'
#' Produces a plot of the observed and imputed values (with credible intervals) for the effect and cost outcomes from a
#' Bayesian cost-effectiveness analysis model with two treatment arms, implemented using the function \code{\link{selection}}, \code{\link{selection_long}}, \code{\link{pattern}} or \code{\link{hurdle}}.
#' The graphical layout is obtained from the functions contained in the package \strong{ggplot2} and \strong{ggthemes}.
#' @keywords plot missing data
#' @param x A \code{missingHE} object containing the results of the Bayesian model for cost-effectiveness analysis.
#' @param prob A numeric vector of probabilities representing the upper and lower CI sample quantiles to be calculated and returned for the imputed values.
#' @param class Type of the plot comparing the observed and imputed outcome data. Available choices are
#' 'histogram' and 'scatter' for a histogram or a scatter plot of the observed and imputed outcome data, respectively.
#' @param outcome The outcome variables that should be displayed. Options are: 'all' (default) which shows the plots
#' for both treatment arms, time points (only for longitudinal models) and types of outcome variables; 'effects' and 'costs' which show the plots for the corresponding
#' outcome variables in both arms; 'arm1' and 'arm2' which show the plots by the selected treatment arm. To select
#' the plots for a specific outcome in a specific treatment arm the options that can be used are 'effects_arm1',
#' 'effects_arm2', 'costs_arm1' or 'costs_arm2'.
#' @param time_plot Time point for which plots should be displayed (only for longitudinal models).
#' @param theme Type of ggplot theme among some pre-defined themes, mostly taken from the package \strong{ggthemes}. For a full list of available themes see details.
#' @param ... Additional parameters that can be provided to manage the output of \code{plot.missingHE}.
#' @return A \code{ggplot} object containing the plots specified in the argument \code{class}.
#' @seealso \code{\link{selection}} \code{\link{selection_long}} \code{\link{pattern}} \code{\link{hurdle}} \code{\link{diagnostic}}
#' @details The function produces a plot of the observed and imputed effect and cost data in a two-arm based
#' cost-effectiveness model implemented using the function \code{\link{selection}}, \code{\link{selection_long}}, \code{\link{pattern}} or \code{\link{hurdle}}. The purpose of this graph
#' is to visually compare the outcome values for the fully-observed individuals with those imputed by the model for the missing individuals.
#' For the scatter plot, imputed values are also associated with the credible intervals specified in the argument \code{prob}.
#' The argument \code{theme} allows to customise the graphical aspect of the plots generated by \code{plot.missingHE} and
#' allows to choose among a set of possible pre-defined themes taken form the package \strong{ggtheme}. For a complete list of the available character names
#' for each theme and scheme set, see \strong{ggthemes} and \strong{bayesplot}.
#' @author Andrea Gabrio
#' @references
#' Daniels, MJ. Hogan, JW. (2008) \emph{Missing Data in Longitudinal Studies: strategies for Bayesian modelling and sensitivity analysis}, CRC/Chapman Hall.
#'
#' Molenberghs, G. Fitzmaurice, G. Kenward, MG. Tsiatis, A. Verbeke, G. (2015) \emph{Handbook of Missing Data Methodology}, CRC/Chapman Hall.
#' @import ggplot2 gridExtra grid
#' @export
#' @examples
#' # For examples see the function \code{\link{selection}}, \code{\link{selection_long}},
#' # \code{\link{pattern}} or \code{\link{hurdle}}
#' #
#' #
plot.missingHE <- function(x, prob = c(0.025, 0.975), class = "scatter", outcome = "all", time_plot = NULL, theme = NULL, ...) {
if(!isTRUE(requireNamespace("gridExtra")) | !isTRUE(requireNamespace("grid")) | !isTRUE(requireNamespace("ggplot2")) | !isTRUE(requireNamespace("ggthemes"))) {
stop("You need to install the R packages 'gridExtra', 'grid' and 'ggplot2'. Please run in your R terminal:\n install.packages('gridExtra', 'grid', 'ggplot2', 'ggthemes')")
}
if(is.null(theme) == TRUE) {theme = "base" }
if(!theme %in% c("base", "calc", "economist", "excel", "few", "538", "gdocs", "hc", "par", "pander", "solarized", "stata", "tufte", "wsj")) {
stop("You must provide a valid theme type among those available")
}
if(!class %in% c("scatter", "histogram")) {
stop("You must provide a plot class among those available")
}
if(!outcome %in% c("all", "effects", "costs", "arm1", "arm2", "effects_arm1", "costs_arm1", "effects_arm2", "costs_arm2")) {
stop("You must provide a plot outcome among those available")
}
exArgs <- list(...)
if(!inherits(x, what = "missingHE")) {
stop("Only objects of class 'missingHE' can be used")
}
if(length(prob) != 2 | is.numeric(prob) == FALSE | any(prob < 0) != FALSE | any(prob > 1) != FALSE) {
stop("You must provide valid lower/upper quantiles for the imputed data distribution")
}
if(x$data_format == "wide") {
if(x$data_set$`N missing in comparator arm`[1]==0 & x$data_set$`N missing in comparator arm`[2]==0 &
x$data_set$`N missing in reference arm`[1]==0 & x$data_set$`N missing in reference arm`[2]==0) {
stop("No missing value found in the data")
}
eff1_pos <- matrix(x$data_set$effects[[1]], x$data_set$`N in reference arm`, 3)
cost1_pos <- matrix(x$data_set$costs[[1]], x$data_set$`N in reference arm`, 3)
eff2_pos <- matrix(x$data_set$effects[[2]], x$data_set$`N in comparator arm`, 3)
cost2_pos <- matrix(x$data_set$costs[[2]], x$data_set$`N in comparator arm`, 3)
eff1_pos[,1] <- apply(x$model_output$`model summary`$BUGSoutput$sims.list$eff1, 2, mean)
eff1_pos[,2] <- apply(x$model_output$`model summary`$BUGSoutput$sims.list$eff1, 2, quantile, probs = prob[1])
eff1_pos[,3] <- apply(x$model_output$`model summary`$BUGSoutput$sims.list$eff1, 2, quantile, probs = prob[2])
eff2_pos[,1] <- apply(x$model_output$`model summary`$BUGSoutput$sims.list$eff2, 2, mean)
eff2_pos[,2] <- apply(x$model_output$`model summary`$BUGSoutput$sims.list$eff2, 2, quantile, probs = prob[1])
eff2_pos[,3] <- apply(x$model_output$`model summary`$BUGSoutput$sims.list$eff2, 2, quantile, probs = prob[2])
cost1_pos[,1] <- apply(x$model_output$`model summary`$BUGSoutput$sims.list$cost1, 2, mean)
cost1_pos[,2] <- apply(x$model_output$`model summary`$BUGSoutput$sims.list$cost1, 2, quantile, probs = prob[1])
cost1_pos[,3] <- apply(x$model_output$`model summary`$BUGSoutput$sims.list$cost1, 2, quantile, probs = prob[2])
cost2_pos[,1] <- apply(x$model_output$`model summary`$BUGSoutput$sims.list$cost2, 2, mean)
cost2_pos[,2] <- apply(x$model_output$`model summary`$BUGSoutput$sims.list$cost2, 2, quantile, probs = prob[1])
cost2_pos[,3] <- apply(x$model_output$`model summary`$BUGSoutput$sims.list$cost2, 2, quantile, probs = prob[2])
colnames(eff1_pos) <- c("mean", "LB", "UB")
colnames(eff2_pos) <- c("mean", "LB", "UB")
colnames(cost1_pos) <- c("mean", "LB", "UB")
colnames(cost2_pos) <- c("mean", "LB", "UB")
complete_labels <- complete <- list("effects1" = eff1_pos, "effects2" = eff2_pos, "costs1" = cost1_pos, "costs2" = cost2_pos)
observed<-list("effects1" = x$data_set$effects[[1]], "effects2" = x$data_set$effects[[2]],
"costs1" = x$data_set$costs[[1]], "costs2" = x$data_set$costs[[2]])
eff1_imp <- matrix(NA, length(complete$effects1[, 1]), 3)
cost1_imp <- matrix(NA, length(complete$costs1[, 1]), 3)
eff2_imp <- matrix(NA, length(complete$effects2[, 1]), 3)
cost2_imp <- matrix(NA, length(complete$costs2[, 1]), 3)
eff1_imputed <- lapply(1:3, function(j) {
unlist(lapply(1:length(complete$effects1[, j]), function(i) {
if(is.na(observed$effects1[i]) == TRUE) {eff1_imp[i] <- complete$effects1[i, j]} else {eff1_imp[i] <- NA } } )) })
eff2_imputed <- lapply(1:3, function(j){
unlist(lapply(1:length(complete$effects2[, j]), function(i) {
if(is.na(observed$effects2[i]) == TRUE) {eff2_imp[i] <- complete$effects2[i, j]} else {eff2_imp[i] <- NA } })) })
cost1_imputed <- lapply(1:3, function(j) {
unlist(lapply(1:length(complete$costs1[, j]), function(i) {
if(is.na(observed$costs1[i]) == TRUE){cost1_imp[i] <- complete$costs1[i, j]} else {cost1_imp[i] <- NA } })) })
cost2_imputed <- lapply(1:3, function(j) {
unlist(lapply(1:length(complete$costs2[, j]), function(i) {
if(is.na(observed$costs2[i]) == TRUE) {cost2_imp[i] <- complete$costs2[i, j]} else {cost2_imp[i] <- NA } })) })
eff1_imp <- sapply(1:3, function(j) {eff1_imp[, j] <- unlist(eff1_imputed[j]) })
eff2_imp <- sapply(1:3, function(j) {eff2_imp[, j] <- unlist(eff2_imputed[j]) })
cost1_imp <- sapply(1:3, function(j) {cost1_imp[, j] <- unlist(cost1_imputed[j]) })
cost2_imp <- sapply(1:3, function(j) {cost2_imp[, j] <- unlist(cost2_imputed[j]) })
imputed <- list("effects1"= eff1_imp, "effects2" = eff2_imp, "costs1" = cost1_imp, "costs2" = cost2_imp)
colnames(eff1_imp) <- c("mean", "LB", "UB")
colnames(eff2_imp) <- c("mean", "LB", "UB")
colnames(cost1_imp) <- c("mean", "LB", "UB")
colnames(cost2_imp) <- c("mean", "LB", "UB")
imputed_labels <- list("effects1"= eff1_imp, "effects2" = eff2_imp, "costs1" = cost1_imp, "costs2" = cost2_imp)
data <- list("observed" = observed, "imputed" = imputed, "complete" = complete)
indic <- function(x) {
w = NULL
if (is.na(x) == TRUE)
w = "missing"
else w = "observed"
return(w)
}
m_eff1 <- m_eff2 <- m_cost1 <- m_cost2 <- c()
bound_m_eff1 <- matrix(0, length(observed$effects1), 3)
m_eff1 <- sapply(observed$effects1, indic)
bound_m_eff1 <- sapply(2:3, function(j) {
sapply(1:length(m_eff1), function(i) {
if(m_eff1[i] == "observed") {
bound_m_eff1[i, j] = 0
} else if(m_eff1[i] == "missing") {
bound_m_eff1[i, j] = imputed$effects1[i, j] } }) })
bound_m_eff2 <- matrix(0, length(observed$effects2), 3)
m_eff2 <- sapply(observed$effects2, indic)
bound_m_eff2 <- sapply(2:3, function(j) {
sapply(1:length(m_eff2), function(i) {
if(m_eff2[i] == "observed") {
bound_m_eff2[i, j] = 0
} else if(m_eff2[i] == "missing") {
bound_m_eff2[i, j] = imputed$effects2[i,j] } }) })
bound_m_cost1 <- matrix(0, length(observed$costs1), 3)
m_cost1 <- sapply(observed$costs1, indic)
bound_m_cost1 <- sapply(2:3, function(j) {
sapply(1:length(m_cost1), function(i) {
if(m_cost1[i] == "observed") {
bound_m_cost1[i, j] = 0
} else if(m_cost1[i] == "missing") {
bound_m_cost1[i, j] = imputed$costs1[i, j] } }) })
bound_m_cost2 <- matrix(0, length(observed$costs2), 3)
m_cost2 <- sapply(observed$costs2, indic)
bound_m_cost2 <- sapply(2:3, function(j) {
sapply(1:length(m_cost2), function(i) {
if(m_cost2[i] == "observed") {
bound_m_cost2[i, j] = 0
} else if(m_cost2[i] == "missing") {
bound_m_cost2[i, j] = imputed$costs2[i, j] } }) })
effects <- costs <- upper <- lower <- Individuals <- type <- NULL
if(class == "scatter") {
pd <- ggplot2::position_dodge(0.1)
if(any(is.na(x$data_set$effects[[1]])) == TRUE) {
plot.eff1.data <- data.frame(Individuals = seq(1:length(complete$effects1[, 1])), effects = observed$effects1, mean = imputed$effects1[, 1],
lower = imputed$effects1[, 2], upper = imputed$effects1[, 3], type = m_eff1)
plot_eff1 <- ggplot2::ggplot(plot.eff1.data,ggplot2::aes(colour = type, x = Individuals, y = effects)) + ggplot2::geom_point(position = pd,na.rm = TRUE) +
ggplot2::geom_pointrange(data = plot.eff1.data, mapping = ggplot2::aes(x = Individuals, y = mean, ymin = upper, ymax = lower), na.rm = TRUE) +
ggplot2::scale_colour_manual(values = c("red", "black"), guide = ggplot2::guide_legend(override.aes = list(shape = c(16, 16), linetype = c(1, 0)))) +
ggplot2::ggtitle("effects (control)")
} else if(any(is.na(x$data_set$effects[[1]])) == FALSE) {
plot.eff1.data<-data.frame(Individuals = seq(1:length(complete$effects1[, 1])), effects = observed$effects1, type = m_eff1)
plot_eff1 <- ggplot2::ggplot(plot.eff1.data,ggplot2::aes(colour = type, x = Individuals, y = effects)) + ggplot2::geom_point(position = pd, na.rm = TRUE) +
ggplot2::scale_colour_manual(values = c("black"), guide = ggplot2::guide_legend(override.aes = list(shape = c(16), linetype = c(0)))) +
ggplot2::ggtitle("effects (control)")
}
if(any(is.na(x$data_set$effects[[2]])) == TRUE) {
plot.eff2.data <- data.frame(Individuals = seq(1:length(complete$effects2[, 1])), effects = observed$effects2, mean = imputed$effects2[, 1],
lower = imputed$effects2[,2], upper = imputed$effects2[, 3], type = m_eff2)
plot_eff2 <- ggplot2::ggplot(plot.eff2.data,ggplot2::aes(colour = type, x = Individuals, y = effects)) + ggplot2::geom_point(position = pd, na.rm = TRUE) +
ggplot2::geom_pointrange(data = plot.eff2.data, mapping = ggplot2::aes(x = Individuals, y = mean, ymin = upper, ymax = lower), na.rm = TRUE) +
ggplot2::scale_colour_manual(values = c("red", "black"), guide = ggplot2::guide_legend(override.aes = list(shape = c(16, 16), linetype = c(1, 0)))) +
ggplot2::ggtitle("effects (intervention)")
} else if(any(is.na(x$data_set$effects[[2]])) == FALSE) {
plot.eff2.data <- data.frame(Individuals = seq(1:length(complete$effects2[, 1])), effects = observed$effects2, type = m_eff2)
plot_eff2 <- ggplot2::ggplot(plot.eff2.data,ggplot2::aes(colour = type, x = Individuals, y = effects)) + ggplot2::geom_point(position = pd, na.rm = TRUE) +
ggplot2::scale_colour_manual(values = c("black"), guide = ggplot2::guide_legend(override.aes = list(shape = c(16), linetype = c(0)))) +
ggplot2::ggtitle("effects (intervention)")
}
if(any(is.na(x$data_set$costs[[1]])) == TRUE) {
plot.cost1.data <- data.frame(Individuals = seq(1:length(complete$costs1[, 1])), costs = observed$costs1, mean = imputed$costs1[, 1],
lower = imputed$costs1[, 2], upper = imputed$costs1[, 3], type = m_cost1)
plot_cost1 <- ggplot2::ggplot(plot.cost1.data, ggplot2::aes(colour = type, x = Individuals, y = costs)) + ggplot2::geom_point(position = pd, na.rm = TRUE) +
ggplot2::geom_pointrange(data = plot.cost1.data, mapping = ggplot2::aes(x = Individuals, y = mean, ymin = upper, ymax = lower), na.rm = TRUE) +
ggplot2::scale_colour_manual(values = c("red", "black"), guide = ggplot2::guide_legend(override.aes = list(shape = c(16, 16), linetype=c(1, 0)))) +
ggplot2::ggtitle("costs (control)")
} else if(any(is.na(x$data_set$costs[[1]])) == FALSE) {
plot.cost1.data <- data.frame(Individuals = seq(1:length(complete$costs1[, 1])), costs = observed$costs1, type = m_cost1)
plot_cost1 <- ggplot2::ggplot(plot.cost1.data, ggplot2::aes(colour = type, x = Individuals, y = costs)) + ggplot2::geom_point(position = pd, na.rm = TRUE) +
ggplot2::scale_colour_manual(values = c("black"), guide = ggplot2::guide_legend(override.aes = list(shape = c(16), linetype = c(0)))) +
ggplot2::ggtitle("costs (control)")
}
if(any(is.na(x$data_set$costs[[2]])) == TRUE) {
plot.cost2.data <- data.frame(Individuals = seq(1:length(complete$costs2[, 1])),costs = observed$costs2, mean = imputed$costs2[, 1],
lower = imputed$costs2[, 2], upper = imputed$costs2[, 3], type = m_cost2)
plot_cost2 <- ggplot2::ggplot(plot.cost2.data, ggplot2::aes(colour = type, x = Individuals, y = costs)) + ggplot2::geom_point(position = pd, na.rm = TRUE) +
ggplot2::geom_pointrange(data = plot.cost2.data, mapping = ggplot2::aes(x = Individuals, y = mean, ymin = upper, ymax = lower), na.rm = TRUE) +
ggplot2::scale_colour_manual(values = c("red", "black"), guide = ggplot2::guide_legend(override.aes = list(shape = c(16, 16), linetype = c(1, 0)))) +
ggplot2::ggtitle("costs (intervention)")
} else if(any(is.na(x$data_set$costs[[2]])) == FALSE) {
plot.cost2.data <- data.frame(Individuals = seq(1:length(complete$costs2[,1])), costs = observed$costs2, type = m_cost2)
plot_cost2 <- ggplot2::ggplot(plot.cost2.data,ggplot2::aes(colour = type, x = Individuals, y = costs)) + ggplot2::geom_point(position = pd, na.rm = TRUE) +
ggplot2::scale_colour_manual(values = c("black"), guide = ggplot2::guide_legend(override.aes = list(shape = c(16), linetype = c(0)))) +
ggplot2::ggtitle("costs (intervention)")
}
} else if(class == "histogram") {
if(any(is.na(x$data_set$effects[[1]])) == TRUE) {
plot.eff1.data <- data.frame(Individuals = seq(1:length(complete$effects1[, 1])), effects = complete$effects1[, 1],
lower = complete$effects1[, 2], upper = complete$effects1[, 3], type = m_eff1)
plot_eff1 <- ggplot2::ggplot(plot.eff1.data, ggplot2::aes(x = effects, color = type)) + ggplot2::geom_histogram(fill = "white", position = "dodge") +
ggplot2::theme(legend.position = "top") + ggplot2::scale_colour_manual(values = c("red","black")) + ggplot2::ggtitle("effects (control)")
} else if(any(is.na(x$data_set$effects[[1]])) == FALSE) {
plot.eff1.data <- data.frame(Individuals = seq(1:length(complete$effects1[,1])), effects = complete$effects1[,1], type = m_eff1)
plot_eff1 <- ggplot2::ggplot(plot.eff1.data, ggplot2::aes(x = effects, color = type)) + ggplot2::geom_histogram(fill = "white", position = "dodge") +
ggplot2::theme(legend.position = "top") + ggplot2::scale_colour_manual(values = c("black")) + ggplot2::ggtitle("effects (control)")
}
if(any(is.na(x$data_set$effects[[2]])) == TRUE) {
plot.eff2.data <- data.frame(Individuals = seq(1:length(complete$effects2[, 1])), effects = complete$effects2[, 1],
lower = complete$effects2[, 2], upper = complete$effects2[, 3], type = m_eff2)
plot_eff2 <- ggplot2::ggplot(plot.eff2.data, ggplot2::aes(x = effects, color = type)) + ggplot2::geom_histogram(fill = "white", position = "dodge") +
ggplot2::theme(legend.position = "top") + ggplot2::scale_colour_manual(values = c("red", "black")) + ggplot2::ggtitle("effects (intervention)")
} else if(any(is.na(x$data_set$effects[[2]])) == FALSE) {
plot.eff2.data <- data.frame(Individuals = seq(1:length(complete$effects1[, 2])), effects = complete$effects1[, 2], type = m_eff1)
plot_eff2 <- ggplot2::ggplot(plot.eff2.data, ggplot2::aes(x = effects, color = type)) + ggplot2::geom_histogram(fill = "white", position = "dodge") +
ggplot2::theme(legend.position = "top") + ggplot2::scale_colour_manual(values = c("black")) + ggplot2::ggtitle("effects (intervention)")
}
if(any(is.na(x$data_set$costs[[1]])) == TRUE) {
plot.cost1.data <- data.frame(Individuals = seq(1:length(complete$costs1[, 1])), costs = complete$costs1[, 1],
lower = complete$costs1[, 2], upper = complete$costs1[, 3], type = m_cost1)
plot_cost1 <- ggplot2::ggplot(plot.cost1.data, ggplot2::aes(x = costs, color = type)) + ggplot2::geom_histogram(fill = "white", position = "dodge") +
ggplot2::theme(legend.position = "top") + ggplot2::scale_colour_manual(values = c("red", "black")) + ggplot2::ggtitle("costs (control)")
} else if(any(is.na(x$data_set$costs[[1]])) == FALSE) {
plot.cost1.data <- data.frame(Individuals = seq(1:length(complete$costs1[, 1])), costs = complete$costs1[, 1], type = m_cost1)
plot_cost1 <- ggplot2::ggplot(plot.cost1.data, ggplot2::aes(x = costs, color = type)) + ggplot2::geom_histogram(fill = "white", position = "dodge") +
ggplot2::theme(legend.position = "top") + ggplot2::scale_colour_manual(values = c("black")) + ggplot2::ggtitle("costs (control)")
}
if(any(is.na(x$data_set$costs[[2]])) == TRUE) {
plot.cost2.data <- data.frame(Individuals = seq(1:length(complete$costs2[, 1])), costs = complete$costs2[, 1], lower = complete$costs2[, 2], upper = complete$costs2[, 3], type = m_cost2)
plot_cost2 <- ggplot2::ggplot(plot.cost2.data, ggplot2::aes(x = costs, color = type)) + ggplot2::geom_histogram(fill = "white", position = "dodge") +
ggplot2::theme(legend.position = "top") + ggplot2::scale_colour_manual(values = c("red", "black")) + ggplot2::ggtitle("costs (intervention)")
} else if(any(is.na(x$data_set$costs[[2]])) == FALSE) {
plot.cost2.data <- data.frame(Individuals = seq(1:length(complete$costs2[, 1])), costs = complete$costs2[, 1], type = m_cost2)
plot_cost2 <- ggplot2::ggplot(plot.cost2.data, ggplot2::aes(x = costs, color = type)) + ggplot2::geom_histogram(fill = "white", position = "dodge") +
ggplot2::theme(legend.position = "top") + ggplot2::scale_colour_manual(values = c("black")) + ggplot2::ggtitle("costs (intervention)")
}
}
if(theme == "base") {
plot_eff1 <- plot_eff1 + ggplot2::theme(panel.border = ggplot2::element_rect(colour = "black", fill = NA), panel.background = ggplot2::element_blank(),
panel.grid.major = ggplot2::element_blank(), panel.grid.minor = ggplot2::element_blank(), plot.title = ggplot2::element_text(hjust = 0.5))
plot_eff2 <- plot_eff2 + ggplot2::theme(panel.border = ggplot2::element_rect(colour = "black", fill = NA), panel.background = ggplot2::element_blank(),
panel.grid.major = ggplot2::element_blank(), panel.grid.minor = ggplot2::element_blank(), plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost1 <- plot_cost1 + ggplot2::theme(panel.border = ggplot2::element_rect(colour = "black", fill = NA), panel.background = ggplot2::element_blank(),
panel.grid.major = ggplot2::element_blank(),panel.grid.minor = ggplot2::element_blank(), plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost2 <- plot_cost2 + ggplot2::theme(panel.border = ggplot2::element_rect(colour = "black", fill = NA), panel.background = ggplot2::element_blank(),
panel.grid.major = ggplot2::element_blank(), panel.grid.minor = ggplot2::element_blank(), plot.title = ggplot2::element_text(hjust = 0.5))
} else if(theme == "calc") {
plot_eff1 <- plot_eff1 + ggthemes::theme_calc() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_eff2 <- plot_eff2 + ggthemes::theme_calc() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost1 <- plot_cost1 + ggthemes::theme_calc() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost2 <- plot_cost2 + ggthemes::theme_calc() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
} else if(theme == "economist") {
plot_eff1 <- plot_eff1 + ggthemes::theme_economist() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_eff2 <- plot_eff2 + ggthemes::theme_economist() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost1 <- plot_cost1 + ggthemes::theme_economist() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost2 <- plot_cost2 + ggthemes::theme_economist() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
} else if(theme == "excel") {
plot_eff1 <- plot_eff1 + ggthemes::theme_excel() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_eff2 <- plot_eff2 + ggthemes::theme_excel() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost1 <- plot_cost1 + ggthemes::theme_excel() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost2 <- plot_cost2 + ggthemes::theme_excel() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
} else if(theme == "few") {
plot_eff1 <- plot_eff1 + ggthemes::theme_few() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_eff2 <- plot_eff2 + ggthemes::theme_few() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost1 <- plot_cost1 + ggthemes::theme_few() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost2 <- plot_cost2 + ggthemes::theme_few() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
} else if(theme == "538") {
plot_eff1 <- plot_eff1 + ggthemes::theme_fivethirtyeight() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_eff2 <- plot_eff2 + ggthemes::theme_fivethirtyeight() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost1 <- plot_cost1 + ggthemes::theme_fivethirtyeight() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost2 <- plot_cost2 + ggthemes::theme_fivethirtyeight() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
} else if(theme == "gdocs"){
plot_eff1 <- plot_eff1 + ggthemes::theme_gdocs() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_eff2 <- plot_eff2 + ggthemes::theme_gdocs() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost1 <- plot_cost1 + ggthemes::theme_gdocs() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost2 <- plot_cost2 + ggthemes::theme_gdocs() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
} else if(theme == "hc") {
plot_eff1 <- plot_eff1 + ggthemes::theme_hc() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_eff2 <- plot_eff2 + ggthemes::theme_hc() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost1 <- plot_cost1 + ggthemes::theme_hc() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost2 <- plot_cost2 + ggthemes::theme_hc() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
} else if(theme == "par") {
plot_eff1 <- plot_eff1 + ggthemes::theme_par() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_eff2 <- plot_eff2 + ggthemes::theme_par() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost1 <- plot_cost1 + ggthemes::theme_par() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost2 <- plot_cost2 + ggthemes::theme_par() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
} else if(theme == "solarized") {
plot_eff1 <- plot_eff1 + ggthemes::theme_solarized() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_eff2 <- plot_eff2 + ggthemes::theme_solarized() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost1 <- plot_cost1 + ggthemes::theme_solarized() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost2 <- plot_cost2 + ggthemes::theme_solarized() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
} else if(theme == "pander") {
plot_eff1 <- plot_eff1 + ggthemes::theme_pander() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_eff2 <- plot_eff2 + ggthemes::theme_pander() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost1 <- plot_cost1 + ggthemes::theme_pander() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost2 <- plot_cost2 + ggthemes::theme_pander() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
} else if(theme == "stata") {
plot_eff1 <- plot_eff1 + ggthemes::theme_stata() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_eff2 <- plot_eff2 + ggthemes::theme_stata() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost1 <- plot_cost1 + ggthemes::theme_stata() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost2 <- plot_cost2 + ggthemes::theme_stata() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
} else if(theme == "tufte") {
plot_eff1 <- plot_eff1 + ggthemes::theme_tufte() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_eff2 <- plot_eff2 + ggthemes::theme_tufte() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost1 <- plot_cost1 + ggthemes::theme_tufte() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost2 <- plot_cost2 + ggthemes::theme_tufte() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
} else if(theme == "wsj") {
plot_eff1 <- plot_eff1 + ggthemes::theme_wsj() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_eff2 <- plot_eff2 + ggthemes::theme_wsj() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost1 <- plot_cost1 + ggthemes::theme_wsj() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost2 <- plot_cost2 + ggthemes::theme_wsj() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
}
grid_arrange_shared_legend <- function(..., nrow = 1, ncol = length(list(...)), position = c("bottom", "right"), n = 1) {
plots <- list(...)
position <- match.arg(position)
g <- ggplot2::ggplotGrob(plots[[n]] + ggplot2::theme(legend.position = position))$grobs
legend <- g[[which(sapply(g, function(x) x$name) == "guide-box")]]
lheight <- sum(legend$height)
lwidth <- sum(legend$width)
gl <- lapply(plots, function(x) x + ggplot2::theme(legend.position = "none"))
gl <- c(gl, nrow = nrow, ncol = ncol)
combined <- switch(position,"bottom" = gridExtra::arrangeGrob(do.call(gridExtra::arrangeGrob, gl), legend,ncol = 1,
heights = grid::unit.c(grid::unit(1, "npc") - lheight, lheight)),
"right" = gridExtra::arrangeGrob(do.call(gridExtra::arrangeGrob, gl), legend, ncol = 2, widths = grid::unit.c(grid::unit(1, "npc") - lwidth, lwidth)))
grid::grid.newpage()
grid::grid.draw(combined)
}
if(outcome == "all") {
suppressWarnings(check_missing <- c(any(is.na(x$data_set$effects[[1]])), any(is.na(x$data_set$effects[[2]])),
any(is.na(x$data_set$costs[[1]])), any(is.na(x$data_set$costs[[2]]))))
if(any(check_missing == TRUE)) {n <- match(TRUE, check_missing) } else {n = 1 }
suppressMessages(plot_output <- grid_arrange_shared_legend(plot_eff1, plot_eff2, plot_cost1, plot_cost2, nrow = 2, ncol = 2, n = n))
} else if(outcome == "effects") {
suppressWarnings(check_missing <- c(any(is.na(x$data_set$effects[[1]])), any(is.na(x$data_set$effects[[2]]))))
if(any(check_missing == TRUE)) {n <- match(TRUE, check_missing) } else {n = 1 }
suppressMessages(plot_output <- grid_arrange_shared_legend(plot_eff1, plot_eff2, nrow = 1, ncol = 2, n = n))
} else if(outcome == "costs") {
suppressWarnings(check_missing <- c(any(is.na(x$data_set$costs[[1]])), any(is.na(x$data_set$costs[[2]]))))
if(any(check_missing==TRUE)) {n <- match(TRUE, check_missing) } else {n = 1 }
suppressMessages(plot_output <- grid_arrange_shared_legend(plot_cost1, plot_cost2, nrow = 1, ncol = 2, n = n))
} else if(outcome == "arm1") {
suppressWarnings(check_missing <- c(any(is.na(x$data_set$effects[[1]])), any(is.na(x$data_set$costs[[1]]))))
if(any(check_missing == TRUE)) {n <- match(TRUE, check_missing) } else {n = 1 }
suppressMessages(plot_output <- grid_arrange_shared_legend(plot_eff1, plot_cost1, nrow = 1, ncol = 2, n = n))
} else if(outcome == "arm2") {
suppressWarnings(check_missing <- c(any(is.na(x$data_set$effects[[2]])), any(is.na(x$data_set$costs[[2]]))))
if(any(check_missing == TRUE)) {n <- match(TRUE, check_missing) } else {n = 1 }
suppressMessages(plot_output <- grid_arrange_shared_legend(plot_eff2, plot_cost2, nrow = 1, ncol = 2, n = n))
} else if(outcome == "effects_arm1") {
suppressWarnings(check_missing <- any(is.na(x$data_set$effects[[1]])))
if(any(check_missing == TRUE)) {n <- match(TRUE, check_missing) } else {n = 1 }
suppressMessages(plot_output <- grid_arrange_shared_legend(plot_eff1, nrow = 1, ncol = 1, n = n))
} else if(outcome == "effects_arm2") {
suppressWarnings(check_missing <- any(is.na(x$data_set$effects[[2]])))
if(any(check_missing == TRUE)) {n <- match(TRUE, check_missing) } else {n = 1 }
suppressMessages(plot_output <- grid_arrange_shared_legend(plot_eff2, nrow = 1, ncol = 1))
} else if(outcome == "costs_arm1") {
suppressWarnings(check_missing <- any(is.na(x$data_set$costs[[1]])))
if(any(check_missing == TRUE)) {n <- match(TRUE, check_missing) } else {n = 1 }
suppressMessages(plot_output <- grid_arrange_shared_legend(plot_cost1, nrow = 1, ncol = 1))
} else if(outcome == "costs_arm2") {
suppressWarnings(check_missing <- any(is.na(x$data_set$costs[[1]])))
if(any(check_missing==TRUE)) {n <- match(TRUE, check_missing) } else {n = 1 }
suppressMessages(plot_output <- grid_arrange_shared_legend(plot_cost2, nrow = 1, ncol = 1))
}
}
if(x$data_format == "long") {
if(is.null(time_plot) == FALSE) {
if(time_plot < 1 | time_plot > dim(x$data_set$effects$Control)[2] | is.numeric(time_plot) == FALSE | isTRUE(all.equal(time_plot, as.integer(time_plot))) == FALSE) {
stop("Time must be a numeric integer. Minimum time is 1 (baseline) and maximum time is the latest follow-up time in the data")
}
}
max_time <- dim(x$data_set$effects$Control)[2]
n_mis_comparator_u <- n_mis_comparator_c <- rep(NA, max_time)
n_mis_reference_u <- n_mis_reference_c <- rep(NA, max_time)
for(time in 1:max_time) {
n_mis_comparator_u[time] <- x$data_set$`N missing in comparator arm`[1, time]
n_mis_comparator_c[time] <- x$data_set$`N missing in comparator arm`[2, time]
n_mis_reference_u[time] <- x$data_set$`N missing in reference arm`[1, time]
n_mis_reference_c[time] <- x$data_set$`N missing in reference arm`[2, time]
}
if(all(n_mis_comparator_u) == 0 & all(n_mis_comparator_c) == 0 & all(n_mis_reference_u) == 0 & all(n_mis_reference_c) == 0) {
stop("No missing value found in the data")
}
eff1_pos <- cost1_pos <- replicate(max_time, list())
eff2_pos <- cost2_pos <- replicate(max_time, list())
for(time in 1:max_time) {
eff1_pos[[time]] <- matrix(x$data_set$effects[[1]][, time], x$data_set$`N in reference arm`, 3)
cost1_pos[[time]] <- matrix(x$data_set$costs[[1]][, time], x$data_set$`N in reference arm`, 3)
eff2_pos[[time]] <- matrix(x$data_set$effects[[2]][, time], x$data_set$`N in comparator arm`, 3)
cost2_pos[[time]] <- matrix(x$data_set$costs[[2]][, time], x$data_set$`N in comparator arm`, 3)
eff1_pos[[time]][,1] <- apply(x$model_output$`model summary`$BUGSoutput$sims.list$eff1[, , time], 2, mean)
eff1_pos[[time]][,2] <- apply(x$model_output$`model summary`$BUGSoutput$sims.list$eff1[, , time], 2, quantile, probs = prob[1])
eff1_pos[[time]][,3] <- apply(x$model_output$`model summary`$BUGSoutput$sims.list$eff1[, , time], 2, quantile, probs = prob[2])
eff2_pos[[time]][,1] <- apply(x$model_output$`model summary`$BUGSoutput$sims.list$eff2[, , time], 2, mean)
eff2_pos[[time]][,2] <- apply(x$model_output$`model summary`$BUGSoutput$sims.list$eff2[, , time], 2, quantile, probs = prob[1])
eff2_pos[[time]][,3] <- apply(x$model_output$`model summary`$BUGSoutput$sims.list$eff2[, , time], 2, quantile, probs = prob[2])
cost1_pos[[time]][,1] <- apply(x$model_output$`model summary`$BUGSoutput$sims.list$cost1[, , time], 2, mean)
cost1_pos[[time]][,2] <- apply(x$model_output$`model summary`$BUGSoutput$sims.list$cost1[, , time], 2, quantile, probs = prob[1])
cost1_pos[[time]][,3] <- apply(x$model_output$`model summary`$BUGSoutput$sims.list$cost1[, , time], 2, quantile, probs = prob[2])
cost2_pos[[time]][,1] <- apply(x$model_output$`model summary`$BUGSoutput$sims.list$cost2[, , time], 2, mean)
cost2_pos[[time]][,2] <- apply(x$model_output$`model summary`$BUGSoutput$sims.list$cost2[, , time], 2, quantile, probs = prob[1])
cost2_pos[[time]][,3] <- apply(x$model_output$`model summary`$BUGSoutput$sims.list$cost2[, , time], 2, quantile, probs = prob[2])
colnames(eff1_pos[[time]]) <- c("mean", "LB", "UB")
colnames(eff2_pos[[time]]) <- c("mean", "LB", "UB")
colnames(cost1_pos[[time]]) <- c("mean", "LB", "UB")
colnames(cost2_pos[[time]]) <- c("mean", "LB", "UB")
}
complete_labels <- complete <- list("effects1" = eff1_pos, "effects2" = eff2_pos, "costs1" = cost1_pos, "costs2" = cost2_pos)
observed <- list("effects1" = x$data_set$effects[[1]], "effects2" = x$data_set$effects[[2]],
"costs1" = x$data_set$costs[[1]], "costs2" = x$data_set$costs[[2]])
eff1_imp <- cost1_imp <- eff1_imputed <- cost1_imputed <- replicate(max_time, list())
eff2_imp <- cost2_imp <- eff2_imputed <- cost2_imputed <- replicate(max_time, list())
for(time in 1:max_time) {
eff1_imp[[time]] <- eff1_imputed[[time]] <- matrix(NA, length(complete$effects1[[time]][, 1]), 3)
cost1_imp[[time]] <- eff2_imputed[[time]] <- matrix(NA, length(complete$costs1[[time]][, 1]), 3)
eff2_imp[[time]] <- cost1_imputed[[time]] <- matrix(NA, length(complete$effects2[[time]][, 1]), 3)
cost2_imp[[time]] <- cost2_imputed[[time]] <- matrix(NA, length(complete$costs2[[time]][, 1]), 3)
}
for(time in 1:max_time) {
eff1_imputed[[time]] <- lapply(1:3, function(j) {
unlist(lapply(1:length(complete$effects1[[time]][, j]), function(i) {
if(is.na(observed$effects1[i, time]) == TRUE) {eff1_imp[[time]][i, time] <- complete$effects1[[time]][i, j]} else {eff1_imp[[time]][i, time] <- NA } } )) })
eff2_imputed[[time]] <- lapply(1:3, function(j){
unlist(lapply(1:length(complete$effects2[[time]][, j]), function(i) {
if(is.na(observed$effects2[i, time]) == TRUE) {eff2_imp[[time]][i, time] <- complete$effects2[[time]][i, j]} else {eff2_imp[[time]][i, time] <- NA } })) })
cost1_imputed[[time]] <- lapply(1:3, function(j) {
unlist(lapply(1:length(complete$costs1[[time]][, j]), function(i) {
if(is.na(observed$costs1[i, time]) == TRUE){cost1_imp[[time]][i, time] <- complete$costs1[[time]][i, j]} else {cost1_imp[[time]][i, time] <- NA } })) })
cost2_imputed[[time]] <- lapply(1:3, function(j) {
unlist(lapply(1:length(complete$costs2[[time]][, j]), function(i) {
if(is.na(observed$costs2[i, time]) == TRUE) {cost2_imp[[time]][i, time] <- complete$costs2[[time]][i, j]} else {cost2_imp[[time]][i, time] <- NA } })) })
eff1_imp[[time]] <- sapply(1:3, function(j) {eff1_imp[[time]][, j] <- unlist(eff1_imputed[[time]][j]) })
eff2_imp[[time]] <- sapply(1:3, function(j) {eff2_imp[[time]][, j] <- unlist(eff2_imputed[[time]][j]) })
cost1_imp[[time]] <- sapply(1:3, function(j) {cost1_imp[[time]][, j] <- unlist(cost1_imputed[[time]][j]) })
cost2_imp[[time]] <- sapply(1:3, function(j) {cost2_imp[[time]][, j] <- unlist(cost2_imputed[[time]][j]) })
colnames(eff1_imp[[time]]) <- c("mean", "LB", "UB")
colnames(eff2_imp[[time]]) <- c("mean", "LB", "UB")
colnames(cost1_imp[[time]]) <- c("mean", "LB", "UB")
colnames(cost2_imp[[time]]) <- c("mean", "LB", "UB")
}
imputed <- list("effects1"= eff1_imp, "effects2" = eff2_imp, "costs1" = cost1_imp, "costs2" = cost2_imp)
imputed_labels <- list("effects1"= eff1_imp, "effects2" = eff2_imp, "costs1" = cost1_imp, "costs2" = cost2_imp)
data <- list("observed" = observed, "imputed" = imputed, "complete" = complete)
indic <- function(x) {
w = NULL
if (is.na(x) == TRUE)
w = "missing"
else w = "observed"
return(w)
}
m_eff1 <- m_cost1 <- matrix(NA, nrow = dim(observed$effects1)[1], ncol = max_time)
m_eff2 <- m_cost2 <- matrix(NA, nrow = dim(observed$effects2)[1], ncol = max_time)
bound_m_eff1 <- bound_m_cost1 <- replicate(max_time, list())
bound_m_eff2 <- bound_m_cost2 <- replicate(max_time, list())
for(time in 1:max_time) {
bound_m_eff1[[time]] <- matrix(0, dim(observed$effects1)[1], 3)
bound_m_cost1[[time]] <- matrix(0, dim(observed$costs1)[1], 3)
bound_m_eff2[[time]] <- matrix(0, dim(observed$effects2)[1], 3)
bound_m_cost2[[time]] <- matrix(0, dim(observed$costs2)[1], 3)
}
for(time in 1:max_time) {
m_eff1[, time] <- sapply(observed$effects1[, time], indic)
bound_m_eff1[[time]] <- sapply(2:3, function(j) {
sapply(1:length(m_eff1[, time]), function(i) {
if(m_eff1[i, time] == "observed") {
bound_m_eff1[[time]][i, j] = 0
} else if(m_eff1[i, time] == "missing") {
bound_m_eff1[[time]][i, j] = imputed$effects1[[time]][i, j] } }) })
m_eff2[, time] <- sapply(observed$effects2[, time], indic)
bound_m_eff2[[time]] <- sapply(2:3, function(j) {
sapply(1:length(m_eff2[, time]), function(i) {
if(m_eff2[i, time] == "observed") {
bound_m_eff2[[time]][i, j] = 0
} else if(m_eff2[i, time] == "missing") {
bound_m_eff2[[time]][i, j] = imputed$effects2[[time]][i,j] } }) })
m_cost1[, time] <- sapply(observed$costs1[, time], indic)
bound_m_cost1[[time]] <- sapply(2:3, function(j) {
sapply(1:length(m_cost1[, time]), function(i) {
if(m_cost1[i, time] == "observed") {
bound_m_cost1[[time]][i, j] = 0
} else if(m_cost1[i, time] == "missing") {
bound_m_cost1[[time]][i, j] = imputed$costs1[[time]][i, j] } }) })
m_cost2[, time] <- sapply(observed$costs2[, time], indic)
bound_m_cost2[[time]] <- sapply(2:3, function(j) {
sapply(1:length(m_cost2[, time]), function(i) {
if(m_cost2[i, time] == "observed") {
bound_m_cost2[[time]][i, j] = 0
} else if(m_cost2[i, time] == "missing") {
bound_m_cost2[[time]][i, j] = imputed$costs2[[time]][i, j] } }) })
}
effects <- costs <- upper <- lower <- Individuals <- type <- NULL
plot.eff1.data <- plot.cost1.data <- replicate(max_time, list())
plot.eff2.data <- plot.cost2.data <- replicate(max_time, list())
plot_eff1 <- plot_cost1 <- replicate(max_time, list())
plot_eff2 <- plot_cost2 <- replicate(max_time, list())
if(class == "scatter") {
pd <- ggplot2::position_dodge(0.1)
for(time in 1:max_time) {
if(any(is.na(x$data_set$effects[[1]][, time])) == TRUE) {
plot.eff1.data[[time]] <- data.frame(Individuals = seq(1:length(complete$effects1[[time]][, 1])), effects = observed$effects1[, time], mean = imputed$effects1[[time]][, 1],
lower = imputed$effects1[[time]][, 2], upper = imputed$effects1[[time]][, 3], type = m_eff1[, time])
plot_eff1[[time]] <- ggplot2::ggplot(plot.eff1.data[[time]], ggplot2::aes(colour = type, x = Individuals, y = effects)) + ggplot2::geom_point(position = pd,na.rm = TRUE) +
ggplot2::geom_pointrange(data = plot.eff1.data[[time]], mapping = ggplot2::aes(x = Individuals, y = mean, ymin = upper, ymax = lower), na.rm = TRUE) +
ggplot2::scale_colour_manual(values = c("red", "black"), guide = ggplot2::guide_legend(override.aes = list(shape = c(16, 16), linetype = c(1, 0)))) +
ggplot2::ggtitle(paste0("effects (control), time ", time))
} else if(any(is.na(x$data_set$effects[[1]][, time])) == FALSE) {
plot.eff1.data[[time]] <- data.frame(Individuals = seq(1:length(complete$effects1[[time]][, 1])), effects = observed$effects1[, time], type = m_eff1[, time])
plot_eff1[[time]] <- ggplot2::ggplot(plot.eff1.data[[time]], ggplot2::aes(colour = type, x = Individuals, y = effects)) + ggplot2::geom_point(position = pd, na.rm = TRUE) +
ggplot2::scale_colour_manual(values = c("black"), guide = ggplot2::guide_legend(override.aes = list(shape = c(16), linetype = c(0)))) +
ggplot2::ggtitle(paste0("effects (control), time ", time))
}
if(any(is.na(x$data_set$effects[[2]][, time])) == TRUE) {
plot.eff2.data[[time]] <- data.frame(Individuals = seq(1:length(complete$effects2[[time]][, 1])), effects = observed$effects2[, time], mean = imputed$effects2[[time]][, 1],
lower = imputed$effects2[[time]][,2], upper = imputed$effects2[[time]][, 3], type = m_eff2[, time])
plot_eff2[[time]] <- ggplot2::ggplot(plot.eff2.data[[time]], ggplot2::aes(colour = type, x = Individuals, y = effects)) + ggplot2::geom_point(position = pd, na.rm = TRUE) +
ggplot2::geom_pointrange(data = plot.eff2.data[[time]], mapping = ggplot2::aes(x = Individuals, y = mean, ymin = upper, ymax = lower), na.rm = TRUE) +
ggplot2::scale_colour_manual(values = c("red", "black"), guide = ggplot2::guide_legend(override.aes = list(shape = c(16, 16), linetype = c(1, 0)))) +
ggplot2::ggtitle(paste0("effects (intervention), time ", time))
} else if(any(is.na(x$data_set$effects[[2]])) == FALSE) {
plot.eff2.data[[time]] <- data.frame(Individuals = seq(1:length(complete$effects2[[time]][, 1])), effects = observed$effects2[, time], type = m_eff2[, time])
plot_eff2[[time]] <- ggplot2::ggplot(plot.eff2.data[[time]], ggplot2::aes(colour = type, x = Individuals, y = effects)) + ggplot2::geom_point(position = pd, na.rm = TRUE) +
ggplot2::scale_colour_manual(values = c("black"), guide = ggplot2::guide_legend(override.aes = list(shape = c(16), linetype = c(0)))) +
ggplot2::ggtitle(paste0("effects (intervention), time ", time))
}
if(any(is.na(x$data_set$costs[[1]][, time])) == TRUE) {
plot.cost1.data[[time]] <- data.frame(Individuals = seq(1:length(complete$costs1[[time]][, 1])), costs = observed$costs1[, time], mean = imputed$costs1[[time]][, 1],
lower = imputed$costs1[[time]][, 2], upper = imputed$costs1[[time]][, 3], type = m_cost1[, time])
plot_cost1[[time]] <- ggplot2::ggplot(plot.cost1.data[[time]], ggplot2::aes(colour = type, x = Individuals, y = costs)) + ggplot2::geom_point(position = pd, na.rm = TRUE) +
ggplot2::geom_pointrange(data = plot.cost1.data[[time]], mapping = ggplot2::aes(x = Individuals, y = mean, ymin = upper, ymax = lower), na.rm = TRUE) +
ggplot2::scale_colour_manual(values = c("red", "black"), guide = ggplot2::guide_legend(override.aes = list(shape = c(16, 16), linetype=c(1, 0)))) +
ggplot2::ggtitle(paste0("costs (control), time ", time))
} else if(any(is.na(x$data_set$costs[[1]][, time])) == FALSE) {
plot.cost1.data[[time]] <- data.frame(Individuals = seq(1:length(complete$costs1[[time]][, 1])), costs = observed$costs1[, time], type = m_cost1[, time])
plot_cost1[[time]] <- ggplot2::ggplot(plot.cost1.data[[time]], ggplot2::aes(colour = type, x = Individuals, y = costs)) + ggplot2::geom_point(position = pd, na.rm = TRUE) +
ggplot2::scale_colour_manual(values = c("black"), guide = ggplot2::guide_legend(override.aes = list(shape = c(16), linetype = c(0)))) +
ggplot2::ggtitle(paste0("costs (control), time ", time))
}
if(any(is.na(x$data_set$costs[[2]][, time])) == TRUE) {
plot.cost2.data[[time]] <- data.frame(Individuals = seq(1:length(complete$costs2[[time]][, 1])),costs = observed$costs2[, time], mean = imputed$costs2[[time]][, 1],
lower = imputed$costs2[[time]][, 2], upper = imputed$costs2[[time]][, 3], type = m_cost2[, time])
plot_cost2[[time]] <- ggplot2::ggplot(plot.cost2.data[[time]], ggplot2::aes(colour = type, x = Individuals, y = costs)) + ggplot2::geom_point(position = pd, na.rm = TRUE) +
ggplot2::geom_pointrange(data = plot.cost2.data[[time]], mapping = ggplot2::aes(x = Individuals, y = mean, ymin = upper, ymax = lower), na.rm = TRUE) +
ggplot2::scale_colour_manual(values = c("red", "black"), guide = ggplot2::guide_legend(override.aes = list(shape = c(16, 16), linetype = c(1, 0)))) +
ggplot2::ggtitle(paste0("costs (intervention), time ", time))
} else if(any(is.na(x$data_set$costs[[2]][, time])) == FALSE) {
plot.cost2.data[[time]] <- data.frame(Individuals = seq(1:length(complete$costs2[[time]][, 1])), costs = observed$costs2[, time], type = m_cost2[, time])
plot_cost2[[time]] <- ggplot2::ggplot(plot.cost2.data[[time]], ggplot2::aes(colour = type, x = Individuals, y = costs)) + ggplot2::geom_point(position = pd, na.rm = TRUE) +
ggplot2::scale_colour_manual(values = c("black"), guide = ggplot2::guide_legend(override.aes = list(shape = c(16), linetype = c(0)))) +
ggplot2::ggtitle(paste0("costs (intervention), time ", time))
}
}
} else if(class == "histogram") {
for(time in 1:max_time) {
if(any(is.na(x$data_set$effects[[1]][, time])) == TRUE) {
plot.eff1.data[[time]] <- data.frame(Individuals = seq(1:length(complete$effects1[[time]][, 1])), effects = complete$effects1[[time]][, 1],
lower = complete$effects1[[time]][, 2], upper = complete$effects1[[time]][, 3], type = m_eff1[, time])
plot_eff1[[time]] <- ggplot2::ggplot(plot.eff1.data[[time]], ggplot2::aes(x = effects, color = type)) + ggplot2::geom_histogram(fill = "white", position = "dodge") +
ggplot2::theme(legend.position = "top") + ggplot2::scale_colour_manual(values = c("red","black")) + ggplot2::ggtitle(paste0("effects (control), time ", time))
} else if(any(is.na(x$data_set$effects[[1]][, time])) == FALSE) {
plot.eff1.data[[time]] <- data.frame(Individuals = seq(1:length(complete$effects1[[time]][, 1])), effects = complete$effects1[[time]][, 1], type = m_eff1[, time])
plot_eff1[[time]] <- ggplot2::ggplot(plot.eff1.data[[time]], ggplot2::aes(x = effects, color = type)) + ggplot2::geom_histogram(fill = "white", position = "dodge") +
ggplot2::theme(legend.position = "top") + ggplot2::scale_colour_manual(values = c("black")) + ggplot2::ggtitle(paste0("effects (control), time ", time))
}
if(any(is.na(x$data_set$effects[[2]][, time])) == TRUE) {
plot.eff2.data[[time]] <- data.frame(Individuals = seq(1:length(complete$effects2[[time]][, 1])), effects = complete$effects2[[time]][, 1],
lower = complete$effects2[[time]][, 2], upper = complete$effects2[[time]][, 3], type = m_eff2[, time])
plot_eff2[[time]] <- ggplot2::ggplot(plot.eff2.data[[time]], ggplot2::aes(x = effects, color = type)) + ggplot2::geom_histogram(fill = "white", position = "dodge") +
ggplot2::theme(legend.position = "top") + ggplot2::scale_colour_manual(values = c("red", "black")) + ggplot2::ggtitle(paste0("effects (intervention), time ", time))
} else if(any(is.na(x$data_set$effects[[2]][, time])) == FALSE) {
plot.eff2.data[[time]] <- data.frame(Individuals = seq(1:length(complete$effects1[[time]][, 2])), effects = complete$effects1[[time]][, 2], type = m_eff1[, time])
plot_eff2[[time]] <- ggplot2::ggplot(plot.eff2.data[[time]], ggplot2::aes(x = effects, color = type)) + ggplot2::geom_histogram(fill = "white", position = "dodge") +
ggplot2::theme(legend.position = "top") + ggplot2::scale_colour_manual(values = c("black")) + ggplot2::ggtitle(paste0("effects (intervention), time ", time))
}
if(any(is.na(x$data_set$costs[[1]][, time])) == TRUE) {
plot.cost1.data[[time]] <- data.frame(Individuals = seq(1:length(complete$costs1[[time]][, 1])), costs = complete$costs1[[time]][, 1],
lower = complete$costs1[[time]][, 2], upper = complete$costs1[[time]][, 3], type = m_cost1[, time])
plot_cost1[[time]] <- ggplot2::ggplot(plot.cost1.data[[time]], ggplot2::aes(x = costs, color = type)) + ggplot2::geom_histogram(fill = "white", position = "dodge") +
ggplot2::theme(legend.position = "top") + ggplot2::scale_colour_manual(values = c("red", "black")) + ggplot2::ggtitle(paste0("costs (control), time ", time))
} else if(any(is.na(x$data_set$costs[[1]][, time])) == FALSE) {
plot.cost1.data[[time]] <- data.frame(Individuals = seq(1:length(complete$costs1[[time]][, 1])), costs = complete$costs1[[time]][, 1], type = m_cost1[, time])
plot_cost1[[time]] <- ggplot2::ggplot(plot.cost1.data[[time]], ggplot2::aes(x = costs, color = type)) + ggplot2::geom_histogram(fill = "white", position = "dodge") +
ggplot2::theme(legend.position = "top") + ggplot2::scale_colour_manual(values = c("black")) + ggplot2::ggtitle(paste0("costs (control), time ", time))
}
if(any(is.na(x$data_set$costs[[2]][, time])) == TRUE) {
plot.cost2.data[[time]] <- data.frame(Individuals = seq(1:length(complete$costs2[[time]][, 1])), costs = complete$costs2[[time]][, 1],
lower = complete$costs2[[time]][, 2], upper = complete$costs2[[time]][, 3], type = m_cost2[, time])
plot_cost2[[time]] <- ggplot2::ggplot(plot.cost2.data[[time]], ggplot2::aes(x = costs, color = type)) + ggplot2::geom_histogram(fill = "white", position = "dodge") +
ggplot2::theme(legend.position = "top") + ggplot2::scale_colour_manual(values = c("red", "black")) + ggplot2::ggtitle(paste0("costs (intervention), time ", time))
} else if(any(is.na(x$data_set$costs[[2]][, time])) == FALSE) {
plot.cost2.data[[time]] <- data.frame(Individuals = seq(1:length(complete$costs2[[time]][, 1])), costs = complete$costs2[[time]][, 1], type = m_cost2[, time])
plot_cost2[[time]] <- ggplot2::ggplot(plot.cost2.data[[time]], ggplot2::aes(x = costs, color = type)) + ggplot2::geom_histogram(fill = "white", position = "dodge") +
ggplot2::theme(legend.position = "top") + ggplot2::scale_colour_manual(values = c("black")) + ggplot2::ggtitle(paste0("costs (intervention), time ", time))
}
}
}
if(theme == "base") {
for(time in 1:max_time) {
plot_eff1[[time]] <- plot_eff1[[time]] + ggplot2::theme(panel.border = ggplot2::element_rect(colour = "black", fill = NA), panel.background = ggplot2::element_blank(),
panel.grid.major = ggplot2::element_blank(), panel.grid.minor = ggplot2::element_blank(), plot.title = ggplot2::element_text(hjust = 0.5))
plot_eff2[[time]] <- plot_eff2[[time]] + ggplot2::theme(panel.border = ggplot2::element_rect(colour = "black", fill = NA), panel.background = ggplot2::element_blank(),
panel.grid.major = ggplot2::element_blank(), panel.grid.minor = ggplot2::element_blank(), plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost1[[time]] <- plot_cost1[[time]] + ggplot2::theme(panel.border = ggplot2::element_rect(colour = "black", fill = NA), panel.background = ggplot2::element_blank(),
panel.grid.major = ggplot2::element_blank(),panel.grid.minor = ggplot2::element_blank(), plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost2[[time]] <- plot_cost2[[time]] + ggplot2::theme(panel.border = ggplot2::element_rect(colour = "black", fill = NA), panel.background = ggplot2::element_blank(),
panel.grid.major = ggplot2::element_blank(), panel.grid.minor = ggplot2::element_blank(), plot.title = ggplot2::element_text(hjust = 0.5))
}
} else if(theme == "calc") {
for(time in 1:max_time) {
plot_eff1[[time]] <- plot_eff1[[time]] + ggthemes::theme_calc() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_eff2[[time]] <- plot_eff2[[time]] + ggthemes::theme_calc() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost1[[time]] <- plot_cost1[[time]] + ggthemes::theme_calc() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost2[[time]] <- plot_cost2[[time]] + ggthemes::theme_calc() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
}
} else if(theme == "economist") {
for(time in 1:max_time) {
plot_eff1[[time]] <- plot_eff1[[time]] + ggthemes::theme_economist() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_eff2[[time]] <- plot_eff2[[time]] + ggthemes::theme_economist() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost1[[time]] <- plot_cost1[[time]] + ggthemes::theme_economist() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost2[[time]] <- plot_cost2[[time]] + ggthemes::theme_economist() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
}
} else if(theme == "excel") {
for(time in 1:max_time) {
plot_eff1[[time]] <- plot_eff1[[time]] + ggthemes::theme_excel() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_eff2[[time]] <- plot_eff2[[time]] + ggthemes::theme_excel() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost1[[time]] <- plot_cost1[[time]] + ggthemes::theme_excel() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost2[[time]] <- plot_cost2[[time]] + ggthemes::theme_excel() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
}
} else if(theme == "few") {
for(time in 1:max_time) {
plot_eff1[[time]] <- plot_eff1[[time]] + ggthemes::theme_few() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_eff2[[time]] <- plot_eff2[[time]] + ggthemes::theme_few() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost1[[time]] <- plot_cost1[[time]] + ggthemes::theme_few() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost2[[time]] <- plot_cost2[[time]] + ggthemes::theme_few() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
}
} else if(theme == "538") {
for(time in 1:max_time) {
plot_eff1[[time]] <- plot_eff1[[time]] + ggthemes::theme_fivethirtyeight() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_eff2[[time]] <- plot_eff2[[time]] + ggthemes::theme_fivethirtyeight() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost1[[time]] <- plot_cost1[[time]] + ggthemes::theme_fivethirtyeight() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost2[[time]] <- plot_cost2[[time]] + ggthemes::theme_fivethirtyeight() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
}
} else if(theme == "gdocs"){
for(time in 1:max_time) {
plot_eff1[[time]] <- plot_eff1[[time]] + ggthemes::theme_gdocs() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_eff2[[time]] <- plot_eff2[[time]] + ggthemes::theme_gdocs() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost1[[time]] <- plot_cost1[[time]] + ggthemes::theme_gdocs() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost2[[time]] <- plot_cost2[[time]] + ggthemes::theme_gdocs() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
}
} else if(theme == "hc") {
for(time in 1:max_time) {
plot_eff1[[time]] <- plot_eff1[[time]] + ggthemes::theme_hc() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_eff2[[time]] <- plot_eff2[[time]] + ggthemes::theme_hc() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost1[[time]] <- plot_cost1[[time]] + ggthemes::theme_hc() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost2[[time]] <- plot_cost2[[time]] + ggthemes::theme_hc() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
}
} else if(theme == "par") {
for(time in 1:max_time) {
plot_eff1[[time]] <- plot_eff1[[time]] + ggthemes::theme_par() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_eff2[[time]] <- plot_eff2[[time]] + ggthemes::theme_par() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost1[[time]] <- plot_cost1[[time]] + ggthemes::theme_par() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost2[[time]] <- plot_cost2[[time]] + ggthemes::theme_par() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
}
} else if(theme == "solarized") {
for(time in 1:max_time) {
plot_eff1[[time]] <- plot_eff1[[time]] + ggthemes::theme_solarized() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_eff2[[time]] <- plot_eff2[[time]] + ggthemes::theme_solarized() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost1[[time]] <- plot_cost1[[time]] + ggthemes::theme_solarized() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost2[[time]] <- plot_cost2[[time]] + ggthemes::theme_solarized() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
}
} else if(theme == "pander") {
for(time in 1:max_time) {
plot_eff1[[time]] <- plot_eff1[[time]] + ggthemes::theme_pander() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_eff2[[time]] <- plot_eff2[[time]] + ggthemes::theme_pander() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost1[[time]] <- plot_cost1[[time]] + ggthemes::theme_pander() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost2[[time]] <- plot_cost2[[time]] + ggthemes::theme_pander() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
}
} else if(theme == "stata") {
for(time in 1:max_time) {
plot_eff1[[time]] <- plot_eff1[[time]] + ggthemes::theme_stata() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_eff2[[time]] <- plot_eff2[[time]] + ggthemes::theme_stata() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost1[[time]] <- plot_cost1[[time]] + ggthemes::theme_stata() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost2[[time]] <- plot_cost2[[time]] + ggthemes::theme_stata() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
}
} else if(theme == "tufte") {
for(time in 1:max_time) {
plot_eff1[[time]] <- plot_eff1[[time]] + ggthemes::theme_tufte() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_eff2[[time]] <- plot_eff2[[time]] + ggthemes::theme_tufte() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost1[[time]] <- plot_cost1[[time]] + ggthemes::theme_tufte() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost2[[time]] <- plot_cost2[[time]] + ggthemes::theme_tufte() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
}
} else if(theme == "wsj") {
for(time in 1:max_time) {
plot_eff1[[time]] <- plot_eff1[[time]] + ggthemes::theme_wsj() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_eff2[[time]] <- plot_eff2[[time]] + ggthemes::theme_wsj() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost1[[time]] <- plot_cost1[[time]] + ggthemes::theme_wsj() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
plot_cost2[[time]] <- plot_cost2[[time]] + ggthemes::theme_wsj() + ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5))
}
}
grid_arrange_shared_legend_plotlist <- function(..., plotlist = NULL, ncol = length(list(...)), nrow = NULL,
position = c("bottom", "right"), n = 1) {
plots <- c(list(...), plotlist)
if (is.null(nrow)) nrow = ceiling(length(plots)/ncol)
position <- match.arg(position)
g <- ggplot2::ggplotGrob(plots[[n]] + ggplot2::theme(legend.position = position))$grobs
legend <- g[[which(sapply(g, function(x) x$name) == "guide-box")]]
lheight <- sum(legend$height)
lwidth <- sum(legend$width)
gl <- lapply(plots, function(x) x + ggplot2::theme(legend.position = "none"))
gl <- c(gl, ncol = ncol, nrow = nrow)
combined <- switch(position, "bottom" = gridExtra::arrangeGrob(do.call(gridExtra::arrangeGrob, gl), legend, ncol = 1,
heights = grid::unit.c(grid::unit(1, "npc") - lheight, lheight)),
"right" = gridExtra::arrangeGrob(do.call(gridExtra::arrangeGrob, gl), legend, ncol = 2, widths = grid::unit.c(grid::unit(1, "npc") - lwidth, lwidth)))
grid::grid.newpage()
grid::grid.draw(combined)
}
if(outcome == "all" & is.null(time_plot) == TRUE) {
check_missing_u <- matrix(NA, nrow = 2, ncol = max_time)
check_missing_c <- matrix(NA, nrow = 2, ncol = max_time)
for(time in 1:max_time) {
suppressWarnings(check_missing_u[ , time] <- c(any(is.na(x$data_set$effects[[1]][, time])), any(is.na(x$data_set$effects[[2]][, time]))))
suppressWarnings(check_missing_c[ , time] <- c(any(is.na(x$data_set$costs[[1]][, time])), any(is.na(x$data_set$costs[[2]][, time]))))
}
if(any(c(check_missing_u, check_missing_c) == TRUE)) {n <- match(TRUE, c(check_missing_u, check_missing_c)) } else {n = 1 }
suppressMessages(plot_output <- grid_arrange_shared_legend_plotlist(plotlist = c(plot_eff1, plot_eff2, plot_cost1, plot_cost2), nrow = max_time, ncol = 4, n = n))
} else if(outcome == "all" & is.null(time_plot) == FALSE) {
check_missing_u <- matrix(NA, nrow = 2, ncol = 1)
check_missing_c <- matrix(NA, nrow = 2, ncol = 1)
suppressWarnings(check_missing_u[ , 1] <- c(any(is.na(x$data_set$effects[[1]][, time_plot])), any(is.na(x$data_set$effects[[2]][, time_plot]))))
suppressWarnings(check_missing_c[ , 1] <- c(any(is.na(x$data_set$costs[[1]][, time_plot])), any(is.na(x$data_set$costs[[2]][, time_plot]))))
if(any(c(check_missing_u, check_missing_c) == TRUE)) {n <- match(TRUE, c(check_missing_u, check_missing_c)) } else {n = 1 }
suppressMessages(plot_output <- grid_arrange_shared_legend_plotlist(plot_eff1[[time_plot]], plot_eff2[[time_plot]], plot_cost1[[time_plot]], plot_cost2[[time_plot]], nrow = 2, ncol = 2, n = n))
} else if(outcome == "effects" & is.null(time_plot) == TRUE) {
check_missing_u <- matrix(NA, nrow = 2, ncol = max_time)
for(time in 1:max_time) {
suppressWarnings(check_missing_u[ , time] <- c(any(is.na(x$data_set$effects[[1]][, time])), any(is.na(x$data_set$effects[[2]][, time]))))
}
if(any(c(check_missing_u) == TRUE)) {n <- match(TRUE, c(check_missing_u)) } else {n = 1 }
suppressMessages(plot_output <- grid_arrange_shared_legend_plotlist(plotlist = c(plot_eff1, plot_eff2), nrow = max_time, ncol = 2, n = n))
} else if(outcome == "effects" & is.null(time_plot) == FALSE) {
check_missing_u <- matrix(NA, nrow = 2, ncol = 1)
suppressWarnings(check_missing_u[ , 1] <- c(any(is.na(x$data_set$effects[[1]][, time_plot])), any(is.na(x$data_set$effects[[2]][, time_plot]))))
if(any(c(check_missing_u) == TRUE)) {n <- match(TRUE, c(check_missing_u)) } else {n = 1 }
suppressMessages(plot_output <- grid_arrange_shared_legend_plotlist(plot_eff1[[time_plot]], plot_eff2[[time_plot]], nrow = 1, ncol = 2, n = n))
} else if(outcome == "costs" & is.null(time_plot) == TRUE) {
check_missing_c <- matrix(NA, nrow = 2, ncol = max_time)
for(time in 1:max_time) {
suppressWarnings(check_missing_c[ , time] <- c(any(is.na(x$data_set$costs[[1]][, time])), any(is.na(x$data_set$costs[[2]][, time]))))
}
if(any(c(check_missing_c) == TRUE)) {n <- match(TRUE, c(check_missing_c)) } else {n = 1 }
suppressMessages(plot_output <- grid_arrange_shared_legend_plotlist(plotlist = c(plot_cost1, plot_cost2), nrow = max_time, ncol = 2, n = n))
} else if(outcome == "costs" & is.null(time_plot) == FALSE) {
check_missing_c <- matrix(NA, nrow = 2, ncol = 1)
suppressWarnings(check_missing_c[ , 1] <- c(any(is.na(x$data_set$costs[[1]][, time_plot])), any(is.na(x$data_set$costs[[2]][, time_plot]))))
if(any(c(check_missing_c) == TRUE)) {n <- match(TRUE, c(check_missing_c)) } else {n = 1 }
suppressMessages(plot_output <- grid_arrange_shared_legend_plotlist(plot_cost1[[time_plot]], plot_cost2[[time_plot]], nrow = 1, ncol = 2, n = n))
} else if(outcome == "arm1" & is.null(time_plot) == TRUE) {
check_missing_u <- matrix(NA, nrow = 1, ncol = max_time)
check_missing_c <- matrix(NA, nrow = 1, ncol = max_time)
for(time in 1:max_time) {
suppressWarnings(check_missing_u[ , time] <- c(any(is.na(x$data_set$effects[[1]][, time]))))
suppressWarnings(check_missing_c[ , time] <- c(any(is.na(x$data_set$costs[[1]][, time]))))
}
if(any(c(check_missing_u, check_missing_c) == TRUE)) {n <- match(TRUE, c(check_missing_u, check_missing_c)) } else {n = 1 }
suppressMessages(plot_output <- grid_arrange_shared_legend_plotlist(plotlist = c(plot_eff1, plot_cost1), nrow = max_time, ncol = 2, n = n))
} else if(outcome == "arm1" & is.null(time_plot) == FALSE) {
check_missing_u <- matrix(NA, nrow = 1, ncol = 1)
check_missing_c <- matrix(NA, nrow = 1, ncol = 1)
suppressWarnings(check_missing_u[ , 1] <- c(any(is.na(x$data_set$effects[[1]][, time_plot]))))
suppressWarnings(check_missing_c[ , 1] <- c(any(is.na(x$data_set$costs[[1]][, time_plot]))))
if(any(c(check_missing_u, check_missing_c) == TRUE)) {n <- match(TRUE, c(check_missing_u, check_missing_c)) } else {n = 1 }
suppressMessages(plot_output <- grid_arrange_shared_legend_plotlist(plot_eff1[[time_plot]], plot_cost1[[time_plot]], nrow = 1, ncol = 2, n = n))
} else if(outcome == "arm2" & is.null(time_plot) == TRUE) {
check_missing_u <- matrix(NA, nrow = 1, ncol = max_time)
check_missing_c <- matrix(NA, nrow = 1, ncol = max_time)
for(time in 1:max_time) {
suppressWarnings(check_missing_u[ , time] <- c(any(is.na(x$data_set$effects[[2]][, time]))))
suppressWarnings(check_missing_c[ , time] <- c(any(is.na(x$data_set$costs[[2]][, time]))))
}
if(any(c(check_missing_u, check_missing_c) == TRUE)) {n <- match(TRUE, c(check_missing_u, check_missing_c)) } else {n = 1 }
suppressMessages(plot_output <- grid_arrange_shared_legend_plotlist(plotlist = c(plot_eff2, plot_cost2), nrow = max_time, ncol = 2, n = n))
} else if(outcome == "arm2" & is.null(time_plot) == FALSE) {
check_missing_u <- matrix(NA, nrow = 1, ncol = 1)
check_missing_c <- matrix(NA, nrow = 1, ncol = 1)
suppressWarnings(check_missing_u[ , 1] <- c(any(is.na(x$data_set$effects[[2]][, time_plot]))))
suppressWarnings(check_missing_c[ , 1] <- c(any(is.na(x$data_set$costs[[2]][, time_plot]))))
if(any(c(check_missing_u, check_missing_c) == TRUE)) {n <- match(TRUE, c(check_missing_u, check_missing_c)) } else {n = 1 }
suppressMessages(plot_output <- grid_arrange_shared_legend_plotlist(plot_eff2[[time_plot]], plot_cost2[[time_plot]], nrow = 1, ncol = 2, n = n))
} else if(outcome == "effects_arm1" & is.null(time_plot) == TRUE) {
check_missing_u <- matrix(NA, nrow = 1, ncol = max_time)
for(time in 1:max_time) {
suppressWarnings(check_missing_u[ , time] <- c(any(is.na(x$data_set$effects[[1]][, time]))))
}
if(any(c(check_missing_u) == TRUE)) {n <- match(TRUE, c(check_missing_u)) } else {n = 1 }
suppressMessages(plot_output <- grid_arrange_shared_legend_plotlist(plotlist = plot_eff1, nrow = max_time, ncol = 1, n = n))
} else if(outcome == "effects_arm1" & is.null(time_plot) == FALSE) {
check_missing_u <- matrix(NA, nrow = 1, ncol = 1)
suppressWarnings(check_missing_u[ , 1] <- c(any(is.na(x$data_set$effects[[1]][, time_plot]))))
if(any(c(check_missing_u) == TRUE)) {n <- match(TRUE, c(check_missing_u)) } else {n = 1 }
suppressMessages(plot_output <- grid_arrange_shared_legend_plotlist(plot_eff1[[time_plot]], nrow = 1, ncol = 1, n = n))
} else if(outcome == "effects_arm2" & is.null(time_plot) == TRUE) {
check_missing_u <- matrix(NA, nrow = 1, ncol = max_time)
for(time in 1:max_time) {
suppressWarnings(check_missing_u[ , time] <- c(any(is.na(x$data_set$effects[[2]][, time]))))
}
if(any(c(check_missing_u) == TRUE)) {n <- match(TRUE, c(check_missing_u)) } else {n = 1 }
suppressMessages(plot_output <- grid_arrange_shared_legend_plotlist(plotlist = plot_eff2, nrow = max_time, ncol = 1, n = n))
} else if(outcome == "effects_arm2" & is.null(time_plot) == FALSE) {
check_missing_u <- matrix(NA, nrow = 1, ncol = 1)
suppressWarnings(check_missing_u[ , 1] <- c(any(is.na(x$data_set$effects[[2]][, time_plot]))))
if(any(c(check_missing_u) == TRUE)) {n <- match(TRUE, c(check_missing_u)) } else {n = 1 }
suppressMessages(plot_output <- grid_arrange_shared_legend_plotlist(plot_eff2[[time_plot]], nrow = 1, ncol = 1, n = n))
} else if(outcome == "costs_arm1" & is.null(time_plot) == TRUE) {
check_missing_c <- matrix(NA, nrow = 1, ncol = max_time)
for(time in 1:max_time) {
suppressWarnings(check_missing_c[ , time] <- c(any(is.na(x$data_set$costs[[1]][, time]))))
}
if(any(c(check_missing_c) == TRUE)) {n <- match(TRUE, c(check_missing_c)) } else {n = 1 }
suppressMessages(plot_output <- grid_arrange_shared_legend_plotlist(plotlist = plot_cost1, nrow = max_time, ncol = 1, n = n))
} else if(outcome == "costs_arm1" & is.null(time_plot) == FALSE) {
check_missing_c <- matrix(NA, nrow = 1, ncol = 1)
suppressWarnings(check_missing_c[ , 1] <- c(any(is.na(x$data_set$costs[[1]][, time_plot]))))
if(any(c(check_missing_c) == TRUE)) {n <- match(TRUE, c(check_missing_c)) } else {n = 1 }
suppressMessages(plot_output <- grid_arrange_shared_legend_plotlist(plot_cost1[[time_plot]], nrow = 1, ncol = 1, n = n))
} else if(outcome == "costs_arm2" & is.null(time_plot) == TRUE) {
check_missing_c <- matrix(NA, nrow = 1, ncol = max_time)
for(time in 1:max_time) {
suppressWarnings(check_missing_c[ , time] <- c(any(is.na(x$data_set$costs[[2]][, time]))))
}
if(any(c(check_missing_c) == TRUE)) {n <- match(TRUE, c(check_missing_c)) } else {n = 1 }
suppressMessages(plot_output <- grid_arrange_shared_legend_plotlist(plotlist = plot_cost2, nrow = max_time, ncol = 1, n = n))
} else if(outcome == "costs_arm2" & is.null(time_plot) == FALSE) {
check_missing_c <- matrix(NA, nrow = 1, ncol = 1)
suppressWarnings(check_missing_c[ , 1] <- c(any(is.na(x$data_set$costs[[2]][, time_plot]))))
if(any(c(check_missing_c) == TRUE)) {n <- match(TRUE, c(check_missing_c)) } else {n = 1 }
suppressMessages(plot_output <- grid_arrange_shared_legend_plotlist(plot_cost2[[time_plot]], nrow = 1, ncol = 1, n = n))
}
}
res_plot <- list("plot" = plot_output, "complete data" = complete_labels, "observed data" = observed, "imputed data" = imputed_labels)
return(invisible(res_plot))
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.