migrate obsm varm tests, skip if known issue (#201)

* migrate obsm varm tests, skip if known issue

* update known issues

* fix linting issues

* add yaml to suggests

* fix error message

* add obsm varm as well

* port layers

* port X

* add note

* also include arrays in obsmvarm

* fix obsvar

* fix styling

* skip categorical

* Update tests/testthat/test-InMemoryAnnData.R

Co-authored-by: Luke Zappia <[email protected]>

* Update tests/testthat/test-roundtrip-obsvar.R

* add temporary workaround for data-intuitive/dummy-anndata#12

---------

Co-authored-by: Luke Zappia <[email protected]>

DESCRIPTION

@@ -82,7 +82,8 @@ Suggests:
     SummarizedExperiment,
     testthat (>= 3.0.0),
     vctrs,
-    withr
+    withr,
+    yaml
 VignetteBuilder: 
     knitr
 Config/Needs/website: pkgdown, tibble, knitr, rprojroot, stringr, readr,

NAMESPACE

@@ -16,5 +16,6 @@ importFrom(cli,cli_inform)
 importFrom(cli,cli_warn)
 importFrom(methods,as)
 importFrom(methods,new)
+importFrom(purrr,map_dfr)
 importFrom(purrr,map_lgl)
 importFrom(rlang,caller_env)

R/anndataR-package.R

@@ -61,7 +61,7 @@
 
 ## usethis namespace: start
 #' @importFrom cli cli_abort cli_warn cli_inform
-#' @importFrom purrr map_lgl
+#' @importFrom purrr map_lgl map_dfr
 #' @importFrom methods as new
 ## usethis namespace: end
 NULL

R/known_issues.R

@@ -0,0 +1,71 @@
+# This file contains the known issues that are currently present in the package.
+# It can be used to generate documentation, but also throw warnings instead of errors
+# in tests.
+read_known_issues <- function() {
+  check_requires("Reading known issues", "yaml")
+
+  data <- yaml::read_yaml(system.file("known_issues.yaml", package = "anndataR"))
+
+  map_dfr(
+    data$known_issues,
+    function(row) {
+      expected_names <- c(
+        "backend", "slot", "dtype", "process", "error_message",
+        "description", "proposed_solution", "to_investigate",
+        "to_fix"
+      )
+      if (!all(expected_names %in% names(row))) {
+        stop(
+          "Expected columns ", paste0("'", expected_names, "'", collapse = ", "),
+          " in known_issues.yaml, but got ", paste0("'", names(row), "'", collapse = ", ")
+        )
+      }
+
+      expand.grid(row)
+    }
+  )
+}
+
+is_known <- function(backend, slot, dtype, process, known_issues = NULL) {
+  if (is.null(known_issues)) {
+    known_issues <- read_known_issues()
+  }
+
+  filt <- rep(TRUE, nrow(known_issues))
+
+  if (!is.null(backend)) {
+    filt <- filt & known_issues$backend %in% backend
+  }
+  if (!is.null(slot)) {
+    filt <- filt & known_issues$slot %in% slot
+  }
+  if (!is.null(dtype)) {
+    filt <- filt & known_issues$dtype %in% dtype
+  }
+  if (!is.null(process)) {
+    filt <- filt & known_issues$process %in% process
+  }
+
+  filt
+}
+
+message_if_known <- function(backend, slot, dtype, process, known_issues = NULL) {
+  if (is.null(known_issues)) {
+    known_issues <- read_known_issues()
+  }
+
+  filt <- is_known(backend, slot, dtype, process, known_issues)
+
+  if (any(filt)) {
+    # take first
+    row <- known_issues[which(filt)[[1]], ]
+
+    paste0(
+      "Known issue for backend '", row$backend, "', slot '", row$slot,
+      "', dtype '", row$dtype, "', process '", row$process, "': ",
+      row$description
+    )
+  } else {
+    NULL
+  }
+}

inst/known_issues.yaml

@@ -0,0 +1,74 @@
+known_issues:
+  - backend: HDF5AnnData
+    slot:
+      - X
+      - layers
+      - obsp
+      - varp
+      - obsm
+      - varm
+    dtype:
+      - integer_csparse
+      - integer_rsparse
+      - integer_matrix
+    process: [read]
+    error_message: |
+      Failure (test-roundtrip-obspvarp.R:111:5): Writing an AnnData with obsp and varp 'integer_csparse' works
+      a$dtype (`actual`) not equal to b$dtype (`expected`).
+
+      `class(actual)`:   "numpy.dtypes.Float64DType" "numpy.dtype" "python.builtin.object"
+      `class(expected)`: "numpy.dtypes.Int64DType"   "numpy.dtype" "python.builtin.object"
+    description: Integers are being converted to floats.
+    proposed_solution: Debug and fix
+    to_investigate: True
+    to_fix: True
+  - backend: HDF5AnnData
+    slot:
+      - obsm
+      - varm
+    dtype:
+      - boolean_array
+      - categorical
+      - categorical_missing_values
+      - categorical_ordered
+      - categorical_ordered_missing_values
+      - dense_array
+      - integer_array
+      - nullable_boolean_array
+      - nullable_integer_array
+      - string_array
+    process: [reticulate]
+    error_message: |
+      adata_r$varm[[name]] (`actual`) not equal to py_to_r(py_get_item(adata_py$varm, name)) (`expected`).
+
+      `dim(actual)` is absent
+      `dim(expected)` is an integer vector (20)
+    description: Python nd.arrays have a dimension while R vectors do not.
+    proposed_solution: Debug and fix
+    to_investigate: True
+    to_fix: True
+  - backend: HDF5AnnData
+    slot:
+      - obsm
+      - varm
+    dtype:
+      - boolean_array
+      - categorical
+      - categorical_missing_values
+      - categorical_ordered
+      - categorical_ordered_missing_values
+      - dense_array
+      - integer_array
+      - nullable_boolean_array
+      - nullable_integer_array
+      - string_array
+    process: [write]
+    error_message: |
+      Error in `if (found_dim != expected_dim) {
+          stop("dim(", label, ")[", i, "] should have shape: ", expected_dim, 
+              ", found: ", found_dim, ".")
+      }`: argument is of length zero
+    description: R vectors don't have a dimension.
+    proposed_solution: The input checking function for obsm and varm should allow the object to be a vector of the correct length instead of only a matrix or a data frame.
+    to_investigate: True
+    to_fix: True

tests/testthat/helper-expect_equal_py.R

@@ -0,0 +1,56 @@
+expect_equal_py <- function(a, b) {
+  requireNamespace("testthat")
+  requireNamespace("reticulate")
+
+  bi <- reticulate::import_builtins()
+
+  testthat::expect_equal(bi$type(a), bi$type(b)) # does this always work?
+
+  if (inherits(a, "pandas.core.frame.DataFrame")) {
+    pd <- reticulate::import("pandas")
+    testthat::expect_null(
+      pd$testing$assert_frame_equal(
+        a,
+        b,
+        check_dtype = FALSE,
+        check_exact = FALSE
+      )
+    )
+  } else if (inherits(a, "np.ndarray") || inherits(a, "scipy.sparse.base.spmatrix")) {
+    scipy <- reticulate::import("scipy")
+    np <- reticulate::import("numpy")
+
+    testthat::expect_equal(a$dtype, b$dtype)
+
+    testthat::expect_equal(
+      py_to_r_ifneedbe(a$shape),
+      py_to_r_ifneedbe(b$shape)
+    )
+
+    a_dense <-
+      if (scipy$sparse$issparse(a)) {
+        a$toarray()
+      } else {
+        a
+      }
+    b_dense <-
+      if (scipy$sparse$issparse(b)) {
+        b$toarray()
+      } else {
+        b
+      }
+
+    testthat::expect_null(
+      np$testing$assert_allclose(a_dense, b_dense)
+    )
+  }
+}
+
+py_to_r_ifneedbe <- function(x) {
+  if (inherits(x, "python.builtin.object")) {
+    requireNamespace("reticulate")
+    reticulate::py_to_r(x)
+  } else {
+    x
+  }
+}

tests/testthat/test-InMemoryAnnData.R

@@ -40,7 +40,7 @@ test_that("with empty var", {
   expect_identical(ad$shape(), c(10L, 0L))
 })
 
-test_that("with only X, no obs or var", function() {
+test_that("Creating AnnData works with only X, no obs or var", {
   X <- dummy$X
   dimnames(X) <- list(
     rownames(dummy$obs),