replace axes checkbox

NEWS.md

@@ -3,6 +3,9 @@
 ### Breaking Changes
 * Converted the `hline` parameter of `tm_g_gh_lineplot` to three parameters: `hline_arb`, `hline_arb_color` and `hline_arb_label`.
 
+### Enhancements
+* Added checkbox UI to replace the y and / or x axes with new break points derived from horizontal and or vertical lines.
+
 ### Miscellaneous
 * Added basic logging to the modules.
 * Rewrote modules to use `moduleServer` and updated calls to `teal.devel` modules which have also been written to use `moduleServer`.

R/tm_g_gh_boxplot.R

@@ -412,6 +412,7 @@ srv_g_boxplot <- function(id,
       hline_arb <- horizontal_line()$line_arb
       hline_arb_label <- horizontal_line()$line_arb_label
       hline_arb_color <- horizontal_line()$line_arb_color
+      replace_y_axis <- horizontal_line()$replace_axis
 
       hline_vars <- input$hline_vars
       trt_group <- input$trt_group
@@ -473,6 +474,7 @@ srv_g_boxplot <- function(id,
             alpha = .(alpha),
             dot_size = .(dot_size),
             font_size = .(font_size),
+            replace_y_axis = .(replace_y_axis),
             unit = .("AVALU")
           )
         })

R/tm_g_gh_correlationplot.R

@@ -76,16 +76,16 @@
 #'     AVISIT == "SCREENING" ~ "SCR",
 #'     AVISIT == "BASELINE" ~ "BL",
 #'     grepl("WEEK", AVISIT) ~
-#'     paste(
-#'       "W",
-#'       trimws(
-#'         substr(
-#'           AVISIT,
-#'           start = 6,
-#'           stop = stringr::str_locate(AVISIT, "DAY") - 1
+#'       paste(
+#'         "W",
+#'         trimws(
+#'           substr(
+#'             AVISIT,
+#'             start = 6,
+#'             stop = stringr::str_locate(AVISIT, "DAY") - 1
+#'           )
 #'         )
-#'       )
-#'     ),
+#'       ),
 #'     TRUE ~ NA_character_
 #'   )) %>%
 #'   mutate(AVISITCDN = case_when(
@@ -772,6 +772,7 @@ srv_g_correlationplot <- function(id,
       hline_arb <- horizontal_line()$line_arb
       hline_arb_label <- horizontal_line()$line_arb_label
       hline_arb_color <- horizontal_line()$line_arb_color
+      replace_y_axis <- horizontal_line()$replace_axis
       hline_vars <- if (length(input$hline_vars) == 0) {
         NULL
       } else {
@@ -780,6 +781,7 @@ srv_g_correlationplot <- function(id,
       vline_arb <- vertical_line()$line_arb
       vline_arb_label <- vertical_line()$line_arb_label
       vline_arb_color <- vertical_line()$line_arb_color
+      replace_x_axis <- vertical_line()$replace_axis
       vline_vars <- if (length(input$vline_vars) == 0) {
         NULL
       } else {
@@ -845,7 +847,9 @@ srv_g_correlationplot <- function(id,
             vline_arb_color = .(vline_arb_color),
             vline_vars = .(vline_vars),
             vline_vars_colors = .(vline_vars_colors[seq_along(vline_vars)]),
-            vline_vars_labels = .(paste(vline_vars_labels[seq_along(vline_vars)], "-", xaxis_param))
+            vline_vars_labels = .(paste(vline_vars_labels[seq_along(vline_vars)], "-", xaxis_param)),
+            replace_x_axis = .(replace_x_axis),
+            replace_y_axis = .(replace_y_axis)
           )
           print(p)
         })

R/tm_g_gh_density_distribution_plot.R

@@ -323,6 +323,7 @@ srv_g_density_distribution_plot <- function(id, # nolint
       hline_arb <- horizontal_line()$line_arb
       hline_arb_label <- horizontal_line()$line_arb_label
       hline_arb_color <- horizontal_line()$line_arb_color
+      replace_y_axis <- horizontal_line()$replace_axis
       facet_ncol <- input$facet_ncol
       validate(need(
         is.na(facet_ncol) || (as.numeric(facet_ncol) > 0 && as.numeric(facet_ncol) %% 1 == 0),
@@ -356,7 +357,8 @@ srv_g_density_distribution_plot <- function(id, # nolint
             hline_arb = .(hline_arb),
             hline_arb_label = .(hline_arb_label),
             hline_arb_color = .(hline_arb_color),
-            rug_plot = .(rug_plot)
+            rug_plot = .(rug_plot),
+            replace_y_axis = .(replace_y_axis)
           )
         })
       )

R/tm_g_gh_lineplot.R

@@ -696,6 +696,7 @@ srv_lineplot <- function(id,
       hline_arb <- horizontal_line()$line_arb
       hline_arb_label <- horizontal_line()$line_arb_label
       hline_arb_color <- horizontal_line()$line_arb_color
+      replace_y_axis <- horizontal_line()$replace_axis
 
       chunks_push(
         chunks = private_chunks,
@@ -728,7 +729,8 @@ srv_lineplot <- function(id,
             dodge = .(dodge),
             count_threshold = .(count_threshold),
             table_font_size = .(table_font_size),
-            display_center_tbl = .(include_stat)
+            display_center_tbl = .(include_stat),
+            replace_y_axis = .(replace_y_axis)
           )
           print(p)
         })

R/tm_g_gh_spaghettiplot.R

@@ -394,6 +394,7 @@ srv_g_spaghettiplot <- function(id,
       hline_arb <- horizontal_line()$line_arb
       hline_arb_label <- horizontal_line()$line_arb_label
       hline_arb_color <- horizontal_line()$line_arb_color
+      replace_y_axis <- horizontal_line()$replace_axis
       group_stats <- input$group_stats
       font_size <- input$font_size
       alpha <- input$alpha
@@ -438,7 +439,8 @@ srv_g_spaghettiplot <- function(id,
             group_stats = .(group_stats),
             hline_vars = .(hline_vars),
             hline_vars_colors = .(hline_vars_colors[seq_along(hline_vars)]),
-            hline_vars_labels = .(hline_vars_labels[seq_along(hline_vars)])
+            hline_vars_labels = .(hline_vars_labels[seq_along(hline_vars)]),
+            replace_y_axis = .(replace_y_axis)
           )
           print(p)
         })

R/utils.R

@@ -412,7 +412,8 @@ ui_arbitrary_lines <- function(id, line_arb, line_arb_label, line_arb_color, tit
     tags$b(title),
     textInput(ns("line_arb"), label = "Value:", value = paste(line_arb, collapse = ", ")),
     textInput(ns("line_arb_label"), label = "Label:", value = paste(line_arb_label, collapse = ", ")),
-    textInput(ns("line_arb_color"), label = "Color:", value = paste(line_arb_color, collapse = ", "))
+    textInput(ns("line_arb_color"), label = "Color:", value = paste(line_arb_color, collapse = ", ")),
+    checkboxInput(ns("replace_axis"), label = "Replace axis break points", value = FALSE)
   )
 }
 #' Server module to arbitrary lines
@@ -460,7 +461,12 @@ srv_arbitrary_lines <- function(id) {
           )
         }
       }
-      list(line_arb = line_arb, line_arb_label = line_arb_label, line_arb_color = line_arb_color)
+      list(
+        line_arb = line_arb,
+        line_arb_label = line_arb_label,
+        line_arb_color = line_arb_color,
+        replace_axis = input$replace_axis
+      )
     })
   })
 }