Browse code

vignette for new workflow

Tom Sherman authored on 11/07/2018 16:09:37
Showing1 changed files
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
Showing1 changed files
... ...
@@ -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
Showing1 changed files
... ...
@@ -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
Showing1 changed files
... ...
@@ -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
Showing1 changed files
... ...
@@ -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
Showing1 changed files
... ...
@@ -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
 {
sherman5 authored on 26/01/2018 17:53:51
Showing0 changed files
Browse code

cleaning up notes for v3

sherman5 authored on 24/01/2018 23:38:02
Showing1 changed files
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
Showing1 changed files
... ...
@@ -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
Showing1 changed files
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
Showing1 changed files
... ...
@@ -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
Showing1 changed files
... ...
@@ -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
Showing1 changed files
... ...
@@ -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
Showing1 changed files
... ...
@@ -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
Showing1 changed files
... ...
@@ -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
Showing1 changed files
... ...
@@ -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
Showing1 changed files
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
+}