Allow for nanoplot output of horizontal bars

R/modify_columns.R

@@ -2237,6 +2237,16 @@ cols_add <- function(
 #'   (2) `"zero"` will replace `NA` values with zero values; and (3) `"remove"`
 #'   will remove any incoming `NA` values.
 #'
+#' @param autoscale *Automatically set x- and y-axis scale limits based on data*
+#'
+#'   `scalar<logical>` // *default:* `FALSE`
+#'
+#'   Using `autoscale = TRUE` will ensure that the bounds of all nanoplots
+#'   produced are based on the limits of data combined from all input rows. This
+#'   will result in a shared scale across all of the nanoplots (for *y*- and
+#'   *x*-axis data), which is useful in those cases where the nanoplot data
+#'   should be compared across rows.
+#'
 #' @param columns_x_vals *Columns containing values for the optional x variable*
 #'
 #'   `<column-targeting expression>` // *default:* `NULL` (`optional`)
@@ -2672,6 +2682,7 @@ cols_nanoplot <- function(
     plot_type = c("line", "bar"),
     plot_height = "2em",
     missing_vals = c("gap", "zero", "remove"),
+    autoscale = FALSE,
     columns_x_vals = NULL,
     reference_line = NULL,
     reference_area = NULL,
@@ -2749,6 +2760,35 @@ cols_nanoplot <- function(
     options_plots <- options
   }
 
+  # Get all `y` vals into a vector
+  all_y_vals <- unlist(data_vals_plot_y)
+
+  # Get all `y` vals from single-valued components of `data_vals_plot_y`
+  # into a vector
+  all_single_y_vals <- c()
+  for (i in seq_along(data_vals_plot_y)) {
+    if (length(data_vals_plot_y[[i]]) == 1 && !is.na(data_vals_plot_y[[i]])) {
+      all_single_y_vals <- c(all_single_y_vals, data_vals_plot_y[[i]])
+    }
+  }
+
+  # Automatically apply `expand_x` and `expand_y` values as necessary if
+  # `autoscale` has been set to TRUE
+  if (autoscale) {
+
+    min_y_vals <- min(all_y_vals, na.rm = TRUE)
+    max_y_vals <- max(all_y_vals, na.rm = TRUE)
+    expand_y <- c(min_y_vals, max_y_vals)
+
+    if (!is.null(data_vals_plot_x)) {
+
+      all_x_vals <- unlist(data_vals_plot_x)
+      min_x_vals <- min(all_x_vals, na.rm = TRUE)
+      max_x_vals <- max(all_x_vals, na.rm = TRUE)
+      expand_x <- c(min_x_vals, max_x_vals)
+    }
+  }
+
   # Initialize vector that will contain the nanoplots
   nanoplots <- c()
 
@@ -2771,6 +2811,8 @@ cols_nanoplot <- function(
         expand_x = expand_x,
         expand_y = expand_y,
         missing_vals = missing_vals,
+        all_y_vals = all_y_vals,
+        all_single_y_vals = all_single_y_vals,
         plot_type = plot_type,
         line_type = options_plots$data_line_type,
         currency = options_plots$currency,

R/utils_plots.R

@@ -30,6 +30,8 @@ generate_nanoplot <- function(
     expand_x = NULL,
     expand_y = NULL,
     missing_vals = c("gap", "zero", "remove"),
+    all_y_vals = NULL,
+    all_single_y_vals = NULL,
     plot_type = c("line", "bar"),
     line_type = c("curved", "straight"),
     currency = NULL,
@@ -68,16 +70,20 @@ generate_nanoplot <- function(
   line_type <- rlang::arg_match(line_type)
 
   # Initialize several local `*_tags` variables with `NULL`
-  circle_tags <- NULL
-  bar_tags <- NULL
-  data_path_tags <- NULL
+  ref_area_tags <- NULL
   area_path_tags <- NULL
-  ref_line_tags <- NULL
+  data_path_tags <- NULL
   zero_line_tags <- NULL
-  ref_area_tags <- NULL
+  bar_tags <- NULL
+  ref_line_tags <- NULL
+  circle_tags <- NULL
+  g_y_axis_tags <- NULL
   g_guide_tags <- NULL
 
-  # If the number of `y` values is zero or an empty string,
+  # Initialize the `single_horizontal_bar` variable with `FALSE`
+  single_horizontal_bar <- FALSE
+
+  # If the number of `y` values is zero or if all consist of NA values,
   # return an empty string
   if (length(y_vals) == 0) {
     return("")
@@ -157,6 +163,19 @@ generate_nanoplot <- function(
   # Determine the total number of `y` values available
   num_y_vals <- length(y_vals)
 
+  # If the number of y_vals is `1` and we requested a 'bar' plot, then
+  # generate bars using separate function
+  if (num_y_vals == 1 && grepl("bar", plot_type)) {
+    single_horizontal_bar <- TRUE
+    show_data_points <- FALSE
+    show_data_line <- FALSE
+    show_data_area <- FALSE
+    show_ref_line <- FALSE
+    show_ref_area <- FALSE
+    show_vertical_guides <- FALSE
+    show_y_axis_guide <- FALSE
+  }
+
   # Find out whether the collection of non-NA `y` values are all integer-like
   y_vals_integerlike <- rlang::is_integerish(y_vals)
 
@@ -202,7 +221,7 @@ generate_nanoplot <- function(
   # where `x_vals` aren't present, we'll adjust the final width based
   # on the fixed interval between data points (this is dependent on the
   # number of data points)
-  if (!is.null(x_vals)) {
+  if (!is.null(x_vals) || single_horizontal_bar) {
 
     data_x_width <- 500
 
@@ -908,7 +927,7 @@ generate_nanoplot <- function(
   # Generate data bars
   #
 
-  if (plot_type == "bar") {
+  if (plot_type == "bar" && !single_horizontal_bar) {
 
     bar_strings <- c()
 
@@ -983,11 +1002,62 @@ generate_nanoplot <- function(
     bar_tags <- paste(bar_strings, collapse = "\n")
   }
 
+  if (plot_type == "bar" && single_horizontal_bar) {
+
+    # TODO: This type of display assumes there is only a single `y` value
+
+    bar_thickness <- data_point_radius[1] * 2
+
+    # Scale to proportional values
+    y_proportions_list <-
+      normalize_to_list(
+        val = y_vals,
+        all_vals = all_single_y_vals,
+        zero = 0
+      )
+
+    y_proportion <- y_proportions_list[["val"]]
+    y_proportion_zero <- y_proportions_list[["zero"]]
+
+    y0_width <- y_proportion_zero * data_x_width
+
+    y_width <- y_proportion * data_x_width
+
+    if (y_vals[1] < 0) {
+      data_bar_stroke_color <- data_bar_negative_stroke_color[1]
+      data_bar_stroke_width <- data_bar_negative_stroke_width[1]
+      data_bar_fill_color <- data_bar_negative_fill_color[1]
+    } else if (y_vals[1] > 0) {
+      data_bar_stroke_color <- data_bar_stroke_color[1]
+      data_bar_stroke_width <- data_bar_stroke_width[1]
+      data_bar_fill_color <- data_bar_fill_color[1]
+    } else if (y_vals[1] == 0) {
+      y_width <- 5
+      data_bar_stroke_color <- "#808080"
+      data_bar_stroke_width <- 4
+      data_bar_fill_color <- "#808080"
+    }
+
+    bar_tags <-
+      paste0(
+        "<rect ",
+        "x=\"", 5, "\" ",
+        "y=\"", (bottom_y / 2) - (bar_thickness / 2), "\" ",
+        "width=\"", y_width, "\" ",
+        "height=\"", bar_thickness, "\" ",
+        "stroke=\"", data_bar_stroke_color, "\" ",
+        "stroke-width=\"", data_bar_stroke_width, "\" ",
+        "fill=\"", data_bar_fill_color, "\" ",
+        ">",
+        "</rect>"
+      )
+  }
+
   #
   # Generate zero line for bar plots
   #
 
-  if (plot_type == "bar") {
+  if (plot_type == "bar" && !single_horizontal_bar) {
 
     stroke <- "#BFBFBF"
     stroke_width <- 2
@@ -1006,6 +1076,10 @@ generate_nanoplot <- function(
       )
   }
 
+  if (plot_type == "bar" && single_horizontal_bar) {
+    zero_line_tags <- ""
+  }
+
   #
   # Generate reference line
   #