Preprocess heavy computations before run_app()

NAMESPACE

@@ -9,6 +9,7 @@ S3method(create_table,default)
 S3method(create_table,general)
 S3method(create_table,medical_history)
 S3method(create_table,medication)
+export(check_appdata)
 export(collapse_column_vals)
 export(create_clinsight_config)
 export(create_clinsight_metadata)
@@ -17,12 +18,15 @@ export(db_create)
 export(db_get_query)
 export(db_update)
 export(get_appdata)
+export(get_available_data)
 export(get_base_value)
 export(get_db_connection)
+export(get_meta_vars)
 export(get_metadata)
 export(get_raw_csv_data)
 export(get_review_data)
 export(get_test_results)
+export(get_timeline_data)
 export(key_columns)
 export(merge_meta_with_data)
 export(run_app)

NEWS.md

@@ -15,6 +15,10 @@
 - Added additional navigation buttons next to the tabs to easier navigate between common forms and study forms (#255).
 - Add toggle to enable text wrapping in tables.
 - The timeline is now available in all forms, and can be toggled on or off (#1007).
+- - Moved `app_data`, `app_vars`, `timeline_data` & `available_data` to pre-processing step so that doesn't need to compute every session.
+- Export functions used to create the data objects above ^^^.
+- Started using parquet read / writes for `merged_data`, `timeline_data` & `available_data` to speed startup time.
+
 
 ## Bug fixes 
 

R/app_server.R

@@ -18,14 +18,25 @@ app_server <- function(
     output, 
     session
 ){
+
+  # Read in pre-processed R objects
+  # merged_data <- golem::get_golem_options("data")
   meta <- golem::get_golem_options("meta")
-  merged_data <- golem::get_golem_options("data")
+  app_data <- golem::get_golem_options("app_data")
+  app_vars <- golem::get_golem_options("app_vars")
+  # app_tables <- golem::get_golem_options("app_tables")
+  timeline_data <- golem::get_golem_options("timeline_data")
+  available_data <- golem::get_golem_options("available_data")
   user_db <- golem::get_golem_options("user_db")
   credentials_db <- golem::get_golem_options("credentials_db")
 
-  app_data <- get_appdata(merged_data, meta = meta)
-  app_vars <- get_meta_vars(data = app_data, meta = meta)
-  check_appdata(app_data, meta)
+  # app_data <- get_appdata(merged_data, meta = meta)
+  # app_vars <- get_meta_vars(data = app_data, meta = meta)
+  # app_tables <- lapply(
+  #   setNames(names(app_data), names(app_data)), \(x){
+  #     create_table(app_data[[x]], expected_columns = names(app_vars$items[[x]]))
+  #   })
+  # check_appdata(app_data, meta)
 
   session$userData$pending_review_records <- reactiveValues()
   session$userData$pending_form_review_status <- reactiveValues()
@@ -39,14 +50,16 @@ app_server <- function(
   )
 
   # For query item selector drop-down menus:
-  available_data <- get_available_data(
-    data = app_data,
-    form_repeat_name = with(
-      meta[["table_names"]], 
-      table_name[raw_name == "form_repeat"]
-      ) |> 
-      tryCatch(error = \(e) "N")
-  )
+  # available_data <- get_available_data(
+  #   data = app_data,
+  #   tables = app_tables,            # outdated arg
+  #   all_forms = app_vars$all_forms, # outdated arg
+  #   form_repeat_name = with(
+  #     meta[["table_names"]],
+  #     table_name[raw_name == "form_repeat"]
+  #     ) |>
+  #     tryCatch(error = \(e) "N")
+  # )
 
   # For summary review data:
   static_overview_data <- get_static_overview_data(
@@ -58,11 +71,11 @@ app_server <- function(
   )
 
   # For timeline data
-  timeline_data <-get_timeline_data(
-    app_data,
-    available_data = available_data,
-    treatment_label = meta$settings$treatment_label %||% "\U1F48A T\U2093"
-  )
+  # timeline_data <- get_timeline_data(
+  #   app_data,
+  #   available_data = available_data,
+  #   treatment_label = meta$settings$treatment_label %||% "\U1F48A T\U2093"
+  # )
 
   # think of using the pool package, but functions such as row_update are not yet supported.
   r <- reactiveValues(

R/data.R

@@ -95,6 +95,100 @@
 #'   system.file("raw_data", package = "clinsight")))`.
 "clinsightful_data"
 
+
+#' Application Metadata
+#'
+#' A list of data frames and settings containing metadata that will be used for
+#' the application. The metadata will be merged with raw data. It controls
+#' the variables that will be used in the application, and in which tab the
+#' variables will be shown. The goal is that most, if not all, study-specific
+#' data will be captured in the metadata, leaving the scripts to run the
+#' application largely unaltered between studies. See `vignette("Metadata")` for
+#' in-depth information.
+#'
+#' @format `metadata`: A list with `r length(metadata)` objects.
+#'
+#' @source Can be created with an Excel file. The Excel file format is chosen so
+#'   that the metadata can be changed easily per study. See
+#'   `raw-data/metadata.R` for details.
+"metadata"
+
+
+#' Application Data
+#'
+#' A list of data frames split by `item_group`. It is currently
+#' not needed to provide the application data in this format. However, the
+#' function can be useful for clinsight data customization, especially in
+#' combination with [create_table()]. It creates table classes of the
+#' `item_group` name (in lower case letters, and all punctuation replaced by an
+#' underscore), as long as there is a method available with the corresponding
+#' item_group name for the function [create_table()]. If all data is of type
+#' 'continuous', then laboratory values such as lab limits and units are
+#' cleaned.
+#'
+#' @format ## `cs_app_data`: A list with `r length(cs_app_data)` objects.
+#' 
+#' ```{r }
+#' str(cs_app_data)
+#' ```
+#'
+#' @source See `raw-data/clinsightful_data.R` for details.
+#' 
+"cs_app_data"
+
+
+#' Application Variables
+#'
+#' Named list version of `metadata` object.
+#'
+#' @format ## `cs_app_vars`: A list with `r length(cs_app_vars)` objects.
+#' 
+#' ```{r }
+#' str(cs_app_vars)
+#' ```
+#'
+#' @source See `raw-data/clinsightful_data.R` for details.
+#' 
+"cs_app_vars"
+
+
+#' Application Timeline Data
+#'
+#' A data.frame containing timeline data.
+#'
+#' @format ## `cs_timeline_data`: data.frame formatted for consumption by
+#'   `timevis` package.
+#' 
+#' ```{r }
+#' str(cs_timeline_data)
+#' ```
+#'
+#' @source See `raw-data/clinsightful_data.R` for details.
+#' 
+"cs_timeline_data"
+
+
+#' Application 'Available Data'
+#'
+#' Data frame containing info about available data per individual,
+#' such as visits, adverse events, etc. Will be used in module
+#' [mod_queries_server()], to select available items to create a query for per
+#' individual and per form. Required columns are the ones distinctively
+#' identifying an item. For now that are site_code, event_name, subject_id,
+#' event_label, item_group, item_name.
+#'
+#' @format a data.frame with `r nrow(cs_available_data)` rows and
+#'   `r ncol(cs_available_data)` variables.
+#' 
+#' ```{r }
+#' str(cs_available_data)
+#' ```
+#'
+#' @source See `raw-data/clinsightful_data.R` for details.
+#' 
+"cs_available_data"
+
+
 #' ClinSight key columns
 #'
 #' A character string containing the names of the columns that are needed to

R/fct_appdata_summary_tables.R

@@ -16,7 +16,7 @@
 #'   treatment item in the timeline.
 #'
 #' @return A data frame with timeline data.
-#' @keywords internal
+#' @export
 #' 
 get_timeline_data <- function(
     data, 
@@ -182,7 +182,7 @@ get_timeline_data <- function(
 #'   duplicate names exist for each participant.
 #'
 #' @return A data frame with available data points per form.
-#' @keywords internal
+#' @export
 #' 
 get_available_data <- function(
     data, 

R/fct_data_helpers.R

@@ -244,7 +244,7 @@ fix_multiple_choice_vars <- function(
 #' @param meta List. metadata to use.
 #'
 #' @return a list with all important names to be used in a clinical trial.
-#' @keywords internal
+#' @export
 #'
 get_meta_vars <- function(data = appdata, meta = metadata){
   stopifnot(inherits(data, "list"))

R/fct_data_tests.R

@@ -7,7 +7,7 @@
 #' @param required_cols Character vector, containing the column names that are
 #'   required for the application to run appropriately.
 #'
-#' @keywords internal
+#' @export
 #' 
 check_appdata <- function(
     data = appdata,

R/fct_test_clinsight.R

@@ -32,17 +32,67 @@ test_clinsight <- function(
   meta_data_path <- get_golem_config("meta_data", config = clinsight_config)
   if (
     clinsight_config %in% c("default", "dev") | 
-    !is.character(study_data_path) | !is.character(meta_data_path)
+    !is.character(study_data_path) |
+    !is.character(meta_data_path) #|
   ){
     stop("The 'default' or 'dev' config cannot be used with custom data, ", 
-         "and study_data and meta_data in the config file ", 
-         "should be character vectors.")
+         "and meta_data, app_data, app_vars, timeline_data, & available_data ", 
+         "in the config file should be character vectors.")
   }
+  # Build a version of `app_data` & app_vars
+  app_data <- get_appdata(data = clinsight_data, meta = meta_data)
+  app_vars <- get_meta_vars(data = app_data, meta = meta_data)
+
+  # Build a 'app_tables'
+  # app_tables <- lapply(
+  #   setNames(names(app_data), names(app_data)), \(x){
+  #     create_table(app_data[[x]], expected_columns = names(app_vars$items[[x]]))
+  #   })
+
+  # Build a 'available_data'
+  available_data <- get_available_data(
+    data = app_data,
+    # tables = app_tables,            # outdated arg
+    # all_forms = app_vars$all_forms, # outdated arg
+    form_repeat_name = with(
+      meta_data[["table_names"]],
+      table_name[raw_name == "form_repeat"]
+    ) |>
+      tryCatch(error = \(e) "N")
+  )
+
+  # For timeline data
+  timeline_data <- get_timeline_data(
+    app_data,
+    available_data = available_data,
+    treatment_label = meta_data$settings$treatment_label %||% "\U1F48A T\U2093"
+  )
 
   temp_folder <- tempfile(tmpdir = tempdir())
   dir.create(temp_folder, recursive = TRUE)
-  saveRDS(clinsight_data, file.path(temp_folder, basename(study_data_path))) 
-  saveRDS(meta_data, file.path(temp_folder, basename(meta_data_path)))
+  # saveRDS(clinsight_data, file.path(temp_folder, basename(study_data_path))) 
+  # saveRDS(meta_data, file.path(temp_folder, basename(meta_data_path)))
+  db_path <- file.path(temp_folder, "user_db.sqlite")
+  if(file.exists(db_path)) file.remove(db_path)
+  db_create(get_review_data(clinsight_data),
+            db_path = db_path
+  )
+  save_objs <- c(
+    "clinsight_data",
+    "meta_data",
+    "app_data",
+    "app_vars",
+    # "app_tables",
+    "timeline_data",
+    "available_data")
+  purrr::walk(save_objs, function(x){
+    rds_file <- file.path(temp_folder, paste0(x, ".rds"))
+    saveRDS(get(x), rds_file)
+    if(inherits(get(x), "data.frame")) {
+      pq_file <- file.path(temp_folder, paste0(x, ".parquet"))
+      arrow::write_parquet(get(x), pq_file)
+    }
+  })
   old_config <- Sys.getenv("GOLEM_CONFIG_ACTIVE")
   Sys.setenv("GOLEM_CONFIG_ACTIVE" = clinsight_config)
   run_app(