Test(cleaning): cleaning the unit tests - getting the custom checker function to work for weird case where there are errors and warnings to be expected + added a renv.lock file

Author: patrickCNMartin

.Rbuildignore

@@ -1,3 +1,5 @@
+^renv$
+^renv\.lock$
 ^\.github$
 ^src/\.cargo$
 ^_pkgdown\.yml$

.Rprofile

@@ -0,0 +1 @@
+source("renv/activate.R")

R/cost.R

@@ -1,7 +1,9 @@
 #' compute fast pearson correlation between matrices
-#'
+#' @param seed matrix/sparse matrix of seed cells
+#' @param query matrix/sparse matrix of query cells
+#' @return correlation matrix between all cells in seed and query
 pearson_approx <- function(seed, query) { 
-  n <- nrow(seed) 
+  n <- nrow(seed)
   sums <- outer(colSums(query), colSums(seed)) 
   stds <- outer(apply(query, 2, sd), apply(seed, 2, sd)) 
   correlation <- (t(query) %*% seed - sums / n) / stds / n
@@ -10,7 +12,9 @@ pearson_approx <- function(seed, query) {
 
 
 
-
+#' convert niche composition into matrix format for jaccard compute
+#' @param niches list of niches with the cell composition of each niche
+#' @return matrix with columns as cells and rows as cell types
 make_composition_matrix <- function(niches){
     max_elements <- max(lengths(niches))
     barcodes <- names(niches)

R/dispatch.R

@@ -11,22 +11,22 @@
 #' @param ter_2 integer vector containing territories in group 2
 #' @param cells cell barcodes
 dispatch_territory <- function(territories, ter_1, ter_2, cells) {
-    if (is.null(ter_1) && is.null(ter_2)) {
-        territories <- select(territories, c("barcodes", "x", "y", "trial"))
-    }else if (!is.null(ter_1) && is.null(ter_2)) {
-        territories$trial[!territories$trial %in% ter_1] <- "other"
-    }else if (is.null(ter_1) && !is.null(ter_2)) {
-        territories$trial[!territories$trial %in% ter_2] <- "other"
-    }else {
-        territories$trial[!territories$trial %in% c(ter_1, ter_2)] <- "other"
-    }
-    if (!is.null(cells)) {
-        territories$trial[territories$trial %in% ter_1 &
-            territories$barcodes %in% cells] <- paste0(ter_1, collapse = " ")
-        territories$trial[territories$trial %in% ter_2 &
-            territories$barcodes %in% cells] <- paste0(ter_2, collapse = " ")
-    }
-    return(territories)
+  if (is.null(ter_1) && is.null(ter_2)) {
+    territories <- select(territories, c("barcodes", "x", "y", "trial"))
+  }else if (!is.null(ter_1) && is.null(ter_2)) {
+    territories$trial[!territories$trial %in% ter_1] <- "other"
+  }else if (is.null(ter_1) && !is.null(ter_2)) {
+    territories$trial[!territories$trial %in% ter_2] <- "other"
+  }else {
+    territories$trial[!territories$trial %in% c(ter_1, ter_2)] <- "other"
+  }
+  if (!is.null(cells)) {
+    territories$trial[territories$trial %in% ter_1 &
+      territories$barcodes %in% cells] <- paste0(ter_1, collapse = " ")
+    territories$trial[territories$trial %in% ter_2 &
+      territories$barcodes %in% cells] <- paste0(ter_2, collapse = " ")
+  }
+  return(territories)
 }
 
 
@@ -199,7 +199,9 @@ dispatch_cost_groups <- function(vesalius_assay,
 
 }
 
-
+#' clean trial annotation
+#' @param trial vector of strings with trial tag
+#' @return vector of strings with sanitize numeric value
 clean_trial <- function(trial) {
     trial <- sapply(strsplit(trial, "-"), function(str){
         return(paste0(str[seq(1, length(str) - 1)], collapse = "-"))

R/interoperability.R

@@ -5,8 +5,13 @@
 #--------------------------------/ From Vesalius /----------------------------#
 
 
-as.Seurat.vesalius_assay <- function(obj, assay = NULL) {
-
+as.Seurat.vesalius_assay <- function(obj) {
+    coord <- get_coordinates(obj)
+    counts <- get_counts(obj, type = "all")
+    raw <- counts[names(counts) == "raw"]
+    counts <- counts[names(counts) != "raw"]
+    embeddings <- get_embeddings(obj, active = FALSE)
+    img <- obj@img
 }