Browse code

fixed patternMarkers bug

Genevieve Stein-O'Brien authored on 12/03/2018 13:07:40
Showing 4 changed files

... ...
@@ -6,6 +6,7 @@
6 6
 #'@param nSets number of sets for parallelization
7 7
 #'@param outRDA name of output file
8 8
 #'@param keep logical indicating whether or not to save gene set list. Default is TRUE.
9
+#'@param path character string indicating were to save resulting data objects
9 10
 #'@export
10 11
 #'@return list with randomly generated sets of genes from whole genome data
11 12
 #'@examples \dontrun{
... ...
@@ -13,7 +14,7 @@
13 14
 #'}
14 15
 #'
15 16
 
16
-createGWCoGAPSSets <- function(D, S, nSets, simulationName)
17
+createGWCoGAPSSets <- function(D, S, nSets, simulationName, path="")
17 18
 {
18 19
     # check gene names
19 20
     if (length(unique(colnames(D))) != length(colnames(D)))
... ...
@@ -34,7 +35,7 @@ createGWCoGAPSSets <- function(D, S, nSets, simulationName)
34 35
         # partition data
35 36
         sampleD <- D[geneset,]
36 37
         sampleS <- S[geneset,]
37
-        save(sampleD, sampleS, file=paste(simulationName, "_partition_", set,
38
+        save(sampleD, sampleS, file=paste(path, simulationName, "_partition_", set,
38 39
             ".RData", sep=""));
39 40
     }
40 41
     return(simulationName)
... ...
@@ -8,12 +8,13 @@
8 8
 #' @param simulationName name used to identify files created by this simulation
9 9
 #' @param samplingRatio vector of relative quantities to use for sampling celltypes
10 10
 #' @param annotionObj vector of same length as number of columns of D 
11
+#' @param path character string indicating were to save resulting data objects. default is current working dir
11 12
 #' @return simulationName used to identify saved files
12 13
 #' @examples
13 14
 #' data(SimpSim)
14 15
 #' createscCoGAPSSets(SimpSim.D, SimpSim.S, nSets=2, "example")
15 16
 #' @export
16
-createscCoGAPSSets <- function(D, S, nSets, simulationName,samplingRatio=NULL)
17
+createscCoGAPSSets <- function(D, S, nSets, simulationName,samplingRatio=NULL,path="")
17 18
 {
18 19
     # check gene names
19 20
     if (length(unique(colnames(D))) != length(colnames(D)))
... ...
@@ -41,8 +42,7 @@ createscCoGAPSSets <- function(D, S, nSets, simulationName,samplingRatio=NULL)
41 42
         # partition data
42 43
         sampleD <- D[,cellset]
43 44
         sampleS <- S[,cellset]
44
-        save(sampleD, sampleS, file=paste(simulationName, "_partition_", set,
45
-            ".RData", sep=""));
45
+        save(sampleD, sampleS, file=paste0(path,simulationName, "_partition_", set,".RData"));
46 46
     }
47 47
     return(simulationName)
48 48
 }
... ...
@@ -8,7 +8,7 @@
8 8
 #' @param full logical indicating whether to return the ranks of each gene for each pattern
9 9
 #' @return By default a non-overlapping list of genes associated with each \code{lp}. If \code{full=TRUE} a data.frame of
10 10
 #' genes rankings with a column for each \code{lp} will also be returned.
11
-#' @export
11
+#' @export
12 12
 patternMarkers <- function(Amatrix=NA, scaledPmatrix=FALSE, Pmatrix=NA,
13 13
 threshold="all", lp=NA, full=FALSE)
14 14
 {
... ...
@@ -23,6 +23,11 @@ threshold="all", lp=NA, full=FALSE)
23 23
 
24 24
     # find the A with the highest magnitude
25 25
     Arowmax <- t(apply(Amatrix, 1, function(x) x/max(x)))
26
+    #Arowmax <- t(apply(Amatrix, 1, function(x){ 
27
+    #    if (mean(x) == 0){ return(rep(0, times=length(x))) }
28
+    #    else { return(x/max(x)) }
29
+    #})) ## this prevents NA values from creeping due to rows with zero means
30
+
26 31
     pmax<-apply(Amatrix, 1, max)
27 32
     # determine which genes are most associated with each pattern
28 33
     ssranks<-matrix(NA, nrow=nrow(Amatrix), ncol=ncol(Amatrix),dimnames=dimnames(Amatrix))#list()
... ...
@@ -63,8 +68,13 @@ threshold="all", lp=NA, full=FALSE)
63 68
     else if (threshold=="all")
64 69
     {
65 70
         pIndx<-apply(ssranks,1,which.min)
66
-        gBYp <- lapply(sort(unique(pIndx)),function(x) names(pIndx[pIndx==x]))
67
-        ssgenes.th <- lapply(1:nP, function(x) ssgenes[which(ssgenes[,x] %in% gBYp[[x]]),x])
71
+        gBYp <- list()
72
+        for(i in sort(unique(pIndx))){
73
+            gBYp[[i]]<-names(pIndx[pIndx==i])
74
+        }
75
+        ssgenes.th <- lapply(1:max(sort(unique(pIndx))), function(x) {
76
+            ssgenes[which(ssgenes[,x] %in% gBYp[[x]]),x]
77
+        })
68 78
     }
69 79
     else
70 80
     {
... ...
@@ -37,7 +37,7 @@ cluster.method="complete", ignore.NA=FALSE, bySet=FALSE, ...)
37 37
 
38 38
     #drop n<4 and get weighted Avg
39 39
     cls=sort(unique(cut))
40
-    cMNs=matrix(nrow=cnt,ncol=dim(Atot)[2])
40
+    cMNs=matrix(nrow=cnt,ncol=dim(Atot)[1])
41 41
     rownames(cMNs)=cls
42 42
     colnames(cMNs)=colnames(Atot)
43 43
 
... ...
@@ -45,18 +45,18 @@ cluster.method="complete", ignore.NA=FALSE, bySet=FALSE, ...)
45 45
     PByClust <- list()
46 46
     for(i in cls)
47 47
     {
48
-        if (is.null(dim(Atot[cut == i, ]))==TRUE)
48
+        if (is.null(dim(Atot[,cut == i ]))==TRUE)
49 49
         {
50
-            cMNs[i,] <- Atot[cut == i, ]
51
-            RtoMeanPattern[[i]] <- rep(1,length(Atot[cut == i, ]))
52
-            PByClust[[i]] <- t(as.matrix(Atot[cut == i, ]))
50
+            cMNs[i,] <- Atot[,cut == i ]
51
+            RtoMeanPattern[[i]] <- rep(1,length(Atot[,cut == i ]))
52
+            PByClust[[i]] <- t(as.matrix(Atot[,cut == i ]))
53 53
         }
54 54
         else
55 55
         {
56
-            cMNs[i,]=colMeans(Atot[cut==i,])
57
-            PByClust[[i]] <- Atot[cut==i,]
56
+            cMNs[i,]=colMeans(Atot[,cut==i])
57
+            PByClust[[i]] <- Atot[,cut==i]
58 58
             nIN=sum(cut==i)
59
-            RtoMeanPattern[[i]] <- sapply(1:nIN,function(j) {round(cor(x=Atot[cut==i,][j,],y=cMNs[i,]),3)})
59
+            RtoMeanPattern[[i]] <- sapply(1:nIN,function(j) {round(cor(x=Atot[,cut==i][j,],y=cMNs[i,]),3)})
60 60
         }
61 61
     }
62 62