Redesign of teal.reporter Cards

DESCRIPTION

@@ -84,9 +84,9 @@ VignetteBuilder:
     knitr,
     rmarkdown
 Remotes:
-    insightsengineering/teal.reporter@main,
+    insightsengineering/teal.reporter@redesign@main,
     insightsengineering/teal.widgets@main,
-    insightsengineering/teal@main
+    insightsengineering/teal@redesign@main
 Config/Needs/verdepcheck: haleyjeppson/ggmosaic, tidyverse/ggplot2,
     rstudio/shiny, insightsengineering/teal,
     insightsengineering/teal.slice, insightsengineering/teal.transform,

R/tm_a_pca.R

@@ -235,9 +235,6 @@ ui_a_pca <- function(id, ...) {
         uiOutput(ns("all_plots"))
       ),
       encoding = tags$div(
-        ### Reporter
-        teal.reporter::simple_reporter_ui(ns("simple_reporter")),
-        ###
         tags$label("Encodings", class = "text-primary"),
         teal.transform::datanames_input(args["dat"]),
         teal.transform::data_extract_ui(
@@ -478,7 +475,7 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl
     })
 
     # computation ----
-    computation <- reactive({
+    computation_model <- reactive({
       validation()
 
       # inputs
@@ -504,24 +501,26 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl
         )
       }
 
-      qenv <- teal.code::eval_code(
+      teal.code::eval_code(
         qenv,
         substitute(
           expr = pca <- summary(stats::prcomp(ANL[keep_columns], center = center, scale. = scale, retx = TRUE)),
           env = list(center = center, scale = scale)
         )
       )
-
-      qenv <- teal.code::eval_code(
-        qenv,
+    })
+    computation_tbl_imp <- reactive({
+      teal.code::eval_code(
+        computation_model(),
         quote({
           tbl_importance <- dplyr::as_tibble(pca$importance, rownames = "Metric")
           tbl_importance
         })
       )
-
+    })
+    computation <- reactive({
       teal.code::eval_code(
-        qenv,
+        computation_tbl_imp(),
         quote({
           tbl_eigenvector <- dplyr::as_tibble(pca$rotation, rownames = "Variable")
           tbl_eigenvector
@@ -1124,6 +1123,58 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl
     })
 
     # Render R code.
+    subset_code <- function(code, data) {
+      gsub(code, "", teal.data::get_code(data), fixed = TRUE)
+    }
+    setup_code_r <- reactive(teal.data::get_code(req(data())))
+    libraries_code_r <-
+      reactive(
+        subset_code(
+          setup_code_r(),
+          qenv
+        )
+      )
+
+    data_prep_code_r <-
+      reactive(
+        subset_code(
+          paste0(setup_code_r(), libraries_code_r()),
+          req(anl_merged_q())
+        )
+      )
+
+    computation_model_code_r <-
+      reactive(
+        subset_code(
+          paste0(setup_code_r(), data_prep_code_r()),
+          req(computation_model())
+        )
+      )
+
+    computation_tbl_imp_code_r <-
+      reactive(
+        subset_code(
+          paste0(setup_code_r(), data_prep_code_r(), computation_model_code_r()),
+          req(computation_tbl_imp())
+        )
+      )
+
+    computation_tbl_eig_code_r <-
+      reactive(
+        subset_code(
+          paste0(setup_code_r(), data_prep_code_r(), computation_model_code_r(), computation_tbl_imp_code_r()),
+          req(computation())
+        )
+      )
+
+    plot_code_r <-
+      reactive(
+        subset_code(
+          paste0(setup_code_r(), data_prep_code_r(), computation_model_code_r(), computation_tbl_imp_code_r(), computation_tbl_eig_code_r()),
+          req(decorated_output_q())
+        )
+      )
+
     source_code_r <- reactive(teal.code::get_code(req(decorated_output_q())))
 
     teal.widgets::verbatim_popup_srv(
@@ -1132,30 +1183,43 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl
       title = "R Code for PCA"
     )
 
-    ### REPORTER
-    if (with_reporter) {
-      card_fun <- function(comment, label) {
-        card <- teal::report_card_template(
-          title = "Principal Component Analysis Plot",
-          label = label,
-          with_filter = with_filter,
-          filter_panel_api = filter_panel_api
-        )
-        card$append_text("Principal Components Table", "header3")
-        card$append_table(computation()[["tbl_importance"]])
-        card$append_text("Eigenvectors Table", "header3")
-        card$append_table(computation()[["tbl_eigenvector"]])
-        card$append_text("Plot", "header3")
-        card$append_plot(plot_r(), dim = pws$dim())
-        if (!comment == "") {
-          card$append_text("Comment", "header3")
-          card$append_text(comment)
-        }
-        card$append_src(source_code_r())
-        card
-      }
-      teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
-    }
+    card_fun <- reactive({
+      req(setup_code_r(), data_prep_code_r(), computation_model_code_r(), computation(),
+          computation_tbl_imp_code_r(), computation_tbl_eig_code_r(), plot_code_r(), plot_r())
+
+      teal.reporter::report_document(
+
+        "## Setup",
+        teal.reporter::code_chunk(setup_code_r()),
+
+        "## Libraries",
+        teal.reporter::code_chunk(libraries_code_r(), eval = TRUE),
+
+        "## Data Preparations",
+        teal.reporter::code_chunk(data_prep_code_r()),
+
+        "## PCA Model",
+        teal.reporter::code_chunk(computation_model_code_r()),
+
+        "### Principal Components Table",
+        teal.reporter::code_chunk(computation_tbl_imp_code_r()),
+        computation()[["tbl_importance"]],
+
+        "### Eigenvectors Table",
+        teal.reporter::code_chunk(computation_tbl_eig_code_r()),
+        computation()[["tbl_eigenvector"]],
+
+        "### Plot",
+        teal.reporter::code_chunk(
+          plot_code_r() |> styler::style_text() |> paste(collapse = "\n")
+        ),
+        plot_r()
+      )
+    })
+
     ###
+    list(
+      report_card = card_fun
+    )
   })
 }

R/tm_a_regression.R

@@ -285,9 +285,6 @@ ui_a_regression <- function(id, ...) {
       tags$div(verbatimTextOutput(ns("text")))
     )),
     encoding = tags$div(
-      ### Reporter
-      teal.reporter::simple_reporter_ui(ns("simple_reporter")),
-      ###
       tags$label("Encodings", class = "text-primary"), tags$br(),
       teal.transform::datanames_input(args[c("response", "regressor")]),
       teal.transform::data_extract_ui(
@@ -386,16 +383,15 @@ ui_a_regression <- function(id, ...) {
 # Server function for the regression module
 srv_a_regression <- function(id,
                              data,
-                             reporter,
                              filter_panel_api,
                              response,
                              regressor,
+                             reporter,
                              plot_height,
                              plot_width,
                              ggplot2_args,
                              default_outlier_label,
                              decorators) {
-  with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
   with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
   checkmate::assert_class(data, "reactive")
   checkmate::assert_class(isolate(data()), "teal_data")
@@ -473,6 +469,7 @@ srv_a_regression <- function(id,
         teal.code::eval_code(as.expression(anl_merged_input()$expr))
     })
 
+
     # sets qenv object and populates it with data merge call and fit expression
     fit_r <- reactive({
       ANL <- anl_merged_q()[["ANL"]]
@@ -1027,6 +1024,39 @@ srv_a_regression <- function(id,
     })
 
     # Render R code.
+    subset_code <- function(code, data) {
+      gsub(code, "", teal.data::get_code(data), fixed = TRUE)
+    }
+    setup_code_r <- reactive(teal.data::get_code(req(data())))
+    libraries_code_r <-
+      reactive(
+        subset_code(
+          setup_code_r(),
+          qenv
+        )
+      )
+    data_prep_code_r <-
+      reactive(
+        subset_code(
+          paste0(setup_code_r(), libraries_code_r()),
+          req(anl_merged_q())
+        )
+      )
+    fit_code_r <-
+      reactive(
+        subset_code(
+          paste0(setup_code_r(), libraries_code_r(), data_prep_code_r()),
+          req(fit_r())
+        )
+      )
+    plot_code_r <-
+      reactive(
+        subset_code(
+          paste0(setup_code_r(), libraries_code_r(), data_prep_code_r(), fit_code_r()),
+          req(decorated_output_q())
+        )
+      )
+
     source_code_r <- reactive(teal.code::get_code(req(decorated_output_q())))
 
     teal.widgets::verbatim_popup_srv(
@@ -1036,25 +1066,58 @@ srv_a_regression <- function(id,
     )
 
     ### REPORTER
-    if (with_reporter) {
-      card_fun <- function(comment, label) {
-        card <- teal::report_card_template(
-          title = "Linear Regression Plot",
-          label = label,
-          with_filter = with_filter,
-          filter_panel_api = filter_panel_api
-        )
-        card$append_text("Plot", "header3")
-        card$append_plot(plot_r(), dim = pws$dim())
-        if (!comment == "") {
-          card$append_text("Comment", "header3")
-          card$append_text(comment)
-        }
-        card$append_src(source_code_r())
-        card
-      }
-      teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)
-    }
+    card_fun <- reactive({
+      req(plot_r(), plot_code_r(), setup_code_r(), data_prep_code_r(), fit_code_r(), fitted())
+      teal.reporter::report_document(
+
+        "## Setup",
+        teal.reporter::code_chunk(setup_code_r()),
+
+        "## Libraries",
+        teal.reporter::code_chunk(libraries_code_r(), eval = TRUE),
+
+        "## Data Preparations",
+        teal.reporter::code_chunk(data_prep_code_r()),
+
+        "## Model",
+        teal.reporter::code_chunk(fit_code_r()),
+        teal.reporter::code_output(
+          paste(utils::capture.output(summary(teal.code::dev_suppress(fitted())))[-1],
+              collapse = "\n"
+          )
+        ),
+
+        "## Plot",
+        teal.reporter::code_chunk(
+          plot_code_r() |> styler::style_text() |> paste(collapse = "\n")
+        ),
+        plot_r(),
+
+        "## rtables for testing",
+        teal.reporter::code_chunk(
+          "rtables::rtable(
+          header = LETTERS[1:3],
+          rtables::rrow('one to three', 1, 2, 3),
+          rtables::rrow('more stuff', rtables::rcell(pi, format = 'xx.xx'), 'test', 'and more')
+          )"
+        ),
+        rtables::rtable(
+          header = LETTERS[1:3],
+          rtables::rrow("one to three", 1, 2, 3),
+          rtables::rrow("more stuff", rtables::rcell(pi, format = "xx.xx"), "test", "and more")
+        ),
+
+        "## Table for testing",
+        teal.reporter::code_chunk(
+          "head(iris)"
+        ),
+        head(iris)
+      )
+    })
     ###
+
+    list(
+      report_card = card_fun
+    )
   })
 }