898 save app state version 3

.lintr

@@ -2,5 +2,6 @@ linters: linters_with_defaults(
   line_length_linter = line_length_linter(120),
   cyclocomp_linter = NULL,
   object_usage_linter = NULL,
-  object_name_linter = object_name_linter(styles = c("snake_case", "symbols"), regexes = c(ANL = "^ANL_?[0-9A-Z_]*$", ADaM = "^r?AD[A-Z]{2,3}_?[0-9]*$"))
+  object_name_linter = object_name_linter(styles = c("snake_case", "symbols"), regexes = c(ANL = "^ANL_?[0-9A-Z_]*$", ADaM = "^r?AD[A-Z]{2,3}_?[0-9]*$")),
+  indentation_linter = NULL
   )

R/tm_a_pca.R

@@ -161,7 +161,7 @@ tm_a_pca <- function(label = "Principal Component Analysis",
 
   data_extract_list <- list(dat = dat)
 
-  module(
+  ans <- module(
     label = label,
     server = srv_a_pca,
     ui = ui_a_pca,
@@ -176,6 +176,8 @@ tm_a_pca <- function(label = "Principal Component Analysis",
     ),
     datanames = teal.transform::get_extract_datanames(data_extract_list)
   )
+  attr(ans, "teal_bookmarkable") <- FALSE
+  ans
 }
 
 # UI function for the PCA module
@@ -753,7 +755,11 @@ srv_a_pca <- function(id, data, reporter, filter_panel_api, dat, plot_height, pl
         dev_labs <- list(color = varname_w_label(resp_col, ANL))
 
         scales_biplot <-
-          if (is.character(response) || is.factor(response) || (is.numeric(response) && length(unique(response)) <= 6)) { # nolint: line_length.
+          if (
+            is.character(response) ||
+              is.factor(response) ||
+              (is.numeric(response) && length(unique(response)) <= 6)
+          ) {
             qenv <- teal.code::eval_code(
               qenv,
               quote(pca_rot$response <- as.factor(response))

R/tm_a_regression.R

@@ -225,7 +225,7 @@ tm_a_regression <- function(label = "Regression Analysis",
     response = response
   )
 
-  module(
+  ans <- module(
     label = label,
     server = srv_a_regression,
     ui = ui_a_regression,
@@ -241,6 +241,8 @@ tm_a_regression <- function(label = "Regression Analysis",
     ),
     datanames = teal.transform::get_extract_datanames(data_extract_list)
   )
+  attr(ans, "teal_bookmarkable") <- FALSE
+  ans
 }
 
 # UI function for the regression module
@@ -370,6 +372,8 @@ srv_a_regression <- function(id,
   checkmate::assert_class(data, "reactive")
   checkmate::assert_class(isolate(data()), "teal_data")
   moduleServer(id, function(input, output, session) {
+    ns <- session$ns
+
     rule_rvr1 <- function(value) {
       if (isTRUE(input$plot_type == "Response vs Regressor")) {
         if (length(value) > 1L) {
@@ -472,7 +476,7 @@ srv_a_regression <- function(id,
           session = session,
           inputId = "label_var",
           choices = opts,
-          selected = selected
+          selected = restoreInput(ns("label_var"), selected)
         )
 
         data <- fortify(stats::lm(form, data = ANL))
@@ -484,7 +488,7 @@ srv_a_regression <- function(id,
           inputId = "outlier",
           min = 1,
           max = max_outlier,
-          value = if (cur_outlier < max_outlier) cur_outlier else max_outlier * .9
+          value = restoreInput(ns("outlier"), if (cur_outlier < max_outlier) cur_outlier else max_outlier * .9)
         )
       }
 

R/tm_data_table.R

@@ -116,7 +116,7 @@ tm_data_table <- function(label = "Data Table",
   checkmate::assert_multi_class(post_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE)
   # End of assertions
 
-  module(
+  ans <- module(
     label,
     server = srv_page_data_table,
     ui = ui_page_data_table,
@@ -133,6 +133,8 @@ tm_data_table <- function(label = "Data Table",
       post_output = post_output
     )
   )
+  attr(ans, "teal_bookmarkable") <- TRUE
+  ans
 }
 
 # UI page module
@@ -196,41 +198,44 @@ srv_page_data_table <- function(id,
     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,
-                tags$div(
-                  class = "mt-4",
-                  ui_data_table(
-                    id = session$ns(x),
-                    choices = choices,
-                    selected = variables_selected
+        c(
+          list(id = session$ns("dataname_tab")),
+          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
+                    )
                   )
                 )
               )
-            )
-          }
+            }
+          )
         )
       )
     })
@@ -296,7 +301,7 @@ 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(isolate(data())[[dataname]]), message_fmt = "Not all selected variables exist in the data"
     ))
     iv$enable()
 

R/tm_file_viewer.R

@@ -82,14 +82,16 @@ tm_file_viewer <- function(label = "File Viewer Module",
   # Make UI args
   args <- as.list(environment())
 
-  module(
+  ans <- module(
     label = label,
     server = srv_viewer,
     server_args = list(input_path = input_path),
     ui = ui_viewer,
     ui_args = args,
     datanames = NULL
   )
+  attr(ans, "teal_bookmarkable") <- FALSE
+  ans
 }
 
 # UI function for the file viewer module

R/tm_front_page.R

@@ -81,14 +81,16 @@ tm_front_page <- function(label = "Front page",
   # Make UI args
   args <- as.list(environment())
 
-  module(
+  ans <- module(
     label = label,
     server = srv_front_page,
     ui = ui_front_page,
     ui_args = args,
     server_args = list(tables = tables, show_metadata = show_metadata),
     datanames = if (show_metadata) "all" else NULL
   )
+  attr(ans, "teal_bookmarkable") <- TRUE
+  ans
 }
 
 # UI function for the front page module
@@ -137,6 +139,8 @@ srv_front_page <- function(id, data, tables, show_metadata) {
   moduleServer(id, function(input, output, session) {
     ns <- session$ns
 
+    setBookmarkExclude("metadata_button")
+
     lapply(seq_along(tables), function(idx) {
       output[[paste0("table_", idx)]] <- renderTable(
         tables[[idx]],

R/tm_g_association.R

@@ -177,7 +177,7 @@ tm_g_association <- function(label = "Association",
     vars = vars
   )
 
-  module(
+  ans <- module(
     label = label,
     server = srv_tm_g_association,
     ui = ui_tm_g_association,
@@ -188,6 +188,8 @@ tm_g_association <- function(label = "Association",
     ),
     datanames = teal.transform::get_extract_datanames(data_extract_list)
   )
+  attr(ans, "teal_bookmarkable") <- TRUE
+  ans
 }
 
 # UI function for the association module

R/tm_g_bivariate.R

@@ -288,7 +288,7 @@ tm_g_bivariate <- function(label = "Bivariate Plots",
     size = size
   )
 
-  module(
+  ans <- module(
     label = label,
     server = srv_g_bivariate,
     ui = ui_g_bivariate,
@@ -299,6 +299,8 @@ tm_g_bivariate <- function(label = "Bivariate Plots",
     ),
     datanames = teal.transform::get_extract_datanames(data_extract_list)
   )
+  attr(ans, "teal_bookmarkable") <- TRUE
+  ans
 }
 
 # UI function for the bivariate module
@@ -463,6 +465,8 @@ srv_g_bivariate <- function(id,
   checkmate::assert_class(data, "reactive")
   checkmate::assert_class(isolate(data()), "teal_data")
   moduleServer(id, function(input, output, session) {
+    ns <- session$ns
+
     data_extract <- list(
       x = x, y = y, row_facet = row_facet, col_facet = col_facet,
       color = color, fill = fill, size = size
@@ -586,7 +590,7 @@ srv_g_bivariate <- function(id,
         }
       } else {
         shinyjs::hide("add_lines")
-        updateCheckboxInput(session, "add_lines", value = FALSE)
+        updateCheckboxInput(session, "add_lines", value = restoreInput(ns("add_lines"), FALSE))
         shinyjs::hide("alpha")
         shinyjs::hide("fixed_size")
         shinyjs::hide("size_settings")