Merge branch 'drieslab:suite_dev' into suite_dev

DESCRIPTION

@@ -60,7 +60,6 @@ Imports:
 Suggests:
     ArchR,
     arrow,
-    Biobase,
     biomaRt,
     ClusterR,
     clustree,
@@ -69,14 +68,12 @@ Suggests:
     DelayedMatrixStats,
     dendextend (>= 1.13.0),
     dplyr,
-    exactextractr,
     FactoMineR,
     factoextra,
     fitdistrplus,
     FNN,
     future,
     future.apply,
-    geometry,
     GiottoData,
     ggalluvial,
     ggdendro,
@@ -86,7 +83,6 @@ Suggests:
     graphcoloring,
     HDF5Array (>= 1.18.1),
     hdf5r,
-    htmlwidgets,
     jackstraw,
     kableExtra,
     knitr,
@@ -95,7 +91,6 @@ Suggests:
     multinet (>= 3.0.2),
     networkD3,
     pheatmap,
-    png,
     quadprog,
     harmony,
     R.utils,
@@ -105,10 +100,7 @@ Suggests:
     rhdf5,
     RTriangle (>= 1.6-0.10),
     Rvision,
-    S4Vectors,
     scater,
-    scatterpie,
-    scattermore,
     scran (>= 1.10.1),
     Seurat,
     sf,
@@ -121,10 +113,9 @@ Suggests:
     STexampleData,
     SummarizedExperiment,
     tidygraph,
-    tiff,
     trendsceek,
     testthat (>= 3.0.0),
-    qs
+    rmarkdown
 Remotes:
     drieslab/GiottoUtils,
     drieslab/GiottoClass,

NAMESPACE

@@ -267,6 +267,7 @@ export(hyperGeometricEnrich)
 export(identifyTMAcores)
 export(importCosMx)
 export(importVisiumHD)
+export(importXenium)
 export(initHMRF_V2)
 export(insertCrossSectionFeatPlot3D)
 export(insertCrossSectionSpatPlot3D)

R/ONTraC_wrapper.R

@@ -395,7 +395,10 @@ plotCTCompositionInNicheCluster <- function( # nolint: object_name_linter.
   prob_df$cell_ID <- rownames(prob_df)
   ## combine the cell type and niche cluster probability matrix
   combined_df <- merge(
-    pDataDT(gobject, feat_type = feat_type)[, c("cell_ID", cell_type)],
+    as.data.frame(pDataDT(gobject, feat_type = feat_type))[, c(
+      "cell_ID",
+      cell_type
+    )],
     prob_df,
     by = "cell_ID"
   )
@@ -407,31 +410,34 @@ plotCTCompositionInNicheCluster <- function( # nolint: object_name_linter.
       names_to = "Cluster",
       values_to = "Probability"
     ) %>%
-    dplyr::group_by(Cell_Type, Cluster) %>% # nolint: object_usage_linter.
+    dplyr::group_by(
+      !!rlang::sym(cell_type),
+      Cluster # nolint: object_usage_linter.
+    ) %>%
     dplyr::summarise(Sum = sum(Probability, # nolint: object_usage_linter.
       na.rm = TRUE
     )) %>%
     tidyr::spread(key = "Cluster", value = "Sum", fill = 0)
   cell_type_counts_df <- as.data.frame(cell_type_counts_df)
-  rownames(cell_type_counts_df) <- cell_type_counts_df$Cell_Type
-  cell_type_counts_df$Cell_Type <- NULL
+  rownames(cell_type_counts_df) <- cell_type_counts_df[[cell_type]]
+  cell_type_counts_df[[cell_type]] <- NULL
   normalized_df <- as.data.frame(t(
     t(cell_type_counts_df) / colSums(cell_type_counts_df)
   ))
 
 
   # Reshape the data frame into long format
-  normalized_df$Cell_Type <- rownames(normalized_df)
+  normalized_df[[cell_type]] <- rownames(normalized_df)
   df_long <- normalized_df %>%
     tidyr::pivot_longer(
-      cols = -Cell_Type, # nolint: object_usage_linter.
+      cols = -!!rlang::sym(cell_type), # nolint: object_usage_linter.
       names_to = "Cluster",
       values_to = "Composition"
     )
 
   # Create the heatmap using ggplot2
   pl <- ggplot(df_long, aes(
-    x = Cell_Type, # nolint: object_usage_linter.
+    x = !!rlang::sym(cell_type), # nolint: object_usage_linter.
     y = Cluster, # nolint: object_usage_linter.
     fill = Composition # nolint: object_usage_linter.
   )) +
@@ -470,7 +476,7 @@ plotCellTypeNTScore <- function(gobject, # nolint: object_name_linter.
                                 cell_type,
                                 values = "NTScore",
                                 spat_unit = "cell",
-                                feat_type = "rna",
+                                feat_type = "niche cluster",
                                 show_plot = NULL,
                                 return_plot = NULL,
                                 save_plot = NULL,
@@ -484,16 +490,16 @@ plotCellTypeNTScore <- function(gobject, # nolint: object_name_linter.
     feat_type = feat_type
   )
   avg_scores <- data_df %>%
-    dplyr::group_by(Cell_Type) %>% # nolint: object_usage_linter.
+    dplyr::group_by(!!rlang::sym(cell_type)) %>% # nolint: object_usage_linter.
     dplyr::summarise(Avg_NTScore = mean(NTScore)) # nolint: object_usage_linter.
-  data_df$Cell_Type <- factor(data_df$Cell_Type,
-    levels = avg_scores$Cell_Type[order(avg_scores$Avg_NTScore)]
+  data_df[[cell_type]] <- factor(data_df[[cell_type]],
+    levels = avg_scores[[cell_type]][order(avg_scores$Avg_NTScore)]
   )
 
   pl <- ggplot(data_df, aes(
     x = NTScore, # nolint: object_usage_linter.
-    y = Cell_Type, # nolint: object_usage_linter.
-    fill = Cell_Type
+    y = !!rlang::sym(cell_type),
+    fill = !!rlang::sym(cell_type)
   )) +
     geom_violin() +
     theme_minimal() +

R/auxiliary_giotto.R

@@ -47,10 +47,13 @@
         #   mymatrix = log(mymatrix + offset)/log(base)
     } else if (methods::is(mymatrix, "dgCMatrix")) {
         mymatrix@x <- log(mymatrix@x + offset) / log(base)
-        # replace with sparseMatrixStats
+       # replace with sparseMatrixStats
     } else if (methods::is(mymatrix, "Matrix")) {
         mymatrix@x <- log(mymatrix@x + offset) / log(base)
-    } else {
+    } else if(methods::is(mymatrix, 'dbMatrix')) {
+        mymatrix[] <- dplyr::mutate(mymatrix[], x = x + offset) # workaround for lack of @x slot
+        mymatrix <- log(mymatrix)/log(base)
+  } else {
         mymatrix <- log(as.matrix(mymatrix) + offset) / log(base)
     }
 
@@ -732,14 +735,56 @@ filterGiotto <- function(
         description = "_filter"
     )
 
-    return(newGiottoObject)
+  return(newGiottoObject)
+
+
 }
 
 
 
 
 ### normalization ####
 
+#' @title compute_dbMatrix
+#' @description saves dbMatrix to db if global option is set
+#' @details
+#' Set \code{options(giotto.dbmatrix_compute = FALSE)} if saving dbMatrix
+#' after each step of normalization workflow is not desired.
+#' @keywords internal
+.compute_dbMatrix <- function(dbMatrix, name, verbose = TRUE) {
+  # input validation
+  if(!inherits(dbMatrix, 'dbMatrix')) {
+    stop('dbMatrix must be of class dbMatrix')
+  }
+
+  if(!is.character(name)) {
+    stop('name must be a character')
+  }
+
+  # TODO: update with dbData generic
+  con = dbMatrix:::get_con(dbMatrix)
+
+  # overwrite table by default
+  if(name %in% DBI::dbListTables(con)) {
+    DBI::dbRemoveTable(con, name)
+  }
+
+  if(verbose){
+    msg <- glue::glue('Computing {name} expression matrix on disk...')
+    cat(msg)   
+  }
+
+  dbMatrix[] |>
+    dplyr::compute(temporary=F, name = name)
+
+  # TODO: update below with proper setters from dbMatrix
+  dbMatrix[] <- dplyr::tbl(con, name) # reassign to computed mat
+  dbMatrix@name <- name
+
+  if(verbose) cat('done \n')
+
+  return(dbMatrix)
+}
 
 #' @title RNA standard normalization
 #' @name .rna_standard_normalization
@@ -776,9 +821,6 @@ filterGiotto <- function(
     feat_names <- rownames(raw_expr[])
     col_names <- colnames(raw_expr[])
 
-
-
-
     ## 1. library size normalize
     if (library_size_norm == TRUE) {
         norm_expr <- .lib_norm_giotto(
@@ -853,6 +895,16 @@ filterGiotto <- function(
     }
 
     ## 5. create and set exprObj
+    # Save dbMatrix to db
+    compute_mat <- getOption("giotto.dbmatrix_compute", default = FALSE)
+    if(compute_mat && !is.null(norm_expr)){
+        norm_expr <- .compute_dbMatrix(
+            dbMatrix = norm_expr,
+            name = 'normalized',
+            verbose = verbose
+        ) 
+    }
+
     norm_expr <- create_expr_obj(
         name = "normalized",
         exprMat = norm_expr,
@@ -861,6 +913,15 @@ filterGiotto <- function(
         provenance = provenance,
         misc = NULL
     )
+
+    # Save dbMatrix to db
+    if(compute_mat && !is.null(norm_scaled_expr)){
+        norm_scaled_expr = .compute_dbMatrix(
+            dbMatrix = norm_scaled_expr,
+            name = 'scaled',
+            verbose = verbose
+        ) 
+    }
 
     norm_scaled_expr <- create_expr_obj(
         name = "scaled",