1. CoGAPS
  2. R
  3. calcCoGAPSStat.R
Browse code

vignette for new workflow

Tom Sherman authored on 11/07/2018 16:09:37
Showing 1 changed files
R/calcCoGAPSStat.R
History View file @ dfc276e09
1 1 
deleted file mode 100644
... ... 
@@ -1,130 +0,0 @@
1 
-#' Calculate Gene Set Statistics
2 
-#'
3 
-#' @details calculates the gene set statistics for each
4 
-#' column of A using a Z-score from the elements of the A matrix,
5 
-#' the input gene set, and permutation tests
6 
-#' @param Amean A matrix mean values
7 
-#' @param Asd A matrix standard deviations
8 
-#' @param GStoGenes data.frame or list with gene sets
9 
-#' @param numPerm number of permutations for null
10 
-#' @return gene set statistics for each column of A
11 
-#' @examples
12 
-#' data('SimpSim')
13 
-#' calcCoGAPSStat(SimpSim.result$Amean, SimpSim.result$Asd, GStoGenes=GSets,
14 
-#' numPerm=500)
15 
-#' @export
16 
-calcCoGAPSStat <- function (Amean, Asd, GStoGenes, numPerm=500)
17 
-{
18 
-    # test for std dev of zero, possible mostly in simple simulations
19 
-    if (sum(Asd==0) > 0)
20 
-        Asd[Asd==0] <- 1e-6
21 
-
22 
-    # calculate Z scores
23 
-    zMatrix <- calcZ(Amean,Asd)
24 
-
25 
-    # check input arguments
26 
-    if (!is(GStoGenes, "data.frame") && !is(GStoGenes, "list") && !is(GStoGenes,"GSA.genesets"))
27 
-    {
28 
-        stop("GStoGenes must be a data.frame,GSA.genesets, or list with format specified in the users manual.")
29 
-    }
30 
-
31 
-    if (is(GStoGenes, "GSA.genesets"))
32 
-    {
33 
-        names(GStoGenes$genesets) <- GStoGenes$geneset.names
34 
-        GStoGenes <- GStoGenes$genesets
35 
-    }
36 
-
37 
-    if (is(GStoGenes, "list"))
38 
-    {
39 
-        GStoGenesList <- GStoGenes
40 
-    }
41 
-    else
42 
-    {
43 
-        GStoGenesList <- list()
44 
-        for (i in 1:dim(GStoGenes)[2])
45 
-        {
46 
-            GStoGenesList[[as.character(colnames(GStoGenes)[i])]] <- as.character(unique(GStoGenes[,i]))
47 
-        }
48 
-    }
49 
-
50 
-    # get dimensions
51 
-    numGS   <- length(names(GStoGenesList))
52 
-    numPatt <- dim(zMatrix)[2]
53 
-    numG    <- dim(zMatrix)[1]+0.9999
54 
-
55 
-    # initialize matrices
56 
-    statsUp   <- matrix(ncol = numGS, nrow = numPatt)
57 
-    statsDown <- matrix(ncol = numGS, nrow = numPatt)
58 
-    actEst    <- matrix(ncol = numGS, nrow = numPatt)
59 
-    results   <- list()
60 
-    zPerm     <- matrix(ncol=numPerm,nrow=numPatt)
61 
-
62 
-    # do permutation test
63 
-    for (gs in 1:numGS)
64 
-    {
65 
-        genes <- GStoGenesList[[names(GStoGenesList)[gs]]]
66 
-        index <- rownames(zMatrix) %in% genes
67 
-        zValues <- zMatrix[index,1]
68 
-        numGenes <- length(zValues)
69 
-        label <- as.character(numGenes)
70 
-
71 
-        if (!any(names(results)==label))
72 
-        {
73 
-            for (p in 1:numPatt)
74 
-            {
75 
-                for (j in 1:numPerm)
76 
-                {
77 
-                    temp <- floor(runif(numGenes,1,numG))
78 
-                    temp2 <- zMatrix[temp,p]
79 
-                    zPerm[p,j] <- mean(temp2)
80 
-                }
81 
-            }
82 
-            results[[label]] <- zPerm
83 
-        }
84 
-    }
85 
-
86 
-    # get p-value
87 
-    for (p in 1:numPatt)
88 
-    {
89 
-        for (gs in 1:numGS)
90 
-        {
91 
-            genes <- GStoGenesList[[names(GStoGenesList)[gs]]]
92 
-            index <- rownames(zMatrix) %in% genes
93 
-            zValues <- zMatrix[index,p]
94 
-            zScore <- mean(zValues)
95 
-
96 
-            numGenes <- length(zValues)
97 
-            label <- as.character(numGenes)
98 
-
99 
-            permzValues <- results[[label]][p,]
100 
-            ordering <- order(permzValues)
101 
-            permzValues <- permzValues[ordering]
102 
-
103 
-            statistic <- sum(zScore > permzValues)
104 
-            statUpReg <- 1 - statistic/length(permzValues)
105 
-            statsUp[p,gs] <- max(statUpReg, 1/numPerm)
106 
-
107 
-            statistic <- sum(zScore < permzValues)
108 
-            statDownReg <- 1 - statistic/length(permzValues)
109 
-            statsDown[p,gs] <- max(statDownReg,1/numPerm)
110 
-
111 
-            activity <- 1 - 2*max(statUpReg, 1/numPerm)
112 
-            actEst[p,gs] <- activity
113 
-        }
114 
-    }
115 
-
116 
-    # format output
117 
-    colnames(statsUp) <- names(GStoGenesList)
118 
-    colnames(statsDown) <- names(GStoGenesList)
119 
-    colnames(actEst) <- names(GStoGenesList)
120 
-
121 
-    rownames(statsUp) <- colnames(zMatrix)
122 
-    rownames(statsDown) <- colnames(zMatrix)
123 
-    rownames(actEst) <- colnames(zMatrix)
124 
-
125 
-    results[['GSUpreg']] <- statsUp
126 
-    results[['GSDownreg']] <- statsDown
127 
-    results[['GSActEst']] <- actEst
128 
-
129 
-    return(results)
130 
-}
Browse code

make lintr happy

Tom Sherman authored on 31/05/2018 21:28:52
Showing 1 changed files
R/calcCoGAPSStat.R
History View file @ 743777199
... ... 
@@ -128,4 +128,3 @@ calcCoGAPSStat <- function (Amean, Asd, GStoGenes, numPerm=500)
128 128
129 129 
     return(results)
130 130 
 }
131 
-
Browse code

more framework

sherman5 authored on 14/02/2018 18:44:00
Showing 1 changed files
R/calcCoGAPSStat.R
History View file @ e5201463a
... ... 
@@ -8,6 +8,11 @@
8 8 
 #' @param GStoGenes data.frame or list with gene sets
9 9 
 #' @param numPerm number of permutations for null
10 10 
 #' @return gene set statistics for each column of A
11 
+#' @examples
12 
+#' data('SimpSim')
13 
+#' calcCoGAPSStat(SimpSim.result$Amean, SimpSim.result$Asd, GStoGenes=GSets,
14 
+#' numPerm=500)
15 
+#' @export
11 16 
 calcCoGAPSStat <- function (Amean, Asd, GStoGenes, numPerm=500)
12 17 
 {
13 18 
     # test for std dev of zero, possible mostly in simple simulations
Browse code

passing BioC checks - removed exported function without working examples

sherman5 authored on 29/01/2018 16:21:13
Showing 1 changed files
R/calcCoGAPSStat.R
History View file @ ae8a824e4
... ... 
@@ -8,13 +8,6 @@
8 8 
 #' @param GStoGenes data.frame or list with gene sets
9 9 
 #' @param numPerm number of permutations for null
10 10 
 #' @return gene set statistics for each column of A
11 
-#' @examples
12 
-#' # Load the sample data from CoGAPS
13 
-#' data(SimpSim)
14 
-#' # Run calcCoGAPSStat with the correct arguments from 'results'
15 
-#' calcCoGAPSStat(SimpSim.result$Amean, SimpSim.result$Asd,
16 
-#' GStoGenes=GSets, numPerm=500)
17 
-#' @export
18 11 
 calcCoGAPSStat <- function (Amean, Asd, GStoGenes, numPerm=500)
19 12 
 {
20 13 
     # test for std dev of zero, possible mostly in simple simulations
... ... 
@@ -24,29 +17,30 @@ calcCoGAPSStat <- function (Amean, Asd, GStoGenes, numPerm=500)
24 17 
     # calculate Z scores
25 18 
     zMatrix <- calcZ(Amean,Asd)
26 19
20 
+    # check input arguments
21 
+    if (!is(GStoGenes, "data.frame") && !is(GStoGenes, "list") && !is(GStoGenes,"GSA.genesets"))
22 
+    {
23 
+        stop("GStoGenes must be a data.frame,GSA.genesets, or list with format specified in the users manual.")
24 
+    }
25 
+
27 26 
     if (is(GStoGenes, "GSA.genesets"))
28 27 
     {
29 28 
         names(GStoGenes$genesets) <- GStoGenes$geneset.names
30 29 
         GStoGenes <- GStoGenes$genesets
31 30 
     }
32 
-    else if (is(GStoGenes, "list"))
31 
+
32 
+    if (is(GStoGenes, "list"))
33 33 
     {
34 34 
         GStoGenesList <- GStoGenes
35 35 
     }
36 
-    else if (is(GStoGenes, "data.frame"))
36 
+    else
37 37 
     {
38 38 
         GStoGenesList <- list()
39 39 
         for (i in 1:dim(GStoGenes)[2])
40 40 
         {
41 
-            GStoGenesList[[as.character(colnames(GStoGenes)[i])]] <-
42 
-                as.character(unique(GStoGenes[,i]))
41 
+            GStoGenesList[[as.character(colnames(GStoGenes)[i])]] <- as.character(unique(GStoGenes[,i]))
43 42 
         }
44 43 
     }
45 
-    else
46 
-    {
47 
-        stop(paste("GStoGenes must be a data.frame, GSA.genesets, or list with",
48 
-            "format specified in the users manual."))
49 
-    }
50 44
51 45 
     # get dimensions
52 46 
     numGS   <- length(names(GStoGenesList))
Browse code

more doc updates, some examples still failing

sherman5 authored on 26/01/2018 21:36:40
Showing 1 changed files
R/calcCoGAPSStat.R
History View file @ 21c02aff9
... ... 
@@ -19,10 +19,7 @@ calcCoGAPSStat <- function (Amean, Asd, GStoGenes, numPerm=500)
19 19 
 {
20 20 
     # test for std dev of zero, possible mostly in simple simulations
21 21 
     if (sum(Asd==0) > 0)
22 
-    {
23 
-        #temp <- min(Asd[Asd>0])
24 
-        Asd[Asd==0] <- .Machine$double.eps
25 
-    }
22 
+        Asd[Asd==0] <- 1e-6
26 23
27 24 
     # calculate Z scores
28 25 
     zMatrix <- calcZ(Amean,Asd)
Browse code

more warning clean up

sherman5 authored on 26/01/2018 20:18:09
Showing 1 changed files
R/calcCoGAPSStat.R
History View file @ f62e7b273
... ... 
@@ -1,19 +1,19 @@
1 1 
 #' Calculate Gene Set Statistics
2 2 
 #'
3 3 
 #' @details calculates the gene set statistics for each
4 
-#'  column of A using a Z-score from the elements of the A matrix,
5 
-#'  the input gene set, and permutation tests
4 
+#' column of A using a Z-score from the elements of the A matrix,
5 
+#' the input gene set, and permutation tests
6 6 
 #' @param Amean A matrix mean values
7 7 
 #' @param Asd A matrix standard deviations
8 8 
 #' @param GStoGenes data.frame or list with gene sets
9 9 
 #' @param numPerm number of permutations for null
10 
+#' @return gene set statistics for each column of A
10 11 
 #' @examples
11 
-#' # Load the simulated data
12 
-#' data('SimpSim')
13 
-#' # Load the outputs from gapsRun
14 
-#' data('results')
12 
+#' # Load the sample data from CoGAPS
13 
+#' data(SimpSim)
15 14 
 #' # Run calcCoGAPSStat with the correct arguments from 'results'
16 
-#' calcCoGAPSStat(results$Amean,results$Asd,GStoGenes=GSets,numPerm=500)
15 
+#' calcCoGAPSStat(SimpSim.result$Amean, SimpSim.result$Asd,
16 
+#' GStoGenes=GSets, numPerm=500)
17 17 
 #' @export
18 18 
 calcCoGAPSStat <- function (Amean, Asd, GStoGenes, numPerm=500)
19 19 
 {
Browse code

merge

sherman5 authored on 26/01/2018 17:53:51
Showing 0 changed files
Browse code

cleaning up notes for v3

sherman5 authored on 24/01/2018 23:38:02
Showing 1 changed files
R/calcCoGAPSStat.R
History View file @ 536217d8d
1 1 
new file mode 100644
... ... 
@@ -0,0 +1,127 @@
1 
+#' Calculate Gene Set Statistics
2 
+#'
3 
+#' @details calculates the gene set statistics for each
4 
+#'  column of A using a Z-score from the elements of the A matrix,
5 
+#'  the input gene set, and permutation tests
6 
+#' @param Amean A matrix mean values
7 
+#' @param Asd A matrix standard deviations
8 
+#' @param GStoGenes data.frame or list with gene sets
9 
+#' @param numPerm number of permutations for null
10 
+#' @export
11 
+calcCoGAPSStat <- function (Amean, Asd, GStoGenes, numPerm=500)
12 
+{
13 
+    # test for std dev of zero, possible mostly in simple simulations
14 
+    if (sum(Asd==0) > 0)
15 
+    {
16 
+        #temp <- min(Asd[Asd>0])
17 
+        Asd[Asd==0] <- .Machine$double.eps
18 
+    }
19 
+
20 
+    # calculate Z scores
21 
+    zMatrix <- calcZ(Amean,Asd)
22 
+
23 
+    if (is(GStoGenes, "GSA.genesets"))
24 
+    {
25 
+        names(GStoGenes$genesets) <- GStoGenes$geneset.names
26 
+        GStoGenes <- GStoGenes$genesets
27 
+    }
28 
+    else if (is(GStoGenes, "list"))
29 
+    {
30 
+        GStoGenesList <- GStoGenes
31 
+    }
32 
+    else if (is(GStoGenes, "data.frame"))
33 
+    {
34 
+        GStoGenesList <- list()
35 
+        for (i in 1:dim(GStoGenes)[2])
36 
+        {
37 
+            GStoGenesList[[as.character(colnames(GStoGenes)[i])]] <-
38 
+                as.character(unique(GStoGenes[,i]))
39 
+        }
40 
+    }
41 
+    else
42 
+    {
43 
+        stop(paste("GStoGenes must be a data.frame, GSA.genesets, or list with",
44 
+            "format specified in the users manual."))
45 
+    }
46 
+
47 
+    # get dimensions
48 
+    numGS   <- length(names(GStoGenesList))
49 
+    numPatt <- dim(zMatrix)[2]
50 
+    numG    <- dim(zMatrix)[1]+0.9999
51 
+
52 
+    # initialize matrices
53 
+    statsUp   <- matrix(ncol = numGS, nrow = numPatt)
54 
+    statsDown <- matrix(ncol = numGS, nrow = numPatt)
55 
+    actEst    <- matrix(ncol = numGS, nrow = numPatt)
56 
+    results   <- list()
57 
+    zPerm     <- matrix(ncol=numPerm,nrow=numPatt)
58 
+
59 
+    # do permutation test
60 
+    for (gs in 1:numGS)
61 
+    {
62 
+        genes <- GStoGenesList[[names(GStoGenesList)[gs]]]
63 
+        index <- rownames(zMatrix) %in% genes
64 
+        zValues <- zMatrix[index,1]
65 
+        numGenes <- length(zValues)
66 
+        label <- as.character(numGenes)
67 
+
68 
+        if (!any(names(results)==label))
69 
+        {
70 
+            for (p in 1:numPatt)
71 
+            {
72 
+                for (j in 1:numPerm)
73 
+                {
74 
+                    temp <- floor(runif(numGenes,1,numG))
75 
+                    temp2 <- zMatrix[temp,p]
76 
+                    zPerm[p,j] <- mean(temp2)
77 
+                }
78 
+            }
79 
+            results[[label]] <- zPerm
80 
+        }
81 
+    }
82 
+
83 
+    # get p-value
84 
+    for (p in 1:numPatt)
85 
+    {
86 
+        for (gs in 1:numGS)
87 
+        {
88 
+            genes <- GStoGenesList[[names(GStoGenesList)[gs]]]
89 
+            index <- rownames(zMatrix) %in% genes
90 
+            zValues <- zMatrix[index,p]
91 
+            zScore <- mean(zValues)
92 
+
93 
+            numGenes <- length(zValues)
94 
+            label <- as.character(numGenes)
95 
+
96 
+            permzValues <- results[[label]][p,]
97 
+            ordering <- order(permzValues)
98 
+            permzValues <- permzValues[ordering]
99 
+
100 
+            statistic <- sum(zScore > permzValues)
101 
+            statUpReg <- 1 - statistic/length(permzValues)
102 
+            statsUp[p,gs] <- max(statUpReg, 1/numPerm)
103 
+
104 
+            statistic <- sum(zScore < permzValues)
105 
+            statDownReg <- 1 - statistic/length(permzValues)
106 
+            statsDown[p,gs] <- max(statDownReg,1/numPerm)
107 
+
108 
+            activity <- 1 - 2*max(statUpReg, 1/numPerm)
109 
+            actEst[p,gs] <- activity
110 
+        }
111 
+    }
112 
+
113 
+    # format output
114 
+    colnames(statsUp) <- names(GStoGenesList)
115 
+    colnames(statsDown) <- names(GStoGenesList)
116 
+    colnames(actEst) <- names(GStoGenesList)
117 
+
118 
+    rownames(statsUp) <- colnames(zMatrix)
119 
+    rownames(statsDown) <- colnames(zMatrix)
120 
+    rownames(actEst) <- colnames(zMatrix)
121 
+
122 
+    results[['GSUpreg']] <- statsUp
123 
+    results[['GSDownreg']] <- statsDown
124 
+    results[['GSActEst']] <- actEst
125 
+
126 
+    return(results)
127 
+}
0 128 
\ No newline at end of file
Browse code

New examples

Maggie Wodicka authored on 24/01/2018 16:02:01
Showing 1 changed files
R/calcCoGAPSStat.R
History View file @ 073c00df0
... ... 
@@ -16,6 +16,13 @@
16 16 
 #'@param Asd A matrix standard deviations
17 17 
 #'@param GStoGenes data.frame or list with gene sets
18 18 
 #'@param numPerm number of permutations for null
19 
+#'@examples
20 
+#' # Load the simulated data
21 
+#' data('SimpSim')
22 
+#' # Load the outputs from gapsRun
23 
+#' data('results')
24 
+#' # Run calcCoGAPSStat with the correct arguments from 'results'
25 
+#' calcCoGAPSStat(results$Amean,results$Asd,GStoGenes=GSets,numPerm=500)
19 26 
 #'@export
20 27
21 28 
 calcCoGAPSStat <- function (Amean, Asd, GStoGenes, numPerm=500) {
Browse code

clean up CoGAPS interface

sherman5 authored on 23/01/2018 16:29:50
Showing 1 changed files
R/calcCoGAPSStat.R
History View file @ ad6cc2029
1 1 
deleted file mode 100644
... ... 
@@ -1,130 +0,0 @@
1 
-# calcCoGAPSStat: calculate gene set statistics for A matrix columns
2 
-# History: v1.0 EJF original CoGAPS
3 
-
4 
-# Inputs: Amean - A matrix mean values
5 
-#         Asd - A matrix standard deviations
6 
-#         GStoGenes - data.frame, GSA.genesets class, or list with gene sets
7 
-#         numPerm - number of permutations for null
8 
-
9 
-# Output: list with gene set statistics
10 
-
11 
-#'\code{calcCoGAPSStat} calculates the gene set statistics for each
12 
-#'column of A using a Z-score from the elements of the A matrix,
13 
-#'the input gene set, and permutation tests
14 
-#'
15 
-#'@param Amean A matrix mean values
16 
-#'@param Asd A matrix standard deviations
17 
-#'@param GStoGenes data.frame or list with gene sets
18 
-#'@param numPerm number of permutations for null
19 
-#'@export
20 
-
21 
-calcCoGAPSStat <- function (Amean, Asd, GStoGenes, numPerm=500) {
22 
-
23 
-  # test for std dev of zero, possible mostly in simple simulations
24 
-  if (sum(Asd==0) > 0) {
25 
-      #temp <- min(Asd[Asd>0])
26 
-      Asd[Asd==0] <- .Machine$double.eps
27 
-  }
28 
-
29 
-  # calculate Z scores
30 
-  zMatrix <- calcZ(Amean,Asd)
31 
-
32 
-  # compute the p-value for each gene set belonging to each pattern
33 
-
34 
-  # check input arguments
35 
-  if (!is(GStoGenes, "data.frame") && !is(GStoGenes, "list") && !is(GStoGenes,"GSA.genesets")) {
36 
-    stop("GStoGenes must be a data.frame,GSA.genesets, or list with format specified in the users manual.")
37 
-  }
38 
-
39 
-  if (is(GStoGenes, "GSA.genesets")) {
40 
-    names(GStoGenes$genesets) <- GStoGenes$geneset.names
41 
-    GStoGenes <- GStoGenes$genesets
42 
-  }
43 
-
44 
-  if (is(GStoGenes, "list")) {
45 
-    GStoGenesList <- GStoGenes
46 
-  } else {
47 
-    GStoGenesList <- list()
48 
-    for (i in 1:dim(GStoGenes)[2]) {
49 
-      GStoGenesList[[as.character(colnames(GStoGenes)[i])]] <- as.character(unique(GStoGenes[,i]))
50 
-    }
51 
-  }
52 
-
53 
-  # get dimensions
54 
-  numGS   <- length(names(GStoGenesList))
55 
-  numPatt <- dim(zMatrix)[2]
56 
-  numG    <- dim(zMatrix)[1]+0.9999
57 
-
58 
-  # initialize matrices
59 
-  statsUp   <- matrix(ncol = numGS, nrow = numPatt)
60 
-  statsDown <- matrix(ncol = numGS, nrow = numPatt)
61 
-  actEst    <- matrix(ncol = numGS, nrow = numPatt)
62 
-  results   <- list()
63 
-  zPerm     <- matrix(ncol=numPerm,nrow=numPatt)
64 
-
65 
-  # do permutation test
66 
-  for (gs in 1:numGS) {
67 
-    genes <- GStoGenesList[[names(GStoGenesList)[gs]]]
68 
-    index <- rownames(zMatrix) %in% genes
69 
-    zValues <- zMatrix[index,1]
70 
-    numGenes <- length(zValues)
71 
-    label <- as.character(numGenes)
72 
-
73 
-    if (!any(names(results)==label)) {
74 
-      for (p in 1:numPatt) {
75 
-        for (j in 1:numPerm) {
76 
-          temp <- floor(runif(numGenes,1,numG))
77 
-          temp2 <- zMatrix[temp,p]
78 
-          zPerm[p,j] <- mean(temp2)
79 
-        }
80 
-      }
81 
-      results[[label]] <- zPerm
82 
-    }
83 
-  }
84 
-
85 
-# get p-value
86 
-  for (p in 1:numPatt) {
87 
-
88 
-    for (gs in 1:numGS) {
89 
-
90 
-      genes <- GStoGenesList[[names(GStoGenesList)[gs]]]
91 
-      index <- rownames(zMatrix) %in% genes
92 
-      zValues <- zMatrix[index,p]
93 
-      zScore <- mean(zValues)
94 
-
95 
-      numGenes <- length(zValues)
96 
-      label <- as.character(numGenes)
97 
-
98 
-      permzValues <- results[[label]][p,]
99 
-      ordering <- order(permzValues)
100 
-      permzValues <- permzValues[ordering]
101 
-
102 
-      statistic <- sum(zScore > permzValues)
103 
-      statUpReg <- 1 - statistic/length(permzValues)
104 
-      statsUp[p,gs] <- max(statUpReg, 1/numPerm)
105 
-
106 
-      statistic <- sum(zScore < permzValues)
107 
-      statDownReg <- 1 - statistic/length(permzValues)
108 
-      statsDown[p,gs] <- max(statDownReg,1/numPerm)
109 
-
110 
-      activity <- 1 - 2*max(statUpReg, 1/numPerm)
111 
-      actEst[p,gs] <- activity
112 
-    }
113 
-
114 
-  }
115 
-
116 
-  # format output
117 
-  colnames(statsUp) <- names(GStoGenesList)
118 
-  colnames(statsDown) <- names(GStoGenesList)
119 
-  colnames(actEst) <- names(GStoGenesList)
120 
-
121 
-  rownames(statsUp) <- colnames(zMatrix)
122 
-  rownames(statsDown) <- colnames(zMatrix)
123 
-  rownames(actEst) <- colnames(zMatrix)
124 
-
125 
-  results[['GSUpreg']] <- statsUp
126 
-  results[['GSDownreg']] <- statsDown
127 
-  results[['GSActEst']] <- actEst
128 
-
129 
-  return(results)
130 
-}
Browse code

Remove trailing whitespaces

Jacob Carey authored on 30/12/2015 00:47:37
Showing 1 changed files
R/calcCoGAPSStat.R
History View file @ cb4957f42
... ... 
@@ -1,12 +1,12 @@
1 1 
 # calcCoGAPSStat: calculate gene set statistics for A matrix columns
2 
-# History: v1.0 EJF original CoGAPS
2 
+# History: v1.0 EJF original CoGAPS
3 3
4 4 
 # Inputs: Amean - A matrix mean values
5 5 
 #         Asd - A matrix standard deviations
6 6 
 #         GStoGenes - data.frame, GSA.genesets class, or list with gene sets
7 7 
 #         numPerm - number of permutations for null
8 8
9 
-# Output: list with gene set statistics
9 
+# Output: list with gene set statistics
10 10
11 11 
 #'\code{calcCoGAPSStat} calculates the gene set statistics for each
12 12 
 #'column of A using a Z-score from the elements of the A matrix,
... ... 
@@ -25,10 +25,10 @@ calcCoGAPSStat <- function (Amean, Asd, GStoGenes, numPerm=500) {
25 25 
       #temp <- min(Asd[Asd>0])
26 26 
       Asd[Asd==0] <- .Machine$double.eps
27 27 
   }
28 
-
28 
+
29 29 
   # calculate Z scores
30 30 
   zMatrix <- calcZ(Amean,Asd)
31 
-
31 
+
32 32 
   # compute the p-value for each gene set belonging to each pattern
33 33
34 34 
   # check input arguments
... ... 
@@ -40,7 +40,7 @@ calcCoGAPSStat <- function (Amean, Asd, GStoGenes, numPerm=500) {
40 40 
     names(GStoGenes$genesets) <- GStoGenes$geneset.names
41 41 
     GStoGenes <- GStoGenes$genesets
42 42 
   }
43 
-
43 
+
44 44 
   if (is(GStoGenes, "list")) {
45 45 
     GStoGenesList <- GStoGenes
46 46 
   } else {
... ... 
@@ -49,7 +49,7 @@ calcCoGAPSStat <- function (Amean, Asd, GStoGenes, numPerm=500) {
49 49 
       GStoGenesList[[as.character(colnames(GStoGenes)[i])]] <- as.character(unique(GStoGenes[,i]))
50 50 
     }
51 51 
   }
52 
-
52 
+
53 53 
   # get dimensions
54 54 
   numGS   <- length(names(GStoGenesList))
55 55 
   numPatt <- dim(zMatrix)[2]
... ... 
@@ -59,7 +59,7 @@ calcCoGAPSStat <- function (Amean, Asd, GStoGenes, numPerm=500) {
59 59 
   statsUp   <- matrix(ncol = numGS, nrow = numPatt)
60 60 
   statsDown <- matrix(ncol = numGS, nrow = numPatt)
61 61 
   actEst    <- matrix(ncol = numGS, nrow = numPatt)
62 
-  results   <- list()
62 
+  results   <- list()
63 63 
   zPerm     <- matrix(ncol=numPerm,nrow=numPatt)
64 64
65 65 
   # do permutation test
... ... 
@@ -69,7 +69,7 @@ calcCoGAPSStat <- function (Amean, Asd, GStoGenes, numPerm=500) {
69 69 
     zValues <- zMatrix[index,1]
70 70 
     numGenes <- length(zValues)
71 71 
     label <- as.character(numGenes)
72 
-
72 
+
73 73 
     if (!any(names(results)==label)) {
74 74 
       for (p in 1:numPatt) {
75 75 
         for (j in 1:numPerm) {
... ... 
@@ -100,11 +100,11 @@ calcCoGAPSStat <- function (Amean, Asd, GStoGenes, numPerm=500) {
100 100 
       permzValues <- permzValues[ordering]
101 101
102 102 
       statistic <- sum(zScore > permzValues)
103 
-      statUpReg <- 1 - statistic/length(permzValues)
103 
+      statUpReg <- 1 - statistic/length(permzValues)
104 104 
       statsUp[p,gs] <- max(statUpReg, 1/numPerm)
105 105
106 106 
       statistic <- sum(zScore < permzValues)
107 
-      statDownReg <- 1 - statistic/length(permzValues)
107 
+      statDownReg <- 1 - statistic/length(permzValues)
108 108 
       statsDown[p,gs] <- max(statDownReg,1/numPerm)
109 109
110 110 
       activity <- 1 - 2*max(statUpReg, 1/numPerm)
... ... 
@@ -124,7 +124,7 @@ calcCoGAPSStat <- function (Amean, Asd, GStoGenes, numPerm=500) {
124 124
125 125 
   results[['GSUpreg']] <- statsUp
126 126 
   results[['GSDownreg']] <- statsDown
127 
-  results[['GSActEst']] <- actEst
128 
-
127 
+  results[['GSActEst']] <- actEst
128 
+
129 129 
   return(results)
130 130 
 }
Browse code

Replace tabs with spaces

Jacob Carey authored on 29/12/2015 20:11:04
Showing 1 changed files
R/calcCoGAPSStat.R
History View file @ c3f405d3b
... ... 
@@ -40,7 +40,7 @@ calcCoGAPSStat <- function (Amean, Asd, GStoGenes, numPerm=500) {
40 40 
     names(GStoGenes$genesets) <- GStoGenes$geneset.names
41 41 
     GStoGenes <- GStoGenes$genesets
42 42 
   }
43 
-
43 
+
44 44 
   if (is(GStoGenes, "list")) {
45 45 
     GStoGenesList <- GStoGenes
46 46 
   } else {
Browse code

added interface to GSA style gene sets in CoGAPS statistic

git-svn-id: https://hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/CoGAPS@110270 bc3139a8-67e5-0310-9ffc-ced21a209358

e.fertig authored on 03/11/2015 20:36:42
Showing 1 changed files
R/calcCoGAPSStat.R
History View file @ f1bfd027e
... ... 
@@ -3,7 +3,7 @@
3 3
4 4 
 # Inputs: Amean - A matrix mean values
5 5 
 #         Asd - A matrix standard deviations
6 
-#         GStoGenes - data.frame or list with gene sets
6 
+#         GStoGenes - data.frame, GSA.genesets class, or list with gene sets
7 7 
 #         numPerm - number of permutations for null
8 8
9 9 
 # Output: list with gene set statistics
... ... 
@@ -32,8 +32,13 @@ calcCoGAPSStat <- function (Amean, Asd, GStoGenes, numPerm=500) {
32 32 
   # compute the p-value for each gene set belonging to each pattern
33 33
34 34 
   # check input arguments
35 
-  if (!is(GStoGenes, "data.frame") && !is(GStoGenes, "list")) {
36 
-    stop("GStoGenes must be a data.frame or list with format specified in the users manual.")
35 
+  if (!is(GStoGenes, "data.frame") && !is(GStoGenes, "list") && !is(GStoGenes,"GSA.genesets")) {
36 
+    stop("GStoGenes must be a data.frame,GSA.genesets, or list with format specified in the users manual.")
37 
+  }
38 
+
39 
+  if (is(GStoGenes, "GSA.genesets")) {
40 
+    names(GStoGenes$genesets) <- GStoGenes$geneset.names
41 
+    GStoGenes <- GStoGenes$genesets
37 42 
   }
38 43
39 44 
   if (is(GStoGenes, "list")) {
Browse code

fixed bug in calcCoGAPSStat

git-svn-id: https://hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/CoGAPS@102032 bc3139a8-67e5-0310-9ffc-ced21a209358

e.fertig authored on 07/04/2015 16:12:31
Showing 1 changed files
R/calcCoGAPSStat.R
History View file @ bf80dcbc1
... ... 
@@ -22,8 +22,8 @@ calcCoGAPSStat <- function (Amean, Asd, GStoGenes, numPerm=500) {
22 22
23 23 
   # test for std dev of zero, possible mostly in simple simulations
24 24 
   if (sum(Asd==0) > 0) {
25 
-      temp <- min(Asd[Asd>0])
26 
-      Asd[Asd==0] <- temp
25 
+      #temp <- min(Asd[Asd>0])
26 
+      Asd[Asd==0] <- .Machine$double.eps
27 27 
   }
28 28
29 29 
   # calculate Z scores
... ... 
@@ -90,7 +90,7 @@ calcCoGAPSStat <- function (Amean, Asd, GStoGenes, numPerm=500) {
90 90 
       numGenes <- length(zValues)
91 91 
       label <- as.character(numGenes)
92 92
93 
-      permzValues <- results[[label]]
93 
+      permzValues <- results[[label]][p,]
94 94 
       ordering <- order(permzValues)
95 95 
       permzValues <- permzValues[ordering]
96 96
Browse code

New working version with boost in place of JAGS

git-svn-id: https://hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/CoGAPS@94364 bc3139a8-67e5-0310-9ffc-ced21a209358

e.fertig authored on 22/09/2014 17:32:24
Showing 1 changed files
R/calcCoGAPSStat.R
History View file @ 53d667e0e
... ... 
@@ -1,5 +1,31 @@
1 
+# calcCoGAPSStat: calculate gene set statistics for A matrix columns
2 
+# History: v1.0 EJF original CoGAPS
3 
+
4 
+# Inputs: Amean - A matrix mean values
5 
+#         Asd - A matrix standard deviations
6 
+#         GStoGenes - data.frame or list with gene sets
7 
+#         numPerm - number of permutations for null
8 
+
9 
+# Output: list with gene set statistics
10 
+
11 
+#'\code{calcCoGAPSStat} calculates the gene set statistics for each
12 
+#'column of A using a Z-score from the elements of the A matrix,
13 
+#'the input gene set, and permutation tests
14 
+#'
15 
+#'@param Amean A matrix mean values
16 
+#'@param Asd A matrix standard deviations
17 
+#'@param GStoGenes data.frame or list with gene sets
18 
+#'@param numPerm number of permutations for null
19 
+#'@export
20 
+
1 21 
 calcCoGAPSStat <- function (Amean, Asd, GStoGenes, numPerm=500) {
2 22
23 
+  # test for std dev of zero, possible mostly in simple simulations
24 
+  if (sum(Asd==0) > 0) {
25 
+      temp <- min(Asd[Asd>0])
26 
+      Asd[Asd==0] <- temp
27 
+  }
28 
+
3 29 
   # calculate Z scores
4 30 
   zMatrix <- calcZ(Amean,Asd)
5 31
... ... 
@@ -28,7 +54,7 @@ calcCoGAPSStat <- function (Amean, Asd, GStoGenes, numPerm=500) {
28 54 
   statsUp   <- matrix(ncol = numGS, nrow = numPatt)
29 55 
   statsDown <- matrix(ncol = numGS, nrow = numPatt)
30 56 
   actEst    <- matrix(ncol = numGS, nrow = numPatt)
31 
-  results   <- new.env()
57 
+  results   <- list()
32 58 
   zPerm     <- matrix(ncol=numPerm,nrow=numPatt)
33 59
34 60 
   # do permutation test
... ... 
@@ -39,7 +65,7 @@ calcCoGAPSStat <- function (Amean, Asd, GStoGenes, numPerm=500) {
39 65 
     numGenes <- length(zValues)
40 66 
     label <- as.character(numGenes)
41 67
42 
-    if (!exists(label,envir=results)) {
68 
+    if (!any(names(results)==label)) {
43 69 
       for (p in 1:numPatt) {
44 70 
         for (j in 1:numPerm) {
45 71 
           temp <- floor(runif(numGenes,1,numG))
... ... 
@@ -47,11 +73,11 @@ calcCoGAPSStat <- function (Amean, Asd, GStoGenes, numPerm=500) {
47 73 
           zPerm[p,j] <- mean(temp2)
48 74 
         }
49 75 
       }
50 
-      assign(label,zPerm,envir=results)
76 
+      results[[label]] <- zPerm
51 77 
     }
52 78 
   }
53 79
54 
-  # get p-value
80 
+# get p-value
55 81 
   for (p in 1:numPatt) {
56 82
57 83 
     for (gs in 1:numGS) {
... ... 
@@ -64,7 +90,7 @@ calcCoGAPSStat <- function (Amean, Asd, GStoGenes, numPerm=500) {
64 90 
       numGenes <- length(zValues)
65 91 
       label <- as.character(numGenes)
66 92
67 
-      permzValues <- get(label, envir=results)[p,]
93 
+      permzValues <- results[[label]]
68 94 
       ordering <- order(permzValues)
69 95 
       permzValues <- permzValues[ordering]
70 96
... ... 
@@ -91,9 +117,9 @@ calcCoGAPSStat <- function (Amean, Asd, GStoGenes, numPerm=500) {
91 117 
   rownames(statsDown) <- colnames(zMatrix)
92 118 
   rownames(actEst) <- colnames(zMatrix)
93 119
94 
-  assign('GSUpreg', statsUp, envir=results)
95 
-  assign('GSDownreg', statsDown, envir=results)
96 
-  assign('GSActEst', actEst, envir=results)
120 
+  results[['GSUpreg']] <- statsUp
121 
+  results[['GSDownreg']] <- statsDown
122 
+  results[['GSActEst']] <- actEst
97 123
98 124 
   return(results)
99 125 
 }
Browse code

env to envir

git-svn-id: https://hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/CoGAPS@69651 bc3139a8-67e5-0310-9ffc-ced21a209358

e.fertig authored on 21/09/2012 02:13:52
Showing 1 changed files
R/calcCoGAPSStat.R
History View file @ 268f9c2c8
... ... 
@@ -39,7 +39,7 @@ calcCoGAPSStat <- function (Amean, Asd, GStoGenes, numPerm=500) {
39 39 
     numGenes <- length(zValues)
40 40 
     label <- as.character(numGenes)
41 41
42 
-    if (!exists(label,env=results)) {
42 
+    if (!exists(label,envir=results)) {
43 43 
       for (p in 1:numPatt) {
44 44 
         for (j in 1:numPerm) {
45 45 
           temp <- floor(runif(numGenes,1,numG))
... ... 
@@ -47,7 +47,7 @@ calcCoGAPSStat <- function (Amean, Asd, GStoGenes, numPerm=500) {
47 47 
           zPerm[p,j] <- mean(temp2)
48 48 
         }
49 49 
       }
50 
-      assign(label,zPerm,env=results)
50 
+      assign(label,zPerm,envir=results)
51 51 
     }
52 52 
   }
53 53
... ... 
@@ -64,7 +64,7 @@ calcCoGAPSStat <- function (Amean, Asd, GStoGenes, numPerm=500) {
64 64 
       numGenes <- length(zValues)
65 65 
       label <- as.character(numGenes)
66 66
67 
-      permzValues <- get(label, env=results)[p,]
67 
+      permzValues <- get(label, envir=results)[p,]
68 68 
       ordering <- order(permzValues)
69 69 
       permzValues <- permzValues[ordering]
70 70
... ... 
@@ -91,9 +91,9 @@ calcCoGAPSStat <- function (Amean, Asd, GStoGenes, numPerm=500) {
91 91 
   rownames(statsDown) <- colnames(zMatrix)
92 92 
   rownames(actEst) <- colnames(zMatrix)
93 93
94 
-  assign('GSUpreg', statsUp, env=results)
95 
-  assign('GSDownreg', statsDown, env=results)
96 
-  assign('GSActEst', actEst, env=results)
94 
+  assign('GSUpreg', statsUp, envir=results)
95 
+  assign('GSDownreg', statsDown, envir=results)
96 
+  assign('GSActEst', actEst, envir=results)
97 97
98 98 
   return(results)
99 99 
 }
Browse code

Added the CoGAPS package.

git-svn-id: https://hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/CoGAPS@48067 bc3139a8-67e5-0310-9ffc-ced21a209358

c.wong authored on 12/07/2010 17:26:34
Showing 1 changed files
R/calcCoGAPSStat.R
History View file @ 91ea18cc4
1 1 
new file mode 100644
... ... 
@@ -0,0 +1,99 @@
1 
+calcCoGAPSStat <- function (Amean, Asd, GStoGenes, numPerm=500) {
2 
+
3 
+  # calculate Z scores
4 
+  zMatrix <- calcZ(Amean,Asd)
5 
+
6 
+  # compute the p-value for each gene set belonging to each pattern
7 
+
8 
+  # check input arguments
9 
+  if (!is(GStoGenes, "data.frame") && !is(GStoGenes, "list")) {
10 
+    stop("GStoGenes must be a data.frame or list with format specified in the users manual.")
11 
+  }
12 
+
13 
+  if (is(GStoGenes, "list")) {
14 
+    GStoGenesList <- GStoGenes
15 
+  } else {
16 
+    GStoGenesList <- list()
17 
+    for (i in 1:dim(GStoGenes)[2]) {
18 
+      GStoGenesList[[as.character(colnames(GStoGenes)[i])]] <- as.character(unique(GStoGenes[,i]))
19 
+    }
20 
+  }
21 
+
22 
+  # get dimensions
23 
+  numGS   <- length(names(GStoGenesList))
24 
+  numPatt <- dim(zMatrix)[2]
25 
+  numG    <- dim(zMatrix)[1]+0.9999
26 
+
27 
+  # initialize matrices
28 
+  statsUp   <- matrix(ncol = numGS, nrow = numPatt)
29 
+  statsDown <- matrix(ncol = numGS, nrow = numPatt)
30 
+  actEst    <- matrix(ncol = numGS, nrow = numPatt)
31 
+  results   <- new.env()
32 
+  zPerm     <- matrix(ncol=numPerm,nrow=numPatt)
33 
+
34 
+  # do permutation test
35 
+  for (gs in 1:numGS) {
36 
+    genes <- GStoGenesList[[names(GStoGenesList)[gs]]]
37 
+    index <- rownames(zMatrix) %in% genes
38 
+    zValues <- zMatrix[index,1]
39 
+    numGenes <- length(zValues)
40 
+    label <- as.character(numGenes)
41 
+
42 
+    if (!exists(label,env=results)) {
43 
+      for (p in 1:numPatt) {
44 
+        for (j in 1:numPerm) {
45 
+          temp <- floor(runif(numGenes,1,numG))
46 
+          temp2 <- zMatrix[temp,p]
47 
+          zPerm[p,j] <- mean(temp2)
48 
+        }
49 
+      }
50 
+      assign(label,zPerm,env=results)
51 
+    }
52 
+  }
53 
+
54 
+  # get p-value
55 
+  for (p in 1:numPatt) {
56 
+
57 
+    for (gs in 1:numGS) {
58 
+
59 
+      genes <- GStoGenesList[[names(GStoGenesList)[gs]]]
60 
+      index <- rownames(zMatrix) %in% genes
61 
+      zValues <- zMatrix[index,p]
62 
+      zScore <- mean(zValues)
63 
+
64 
+      numGenes <- length(zValues)
65 
+      label <- as.character(numGenes)
66 
+
67 
+      permzValues <- get(label, env=results)[p,]
68 
+      ordering <- order(permzValues)
69 
+      permzValues <- permzValues[ordering]
70 
+
71 
+      statistic <- sum(zScore > permzValues)
72 
+      statUpReg <- 1 - statistic/length(permzValues)
73 
+      statsUp[p,gs] <- max(statUpReg, 1/numPerm)
74 
+
75 
+      statistic <- sum(zScore < permzValues)
76 
+      statDownReg <- 1 - statistic/length(permzValues)
77 
+      statsDown[p,gs] <- max(statDownReg,1/numPerm)
78 
+
79 
+      activity <- 1 - 2*max(statUpReg, 1/numPerm)
80 
+      actEst[p,gs] <- activity
81 
+    }
82 
+
83 
+  }
84 
+
85 
+  # format output
86 
+  colnames(statsUp) <- names(GStoGenesList)
87 
+  colnames(statsDown) <- names(GStoGenesList)
88 
+  colnames(actEst) <- names(GStoGenesList)
89 
+
90 
+  rownames(statsUp) <- colnames(zMatrix)
91 
+  rownames(statsDown) <- colnames(zMatrix)
92 
+  rownames(actEst) <- colnames(zMatrix)
93 
+
94 
+  assign('GSUpreg', statsUp, env=results)
95 
+  assign('GSDownreg', statsDown, env=results)
96 
+  assign('GSActEst', actEst, env=results)
97 
+
98 
+  return(results)
99 
+}