Browse code

added postFixed4Parallel methods for fixed As

Genevieve Stein-O'Brien authored on 02/04/2018 13:46:46
Showing 1 changed files

... ...
@@ -5,23 +5,46 @@
5 5
 #' for gapsMapRun
6 6
 #' @return list of two data.frames containing the A matrix estimates or their
7 7
 #' corresponding standard deviations from output of parallel CoGAPS
8
-postFixed4Parallel <- function(AP.fixed, setPs)
8
+postFixed4Parallel <- function(AP.fixed, setValues, setMatrix="P")
9 9
 {
10
-    ASummary <- do.call(rbind,lapply(AP.fixed, function(x) x$Amean))
11
-    Asd <- do.call(rbind,lapply(AP.fixed, function(x) x$Asd))
12
-    #PSummary <- do.call(rbind,lapply(AP.fixed, function(x) x$Pmean))
13
-    PSummary <- AP.fixed[[1]]$Pmean
10
+    if(setMatrix=="P"){
11
+        ASummary <- do.call(rbind,lapply(AP.fixed, function(x) x$Amean))
12
+        Asd <- do.call(rbind,lapply(AP.fixed, function(x) x$Asd))
13
+        #PSummary <- do.call(rbind,lapply(AP.fixed, function(x) x$Pmean))
14
+        PSummary <- AP.fixed[[1]]$Pmean
14 15
 
15
-    Pmax <- apply(PSummary,1,max)
16
-    Pneu <- sweep(PSummary,1,Pmax,FUN="/")
17
-    Aneu <- sweep(ASummary,2,Pmax,FUN="*")
16
+        Pmax <- apply(PSummary,1,max)
17
+        Pneu <- sweep(PSummary,1,Pmax,FUN="/")
18
+        Aneu <- sweep(ASummary,2,Pmax,FUN="*")
18 19
 
19
-    X <- apply(Pneu,1,range)
20
-    Y <- apply(setPs,1,range)
21
-    colnames(X) <- colnames(Y)
22
-    if (all.equal(X,Y,tolerance=0.01) != TRUE)
23
-        warning("Patterns do not match fixed values.")
20
+        X <- apply(Pneu,1,range)
21
+        Y <- apply(setPs,1,range)
22
+        colnames(X) <- colnames(Y)
23
+        if (all.equal(X,Y,tolerance=0.01) != TRUE)
24
+            warning("Patterns do not match fixed values.")
25
+
26
+        As4fixPs<-list("A"=Aneu,"Asd"=Asd)
27
+        return(As4fixPs)
28
+    } else if(setMatrix=="A"){
29
+        PSummary <- do.call(cbind,lapply(AP.fixed, function(x) x$Pmean))
30
+        Psd <- do.call(cbind,lapply(AP.fixed, function(x) x$Psd))
31
+        #PSummary <- do.call(rbind,lapply(AP.fixed, function(x) x$Pmean))
32
+        ASummary <- AP.fixed[[1]]$Amean
33
+
34
+        Amax <- apply(ASummary,1,max)
35
+        Aneu <- sweep(ASummary,1,Pmax,FUN="/")
36
+        Pneu <- sweep(PSummary,2,Pmax,FUN="*")
37
+
38
+        X <- apply(Aneu,1,range)
39
+        Y <- apply(setAs,1,range)
40
+        colnames(X) <- colnames(Y)
41
+        if (all.equal(X,Y,tolerance=0.01) != TRUE)
42
+            warning("As do not match fixed values.")
43
+
44
+        Ps4fixAs<-list("P"=Pneu,"Psd"=Psd)
45
+        return(Ps4fixAs)
46
+    } else{
47
+        warning("setMatrix can only take values of 'A' or 'P'")
48
+    }
24 49
 
25
-    As4fixPs<-list("A"=Aneu,"Asd"=Asd)
26
-    return(As4fixPs)
27 50
 }