diff --git a/R/utils_plots.R b/R/utils_plots.R index 5110f7452b..2e08d4f5f0 100644 --- a/R/utils_plots.R +++ b/R/utils_plots.R @@ -223,7 +223,7 @@ generate_nanoplot <- function( # number of data points) if (!is.null(x_vals) || single_horizontal_bar) { - data_x_width <- 500 + data_x_width <- 600 } else { @@ -965,15 +965,20 @@ generate_nanoplot <- function( } else { if (y_vals[i] < 0) { + y_value_i <- data_y0_point y_height <- data_y_points[i] - data_y0_point data_bar_stroke_color_i <- data_bar_negative_stroke_color[1] data_bar_stroke_width_i <- data_bar_negative_stroke_width[1] data_bar_fill_color_i <- data_bar_negative_fill_color[1] + } else if (y_vals[i] > 0) { + y_value_i <- data_y_points[i] y_height <- data_y0_point - data_y_points[i] + } else if (y_vals[i] == 0) { + y_value_i <- data_y0_point - 1 y_height <- 2 data_bar_stroke_color_i <- "#808080" @@ -1004,46 +1009,70 @@ generate_nanoplot <- function( if (plot_type == "bar" && single_horizontal_bar) { - # TODO: This type of display assumes there is only a single `y` value + # This type of display assumes there is only a single `y` value and there + # are possibly several such horizontal bars across different rows that + # need to be on a common scale - bar_thickness <- data_point_radius[1] * 2 + bar_thickness <- data_point_radius[1] * 4 - # Scale to proportional values - y_proportions_list <- - normalize_to_list( - val = y_vals, - all_vals = all_single_y_vals, - zero = 0 - ) + if (all(all_single_y_vals == 0)) { - y_proportion <- y_proportions_list[["val"]] - y_proportion_zero <- y_proportions_list[["zero"]] + # Handle case where all values across rows are `0` - y0_width <- y_proportion_zero * data_x_width + y_proportion <- 0.5 + y_proportion_zero <- 0.5 + + } else { + # 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] + + rect_x <- y_width + rect_width <- y0_width - y_width + } 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] + + rect_x <- y0_width + rect_width <- y_width - y0_width + } else if (y_vals[1] == 0) { - y_width <- 5 + data_bar_stroke_color <- "#808080" data_bar_stroke_width <- 4 data_bar_fill_color <- "#808080" + + rect_x <- y0_width - 2.5 + rect_width <- 5 } bar_tags <- paste0( "", "" ) + + stroke <- "#BFBFBF" + stroke_width <- 5 + + zero_line_tags <- + paste0( + "", + "" + ) + + # Redefine the `viewbox` in terms of the `data_x_width` value; this ensures + # that the horizontal bars are centered about their extreme values + viewbox <- paste(left_x, top_y, data_x_width, bottom_y, collapse = " ") } # @@ -1076,10 +1125,6 @@ generate_nanoplot <- function( ) } - if (plot_type == "bar" && single_horizontal_bar) { - zero_line_tags <- "" - } - # # Generate reference line #