Change how pbmc_small is stored and generated

.Rbuildignore

@@ -19,7 +19,7 @@
 ^.*\.rds$
 ^.*\.Rds$
 ^data-raw$
-^inst$
+^data/.*\.rda$
 ^tests$
 ^LICENSE\.md$
 ^vignettes/articles$

.gitignore

@@ -13,6 +13,9 @@ inst/doc
 doc
 Meta
 
+# Ignore built data fiels
+data/*.rda
+
 # Ignore extra pkgdown files
 docs
 *_files

R/compliance.R

@@ -25,9 +25,9 @@
 
 .GetSeuratCompat <- local(
   envir = environment(fun = .SetSeuratCompat),
-  function() {
-    if (is.null(x = seurat.version) && isNamespaceLoaded(name = 'Seurat')) {
-      .SetSeuratCompat()
+  function(pkgname = 'Seurat') {
+    if (is.null(x = seurat.version) && isNamespaceLoaded(name = pkgname)) {
+      .SetSeuratCompat(pkgname = pkgname)
     }
     return(seurat.version %||% '5.0.0')
   }

R/data.R

@@ -23,3 +23,52 @@
 #' @source \url{https://support.10xgenomics.com/single-cell-gene-expression/datasets/1.1.0/pbmc3k}
 #'
 "pbmc_small"
+
+.LoadPkgData <- function(ds, ..., mode = c('load', 'resave'), env = NULL) {
+  resave_data_others <- function(src) {
+    env <- new.env()
+    sys.source(file = src, envir = env, chdir = TRUE)
+    return(env)
+  }
+  data.dir <- system.file('data', package = 'SeuratObject', mustWork = TRUE)
+  datasets <- list.files(path = data.dir, pattern = "\\.R$")
+  if (!length(x = datasets)) {
+    rlang::warn(
+      message = "Loading datasets by function works only under `devtools::load_all()`"
+    )
+    return(invisible(x = NULL))
+  }
+  ds <- match.arg(arg = ds, choices = datasets)
+  mode <- match.arg(arg = mode)
+  ds.env <- resave_data_others(src = file.path(data.dir, ds))
+  if (mode == 'resave') {
+    save(
+      list = ls(envir = ds.env, all.names = TRUE),
+      file = file.path(
+        data.dir,
+        sub(pattern = '\\.R$', replacement = '.rda', x = ds)
+      ),
+      compress = TRUE,
+      compression_level = 9L,
+      envir = ds.env
+    )
+    return(invisible(x = NULL))
+  }
+  ds.env <- as.list(x = ds.env)
+  if (is.environment(x = env)) {
+    for (i in names(x = ds.env)) {
+      env[[i]] <- ds.env[[i]]
+    }
+    return(invisible(x = ds.env))
+  }
+  if (length(x = ds.env) == 1L) {
+    return(ds.env[[1L]])
+  }
+  return(ds.env)
+}
+
+.PBMCsmall <- \(mode = 'load', env = .GlobalEnv) .LoadPkgData(
+  ds = 'pbmc_small',
+  mode = mode,
+  env = env
+)

R/seurat.R

@@ -1121,7 +1121,7 @@ UpdateSeuratObject <- function(object) {
         classes = 'validationWarning'
       )
     }
-    slot(object = object, name = 'version') <- packageVersion(pkg = 'SeuratObject')
+    slot(object = object, name = 'version') <- .PkgEnv$SeuratObjectVersion
     options(op)
     validObject(object = object, complete = TRUE)
     for (i in names(x = object)) {
@@ -1341,7 +1341,7 @@ CreateSeuratObject.Assay <- function(
     images = list(),
     project.name = project,
     misc = list(),
-    version = packageVersion(pkg = 'SeuratObject'),
+    version = .PkgEnv$SeuratObjectVersion,
     commands = list(),
     tools = list()
   ))
@@ -5252,7 +5252,7 @@ setMethod(
       default = Seurat.options$Seurat.object.project
     ),
     misc = list(),
-    version = packageVersion(pkg = 'SeuratObject'),
+    version = .PkgEnv$SeuratObjectVersion,
     commands = list(),
     tools = list(),
     ...

R/utils.R

@@ -324,8 +324,9 @@ rlang::`%||%`
 ) {
   # Figure out current version, rounding up development versions
   caller <- caller_env()
-  current <- .RoundVersion(current = packageVersion(
-    pkg = ns_env_name(x = caller)
+  current <- .RoundVersion(current = tryCatch(
+    expr = packageVersion(pkg = ns_env_name(x = caller)),
+    error = \(...) .PkgVersion(pkg = ns_env_name(x = caller))
   ))
   cv <- paste(current, collapse = '.')
   # Ensure our 'when' is a valid version
@@ -2450,6 +2451,26 @@ t.spam <- spam::t
   return(classes)
 }
 
+#' @inheritParams utils::packageVersion
+#'
+#' @noRd
+#'
+.PkgVersion <- function(pkg, lib.loc = NULL) {
+  if (pkg == 'SeuratObject' && is.null(x = lib.loc)) {
+    return(.PkgEnv$SeuratObjectVersion)
+  }
+  path <- path.package(package = pkg, quiet = TRUE)
+  path <- path %||% find.package(package = pkg, lib.loc = lib.loc)
+  desc <- system.file(
+    'DESCRIPTION',
+    package = pkg,
+    lib.loc = dirname(path = path),
+    mustWork = TRUE
+  )
+  version <- as.vector(x = read.dcf(file = desc, fields = 'Version'))
+  return(package_version(x = version))
+}
+
 #' Get English Vowels
 #'
 #' @return A vector with English vowels in lower case

R/zzz.R

@@ -87,6 +87,12 @@ Seurat.options <- list(
   progressr.clear = FALSE
 )
 
+#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+# Package environment
+#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+.PkgEnv <- new.env()
+
 #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 # Built With
 #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -531,10 +537,22 @@ NameIndex <- function(x, names, MARGIN) {
 }
 
 .onLoad <- function(libname, pkgname) {
+  # Get some package information
+  desc <- system.file(
+    "DESCRIPTION",
+    package = pkgname,
+    lib.loc = libname,
+    mustWork = TRUE
+  )
+  version <- as.vector(x = read.dcf(file = desc, fields = "Version"))
+  .PkgEnv$SeuratObjectVersion <- package_version(x = version)
+  lockEnvironment(env = .PkgEnv, bindings = TRUE)
+  # Set some options
   toset <- setdiff(x = names(x = Seurat.options), y = names(x = options()))
   if (length(x = toset)) {
     options(Seurat.options[toset])
   }
+  # Enable backwards compatibilty checking
   setHook(
     hookName = packageEvent(pkgname = 'Seurat', event = 'onLoad'),
     value = .SetSeuratCompat

data/pbmc_small.R

@@ -0,0 +1,123 @@
+
+pbmc_small <- local({
+  callcheck <- "resave_data_others" %in% unlist(x = lapply(
+    X = sys.calls(),
+    FUN = as.character
+  ))
+  if (!isTRUE(x = callcheck)) {
+    return(NULL)
+  }
+  # Check required packages
+  pkgcheck <- requireNamespace("rprojroot", quietly = TRUE) &&
+    requireNamespace("Seurat", quietly = TRUE) &&
+    utils::packageVersion(pkg = "Seurat") >= "5.0.0"
+  if (!isTRUE(x = pkgcheck)) {
+    return(NULL)
+  }
+
+  library(SeuratObject)
+  op <- options(Seurat.object.assay.version = "v3")
+
+  # Find the raw inputs
+  root <- rprojroot::find_package_root_file()
+  raw <- file.path(root, "inst", "extdata", "raw", "pbmc_small")
+  filecheck <-  dir.exists(raw) &&
+    all(file.exists(file.path(raw, c("counts.mtx", "features.txt", "cells.txt"))))
+  if (!isTRUE(x = filecheck)) {
+    return(NULL)
+  }
+
+  # Read in the raw data
+  mat <- methods::as(
+    object = Matrix::readMM(file = file.path(raw, "counts.mtx")),
+    Class = "CsparseMatrix"
+  )
+  dimnames(x = mat) <- list(
+    readLines(con = file.path(raw, "features.txt")),
+    readLines(con = file.path(raw, "cells.txt"))
+  )
+
+  # Construct the `Seurat` object
+  pbmc_small <- CreateSeuratObject(counts = mat, project = "pbmc_small")
+  if (!inherits(x = pbmc_small[["RNA"]], what = "Assay")) {
+    return(NULL)
+  }
+
+  # Process the object
+  pbmc_small <- Seurat::NormalizeData(
+    object = pbmc_small,
+    normalization.method = "LogNormalize",
+    scale.factor = 10000
+  ) |>
+    Seurat::FindVariableFeatures(
+      selection.method = "vst",
+      loess.span = 0.3,
+      clip.max = "auto",
+      num.bin = 20L,
+      binning.method = "equal_width",
+      nfeatures = 20L
+    ) |>
+    Seurat::ScaleData(
+      model.use = "linear",
+      use.umi = FALSE,
+      do.scale = TRUE,
+      do.center = TRUE,
+      scale.max = 10L,
+      block.size = 1000L,
+      min.cells.to.block = 80L
+    ) |>
+    Seurat::RunPCA(
+      npcs = 20L,
+      rev.pca = FALSE,
+      weight.by.var = TRUE,
+      reduction.name = "pca",
+      reduction.key = Key("PC", quiet = TRUE),
+      seed.use = 42L
+    ) |>
+    Seurat::JackStraw(dims = 10L, num.replicate = 10L) |>
+    Seurat::ScoreJackStraw(dims = 1:5, score.thresh = 1e-5) |>
+    Seurat::FindNeighbors(
+      dims = 1:10,
+      k.param = 30L,
+      prune.SNN = 1/15,
+      nn.eps = 0L
+    ) |>
+    Seurat::FindClusters(resolution = c(0.8, 1)) |>
+    Seurat::RunTSNE(
+      dims = 1:5,
+      perplexity = 5L,
+      seed.use = 1L,
+      check_duplicates = FALSE,
+      reduction.name = "tsne",
+      reduction.key = Key("tSNE", quiet = TRUE)
+    ) |>
+    Seurat::RunUMAP(
+      dims = 1:5,
+      reduction.name = "umap",
+      reduction.key = Key("UMAP", quiet = TRUE)
+    ) |> Seurat::ProjectDim()
+
+  # Add some meta data
+  set.seed(seed = 42L)
+  pbmc_small[[]] <- data.frame(
+    letter.idents = factor(x = sample(
+      x = c("A", "B"),
+      size = ncol(x = pbmc_small),
+      replace = TRUE
+    )),
+    groups = sample(
+      x = c("g1", "g2"),
+      size = ncol(x = pbmc_small),
+      replace = TRUE
+    ),
+    row.names = colnames(x = pbmc_small)
+  )
+
+  # Add a v5 assay
+  rna5 <- methods::as(object = pbmc_small[["RNA"]], Class = "Assay5")
+  Key(rna5) <- Key("RNA5", quiet = TRUE)
+  pbmc_small[["RNA5"]] <- rna5
+
+  # Return
+  pbmc_small
+})

inst/extdata/raw/pbmc_small/cells.txt

@@ -0,0 +1,80 @@
+ATGCCAGAACGACT
+CATGGCCTGTGCAT
+GAACCTGATGAACC
+TGACTGGATTCTCA
+AGTCAGACTGCACA
+TCTGATACACGTGT
+TGGTATCTAAACAG
+GCAGCTCTGTTTCT
+GATATAACACGCAT
+AATGTTGACAGTCA
+AGGTCATGAGTGTC
+AGAGATGATCTCGC
+GGGTAACTCTAGTG
+CATGAGACACGGGA
+TACGCCACTCCGAA
+CTAAACCTGTGCAT
+GTAAGCACTCATTC
+TTGGTACTGAATCC
+CATCATACGGAGCA
+TACATCACGCTAAC
+TTACCATGAATCGC
+ATAGGAGAAACAGA
+GCGCACGACTTTAC
+ACTCGCACGAAAGT
+ATTACCTGCCTTAT
+CCCAACTGCAATCG
+AAATTCGAATCACG
+CCATCCGATTCGCC
+TCCACTCTGAGCTT
+CATCAGGATGCACA
+CTAAACCTCTGACA
+GATAGAGAAGGGTG
+CTAACGGAACCGAT
+AGATATACCCGTAA
+TACTCTGAATCGAC
+GCGCATCTTGCTCC
+GTTGACGATATCGG
+ACAGGTACTGGTGT
+GGCATATGCTTATC
+CATTACACCAACTG
+TAGGGACTGAACTC
+GCTCCATGAGAAGT
+TACAATGATGCTAG
+CTTCATGACCGAAT
+CTGCCAACAGGAGC
+TTGCATTGAGCTAC
+AAGCAAGAGCTTAG
+CGGCACGAACTCAG
+GGTGGAGATTACTC
+GGCCGATGTACTCT
+CGTAGCCTGTATGC
+TGAGCTGAATGCTG
+CCTATAACGAGACG
+ATAAGTTGGTACGT
+AAGCGACTTTGACG
+ACCAGTGAATACCG
+ATTGCACTTGCTTT
+CTAGGTGATGGTTG
+GCACTAGACCTTTA
+CATGCGCTAGTCAC
+TTGAGGACTACGCA
+ATACCACTCTAAGC
+CATATAGACTAAGC
+TTTAGCTGTACTCT
+GACATTCTCCACCT
+ACGTGATGCCATGA
+ATTGTAGATTCCCG
+GATAGAGATCACGA
+AATGCGTGGACGGA
+GCGTAAACACGGTT
+ATTCAGCTCATTGG
+GGCATATGGGGAGT
+ATCATCTGACACCA
+GTCATACTTCGCCT
+TTACGTACGTTCAG
+GAGTTGTGGTAGCT
+GACGCTCTCTCTCG
+AGTCTTACTTCGGA
+GGAACACTTCAGAC
+CTTGATTGATCTTC