Merge branch 'main' into 928_snapshot_upload@main

Signed-off-by: Aleksander Chlebowski <[email protected]>

.pre-commit-config.yaml

@@ -6,7 +6,7 @@ default_language_version:
   python: python3
 repos:
   - repo: https://github.com/lorenzwalthert/precommit
-    rev: v0.3.2.9021
+    rev: v0.3.2.9023
     hooks:
       - id: style-files
         name: Style code with `styler`

DESCRIPTION

@@ -1,8 +1,8 @@
 Type: Package
 Package: teal
 Title: Exploratory Web Apps for Analyzing Clinical Trials Data
-Version: 0.14.0.9012
-Date: 2023-10-13
+Version: 0.14.0.9013
+Date: 2023-10-19
 Authors@R: c(
     person("Dawid", "Kaledkowski", , "[email protected]", role = c("aut", "cre")),
     person("Pawel", "Rucki", , "[email protected]", role = "aut"),
@@ -88,6 +88,7 @@ Collate:
     'tdata.R'
     'teal.R'
     'teal_reporter.R'
+    'teal_slices-store.R'
     'teal_slices.R'
     'utils.R'
     'validate_inputs.R'

NEWS.md

@@ -1,9 +1,10 @@
-# teal 0.14.0.9012
+# teal 0.14.0.9013
 
 ### Miscellaneous
 
 * Enhanced a `module` validation checks so that it won't throw messages about `data` argument unnecessarily.
 * Removed `Report previewer` module from mapping matrix display in filter manager.
+* Added internal functions for storing and restoring of `teal_slices` objects.
 * Filter state snapshots can now be uploaded from file. See `?snapshot`.
 * Added argument to `teal_slices` and made modifications to `init` to enable tagging `teal_slices` with an app id to safely upload snapshots from disk.
 

R/module_snapshot_manager.R

@@ -49,7 +49,7 @@
 #' The snapshot is then set as the current content of `slices_global`.
 #'
 #' To save a snapshot, the snapshot is retrieved and reassembled just like for restoring,
-#' and then saved to file with [`teal.slice::slices_store`].
+#' and then saved to file with [`slices_store`].
 #'
 #' When a snapshot is uploaded, it will first be added to storage just like a newly created one,
 #' and then used to restore app state much like a snapshot taken from storage.
@@ -295,7 +295,7 @@ snapshot_manager_srv <- function(id, slices_global, mapping_matrix, filtered_dat
             content = function(file) {
               snapshot <- snapshot_history()[[s]]
               snapshot_state <- as.teal_slices(snapshot)
-              teal.slice::slices_store(tss = snapshot_state, file = file)
+              slices_store(tss = snapshot_state, file = file)
             }
           )
           handlers[[id_saveme]] <- id_saveme

R/teal_slices-store.R

@@ -0,0 +1,86 @@
+#' Store teal_slices object to a file
+#'
+#' This function takes a `teal_slices` object and saves it to a file in `JSON` format.
+#' The `teal_slices` object contains information about filter states and can be used to
+#' create, modify, and delete filter states. The saved file can be later loaded using
+#' the `slices_restore` function.
+#'
+#' @param tss (`teal_slices`) object to be stored.
+#' @param file (`character(1)`) The file path where `teal_slices` object will be saved.
+#'  The file extension should be `".json"`.
+#'
+#' @details `Date` class is stored in `"ISO8601"` format (`YYYY-MM-DD`). `POSIX*t` classes are converted to a
+#' character by using `format.POSIX*t(usetz = TRUE, tz = "UTC")` (`YYYY-MM-DD {N}{N}:{N}{N}:{N}{N} UTC`, where
+#' `{N} = [0-9]` is a number and `UTC` is `Coordinated Universal Time` timezone short-code).
+#' This format is assumed during `slices_restore`. All `POSIX*t` objects in `selected` or `choices` fields of
+#' `teal_slice` objects are always printed in `UTC` timezone as well.
+#'
+#' @return `NULL`, invisibly.
+#'
+#' @keywords internal
+#'
+#' @examples
+#' # Create a teal_slices object
+#' tss <- teal_slices(
+#'   teal_slice(dataname = "data", varname = "var"),
+#'   teal_slice(dataname = "data", expr = "x > 0", id = "positive_x", title = "Positive x")
+#' )
+#'
+#' if (interactive()) {
+#'   # Store the teal_slices object to a file
+#'   slices_store(tss, "path/to/file.json")
+#' }
+#'
+slices_store <- function(tss, file) {
+  checkmate::assert_class(tss, "teal_slices")
+  checkmate::assert_path_for_output(file, overwrite = TRUE, extension = "json")
+
+  cat(format(tss, trim_lines = FALSE), "\n", file = file)
+}
+
+#' Restore teal_slices object from a file
+#'
+#' This function takes a file path to a `JSON` file containing a `teal_slices` object
+#' and restores it to its original form. The restored `teal_slices` object can be used
+#' to access filter states and their corresponding attributes.
+#'
+#' @param file Path to file where `teal_slices` is stored. Must have a `.json` extension and read access.
+#'
+#' @return A `teal_slices` object restored from the file.
+#'
+#' @keywords internal
+#'
+#' @examples
+#' if (interactive()) {
+#'   # Restore a teal_slices object from a file
+#'   tss_restored <- slices_restore("path/to/file.json")
+#' }
+#'
+slices_restore <- function(file) {
+  checkmate::assert_file_exists(file, access = "r", extension = "json")
+
+  tss_json <- jsonlite::fromJSON(file, simplifyDataFrame = FALSE)
+  tss_json$slices <-
+    lapply(tss_json$slices, function(slice) {
+      for (field in c("selected", "choices")) {
+        if (!is.null(slice[[field]])) {
+          date_partial_regex <- "^[0-9]{4}-[0-9]{2}-[0-9]{2}"
+          time_stamp_regex <- paste0(date_partial_regex, "\\s[0-9]{2}:[0-9]{2}:[0-9]{2}\\sUTC$")
+
+          slice[[field]] <-
+            if (all(grepl(paste0(date_partial_regex, "$"), slice[[field]]))) {
+              as.Date(slice[[field]])
+            } else if (all(grepl(time_stamp_regex, slice[[field]]))) {
+              as.POSIXct(slice[[field]], tz = "UTC")
+            } else {
+              slice[[field]]
+            }
+        }
+      }
+      slice
+    })
+
+  tss_elements <- lapply(tss_json$slices, as.teal_slice)
+
+  do.call(teal_slices, c(tss_elements, tss_json$attributes))
+}

tests/testthat/test-teal_slices-store.R

@@ -0,0 +1,151 @@
+testthat::test_that("teal_slice store/restore supports saving `POSIXct` timestamps in selected", {
+  slices_path <- withr::local_file("slices.json")
+
+  time_stamps <- Sys.time() + c(-10 * 60 * 60 * 24, -30, 0)
+
+  # ISO8601 does not keep milliseconds
+  time_stamps <- as.POSIXct(
+    ceiling(as.double(time_stamps)),
+    tz = "UTC",
+    origin = "1970-01-01"
+  )
+
+  tss <- teal_slices(
+    teal_slice(
+      dataname = "ADSL",
+      varname = "EOSDTM",
+      selected = time_stamps,
+      fixed = TRUE
+    )
+  )
+
+  # Store the teal_slices object to a file
+  slices_store(tss, slices_path)
+  tss_restored <- slices_restore(slices_path)
+
+  tss_restored_list <- shiny::isolate(shiny::reactiveValuesToList(tss_restored[[1]]))
+  testthat::expect_s3_class(tss_restored_list$selected, "POSIXct")
+
+  teal.slice:::expect_identical_slice(tss[[1]], tss_restored[[1]])
+})
+
+testthat::test_that("teal_slice store/restore supports saving `Date` dates in selected", {
+  slices_path <- withr::local_file("slices.json")
+
+  time_stamps <- Sys.Date() + c(-10 * 600, -30, 0)
+
+  tss <- teal_slices(
+    teal_slice(
+      dataname = "ADSL",
+      varname = "EOSDT",
+      selected = time_stamps,
+      fixed = TRUE
+    )
+  )
+
+  # Store the teal_slices object to a file
+  slices_store(tss, slices_path)
+  tss_restored <- slices_restore(slices_path)
+
+  tss_restored_list <- shiny::isolate(shiny::reactiveValuesToList(tss_restored[[1]]))
+  testthat::expect_s3_class(tss_restored_list$selected, "Date")
+
+  teal.slice:::expect_identical_slice(tss[[1]], tss_restored[[1]])
+})
+
+testthat::test_that("teal_slice store/restore supports saving `POSIXct` timestamps in choices", {
+  slices_path <- withr::local_file("slices.json")
+
+  time_stamps <- Sys.time() + c(-10 * 60 * 60 * 24, -30, 0)
+
+  # ISO8601 does not keep milliseconds
+  time_stamps <- as.POSIXct(
+    ceiling(as.double(time_stamps)),
+    tz = "UTC",
+    origin = "1970-01-01"
+  )
+
+  tss <- teal_slices(
+    teal_slice(
+      dataname = "ADSL",
+      varname = "EOSDTM",
+      selected = sample(time_stamps, 2),
+      choices = time_stamps,
+      fixed = TRUE
+    )
+  )
+
+  # Store the teal_slices object to a file
+  slices_store(tss, slices_path)
+  tss_restored <- slices_restore(slices_path)
+
+  tss_restored_list <- shiny::isolate(shiny::reactiveValuesToList(tss_restored[[1]]))
+  testthat::expect_s3_class(tss_restored_list$choices, "POSIXct")
+
+  teal.slice:::expect_identical_slice(tss[[1]], tss_restored[[1]])
+})
+
+testthat::test_that("teal_slice store/restore supports saving `Date` timestamps in choices", {
+  slices_path <- withr::local_file("slices.json")
+
+  time_stamps <- Sys.Date() + c(-10 * 600, -30, 0)
+
+  tss <- teal_slices(
+    teal_slice(
+      dataname = "ADSL",
+      varname = "EOSDT",
+      selected = sample(time_stamps, 2),
+      choices = time_stamps,
+      fixed = TRUE
+    )
+  )
+
+  # Store the teal_slices object to a file
+  slices_store(tss, slices_path)
+  tss_restored <- slices_restore(slices_path)
+
+  tss_restored_list <- shiny::isolate(shiny::reactiveValuesToList(tss_restored[[1]]))
+  testthat::expect_s3_class(tss_restored_list$choices, "Date")
+
+  teal.slice:::expect_identical_slice(tss[[1]], tss_restored[[1]])
+})
+
+
+testthat::test_that("teal_slice store/restore restores mixed `Date`-characters as characters in selected", {
+  slices_path <- withr::local_file("slices.json")
+  tss <- teal_slices(
+    teal_slice(
+      dataname = "ADSL",
+      varname = "EOSDTM",
+      selected = c(
+        "beta 2023-09-11",
+        "release candidate 2023-09-21",
+        "release 2023-09-21"
+      ),
+      fixed = TRUE
+    )
+  )
+
+  slices_store(tss, slices_path)
+  tss_restored <- slices_restore(slices_path)
+  teal.slice:::expect_identical_slice(tss[[1]], tss_restored[[1]])
+})
+
+testthat::test_that("teal_slice store/restore restores characters as characters in selected and choices", {
+  slices_path <- withr::local_file("slices.json")
+  tss <- teal_slices(
+    teal_slice(
+      dataname = "ADSL",
+      varname = "EOSDTM",
+      choices = c("a", "b", "c"),
+      selected = c("a", "b")
+    )
+  )
+
+  slices_store(tss, slices_path)
+  tss_restored <- slices_restore(slices_path)
+
+  testthat::expect_type(shiny::isolate(tss_restored[[1]]$selected), "character")
+  testthat::expect_type(shiny::isolate(tss_restored[[1]]$choices), "character")
+  teal.slice:::expect_identical_slice(tss[[1]], tss_restored[[1]])
+})