Merge pull request #137 from BIMSBbioinfo/main

main -> dev

DESCRIPTION

@@ -9,7 +9,7 @@ Description: VoltRon is a novel spatial omic analysis toolbox for multi-omics in
 License: MIT + file LICENSE
 SystemRequirements: OpenCV 4.7 (or higher): libopencv-dev (Debian, Ubuntu) or opencv-devel (Fedora)
 Encoding: UTF-8
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
 biocViews:
 Imports: methods, S4Vectors, EBImage, FNN, Matrix, dplyr, ggforce, 
          ggplot2, ggpubr, ggrepel, hdf5r, igraph, irlba, rjson, magick, 
@@ -62,3 +62,4 @@ Suggests:
     anndata
 Config/testthat/edition: 3
 LazyData: true
+LazyDataCompression: gzip

NAMESPACE

@@ -157,9 +157,11 @@ export(getSpatialNeighbors)
 export(getUMAP)
 export(getVariableFeatures)
 export(importCosMx)
+export(importDBITSeq)
 export(importGenePS)
 export(importGeoMx)
 export(importImageData)
+export(importOpenST)
 export(importPhenoCycler)
 export(importSTOmics)
 export(importVisium)
@@ -357,6 +359,7 @@ importFrom(utils,.DollarNames)
 importFrom(utils,capture.output)
 importFrom(utils,head)
 importFrom(utils,read.csv)
+importFrom(utils,read.table)
 importFrom(uwot,umap)
 importFrom(waiter,spin_ring)
 importFrom(waiter,useWaiter)

R/assay.R

@@ -593,20 +593,29 @@ flipCoordinates.vrAssay <- function(object, image_name = NULL, spatial_name = NU
   if(!is.null(spatial_name)) 
     image_name <- spatial_name
 
+  # get coordinates
+  coords <- vrCoordinates(object, image_name = image_name, ...)
+
   # get image info
-  imageinfo <- magick::image_info(vrImages(object, name = image_name))
+  # imageinfo <- magick::image_info(vrImages(object, name = image_name))
+  image <- vrImages(object, name = image_name)
+  if(!is.null(image)){
+    imageinfo <- magick::image_info(vrImages(object, name = image_name))
+    height <- imageinfo$height
+  } else{
+    height <- max(coords[,"y"])
+  }
 
   # flip coordinates
-  coords <- vrCoordinates(object, image_name = image_name, ...)
-  coords[,"y"] <- imageinfo$height - coords[,"y"]
+  coords[,"y"] <- height - coords[,"y"]
   vrCoordinates(object, image_name = image_name, ...) <- coords
 
   # flip segments
   segments <- vrSegments(object, image_name = image_name, ...)
   if(length(segments) > 0){
     name_segments <- names(segments)
     segments <- do.call("rbind", segments)
-    segments[,"y"] <- imageinfo$height - segments[,"y"]
+    segments[,"y"] <- height - segments[,"y"]
     segments <- split(segments, segments[,1])
     names(segments) <- name_segments
     vrSegments(object, image_name = image_name, ...) <- segments

R/import.R

@@ -1368,7 +1368,7 @@ importSTOmics <- function(h5ad.path, assay_name = "STOmics", sample_name = NULL,
 
 #' readPhenoCyclerMat
 #' 
-#' Read and Load Akoya CODEX data, adapted from \code{ReadAkoya} function \code{Seurat} package
+#' Read and Load Akoya CODEX data, adapted from the \code{ReadAkoya} function \code{Seurat} package
 #'
 #' @param filename Path to matrix generated by upstream processing.
 #' @param type Specify which type matrix is being provided.
@@ -1380,6 +1380,8 @@ importSTOmics <- function(h5ad.path, assay_name = "STOmics", sample_name = NULL,
 #' @param filter A pattern to filter features by; pass \code{NA} to skip feature filtering
 #' @param inform.quant When \code{type} is \dQuote{\code{inform}}, the quantification level to read in
 #' 
+#' @importFrom methods as
+#' 
 #' @noRd
 readPhenoCyclerMat <- function(
     filename,
@@ -1438,7 +1440,8 @@ readPhenoCyclerMat <- function(
       }
       mtx <- t(x = mtx)
       if ((sum(mtx == 0) / length(x = mtx)) > ratio) {
-        mtx <- as.sparse(x = mtx)
+        # mtx <- as.sparse(x = mtx)
+        mtx <- methods::as(mtx, 'CsparseMatrix')
       }
       list(matrix = mtx, centroids = centroids, metadata = md)
     },
@@ -1523,7 +1526,8 @@ readPhenoCyclerMat <- function(
         }
         expr <- t(x = expr)
         if ((sum(expr == 0, na.rm = TRUE) / length(x = expr)) > ratio) {
-          expr <- as.sparse(x = expr)
+          # expr <- as.sparse(x = expr)
+          expr <- methods::as(expr, 'CsparseMatrix')
         }
         outs[[switch(EXPR = i, 'entire' = 'matrix', i)]] <- expr
       }
@@ -1576,7 +1580,8 @@ readPhenoCyclerMat <- function(
       }
       mtx <- t(x = mtx)
       if ((sum(mtx == 0) / length(x = mtx)) > ratio) {
-        mtx <- as.sparse(x = mtx)
+        # mtx <- as.sparse(x = mtx)
+        mtx <- methods::as(mtx, 'CsparseMatrix')
       }
       list(matrix = mtx, centroids = centroids, metadata = md)
     },
@@ -1592,7 +1597,6 @@ readPhenoCyclerMat <- function(
 #' @param assay_name the assay name of the SR object
 #' @param sample_name the name of the sample
 #' @param image_name the image name of the Xenium assay, Default: main
-#' @param filename Path to matrix generated by upstream processing.
 #' @param type Specify which type matrix is being provided.
 #' \itemize{
 #'  \item \dQuote{\code{processor}}: matrix generated by CODEX Processor
@@ -1670,6 +1674,153 @@ importPhenoCycler <- function(dir.path, assay_name = "PhenoCycler", sample_name
   object
 }
 
+####
+# Non-Commercial ####
+####
+
+####
+## OpenST ####
+####
+
+#' importOpenST
+#'
+#' Importing OpenST data
+#'
+#' @param h5ad.path path to h5ad file of STOmics output
+#' @param assay_name the assay name
+#' @param sample_name the name of the sample
+#' @param image_name the image name of the Visium assay, Default: main
+#' @param channel_name the channel name of the image of the Visium assay, Default: H&E
+#' @param ... additional parameters passed to \link{formVoltRon}
+#'
+#' @importFrom methods as
+#' @export
+importOpenST <- function(h5ad.path, assay_name = "OpenST", sample_name = NULL, image_name = "main", channel_name = "H&E", ...)
+{
+  # check Seurat package
+  if(!requireNamespace('anndataR'))
+    stop("Please install anndataR package")
+
+  # get h5ad data
+  stdata <- anndataR::read_h5ad(h5ad.path)
+
+  # observation and feature names
+  obs_names <- stdata$obs_names
+  var_names <- stdata$var_names
+
+  # raw counts
+  rawdata <- Matrix::t(stdata$X)
+  rownames(rawdata) <- var_names
+  colnames(rawdata) <- obs_names
+  rawdata <- methods::as(rawdata, 'CsparseMatrix')
+
+  # metadata
+  metadata <- stdata$obs
+  rownames(metadata) <- obs_names
+
+  # coordinates
+  coords <- stdata$obsm$spatial_3d_aligned
+  rownames(coords) <- obs_names
+
+  # get individual sections as voltron data
+  sections <- unique(metadata$n_section)
+  sections <- sections[order(sections)]
+  vr_data_list <- list()
+  message("Creating Layers ...")
+  for(i in 1:length(sections)){
+    ind <- metadata$n_section == sections[i]
+    spatialpoints <- rownames(metadata[metadata$n_section == sections[i],])
+    cur_data <- Matrix::t(rawdata[spatialpoints,])
+    cur_metadata <- metadata[spatialpoints,]
+    cur_coords <- coords[ind,c(1,2)]
+    rownames(cur_coords) <- spatialpoints
+    vr_data_list[[i]] <- formVoltRon(data = cur_data, metadata = cur_metadata, coords = cur_coords, 
+                                     main.assay = assay_name, sample_name = paste0("Section", sections[i]),
+                                     image_name = image_name, main_channel = channel_name)
+  }
+
+  # create VoltRon
+  merge(vr_data_list[[1]], vr_data_list[-1], samples = ifelse(is.null(sample_name), "Sample", sample_name))
+}
+
+####
+## DBIT-Seq ####
+####
+
+#' importDBITSeq
+#'
+#' Importing DBIT-Seq data
+#'
+#' @param path.rna path to rna count matrix
+#' @param path.prot path to protein count matrix
+#' @param size the size of the in situ pixel (defualt is 10 (micron))
+#' @param assay_name the assay name
+#' @param sample_name the name of the sample
+#' @param image_name the image name of the Visium assay, Default: main
+#' @param channel_name the channel name of the image of the Visium assay, Default: H&E
+#' @param ... additional parameters passed to \link{formVoltRon}
+#'
+#' @importFrom utils read.table
+#'
+#' @export
+importDBITSeq <- function(path.rna, path.prot = NULL, size = 10, assay_name = "DBIT-Seq", sample_name = NULL, image_name = "main", channel_name = "H&E", ...)
+{
+  # count matrix RNA
+  rnadata <- utils::read.table(path.rna, header = TRUE, sep = "\t", row.names = 1)
+  rnadata <- t(as.matrix(rnadata))
+
+  # count matrix Protein
+  protdata <- utils::read.table(path.prot, header = TRUE, sep = "\t", row.names = 1)
+  protdata <- t(as.matrix(protdata))
+
+  # coords 
+  coords <- sapply(colnames(rnadata), function(x) as.numeric(strsplit(x, split = "x")[[1]]))
+  coords <- t(coords)
+  colnames(coords) <- c("x", "y")
+
+  # get DBIT-Seq parameters
+  params <- list(
+    spot.radius = size/2,
+    vis.spot.radius = size,
+    nearestpost.distance = size*2*sqrt(2))
+  coords <- coords*size*3/2
+
+  # make voltron object
+  object <- formVoltRon(data = rnadata, coords = coords, image = NULL, assay.type = "spot", params = params, image_name = "main", 
+                        main.assay = paste0(assay_name, "-RNA"), sample_name = sample_name, ...)
+
+  # add protein assay
+  if(!is.null(path.prot)){
+
+    # create protein assay
+    new_assay <- formAssay(data = protdata,
+                           coords = coords,
+                           type = "spot")
+    new_assay@image <- object[["Assay1"]]@image
+    sample.metadata <- SampleMetadata(object)
+
+    # add new assay
+    object <- addAssay(object,
+                       assay = new_assay,
+                       metadata = Metadata(object),
+                       assay_name = paste(assay_name, "Prot", sep = "-"),
+                       sample = sample.metadata["Assay1", "Sample"],
+                       layer = sample.metadata["Assay1", "Layer"])
+
+    # add connectivity of spatial points across assays
+    connectivity <- cbind(vrSpatialPoints(object, assay = "Assay1"),
+                          vrSpatialPoints(object, assay = "Assay2"))
+    object <- addConnectivity(object,
+                              connectivity = connectivity,
+                              sample = sample.metadata["Assay1", "Sample"],
+                              layer = sample.metadata["Assay1", "Layer"])
+
+  }
+
+  # return 
+  return(object)
+}
+
 ####
 # Image Data ####
 ####

cleanup

@@ -14,3 +14,4 @@ rm -Rf .deps
 rm -Rf .deps
 rm -Rf .deps
 rm -Rf .deps
+rm -Rf .deps