allow for testing design lists which are not in a tomic object

NAMESPACE

@@ -5,6 +5,7 @@ export(app_flow)
 export(app_heatmap)
 export(app_pcs)
 export(center_tomic)
+export(check_design)
 export(check_tomic)
 export(convert_wide_to_tidy_omic)
 export(create_tidy_omic)

R/data_classes.R

@@ -59,14 +59,14 @@
 #' )
 #' @export
 create_tidy_omic <- function(
     df,
     feature_pk,
     feature_vars = NULL,
     sample_pk,
     sample_vars = NULL,
     omic_type_tag = "general",
     verbose = TRUE
     ) {
 
   checkmate::assertDataFrame(df)
   checkmate::assertString(omic_type_tag)
@@ -86,7 +86,7 @@
 
   n_var_uses <- table(c(feature_pk, feature_vars, sample_pk, sample_vars))
   if (any(n_var_uses > 1)) {
     invalid_vars <- names(n_var_uses)[n_var_uses > 1]
 
     cli::cli_abort(
       "{paste(invalid_vars, collapse = ', ')} were assigned to multiple
@@ -134,7 +134,7 @@
     measurement_vars <- setdiff(
       output$design$measurements$variable,
       c(feature_pk, sample_pk)
       )
 
     message(glue::glue(
       "{length(measurement_vars)} measurement variables were defined as the
@@ -166,7 +166,7 @@
   checkmate::assertClass(tidy_omic, "tidy_omic")
   checkmate::assertLogical(fast_check, len = 1)
   # check design
-  check_design(tidy_omic)
+  check_design_in_tomic(tidy_omic)
 
   feature_pk <- tidy_omic$design$feature_pk
   sample_pk <- tidy_omic$design$sample_pk
@@ -475,7 +475,7 @@
   checkmate::assertClass(triple_omic, "triple_omic")
   checkmate::assertLogical(fast_check, len = 1)
   # check design
-  check_design(triple_omic)
+  check_design_in_tomic(triple_omic)
 
   # variables are same as design
   checkmate::assertNames(

R/design.R

@@ -20,17 +20,51 @@ get_design_tbl <- function(tomic) {
     dplyr::bind_rows()
 }
 
-check_design <- function(tomic) {
+#' Check Design
+#'
+#' Check that the design list embedded in `tomic` objects is properly
+#' formatted.
+#'
+#' @param tomic_design a list with named attributes describing feature,
+#'   sample, and measurement variables.
+#'
+#' @return 0, invisibly
+#'
+#' @examples
+#' check_design(brauer_2008_triple$design)
+#'
+#' @export
+check_design <- function(tomic_design) {
+
+  checkmate::assertList(tomic_design)
+
+  EXPECTED_ATTRIBUTES <- c("feature_pk", "features", "measurements", "sample_pk", "samples")
+  extra_elements <- setdiff(names(tomic_design), EXPECTED_ATTRIBUTES)
+  if (length(extra_elements) > 0) {
+    cli::cli_abort(
+      "The following unexpected attributes were found in the design: {.field {extra_elements}}"
+    )
+  }
+
+  missing_elements <- setdiff(EXPECTED_ATTRIBUTES, names(tomic_design))
+  if (length(missing_elements) > 0) {
+    cli::cli_abort(
+      "The following attributes were missing in the design: {.field {missing_elements}}"
+    )
+  }
+
+  checkmate::assertString(tomic_design$feature_pk)
+  checkmate::assertDataFrame(tomic_design$features)
+  checkmate::assertDataFrame(tomic_design$measurements)
+  checkmate::assertString(tomic_design$sample_pk)
+  checkmate::assertDataFrame(tomic_design$samples)
+}
+
+check_design_in_tomic <- function(tomic) {
+
   checkmate::assertClass(tomic, "tomic")
   stopifnot("design" %in% names(tomic))
-  stopifnot(all(
-    sort(names(tomic$design)) ==
-      c("feature_pk", "features", "measurements", "sample_pk", "samples")
-  ))
-
-  checkmate::assertString(tomic$design$feature_pk)
-  checkmate::assertDataFrame(tomic$design$features)
-  checkmate::assertDataFrame(tomic$design$measurements)
-  checkmate::assertString(tomic$design$sample_pk)
-  checkmate::assertDataFrame(tomic$design$samples)
+  check_design(tomic$design)
+
 }
+

tests/testthat/_snaps/data_classes.md

@@ -2,8 +2,9 @@
 
     Code
       check_tidy_omic(double_data_tidy, fast_check = FALSE)
-    Error <simpleError>
-      100 measurements were present multiple times with
+    Condition
+      Error in `check_tidy_omic()`:
+      ! 100 measurements were present multiple times with
            the same feature and sample primary keys
 
            For example:
@@ -25,8 +26,9 @@
       create_tidy_omic(degenerate_attributes %>% select(-degen_sample_var),
       feature_pk = "features", sample_pk = "samples", feature_var = "degen_feature_var",
       verbose = FALSE)
-    Error <simpleError>
-      "degen_feature_var" was duplicated for 10 features
+    Condition
+      Error in `check_tidy_omic()`:
+      ! "degen_feature_var" was duplicated for 10 features
       this variable should not be a feature attribute. 
 
 ---
@@ -35,23 +37,26 @@
       create_tidy_omic(degenerate_attributes %>% select(-degen_feature_var),
       feature_pk = "features", sample_pk = "samples", sample_var = "degen_sample_var",
       verbose = FALSE)
-    Error <simpleError>
-      "degen_sample_var" was duplicated for 10 features
+    Condition
+      Error in `check_tidy_omic()`:
+      ! "degen_sample_var" was duplicated for 10 features
       this variable should not be a feature attribute. 
 
 # Factor primary keys are preserved when converting from a tidy to a triple
 
     Code
       create_tidy_omic(three_col_df_fct, feature_pk = "features", sample_pk = "samples",
         sample_vars = "measurement", feature_vars = "measurement", verbose = FALSE)
-    Error <rlang_error>
-      measurement were assigned to multiple classes of variables each variable should only belong to one class
+    Condition
+      Error in `create_tidy_omic()`:
+      ! measurement were assigned to multiple classes of variables each variable should only belong to one class
 
 # Test that get_tomic_table() can retrieve various tables
 
     Code
       infer_tomic_table_type(simple_tidy, samples_df %>% rename(fake_samples = samples))
-    Error <simpleError>
-      based on the "tomic" primary keys, tomic_table doesn't appear to
+    Condition
+      Error in `infer_tomic_table_type()`:
+      ! based on the "tomic" primary keys, tomic_table doesn't appear to
              be features, samples or measurements
 

tests/testthat/_snaps/filters.md

@@ -11,8 +11,10 @@
 ---
 
     Code
-      .
-    Error <simpleError>
-      bar is not a valid value for "filter_type",
+      filter_tomic(brauer_2008_triple, filter_type = "category", filter_table = "features",
+        filter_variable = "bar", filter_value = "biological process unknown")
+    Condition
+      Error in `filter_tomic()`:
+      ! bar is not a valid value for "filter_type",
               valid values are all variables within the "features" table: name, BP, MF, systematic_name
 

tests/testthat/_snaps/mutates.md

@@ -2,8 +2,9 @@
 
     Code
       center_tomic(brauer_2008_tidy, measurement_vars = "foo")
-    Error <simpleError>
-      foo are not valid numeric or integer measurement variables.
+    Condition
+      Error in `center_tomic()`:
+      ! foo are not valid numeric or integer measurement variables.
               Valid measurements are: expression
 
 # Sort tables and update primary keys with new sort
@@ -30,7 +31,8 @@
 
     Code
       .
-    Error <simpleError>
-      bar is not present in measurements, valid value_vars include:
+    Condition
+      Error in `sort_triple_hclust()`:
+      ! bar is not present in measurements, valid value_vars include:
       expression
 

tests/testthat/test-design.R

@@ -2,6 +2,6 @@ test_that("extract design as a table", {
   get_design_tbl(brauer_2008_tidy) %>%
     expect_snapshot()
 
-  expect_invisible(check_design(brauer_2008_tidy))
+  expect_invisible(check_design_in_tomic(brauer_2008_tidy))
 })
 

tests/testthat/test-filters.R

@@ -42,14 +42,16 @@ test_that("Try all of the filters", {
     expect_equal(1)
 
   # edge cases
-  filter_tomic(
-    brauer_2008_triple,
-    filter_type = "category",
-    filter_table = "features",
-    filter_variable = "bar",
-    filter_value = "biological process unknown"
-    ) %>%
-    expect_snapshot(error = TRUE)
+  expect_snapshot(
+    filter_tomic(
+      brauer_2008_triple,
+      filter_type = "category",
+      filter_table = "features",
+      filter_variable = "bar",
+      filter_value = "biological process unknown"
+    ),
+    error = TRUE
+    )
 
   expect_warning(
     filter_tomic(