Add error messages to fetch_reduction

DESCRIPTION

@@ -1,14 +1,14 @@
 Package: SCUBA
 Title: Common data accession for single cell object formats
-Version: 0.10.0
+Version: 1.0.0
 Authors@R: 
     person("First", "Last", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "YOUR-ORCID-ID"))
 Description: SCUBA provides a common accession framework for multiple single cell object formats (Seurat, SingleCellExperiment, Anndata), facilitating analysis.
 License: MIT + file LICENSE
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
 Depends: 
     R (>= 2.10)
 Imports: 

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]
 

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)
 

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(),