feat: add a poc of a module that uses multiple modules

Author: vedhav

R/module_colur_picker.R

@@ -2,9 +2,9 @@
 
 colour_picker_ui <- function(id) {
   ns <- NS(id)
-  bslib::accordion(
-    uiOutput(ns("module"), title = "Event colors:", container = bslib::accordion_panel),
-    open = FALSE
+  bslib::popover(
+    actionButton(ns("toggle"), "Edit colors"),
+    uiOutput(ns("module"))
   )
 }
 

R/tm_p_lineplot.R

@@ -3,6 +3,7 @@ tm_p_lineplot <- function(label = "Line Plot",
                           plot_dataname,
                           x_var,
                           y_var,
+                          group_var,
                           transformators = list()) {
   module(
     label = label,
@@ -12,7 +13,8 @@ tm_p_lineplot <- function(label = "Line Plot",
     server_args = list(
       plot_dataname = plot_dataname,
       x_var = x_var,
-      y_var = y_var
+      y_var = y_var,
+      group_var = group_var
     ),
     transformators = transformators
   )
@@ -28,7 +30,7 @@ ui_p_lineplot <- function(id) {
   )
 }
 
-srv_p_lineplot <- function(id, data, plot_dataname, x_var, y_var) {
+srv_p_lineplot <- function(id, data, plot_dataname, x_var, y_var, group_var) {
   moduleServer(id, function(input, output, session) {
     plotly_q <- reactive({
       df <- data()[[plot_dataname]]
@@ -39,7 +41,7 @@ srv_p_lineplot <- function(id, data, plot_dataname, x_var, y_var) {
       y_low_last <- if ("si_low" %in% names(df)) utils::tail(stats::na.omit(df[["si_low"]]), 1) else NA
       y_high_last <- if ("si_high" %in% names(df)) utils::tail(stats::na.omit(df[["si_high"]]), 1) else NA
 
-      p <- plotly::plot_ly(data = df, x = df[[x_var]]) |>
+      p <- plotly::plot_ly(data = df |> dplyr::group_by(!!sym(group_var)), x = df[[x_var]]) |>
         plotly::add_trace(
           y = df[[y_var]],
           mode = "lines+markers", type = "scatter", name = "Lab Result",

R/tm_p_scatterlineplot.R

@@ -0,0 +1,63 @@
+#' @export
+tm_p_scatterlineplot <- function(label = "Scatter + Line Plot",
+                                 plot_dataname,
+                                 subject_var,
+                                 x_var,
+                                 y_var,
+                                 color_var,
+                                 point_colors = character(0),
+                                 transformators = list()) {
+  module(
+    label = label,
+    ui = ui_p_scatterlineplot,
+    server = srv_p_scatterlineplot,
+    ui_args = list(),
+    server_args = list(
+      plot_dataname = plot_dataname,
+      subject_var = subject_var,
+      x_var = x_var,
+      y_var = y_var,
+      color_var = color_var,
+      point_colors = point_colors
+    ),
+    transformators = transformators
+  )
+}
+
+ui_p_scatterlineplot <- function(id) {
+  ns <- NS(id)
+  bslib::page_fluid(
+    ui_p_scatterplot(ns("scatter")),
+    ui_p_lineplot(ns("line"))
+  )
+}
+
+srv_p_scatterlineplot <- function(id,
+                                  data,
+                                  plot_dataname,
+                                  subject_var,
+                                  x_var,
+                                  y_var,
+                                  color_var,
+                                  point_colors) {
+  moduleServer(id, function(input, output, session) {
+    plot_q <- srv_p_scatterplot(
+      "scatter",
+      data = data,
+      plot_dataname = plot_dataname,
+      subject_var = subject_var,
+      x_var = x_var,
+      y_var = y_var,
+      color_var = color_var,
+      point_colors = point_colors
+    )
+    srv_p_lineplot(
+      "line",
+      data = plot_q,
+      plot_dataname = plot_dataname,
+      x_var = x_var,
+      y_var = y_var,
+      group_var = subject_var
+    )
+  })
+}

R/tm_p_scatterplot.R

@@ -5,7 +5,6 @@ tm_p_scatterplot <- function(label = "Scatter Plot",
                              x_var,
                              y_var,
                              color_var,
-                             filter_var,
                              point_colors = character(0),
                              transformators = list()) {
   module(
@@ -19,7 +18,6 @@ tm_p_scatterplot <- function(label = "Scatter Plot",
       x_var = x_var,
       y_var = y_var,
       color_var = color_var,
-      filter_var = filter_var,
       point_colors = point_colors
     ),
     transformators = transformators
@@ -28,12 +26,16 @@ tm_p_scatterplot <- function(label = "Scatter Plot",
 
 ui_p_scatterplot <- function(id) {
   ns <- NS(id)
-  bslib::page_sidebar(
-    sidebar = div(
-      bslib::input_switch(ns("add_lines"), "Add lines", value = FALSE),
-      colour_picker_ui(ns("colors"))
-    ),
+  bslib::page_fluid(
     tags$div(
+      shinyWidgets::prettySwitch(
+        ns("add_lines"),
+        label = "Add lines",
+        status = "primary",
+        slim = TRUE,
+        inline = TRUE
+      ),
+      colour_picker_ui(ns("colors")),
       bslib::card(
         full_screen = TRUE,
         tags$div(
@@ -52,7 +54,6 @@ srv_p_scatterplot <- function(id,
                               x_var,
                               y_var,
                               color_var,
-                              filter_var,
                               point_colors) {
   moduleServer(id, function(input, output, session) {
     color_inputs <- colour_picker_srv(
@@ -67,7 +68,6 @@ srv_p_scatterplot <- function(id,
       req(color_inputs())
       within(
         data(),
-        filter_var = str2lang(filter_var),
         subject_var = str2lang(subject_var),
         x_var = str2lang(x_var),
         y_var = str2lang(y_var),
@@ -77,11 +77,13 @@ srv_p_scatterplot <- function(id,
         expr = {
           plot_data <- scatterplot_ds |>
             dplyr::select(subject_var, x_var, y_var, color_var) |>
-            dplyr::mutate(color_var = factor(color_var, levels = names(colors)))
+            dplyr::mutate(color_var = factor(color_var, levels = names(colors))) |>
+            dplyr::mutate(customdata = dplyr::row_number())
           p <- plotly::plot_ly(
             data = plot_data,
             x = ~x_var,
             y = ~y_var,
+            customdata = ~customdata,
             color = ~color_var,
             colors = colors,
             mode = "markers",
@@ -111,9 +113,25 @@ srv_p_scatterplot <- function(id,
     output$plot <- plotly::renderPlotly(plotly::event_register(
       {
         plotly_q()$p |>
-          setup_trigger_tooltips(session$ns)
+          setup_trigger_tooltips(session$ns) |>
+          set_plot_data(session$ns("plot_data"))
       },
       "plotly_selected"
     ))
+
+    plotly_selected <- reactive(plotly::event_data("plotly_selected", source = "scatterplot"))
+    reactive({
+      req(plotly_selected())
+      plotly_q() |>
+        within(
+          {
+            selected_plot_data <- plot_data |>
+              dplyr::filter(customdata %in% plotly_selected_customdata)
+            scatterplot_ds <- scatterplot_ds |>
+              filter(subject %in% selected_plot_data$subject)
+          },
+          plotly_selected_customdata = plotly_selected()$customdata
+        )
+    })
   })
 }