diff --git a/DESCRIPTION b/DESCRIPTION index 1d51a7f..bb41eb0 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: SCUBA Title: Common data accession for single cell object formats -Version: 0.10.0 +Version: 1.0.0 Authors@R: person("First", "Last", , "first.last@example.com", role = c("aut", "cre"), comment = c(ORCID = "YOUR-ORCID-ID")) @@ -8,7 +8,7 @@ Description: SCUBA provides a common accession framework for multiple single cel License: MIT + file LICENSE Encoding: UTF-8 Roxygen: list(markdown = TRUE) -RoxygenNote: 7.3.1 +RoxygenNote: 7.3.2 Depends: R (>= 2.10) Imports: diff --git a/R/fetch_metadata.R b/R/fetch_metadata.R index 8960629..bb648f6 100644 --- a/R/fetch_metadata.R +++ b/R/fetch_metadata.R @@ -81,6 +81,35 @@ fetch_metadata.Seurat <- return(object@meta.data) } + # Return an error if the variable name is not in the object metadata + vars_present <- meta_varnames(object) + # not_found: TRUE if a var exists in the object, FALSE if not + not_found <- !vars %in% vars_present + + # Return an error if any or all variables entered are not found + if (any(not_found)){ + if (all(not_found)){ + stop( + paste0( + "\nNone of the variables entered in `vars` were not found\n", + "in the object. To view available entries for your object,\n", + "run SCUBA::meta_varnames()." + ) + ) + } else { + # If some but not all variables entered are not found, report the + # variables that are not found + stop( + paste0( + "\nThe following variables entered in `vars` were not found in \n", + "the object: ", + paste(vars[not_found]), ". \n\n", + "To view available entries for your object, run SCUBA::meta_varnames()." + ) + ) + } + } + # Cells: if undefined, pull data for all cells cells <- cells %||% get_all_cells(object) @@ -134,6 +163,35 @@ fetch_metadata.SingleCellExperiment <- if (full_table == TRUE){ return(colData(object)) } + + # Return an error if the variable name is not in the object metadata + vars_present <- meta_varnames(object) + # not_found: TRUE if a var exists in the object, FALSE if not + not_found <- !vars %in% vars_present + + # Return an error if any or all variables entered are not found + if (any(not_found)){ + if (all(not_found)){ + stop( + paste0( + "\nNone of the variables entered in `vars` were not found\n", + "in the object. To view available entries for your object,\n", + "run SCUBA::meta_varnames()." + ) + ) + } else { + # If some but not all variables entered are not found, report the + # variables that are not found + stop( + paste0( + "\nThe following variables entered in `vars` were not found in \n", + "the object: ", + paste(vars[not_found]), ". \n\n", + "To view available entries for your object, run SCUBA::meta_varnames()." + ) + ) + } + } # Cells: if undefined, pull data for all cells cells <- cells %||% get_all_cells(object) @@ -192,10 +250,40 @@ fetch_metadata.AnnDataR6 <- return(object$obs) } + # Return an error if the variable name is not in the object metadata + vars_present <- meta_varnames(object) + # not_found: TRUE if a var exists in the object, FALSE if not + not_found <- !vars %in% vars_present + + # Return an error if any or all variables entered were not found + if (any(not_found)){ + if (all(not_found)){ + stop( + paste0( + "\nNone of the variables entered in `vars` were not found\n", + "in the object. To view available entries for your object,\n", + "run SCUBA::meta_varnames()." + ) + ) + } else { + # If some but not all variables entered were not found, report the + # variables that are not found + stop( + paste0( + "\nThe following variables entered in `vars` were not found in \n", + "the object: ", + paste(vars[not_found]), ". \n\n", + "To view available entries for your object, run SCUBA::meta_varnames()." + ) + ) + } + } + # Cells: if undefined, pull data for all cells cells <- cells %||% get_all_cells(object) - # AnnData use obs + # Pull metadata + # For anndata objects, use obs data <- object$obs[cells, vars] diff --git a/R/fetch_reduction.R b/R/fetch_reduction.R index 9bc1025..e3bab9d 100644 --- a/R/fetch_reduction.R +++ b/R/fetch_reduction.R @@ -58,6 +58,23 @@ fetch_reduction.Seurat <- if (length(x = dims) != 2) { stop("'dims' must be a two-length vector") } + + # Throw an error if the reduction entered does not exist + if (!reduction %in% names(object@reductions)){ + # Collapse available reductions into a single-length character + # vector for display + reductions_str <- paste(names(object@reductions), collapse = ", ") + + stop( + paste0( + '\nThe reduction "', reduction, + '" was not found in the object passsed. \n', + 'Reductions present in object: ', + reductions_str, + '.' + ) + ) + } # Cells: if NULL, use all cells in the object cells <- cells %||% get_all_cells(object) @@ -80,6 +97,22 @@ fetch_reduction.SingleCellExperiment <- if (length(x = dims) != 2) { stop("'dims' must be a two-length vector") } + + # Throw an error if the reduction entered does not exist + if (!reduction %in% reducedDimNames(object)){ + # Collapse available reductions into a single-length character + # vector for display + reductions_str <- paste(reducedDimNames(object), collapse = ", ") + + stop( + paste0( + '\nThe reduction "', reduction, + '" was not found in the object passsed. \n', + 'Reductions present in object: ', + reductions_str, '.' + ) + ) + } # Cells: if NULL, use all cells in the object cells <- cells %||% get_all_cells(object) @@ -105,6 +138,26 @@ fetch_reduction.AnnDataR6 <- stop("'dims' must be a two-length vector") } + # Throw an error if the reduction entered does not exist + if (!reduction %in% object$obsm_keys()){ + # Collapse available reductions into a single-length character + # vector for display + reductions_str <- paste(object$obsm_keys(), collapse = ", ") + + stop( + paste0( + '\nThe reduction "', reduction, + '" was not found in the obsm slot of object passsed. \n', + 'Available obsm matrices: ', + reductions_str, '.', + '\n\n(This list includes all reductions, but is not limited to \n', + 'them since anndata objects do not have a location specific to \n', + 'reductions only. obsm matrices that are not reductions can be \n', + 'entered, but unexpected results may occur.)' + ) + ) + } + # Cells: if NULL, use all cells in the object cells <- cells %||% get_all_cells(object) diff --git a/tests/testthat/test-fetch_metadata.R b/tests/testthat/test-fetch_metadata.R index 087223e..b1193da 100644 --- a/tests/testthat/test-fetch_metadata.R +++ b/tests/testthat/test-fetch_metadata.R @@ -1,12 +1,77 @@ -test_that("fetch_metadata returns the same results for Anndata R6, SingleCellExperiment and Seurat objects. - ", { - seurat_metadata <- - fetch_metadata( - AML_Seurat, - full_table=T -# vars = "condensed_cell_type", -# cells = get_all_cells(AML_Seurat) - ) +# List of test objects to iterate through +test_objects <- list(AML_Seurat, AML_SCE(), AML_h5ad()) + +# Dummy sets of variables +# none_wrong: all variables are in the test objects +none_wrong <- c("nCount_RNA", "ct", "prop") +# some_wrong: one variable is not in the test object. This should return a +# warning. +some_wrong <- c("nCount_RNA", "ct", "stuff") +# all_wrong: all variables are not in the test object. +all_wrong <- c("stuff", "things", "junk") + +test_that( + paste0( + "fetch_metadata runs without errors when all variables entered are ", + "present in object" + ), + { + # Test on each supported object class + for (object in test_objects){ + testthat::expect_no_error( + fetch_metadata( + object, + vars = none_wrong, + cells = get_all_cells(object) + ) + ) + } + }) + +test_that( + paste0( + "fetch_metadata returns an error if some or all variables ", + "entered are not found" + ), + { + # Seurat objects + + # Test on each supported object class + # Test for no error, but a warning + for (object in test_objects){ + testthat::expect_error( + fetch_metadata( + object, + vars = some_wrong, + cells = get_all_cells(object) + ) + ) + + testthat::expect_error( + fetch_metadata( + object, + vars = all_wrong, + cells = get_all_cells(object) + ) + ) + } + }) + + +test_that( + paste0( + "fetch_metadata with full table = TRUE returns the same results for ", + "Anndata R6, SingleCellExperiment and Seurat objects." + ), + { + seurat_metadata <- + fetch_metadata( + AML_Seurat, + full_table = T + # vars = "condensed_cell_type", + # cells = get_all_cells(AML_Seurat) + ) + sce_metadata <- fetch_metadata( AML_SCE(),