insightsengineering · mhallal1 · Jul 13, 2022 · Jul 11, 2022 · Jul 11, 2022 · Jul 11, 2022
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -50,6 +50,7 @@ Imports:
     SummarizedExperiment,
     teal.data (>= 0.1.1),
     teal.logger (>= 0.1.0),
+    teal.reporter (>= 0.1.0),
     teal.widgets (>= 0.1.1),
     tern (>= 0.7.8)
 Suggests:

diff --git a/NEWS.md b/NEWS.md
@@ -3,6 +3,7 @@
 # teal.modules.hermes 0.1.3
 
 * Improve the selection of sample variables in the forest module (`tm_g_forest_tte`) such that only categorical variables can be selected in the first place.
+* Added the `teal.reporter` functionality to all modules.
 
 ### Miscellaneous
 * Added a template to the `pkgdown` site.

diff --git a/R/argument_convention.R b/R/argument_convention.R
@@ -33,6 +33,7 @@
 #' @param summary_funs (named `list` of functions or `NULL`)\cr functions which can be used
 #'   in the the gene signatures. For modules that support also multiple genes without
 #'   summary, `NULL` can be included to not summarize the genes but provide all of them.
+#' @param reporter (`Reporter`) object
 #' @param pre_output (`shiny.tag` or `NULL`)\cr
 #'   placed before the output to put the output into context (for example a title).
 #' @param post_output (`shiny.tag` or `NULL`)\cr

diff --git a/R/barplot.R b/R/barplot.R
@@ -76,6 +76,14 @@ ui_g_barplot <- function(id,
   ns <- NS(id)
   teal.widgets::standard_layout(
     encoding = div(
+      ### Reporter
+      shiny::tags$div(
+        teal.reporter::add_card_button_ui(ns("addReportCard")),
+        teal.reporter::download_report_button_ui(ns("downloadButton")),
+        teal.reporter::reset_report_button_ui(ns("resetButton"))
+      ),
+      shiny::tags$br(),
+      ###
       tags$label("Encodings", class = "text-primary"),
       helpText("Analysis of MAE:", tags$code(mae_name)),
       experimentSpecInput(ns("experiment"), datasets, mae_name),
@@ -112,9 +120,11 @@ ui_g_barplot <- function(id,
 #' @export
 srv_g_barplot <- function(id,
                           datasets,
+                          reporter,
                           mae_name,
                           exclude_assays,
                           summary_funs) {
+  with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
   moduleServer(id, function(input, output, session) {
     experiment <- experimentSpecServer(
       "experiment",
@@ -137,7 +147,7 @@ srv_g_barplot <- function(id,
       gene_choices = experiment$genes
     )
 
-    output$plot <- renderPlot({
+    plot_r <- reactive({
       # Resolve all reactivity.
       experiment_data <- multi$experiment_data()
       facet_var <- multi$vars$facet()
@@ -171,6 +181,55 @@ srv_g_barplot <- function(id,
         percentiles = percentiles
       )
     })
+    output$plot <- renderPlot(plot_r())
+    ### REPORTER
+    if (with_reporter) {
+      card_fun <- function(comment) {
+        card <- teal.reporter::TealReportCard$new()
+        card$set_name("Barplot")
+        card$append_text("Barplot", "header2")
+        card$append_text("Filter State", "header3")
+        card$append_fs(datasets$get_filter_state())
+        card$append_text("Selected Options", "header3")
+        encodings_list <- list(
+          "Experiment:",
+          input$`experiment-name`,
+          "\nAssay:",
+          input$`assay-name`,
+          "\nFacetting Variable:",
+          input$`facet-sample_var`,
+          "\nGenes Selected:",
+          paste0(input$`x-genes`, collapse = ", "),
+          "\nGene Summary:",
+          input$`x-fun_name`,
+          "\nQuantiles:",
+          paste0(input$percentiles, collapse = ", "),
+          "\nOptional Fill Variable:",
+          input$`fill-sample_var`
+        )
+        null_encodings_indices <- which(sapply(encodings_list, function(x) is.null(x) || x == ""))
+        final_encodings <- if (length(null_encodings_indices) > 0) {
+          null_encodings_indices_1 <- c(null_encodings_indices, null_encodings_indices - 1)
+          paste(encodings_list[-null_encodings_indices_1], collapse = " ")
+        } else {
+          paste(encodings_list, collapse = " ")
+        }
+
+        card$append_text(final_encodings, style = "verbatim")
+        card$append_text("Plot", "header3")
+        card$append_plot(plot_r())
+        if (!comment == "") {
+          card$append_text("Comment", "header3")
+          card$append_text(comment)
+        }
+        card
+      }
+
+      teal.reporter::add_card_button_srv("addReportCard", reporter = reporter, card_fun = card_fun)
+      teal.reporter::download_report_button_srv("downloadButton", reporter = reporter)
+      teal.reporter::reset_report_button_srv("resetButton", reporter)
+    }
+    ###
   })
 }
 

diff --git a/R/boxplot.R b/R/boxplot.R
@@ -78,6 +78,14 @@ ui_g_boxplot <- function(id,
 
   teal.widgets::standard_layout(
     encoding = div(
+      ### Reporter
+      shiny::tags$div(
+        teal.reporter::add_card_button_ui(ns("addReportCard")),
+        teal.reporter::download_report_button_ui(ns("downloadButton")),
+        teal.reporter::reset_report_button_ui(ns("resetButton"))
+      ),
+      shiny::tags$br(),
+      ###
       tags$label("Encodings", class = "text-primary"),
       helpText("Analysis of MAE:", tags$code(mae_name)),
       experimentSpecInput(ns("experiment"), datasets, mae_name),
@@ -109,9 +117,11 @@ ui_g_boxplot <- function(id,
 #' @export
 srv_g_boxplot <- function(id,
                           datasets,
+                          reporter,
                           mae_name,
                           exclude_assays,
                           summary_funs) {
+  with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
   moduleServer(id, function(input, output, session) {
     experiment <- experimentSpecServer(
       "experiment",
@@ -133,7 +143,7 @@ srv_g_boxplot <- function(id,
       funs = summary_funs,
       gene_choices = experiment$genes
     )
-    output$plot <- renderPlot({
+    plot_r <- reactive({
       # Resolve all reactivity.
       experiment_data <- multi$experiment_data()
       strat <- multi$vars$strat()
@@ -167,6 +177,62 @@ srv_g_boxplot <- function(id,
         violin = violin
       )
     })
+    output$plot <- renderPlot(plot_r())
+
+    ### REPORTER
+    if (with_reporter) {
+      card_fun <- function(comment) {
+        card <- teal.reporter::TealReportCard$new()
+        card$set_name("Boxplot")
+        card$append_text("Boxplot", "header2")
+        card$append_text("Filter State", "header3")
+        card$append_fs(datasets$get_filter_state())
+        card$append_text("Selected Options", "header3")
+        encodings_list <- list(
+          "Experiment:",
+          input$`experiment-name`,
+          "\nAssay:",
+          input$`assay-name`,
+          "\nFacetting Variable:",
+          input$`facet-sample_var`,
+          "\nGenes Selected:",
+          paste0(input$`genes-genes`, collapse = ", "),
+          "\nGene Summary:",
+          input$`genes-fun_name`,
+          "\nJitter:",
+          input$jitter,
+          "\nViolin:",
+          input$violin,
+          "\nOptional Stratifying Variable:",
+          input$`strat-sample_var`,
+          "\nOptional Color Variable:",
+          input$`color-sample_var`,
+          "\nOptional Facet Variable:",
+          input$`facet-sample_var`
+        )
+        null_encodings_indices <- which(sapply(encodings_list, function(x) is.null(x) || x == ""))
+        final_encodings <- if (length(null_encodings_indices) > 0) {
+          null_encodings_indices_1 <- c(null_encodings_indices, null_encodings_indices - 1)
+          paste(encodings_list[-null_encodings_indices_1], collapse = " ")
+        } else {
+          paste(encodings_list, collapse = " ")
+        }
+
+        card$append_text(final_encodings, style = "verbatim")
+        card$append_text("Plot", "header3")
+        card$append_plot(plot_r())
+        if (!comment == "") {
+          card$append_text("Comment", "header3")
+          card$append_text(comment)
+        }
+        card
+      }
+
+      teal.reporter::add_card_button_srv("addReportCard", reporter = reporter, card_fun = card_fun)
+      teal.reporter::download_report_button_srv("downloadButton", reporter = reporter)
+      teal.reporter::reset_report_button_srv("resetButton", reporter)
+    }
+    ###
   })
 }
 

diff --git a/R/forestplot.R b/R/forestplot.R
@@ -104,6 +104,14 @@ ui_g_forest_tte <- function(id,
   ns <- NS(id)
   teal.widgets::standard_layout(
     encoding = div(
+      ### Reporter
+      shiny::tags$div(
+        teal.reporter::add_card_button_ui(ns("addReportCard")),
+        teal.reporter::download_report_button_ui(ns("downloadButton")),
+        teal.reporter::reset_report_button_ui(ns("resetButton"))
+      ),
+      shiny::tags$br(),
+      ###
       tags$label("Encodings", class = "text-primary"),
       helpText("Analysis of MAE:", tags$code(mae_name)),
       experimentSpecInput(ns("experiment"), datasets, mae_name),
@@ -132,13 +140,15 @@ ui_g_forest_tte <- function(id,
 #' @export
 srv_g_forest_tte <- function(id,
                              datasets,
+                             reporter,
                              adtte_name,
                              mae_name,
                              adtte_vars,
                              exclude_assays,
                              summary_funs,
                              plot_height,
                              plot_width) {
+  with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
   moduleServer(id, function(input, output, session) {
     experiment <- experimentSpecServer(
       "experiment",
@@ -210,12 +220,61 @@ srv_g_forest_tte <- function(id,
       tern::g_forest(result)
     })
 
-    teal.widgets::plot_with_settings_srv(
+    pws <- teal.widgets::plot_with_settings_srv(
       id = "plot",
       plot_r = forest_plot,
       height = plot_height,
       width = plot_width
     )
+
+    ### REPORTER
+    if (with_reporter) {
+      card_fun <- function(comment) {
+        card <- teal.reporter::TealReportCard$new()
+        card$set_name("Forest Plot")
+        card$append_text("Forest Plot", "header2")
+        card$append_text("Filter State", "header3")
+        card$append_fs(datasets$get_filter_state())
+        card$append_text("Selected Options", "header3")
+        encodings_list <- list(
+          "Experiment:",
+          input$`experiment-name`,
+          "\nAssay:",
+          input$`assay-name`,
+          "\nGenes Selected:",
+          paste0(input$`genes-genes`, collapse = ", "),
+          "\nGene Summary:",
+          input$`genes-fun_name`,
+          "\nEndpoint:",
+          input$`adtte-paramcd`,
+          "\nProbability Cutoff:",
+          input$probs,
+          "\nSubgroup Variable:",
+          input$`subgroups-sample_var`
+        )
+        null_encodings_indices <- which(sapply(encodings_list, function(x) is.null(x) || x == ""))
+        final_encodings <- if (length(null_encodings_indices) > 0) {
+          null_encodings_indices_1 <- c(null_encodings_indices, null_encodings_indices - 1)
+          paste(encodings_list[-null_encodings_indices_1], collapse = " ")
+        } else {
+          paste(encodings_list, collapse = " ")
+        }
+
+        card$append_text(final_encodings, style = "verbatim")
+        card$append_text("Plot", "header3")
+        card$append_plot(forest_plot(), dim = pws$dim())
+        if (!comment == "") {
+          card$append_text("Comment", "header3")
+          card$append_text(comment)
+        }
+        card
+      }
+
+      teal.reporter::add_card_button_srv("addReportCard", reporter = reporter, card_fun = card_fun)
+      teal.reporter::download_report_button_srv("downloadButton", reporter = reporter)
+      teal.reporter::reset_report_button_srv("resetButton", reporter)
+    }
+    ###
   })
 }