Merge pull request #177 from ACCLAB/feat/delta_text_dots

Features: contrast bars, swarm bars, delta text and delta dots

DESCRIPTION

@@ -58,7 +58,8 @@ Imports:
   stats,
   stringr,
   brunnermunzel,
-  methods
+  RColorBrewer,
+  viridisLite
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.2.3
 Suggests: 

R/001_plotter.R

@@ -39,8 +39,8 @@ dabest_plot <- function(dabest_effectsize_obj, float_contrast = TRUE, ...) {
   check_effectsize_object(dabest_effectsize_obj)
 
   plot_kwargs <- list(...)
-  plot_kwargs <- assign_plot_kwargs(dabest_effectsize_obj, plot_kwargs)
 
+  plot_kwargs <- assign_plot_kwargs(dabest_effectsize_obj, plot_kwargs)
   custom_palette <- plot_kwargs$custom_palette
 
   is_colour <- dabest_effectsize_obj$is_colour
@@ -62,7 +62,6 @@ dabest_plot <- function(dabest_effectsize_obj, float_contrast = TRUE, ...) {
   raw_plot <- apply_palette(raw_plot, custom_palette)
   delta_plot <- apply_palette(delta_plot, custom_palette)
 
-
   if (float_contrast) {
     final_plot <- cowplot::plot_grid(
       plotlist = list(

R/001_utils.R

@@ -1,21 +1,7 @@
 #' Validate the input parameters for the load function
 #'
+#' TODO Add documentation
 #' @noRd
-#' TODO Add description of parameters
-#' @param data A tidy dataframe.
-#' @param name_x
-#' @param name_y
-#' @param id_col_params
-#' @param colour_params
-#' @param delta2
-#' @param idx
-#' @param paired
-#' @param proportional
-#'
-#' @return no error if all parameters are fine
-#'
-#'
-#'
 validate_load_params <- function(data, name_x, name_y,
                                  id_col, enquo_id_col, is_id_col,
                                  colour, enquo_colour, is_colour,
@@ -104,7 +90,8 @@ validate_load_params <- function(data, name_x, name_y,
   }
 }
 
-# TODO Add documentation
+#' TODO Add documentation
+#' @noRd
 validate_minimeta_params <- function(proportional, delta2, minimeta_idx_lengths) {
   if (proportional) {
     cli::cli_abort(c(
@@ -127,7 +114,8 @@ validate_minimeta_params <- function(proportional, delta2, minimeta_idx_lengths)
   }
 }
 
-# TODO Add documentation
+#' TODO Add documentation
+#' @noRd
 check_dabest_object <- function(dabest_obj) {
   if (!inherits(dabest_obj, "dabest")) {
     cli::cli_abort(c("{.field dabest_obj} must be a {.cls dabest} object."),
@@ -136,7 +124,8 @@ check_dabest_object <- function(dabest_obj) {
   }
 }
 
-# TODO Add documentation
+#' TODO Add documentation
+#' @noRd
 check_effectsize_object <- function(dabest_effectsize_obj) {
   if (!inherits(dabest_effectsize_obj, "dabest_effectsize")) {
     cli::cli_abort(c("{.field dabest_effectsize_obj} must be a {.cls dabest_effectsize} object.",

R/002_df_for_plots.R

@@ -261,7 +261,7 @@ create_dfs_for_xaxis_redraw <- function(idx) {
 #'
 #' This function generates data frames to
 #' represent bars with proportional data in a graphical display.
-#' @param proportion_success
+#' @param proportion_success List of values containing percentages
 #' @param bar_width Numeric value determining the width of the bar in the sankey diagram.
 #' @param gap Integer value specifying the amount of gap for each tufte line.
 #'
@@ -279,8 +279,7 @@ create_dfs_for_proportion_bar <- function(proportion_success, bar_width = 0.3, g
   for (x in 1:length(proportion_success)) {
     y <- proportion_success[x]
     if ((y > 1) || (y < 0)) {
-      cli::cli_abort(c("Proportion plots must be supplied with data of values between 0 and 1."
-      ))
+      cli::cli_abort(c("Proportion plots must be supplied with data of values between 0 and 1."))
     }
 
     x_failure_success <- c(x - bar_width / 2, x + bar_width / 2, x + bar_width / 2, x - bar_width / 2)

R/002_plot_api.R

@@ -59,9 +59,6 @@ plot_raw <- function(dabest_effectsize_obj, float_contrast, plot_kwargs) {
   }
 
   #### Load in sizes of plot elements ####
-  raw_marker_size <- plot_kwargs$raw_marker_size
-  raw_marker_alpha <- plot_kwargs$raw_marker_alpha
-  raw_marker_spread <- plot_kwargs$raw_marker_spread
   raw_marker_side_shift <- plot_kwargs$raw_marker_side_shift
   raw_bar_width <- plot_kwargs$raw_bar_width
   tufte_size <- plot_kwargs$tufte_size
@@ -121,7 +118,16 @@ plot_raw <- function(dabest_effectsize_obj, float_contrast, plot_kwargs) {
   }
 
   #### Initialise raw_plot & Add main_plot_type component ####
-  output <- initialize_raw_plot(plot_kwargs, plot_components, dabest_effectsize_obj, df_for_proportion_bar, sankey_df, sankey_bars, idx, float_contrast)
+  output <- initialize_raw_plot(
+    plot_kwargs,
+    plot_components,
+    dabest_effectsize_obj,
+    df_for_proportion_bar,
+    sankey_df,
+    sankey_bars,
+    idx,
+    float_contrast
+  )
   raw_plot <- output[[1]]
   raw_y_range <- output[[2]]
   raw_y_min <- output[[3]]
@@ -286,6 +292,41 @@ plot_raw <- function(dabest_effectsize_obj, float_contrast, plot_kwargs) {
       axis.title.y = ggplot2::element_text(size = swarm_y_text)
     )
 
+  ### Add swarm bars if plot type is compatible and requested ###
+  swarm_bars <- plot_kwargs$swarm_bars
+  valid_plots <- (main_plot_type == "slope") || (main_plot_type == "swarmplot")
+  if (valid_plots && (swarm_bars)) {
+    if (is_tufte_lines) {
+      # the starting point of y needs to be computed using tufte_gap_value
+      y_values <- tufte_lines_df$y_bot_start + tufte_gap_value
+      raw_plot <- raw_plot +
+        add_swarm_bars_to_raw_plot(
+          dabest_effectsize_obj,
+          plot_kwargs,
+          row_ref,
+          y_values,
+          raw_y_min + raw_y_range / 40,
+          main_plot_type
+        )
+    } else {
+      # compute the mean values
+      mean_values <- raw_data %>%
+        dplyr::group_by(!!enquo_x) %>%
+        dplyr::summarize(
+          mean = mean(!!enquo_y),
+        )
+
+      raw_plot <- raw_plot +
+        add_swarm_bars_to_raw_plot(
+          dabest_effectsize_obj,
+          plot_kwargs,
+          x_axis_raw,
+          mean_values$mean,
+          raw_y_min + raw_y_range / 40,
+          main_plot_type
+        )
+    }
+  }
   return(raw_plot)
 }
 
@@ -308,7 +349,6 @@ plot_raw <- function(dabest_effectsize_obj, float_contrast, plot_kwargs) {
 plot_delta <- function(dabest_effectsize_obj, float_contrast, plot_kwargs) {
   idx <- dabest_effectsize_obj$idx
   separated_idx <- idx
-  bootstraps <- dabest_effectsize_obj$bootstraps
   proportional <- dabest_effectsize_obj$proportional
   paired <- dabest_effectsize_obj$paired
 
@@ -343,9 +383,6 @@ plot_delta <- function(dabest_effectsize_obj, float_contrast, plot_kwargs) {
   }
 
   #### Load in sizes of plot elements ####
-  raw_marker_size <- plot_kwargs$raw_marker_size
-  raw_marker_alpha <- plot_kwargs$raw_marker_alpha
-  raw_bar_width <- plot_kwargs$raw_bar_width
   tufte_size <- plot_kwargs$tufte_size
   es_marker_size <- plot_kwargs$es_marker_size
   es_line_size <- plot_kwargs$es_line_size
@@ -441,6 +478,15 @@ plot_delta <- function(dabest_effectsize_obj, float_contrast, plot_kwargs) {
   } else {
     raw_ylim
   }
+
+  ### Preparing delta dots data
+  delta_dots <- plot_kwargs$delta_dots
+  show_delta_dots <- (is_paired && !(proportional) && delta_dots)
+  if (show_delta_dots) {
+    delta_dots_data <- create_delta_dots_data(dabest_effectsize_obj, x_axis_breaks)
+    delta_y_min <- min(delta_dots_data$y_var)
+    delta_y_max <- max(delta_dots_data$y_var)
+  }
   summary_data <- list(control_summary, test_summary)
   delta_x_axis_params <- list(delta_x_max, delta_x_labels, x_axis_breaks)
   delta_y_axis_params <- list(delta_y_min, delta_y_max, delta_y_mean, raw_ylim)
@@ -454,6 +500,8 @@ plot_delta <- function(dabest_effectsize_obj, float_contrast, plot_kwargs) {
   delta_y_max <- delta_y_params[[3]]
   delta_y_mean <- delta_y_params[[4]]
 
+
+
   #### Add bootci Component ####
   if (delta2 != dabest_effectsize_obj$delta2 || minimeta != dabest_effectsize_obj$minimeta) {
     boot_result <- boot_result[-nrow(boot_result), ]
@@ -561,6 +609,43 @@ plot_delta <- function(dabest_effectsize_obj, float_contrast, plot_kwargs) {
       axis.text.x = ggplot2::element_text(size = contrast_x_text),
       axis.title.y = ggplot2::element_text(size = contrast_y_text)
     )
+  ### Add contrast bars if requested ###
+  contrast_bars <- plot_kwargs$contrast_bars
+  if (contrast_bars) {
+    cb <- add_contrast_bars_to_delta_plot(
+      dabest_effectsize_obj,
+      plot_kwargs,
+      x_axis_breaks,
+      difference,
+      main_violin_type
+    )
+    delta_plot <- delta_plot + cb
+  }
+
+  ### Add delta text if requested
+  delta_text <- plot_kwargs$delta_text
+  if (delta_text) {
+    delta_plot <- add_delta_text_to_delta_plot(
+      delta_plot,
+      dabest_effectsize_obj,
+      plot_kwargs,
+      x_axis_breaks,
+      difference,
+      main_violin_type,
+      float_contrast
+    )
+  }
+  ### Add delta dots if requested
+  if (show_delta_dots) {
+    delta_plot <- add_delta_dots_to_delta_plot(
+      delta_plot,
+      dabest_effectsize_obj,
+      plot_kwargs,
+      x_axis_breaks,
+      main_violin_type,
+      delta_dots_data
+    )
+  }
 
   return(list(delta_plot = delta_plot, delta_range = c(delta_y_min - delta_y_mean / 10, delta_y_max)))
 }

R/002_plot_components.R

@@ -237,6 +237,11 @@ add_scaling_component_to_delta_plot <- function(delta_plot, float_contrast, boot
   delta_y_mean <- delta_y_axis_params[[3]]
   raw_ylim <- delta_y_axis_params[[4]]
 
+  delta_text_space <- 0
+  if (!(float_contrast) && (plot_kwargs$delta_text) && (plot_kwargs$params_delta_text$x_location == "right")) {
+    delta_text_space <- 0.4
+  }
+
   min_y_coords <- NULL # only valid for float_contrast
 
   if (float_contrast) {
@@ -253,8 +258,9 @@ add_scaling_component_to_delta_plot <- function(delta_plot, float_contrast, boot
       ggplot2::theme_classic() +
       ggplot2::coord_cartesian(
         ylim = c(min_y_coords, min_y_coords + delta_y_range),
-        xlim = c(1.8, delta_x_max + 0.4),
-        expand = FALSE
+        xlim = c(1.8, delta_x_max + 0.4 + delta_text_space),
+        expand = FALSE,
+        clip = "off"
       ) +
       ggplot2::scale_x_continuous(
         breaks = c(2),
@@ -284,8 +290,9 @@ add_scaling_component_to_delta_plot <- function(delta_plot, float_contrast, boot
           delta_y_min - delta_y_mean / 10,
           delta_y_max
         ),
-        xlim = c(delta_x_min, delta_x_max + delta_x_scalar),
-        expand = FALSE
+        xlim = c(delta_x_min, delta_x_max + delta_x_scalar + delta_text_space),
+        expand = FALSE,
+        clip = "off"
       ) +
       ggplot2::scale_x_continuous(
         breaks = x_axis_breaks,