helper retrieve function

ccb-hms · May 22, 2024 · 8d27779 · 8d27779
1 parent 96e292b
commit 8d27779
Show file tree

Hide file tree

Showing 2 changed files with 48 additions and 21 deletions.
diff --git a/R/getPredictionSets.R b/R/getPredictionSets.R
@@ -154,14 +154,19 @@ getPredictionSets <- function(x.query, x.cal, y.cal, onto=NULL, alpha = 0.1,
                               labels=NULL,
                               return.sc=NULL,
                               pr.name="pred.set"){
+
+    ## Sanity checks
+
     if(follow.ontology & is.null(onto)){
         stop("An ontology is required for hierarchical prediction set.
              Please provide one or ask for conformal prediction set
              (follow.ontology=FALSE)")
     }
+
     if(is.null(onto) & is.null(labels)){
         stop("Please provide cell labels (labels parameter)")
     }
+
     if(isa(x.query, "SpatialExperiment") |
        isa(x.query, "SingleCellExperiment") |
        isa(x.query, "SummarizedExperiment"))
@@ -171,6 +176,7 @@ getPredictionSets <- function(x.query, x.cal, y.cal, onto=NULL, alpha = 0.1,
     else
         stop("Please provide as input in x.query a SpatialExperiment,
               SingleCellExperiment or a matrix")
+
     if(!is.null(return.sc)){
       if(return.sc==TRUE & !sc){
         stop("If x.query is a matrix output has to be a list
@@ -187,22 +193,24 @@ getPredictionSets <- function(x.query, x.cal, y.cal, onto=NULL, alpha = 0.1,
     # If input is not a matrix, retrieve prediction matrix from colData
     # might turn this into a helper function
     if(!is.matrix(x.query)){
-        n.query <- ncol(x.query)
-        p.query <- matrix(NA, nrow=n.query, ncol=K)
-        colnames(p.query) <- labels
-        for(i in labels){
-            p.query[,i] <- colData(x.query)[[i]]
-        }
+        # n.query <- ncol(x.query)
+        # p.query <- matrix(NA, nrow=n.query, ncol=K)
+        # colnames(p.query) <- labels
+        # for(i in labels){
+        #     p.query[,i] <- colData(x.query)[[i]]
+        # }
+        p.query <- .retrievePredMatrix(x.query)
     }
     else p.query <- x.query
 
     if(!is.matrix(x.cal)){
-        n.cal <- ncol(x.cal)
-        p.cal <- matrix(NA, nrow=n.cal, ncol=K)
-        colnames(p.cal) <- labels
-        for(i in labels){
-            p.cal[,i] <- colData(x.cal)[[i]]
-        }
+        # n.cal <- ncol(x.cal)
+        # p.cal <- matrix(NA, nrow=n.cal, ncol=K)
+        # colnames(p.cal) <- labels
+        # for(i in labels){
+        #     p.cal[,i] <- colData(x.cal)[[i]]
+        # }
+        p.cal <- .retrievePredMatrix(x.cal)
     }
     else p.cal <- x.cal
 
@@ -266,3 +274,22 @@ getPredictionSets <- function(x.query, x.cal, y.cal, onto=NULL, alpha = 0.1,
     }
 
 }
+
+## function to retrieve prediction matrix from the colData of a
+## SingleCellExperiment object
+
+.retrievePredMatrix <- function(sc){
+    n.sc <- ncol(sc)
+    p.sc <- matrix(NA, nrow=n.sc, ncol=K)
+    colnames(p.sc) <- labels
+    for(i in labels){
+        p.sc[,i] <- colData(sc)[[i]]
+    }
+    return(p.sc)
+}
+
+
+
+
+
+
diff --git a/R/utils_Resample.R b/R/utils_Resample.R
@@ -19,15 +19,15 @@ resample.two <- function(p.cal, p.test, y.cal, labels){
 
     idx1 <- idx2 <- NULL
     for (i in labels) {
-      cat <- which(y.cal == i)
-      if(!is.na(des.freq1[i])){
-        idx.cat1 <- sample(cat, size = des.freq1[i], replace = TRUE)
-        idx1 <- c(idx1, idx.cat1)
-      }
-      if(!is.na(des.freq2[i])){
-        idx.cat2 <- sample(cat, size = des.freq2[i], replace = TRUE)
-        idx2 <- c(idx2, idx.cat2)
-      }
+        cat <- which(y.cal == i)
+        if(!is.na(des.freq1[i])){
+            idx.cat1 <- sample(cat, size = des.freq1[i], replace = TRUE)
+            idx1 <- c(idx1, idx.cat1)
+        }
+        if(!is.na(des.freq2[i])){
+            idx.cat2 <- sample(cat, size = des.freq2[i], replace = TRUE)
+            idx2 <- c(idx2, idx.cat2)
+        }
     }
 
     return(list(p.cal1=p.cal[idx1,],