[Swift-commit] r3074 - SwiftApps/SIDGrid/swift/projects/andric/ccf_emblem/NonParametric_lag_analy/scripts
noreply at svn.ci.uchicago.edu
noreply at svn.ci.uchicago.edu
Thu Aug 6 23:56:13 CDT 2009
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)
More information about the Swift-commit
mailing list