[Swift-commit] r3060 - in SwiftApps/SIDGrid/swift/projects/andric/ccf_emblem/ccf_emblemIDEAL: . scripts
noreply at svn.ci.uchicago.edu
noreply at svn.ci.uchicago.edu
Thu Aug 6 10:35:30 CDT 2009
Author: andric
Date: 2009-08-06 10:35:30 -0500 (Thu, 06 Aug 2009)
New Revision: 3060
Added:
SwiftApps/SIDGrid/swift/projects/andric/ccf_emblem/ccf_emblemIDEAL/scripts/
SwiftApps/SIDGrid/swift/projects/andric/ccf_emblem/ccf_emblemIDEAL/scripts/grid_ccf_lh.R
SwiftApps/SIDGrid/swift/projects/andric/ccf_emblem/ccf_emblemIDEAL/scripts/grid_ccf_rh.R
SwiftApps/SIDGrid/swift/projects/andric/ccf_emblem/ccf_emblemIDEAL/scripts/grid_ccfinterp.R
SwiftApps/SIDGrid/swift/projects/andric/ccf_emblem/ccf_emblemIDEAL/scripts/grid_ccfinterpOLD.R
SwiftApps/SIDGrid/swift/projects/andric/ccf_emblem/ccf_emblemIDEAL/scripts/grid_ccfinterp_lh.R
Log:
R scripts for ccf group analysis
Added: SwiftApps/SIDGrid/swift/projects/andric/ccf_emblem/ccf_emblemIDEAL/scripts/grid_ccf_lh.R
===================================================================
--- SwiftApps/SIDGrid/swift/projects/andric/ccf_emblem/ccf_emblemIDEAL/scripts/grid_ccf_lh.R (rev 0)
+++ SwiftApps/SIDGrid/swift/projects/andric/ccf_emblem/ccf_emblemIDEAL/scripts/grid_ccf_lh.R 2009-08-06 15:35:30 UTC (rev 3060)
@@ -0,0 +1,145 @@
+#---- Thursday; April 24, 2008
+#---- This vrsion cuts off Beta vals abs(val) > 8 and uses lag.max=4
+allinputs <- Sys.getenv("R_SWIFT_ARGS")
+outname <- noquote(strsplit(allinputs," ")[[1]][1])
+
+inputfile <- Sys.getenv("R_INPUT")
+dd <- read.table(inputfile)
+Query_out <- data.frame(dd)
+
+NumSubjects <- 24;
+NumTimepoints <- 9;
+NumCols <- 36
+# generate the vectors that apply to each group of vectors
+SubjectVec <- as.factor(rep(1:NumSubjects,NumCols))
+CondVect <- as.factor(rep(1:4, rep(NumTimepoints*NumSubjects, 4)))
+TimePointVec <- as.factor(rep(rep(1:9, rep(NumSubjects, 9)),4))
+# the subject categorization: 1=ta-percept 0=ka or ka-ta-percept, 9=to remove from this analysis
+# mja: WHAT DO I DO WITH THIS ??????
+# for now, EVERYBODY'S IN! : 0 = stayin alive
+SubjectCategorization <- c(0,0,0,0,0,0,0,0,0,0,0,0)
+SubjectCategorization_Vec <- as.factor(rep(SubjectCategorization, 36))
+OverallRows <- length(levels(as.factor(Query_out[,2])))
+ccf <- matrix(nrow=OverallRows, ncol=10)
+speech <- matrix(nrow=OverallRows, ncol=10)
+gesture <- matrix(nrow=OverallRows, ncol=10)
+gestspeech <- matrix(nrow=OverallRows, ncol=10)
+grasp <- matrix(nrow=OverallRows, ncol=10)
+
+mat_row = 0
+
+attach(Query_out)
+#vox_levels <- as.factor(voxel)
+vox_levels <- as.factor(Query_out[,2])
+for (vox in levels(vox_levels)){
+ mat_row = mat_row + 1
+ # brougt in many voxels, now go one by one
+ vox_matrix <- Query_out[which(Query_out[,2] == vox),]
+ # take colums 3-38of the results and make vector
+ zz <- (stack(vox_matrix[,3:38]))
+ VoxValues_vec <- zz[,1]
+ Voxel_df <- data.frame(S=SubjectVec, Cond=CondVect, Time=TimePointVec, Beta=VoxValues_vec, SubjCat=SubjectCategorization_Vec)
+ attach(Voxel_df)
+ # grab those entries with extreme betavalues
+ cutoff_obs <- Voxel_df[(Voxel_df$Beta <= -8) | (Voxel_df$Beta >= 8),]
+ # if there are extreme values, clean them, otherwise, the final dataframe is the original one
+ # IN THIS ANALYSIS, WE COMPLETELY REMOVE SS THAT CONTRIBUTE EXTREME VALS
+
+ if (length(unique(cutoff_obs$Beta)) > 0){
+ # get breakdown of the extreme values by subject and condition. if we wanted just by subject could have used
+ # cutoff_obs_breakdown <- aggregate(cutoff_obs$Beta, by=list(cutoff_obs$S), length)
+ cutoff_obs_breakdown <- aggregate(cutoff_obs$Beta, by=list(cutoff_obs$S, cutoff_obs$Time), length)
+ # now get just those conditions that had 1 or more extreme vals.
+ # ss that contributed more than 1 vals to any condition gets kicked out from this voxel's analysis
+ # this filter is very conservative. basically kicks out any ss that contributed extreme vals
+ # clean_ss_df is basically Voxel_df with the problematic ss removed
+ t1 <- subset(cutoff_obs_breakdown, cutoff_obs_breakdown$x >=1)
+ kicked_out_ss <- as.factor(as.vector(unique(t1[,1])))
+ num_kicked_out_ss <- (length(kicked_out_ss))
+ cleaned_ss_df <- Voxel_df[!(Voxel_df$S %in% kicked_out_ss),]
+ # skip scaling and outlier removal for now
+ # remove remaining extreme values from df with filtered ss
+ # cleaned_ss_noextreme_df <- cleaned_ss_df[(cleaned_ss_df$Beta >= -10) & (cleaned_ss_df$Beta <= 10),]
+ # final_df <- cleaned_ss_noextreme_df[(cleaned_ss_noextreme_df$ScaledBeta >= -4) & (cleaned_ss_noextreme_df$ScaledBeta <= 4),]
+ remaining_ss <- length(as.factor(as.vector(unique(cleaned_ss_df$S))))
+ # print(remaining_ss)
+ final_df <- cleaned_ss_df
+ rm(cleaned_ss_df)
+ }
+ else{
+ num_kicked_out_ss = 0
+ final_df <- Voxel_df
+ }
+
+ # once we have final_df either after removal of extreme value or not we are ready for computations
+ detach(Voxel_df)
+ rm(Voxel_df)
+ attach(final_df)
+ # agList collapses across time so each SXSyllable is one value rather than 9.
+ #agListMean <- aggregate(Beta, by=list(S, Cond), mean)
+ agListMean <- aggregate(Beta, by=list(Time, Cond), mean)
+ #agListMax <- aggregate(Beta, by=list(S, Cond), max)
+ #agListMean <- aggregate(agListMax[,3], by=list(agListMax[,2]), mean)
+ #mydf <- data.frame(agListMean)
+ #mydf <- data.frame(agListMean[,3], agListMax[,3])
+ #write.table(mydf, file=paste("firsttry",vox,".txt",sep=""), row.names=FALSE, quote=FALSE)
+ # get beta vals for each condition collapsed across time. subset gets a matrix, and [,3] selects the third column. try without [,3]
+ waver.vector <- c(0,8.96394,89.8344,75.8427,23.2527,4.09246,0.507025,0.0493012,0)
+ vox_speech_vec <- subset(agListMean, Group.2==1)[,3]
+ vox_gesture_vec <- subset(agListMean, Group.2==2)[,3]
+ vox_gestspeech_vec <- subset(agListMean, Group.2==3)[,3]
+ vox_grasp_vec <- subset(agListMean, Group.2==4)[,3]
+
+ #---- SPEECH
+ speech_ccf <- ccf(vox_speech_vec, waver.vector, lag.max = 4, type = c("correlation"), na.action=na.pass, plot=FALSE)
+ if (sum(as.numeric(is.na(speech_ccf$acf))) != 0){
+ speech_ccf$acf[1:9] = 0
+ }
+ speech_frame <- as.matrix(data.frame(speech_ccf$acf,speech_ccf$lag))
+ speech_cor <- speech_frame[which.max(speech_frame[,1]),]
+
+
+ #---- GESTURE
+ gesture_ccf <- ccf(vox_gesture_vec, waver.vector, lag.max = 4, type = c("correlation"), na.action=na.pass, plot=FALSE)
+ if (sum(as.numeric(is.na(gesture_ccf$acf))) != 0){
+ gesture_ccf$acf[1:9] = 0
+ }
+ gesture_frame <- as.matrix(data.frame(gesture_ccf$acf,gesture_ccf$lag))
+ gesture_cor <- gesture_frame[which.max(gesture_frame[,1]),]
+
+
+ #---- GESTURE & SPEECH
+ gestspeech_ccf <- ccf(vox_gestspeech_vec, waver.vector, lag.max = 4, type = c("correlation"), na.action=na.pass, plot=FALSE)
+ if (sum(as.numeric(is.na(gestspeech_ccf$acf))) != 0){
+ gestspeech_ccf$acf[1:9] = 0
+ }
+ gestspeech_frame <- as.matrix(data.frame(gestspeech_ccf$acf,gestspeech_ccf$lag))
+ gestspeech_cor <- gestspeech_frame[which.max(gestspeech_frame[,1]),]
+
+
+ #---- GRASP
+ grasp_ccf <- ccf(vox_grasp_vec, waver.vector, lag.max = 4, type = c("correlation"), na.action=na.pass, plot=FALSE)
+ if (sum(as.numeric(is.na(grasp_ccf$acf))) != 0){
+ grasp_ccf$acf[1:9] = 0
+ }
+ grasp_frame <- as.matrix(data.frame(grasp_ccf$acf,grasp_ccf$lag))
+ grasp_cor <- grasp_frame[which.max(grasp_frame[,1]),]
+
+
+
+ vox_id <- as.integer(vox)
+ ccf[mat_row, ] <- c(vox_id, speech_cor[[1]], speech_cor[[2]], gesture_cor[[1]], gesture_cor[[2]], gestspeech_cor[[1]], gestspeech_cor[[2]], grasp_cor[[1]], grasp_cor[[2]], num_kicked_out_ss)
+ speech[mat_row, ] <- c(vox_id,vox_speech_vec)
+ gesture[mat_row, ] <- c(vox_id,vox_gesture_vec)
+ gestspeech[mat_row, ] <- c(vox_id,vox_gestspeech_vec)
+ grasp[mat_row, ] <- c(vox_id,vox_grasp_vec)
+
+ detach(final_df)
+ rm(final_df, agListMean)
+}
+
+write.table(round(ccf,5), file=paste(outname,"_lh_ccf.txt",sep=""), row.names=FALSE, col.names=FALSE)
+write.table(round(speech,5), file=paste(outname,"_lh_speech.txt",sep=""), row.names=FALSE, col.names=FALSE)
+write.table(round(gesture,5), file=paste(outname,"_lh_emblem.txt",sep=""), row.names=FALSE, col.names=FALSE)
+write.table(round(gestspeech,5), file=paste(outname,"_lh_embspeech.txt",sep=""), row.names=FALSE, col.names=FALSE)
+write.table(round(grasp,5), file=paste(outname,"_lh_grasp.txt",sep=""), row.names=FALSE, col.names=FALSE)
Added: SwiftApps/SIDGrid/swift/projects/andric/ccf_emblem/ccf_emblemIDEAL/scripts/grid_ccf_rh.R
===================================================================
--- SwiftApps/SIDGrid/swift/projects/andric/ccf_emblem/ccf_emblemIDEAL/scripts/grid_ccf_rh.R (rev 0)
+++ SwiftApps/SIDGrid/swift/projects/andric/ccf_emblem/ccf_emblemIDEAL/scripts/grid_ccf_rh.R 2009-08-06 15:35:30 UTC (rev 3060)
@@ -0,0 +1,145 @@
+#---- Thursday; April 24, 2008
+#---- This vrsion cuts off Beta vals abs(val) > 8 and uses lag.max=4
+allinputs <- Sys.getenv("R_SWIFT_ARGS")
+outname <- noquote(strsplit(allinputs," ")[[1]][1])
+
+inputfile <- Sys.getenv("R_INPUT")
+dd <- read.table(inputfile)
+Query_out <- data.frame(dd)
+
+NumSubjects <- 24;
+NumTimepoints <- 9;
+NumCols <- 36
+# generate the vectors that apply to each group of vectors
+SubjectVec <- as.factor(rep(1:NumSubjects,NumCols))
+CondVect <- as.factor(rep(1:4, rep(NumTimepoints*NumSubjects, 4)))
+TimePointVec <- as.factor(rep(rep(1:9, rep(NumSubjects, 9)),4))
+# the subject categorization: 1=ta-percept 0=ka or ka-ta-percept, 9=to remove from this analysis
+# mja: WHAT DO I DO WITH THIS ??????
+# for now, EVERYBODY'S IN! : 0 = stayin alive
+SubjectCategorization <- c(0,0,0,0,0,0,0,0,0,0,0,0)
+SubjectCategorization_Vec <- as.factor(rep(SubjectCategorization, 36))
+OverallRows <- length(levels(as.factor(Query_out[,2])))
+ccf <- matrix(nrow=OverallRows, ncol=10)
+speech <- matrix(nrow=OverallRows, ncol=10)
+gesture <- matrix(nrow=OverallRows, ncol=10)
+gestspeech <- matrix(nrow=OverallRows, ncol=10)
+grasp <- matrix(nrow=OverallRows, ncol=10)
+
+mat_row = 0
+
+attach(Query_out)
+#vox_levels <- as.factor(voxel)
+vox_levels <- as.factor(Query_out[,2])
+for (vox in levels(vox_levels)){
+ mat_row = mat_row + 1
+ # brougt in many voxels, now go one by one
+ vox_matrix <- Query_out[which(Query_out[,2] == vox),]
+ # take colums 3-38of the results and make vector
+ zz <- (stack(vox_matrix[,3:38]))
+ VoxValues_vec <- zz[,1]
+ Voxel_df <- data.frame(S=SubjectVec, Cond=CondVect, Time=TimePointVec, Beta=VoxValues_vec, SubjCat=SubjectCategorization_Vec)
+ attach(Voxel_df)
+ # grab those entries with extreme betavalues
+ cutoff_obs <- Voxel_df[(Voxel_df$Beta <= -8) | (Voxel_df$Beta >= 8),]
+ # if there are extreme values, clean them, otherwise, the final dataframe is the original one
+ # IN THIS ANALYSIS, WE COMPLETELY REMOVE SS THAT CONTRIBUTE EXTREME VALS
+
+ if (length(unique(cutoff_obs$Beta)) > 0){
+ # get breakdown of the extreme values by subject and condition. if we wanted just by subject could have used
+ # cutoff_obs_breakdown <- aggregate(cutoff_obs$Beta, by=list(cutoff_obs$S), length)
+ cutoff_obs_breakdown <- aggregate(cutoff_obs$Beta, by=list(cutoff_obs$S, cutoff_obs$Time), length)
+ # now get just those conditions that had 1 or more extreme vals.
+ # ss that contributed more than 1 vals to any condition gets kicked out from this voxel's analysis
+ # this filter is very conservative. basically kicks out any ss that contributed extreme vals
+ # clean_ss_df is basically Voxel_df with the problematic ss removed
+ t1 <- subset(cutoff_obs_breakdown, cutoff_obs_breakdown$x >=1)
+ kicked_out_ss <- as.factor(as.vector(unique(t1[,1])))
+ num_kicked_out_ss <- (length(kicked_out_ss))
+ cleaned_ss_df <- Voxel_df[!(Voxel_df$S %in% kicked_out_ss),]
+ # skip scaling and outlier removal for now
+ # remove remaining extreme values from df with filtered ss
+ # cleaned_ss_noextreme_df <- cleaned_ss_df[(cleaned_ss_df$Beta >= -10) & (cleaned_ss_df$Beta <= 10),]
+ # final_df <- cleaned_ss_noextreme_df[(cleaned_ss_noextreme_df$ScaledBeta >= -4) & (cleaned_ss_noextreme_df$ScaledBeta <= 4),]
+ remaining_ss <- length(as.factor(as.vector(unique(cleaned_ss_df$S))))
+ # print(remaining_ss)
+ final_df <- cleaned_ss_df
+ rm(cleaned_ss_df)
+ }
+ else{
+ num_kicked_out_ss = 0
+ final_df <- Voxel_df
+ }
+
+ # once we have final_df either after removal of extreme value or not we are ready for computations
+ detach(Voxel_df)
+ rm(Voxel_df)
+ attach(final_df)
+ # agList collapses across time so each SXSyllable is one value rather than 9.
+ #agListMean <- aggregate(Beta, by=list(S, Cond), mean)
+ agListMean <- aggregate(Beta, by=list(Time, Cond), mean)
+ #agListMax <- aggregate(Beta, by=list(S, Cond), max)
+ #agListMean <- aggregate(agListMax[,3], by=list(agListMax[,2]), mean)
+ #mydf <- data.frame(agListMean)
+ #mydf <- data.frame(agListMean[,3], agListMax[,3])
+ #write.table(mydf, file=paste("firsttry",vox,".txt",sep=""), row.names=FALSE, quote=FALSE)
+ # get beta vals for each condition collapsed across time. subset gets a matrix, and [,3] selects the third column. try without [,3]
+ waver.vector <- c(0,8.96394,89.8344,75.8427,23.2527,4.09246,0.507025,0.0493012,0)
+ vox_speech_vec <- subset(agListMean, Group.2==1)[,3]
+ vox_gesture_vec <- subset(agListMean, Group.2==2)[,3]
+ vox_gestspeech_vec <- subset(agListMean, Group.2==3)[,3]
+ vox_grasp_vec <- subset(agListMean, Group.2==4)[,3]
+
+ #---- SPEECH
+ speech_ccf <- ccf(vox_speech_vec, waver.vector, lag.max = 4, type = c("correlation"), na.action=na.pass, plot=FALSE)
+ if (sum(as.numeric(is.na(speech_ccf$acf))) != 0){
+ speech_ccf$acf[1:9] = 0
+ }
+ speech_frame <- as.matrix(data.frame(speech_ccf$acf,speech_ccf$lag))
+ speech_cor <- speech_frame[which.max(speech_frame[,1]),]
+
+
+ #---- GESTURE
+ gesture_ccf <- ccf(vox_gesture_vec, waver.vector, lag.max = 4, type = c("correlation"), na.action=na.pass, plot=FALSE)
+ if (sum(as.numeric(is.na(gesture_ccf$acf))) != 0){
+ gesture_ccf$acf[1:9] = 0
+ }
+ gesture_frame <- as.matrix(data.frame(gesture_ccf$acf,gesture_ccf$lag))
+ gesture_cor <- gesture_frame[which.max(gesture_frame[,1]),]
+
+
+ #---- GESTURE & SPEECH
+ gestspeech_ccf <- ccf(vox_gestspeech_vec, waver.vector, lag.max = 4, type = c("correlation"), na.action=na.pass, plot=FALSE)
+ if (sum(as.numeric(is.na(gestspeech_ccf$acf))) != 0){
+ gestspeech_ccf$acf[1:9] = 0
+ }
+ gestspeech_frame <- as.matrix(data.frame(gestspeech_ccf$acf,gestspeech_ccf$lag))
+ gestspeech_cor <- gestspeech_frame[which.max(gestspeech_frame[,1]),]
+
+
+ #---- GRASP
+ grasp_ccf <- ccf(vox_grasp_vec, waver.vector, lag.max = 4, type = c("correlation"), na.action=na.pass, plot=FALSE)
+ if (sum(as.numeric(is.na(grasp_ccf$acf))) != 0){
+ grasp_ccf$acf[1:9] = 0
+ }
+ grasp_frame <- as.matrix(data.frame(grasp_ccf$acf,grasp_ccf$lag))
+ grasp_cor <- grasp_frame[which.max(grasp_frame[,1]),]
+
+
+
+ vox_id <- as.integer(vox)
+ ccf[mat_row, ] <- c(vox_id, speech_cor[[1]], speech_cor[[2]], gesture_cor[[1]], gesture_cor[[2]], gestspeech_cor[[1]], gestspeech_cor[[2]], grasp_cor[[1]], grasp_cor[[2]], num_kicked_out_ss)
+ speech[mat_row, ] <- c(vox_id,vox_speech_vec)
+ gesture[mat_row, ] <- c(vox_id,vox_gesture_vec)
+ gestspeech[mat_row, ] <- c(vox_id,vox_gestspeech_vec)
+ grasp[mat_row, ] <- c(vox_id,vox_grasp_vec)
+
+ detach(final_df)
+ rm(final_df, agListMean)
+}
+
+write.table(round(ccf,5), file=paste(outname,"_rh_ccf.txt",sep=""), row.names=FALSE, col.names=FALSE)
+write.table(round(speech,5), file=paste(outname,"_rh_speech.txt",sep=""), row.names=FALSE, col.names=FALSE)
+write.table(round(gesture,5), file=paste(outname,"_rh_emblem.txt",sep=""), row.names=FALSE, col.names=FALSE)
+write.table(round(gestspeech,5), file=paste(outname,"_rh_embspeech.txt",sep=""), row.names=FALSE, col.names=FALSE)
+write.table(round(grasp,5), file=paste(outname,"_rh_grasp.txt",sep=""), row.names=FALSE, col.names=FALSE)
Added: SwiftApps/SIDGrid/swift/projects/andric/ccf_emblem/ccf_emblemIDEAL/scripts/grid_ccfinterp.R
===================================================================
--- SwiftApps/SIDGrid/swift/projects/andric/ccf_emblem/ccf_emblemIDEAL/scripts/grid_ccfinterp.R (rev 0)
+++ SwiftApps/SIDGrid/swift/projects/andric/ccf_emblem/ccf_emblemIDEAL/scripts/grid_ccfinterp.R 2009-08-06 15:35:30 UTC (rev 3060)
@@ -0,0 +1,151 @@
+#---- May 31, 2009
+## using interpolation to get better precision on the lag
+#---- This vrsion cuts off Beta vals abs(val) > 8 and uses lag.max=4
+library(akima)
+allinputs <- Sys.getenv("R_SWIFT_ARGS")
+print(allinputs)
+outname <- noquote(strsplit(allinputs," ")[[1]][1])
+hemi <- noquote(strsplit(allinputs," ")[[1]][2])
+
+inputfile <- Sys.getenv("R_INPUT")
+dd <- read.table(inputfile)
+Query_out <- data.frame(dd)
+
+NumSubjects <- 24;
+NumTimepoints <- 9;
+NumCols <- 36
+# generate the vectors that apply to each group of vectors
+SubjectVec <- as.factor(rep(1:NumSubjects,NumCols))
+CondVect <- as.factor(rep(1:4, rep(NumTimepoints*NumSubjects, 4)))
+TimePointVec <- as.factor(rep(rep(1:9, rep(NumSubjects, 9)),4))
+# the subject categorization: 1=ta-percept 0=ka or ka-ta-percept, 9=to remove from this analysis
+SubjectCategorization <- c(0,0,0,0,0,0,0,0,0,0,0,0)
+SubjectCategorization_Vec <- as.factor(rep(SubjectCategorization, 36))
+OverallRows <- length(levels(as.factor(Query_out[,2])))
+ccf <- matrix(nrow=OverallRows, ncol=10)
+speech <- matrix(nrow=OverallRows, ncol=10)
+gesture <- matrix(nrow=OverallRows, ncol=10)
+gestspeech <- matrix(nrow=OverallRows, ncol=10)
+grasp <- matrix(nrow=OverallRows, ncol=10)
+
+mat_row = 0
+
+attach(Query_out)
+#vox_levels <- as.factor(voxel)
+vox_levels <- as.factor(Query_out[,2])
+for (vox in levels(vox_levels)){
+ mat_row = mat_row + 1
+ # brougt in many voxels, now go one by one
+ vox_matrix <- Query_out[which(Query_out[,2] == vox),]
+ # take colums 3-38of the results and make vector
+ zz <- (stack(vox_matrix[,3:38]))
+ VoxValues_vec <- zz[,1]
+ Voxel_df <- data.frame(S=SubjectVec, Cond=CondVect, Time=TimePointVec, Beta=VoxValues_vec, SubjCat=SubjectCategorization_Vec)
+ attach(Voxel_df)
+ # grab those entries with extreme betavalues
+ cutoff_obs <- Voxel_df[(Voxel_df$Beta <= -8) | (Voxel_df$Beta >= 8),]
+ # if there are extreme values, clean them, otherwise, the final dataframe is the original one
+ # IN THIS ANALYSIS, WE COMPLETELY REMOVE SS THAT CONTRIBUTE EXTREME VALS
+
+ if (length(unique(cutoff_obs$Beta)) > 0){
+ # get breakdown of the extreme values by subject and condition. if we wanted just by subject could have used
+ cutoff_obs_breakdown <- aggregate(cutoff_obs$Beta, by=list(cutoff_obs$S, cutoff_obs$Time), length)
+ # now get just those conditions that had 1 or more extreme vals.
+ # ss that contributed more than 1 vals to any condition gets kicked out from this voxel's analysis
+ # this filter is very conservative. basically kicks out any ss that contributed extreme vals
+ # clean_ss_df is basically Voxel_df with the problematic ss removed
+ t1 <- subset(cutoff_obs_breakdown, cutoff_obs_breakdown$x >=1)
+ kicked_out_ss <- as.factor(as.vector(unique(t1[,1])))
+ num_kicked_out_ss <- (length(kicked_out_ss))
+ cleaned_ss_df <- Voxel_df[!(Voxel_df$S %in% kicked_out_ss),]
+ # remove remaining extreme values from df with filtered ss
+ # cleaned_ss_noextreme_df <- cleaned_ss_df[(cleaned_ss_df$Beta >= -10) & (cleaned_ss_df$Beta <= 10),]
+ # final_df <- cleaned_ss_noextreme_df[(cleaned_ss_noextreme_df$ScaledBeta >= -4) & (cleaned_ss_noextreme_df$ScaledBeta <= 4),]
+ remaining_ss <- length(as.factor(as.vector(unique(cleaned_ss_df$S))))
+ # print(remaining_ss)
+ final_df <- cleaned_ss_df
+ rm(cleaned_ss_df)
+ }
+ else{
+ num_kicked_out_ss = 0
+ final_df <- Voxel_df
+ }
+
+ # once we have final_df either after removal of extreme value or not we are ready for computations
+ detach(Voxel_df)
+ rm(Voxel_df)
+ attach(final_df)
+ #agListMean <- aggregate(Beta, by=list(S, Cond), mean)
+ agListMean <- aggregate(Beta, by=list(Time, Cond), mean)
+ #agListMax <- aggregate(Beta, by=list(S, Cond), max)
+ #agListMean <- aggregate(agListMax[,3], by=list(agListMax[,2]), mean)
+ #mydf <- data.frame(agListMean)
+ #mydf <- data.frame(agListMean[,3], agListMax[,3])
+ # get beta vals for each condition collapsed across time. subset gets a matrix, and [,3] selects the third column. try without [,3]
+ waver.vector <- c(0,8.96394,89.8344,75.8427,23.2527,4.09246,0.507025,0.0493012,0)
+ vox_speech_vec <- subset(agListMean, Group.2==1)[,3]
+ vox_gesture_vec <- subset(agListMean, Group.2==2)[,3]
+ vox_gestspeech_vec <- subset(agListMean, Group.2==3)[,3]
+ vox_grasp_vec <- subset(agListMean, Group.2==4)[,3]
+
+
+ ##-- INTERPOLATION -------- ##
+ origX <- c(1:NumTimepoints)
+ ## 4 Hz resampling to get into 1/4 of a TR (1/2 second)
+ resample_length <- length(seq(1,NumTimepoints,1/4))
+ ## interpolate waver.vector and then each condition
+ asp_wvr <- aspline(origX,waver.vector,n=resample_length,method="improved")$y
+ asp_speech <- aspline(origX,vox_speech_vec,n=resample_length,method="improved")$y
+ asp_gesture <- aspline(origX,vox_gesture_vec,n=resample_length,method="improved")$y
+ asp_gestspeech <- aspline(origX,vox_gestspeech_vec,n=resample_length,method="improved")$y
+ asp_grasp <- aspline(origX,vox_grasp_vec,n=resample_length,method="improved")$y
+
+
+ #---- SPEECH
+ speech_ccf <- ccf(asp_speech, asp_wvr, lag.max = 12, type = c("correlation"), na.action=na.pass, plot=FALSE)
+ if (sum(as.numeric(is.na(speech_ccf$acf))) != 0){
+ speech_ccf$acf[1:25] = 0
+ }
+ speech_frame <- as.matrix(data.frame(speech_ccf$acf,speech_ccf$lag))
+ speech_cor <- speech_frame[which.max(speech_frame[,1]),]
+
+
+ #---- GESTURE
+ gesture_ccf <- ccf(asp_gesture, asp_wvr, lag.max = 12, type = c("correlation"), na.action=na.pass, plot=FALSE)
+ if (sum(as.numeric(is.na(gesture_ccf$acf))) != 0){
+ gesture_ccf$acf[1:25] = 0
+ }
+ gesture_frame <- as.matrix(data.frame(gesture_ccf$acf,gesture_ccf$lag))
+ gesture_cor <- gesture_frame[which.max(gesture_frame[,1]),]
+
+
+ #---- GESTURE & SPEECH
+ gestspeech_ccf <- ccf(asp_gestspeech, asp_wvr, lag.max = 12, type = c("correlation"), na.action=na.pass, plot=FALSE)
+ if (sum(as.numeric(is.na(gestspeech_ccf$acf))) != 0){
+ gestspeech_ccf$acf[1:25] = 0
+ }
+ gestspeech_frame <- as.matrix(data.frame(gestspeech_ccf$acf,gestspeech_ccf$lag))
+ gestspeech_cor <- gestspeech_frame[which.max(gestspeech_frame[,1]),]
+
+
+ #---- GRASP
+ grasp_ccf <- ccf(asp_grasp, asp_wvr, lag.max = 12, type = c("correlation"), na.action=na.pass, plot=FALSE)
+ if (sum(as.numeric(is.na(grasp_ccf$acf))) != 0){
+ grasp_ccf$acf[1:25] = 0
+ }
+ grasp_frame <- as.matrix(data.frame(grasp_ccf$acf,grasp_ccf$lag))
+ grasp_cor <- grasp_frame[which.max(grasp_frame[,1]),]
+
+
+ vox_id <- as.integer(vox)
+ ccf[mat_row, ] <- c(vox_id, speech_cor[[1]], speech_cor[[2]], gesture_cor[[1]], gesture_cor[[2]], gestspeech_cor[[1]], gestspeech_cor[[2]], grasp_cor[[1]], grasp_cor[[2]], num_kicked_out_ss)
+ #speech[mat_row, ] <- c(vox_id,vox_speech_vec)
+ #gesture[mat_row, ] <- c(vox_id,vox_gesture_vec)
+ #gestspeech[mat_row, ] <- c(vox_id,vox_gestspeech_vec)
+ #grasp[mat_row, ] <- c(vox_id,vox_grasp_vec)
+
+ detach(final_df)
+ rm(final_df, agListMean)
+}
+
+write.table(round(ccf,5), file=paste(hemi,"_",outname,"_ccf.txt",sep=""), row.names=FALSE, col.names=FALSE)
Added: SwiftApps/SIDGrid/swift/projects/andric/ccf_emblem/ccf_emblemIDEAL/scripts/grid_ccfinterpOLD.R
===================================================================
--- SwiftApps/SIDGrid/swift/projects/andric/ccf_emblem/ccf_emblemIDEAL/scripts/grid_ccfinterpOLD.R (rev 0)
+++ SwiftApps/SIDGrid/swift/projects/andric/ccf_emblem/ccf_emblemIDEAL/scripts/grid_ccfinterpOLD.R 2009-08-06 15:35:30 UTC (rev 3060)
@@ -0,0 +1,155 @@
+#---- May 31, 2009
+## using interpolation to get better precision on the lag
+#---- This vrsion cuts off Beta vals abs(val) > 8 and uses lag.max=4
+library(akima)
+allinputs <- Sys.getenv("R_SWIFT_ARGS")
+print(allinputs)
+outname <- noquote(strsplit(allinputs," ")[[1]][1])
+
+inputfile <- Sys.getenv("R_INPUT")
+dd <- read.table(inputfile)
+Query_out <- data.frame(dd)
+
+NumSubjects <- 24;
+NumTimepoints <- 9;
+NumCols <- 36
+# generate the vectors that apply to each group of vectors
+SubjectVec <- as.factor(rep(1:NumSubjects,NumCols))
+CondVect <- as.factor(rep(1:4, rep(NumTimepoints*NumSubjects, 4)))
+TimePointVec <- as.factor(rep(rep(1:9, rep(NumSubjects, 9)),4))
+# the subject categorization: 1=ta-percept 0=ka or ka-ta-percept, 9=to remove from this analysis
+SubjectCategorization <- c(0,0,0,0,0,0,0,0,0,0,0,0)
+SubjectCategorization_Vec <- as.factor(rep(SubjectCategorization, 36))
+OverallRows <- length(levels(as.factor(Query_out[,2])))
+ccf <- matrix(nrow=OverallRows, ncol=10)
+speech <- matrix(nrow=OverallRows, ncol=10)
+gesture <- matrix(nrow=OverallRows, ncol=10)
+gestspeech <- matrix(nrow=OverallRows, ncol=10)
+grasp <- matrix(nrow=OverallRows, ncol=10)
+
+mat_row = 0
+
+attach(Query_out)
+#vox_levels <- as.factor(voxel)
+vox_levels <- as.factor(Query_out[,2])
+for (vox in levels(vox_levels)){
+ mat_row = mat_row + 1
+ # brougt in many voxels, now go one by one
+ vox_matrix <- Query_out[which(Query_out[,2] == vox),]
+ # take colums 3-38of the results and make vector
+ zz <- (stack(vox_matrix[,3:38]))
+ VoxValues_vec <- zz[,1]
+ Voxel_df <- data.frame(S=SubjectVec, Cond=CondVect, Time=TimePointVec, Beta=VoxValues_vec, SubjCat=SubjectCategorization_Vec)
+ attach(Voxel_df)
+ # grab those entries with extreme betavalues
+ cutoff_obs <- Voxel_df[(Voxel_df$Beta <= -8) | (Voxel_df$Beta >= 8),]
+ # if there are extreme values, clean them, otherwise, the final dataframe is the original one
+ # IN THIS ANALYSIS, WE COMPLETELY REMOVE SS THAT CONTRIBUTE EXTREME VALS
+
+ if (length(unique(cutoff_obs$Beta)) > 0){
+ # get breakdown of the extreme values by subject and condition. if we wanted just by subject could have used
+ cutoff_obs_breakdown <- aggregate(cutoff_obs$Beta, by=list(cutoff_obs$S, cutoff_obs$Time), length)
+ # now get just those conditions that had 1 or more extreme vals.
+ # ss that contributed more than 1 vals to any condition gets kicked out from this voxel's analysis
+ # this filter is very conservative. basically kicks out any ss that contributed extreme vals
+ # clean_ss_df is basically Voxel_df with the problematic ss removed
+ t1 <- subset(cutoff_obs_breakdown, cutoff_obs_breakdown$x >=1)
+ kicked_out_ss <- as.factor(as.vector(unique(t1[,1])))
+ num_kicked_out_ss <- (length(kicked_out_ss))
+ cleaned_ss_df <- Voxel_df[!(Voxel_df$S %in% kicked_out_ss),]
+ # remove remaining extreme values from df with filtered ss
+ # cleaned_ss_noextreme_df <- cleaned_ss_df[(cleaned_ss_df$Beta >= -10) & (cleaned_ss_df$Beta <= 10),]
+ # final_df <- cleaned_ss_noextreme_df[(cleaned_ss_noextreme_df$ScaledBeta >= -4) & (cleaned_ss_noextreme_df$ScaledBeta <= 4),]
+ remaining_ss <- length(as.factor(as.vector(unique(cleaned_ss_df$S))))
+ # print(remaining_ss)
+ final_df <- cleaned_ss_df
+ rm(cleaned_ss_df)
+ }
+ else{
+ num_kicked_out_ss = 0
+ final_df <- Voxel_df
+ }
+
+ # once we have final_df either after removal of extreme value or not we are ready for computations
+ detach(Voxel_df)
+ rm(Voxel_df)
+ attach(final_df)
+ #agListMean <- aggregate(Beta, by=list(S, Cond), mean)
+ agListMean <- aggregate(Beta, by=list(Time, Cond), mean)
+ #agListMax <- aggregate(Beta, by=list(S, Cond), max)
+ #agListMean <- aggregate(agListMax[,3], by=list(agListMax[,2]), mean)
+ #mydf <- data.frame(agListMean)
+ #mydf <- data.frame(agListMean[,3], agListMax[,3])
+ # get beta vals for each condition collapsed across time. subset gets a matrix, and [,3] selects the third column. try without [,3]
+ waver.vector <- c(0,8.96394,89.8344,75.8427,23.2527,4.09246,0.507025,0.0493012,0)
+ vox_speech_vec <- subset(agListMean, Group.2==1)[,3]
+ vox_gesture_vec <- subset(agListMean, Group.2==2)[,3]
+ vox_gestspeech_vec <- subset(agListMean, Group.2==3)[,3]
+ vox_grasp_vec <- subset(agListMean, Group.2==4)[,3]
+
+
+ ##-- INTERPOLATION -------- ##
+ origX <- c(1:NumTimepoints)
+ ## 4 Hz resampling to get into 1/4 of a TR (1/2 second)
+ resample_length <- length(seq(1,NumTimepoints,1/4))
+ ## interpolate waver.vector and then each condition
+ asp_wvr <- aspline(origX,waver.vector,n=resample_length,method="improved")$y
+ asp_speech <- aspline(origX,vox_speech_vec,n=resample_length,method="improved")$y
+ asp_gesture <- aspline(origX,vox_gesture_vec,n=resample_length,method="improved")$y
+ asp_gestspeech <- aspline(origX,vox_gestspeech_vec,n=resample_length,method="improved")$y
+ asp_grasp <- aspline(origX,vox_grasp_vec,n=resample_length,method="improved")$y
+
+
+ #---- SPEECH
+ speech_ccf <- ccf(asp_speech, asp_wvr, lag.max = 12, type = c("correlation"), na.action=na.pass, plot=FALSE)
+ if (sum(as.numeric(is.na(speech_ccf$acf))) != 0){
+ speech_ccf$acf[1:25] = 0
+ }
+ speech_frame <- as.matrix(data.frame(speech_ccf$acf,speech_ccf$lag))
+ speech_cor <- speech_frame[which.max(speech_frame[,1]),]
+
+
+ #---- GESTURE
+ gesture_ccf <- ccf(asp_gesture, asp_wvr, lag.max = 12, type = c("correlation"), na.action=na.pass, plot=FALSE)
+ if (sum(as.numeric(is.na(gesture_ccf$acf))) != 0){
+ gesture_ccf$acf[1:25] = 0
+ }
+ gesture_frame <- as.matrix(data.frame(gesture_ccf$acf,gesture_ccf$lag))
+ gesture_cor <- gesture_frame[which.max(gesture_frame[,1]),]
+
+
+ #---- GESTURE & SPEECH
+ gestspeech_ccf <- ccf(asp_gestspeech, asp_wvr, lag.max = 12, type = c("correlation"), na.action=na.pass, plot=FALSE)
+ if (sum(as.numeric(is.na(gestspeech_ccf$acf))) != 0){
+ gestspeech_ccf$acf[1:25] = 0
+ }
+ gestspeech_frame <- as.matrix(data.frame(gestspeech_ccf$acf,gestspeech_ccf$lag))
+ gestspeech_cor <- gestspeech_frame[which.max(gestspeech_frame[,1]),]
+
+
+ #---- GRASP
+ grasp_ccf <- ccf(asp_grasp, asp_wvr, lag.max = 12, type = c("correlation"), na.action=na.pass, plot=FALSE)
+ if (sum(as.numeric(is.na(grasp_ccf$acf))) != 0){
+ grasp_ccf$acf[1:25] = 0
+ }
+ grasp_frame <- as.matrix(data.frame(grasp_ccf$acf,grasp_ccf$lag))
+ grasp_cor <- grasp_frame[which.max(grasp_frame[,1]),]
+
+
+
+ vox_id <- as.integer(vox)
+ ccf[mat_row, ] <- c(vox_id, speech_cor[[1]], speech_cor[[2]], gesture_cor[[1]], gesture_cor[[2]], gestspeech_cor[[1]], gestspeech_cor[[2]], grasp_cor[[1]], grasp_cor[[2]], num_kicked_out_ss)
+ #speech[mat_row, ] <- c(vox_id,vox_speech_vec)
+ #gesture[mat_row, ] <- c(vox_id,vox_gesture_vec)
+ #gestspeech[mat_row, ] <- c(vox_id,vox_gestspeech_vec)
+ #grasp[mat_row, ] <- c(vox_id,vox_grasp_vec)
+
+ detach(final_df)
+ rm(final_df, agListMean)
+}
+
+write.table(round(ccf,5), file=paste(outname,"_ccf.txt",sep=""), row.names=FALSE, col.names=FALSE)
+#write.table(round(speech,5), file=paste(outname,"_lh_speech.txt",sep=""), row.names=FALSE, col.names=FALSE)
+#write.table(round(gesture,5), file=paste(outname,"_lh_emblem.txt",sep=""), row.names=FALSE, col.names=FALSE)
+#write.table(round(gestspeech,5), file=paste(outname,"_lh_embspeech.txt",sep=""), row.names=FALSE, col.names=FALSE)
+#write.table(round(grasp,5), file=paste(outname,"_lh_grasp.txt",sep=""), row.names=FALSE, col.names=FALSE)
Added: SwiftApps/SIDGrid/swift/projects/andric/ccf_emblem/ccf_emblemIDEAL/scripts/grid_ccfinterp_lh.R
===================================================================
--- SwiftApps/SIDGrid/swift/projects/andric/ccf_emblem/ccf_emblemIDEAL/scripts/grid_ccfinterp_lh.R (rev 0)
+++ SwiftApps/SIDGrid/swift/projects/andric/ccf_emblem/ccf_emblemIDEAL/scripts/grid_ccfinterp_lh.R 2009-08-06 15:35:30 UTC (rev 3060)
@@ -0,0 +1,154 @@
+#---- May 31, 2009
+## using interpolation to get better precision on the lag
+#---- This vrsion cuts off Beta vals abs(val) > 8 and uses lag.max=4
+library(akima)
+allinputs <- Sys.getenv("R_SWIFT_ARGS")
+outname <- noquote(strsplit(allinputs," ")[[1]][1])
+
+inputfile <- Sys.getenv("R_INPUT")
+dd <- read.table(inputfile)
+Query_out <- data.frame(dd)
+
+NumSubjects <- 24;
+NumTimepoints <- 9;
+NumCols <- 36
+# generate the vectors that apply to each group of vectors
+SubjectVec <- as.factor(rep(1:NumSubjects,NumCols))
+CondVect <- as.factor(rep(1:4, rep(NumTimepoints*NumSubjects, 4)))
+TimePointVec <- as.factor(rep(rep(1:9, rep(NumSubjects, 9)),4))
+# the subject categorization: 1=ta-percept 0=ka or ka-ta-percept, 9=to remove from this analysis
+SubjectCategorization <- c(0,0,0,0,0,0,0,0,0,0,0,0)
+SubjectCategorization_Vec <- as.factor(rep(SubjectCategorization, 36))
+OverallRows <- length(levels(as.factor(Query_out[,2])))
+ccf <- matrix(nrow=OverallRows, ncol=10)
+speech <- matrix(nrow=OverallRows, ncol=10)
+gesture <- matrix(nrow=OverallRows, ncol=10)
+gestspeech <- matrix(nrow=OverallRows, ncol=10)
+grasp <- matrix(nrow=OverallRows, ncol=10)
+
+mat_row = 0
+
+attach(Query_out)
+#vox_levels <- as.factor(voxel)
+vox_levels <- as.factor(Query_out[,2])
+for (vox in levels(vox_levels)){
+ mat_row = mat_row + 1
+ # brougt in many voxels, now go one by one
+ vox_matrix <- Query_out[which(Query_out[,2] == vox),]
+ # take colums 3-38of the results and make vector
+ zz <- (stack(vox_matrix[,3:38]))
+ VoxValues_vec <- zz[,1]
+ Voxel_df <- data.frame(S=SubjectVec, Cond=CondVect, Time=TimePointVec, Beta=VoxValues_vec, SubjCat=SubjectCategorization_Vec)
+ attach(Voxel_df)
+ # grab those entries with extreme betavalues
+ cutoff_obs <- Voxel_df[(Voxel_df$Beta <= -8) | (Voxel_df$Beta >= 8),]
+ # if there are extreme values, clean them, otherwise, the final dataframe is the original one
+ # IN THIS ANALYSIS, WE COMPLETELY REMOVE SS THAT CONTRIBUTE EXTREME VALS
+
+ if (length(unique(cutoff_obs$Beta)) > 0){
+ # get breakdown of the extreme values by subject and condition. if we wanted just by subject could have used
+ cutoff_obs_breakdown <- aggregate(cutoff_obs$Beta, by=list(cutoff_obs$S, cutoff_obs$Time), length)
+ # now get just those conditions that had 1 or more extreme vals.
+ # ss that contributed more than 1 vals to any condition gets kicked out from this voxel's analysis
+ # this filter is very conservative. basically kicks out any ss that contributed extreme vals
+ # clean_ss_df is basically Voxel_df with the problematic ss removed
+ t1 <- subset(cutoff_obs_breakdown, cutoff_obs_breakdown$x >=1)
+ kicked_out_ss <- as.factor(as.vector(unique(t1[,1])))
+ num_kicked_out_ss <- (length(kicked_out_ss))
+ cleaned_ss_df <- Voxel_df[!(Voxel_df$S %in% kicked_out_ss),]
+ # remove remaining extreme values from df with filtered ss
+ # cleaned_ss_noextreme_df <- cleaned_ss_df[(cleaned_ss_df$Beta >= -10) & (cleaned_ss_df$Beta <= 10),]
+ # final_df <- cleaned_ss_noextreme_df[(cleaned_ss_noextreme_df$ScaledBeta >= -4) & (cleaned_ss_noextreme_df$ScaledBeta <= 4),]
+ remaining_ss <- length(as.factor(as.vector(unique(cleaned_ss_df$S))))
+ # print(remaining_ss)
+ final_df <- cleaned_ss_df
+ rm(cleaned_ss_df)
+ }
+ else{
+ num_kicked_out_ss = 0
+ final_df <- Voxel_df
+ }
+
+ # once we have final_df either after removal of extreme value or not we are ready for computations
+ detach(Voxel_df)
+ rm(Voxel_df)
+ attach(final_df)
+ #agListMean <- aggregate(Beta, by=list(S, Cond), mean)
+ agListMean <- aggregate(Beta, by=list(Time, Cond), mean)
+ #agListMax <- aggregate(Beta, by=list(S, Cond), max)
+ #agListMean <- aggregate(agListMax[,3], by=list(agListMax[,2]), mean)
+ #mydf <- data.frame(agListMean)
+ #mydf <- data.frame(agListMean[,3], agListMax[,3])
+ # get beta vals for each condition collapsed across time. subset gets a matrix, and [,3] selects the third column. try without [,3]
+ waver.vector <- c(0,8.96394,89.8344,75.8427,23.2527,4.09246,0.507025,0.0493012,0)
+ vox_speech_vec <- subset(agListMean, Group.2==1)[,3]
+ vox_gesture_vec <- subset(agListMean, Group.2==2)[,3]
+ vox_gestspeech_vec <- subset(agListMean, Group.2==3)[,3]
+ vox_grasp_vec <- subset(agListMean, Group.2==4)[,3]
+
+
+ ##-- INTERPOLATION -------- ##
+ origX <- c(1:NumTimepoints)
+ ## 4 Hz resampling to get into 1/4 of a TR (1/2 second)
+ resample_length <- length(seq(1,NumTimepoints,1/4))
+ ## interpolate waver.vector and then each condition
+ asp_wvr <- aspline(origX,waver.vector,n=resample_length,method="improved")$y
+ asp_speech <- aspline(origX,vox_speech_vec,n=resample_length,method="improved")$y
+ asp_gesture <- aspline(origX,vox_gesture_vec,n=resample_length,method="improved")$y
+ asp_gestspeech <- aspline(origX,vox_gestspeech_vec,n=resample_length,method="improved")$y
+ asp_grasp <- aspline(origX,vox_grasp_vec,n=resample_length,method="improved")$y
+
+
+ #---- SPEECH
+ speech_ccf <- ccf(asp_speech, asp_wvr, lag.max = 12, type = c("correlation"), na.action=na.pass, plot=FALSE)
+ if (sum(as.numeric(is.na(speech_ccf$acf))) != 0){
+ speech_ccf$acf[1:25] = 0
+ }
+ speech_frame <- as.matrix(data.frame(speech_ccf$acf,speech_ccf$lag))
+ speech_cor <- speech_frame[which.max(speech_frame[,1]),]
+
+
+ #---- GESTURE
+ gesture_ccf <- ccf(asp_gesture, asp_wvr, lag.max = 12, type = c("correlation"), na.action=na.pass, plot=FALSE)
+ if (sum(as.numeric(is.na(gesture_ccf$acf))) != 0){
+ gesture_ccf$acf[1:25] = 0
+ }
+ gesture_frame <- as.matrix(data.frame(gesture_ccf$acf,gesture_ccf$lag))
+ gesture_cor <- gesture_frame[which.max(gesture_frame[,1]),]
+
+
+ #---- GESTURE & SPEECH
+ gestspeech_ccf <- ccf(asp_gestspeech, asp_wvr, lag.max = 12, type = c("correlation"), na.action=na.pass, plot=FALSE)
+ if (sum(as.numeric(is.na(gestspeech_ccf$acf))) != 0){
+ gestspeech_ccf$acf[1:25] = 0
+ }
+ gestspeech_frame <- as.matrix(data.frame(gestspeech_ccf$acf,gestspeech_ccf$lag))
+ gestspeech_cor <- gestspeech_frame[which.max(gestspeech_frame[,1]),]
+
+
+ #---- GRASP
+ grasp_ccf <- ccf(asp_grasp, asp_wvr, lag.max = 12, type = c("correlation"), na.action=na.pass, plot=FALSE)
+ if (sum(as.numeric(is.na(grasp_ccf$acf))) != 0){
+ grasp_ccf$acf[1:25] = 0
+ }
+ grasp_frame <- as.matrix(data.frame(grasp_ccf$acf,grasp_ccf$lag))
+ grasp_cor <- grasp_frame[which.max(grasp_frame[,1]),]
+
+
+
+ vox_id <- as.integer(vox)
+ ccf[mat_row, ] <- c(vox_id, speech_cor[[1]], speech_cor[[2]], gesture_cor[[1]], gesture_cor[[2]], gestspeech_cor[[1]], gestspeech_cor[[2]], grasp_cor[[1]], grasp_cor[[2]], num_kicked_out_ss)
+ #speech[mat_row, ] <- c(vox_id,vox_speech_vec)
+ #gesture[mat_row, ] <- c(vox_id,vox_gesture_vec)
+ #gestspeech[mat_row, ] <- c(vox_id,vox_gestspeech_vec)
+ #grasp[mat_row, ] <- c(vox_id,vox_grasp_vec)
+
+ detach(final_df)
+ rm(final_df, agListMean)
+}
+
+write.table(round(ccf,5), file=paste(outname,"_lh_ccf.txt",sep=""), row.names=FALSE, col.names=FALSE)
+#write.table(round(speech,5), file=paste(outname,"_lh_speech.txt",sep=""), row.names=FALSE, col.names=FALSE)
+#write.table(round(gesture,5), file=paste(outname,"_lh_emblem.txt",sep=""), row.names=FALSE, col.names=FALSE)
+#write.table(round(gestspeech,5), file=paste(outname,"_lh_embspeech.txt",sep=""), row.names=FALSE, col.names=FALSE)
+#write.table(round(grasp,5), file=paste(outname,"_lh_grasp.txt",sep=""), row.names=FALSE, col.names=FALSE)
More information about the Swift-commit
mailing list