Prepare version 0.7 for CRAN release

NAMESPACE

@@ -14,4 +14,5 @@ export(cumulative_plot)
 export(maraca)
 export(plot_maraca)
 export(validate_maraca_plot)
+import(ggplot2)
 import(hce)

R/aaa.R

@@ -29,7 +29,7 @@ utils::globalVariables("average")
 utils::globalVariables("estimate")
 utils::globalVariables("value")
 utils::globalVariables("percentage")
-utils::globalVariables("name")
+utils::globalVariables("count")
 utils::globalVariables(".env")
 utils::globalVariables("separation")
 utils::globalVariables("gap")

R/general.R

@@ -3,6 +3,7 @@
 #' @docType package
 #' @name maraca
 #' @import hce
+#' @import ggplot2
 #' @aliases maraca-package
 NULL
 

R/internal.R

@@ -218,8 +218,9 @@
   range <- log10(range)
   get_axp <- function(x) 10^c(floor(x[1]), ceiling(x[2]))
   n <- ifelse(range[2] > 4, 1, 2)
-  steps <- axTicks(side = 1, usr = range, axp = c(get_axp(range), n = n),
-                   log = TRUE)
+  steps <- graphics::axTicks(side = 1, usr = range, axp = c(get_axp(range),
+                                                            n = n),
+                             log = TRUE)
   return((steps))
 }
 
@@ -461,7 +462,7 @@
   return(minor_grid)
 }
 
-.maraca_from_hce_data <- function(x, last_outcome, arm_levels,
+.maraca_from_hce_data <- function(x, step_outcomes, last_outcome, arm_levels,
                                   fixed_followup_days, compute_win_odds,
                                   step_types = "tte",
                                   last_type = "continuous",
@@ -479,7 +480,14 @@
   checkmate::assert_flag(compute_win_odds)
 
   x <- as.data.frame(x, stringsAsFactors = FALSE)
-  tte <- sort(unique(x$GROUP)[unique(x$GROUP) != last_outcome])
+
+  if (is.null(step_outcomes)) {
+    if (!(last_outcome %in% x$GROUP)) {
+      stop(paste("last_outcome", last_outcome,
+                 "is not in the outcome variable"))
+    }
+    step_outcomes <- sort(unique(x$GROUP)[unique(x$GROUP) != last_outcome])
+  }
 
   # Small bugfix to allow for name change of variable TTEFixed in newer
   # version of HCE package
@@ -491,14 +499,14 @@
     checkmate::assertNames(names(x), must.include = "TTEfixed")
     checkmate::assert_integerish(x$TTEfixed)
 
-    fixed_followup_days <- unname(sapply(tte, function(tte_ind) {
-      x[x$GROUP == tte_ind, "TTEfixed"][[1]]
+    fixed_followup_days <- unname(sapply(step_outcomes, function(tte) {
+      x[x$GROUP == tte, "TTEfixed"][[1]]
     }))
   }
 
   maraca_obj <- maraca(
     data = x,
-    step_outcomes = tte,
+    step_outcomes = step_outcomes,
     last_outcome = last_outcome,
     column_names = c(outcome = "GROUP", arm = "TRTP", value = "AVAL0"),
     arm_levels = arm_levels,

R/internal_winOdds.R

@@ -65,7 +65,7 @@
                                      GROUP = "outcome")
 
   endpoints <- c(step_outcomes, last_outcome)
-  labs <- c(sapply(head(seq_along(endpoints), -1), function(i) {
+  labs <- c(sapply(utils::head(seq_along(endpoints), -1), function(i) {
     paste(endpoints[1:i], collapse = " +\n")
   }), "Overall")
 
@@ -88,31 +88,29 @@
   wins_forest <- do.call("rbind", lapply(seq_along(calcs_lst), function(i) {
     wins <- calcs_lst[[i]]$wins
     nm <- c("value", "LCL", "UCL", "p value")
-    f <- rbind(data.frame(setNames(wins$WO, nm), "method" = "win odds"),
-               data.frame(setNames(wins$WR1, nm), "method" = "win ratio"))
+    f <- rbind(data.frame(stats::setNames(wins$WO, nm), "method" = "win odds"),
+               data.frame(stats::setNames(wins$WR1, nm),
+                          "method" = "win ratio"))
     f$GROUP <- labs[i]
     return(f)
   }))
 
   wo_bar <- do.call("rbind", lapply(seq_along(calcs_lst), function(i) {
-    wo <- head(calcs_lst[[i]]$wo$summary, 1)
+    wo <- utils::head(calcs_lst[[i]]$wo$summary, 1)
     wo$outcome <- endpoints[i]
     wo$GROUP <- labs[i]
     wo %>%
       dplyr::rename(dplyr::all_of(c(A_wins = "WIN", P_wins = "LOSS",
                                     Ties = "TIE"))) %>%
       tidyr::pivot_longer(cols = c("A_wins", "P_wins", "Ties"),
-                          names_to = "name", values_to = "value")
-    # %>%
-    #   dplyr::mutate_at(dplyr::vars(name), factor,
-    #                    levels = c("wins", "losses", "ties"))
+                          names_to = "count", values_to = "value")
   }))
 
   wo_bar <- .label_win_odds_plots(wo_bar, arm_levels)
 
   wins_forest$GROUP <- factor(wins_forest$GROUP, levels = rev(labs))
   wins_forest$method <- factor(wins_forest$method,
-                               levels = c("win ratio", "win odds"))
+                               levels = c("win odds", "win ratio"))
   wo_bar$GROUP <- factor(wo_bar$GROUP, levels = rev(labs))
   wo_bar$percentage <- 100 * (wo_bar$value / win_odds_outcome$summary$TOTAL[1])
 
@@ -150,7 +148,7 @@
                   "Ties" = TIE_A) %>%
     # Long format for plotting
     tidyr::pivot_longer(cols = c("A_wins", "P_wins", "Ties"),
-                        names_to = "name", values_to = "value")
+                        names_to = "count", values_to = "value")
 
   # Total number of wins/losses/ties to get relative results
   wo_bar_nc$total <- wo_tot$TOTAL[1]
@@ -168,12 +166,12 @@
               paste(arms["control"], "wins"),
               "Ties")
 
-  bar_data$name <- ifelse(bar_data$name == "A_wins",
-                          labels[1],
-                          ifelse(bar_data$name == "P_wins",
-                                 labels[2], labels[3]))
+  bar_data$count <- ifelse(bar_data$count == "A_wins",
+                           labels[1],
+                           ifelse(bar_data$count == "P_wins",
+                                  labels[2], labels[3]))
 
-  bar_data$name <- factor(bar_data$name, levels = labels)
+  bar_data$count <- factor(bar_data$count, levels = labels)
 
   return(bar_data)
 }
@@ -188,7 +186,7 @@
 
   plot <-
     ggplot2::ggplot(data = wo_bar_nc, aes(x = GROUP, y = percentage,
-                                          fill = name)) +
+                                          fill = count)) +
     # Bars
     ggplot2::geom_bar(stat = "identity", position = ggplot2::position_dodge(),
                       width = .8) +
@@ -213,39 +211,55 @@
 }
 
 # Create forest plot part of cumulative plot
-.create_forest_plot <- function(wins_forest, theme, reverse) {
+.create_forest_plot <- function(wins_forest, theme, include, reverse) {
 
+  xlab <- paste(include, collapse = " / ")
   if (reverse) {
     wins_forest$GROUP <- factor(wins_forest$GROUP,
                                 levels = rev(levels(wins_forest$GROUP)))
   }
 
-  plot <- ggplot(data = wins_forest) +
-    geom_errorbar(aes(x = GROUP, y = value, ymin = LCL, ymax = UCL,
-                      col = method, group = method), linewidth = 0.3,
-                  width = 0.15,
-                  position = ggplot2::position_dodge(width = 0.3)) +
-    geom_point(aes(x = GROUP, y = value, col = method, shape = method),
-               size = 3, position = ggplot2::position_dodge(width = 0.3)) +
-    geom_hline(yintercept = 1, linetype = "dashed", color = "#676767") +
-    coord_flip() +
-    scale_y_continuous() +
-    scale_x_discrete(labels = NULL, name = NULL)
+  plot <- ggplot2::ggplot(data = wins_forest) +
+    ggplot2::geom_errorbar(ggplot2::aes(x = GROUP, y = value, ymin = LCL,
+                                        ymax = UCL, col = method,
+                                        group = method),
+                           linewidth = 0.3, width = 0.15,
+                           position = ggplot2::position_dodge(width = 0.3)) +
+    ggplot2::geom_point(ggplot2::aes(x = GROUP, y = value,
+                                     col = method, shape = method),
+                        size = 3,
+                        position = ggplot2::position_dodge(width = 0.3)) +
+    ggplot2::geom_hline(yintercept = 1, linetype = "dashed",
+                        color = "#676767") +
+    ggplot2::coord_flip() +
+    ggplot2::scale_y_continuous() +
+    ggplot2::scale_x_discrete(labels = NULL, name = NULL, breaks = NULL)
 
   if (theme != "none") {
     plot <- plot +
       ggplot2::geom_vline(xintercept =
                             seq(0.5, length(levels(wins_forest$GROUP)) + 1.5,
                                 1),
                           linetype = 2, linewidth = 0.3, color = "darkgray") +
-      scale_color_manual(values = c("black", "grey50")) +
-      scale_fill_manual(values = c("black", "grey50")) +
-      ylab("Win Odds / Win Ratio") +
-      theme_bw() +
-      theme(legend.position = "bottom",
-            legend.title = element_blank(),
-            panel.grid.major.y = ggplot2::element_blank(),
-            panel.grid.minor.y = ggplot2::element_blank())
+      ggplot2::ylab(xlab) +
+      ggplot2::theme_bw()
+
+    if (length(include) == 1) {
+      plot <- plot +
+        ggplot2::scale_color_manual(values = "black") +
+        ggplot2::scale_fill_manual(values = "black") +
+        ggplot2::guides(shape = "none", color = "none", fill = "none") +
+        ggplot2::theme(panel.grid.major.y = ggplot2::element_blank(),
+                       panel.grid.minor.y = ggplot2::element_blank())
+    } else {
+      plot <- plot +
+        ggplot2::scale_color_manual(values = c("black", "grey50")) +
+        ggplot2::scale_fill_manual(values = c("black", "grey50")) +
+        ggplot2::theme(legend.position = "bottom",
+                       legend.title = ggplot2::element_blank(),
+                       panel.grid.major.y = ggplot2::element_blank(),
+                       panel.grid.minor.y = ggplot2::element_blank())
+    }
   }
 
   return(plot)
@@ -259,12 +273,15 @@
     wo_bar$GROUP <- factor(wo_bar$GROUP, levels = rev(levels(wo_bar$GROUP)))
   }
 
-  plot <-  ggplot(data = wo_bar, aes(x = GROUP, y = percentage, fill = name)) +
-    geom_bar(stat = "identity", position = position_dodge(), width = .8) +
-    coord_flip() + # make bar plot horizontal
-    geom_text(aes(label = round(percentage, 1)),
-              position = ggplot2::position_dodge(width = .8),
-              vjust = 0.5, hjust = -0.2)
+  plot <-  ggplot2::ggplot(data = wo_bar, ggplot2::aes(x = GROUP,
+                                                       y = percentage,
+                                                       fill = count)) +
+    ggplot2::geom_bar(stat = "identity", position = ggplot2::position_dodge(),
+                      width = .8) +
+    ggplot2::coord_flip() + # make bar plot horizontal
+    ggplot2::geom_text(ggplot2::aes(label = round(percentage, 1)),
+                       position = ggplot2::position_dodge(width = .8),
+                       vjust = 0.5, hjust = -0.2)
 
   plot <- switch(theme,
                  "maraca" = .theme_maraca_cp(plot),

R/maraca.R

@@ -779,7 +779,6 @@ validate_maraca_plot <- function(x,  ...) {
 #' Generic function to plot the maraca object using plot().
 #'
 #' @param x An object of S3 class 'maraca'.
-#' @param \dots not used
 #' @param continuous_grid_spacing_x The spacing of the x grid to use for the
 #'        continuous section of the plot.
 #' @param trans the transformation to apply to the x-axis scale for the last
@@ -797,7 +796,8 @@ validate_maraca_plot <- function(x,  ...) {
 #'        Options are "maraca", "maraca_old", "color1", "color2" and none".
 #'        For more details, check the vignette called
 #'        "Maraca Plots - Themes and Styling".
-#' @return Used for side effect. Returns ggplot2 plot of the maraca object.
+#' @param \dots not used
+#' @return Returns ggplot2 plot of the maraca object.
 #'
 #' @examples
 #' data(hce_scenario_a)
@@ -828,7 +828,13 @@ plot.maraca <- function(
 #' Generic function to plot the hce object using plot().
 #'
 #' @param x an object of S3 class 'hce'.
-#' @param \dots not used
+#' @param step_outcomes A vector of strings containing the outcome labels
+#'                      for all outcomes displayed as part of the step function
+#'                      on the left side of the plot.
+#'                      The order is kept for the plot.
+#'                      By default (when set to NULL) this is automatically
+#'                      updated by taking the non-continuous outcomes from
+#'                      the GROUP variable in alphabetical order.
 #' @param last_outcome A single string containing the last outcome label
 #'                     displayed on the right side of the plot.
 #'                     Default value "C".
@@ -865,6 +871,10 @@ plot.maraca <- function(
 #'                            fixed_followup_days argument is used.
 #' @param compute_win_odds If TRUE compute the win odds, otherwise (default)
 #'                         don't compute them.
+#' @param step_types The type of each outcome in the step_outcomes vector.
+#'                   Can be a single string (if all outcomes of same type) or
+#'                   a vector of same length as step_outcomes. Possible values
+#'                   in the vector are "tte" (default) or "binary".
 #' @param last_type A single string giving the type of the last outcome.
 #'                  Possible values are "continuous" (default), "binary" or
 #'                  "multinomial".
@@ -879,10 +889,15 @@ plot.maraca <- function(
 #'                    calculated correctly.
 #'                    Default value is FALSE, meaning higher values
 #'                    are considered advantageous.
+#' @param tte_outcomes Deprecated and substituted by the more general
+#'                     'step_outcomes'. A vector of strings containing the
+#'                     time-to-event outcome labels. The order is kept for the
+#'                     plot.
 #' @param continuous_outcome Deprecated and substituted by the more general
 #'                           'last_outcome'. A single string containing the
 #'                           continuous outcome label.
-#' @return Used for side effect. Returns ggplot2 plot of the hce object.
+#' @param \dots not used
+#' @return Returns ggplot2 plot of the hce object.
 #'
 #' @examples
 #' Rates_A <- c(1.72, 1.74, 0.58, 1.5, 1)
@@ -894,7 +909,9 @@ plot.maraca <- function(
 #' plot(hce_dat, fixed_followup_days = 3 * 365)
 #'
 #' @export
-plot.hce <- function(x, last_outcome = "C",
+plot.hce <- function(x,
+                     step_outcomes = NULL,
+                     last_outcome = "C",
                      arm_levels = c(active = "A", control = "P"),
                      continuous_grid_spacing_x = 10,
                      trans = c("identity", "log", "log10",
@@ -908,16 +925,24 @@ plot.hce <- function(x, last_outcome = "C",
                      last_type = "continuous",
                      theme = "maraca",
                      lowerBetter = FALSE,
+                     tte_outcomes = lifecycle::deprecated(),
                      continuous_outcome = lifecycle::deprecated(),
                      ...) {
 
+  if (lifecycle::is_present(tte_outcomes)) {
+    lifecycle::deprecate_warn("0.7.0", "maraca(tte_outcomes)",
+                              "maraca(step_outcomes)")
+    step_outcomes <- tte_outcomes
+  }
+
   if (lifecycle::is_present(continuous_outcome)) {
     lifecycle::deprecate_warn("0.7.0", "maraca(continuous_outcome)",
                               "maraca(last_outcome)")
     last_outcome <- continuous_outcome
   }
 
-  maraca_obj <- .maraca_from_hce_data(x, last_outcome, arm_levels,
+  maraca_obj <- .maraca_from_hce_data(x, step_outcomes,
+                                      last_outcome, arm_levels,
                                       fixed_followup_days,
                                       compute_win_odds,
                                       step_types = step_types,

R/themes.R

@@ -26,10 +26,11 @@
                         linetype = 2, linewidth = 0.3, color = "darkgray") +
     # Axis showing percentages
     ggplot2::scale_y_continuous(labels = function(x) paste0(round(x, 2), "%"),
-                                expand = expansion(mult = c(0, .3))) +
+                                expand = ggplot2::expansion(mult = c(0, .3))) +
     ggplot2::ylab("Percent of all comparisons") +
     ggplot2::theme_bw() +
     ggplot2::theme(legend.position = "bottom",
+                   legend.title = ggplot2::element_blank(),
                    axis.title.y = ggplot2::element_blank(),
                    panel.grid.major.y = ggplot2::element_blank(),
                    panel.grid.minor.y = ggplot2::element_blank())