Merge branch 'devel' into add-metric-qc-function

LieberInstitute · Jul 10, 2024 · a2a013c · a2a013c
2 parents 2006346 + 30a8b3a
commit a2a013c
Show file tree

Hide file tree

Showing 55 changed files with 1,144 additions and 447 deletions.
diff --git a/.github/workflows/check-bioc.yml b/.github/workflows/check-bioc.yml
@@ -52,9 +52,9 @@ jobs:
       fail-fast: false
       matrix:
         config:
-          - { os: ubuntu-latest, r: '4.3', bioc: '3.18', cont: "bioconductor/bioconductor_docker:RELEASE_3_18", rspm: "https://packagemanager.rstudio.com/cran/__linux__/jammy/latest" }
-          - { os: macOS-latest, r: '4.3', bioc: '3.18'}
-          - { os: windows-latest, r: '4.3', bioc: '3.18'}
+          - { os: ubuntu-latest, r: '4.4', bioc: '3.19', cont: "bioconductor/bioconductor_docker:RELEASE_3_19", rspm: "https://packagemanager.rstudio.com/cran/__linux__/jammy/latest" }
+          # - { os: macOS-latest, r: '4.4', bioc: '3.19'}
+          - { os: windows-latest, r: '4.4', bioc: '3.19'}
           ## Check https://github.com/r-lib/actions/tree/master/examples
           ## for examples using the http-user-agent
     env:
@@ -105,16 +105,16 @@ jobs:
         uses: actions/cache@v3
         with:
           path: ${{ env.R_LIBS_USER }}
-          key: ${{ env.cache-version }}-${{ runner.os }}-biocversion-RELEASE_3_18-r-4.3-${{ hashFiles('.github/depends.Rds') }}
-          restore-keys: ${{ env.cache-version }}-${{ runner.os }}-biocversion-RELEASE_3_18-r-4.3-
+          key: ${{ env.cache-version }}-${{ runner.os }}-biocversion-RELEASE_3_19-r-4.4-${{ hashFiles('.github/depends.Rds') }}
+          restore-keys: ${{ env.cache-version }}-${{ runner.os }}-biocversion-RELEASE_3_19-r-4.4-
 
       - name: Cache R packages on Linux
         if: "!contains(github.event.head_commit.message, '/nocache') && runner.os == 'Linux' "
         uses: actions/cache@v3
         with:
           path: /home/runner/work/_temp/Library
-          key: ${{ env.cache-version }}-${{ runner.os }}-biocversion-RELEASE_3_18-r-4.3-${{ hashFiles('.github/depends.Rds') }}
-          restore-keys: ${{ env.cache-version }}-${{ runner.os }}-biocversion-RELEASE_3_18-r-4.3-
+          key: ${{ env.cache-version }}-${{ runner.os }}-biocversion-RELEASE_3_19-r-4.4-${{ hashFiles('.github/depends.Rds') }}
+          restore-keys: ${{ env.cache-version }}-${{ runner.os }}-biocversion-RELEASE_3_19-r-4.4-
 
       # - name: Install Linux system dependencies
       #   if: runner.os == 'Linux'
@@ -221,7 +221,7 @@ jobs:
           rcmdcheck::rcmdcheck(
               args = c("--no-manual", "--no-vignettes", "--timings"),
               build_args = c("--no-manual", "--keep-empty-dirs", "--no-resave-data"),
-              error_on = "error",
+              error_on = "warning",
               check_dir = "check"
           )
         shell: Rscript {0}
@@ -253,7 +253,7 @@ jobs:
       - name: Test coverage
         if: github.ref == 'refs/heads/devel' && env.run_covr == 'true' && runner.os == 'Linux'
         run: |
-          covr::codecov()
+          covr::codecov(coverage = covr::package_coverage(type = "all"))
         shell: Rscript {0}
 
       - name: Install package
@@ -286,7 +286,7 @@ jobs:
         if: failure()
         uses: actions/upload-artifact@master
         with:
-          name: ${{ runner.os }}-biocversion-RELEASE_3_18-r-4.3-results
+          name: ${{ runner.os }}-biocversion-RELEASE_3_19-r-4.4-results
           path: check
 
 

diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,8 +1,8 @@
 Package: spatialLIBD
 Title: spatialLIBD: an R/Bioconductor package to visualize spatially-resolved
     transcriptomics data
-Version: 1.17.0
-Date: 2024-04-19
+Version: 1.17.4
+Date: 2024-07-03
 Authors@R:
     c(
     person("Leonardo", "Collado-Torres", role = c("aut", "cre"), 
@@ -80,7 +80,7 @@ Imports:
     MatrixGenerics,
     rlang,
     dplyr
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
 Roxygen: list(markdown = TRUE)
 URL: https://github.com/LieberInstitute/spatialLIBD
 BugReports: https://support.bioconductor.org/tag/spatialLIBD

diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,12 @@
+# spatialLIBD 1.17.3
+
+NEW FEATURES
+
+* Added support for `SpatialExperiment` objects created with
+`visiumStitched::build_spe()` 
+<https://research.libd.org/visiumStitched/reference/build_spe.html> that 
+stitch together multiple Visium capture areas. Developed by @Nick-Eagles.
+
 # spatialLIBD 1.15.2
 
 SIGNIFICANT USER-VISIBLE CHANGES

diff --git a/R/add10xVisiumAnalysis.R b/R/add10xVisiumAnalysis.R
@@ -29,9 +29,8 @@
 #'
 #' ## Note that ?SpatialExperiment::read10xVisium doesn't include all the files
 #' ## we need to illustrate read10xVisiumWrapper().
-add10xVisiumAnalysis <- function(
-        spe,
-        visium_analysis) {
+add10xVisiumAnalysis <- function(spe,
+    visium_analysis) {
     col_info <- colData(spe)
     barcode_present <- "barcode" %in% colnames(col_info)
     if (!barcode_present) {

diff --git a/R/add_images.R b/R/add_images.R
@@ -43,13 +43,12 @@
 #'     ))
 #' }
 add_images <-
-    function(
-        spe,
-        image_dir,
-        image_pattern,
-        image_id_current = "lowres",
-        image_id = image_pattern,
-        image_paths = locate_images(spe, image_dir, image_pattern)) {
+    function(spe,
+    image_dir,
+    image_pattern,
+    image_id_current = "lowres",
+    image_id = image_pattern,
+    image_paths = locate_images(spe, image_dir, image_pattern)) {
         stopifnot(length(names(image_paths)) > 0)
         stopifnot(all(names(image_paths) %in% unique(spe$sample_id)))
         stopifnot(!any(duplicated(names(image_paths))))

diff --git a/R/annotate_registered_clusters.R b/R/annotate_registered_clusters.R
@@ -48,10 +48,9 @@
 #' ## More relaxed merging threshold
 #' annotate_registered_clusters(cor_stats_layer, cutoff_merge_ratio = 1)
 annotate_registered_clusters <-
-    function(
-        cor_stats_layer,
-        confidence_threshold = 0.25,
-        cutoff_merge_ratio = 0.25) {
+    function(cor_stats_layer,
+    confidence_threshold = 0.25,
+    cutoff_merge_ratio = 0.25) {
         annotated <-
             apply(cor_stats_layer,
                 1,
@@ -87,11 +86,10 @@ annotate_registered_clusters <-
     }
 
 annotate_registered_cluster <-
-    function(
-        remaining,
-        label = "",
-        current = NULL,
-        cutoff_merge_ratio = 0.25) {
+    function(remaining,
+    label = "",
+    current = NULL,
+    cutoff_merge_ratio = 0.25) {
         ## Filter negative correlations
         remaining <- remaining[remaining > 0]
 

diff --git a/R/app_server.R b/R/app_server.R
@@ -25,6 +25,7 @@ app_server <- function(input, output, session) {
     modeling_results <- golem::get_golem_options("modeling_results")
     sig_genes <- golem::get_golem_options("sig_genes")
     default_cluster <- golem::get_golem_options("default_cluster")
+    is_stitched <- golem::get_golem_options("is_stitched")
 
 
     # List the first level callModules here
@@ -171,6 +172,7 @@ app_server <- function(input, output, session) {
             alpha = input$alphalevel,
             point_size = input$pointsize,
             auto_crop = input$auto_crop,
+            is_stitched = is_stitched,
             ... = paste(" with", input$cluster)
         )
         if (!input$side_by_side_histology) {
@@ -211,6 +213,7 @@ app_server <- function(input, output, session) {
                 sample_order = isolate(input$grid_samples),
                 point_size = isolate(input$pointsize),
                 auto_crop = isolate(input$auto_crop),
+                is_stitched = is_stitched,
                 ... = paste(" with", isolate(input$cluster))
             )
         cowplot::plot_grid(
@@ -232,7 +235,8 @@ app_server <- function(input, output, session) {
             image_id = input$imageid,
             alpha = input$alphalevel,
             point_size = input$pointsize,
-            auto_crop = input$auto_crop
+            auto_crop = input$auto_crop,
+            is_stitched = is_stitched
         )
         if (!input$side_by_side_gene) {
             return(p)
@@ -270,7 +274,8 @@ app_server <- function(input, output, session) {
                 alpha = isolate(input$alphalevel),
                 point_size = isolate(input$pointsize),
                 sample_order = isolate(input$gene_grid_samples),
-                auto_crop = isolate(input$auto_crop)
+                auto_crop = isolate(input$auto_crop),
+                is_stitched = is_stitched
             )
         cowplot::plot_grid(
             plotlist = plots,
@@ -608,8 +613,17 @@ app_server <- function(input, output, session) {
 
         ## From vis_gene() in global.R
         spe_sub <- spe[, spe$sample_id == sampleid]
+
+        point_size <- input$pointsize
+        if (is_stitched) {
+            #   Drop excluded spots and calculate an appropriate point size
+            temp <- prep_stitched_data(spe_sub, point_size, input$imageid)
+            spe_sub <- temp$spe
+            point_size <- temp$point_size
+        }
+
         d <-
-            as.data.frame(cbind(colData(spe), SpatialExperiment::spatialCoords(spe))[spe$sample_id == sampleid, ],
+            as.data.frame(cbind(colData(spe_sub), SpatialExperiment::spatialCoords(spe_sub)),
                 optional = TRUE
             )
         #   Grab any continuous colData columns
@@ -692,7 +706,7 @@ app_server <- function(input, output, session) {
             title = plot_title,
             image_id = input$imageid,
             alpha = input$alphalevel,
-            point_size = input$pointsize,
+            point_size = point_size,
             auto_crop = input$auto_crop
         )
 
@@ -706,11 +720,11 @@ app_server <- function(input, output, session) {
             cont_colors = cont_colors(),
             image_id = input$imageid,
             alpha = input$alphalevel,
-            point_size = input$pointsize,
+            point_size = point_size,
             auto_crop = input$auto_crop
         ) + geom_point(
             shape = 21,
-            size = input$pointsize,
+            size = point_size,
             stroke = 0,
             alpha = input$alphalevel
         )
@@ -728,7 +742,7 @@ app_server <- function(input, output, session) {
             ) +
                 geom_point(
                     shape = 21,
-                    size = input$pointsize,
+                    size = point_size,
                     stroke = 0
                 ) +
                 scale_fill_manual(values = get_colors(colors, colData(spe)[[clustervar]][spe$sample_id == sampleid])) +
@@ -756,7 +770,7 @@ app_server <- function(input, output, session) {
             ) +
                 geom_point(
                     shape = 21,
-                    size = input$pointsize,
+                    size = point_size,
                     stroke = 0
                 )
         } else {
@@ -951,7 +965,8 @@ app_server <- function(input, output, session) {
                 image_id = input$imageid,
                 alpha = input$alphalevel,
                 point_size = input$pointsize,
-                auto_crop = input$auto_crop
+                auto_crop = input$auto_crop,
+                is_stitched = is_stitched
             ) +
             geom_point(
                 shape = 21,

diff --git a/R/check_sce.R b/R/check_sce.R
@@ -24,41 +24,40 @@
 #'     ## Check the object
 #'     check_sce(sce_example)
 #' }
-check_sce <- function(
-        sce,
-        variables = c(
-            "GraphBased",
-            "ManualAnnotation",
-            "Maynard",
-            "Martinowich",
-            paste0("SNN_k50_k", 4:28),
-            "spatialLIBD",
-            "cell_count",
-            "sum_umi",
-            "sum_gene",
-            "expr_chrM",
-            "expr_chrM_ratio",
-            "SpatialDE_PCA",
-            "SpatialDE_pool_PCA",
-            "HVG_PCA",
-            "pseudobulk_PCA",
-            "markers_PCA",
-            "SpatialDE_UMAP",
-            "SpatialDE_pool_UMAP",
-            "HVG_UMAP",
-            "pseudobulk_UMAP",
-            "markers_UMAP",
-            "SpatialDE_PCA_spatial",
-            "SpatialDE_pool_PCA_spatial",
-            "HVG_PCA_spatial",
-            "pseudobulk_PCA_spatial",
-            "markers_PCA_spatial",
-            "SpatialDE_UMAP_spatial",
-            "SpatialDE_pool_UMAP_spatial",
-            "HVG_UMAP_spatial",
-            "pseudobulk_UMAP_spatial",
-            "markers_UMAP_spatial"
-        )) {
+check_sce <- function(sce,
+    variables = c(
+        "GraphBased",
+        "ManualAnnotation",
+        "Maynard",
+        "Martinowich",
+        paste0("SNN_k50_k", 4:28),
+        "spatialLIBD",
+        "cell_count",
+        "sum_umi",
+        "sum_gene",
+        "expr_chrM",
+        "expr_chrM_ratio",
+        "SpatialDE_PCA",
+        "SpatialDE_pool_PCA",
+        "HVG_PCA",
+        "pseudobulk_PCA",
+        "markers_PCA",
+        "SpatialDE_UMAP",
+        "SpatialDE_pool_UMAP",
+        "HVG_UMAP",
+        "pseudobulk_UMAP",
+        "markers_UMAP",
+        "SpatialDE_PCA_spatial",
+        "SpatialDE_pool_PCA_spatial",
+        "HVG_PCA_spatial",
+        "pseudobulk_PCA_spatial",
+        "markers_PCA_spatial",
+        "SpatialDE_UMAP_spatial",
+        "SpatialDE_pool_UMAP_spatial",
+        "HVG_UMAP_spatial",
+        "pseudobulk_UMAP_spatial",
+        "markers_UMAP_spatial"
+    )) {
     ## Should be a SingleCellExperiment object
     stopifnot(is(sce, "SingleCellExperiment"))
 

diff --git a/R/check_spe.R b/R/check_spe.R
@@ -25,14 +25,13 @@
 #'     ## Check the object
 #'     check_spe(spe)
 #' }
-check_spe <- function(
-        spe,
-        variables = c(
-            "sum_umi",
-            "sum_gene",
-            "expr_chrM",
-            "expr_chrM_ratio"
-        )) {
+check_spe <- function(spe,
+    variables = c(
+        "sum_umi",
+        "sum_gene",
+        "expr_chrM",
+        "expr_chrM_ratio"
+    )) {
     ## Should be a SpatialExperiment object
     stopifnot(is(spe, "SpatialExperiment"))