getSpatialParametersExternal

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: SpaceMarkers
 Title: Spatial Interaction Markers
-Version: 1.1.3
+Version: 1.1.6
 Authors@R: c(
     person(given = "Atul", family = "Deshpande", email = "[email protected]", role = c("aut", "cre"), comment = c(ORCID="0000-0001-5144-6924")),
     person(given = "Ludmila", family = "Danilova", email = "[email protected]", role = "ctb"),

R/getInteractingGenes.R

@@ -4,15 +4,14 @@
 find_pattern_hotspots <- function(
         spPatterns, params = NULL, patternName = "Pattern_1",
         outlier = "positive",
-    nullSamples = 100,...){
+    nullSamples = 100,includeSelf = TRUE,...){
     if (is.null(params)){
         sigmaPair <- 10
-        kernelthreshold <- 2
+        kernelthreshold <- 3
     } else {
         sigmaPair <- params["sigmaOpt"]
         kernelthreshold <- params["threshOpt"]
     }
-
     allwin <- spatstat.geom::owin(
         xrange = c(min(spPatterns$x),max(spPatterns$x)),yrange =c(
             min(spPatterns$y),max(spPatterns$y)))
@@ -21,6 +20,11 @@ find_pattern_hotspots <- function(
         x=spPatterns$x,y = spPatterns$y, window = allwin,marks = patternVector)
     Kact1 <- spatstat.explore::Smooth(
         X, at = "points", sigma = sigmaPair[1], ...)
+    if (includeSelf == TRUE){
+      Kact1 <- spPatterns[,patternName] + Kact1
+    } else {
+      Kact1 <- Kact1
+    }
     Karr1 <- vapply(seq(1,nullSamples),function(i){
         Xr<-X;
         spatstat.geom::marks(Xr) <- sample(spatstat.geom::marks(X));
@@ -83,17 +87,19 @@ getSpaceMarkersMetric <- function(interacting.genes){
     for (i in seq(1,length(interacting_genes)))
     {
         if (all(dim(interacting_genes[[i]])>1))   {
-            Zsign <- (2*(-1+((interacting_genes[[i]]$Dunn.zP1_Int<0)|
-                        (interacting_genes[[i]]$Dunn.zP2_Int<0))*1)+1)
-            Zmag <- (interacting_genes[[i]]$Dunn.zP1_Int)*
-                    (interacting_genes[[i]]$Dunn.zP2_Int)/
-                    (pmax(abs(interacting_genes[[i]]$Dunn.zP2_P1),1))
-                interacting_genes[[i]]$SpaceMarkersMetric <- Zsign*Zmag
-                od <- order(
-                    interacting_genes[[i]]$SpaceMarkersMetric,decreasing=TRUE)
-                interacting_genes[[i]] <- interacting_genes[[i]][od,]
-                interacting_genes[[i]] <- interacting_genes[[i]][!is.na(
-                    interacting_genes[[i]]$SpaceMarkersMetric),]
+          Zsign <- (2*(-1+((interacting_genes[[i]]$Dunn.zP1_Int<0) &
+                             (interacting_genes[[i]]$Dunn.zP2_Int<0))*1)+1)
+          Zmag <- abs((interacting_genes[[i]]$Dunn.zP1_Int)*
+                        (interacting_genes[[i]]$Dunn.zP2_Int))/
+            (pmax(abs(interacting_genes[[i]]$Dunn.zP2_P1),1))
+          Zmetric <- Zsign*Zmag
+          interacting_genes[[i]]$SpaceMarkersMetric <- sign(Zmetric) * 
+            log2(abs(Zmetric)+1)
+          od <- order(
+            interacting_genes[[i]]$SpaceMarkersMetric,decreasing=TRUE)
+          interacting_genes[[i]] <- interacting_genes[[i]][od,]
+          interacting_genes[[i]] <- interacting_genes[[i]][!is.na(
+            interacting_genes[[i]]$SpaceMarkersMetric),]
         }
     }
     return(interacting_genes)

R/getSpatialParameters.R

@@ -121,3 +121,68 @@ getSpatialParameters <- function(spatialPatterns,...){
     return(optParams)
 }
 
+#===================
+#' getSpatialParametersExternal
+#' Manually obtain Optimal Parameters for Interacting cells
+#'
+#' This function calculates obtains a specified width of a distribution
+#' (sigmaOpt) as well as the outlier threshold around the set of spots 
+#' (thresOpt) for each pattern from a latent feature space.
+#'
+#' @export
+#'
+#' @param spatialPatterns  A data frame that contains the spatial coordinates 
+#' for each cell type. The column names must include 'x' and 'y' as well as a 
+#' set of numbered columns named  'Pattern_1.....N'.
+#' @param visiumDir A string path specifying the location of the 10xVisium
+#' directory
+#' @param spatial A string path specifying the location of the spatial folder
+#' containing the .json file of the spot characteristics
+#' @param pattern A string specifying the name of the .json file
+#' @param spotDiameter A numeric value specifying your desired sigma
+#' @param threshold A numeric value specifying your hotspot threshold
+#' @return a numeric matrix of sigmaOpts - the optimal width of the gaussian 
+#' distribution, and the thresOpt - outlier threshold around the set of spots 
+#' for each pattern
+#' @examples
+#' library(SpaceMarkers)
+#' # Create test data
+#' cells <- c()
+#' test_num <- 500
+#' for(i in 1:test_num){
+#'     cells[length(cells)+1] <- paste0("cell_",i)
+#' }
+#' spPatterns <- data.frame(barcode = cells,
+#' y = runif(test_num, min=0, max=test_num),
+#' x = runif(test_num, min=0, max=test_num),
+#' Pattern_1 = runif(test_num, min=0, max=1),
+#' Pattern_2 = runif(test_num, min=0, max=1) )
+#' # Call the getSpatialParameters function with the test data
+#' optParams <- getSpatialParametersExternal(spPatterns, spotDiameter = 10)
+#'
+
+getSpatialParametersExternal <- function(spatialPatterns,visiumDir = ".",
+                                         spatialDir ="spatial",
+                                         pattern = "scalefactors_json.json",
+                                         spotDiameter = NULL,threshold = 3) {
+  patternList <- setdiff(colnames(spatialPatterns),c("barcode","x","y"))
+  if (!is.null(spotDiameter)) {
+    sigmaOpt <- spotDiameter
+    threshOpt <- threshold
+  } else if (is.null(spotDiameter)) {
+    message("Assuming Visium folder with .json file and spot diamater exists")
+    scale_json <- dir(paste0(visiumDir,"/",spatialDir),
+                      pattern = pattern,full.names = TRUE)
+    scale_values <- jsonlite::read_json(scale_json)
+    sigmaOpt <- scale_values[[4]]
+    threshOpt <- threshold
+
+  } else {
+    stop("Please specify the spot diameter")
+  }
+  optParams <-matrix(c(sigmaOpt,threshOpt),nrow = 2,ncol = length(patternList))
+  colnames(optParams) <- patternList
+  rownames(optParams) <- c("sigmaOpt","threshOpt")
+  return(optParams)
+}
+