[Swift-commit] r3074 - SwiftApps/SIDGrid/swift/projects/andric/ccf_emblem/NonParametric_lag_analy/scripts

[noreply at svn.ci.uchicago.edu]

Author: andric
Date: 2009-08-06 23:56:12 -0500 (Thu, 06 Aug 2009)
New Revision: 3074

Modified:
   SwiftApps/SIDGrid/swift/projects/andric/ccf_emblem/NonParametric_lag_analy/scripts/FriedmanTest.R
Log:
this version uses an aggregate function rather than a 'for' loop

Modified: SwiftApps/SIDGrid/swift/projects/andric/ccf_emblem/NonParametric_lag_analy/scripts/FriedmanTest.R
===================================================================
--- SwiftApps/SIDGrid/swift/projects/andric/ccf_emblem/NonParametric_lag_analy/scripts/FriedmanTest.R	2009-08-07 03:34:06 UTC (rev 3073)
+++ SwiftApps/SIDGrid/swift/projects/andric/ccf_emblem/NonParametric_lag_analy/scripts/FriedmanTest.R	2009-08-07 04:56:12 UTC (rev 3074)
@@ -1,25 +1,36 @@
-#---- this is to do friedman non-parametric test on lags
+#---- R script for carrying out friedman test
+FriedmanStat <- function(x){
+    mm <- matrix(nrow=24,ncol=3)
+    mm[,1] = x[1:24]
+    mm[,2] = x[25:48]
+    mm[,3] = x[49:72]
+    return(friedman.test(mm)[[1]][[1]])
+}
+
+FriedmanP <- function(x){
+    mm <- matrix(nrow=24,ncol=3)
+    mm[,1] = x[1:24]
+    mm[,2] = x[25:48]
+    mm[,3] = x[49:72]
+    return(friedman.test(mm)[[3]][[1]])
+}
+
+#---- Swift housekeeping:
 allinputs <- Sys.getenv("R_SWIFT_ARGS")
 print(Sys.getenv("R_SWIFT_ARGS"));
-outname <- noquote(strsplit(allinputs," ")[[1]][1])
-outname2 <- noquote(strsplit(allinputs," ")[[1]][2])
-
+batchID <- noquote(strsplit(allinputs," ")[[1]][1])
+outname <- noquote(strsplit(allinputs," ")[[1]][2])
+print(outname)
 inputfile <- Sys.getenv("R_INPUT")
 print(inputfile)
 Query_out <- as.matrix(read.table(inputfile))
 
-#names(Query_out) <- c("subject", "vertex", "speech_lag", "emblem_lag", "embspeech_lag");
-
-m <- matrix(nrow=500,ncol=3)
-mat_row <- 0;
-#attach(Query_out)
-vertex_levels <- as.factor(Query_out[,2])
-for (vert in levels(vertex_levels)){
-    mat_row = mat_row + 1
-    vert_data <- matrix(c(Query_out[which(Query_out[,2]==vert),3:5]),nr=24)
-    friedman_test <- friedman.test(vert_data)
-    vert_id <- as.integer(vert)
-    m[mat_row, ] <- c(vert_id, friedman_test$statistic[[1]], friedman_test$p.value[[1]])
-    rm(vert_data)
-}
-write.table(round(m,5), file=paste(outname2,outname,".txt",sep=""), row.names=FALSE, col.names=FALSE, quote=F)
+#---- analysis:
+data_stack <- stack(data.frame(Query_out[,3:5]))[1]
+vertices <- Query_out[,2]
+nn <- data.frame(cbind(vertices,data_stack))
+m <- matrix(nrow=length(as.integer(levels(as.factor(vertices)))),ncol=3)
+m[,1] <- as.integer(levels(as.factor(vertices)))
+m[,2] <- aggregate(nn$values, list(nn$vertices),FriedmanStat)[,2]
+m[,3] <- 1 - (aggregate(nn$values, list(nn$vertices),FriedmanP)[,2])
+write.table(round(m,5), file=paste(outname,".txt",sep=""), row.names=FALSE, col.names=FALSE, quote=F)