Merge pull request #109 from stemangiola/bioc-review

Bioc review changes

Author: stemangiola

.github/workflows/check-bioc.yml

@@ -48,12 +48,12 @@ jobs:
     ## Environment variables unique to this job.
 
     strategy:
-      fail-fast: false
+      fail-fast: true
       matrix:
         config:
-          - { os: ubuntu-latest, r: '4.2', bioc: '3.15', cont: "bioconductor/bioconductor_docker:RELEASE_3_15", rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest" }
-          - { os: macOS-latest, r: '4.2', bioc: '3.15'}
-          - { os: windows-latest, r: '4.2', bioc: '3.15'}
+          - { os: ubuntu-latest, r: '4.2', bioc: '3.16', cont: "bioconductor/bioconductor_docker:RELEASE_3_16", rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest" }
+          - { os: macOS-latest, r: '4.2', bioc: '3.16'}
+          - { os: windows-latest, r: '4.2', bioc: '3.16'}
     env:
       R_REMOTES_NO_ERRORS_FROM_WARNINGS: true
       RSPM: ${{ matrix.config.rspm }}
@@ -95,26 +95,20 @@ jobs:
           install.packages('remotes')
           saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2)
         shell: Rscript {0}
-      
-      - name: Cache assay data
-        uses: actions/cache@v3
-        with:
-          key: ${{ runner.os }}-hca-harmonised
-          path: ~/.cache/hca_harmonised
 
       - name: Cache R packages
         if: "!contains(github.event.head_commit.message, '/nocache') && runner.os != 'Linux'"
         uses: actions/cache@v2
         with:
           path: ${{ env.R_LIBS_USER }}
-          key: ${{ env.cache-version }}-${{ runner.os }}-biocversion-RELEASE_3_15-r-4.2
+          key: "${{ env.cache-version }}-${{ runner.os }}-biocversion-RELEASE_${{ matrix.config.bioc }}r-{{ matrix.config.r }}"
 
       - name: Cache R packages on Linux
         if: "!contains(github.event.head_commit.message, '/nocache') && runner.os == 'Linux' "
         uses: actions/cache@v2
         with:
           path: /home/runner/work/_temp/Library
-          key: ${{ env.cache-version }}-${{ runner.os }}-biocversion-RELEASE_3_15-r-4.2
+          key: "${{ env.cache-version }}-${{ runner.os }}-biocversion-RELEASE_${{ matrix.config.bioc }}r-{{ matrix.config.r }}"
 
       - name: Install Linux system dependencies
         if: runner.os == 'Linux'
@@ -172,15 +166,15 @@ jobs:
 
           ## Pass #1 at installing dependencies
           message(paste('****', Sys.time(), 'pass number 1 at installing dependencies: local dependencies ****'))
-          remotes::install_local(dependencies = TRUE, repos = BiocManager::repositories(), build_vignettes = TRUE, upgrade = TRUE)
+          remotes::install_local(dependencies = TRUE, repos = BiocManager::repositories(), build_vignettes = FALSE, upgrade = TRUE)
         continue-on-error: true
         shell: Rscript {0}
 
       - name: Install dependencies pass 2
         run: |
           ## Pass #2 at installing dependencies
           message(paste('****', Sys.time(), 'pass number 2 at installing dependencies: any remaining dependencies ****'))
-          remotes::install_local(dependencies = TRUE, repos = BiocManager::repositories(), build_vignettes = TRUE, upgrade = TRUE)
+          remotes::install_local(dependencies = TRUE, repos = BiocManager::repositories(), build_vignettes = FALSE, upgrade = TRUE)
           
           ## For running the checks
           message(paste('****', Sys.time(), 'installing rcmdcheck and BiocCheck ****'))
@@ -219,7 +213,7 @@ jobs:
           _R_CHECK_CRAN_INCOMING_: false
         run: |
           rcmdcheck::rcmdcheck(
-              args = c("--no-build-vignettes", "--no-manual", "--timings"),
+              args = c("--no-manual", "--timings"),
               build_args = c("--no-manual", "--no-resave-data"),
               error_on = "warning",
               check_dir = "check"

DESCRIPTION

@@ -7,13 +7,15 @@ Authors@R: c(
         "Stefano",
         "Mangiola",
         email = "[email protected]",
-        role = c("aut", "cre", "rev")
+        role = c("aut", "cre", "rev"),
+        comment = c(ORCID = "0000-0001-7474-836X")
     ),
     person(
         "Michael",
         "Milton",
         email = "[email protected]",
-        role = c("aut", "rev")
+        role = c("aut", "rev"),
+        comment = c(ORCID = "0000-0002-8965-2595")
     ),
     person(
         "Martin",
@@ -50,7 +52,7 @@ Authors@R: c(
         role = c( "fnd")
     ),
     person(
-        "Victoria Cancer Agnency",
+        "Victoria Cancer Agency",
         "ECRF21036",
         role = c( "fnd")
     ),
@@ -99,7 +101,12 @@ Suggests:
     testthat,
     basilisk,
     arrow,
-    reticulate
+    reticulate,
+    spelling,
+    forcats,
+    ggplot2,
+    tidySingleCellExperiment,
+    rprojroot
 Biarch: true
 biocViews: 
     AssayDomain,
@@ -128,3 +135,4 @@ Collate:
     'seurat.R'
     'unharmonised.R'
     'zzz.R'
+Language: en-US

NAMESPACE

@@ -1,9 +1,12 @@
 # Generated by roxygen2: do not edit by hand
 
 S3method(as.sparse,DelayedMatrix)
+export(DATABASE_URL)
+export(SAMPLE_DATABASE_URL)
 export(get_SingleCellExperiment)
 export(get_metadata)
 export(get_seurat)
+export(get_single_cell_experiment)
 export(get_unharmonised_metadata)
 importFrom(BiocGenerics,cbind)
 importFrom(DBI,dbConnect)

R/counts.R

@@ -22,6 +22,18 @@ COUNTS_URL <- single_line_str(
 #' version is released
 COUNTS_VERSION <- "0.2.1"
 
+#' @inherit get_single_cell_experiment
+#' @inheritDotParams get_single_cell_experiment
+#' @importFrom cli cli_alert_warning
+#' @export
+get_SingleCellExperiment <- function(...){
+    single_line_str("This function name is deprecated. 
+                    Please use `get_single_cell_experiment()` instead") |>
+        cli_alert_warning()
+    
+    get_single_cell_experiment(...)
+}
+
 #' Gets a SingleCellExperiment from curated metadata
 #'
 #' Given a data frame of Curated Atlas metadata obtained from [get_metadata()],
@@ -46,7 +58,7 @@ COUNTS_VERSION <- "0.2.1"
 #'   assays argument
 #' @examples
 #' meta <- get_metadata() |> head(2)
-#' sce <- get_SingleCellExperiment(meta)
+#' sce <- get_single_cell_experiment(meta)
 #'
 #' @importFrom dplyr pull filter as_tibble inner_join collect
 #' @importFrom tibble column_to_rownames
@@ -64,34 +76,39 @@ COUNTS_VERSION <- "0.2.1"
 #' @importFrom stats setNames
 #' @importFrom S4Vectors DataFrame
 #' @export
-get_SingleCellExperiment <- function(
+get_single_cell_experiment <- function(
     data,
     assays = "counts",
     cache_directory = get_default_cache_dir(),
     repository = COUNTS_URL,
     features = NULL
 ) {
     # Parameter validation
+    
     assays %in% names(assay_map) |>
         all() |>
         assert_that(
             msg = 'assays must be a character vector containing "counts" and/or
-          "cpm"'
+            "cpm"'
         )
-    (!anyDuplicated(assays)) |> assert_that()
-    inherits(cache_directory, "character") |> assert_that()
-    is.null(repository) || is.character(repository) |> assert_that()
-    is.null(features) || is.character(features) |> assert_that()
+    assert_that(
+        !anyDuplicated(assays),
+        inherits(cache_directory, "character"),
+        is.null(repository) || is.character(repository),
+        is.null(features) || is.character(features)
+    )
 
     # Data parameter validation (last, because it's slower)
     ## Evaluate the promise now so that we get a sensible error message
-    data
+    force(data)
     ## We have to convert to an in-memory table here, or some of the dplyr
     ## operations will fail when passed a database connection
     cli_alert_info("Realising metadata.")
     raw_data <- collect(data)
-    inherits(raw_data, "tbl") |> assert_that()
-    has_name(raw_data, c("cell_", "file_id_db")) |> assert_that()
+    assert_that(
+        inherits(raw_data, "tbl"),
+        has_name(raw_data, c("cell_", "file_id_db"))
+    )
 
     versioned_cache_directory <- file.path(cache_directory, COUNTS_VERSION)
     versioned_cache_directory |> dir.create(
@@ -182,10 +199,10 @@ group_to_sce <- function(i, df, dir_prefix, features) {
 
     file.exists(sce_path) |>
         assert_that(
-            msg = "Your cache does not contain a file you
+            msg = "Your cache does not contain a file {sce_path} you
                             attempted to query. Please provide the repository
                             parameter so that files can be synchronised from the
-                            internet"
+                            internet" |> glue()
         )
 
     sce <- loadHDF5SummarizedExperiment(sce_path)
@@ -194,11 +211,12 @@ group_to_sce <- function(i, df, dir_prefix, features) {
     cells <- colnames(sce) |> intersect(df$cell_)
 
     if (length(cells) < nrow(df)){
-        str_replace_all(
-            "Some cells were filtered out because of extremely low counts. The
+        single_line_str(
+            "Some cells were filtered out while loading {head(df$file_id_db, 1)}
+            because of extremely low counts. The
             number of cells in the SingleCellExperiment will be less than the
             number of cells you have selected from the metadata."
-        )
+        ) |> cli_alert_warning()
         df <- filter(df, .data$cell_ %in% cells)
     }
     else if (length(cells) > nrow(df)){

R/dev.R

@@ -145,7 +145,7 @@ update_unharmonised <- function(unharmonised_parquet_dir, ...){
 #'     "/vast/projects/cellxgene_curated/splitted_DB2_anndata_scaled_0.2.1"
 #' )
 #' }
-dir_to_anndata = function(src, dest){
+dir_to_anndata <- function(src, dest){
     dir.create(dest, showWarnings = FALSE)
     # This is a quick utility script to convert the SCE files into AnnData format for use in Pythonlist.files("/vast/projects/RCP/human_cell_atlas/splitted_DB2_data", full.names = FALSE) |>  purrr::walk(function(dir){
     basilisk::basiliskRun(fun = function(sce) {
@@ -184,3 +184,53 @@ dir_to_anndata = function(src, dest){
             }, .progress = "Converting files")
     }, env = zellkonverter::zellkonverterAnnDataEnv())
 }
+
+#' Makes a "downsampled" metadata file that only contains the minimal data
+#' needed to run the vignette.
+#' @param output Character scalar. Path to the output file.
+#' @return NULL
+#' @keywords internal
+downsample_metadata <- function(output = "sample_meta.parquet"){
+    metadata <- get_metadata()
+    
+    # Make a table of rows per dataset
+    dataset_sizes <- metadata |>
+        dplyr::group_by(.data$file_id_db) |>
+        summarise(n = dplyr::n()) |> 
+        dplyr::collect()
+    
+    # Find a minimal set of file_id_dbs we need
+    minimal_file_ids <- rlang::exprs(
+        # Used by the vignette
+        .data$ethnicity == "African" &
+            stringr::str_like(.data$assay, "%10x%") &
+            .data$tissue == "lung parenchyma" &
+            stringr::str_like(.data$cell_type, "%CD4%"),
+        .data$cell_type_harmonised == "nk",
+        .data$cell_type_harmonised == "cd14 mono",
+        .data$tissue == "kidney blood vessel",
+        # Used by tests
+        .data$file_id_db == "3214d8f8986c1e33a85be5322f2db4a9",
+        .data$cell_ == "868417_1"
+    ) |>
+        purrr::map(function(filter){
+            all_ids <- metadata |> 
+                dplyr::filter(!!filter) |>
+                dplyr::group_by(.data$file_id_db) |>
+                dplyr::pull(.data$file_id_db) |> unique()
+                
+            dataset_sizes |>
+                dplyr::filter(.data$file_id_db %in% all_ids) |>
+                dplyr::slice_min(n=50, order_by = .data$n) |>
+                dplyr::pull(.data$file_id_db)
+        }) |>
+        purrr::reduce(union)
+    
+    metadata |>    
+        dplyr::filter(.data$file_id_db %in% minimal_file_ids) |>
+        dplyr::arrange(.data$file_id_db, .data$sample_) |>
+        dplyr::collect() |>
+        arrow::write_parquet(output)
+    
+    NULL
+}

R/metadata.R

@@ -8,23 +8,38 @@ cache <- rlang::env(
     metadata_table = rlang::env()
 )
 
+#' URL pointing to the full metadata file
+#' @export
+#' @examples
+#' get_metadata(remote_url = DATABASE_URL)
 DATABASE_URL <- single_line_str(
     "https://object-store.rc.nectar.org.au/v1/
     AUTH_06d6e008e3e642da99d806ba3ea629c5/metadata/metadata.0.2.3.parquet"
 )
 
+#' URL pointing to the sample metadata file, which is smaller and for test,
+#' demonstration, and vignette purposes only
+#' @export
+#' @examples
+#' get_metadata(remote_url = SAMPLE_DATABASE_URL)
+SAMPLE_DATABASE_URL <- single_line_str(
+    "https://object-store.rc.nectar.org.au/v1/
+    AUTH_06d6e008e3e642da99d806ba3ea629c5/metadata/
+    sample_metadata.0.2.3.parquet"
+)
+
 #' Gets the Curated Atlas metadata as a data frame.
 #'
 #' Downloads a parquet database of the Human Cell Atlas metadata to a local
 #' cache, and then opens it as a data frame. It can then be filtered and passed
-#' into [get_SingleCellExperiment()] to obtain a
+#' into [get_single_cell_experiment()] to obtain a
 #' [`SingleCellExperiment::SingleCellExperiment-class`]
 #'
 #' @param remote_url Optional character vector of length 1. An HTTP URL pointing
 #'   to the location of the parquet database.
 #' @param cache_directory Optional character vector of length 1. A file path on
 #'   your local system to a directory (not a file) that will be used to store
-#'   metadata.parquet
+#'   `metadata.parquet`
 #' @param use_cache Optional logical scalar. If `TRUE` (the default), and this
 #'   function has been called before with the same parameters, then a cached
 #'   reference to the table will be returned. If `FALSE`, a new connection will
@@ -116,7 +131,7 @@ DATABASE_URL <- single_line_str(
 #'
 #' Error in `db_query_fields.DBIConnection()`: ! Can't query fields. Caused by
 #' error: ! Parser Error: syntax error at or near "/" LINE 2: FROM
-#' /Users/bob/Library/Cach...
+#' /Users/bob/Library/Caches...
 #'
 #' The solution is to choose a different cache, for example
 #'
@@ -134,13 +149,17 @@ get_metadata <- function(
         cached_connection
     }
     else {
-        report_file_sizes(remote_url)
         db_path <- file.path(cache_directory, "metadata.0.2.3.parquet")
-        sync_remote_file(
-            remote_url,
-            db_path,
-            progress(type = "down", con = stderr())
-        )
+        
+        if (!file.exists(db_path)){
+            report_file_sizes(remote_url)
+            sync_remote_file(
+                remote_url,
+                db_path,
+                progress(type = "down", con = stderr())
+            )
+        }
+
         table <- duckdb() |>
             dbConnect(drv = _, read_only = TRUE) |>
             tbl(db_path)

R/seurat.R

@@ -13,15 +13,15 @@ as.sparse.DelayedMatrix <- function(x) {
 #' Given a data frame of HCA metadata, returns a Seurat object corresponding to
 #' the samples in that data frame
 #'
-#' @inheritDotParams get_SingleCellExperiment
+#' @inheritDotParams get_single_cell_experiment
 #' @importFrom SeuratObject as.Seurat
 #' @export
 #' @return A Seurat object containing the same data as a call to
-#'   get_SingleCellExperiment.
+#'   [get_single_cell_experiment()]
 #' @examples
 #' meta <- get_metadata() |> head(2)
 #' seurat <- get_seurat(meta)
 #'
 get_seurat <- function(...) {
-    get_SingleCellExperiment(...) |> as.Seurat(data = NULL)
+    get_single_cell_experiment(...) |> as.Seurat(data = NULL)
 }