Add tests for new functionalities

R/aaa.R

@@ -26,6 +26,7 @@ utils::globalVariables("continuous_outcome")
 utils::globalVariables("treatments")
 utils::globalVariables("fixed_followup_days")
 utils::globalVariables("average")
+utils::globalVariables("estimate")
 utils::globalVariables("value")
 utils::globalVariables("percentage")
 utils::globalVariables("name")
@@ -53,12 +54,7 @@ utils::globalVariables("WIN_A")
 utils::globalVariables("WIN_P")
 utils::globalVariables("TIE_A")
 utils::globalVariables("linetype")
-utils::globalVariables("wins")
-utils::globalVariables("losses")
-utils::globalVariables("ties")
 utils::globalVariables("method")
 utils::globalVariables("UCL")
 utils::globalVariables("LCL")
-utils::globalVariables("wins")
-utils::globalVariables("losses")
 utils::globalVariables("tot")

R/internal.R

@@ -212,6 +212,9 @@
 }
 
 .log10Ticks <- function(range) {
+  if (range[1] <= 0) {
+    range[1] <- 0.0000001
+  }
   range <- log10(range)
   get_axp <- function(x) 10^c(floor(x[1]), ceiling(x[2]))
   n <- ifelse(range[2] > 4, 1, 2)
@@ -291,16 +294,16 @@
     dplyr::group_by(arm) %>%
     dplyr::summarise(n = n(),
                      x = base::sum(value, na.rm = TRUE),
-                     average = 100 *
+                     estimate = 100 *
                        as.numeric(stats::prop.test(x, n)$estimate),
-                     se = abs(average -
+                     ci_diff = abs(estimate -
                          (100 * as.numeric(stats::prop.test(x, n)$conf.int)[1])
                      )) %>%
     dplyr::ungroup()
 
   # To create ellipsis shape and avoid overlapping between both of them,
-  # set the height to 80% of the SE (minimum scaled in x-axis or y-axis range)
-  width <- (100 - start_binary_endpoint) * min(binary_meta$se) / 100
+  # set the height to 80% of the CI (minimum scaled in x-axis or y-axis range)
+  width <- (100 - start_binary_endpoint) * min(binary_meta$ci_diff) / 100
   y_range <- (max(actv_y, ctrl_y) + 10)  * (width / 100)
   y_height <- min(c(0.4 * abs(actv_y - ctrl_y), 0.8 * min(width, y_range)))
 
@@ -309,17 +312,17 @@
   # with the standard error as width and the height as calculated above
   actv_point <-
     .create_ellipsis_points(unlist(binary_meta[binary_meta$arm == actv,
-                                               "average"]),
+                                               "estimate"]),
                             actv_y,
                             unlist(binary_meta[binary_meta$arm == actv,
-                                               "se"]),
+                                               "ci_diff"]),
                             y_height)
   ctrl_point <-
     .create_ellipsis_points(unlist(binary_meta[binary_meta$arm == ctrl,
-                                               "average"]),
+                                               "estimate"]),
                             ctrl_y,
                             unlist(binary_meta[binary_meta$arm == ctrl,
-                                               "se"]),
+                                               "ci_diff"]),
                             y_height)
 
   binary_data <- rbind(data.frame("outcome" = last_outcome,
@@ -332,18 +335,23 @@
                ctrl_point)
   )
 
+  lowest_value <- binary_meta$estimate - binary_meta$ci_diff
+  highest_value <- binary_meta$estimate + binary_meta$ci_diff
+  x_range <- c(min(0, floor(lowest_value / 10) * 10),
+               max(100, ceiling(highest_value / 10) * 10))
+
   binary_data$x <- .to_rangeab(
     binary_data$x,
     start_binary_endpoint,
-    0,
-    100
+    x_range[1],
+    x_range[2]
   )
 
   binary_meta$average <- .to_rangeab(
-    binary_meta$average,
+    binary_meta$estimate,
     start_binary_endpoint,
-    0,
-    100
+    x_range[1],
+    x_range[2]
   )
 
   binary_meta$y <- 0

R/internal_validation.R

@@ -29,6 +29,8 @@
 
 .create_validation_binary_step <- function(layers, x, arms) {
 
+  `%>%` <- dplyr::`%>%`
+
   binary_layers <- which(layers == "GeomSegment")
 
   if (length(binary_layers) != 0) {
@@ -60,6 +62,8 @@
 
 .create_validation_binary_last <- function(layers, x, arms) {
 
+  `%>%` <- dplyr::`%>%`
+
   polygon_layers <- which(layers == "GeomPolygon")
   point_layers <- which(layers == "GeomPoint")
 
@@ -73,12 +77,11 @@
     polygon_data <- polygon_data %>%
       dplyr::filter(y %in% point_data$y) %>%
       dplyr::group_by(group) %>%
-      dplyr::summarise("lower_se" = base::min(x, na.rm = TRUE),
-                       "upper_se" = base::max(x, na.rm = TRUE))
+      dplyr::summarise("lower_ci" = base::min(x, na.rm = TRUE),
+                       "upper_ci" = base::max(x, na.rm = TRUE))
 
     binary_data <- dplyr::left_join(point_data, polygon_data,
                                     by = "group")
-    binary_data$se <- binary_data$x - binary_data$lower_se
     binary_data$group <- factor(binary_data$group, labels = arms)
 
   } else {

R/internal_winOdds.R

@@ -260,10 +260,10 @@
   }
 
   plot <-  ggplot(data = wo_bar, aes(x = GROUP, y = percentage, fill = name)) +
-    geom_bar(stat = "identity", position = position_dodge(), width = .9) +
+    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 = .9),
+              position = ggplot2::position_dodge(width = .8),
               vjust = 0.5, hjust = -0.2)
 
   plot <- switch(theme,

R/maraca.R

@@ -447,8 +447,8 @@ plot_maraca <- function(
 
   } else if (last_type == "binary") {
 
-    lowest_value <- min(plotdata_last$value, na.rm = TRUE)
-    highest_value <- max(plotdata_last$value, na.rm = TRUE)
+    lowest_value <- last_data$meta$estimate - last_data$meta$ci_diff
+    highest_value <- last_data$meta$estimate + last_data$meta$ci_diff
     range <- c(min(0, floor(lowest_value / 10) * 10),
                max(100, ceiling(highest_value / 10) * 10))
     minor_grid <- seq(range[1], range[2], continuous_grid_spacing_x)
@@ -462,14 +462,14 @@ plot_maraca <- function(
       dplyr::select("x" = median, arm)
   } else if (vline_type == "mean") {
     vline_data <- last_data$meta %>%
-      dplyr::select("x" = median, arm)
+      dplyr::select("x" = average, arm)
   }
 
   if (trans %in% c("log", "log10", "sqrt")) {
 
     if (range[1] < 0) {
       warning(paste("Continuous endpoint has negative values - the",
-                    trans, "transformation will result in missing values"))
+                    trans, "transformation will result in missing values."))
     }
     plotdata_last$value <- eval(parse(text = paste0(trans,
                                                     "(plotdata_last$value)")))
@@ -486,7 +486,7 @@ plot_maraca <- function(
   if (trans == "reverse") {
     if (!is.null(win_odds) && !obj$lowerBetter) {
       message(paste("Last endpoint axis has been reversed, which might",
-                    "indicate that lower values are considered advantageuos.",
+                    "indicate that lower values are considered advantageous.",
                     "Note that the win odds were calculated assuming that",
                     "higher values are better. If that is not correct, please",
                     "use the parameter lowerBetter = TRUE in the",
@@ -498,7 +498,7 @@ plot_maraca <- function(
     plotdata_last$x <- start_last_endpoint - plotdata_last$x + 100
 
     if (!is.null(vline_data)) {
-      vline_data$x <- start_last_endpoint - plotdata_last$x + 100
+      vline_data$x <- start_last_endpoint - vline_data$x + 100
     }
   }
 

R/themes.R

@@ -25,8 +25,8 @@
     ggplot2::geom_vline(xintercept = seq(0.5, n + 1.5, 1),
                         linetype = 2, linewidth = 0.3, color = "darkgray") +
     # Axis showing percentages
-    ggplot2::scale_y_continuous(labels =
-                                  function(x) paste0(round(x, 2), "%")) +
+    ggplot2::scale_y_continuous(labels = function(x) paste0(round(x, 2), "%"),
+                                expand = expansion(mult = c(0, .2))) +
     ggplot2::ylab("Percent of all comparisons") +
     ggplot2::theme_bw() +
     ggplot2::theme(legend.position = "bottom",