tdata to teal_data (#603)

Signed-off-by: kartikeya kirar <[email protected]> Co-authored-by: Aleksander Chlebowski <[email protected]> Co-authored-by: Aleksander Chlebowski <[email protected]> Co-authored-by: kartikeya kirar <[email protected]> Co-authored-by: vedhav <[email protected]>
insightsengineering · Dec 8, 2023 · 986891a · 986891a
1 parent bed6119
commit 986891a
Show file tree

Hide file tree

Showing 18 changed files with 238 additions and 285 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -21,7 +21,7 @@ Depends:
     R (>= 3.6),
     shiny (>= 1.6.0),
     shinyTree,
-    teal (>= 0.14.0.9019)
+    teal (>= 0.14.0.9027)
 Imports:
     checkmate (>= 2.1.0),
     dplyr (>= 1.0.5),
@@ -36,11 +36,11 @@ Imports:
     shinyWidgets (>= 0.5.1),
     stats,
     stringr (>= 1.4.1),
-    teal.code (>= 0.4.0),
+    teal.code (>= 0.4.1.9009),
     teal.logger (>= 0.1.1),
     teal.reporter (>= 0.2.0),
-    teal.slice (>= 0.4.0.9023),
-    teal.transform (>= 0.4.0.9007),
+    teal.slice (>= 0.4.0.9028),
+    teal.transform (>= 0.4.0.9011),
     teal.widgets (>= 0.4.0),
     tern (>= 0.7.10),
     tibble (>= 2.0.0),
@@ -65,7 +65,7 @@ Suggests:
     rlang (>= 1.0.0),
     rtables (>= 0.5.1),
     sparkline,
-    teal.data (>= 0.3.0.9010),
+    teal.data (>= 0.3.0.9018),
     testthat (>= 3.0.4)
 VignetteBuilder:
     knitr

diff --git a/NEWS.md b/NEWS.md
@@ -1,4 +1,4 @@
-# teal.modules.general 0.2.16.9012
+# teal.modules.general 0.2.16.9013
 
 ### Enhancements
 

diff --git a/R/tm_a_pca.R b/R/tm_a_pca.R
@@ -246,18 +246,19 @@ ui_a_pca <- function(id, ...) {
 srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, plot_width, ggplot2_args) {
   with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
   with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
-  checkmate::assert_class(data, "tdata")
+  checkmate::assert_class(data, "reactive")
+  checkmate::assert_class(isolate(data()), "teal_data")
   moduleServer(id, function(input, output, session) {
     response <- dat
 
     for (i in seq_along(response)) {
       response[[i]]$select$multiple <- FALSE
       response[[i]]$select$always_selected <- NULL
       response[[i]]$select$selected <- NULL
-      response[[i]]$select$choices <- var_labels(data[[response[[i]]$dataname]]())
+      response[[i]]$select$choices <- var_labels(isolate(data())[[response[[i]]$dataname]])
       response[[i]]$select$choices <- setdiff(
         response[[i]]$select$choices,
-        unlist(teal.data::join_keys(data)[[response[[i]]$dataname]])
+        unlist(teal.data::join_keys(isolate(data()))[[response[[i]]$dataname]])
       )
     }
 
@@ -322,13 +323,12 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl
 
     anl_merged_input <- teal.transform::merge_expression_srv(
       selector_list = selector_list,
-      datasets = data,
-      join_keys = teal.data::join_keys(data)
+      datasets = data
     )
 
     anl_merged_q <- reactive({
       req(anl_merged_input())
-      teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) %>%
+      data() %>%
         teal.code::eval_code(as.expression(anl_merged_input()$expr))
     })
 
@@ -1016,7 +1016,7 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl
           card$append_text("Comment", "header3")
           card$append_text(comment)
         }
-        card$append_src(paste(teal.code::get_code(output_q()), collapse = "\n"))
+        card$append_src(teal.code::get_code(output_q()))
         card
       }
       teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)

diff --git a/R/tm_a_regression.R b/R/tm_a_regression.R
@@ -246,7 +246,8 @@ srv_a_regression <- function(id,
                              default_outlier_label) {
   with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
   with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
-  checkmate::assert_class(data, "tdata")
+  checkmate::assert_class(data, "reactive")
+  checkmate::assert_class(isolate(data()), "teal_data")
   moduleServer(id, function(input, output, session) {
     rule_rvr1 <- function(value) {
       if (isTRUE(input$plot_type == "Response vs Regressor")) {
@@ -294,8 +295,7 @@ srv_a_regression <- function(id,
 
     anl_merged_input <- teal.transform::merge_expression_srv(
       selector_list = selector_list,
-      datasets = data,
-      join_keys = teal.data::join_keys(data)
+      datasets = data
     )
 
     regression_var <- reactive({
@@ -309,7 +309,7 @@ srv_a_regression <- function(id,
 
     anl_merged_q <- reactive({
       req(anl_merged_input())
-      teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) %>%
+      data() %>%
         teal.code::eval_code(as.expression(anl_merged_input()$expr))
     })
 
@@ -886,7 +886,7 @@ srv_a_regression <- function(id,
           card$append_text("Comment", "header3")
           card$append_text(comment)
         }
-        card$append_src(paste(teal.code::get_code(output_q()), collapse = "\n"))
+        card$append_src(teal.code::get_code(output_q()))
         card
       }
       teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)

diff --git a/R/tm_data_table.R b/R/tm_data_table.R
@@ -85,14 +85,13 @@ tm_data_table <- function(label = "Data Table",
     ui = ui_page_data_table,
     datanames = if (length(datasets_selected) == 0) "all" else datasets_selected,
     server_args = list(
+      variables_selected = variables_selected,
       datasets_selected = datasets_selected,
       dt_args = dt_args,
       dt_options = dt_options,
       server_rendering = server_rendering
     ),
     ui_args = list(
-      selected = variables_selected,
-      datasets_selected = datasets_selected,
       pre_output = pre_output,
       post_output = post_output
     )
@@ -102,20 +101,10 @@ tm_data_table <- function(label = "Data Table",
 
 # ui page module
 ui_page_data_table <- function(id,
-                               data,
-                               selected,
-                               datasets_selected,
                                pre_output = NULL,
                                post_output = NULL) {
   ns <- NS(id)
 
-  datanames <- names(data)
-
-  if (!identical(datasets_selected, character(0))) {
-    stopifnot(all(datasets_selected %in% datanames))
-    datanames <- datasets_selected
-  }
-
   shiny::tagList(
     include_css_files("custom"),
     teal.widgets::standard_layout(
@@ -134,45 +123,7 @@ ui_page_data_table <- function(id,
           class = "mb-8",
           column(
             width = 12,
-            do.call(
-              tabsetPanel,
-              lapply(
-                datanames,
-                function(x) {
-                  dataset <- isolate(data[[x]]())
-                  choices <- names(dataset)
-                  labels <- vapply(
-                    dataset,
-                    function(x) ifelse(is.null(attr(x, "label")), "", attr(x, "label")),
-                    character(1)
-                  )
-                  names(choices) <- ifelse(
-                    is.na(labels) | labels == "",
-                    choices,
-                    paste(choices, labels, sep = ": ")
-                  )
-                  selected <- if (!is.null(selected[[x]])) {
-                    selected[[x]]
-                  } else {
-                    utils::head(choices)
-                  }
-                  tabPanel(
-                    title = x,
-                    column(
-                      width = 12,
-                      div(
-                        class = "mt-4",
-                        ui_data_table(
-                          id = ns(x),
-                          choices = choices,
-                          selected = selected
-                        )
-                      )
-                    )
-                  )
-                }
-              )
-            )
+            uiOutput(ns("dataset_table"))
           )
         )
       ),
@@ -187,15 +138,63 @@ ui_page_data_table <- function(id,
 srv_page_data_table <- function(id,
                                 data,
                                 datasets_selected,
+                                variables_selected,
                                 dt_args,
                                 dt_options,
                                 server_rendering) {
-  checkmate::assert_class(data, "tdata")
+  checkmate::assert_class(data, "reactive")
+  checkmate::assert_class(isolate(data()), "teal_data")
   moduleServer(id, function(input, output, session) {
     if_filtered <- reactive(as.logical(input$if_filtered))
     if_distinct <- reactive(as.logical(input$if_distinct))
 
-    datanames <- names(data)
+    datanames <- teal.data::datanames(isolate(data()))
+    if (!identical(datasets_selected, character(0))) {
+      checkmate::assert_subset(datasets_selected, datanames)
+      datanames <- datasets_selected
+    }
+
+    output$dataset_table <- renderUI({
+      do.call(
+        tabsetPanel,
+        lapply(
+          datanames,
+          function(x) {
+            dataset <- isolate(data()[[x]])
+            choices <- names(dataset)
+            labels <- vapply(
+              dataset,
+              function(x) ifelse(is.null(attr(x, "label")), "", attr(x, "label")),
+              character(1)
+            )
+            names(choices) <- ifelse(
+              is.na(labels) | labels == "",
+              choices,
+              paste(choices, labels, sep = ": ")
+            )
+            variables_selected <- if (!is.null(variables_selected[[x]])) {
+              variables_selected[[x]]
+            } else {
+              utils::head(choices)
+            }
+            tabPanel(
+              title = x,
+              column(
+                width = 12,
+                div(
+                  class = "mt-4",
+                  ui_data_table(
+                    id = session$ns(x),
+                    choices = choices,
+                    selected = variables_selected
+                  )
+                )
+              )
+            )
+          }
+        )
+      )
+    })
 
     lapply(
       datanames,
@@ -256,14 +255,14 @@ srv_data_table <- function(id,
     iv <- shinyvalidate::InputValidator$new()
     iv$add_rule("variables", shinyvalidate::sv_required("Please select valid variable names"))
     iv$add_rule("variables", shinyvalidate::sv_in_set(
-      set = names(data[[dataname]]()), message_fmt = "Not all selected variables exist in the data"
+      set = names(data()[[dataname]]), message_fmt = "Not all selected variables exist in the data"
     ))
     iv$enable()
 
     output$data_table <- DT::renderDataTable(server = server_rendering, {
       teal::validate_inputs(iv)
 
-      df <- data[[dataname]]()
+      df <- data()[[dataname]]
       variables <- input$variables
 
       teal::validate_has_data(df, min_nrow = 1L, msg = paste("data", dataname, "is empty"))

diff --git a/R/tm_front_page.R b/R/tm_front_page.R
@@ -21,6 +21,7 @@
 #' data <- within(data, {
 #'   library(nestcolor)
 #'   ADSL <- teal.modules.general::rADSL
+#'   attr(ADSL, "metadata") <- list("Author" = "NEST team", "data_source" = "synthetic data")
 #' })
 #' datanames <- c("ADSL")
 #' datanames(data) <- datanames
@@ -167,7 +168,8 @@ get_footer_tags <- function(footnotes) {
 }
 
 srv_front_page <- function(id, data, tables, show_metadata) {
-  checkmate::assert_class(data, "tdata")
+  checkmate::assert_class(data, "reactive")
+  checkmate::assert_class(isolate(data()), "teal_data")
   moduleServer(id, function(input, output, session) {
     ns <- session$ns
 
@@ -193,9 +195,10 @@ srv_front_page <- function(id, data, tables, show_metadata) {
       )
 
       metadata_data_frame <- reactive({
+        datanames <- teal.data::datanames(data())
         convert_metadata_to_dataframe(
-          lapply(names(data), function(dataname) get_metadata(data, dataname)),
-          names(data)
+          lapply(datanames, function(dataname) attr(data()[[dataname]], "metadata")),
+          datanames
         )
       })
 

diff --git a/R/tm_g_association.R b/R/tm_g_association.R
@@ -222,7 +222,9 @@ srv_tm_g_association <- function(id,
                                  ggplot2_args) {
   with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
   with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
-  checkmate::assert_class(data, "tdata")
+  checkmate::assert_class(data, "reactive")
+  checkmate::assert_class(isolate(data()), "teal_data")
+
   moduleServer(id, function(input, output, session) {
     selector_list <- teal.transform::data_extract_multiple_srv(
       data_extract = list(ref = ref, vars = vars),
@@ -250,14 +252,12 @@ srv_tm_g_association <- function(id,
 
     anl_merged_input <- teal.transform::merge_expression_srv(
       datasets = data,
-      selector_list = selector_list,
-      join_keys = teal.data::join_keys(data)
+      selector_list = selector_list
     )
 
     anl_merged_q <- reactive({
       req(anl_merged_input())
-      teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) %>%
-        teal.code::eval_code(as.expression(anl_merged_input()$expr))
+      data() %>% teal.code::eval_code(as.expression(anl_merged_input()$expr))
     })
 
     merged <- list(
@@ -474,7 +474,7 @@ srv_tm_g_association <- function(id,
           card$append_text("Comment", "header3")
           card$append_text(comment)
         }
-        card$append_src(paste(teal.code::get_code(output_q()), collapse = "\n"))
+        card$append_src(teal.code::get_code(output_q()))
         card
       }
       teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)

diff --git a/R/tm_g_bivariate.R b/R/tm_g_bivariate.R
@@ -383,7 +383,8 @@ srv_g_bivariate <- function(id,
                             ggplot2_args) {
   with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
   with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
-  checkmate::assert_class(data, "tdata")
+  checkmate::assert_class(data, "reactive")
+  checkmate::assert_class(isolate(data()), "teal_data")
   moduleServer(id, function(input, output, session) {
     data_extract <- list(
       x = x, y = y, row_facet = row_facet, col_facet = col_facet,
@@ -440,13 +441,12 @@ srv_g_bivariate <- function(id,
 
     anl_merged_input <- teal.transform::merge_expression_srv(
       selector_list = selector_list,
-      datasets = data,
-      join_keys = teal.data::join_keys(data)
+      datasets = data
     )
 
     anl_merged_q <- reactive({
       req(anl_merged_input())
-      teal.code::new_qenv(tdata2env(data), code = get_code_tdata(data)) %>%
+      data() %>%
         teal.code::eval_code(as.expression(anl_merged_input()$expr))
     })
 
@@ -637,7 +637,7 @@ srv_g_bivariate <- function(id,
           card$append_text("Comment", "header3")
           card$append_text(comment)
         }
-        card$append_src(paste(teal.code::get_code(output_q()), collapse = "\n"))
+        card$append_src(teal.code::get_code(output_q()))
         card
       }
       teal.reporter::simple_reporter_srv("simple_reporter", reporter = reporter, card_fun = card_fun)