diff --git a/R/data_classes.R b/R/data_classes.R index 8bf2ca6..18aa942 100644 --- a/R/data_classes.R +++ b/R/data_classes.R @@ -554,7 +554,7 @@ check_triple_omic <- function(triple_omic, fast_check = TRUE) { if (nrow(samples_not_unique) != 0) { stop(glue::glue( - "{nrow(samples_not_unique)} features were present multiple times with + "{nrow(samples_not_unique)} samples were present multiple times with the same sample primary key" )) } diff --git a/R/hclust.R b/R/hclust.R index c7e1956..b314bd3 100644 --- a/R/hclust.R +++ b/R/hclust.R @@ -1,11 +1,13 @@ hclust_tidy_omic <- function( - tidy_omic, - feature_var, - sample_var, - value_var, - cluster_dim, - distance_measure = "dist", - hclust_method = "ward.D2") { + tidy_omic, + feature_var, + sample_var, + value_var, + cluster_dim, + distance_measure = "dist", + hclust_method = "ward.D2" + ) { + check_tidy_omic(tidy_omic) checkmate::assertChoice(feature_var, tidy_omic$design$features$variable) @@ -37,7 +39,7 @@ hclust_tidy_omic <- function( cluster_orders$columns <- coerce_to_classes( cluster_orders$columns, - tidy_omic$data[[tidy_omic$design$feature_pk]] + tidy_omic$data[[tidy_omic$design$sample_pk]] ) # order rows and columns @@ -49,7 +51,7 @@ hclust_tidy_omic <- function( ) if (cluster_dim == "columns") { - # order by factor or alpha-numerically + # order features by factor or alpha-numerically if ( any(class(distinct_features[[feature_var]]) %in% c("factor", "ordered")) @@ -93,7 +95,7 @@ hclust_tidy_omic <- function( ) if (cluster_dim == "rows") { - # order by factor or alpha-numerically + # order samples by factor or alpha-numerically if (any(class(distinct_samples[[sample_var]]) %in% c("factor", "ordered"))) { # retain previous ordering @@ -208,13 +210,15 @@ hclust_tidy_omic <- function( #' hclust_order(df, "letters", "numbers", "noise", "rows") #' @export hclust_order <- function( - df, - feature_pk, - sample_pk, - value_var, - cluster_dim, - distance_measure = "dist", - hclust_method = "ward.D2") { + df, + feature_pk, + sample_pk, + value_var, + cluster_dim, + distance_measure = "dist", + hclust_method = "ward.D2" + ) { + checkmate::assertDataFrame(df) checkmate::assertChoice(feature_pk, colnames(df)) checkmate::assertChoice(sample_pk, colnames(df)) diff --git a/R/mutates.R b/R/mutates.R index 54b0195..67a6a76 100644 --- a/R/mutates.R +++ b/R/mutates.R @@ -150,6 +150,9 @@ center <- function(x) { #' mutate(new_sample_var = "foo") %>% #' select(-DR) #' new_variable_tables <- c("new_sample_var" = "samples") +#' +#' update_tidy_omic(tidy_omic, updated_tidy_data, new_variable_tables) +#' #' @export update_tidy_omic <- function( tidy_omic, diff --git a/R/utils.R b/R/utils.R index d642d97..2c0a298 100644 --- a/R/utils.R +++ b/R/utils.R @@ -24,19 +24,18 @@ format_names_for_plotting <- function(chars, width = 40, truncate_at = 80) { } coerce_to_classes <- function(obj, reference_obj) { - reference_obj_class <- class(reference_obj) + reference_obj_class <- class(reference_obj)[1] if (any(reference_obj_class %in% "glue")) { out <- glue::as_glue(obj) } else if (any(reference_obj_class %in% c("factor", "ordered"))) { - out <- - do.call( - reference_obj_class, - list( - x = obj, - levels = levels(reference_obj) - ) + out <- do.call( + reference_obj_class, + list( + x = obj, + levels = levels(reference_obj) ) + ) } else if (reference_obj_class == "character") { out <- as.character(obj) } else if (reference_obj_class == "numeric") { diff --git a/tests/testthat/_snaps/data_classes.md b/tests/testthat/_snaps/data_classes.md index 8f5cefb..7a5c8a0 100644 --- a/tests/testthat/_snaps/data_classes.md +++ b/tests/testthat/_snaps/data_classes.md @@ -51,6 +51,79 @@ Error in `create_tidy_omic()`: ! measurement were assigned to multiple classes of variables each variable should only belong to one class +# Catch corner cases when reading wide data + + Code + convert_wide_to_tidy_omic(wide_df_nonunique_feature_id, feature_pk = "name") + Condition + Warning in `convert_wide_to_tidy_omic()`: + 4 rows did not contain a unique name; adding extra variables 'unique_name' & 'entry_number' to distinguish them + Warning: + `mutate_()` was deprecated in dplyr 0.7.0. + i Please use `mutate()` instead. + i See vignette('programming') for more help + Message + 1 measurement variables were defined as the + left overs from the specified feature and sample varaibles: + abundance + Output + $data + # A tibble: 19,500 x 5 + name entry_number unique_name sample abundance + + 1 YOL029C 1 YOL029C-1 BP biological process unknown + 2 YOL029C 2 YOL029C-2 BP cytokinesis, completion of separation + 3 YOL029C 3 YOL029C-3 BP biological process unknown + 4 YOL029C 4 YOL029C-4 BP cell wall organization and biogenesis + 5 YOL029C 5 YOL029C-5 BP cell wall organization and biogenesi~ + 6 FKH1 1 FKH1 BP pseudohyphal growth* + 7 HOC1 1 HOC1 BP cell wall mannoprotein biosynthesis* + 8 CSN12 1 CSN12 BP adaptation to pheromone during conju~ + 9 YAL046C 1 YAL046C BP biological process unknown + 10 SLG1 1 SLG1 BP cell wall organization and biogenesi~ + # i 19,490 more rows + + $design + $design$features + # A tibble: 3 x 2 + variable type + + 1 unique_name feature_primary_key + 2 name character + 3 entry_number integer + + $design$samples + # A tibble: 1 x 2 + variable type + + 1 sample sample_primary_key + + $design$measurements + # A tibble: 3 x 2 + variable type + + 1 unique_name feature_primary_key + 2 sample sample_primary_key + 3 abundance character + + $design$feature_pk + [1] "unique_name" + + $design$sample_pk + [1] "sample" + + + attr(,"class") + [1] "tidy_omic" "tomic" "general" + +# Find primary or foreign keys in tomic table + + Code + get_identifying_keys(brauer_2008_triple, "foo") + Condition + Error in `get_identifying_keys()`: + ! Assertion on 'table' failed: Must be element of set {'features','samples','measurements'}, but is 'foo'. + # Test that get_tomic_table() can retrieve various tables Code @@ -60,3 +133,19 @@ ! based on the "tomic" primary keys, tomic_table doesn't appear to be features, samples or measurements +# Catch corner cases when interconverting tomics + + Code + check_tomic(mtcars) + Condition + Error in `check_tomic()`: + ! Assertion on 'tomic' failed: Must inherit from class 'tomic', but has class 'data.frame'. + +--- + + Code + tomic_to(romic::brauer_2008_tidy, "foo") + Condition + Error in `tomic_to()`: + ! Assertion on 'to_class' failed: Must be element of set {'tidy_omic','triple_omic'}, but is 'foo'. + diff --git a/tests/testthat/_snaps/design.md b/tests/testthat/_snaps/design.md index 67f9031..660023d 100644 --- a/tests/testthat/_snaps/design.md +++ b/tests/testthat/_snaps/design.md @@ -17,3 +17,19 @@ 9 sample sample_primary_key measurements 10 expression numeric measurements +# Catch malformed design objects + + Code + check_design(malformed_design) + Condition + Error in `check_design()`: + ! The following unexpected attributes were found in the design: foo + +--- + + Code + check_design(malformed_design) + Condition + Error in `check_design()`: + ! The following attributes were missing in the design: feature_pk + diff --git a/tests/testthat/_snaps/dim_reduction.md b/tests/testthat/_snaps/dim_reduction.md new file mode 100644 index 0000000..f906529 --- /dev/null +++ b/tests/testthat/_snaps/dim_reduction.md @@ -0,0 +1,20 @@ +# Sample mahalanobis distances are calculated + + Code + pc_distances + Output + # A tibble: 36 x 4 + sample nutrient DR pc_distance + + 1 G0.05 G 0.05 188. + 2 G0.1 G 0.1 125. + 3 G0.15 G 0.15 128. + 4 G0.2 G 0.2 125. + 5 G0.25 G 0.25 83.4 + 6 G0.3 G 0.3 101. + 7 N0.05 N 0.05 371. + 8 N0.1 N 0.1 226. + 9 N0.15 N 0.15 123. + 10 N0.2 N 0.2 100. + # i 26 more rows + diff --git a/tests/testthat/_snaps/mutates.md b/tests/testthat/_snaps/mutates.md index 833d626..9932b94 100644 --- a/tests/testthat/_snaps/mutates.md +++ b/tests/testthat/_snaps/mutates.md @@ -36,3 +36,55 @@ ! bar is not present in measurements, valid value_vars include: expression +# Factor levels can be updated using a list of factor orders + + Code + brauer_w_mystery_nutrients <- update_sample_factors(brauer_2008_tidy_w_NAs, + list(nutrient = NUTRIENT_ORDER)) + Message + ! NA was present in the sample metadata's nutrient field but did not have a corresponding factor level in the `factor_levels` list. They will be added to the end of the specified factor levels + ! The nutrient field in the sample metadata contains 2 NA values. These entries will be replaced with an "unspecified" level. + +--- + + Code + reordered_tidy <- update_sample_factors(brauer_2008_tidy, list(nutrient = CONFUSED_NUTRIENT_ORDER)) + Message + ! "G" was present in the sample metadata's nutrient field but did not have a corresponding factor level in the `factor_levels` list. They will be added to the end of the specified factor levels + ! "C" was present in `factor_levels` for nutrient but did not have a corresponding entry in the sample metadata. + +--- + + Code + update_sample_factors(brauer_2008_tidy, list(nutrient = 1:5)) + Condition + Error in `set_factor_levels()`: + ! The factor levels for nutrient were "integer". This should be a character vector. + +--- + + Code + update_sample_factors(brauer_2008_tidy, list(nutrient = c("G", "G", "N", "L"))) + Condition + Error in `set_factor_levels()`: + ! 1 factor levels was duplicated in the `factor_levels` specification for "nutrient": G + +--- + + Code + update_sample_factors(brauer_2008_tidy, list(DR = seq(0.05, 0.3, by = 0.05))) + Condition + Error in `set_factor_levels()`: + ! The factor levels for DR were "numeric". This should be a character vector. + +# Update tidy omics with new added variables + + Code + update_tidy_omic(tidy_omic, updated_tidy_data, c()) + Condition + Error in `update_tidy_omic()`: + ! updated_tidy_data contains 1 + - new fields: new_sample_var. + - Add these to "new_variable_tables" so that romic know how to + - use them. + diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R index 0fdb0d7..44d10ee 100644 --- a/tests/testthat/helper.R +++ b/tests/testthat/helper.R @@ -7,7 +7,7 @@ three_col_df <- tidyr:::expand_grid( samples = 1:10 ) %>% dplyr::mutate( - measurement = 1 + measurement = 1:100 ) simple_tidy <- create_tidy_omic( diff --git a/tests/testthat/test-data_classes.R b/tests/testthat/test-data_classes.R index 1d38d92..6ad2e05 100644 --- a/tests/testthat/test-data_classes.R +++ b/tests/testthat/test-data_classes.R @@ -57,6 +57,24 @@ test_that("Test check_tidy_omic edge cases", { ), error = TRUE) + # inconsistencies between data and design + simple_tidy_missing_join_1 <- simple_tidy + simple_tidy_missing_join_1$data <- simple_tidy_missing_join_1$data %>% + dplyr::select(-features) + + expect_error( + check_tomic(simple_tidy_missing_join_1), + regex = "features: are present in the design but not data.frames" + ) + + simple_tidy_missing_join_2 <- simple_tidy + simple_tidy_missing_join_2$data <- simple_tidy_missing_join_2$data %>% + dplyr::mutate(foo = "bar") + + expect_error( + check_tomic(simple_tidy_missing_join_2), + regex = "foo: are present in the data.frames but not in the design" + ) }) @@ -112,6 +130,76 @@ test_that("Create triple omic", { ) testthat::expect_s3_class(simple_triple, "triple_omic") + + # works when providing features and samples df + + triple_omic_full <- create_triple_omic( + triple_setup$measurement_df, + feature_df = triple_setup$feature_df, + sample_df = triple_setup$samples_df, + feature_pk = "feature_id", + sample_pk = "sample_id" + ) + + testthat::expect_s3_class(simple_triple, "triple_omic") +}) + +test_that("Test check_triple_omic edge cases", { + + # inconsistent classes of primary and foreign keys + simple_triple_class_inconsistency <- simple_triple + simple_triple_class_inconsistency$features$feature_id <- + factor(simple_triple_class_inconsistency$features$feature_id) + + expect_error( + check_triple_omic(simple_triple_class_inconsistency), + "feature_id classes differ between the features" + ) + + + simple_triple_class_inconsistency_samples <- simple_triple + simple_triple_class_inconsistency_samples$samples$sample_id <- + factor(simple_triple_class_inconsistency_samples$samples$sample_id) + + expect_error( + check_triple_omic(simple_triple_class_inconsistency_samples), + "sample_id classes differ between the samples" + ) + + # degenerate entries + nonunique_feature_ids <- simple_triple + nonunique_feature_ids$features <- dplyr::bind_rows( + nonunique_feature_ids$features, + nonunique_feature_ids$features + ) + + expect_error( + check_triple_omic(nonunique_feature_ids, fast_check = FALSE), + "10 features were present multiple times with" + ) + + nonunique_sample_ids <- simple_triple + nonunique_sample_ids$samples <- dplyr::bind_rows( + nonunique_sample_ids$samples, + nonunique_sample_ids$samples + ) + + expect_error( + check_triple_omic(nonunique_sample_ids, fast_check = FALSE), + "5 samples were present multiple times with" + ) + + nonunique_measurements <- simple_triple + nonunique_measurements$measurements <- dplyr::bind_rows( + nonunique_measurements$measurements, + nonunique_measurements$measurements + ) + + expect_error( + check_triple_omic(nonunique_measurements, fast_check = FALSE), + "50 measurements were present multiple times with" + ) + }) test_that("Unstructured data preserved using tomic_to", { @@ -147,12 +235,49 @@ test_that("Read wide data", { }) +test_that("Catch corner cases when reading wide data", { + + wide_measurements <- brauer_2008_triple[["measurements"]] %>% + tidyr::spread(sample, expression) + + wide_df <- brauer_2008_triple[["features"]] %>% + left_join(wide_measurements, by = "name") + + # reserved name is used + wide_df_w_reserved <- wide_df %>% + dplyr::rename(entry_number = name) + + expect_error( + convert_wide_to_tidy_omic( + wide_df_w_reserved, + feature_pk = "entry_number" + ), + "entry_number are reserved variable names" + ) + + wide_df_nonunique_feature_id <- wide_df + wide_df_nonunique_feature_id$name[1:5] <- wide_df_nonunique_feature_id$name[1] + + expect_snapshot( + convert_wide_to_tidy_omic( + wide_df_nonunique_feature_id, + feature_pk = "name" + ) + ) +}) + + test_that("Find primary or foreign keys in tomic table", { expect_equal(get_identifying_keys(brauer_2008_triple, "measurements"), c("name", "sample")) expect_equal(get_identifying_keys(brauer_2008_triple, "features"), "name") expect_equal(get_identifying_keys(brauer_2008_triple, "samples"), "sample") + # enable + expect_snapshot( + get_identifying_keys(brauer_2008_triple, "foo"), + error = TRUE + ) }) test_that("Test that get_tomic_table() can retrieve various tables", { @@ -179,3 +304,26 @@ test_that("reform_tidy_omic() can create a tidy_omic object from its attributes" expect_s3_class(tomic, "tidy_omic") }) + +test_that("Catch corner cases when interconverting tomics", { + # check tomic only works on tidy and triple omics + expect_snapshot( + check_tomic(mtcars), + error = TRUE + ) + + expect_snapshot( + tomic_to(romic::brauer_2008_tidy, "foo"), + error = TRUE + ) + + # tomic but not a tidy or triple + weird_s3_classes_tomic <- romic::brauer_2008_tidy + class(weird_s3_classes_tomic) <- "tomic" + + expect_error( + check_tomic(weird_s3_classes_tomic), + "tomic is not a tidy_omic or triple_omic. This is unexpected since" + ) + +}) diff --git a/tests/testthat/test-design.R b/tests/testthat/test-design.R index da50d69..c857f99 100644 --- a/tests/testthat/test-design.R +++ b/tests/testthat/test-design.R @@ -5,3 +5,31 @@ test_that("extract design as a table", { expect_invisible(check_design_in_tomic(brauer_2008_tidy)) }) +test_that("get_design_tbl() works when directly passing a design instead of a tomic", { + expect_equal( + get_design_tbl(brauer_2008_tidy), + get_design_tbl(brauer_2008_tidy$design) + ) +}) + +test_that("Catch malformed design objects", { + + malformed_design <- brauer_2008_tidy$design + malformed_design$foo <- "bar" + + expect_snapshot( + check_design(malformed_design), + error = TRUE + ) + + + malformed_design <- brauer_2008_tidy$design + malformed_design$feature_pk <- NULL + + expect_snapshot( + check_design(malformed_design), + error = TRUE + ) + +}) + diff --git a/tests/testthat/test-dim_reduction.R b/tests/testthat/test-dim_reduction.R index f77db3b..dd6a889 100644 --- a/tests/testthat/test-dim_reduction.R +++ b/tests/testthat/test-dim_reduction.R @@ -41,3 +41,10 @@ test_that("Matrices keys are reconstructed with appropriate classes", { } }) + +test_that("Sample mahalanobis distances are calculated", { + + pc_distances <- calculate_sample_mahalanobis_distances(brauer_2008_tidy) + expect_snapshot(pc_distances) + +}) diff --git a/tests/testthat/test-hclust.R b/tests/testthat/test-hclust.R index fe13a32..adebacb 100644 --- a/tests/testthat/test-hclust.R +++ b/tests/testthat/test-hclust.R @@ -92,3 +92,180 @@ test_that("downsampling features (for creating a heatmap works)", { expect_equal(nrow(downsampled_df), 3600) expect_equal(length(unique(downsampled_df$name)), 100) }) + +test_that("hclust_tidy_omic() tests all logic branches", { + + simple_tidy_w_factors <- simple_tidy + simple_tidy_w_factors$data <- simple_tidy_w_factors$data %>% + dplyr::mutate( + features = factor(features), + samples = ordered(samples) + ) %>% + # shuffle so we can test ordering + dplyr::sample_frac(1) + + hclust_w_fct_coercion <- hclust_tidy_omic( + simple_tidy_w_factors, + feature_var = simple_tidy_w_factors$design$feature_pk, + sample_var = simple_tidy_w_factors$design$sample_pk, + value_var = "measurement", + cluster_dim = "both" + ) + + expect_s3_class( + hclust_w_fct_coercion$data$features, + "factor" + ) + + expect_s3_class( + hclust_w_fct_coercion$data$samples, + "ordered" + ) + + # catch corner cases + + expect_error( + hclust_tidy_omic( + simple_tidy_w_factors, + feature_var = "features", + sample_var = "samples", + value_var = "features", + cluster_dim = "both" + ), + "feature_pk, sample_pk, and value_var must all be different" + ) + + # preserve default feature ordering + hclust_w_default_feature_orders <- hclust_tidy_omic( + simple_tidy_w_factors, + feature_var = simple_tidy_w_factors$design$feature_pk, + sample_var = simple_tidy_w_factors$design$sample_pk, + value_var = "measurement", + cluster_dim = "columns" + ) + + expect_equal( + class(hclust_w_default_feature_orders$data$features), + class(hclust_w_default_feature_orders$data$ordered_featureId) + ) + + # factor ordering defined by original orders + expect_equal( + as.character(levels(hclust_w_default_feature_orders$data$features)), + levels(hclust_w_default_feature_orders$data$ordered_featureId) + ) + + # preserve default sample orders + hclust_w_default_sample_orders <- hclust_tidy_omic( + simple_tidy_w_factors, + feature_var = simple_tidy_w_factors$design$feature_pk, + sample_var = simple_tidy_w_factors$design$sample_pk, + value_var = "measurement", + cluster_dim = "rows" + ) + + expect_equal( + class(hclust_w_default_sample_orders$data$samples), + class(hclust_w_default_sample_orders$data$ordered_sampleId) + ) + + # factor ordering defined by original orders + expect_equal( + as.character(levels(hclust_w_default_sample_orders$data$samples)), + levels(hclust_w_default_sample_orders$data$ordered_sampleId) + ) + + # sort features by non-factor feature variable when clustering just columns + + simple_tidy_shuffle <- simple_tidy + simple_tidy_shuffle$data <- dplyr::sample_frac(simple_tidy_shuffle$data) + + sorted_tidy_omic <- hclust_tidy_omic( + simple_tidy_shuffle, + feature_var = "features", + sample_var = "samples", + value_var = "measurement", + cluster_dim = "columns", + ) + + expect_s3_class(sorted_tidy_omic$data$ordered_featureId, "factor") + expect_equal(levels(sorted_tidy_omic$data$ordered_featureId), as.character(1:10)) +}) + + +test_that("hclust_tidy_omic() runs even if clustering initially fails due to missing values", { + + # create a dataset where distances between features and samples will create + # some NAs + disjoint_tomic <- simple_tidy + disjoint_tomic$data <- dplyr::bind_rows( + simple_tidy$data %>% + dplyr::filter( + features <= 5, + samples <= 5 + ), + simple_tidy$data %>% + dplyr::filter( + features > 5, + samples > 5 + ) + ) + + clustered_disjoint_tomic <- hclust_tidy_omic( + disjoint_tomic, + feature_var = "features", + sample_var = "samples", + value_var = "measurement", + cluster_dim = "both" + ) + + expect_s3_class(clustered_disjoint_tomic, "tomic") +}) + +test_that("Catch apply_hclust() corner cases", { + + invalid_matrix <- matrix(1:4, nrow = 2) + invalid_matrix <- invalid_matrix[-c(1:2),] + + expect_error( + apply_hclust(invalid_matrix, "foo", "bar"), + "contained zero rows" + ) + + # create data which will generate NAs in distance matrix + disjoint_data_matrix <- dplyr::bind_rows( + simple_tidy$data %>% + dplyr::filter( + features <= 5, + samples <= 5 + ), + simple_tidy$data %>% + dplyr::filter( + features > 5, + samples > 5 + ) + ) %>% + reshape2::acast(features ~ samples, value.var = "measurement") + + expect_error( + apply_hclust(disjoint_data_matrix, "dist", "ward.D2"), + "NA/NaN/Inf in foreign function call" + ) + + expect_error( + apply_hclust(disjoint_data_matrix, "corr", "ward.D2"), + "NA distances are not allowed with hierarchical clustering" + ) + + expect_error( + apply_hclust(disjoint_data_matrix, "baz", "ward.D2"), + "baz is not a defined distance_measure" + ) + +}) + +test_that("collapse_feature_vars() is well behaved", { + expect_equal(collapse_feature_vars("A"), "A") + expect_equal(collapse_feature_vars(c("B", "A")), "B & A") + expect_equal(collapse_feature_vars(1:5), 1) +}) diff --git a/tests/testthat/test-mutates.R b/tests/testthat/test-mutates.R index 268332f..3f444a2 100644 --- a/tests/testthat/test-mutates.R +++ b/tests/testthat/test-mutates.R @@ -75,3 +75,87 @@ test_that("Sort tomic applies a sort to features and/or samples", { expect_equal("fully sorted") }) +test_that("Factor levels can be updated using a list of factor orders", { + + NUTRIENT_ORDER <- c("G", "N", "P", "S", "L", "U") + + reordered_tidy <- update_sample_factors( + brauer_2008_tidy, + list(nutrient = NUTRIENT_ORDER) + ) + + expect_equal(levels(reordered_tidy$data$nutrient), NUTRIENT_ORDER) + + # test NA handling + brauer_samples <- get_tomic_table(brauer_2008_tidy, "samples") + brauer_samples$nutrient[1:2] <- NA + + brauer_2008_tidy_w_NAs <- update_tomic( + brauer_2008_tidy, + brauer_samples + ) + + expect_snapshot( + brauer_w_mystery_nutrients <- update_sample_factors( + brauer_2008_tidy_w_NAs, + list(nutrient = NUTRIENT_ORDER) + ) + ) + + expect_equal( + levels(brauer_w_mystery_nutrients$data$nutrient), + c(NUTRIENT_ORDER, "unspecified") + ) + + # W/ unexpected levels + + CONFUSED_NUTRIENT_ORDER <- c("C", "N", "P", "S", "L", "U") + + expect_snapshot( + reordered_tidy <- update_sample_factors( + brauer_2008_tidy, + list(nutrient = CONFUSED_NUTRIENT_ORDER) + )) + + expect_equal(levels(reordered_tidy$data$nutrient), c(CONFUSED_NUTRIENT_ORDER, "G")) + + # invalid factor specifications + + expect_snapshot( + update_sample_factors(brauer_2008_tidy, list(nutrient = 1:5)), + error = TRUE + ) + + expect_snapshot( + update_sample_factors(brauer_2008_tidy, list(nutrient = c("G", "G", "N", "L"))), + error = TRUE + ) + + expect_snapshot( + update_sample_factors(brauer_2008_tidy, list(DR = seq(0.05, 0.3, by = 0.05))), + error = TRUE + ) + +}) + +test_that("Update tidy omics with new added variables", { + + tidy_omic <- brauer_2008_tidy + updated_tidy_data <- tidy_omic$data %>% + dplyr::mutate(new_sample_var = "foo") %>% + dplyr::select(-DR) + + new_variable_tables <- c("new_sample_var" = "samples") + + tidy_w_updated_samples <- update_tidy_omic(tidy_omic, updated_tidy_data, new_variable_tables) + expect_equal( + tidy_w_updated_samples$design$samples$variable, + c('sample', "nutrient", "new_sample_var") + ) + + expect_snapshot( + update_tidy_omic(tidy_omic, updated_tidy_data, c()), + error = TRUE + ) + +}) diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index 0ad57a8..9e3e189 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -2,9 +2,13 @@ library(dplyr) test_that("Coercing to original classes works", { simple_factor <- factor(c("B", "A"), levels = c("A", "B")) - # -> factor expect_equal(coerce_to_classes(c("B", "A"), simple_factor), simple_factor) + + simple_ordered <- ordered(c("B", "A"), levels = c("A", "B")) + # -> ordered + expect_equal(coerce_to_classes(c("B", "A"), simple_ordered), simple_ordered) + # should throw an error when NAs are introduced for non-NAs expect_error(coerce_to_classes(c("B", "A", "C"), simple_factor), "reference object") # -> character