#!/usr/bin/env Rscript # Usage: This script uses reads in static files produced by STOUT that include form data from other services (e.g., SurveyMonkey) #and experiment data from STOUT, and timing data collected through a STOUT User ALE instance. ##It runs: ###basic "truthing" (is form entry right or wrong), ###"timing corrections" (client (STOUT time) vs. 3rd party timing), and ###post-processing operations (scale mean calculation, basic statistics) ###prints new version of STOUT data with appendended fields (variables), and values. #-------------------------------------------------------------------------------------------------------------- # Data Ingest ##Read in static files from STOUT # Rscript --vanilla scotchArgs.R working.merge.csv xdata.codebook.yr3.v2.scales.csv xdata.codebook.yr3.v2.items.csv aggCheck.csv MasterAnswerTable.csv args = commandArgs(trailingOnly=TRUE) # input files: matDataFile = "working.merge.csv" codeBookScalesFile = "xdata.codebook.MOTv4.scales.csv" codeBookItemsFile = "xdata.codebook.MOTv4.items.csv" # output files: aggCheckFile = "aggCheck.csv" matFile = "MasterAnswerTable.csv" if (length(args)>=1) { matDataFile = args[1] if (length(args)>=2) { codeBookScalesFile = args[2] if (length(args)>=3) { codeBookItemsFile = args[3] if (length(args)>=4) { aggCheckFile = args[4] if (length(args)>=5) { matFile = args[5] } } } } } # raw data file as .csv into Data Frames raw.data <- read.csv(matDataFile, header=TRUE, stringsAsFactors=FALSE) colnames(raw.data)[colnames(raw.data)=="user_hash"] <- "SYS.IND.SESS." codebook.scales <- read.csv(codeBookScalesFile, header=TRUE, stringsAsFactors=FALSE) # create dataframe to hold codebook subscale metadata row.names(codebook.scales) <- make.names(codebook.scales[,"varnames"], unique=TRUE) codebook.items <- read.csv(codeBookItemsFile, header=TRUE, stringsAsFactors=FALSE) # create dataframe to hold codebook items metadata row.names(codebook.items) <- make.names(codebook.items[,"varnames"], unique=TRUE) #-------------------------------------------------------------------------------------------------------------- #Truthing Script ##This script compares correct answers from Codebook to responses collected through form data OTdataRaw.CP1 <- cbind(raw.data[,"SYS.IND.SESS."], subset(raw.data, select = (grepl("TSK.PRB.CP1.",names(raw.data))==TRUE))) # create working dataset from raw names(OTdataRaw.CP1)[1] <- "SYS.IND.SESS." OTdataRaw.CP2 <- cbind(raw.data[,"SYS.IND.SESS."], subset(raw.data, select = (grepl("TSK.PRB.CP2.",names(raw.data))==TRUE))) # create working dataset from raw names(OTdataRaw.CP2)[1] <- "SYS.IND.SESS." OTdataRaw.CP3 <- cbind(raw.data[,"SYS.IND.SESS."], subset(raw.data, select = (grepl("TSK.PRB.CP3.",names(raw.data))==TRUE))) # create working dataset from raw names(OTdataRaw.CP3)[1] <- "SYS.IND.SESS." OTdataRaw.CP4 <- cbind(raw.data[,"SYS.IND.SESS."], subset(raw.data, select = (grepl("TSK.PRB.CP4.",names(raw.data))==TRUE))) # create working dataset from raw names(OTdataRaw.CP4)[1] <- "SYS.IND.SESS." OTdataRaw.CP5 <- cbind(raw.data[,"SYS.IND.SESS."], subset(raw.data, select = (grepl("TSK.PRB.CP5.",names(raw.data))==TRUE))) # create working dataset from raw names(OTdataRaw.CP5)[1] <- "SYS.IND.SESS." # write truthing dataframe for each challenge problem, with common case index with working dataset, and name index column. truth.cp1.data <- as.data.frame(cbind.data.frame(OTdataRaw.CP1[,"SYS.IND.SESS."], "TSK.PRB.ANS.CP1.OT1.001." = 0,"TSK.PRB.ANS.CP1.OT1.002." = 0,"TSK.PRB.ANS.CP1.OT1.003." = 0,"TSK.PRB.ANS.CP1.OT1.004." =0, "TSK.PRB.ANS.CP1.OT1.005." =0,"TSK.PRB.ANS.CP1.OT2.001." = 0,"TSK.PRB.ANS.CP1.OT2.003." = 0,"TSK.PRB.ANS.CP1.OT2.004." = 0,"TSK.PRB.ANS.CP1.OT2.005." = 0), stringsAsFactors=FALSE) truth.cp2.data <- as.data.frame(cbind.data.frame(OTdataRaw.CP2[,"SYS.IND.SESS."], "TSK.PRB.ANS.CP2.OT1.001." = 0,"TSK.PRB.ANS.CP2.OT1.002." = 0,"TSK.PRB.ANS.CP2.OT1.003." = 0,"TSK.PRB.ANS.CP2.OT1.004." =0, "TSK.PRB.ANS.CP2.OT1.005." =0,"TSK.PRB.ANS.CP2.OT2.001." = 0,"TSK.PRB.ANS.CP2.OT2.002." = 0,"TSK.PRB.ANS.CP2.OT2.003." = 0,"TSK.PRB.ANS.CP2.OT2.004." = 0,"TSK.PRB.ANS.CP2.OT2.005." = 0), stringsAsFactors=FALSE) truth.cp3.data <- as.data.frame(cbind.data.frame(OTdataRaw.CP3[,"SYS.IND.SESS."], "TSK.PRB.ANS.CP3.OT1.005.CGBI." = 0, "TSK.PRB.ANS.CP3.OT1.005.AERG." = 0, "TSK.PRB.ANS.CP3.OT1.005.MMTRS." = 0, "TSK.PRB.ANS.CP3.OT1.005.PGFY." = 0, "TSK.PRB.ANS.CP3.OT1.001." = 0, "TSK.PRB.ANS.CP3.OT1.004." = 0, "TSK.PRB.ANS.CP3.OT1.002." = 0, "TSK.PRB.ANS.CP3.OT1.003." = 0, "TSK.PRB.ANS.CP3.OT2.001.1ST." = 0, "TSK.PRB.ANS.CP3.OT2.001.2ND." = 0, "TSK.PRB.ANS.CP3.OT2.002.PZOO." = 0, "TSK.PRB.ANS.CP3.OT2.002.QMCI." = 0, "TSK.PRB.ANS.CP3.OT2.002.IMLE." = 0, "TSK.PRB.ANS.CP3.OT2.002.IMMB." = 0, "TSK.PRB.ANS.CP3.OT2.002.AHII." = 0, "TSK.PRB.ANS.CP3.OT2.002.GOOO." = 0, "TSK.PRB.ANS.CP3.OT2.002.FNRG." = 0, "TSK.PRB.ANS.CP3.OT2.003." = 0, "TSK.PRB.ANS.CP3.OT2.004.JAN." = 0, "TSK.PRB.ANS.CP3.OT2.004.FEB." = 0, "TSK.PRB.ANS.CP3.OT2.004.MAR." = 0, "TSK.PRB.ANS.CP3.OT2.004.APR." = 0, "TSK.PRB.ANS.CP3.OT2.004.MAY." = 0, "TSK.PRB.ANS.CP3.OT2.004.JUN." = 0, "TSK.PRB.ANS.CP3.OT2.004.JUL." = 0, "TSK.PRB.ANS.CP3.OT2.004.AUG." = 0, "TSK.PRB.ANS.CP3.OT2.004.SEP." = 0, "TSK.PRB.ANS.CP3.OT2.004.OCT." = 0, "TSK.PRB.ANS.CP3.OT2.004.NOV." = 0, "TSK.PRB.ANS.CP3.OT2.004.DEC." = 0, "TSK.PRB.ANS.CP3.OT2.005.GHIL." = 0, "TSK.PRB.ANS.CP3.OT2.005.IFLM." = 0, "TSK.PRB.ANS.CP3.OT2.005.FNRG." = 0, "TSK.PRB.ANS.CP3.OT2.005.CTOT." = 0, "TSK.PRB.ANS.CP3.OT2.005.CMGO." = 0, "TSK.PRB.ANS.CP3.OT2.005.MYRY." = 0), stringsAsFactors=FALSE) truth.cp4.data <- as.data.frame(cbind.data.frame(OTdataRaw.CP4[,"SYS.IND.SESS."], "TSK.PRB.ANS.CP4.OT1.001." = 0,"TSK.PRB.ANS.CP4.OT1.002." = 0,"TSK.PRB.ANS.CP4.OT1.003." = 0,"TSK.PRB.ANS.CP4.OT2.001." = 0,"TSK.PRB.ANS.CP4.OT2.002." = 0,"TSK.PRB.ANS.CP4.OT2.003." = 0), stringsAsFactors=FALSE) truth.cp5.data <- as.data.frame(cbind.data.frame(OTdataRaw.CP5[,"SYS.IND.SESS."], "TSK.PRB.ANS.CP5.OT1.001." = 0,"TSK.PRB.ANS.CP5.OT1.002." = 0,"TSK.PRB.ANS.CP5.OT1.003." = 0,"TSK.PRB.ANS.CP5.OT1.004." =0, "TSK.PRB.ANS.CP5.OT2.001." = 0,"TSK.PRB.ANS.CP5.OT2.002." = 0,"TSK.PRB.ANS.CP5.OT2.003." = 0,"TSK.PRB.ANS.CP5.OT2.004." = 0,"TSK.PRB.ANS.CP5.OT2.005." = 0), stringsAsFactors=FALSE) names(truth.cp1.data)[1] <- "SYS.IND.SESS." names(truth.cp2.data)[1] <- "SYS.IND.SESS." names(truth.cp3.data)[1] <- "SYS.IND.SESS." names(truth.cp4.data)[1] <- "SYS.IND.SESS." names(truth.cp5.data)[1] <- "SYS.IND.SESS." truthCalc = function(ind, ans, rawData, codebook, truthData){ # arguments: # ind = the variable being checked # ans = the variable name containing the truth # rawData = dataframe holding participant data being checked # codebook = dataframe containing correct answers and the weights for each # truthData = dataframe holding the truthed data truths = strsplit(codebook[ind,"truth"],split=",") # each "truth" cell in the codebook contains all the strings such that if any are in the answer, it is correct; this command splits the contents of the truth cell into those strings for(i in 1:nrow(rawData)){ # for each case in the raw data flagCorrect = FALSE # the answer is wrong until a match is found if(length(truths[[1]])>0) { for(n in 1:length(truths[[1]])){ # for all the strings that need to be checked (if no commas, length equals 1, containing the contents that are in the truth cell) if(!is.na(rawData[i,ind])){ #if cell is not empty if(grepl(paste("\\<" ,truths[[1]][[n]],"\\>",sep=""), rawData[i,ind], ignore.case=TRUE)==TRUE){ # paste truth from codebook, then \\ match on complete string sequence against cell content flagCorrect = TRUE # if a match is found, then mark the answer as correct } } } } if(flagCorrect == TRUE){ truthData[i, ans] = 1 } # if the answer was flagged correct } truthCalc = truthData # return the truth data } truthCalcExactMatch = function(ind, ans, rawData, codebook, truthData){ # arguments: # ind = the variable being checked # ans = the variable name containing the truth # rawData = dataframe holding participant data being checked # codebook = dataframe containing correct answers and the weights for each # truthData = dataframe holding the truthed data truths = strsplit(codebook[ind,"truth"],split=",") # each "truth" cell in the codebook contains all the strings such that if any are in the answer, it is correct; this command splits the contents of the truth cell into those strings for(i in 1:nrow(rawData)){ # for each case in the raw data flagCorrect = FALSE # the answer is wrong until a match is found for(n in 1:length(truths[[1]])){ # for all the strings that need to be checked (if no commas, length equals 1, containing the contents that are in the truth cell) if(!is.na(rawData[i,ind])){ #if cell is not empty if(grepl(paste("^" ,truths[[1]][[n]],"$",sep=""), rawData[i,ind], ignore.case=TRUE)==TRUE){ # paste truth from codebook, then \\ match on complete string sequence against cell content flagCorrect = TRUE # if a match is found, then mark the answer as correct } } } if(flagCorrect == TRUE){ truthData[i, ans] = 1 } # if the answer was flagged correct } truthCalcExactMatch = truthData # return the truth data } #------------------------------------------------------------------------------ # CP1. Population Movements #------------------------------------------------------------------------------ truth.cp1.data = truthCalc("TSK.PRB.CP1.OT1.001.", "TSK.PRB.ANS.CP1.OT1.001.", OTdataRaw.CP1, codebook.items, truth.cp1.data) truth.cp1.data = truthCalc("TSK.PRB.CP1.OT1.002.", "TSK.PRB.ANS.CP1.OT1.002.", OTdataRaw.CP1, codebook.items, truth.cp1.data) truth.cp1.data = truthCalc("TSK.PRB.CP1.OT1.003.", "TSK.PRB.ANS.CP1.OT1.003.", OTdataRaw.CP1, codebook.items, truth.cp1.data) truth.cp1.data = truthCalc("TSK.PRB.CP1.OT1.004.", "TSK.PRB.ANS.CP1.OT1.004.", OTdataRaw.CP1, codebook.items, truth.cp1.data) truth.cp1.data = truthCalc("TSK.PRB.CP1.OT1.005.", "TSK.PRB.ANS.CP1.OT1.005.", OTdataRaw.CP1, codebook.items, truth.cp1.data) truth.cp1.data = truthCalc("TSK.PRB.CP1.OT2.001.", "TSK.PRB.ANS.CP1.OT2.001.", OTdataRaw.CP1, codebook.items, truth.cp1.data) #truth.cp1.data = truthCalc("TSK.PRB.CP1.OT2.002.", "TSK.PRB.ANS.CP1.OT2.002.", OTdataRaw.CP1, codebook.items, truth.cp1.data) truth.cp1.data = truthCalc("TSK.PRB.CP1.OT2.003.", "TSK.PRB.ANS.CP1.OT2.003.", OTdataRaw.CP1, codebook.items, truth.cp1.data) truth.cp1.data = truthCalc("TSK.PRB.CP1.OT2.004.", "TSK.PRB.ANS.CP1.OT2.004.", OTdataRaw.CP1, codebook.items, truth.cp1.data) truth.cp1.data = truthCalc("TSK.PRB.CP1.OT2.005.", "TSK.PRB.ANS.CP1.OT2.005.", OTdataRaw.CP1, codebook.items, truth.cp1.data) #write.csv(truth.cp1.data, file = "CP1_Truthv3_Check.csv", row.names=FALSE) # write out the data #------------------------------------------------------------------------------ # CP2. Dealiasing #------------------------------------------------------------------------------ truth.cp2.data = truthCalc("TSK.PRB.CP2.OT1.001.", "TSK.PRB.ANS.CP2.OT1.001.", OTdataRaw.CP2, codebook.items, truth.cp2.data) truth.cp2.data = truthCalc("TSK.PRB.CP2.OT1.002.", "TSK.PRB.ANS.CP2.OT1.002.", OTdataRaw.CP2, codebook.items, truth.cp2.data) truth.cp2.data = truthCalc("TSK.PRB.CP2.OT1.003.", "TSK.PRB.ANS.CP2.OT1.003.", OTdataRaw.CP2, codebook.items, truth.cp2.data) truth.cp2.data = truthCalc("TSK.PRB.CP2.OT1.004.", "TSK.PRB.ANS.CP2.OT1.004.", OTdataRaw.CP2, codebook.items, truth.cp2.data) truth.cp2.data = truthCalc("TSK.PRB.CP2.OT1.005.", "TSK.PRB.ANS.CP2.OT1.005.", OTdataRaw.CP2, codebook.items, truth.cp2.data) truth.cp2.data = truthCalc("TSK.PRB.CP2.OT2.001.", "TSK.PRB.ANS.CP2.OT2.001.", OTdataRaw.CP2, codebook.items, truth.cp2.data) truth.cp2.data = truthCalc("TSK.PRB.CP2.OT2.002.", "TSK.PRB.ANS.CP2.OT2.002.", OTdataRaw.CP2, codebook.items, truth.cp2.data) truth.cp2.data = truthCalc("TSK.PRB.CP2.OT2.003.", "TSK.PRB.ANS.CP2.OT2.003.", OTdataRaw.CP2, codebook.items, truth.cp2.data) truth.cp2.data = truthCalc("TSK.PRB.CP2.OT2.004.", "TSK.PRB.ANS.CP2.OT2.004.", OTdataRaw.CP2, codebook.items, truth.cp2.data) truth.cp2.data = truthCalc("TSK.PRB.CP2.OT2.005.", "TSK.PRB.ANS.CP2.OT2.005.", OTdataRaw.CP2, codebook.items, truth.cp2.data) #write.csv(truth.cp2.data, file = "CP2_Truthv3_Check.csv", row.names=FALSE) #------------------------------------------------------------------------------ # CP3. Financial #------------------------------------------------------------------------------ truth.cp3.data = truthCalc("TSK.PRB.CP3.OT1.005.CGBI.", "TSK.PRB.ANS.CP3.OT1.005.CGBI.", OTdataRaw.CP3, codebook.items, truth.cp3.data) truth.cp3.data = truthCalc("TSK.PRB.CP3.OT1.005.AERG.", "TSK.PRB.ANS.CP3.OT1.005.AERG.", OTdataRaw.CP3, codebook.items, truth.cp3.data) truth.cp3.data = truthCalc("TSK.PRB.CP3.OT1.005.MMTRS.", "TSK.PRB.ANS.CP3.OT1.005.MMTRS.", OTdataRaw.CP3, codebook.items, truth.cp3.data) truth.cp3.data = truthCalc("TSK.PRB.CP3.OT1.005.PGFY.", "TSK.PRB.ANS.CP3.OT1.005.PGFY.", OTdataRaw.CP3, codebook.items, truth.cp3.data) truth.cp3.data = truthCalc("TSK.PRB.CP3.OT1.001.", "TSK.PRB.ANS.CP3.OT1.001.", OTdataRaw.CP3, codebook.items, truth.cp3.data) truth.cp3.data = truthCalc("TSK.PRB.CP3.OT1.004.", "TSK.PRB.ANS.CP3.OT1.004.", OTdataRaw.CP3, codebook.items, truth.cp3.data) truth.cp3.data = truthCalc("TSK.PRB.CP3.OT1.002.", "TSK.PRB.ANS.CP3.OT1.002.", OTdataRaw.CP3, codebook.items, truth.cp3.data) truth.cp3.data = truthCalc("TSK.PRB.CP3.OT1.003.", "TSK.PRB.ANS.CP3.OT1.003.", OTdataRaw.CP3, codebook.items, truth.cp3.data) # truthing for TSK.PRB.CP3.OT2.001.1ST. for(i in 1:nrow(OTdataRaw.CP3)){ if(is.null(OTdataRaw.CP3[i,"TSK.PRB.CP3.OT2.001.1ST."])==FALSE){ dateTemp1 = as.Date("2000-01-01") if(nchar(OTdataRaw.CP3[i,"TSK.PRB.CP3.OT2.001.1ST."])<8){ OTdataRaw.CP3[i,"TSK.PRB.CP3.OT2.001.1ST."] = paste("0", OTdataRaw.CP3[i,"TSK.PRB.CP3.OT2.001.1ST."], sep = "")} if(!is.na(as.Date(OTdataRaw.CP3[i,"TSK.PRB.CP3.OT2.001.1ST."], "%m%d%Y"))){ dateTemp1 = as.Date(OTdataRaw.CP3[i,"TSK.PRB.CP3.OT2.001.1ST."], "%m%d%Y") } else if(!is.na(as.Date(OTdataRaw.CP3[i,"TSK.PRB.CP3.OT2.001.1ST."], "%m/%d/%Y"))){ dateTemp1 = as.Date(OTdataRaw.CP3[i,"TSK.PRB.CP3.OT2.001.1ST."], "%m/%d/%Y") } if((dateTemp1 >= as.Date("2014-01-01")) && (dateTemp1 <= as.Date("2014-05-31"))){ truth.cp3.data[i, "TSK.PRB.ANS.CP3.OT2.001.1ST."] = 1 } } } # truthing for TSK.PRB.CP3.OT2.001.2ND. for(i in 1:nrow(OTdataRaw.CP3)){ if(is.null(OTdataRaw.CP3[i,"TSK.PRB.CP3.OT2.001.2ND."])==FALSE){ dateTemp1 = as.Date("2000-01-01") if(nchar(OTdataRaw.CP3[i,"TSK.PRB.CP3.OT2.001.2ND."])<8){ OTdataRaw.CP3[i,"TSK.PRB.CP3.OT2.001.2ND."] = paste("0", OTdataRaw.CP3[i,"TSK.PRB.CP3.OT2.001.2ND."], sep = "")} if(!is.na(as.Date(OTdataRaw.CP3[i,"TSK.PRB.CP3.OT2.001.2ND."], "%m%d%Y"))){ dateTemp1 = as.Date(OTdataRaw.CP3[i,"TSK.PRB.CP3.OT2.001.2ND."], "%m%d%Y") } else if(!is.na(as.Date(OTdataRaw.CP3[i,"TSK.PRB.CP3.OT2.001.2ND."], "%m/%d/%Y"))){ dateTemp1 = as.Date(OTdataRaw.CP3[i,"TSK.PRB.CP3.OT2.001.2ND."], "%m/%d/%Y") } if((dateTemp1 >= as.Date("2015-01-01")) && (dateTemp1 <= as.Date("2015-03-31"))){ truthData[i, "TSK.PRB.ANS.CP3.OT2.001.2ND."] = 1 } } } truth.cp3.data = truthCalcExactMatch("TSK.PRB.CP3.OT2.002.PZOO.", "TSK.PRB.ANS.CP3.OT2.002.PZOO.", OTdataRaw.CP3, codebook.items, truth.cp3.data) truth.cp3.data = truthCalcExactMatch("TSK.PRB.CP3.OT2.002.QMCI.", "TSK.PRB.ANS.CP3.OT2.002.QMCI.", OTdataRaw.CP3, codebook.items, truth.cp3.data) truth.cp3.data = truthCalcExactMatch("TSK.PRB.CP3.OT2.002.IMLE.", "TSK.PRB.ANS.CP3.OT2.002.IMLE.", OTdataRaw.CP3, codebook.items, truth.cp3.data) truth.cp3.data = truthCalcExactMatch("TSK.PRB.CP3.OT2.002.IMMB.", "TSK.PRB.ANS.CP3.OT2.002.IMMB.", OTdataRaw.CP3, codebook.items, truth.cp3.data) truth.cp3.data = truthCalcExactMatch("TSK.PRB.CP3.OT2.002.AHII.", "TSK.PRB.ANS.CP3.OT2.002.AHII.", OTdataRaw.CP3, codebook.items, truth.cp3.data) truth.cp3.data = truthCalcExactMatch("TSK.PRB.CP3.OT2.002.GOOO.", "TSK.PRB.ANS.CP3.OT2.002.GOOO.", OTdataRaw.CP3, codebook.items, truth.cp3.data) truth.cp3.data = truthCalcExactMatch("TSK.PRB.CP3.OT2.002.FNRG.", "TSK.PRB.ANS.CP3.OT2.002.FNRG.", OTdataRaw.CP3, codebook.items, truth.cp3.data) truth.cp3.data = truthCalc("TSK.PRB.CP3.OT2.003.", "TSK.PRB.ANS.CP3.OT2.003.", OTdataRaw.CP3, codebook.items, truth.cp3.data) truth.cp3.data = truthCalc("TSK.PRB.CP3.OT2.004.JAN.", "TSK.PRB.ANS.CP3.OT2.004.JAN.", OTdataRaw.CP3, codebook.items, truth.cp3.data) truth.cp3.data = truthCalc("TSK.PRB.CP3.OT2.004.FEB.", "TSK.PRB.ANS.CP3.OT2.004.FEB.", OTdataRaw.CP3, codebook.items, truth.cp3.data) truth.cp3.data = truthCalc("TSK.PRB.CP3.OT2.004.MAR.", "TSK.PRB.ANS.CP3.OT2.004.MAR.", OTdataRaw.CP3, codebook.items, truth.cp3.data) truth.cp3.data = truthCalc("TSK.PRB.CP3.OT2.004.APR.", "TSK.PRB.ANS.CP3.OT2.004.APR.", OTdataRaw.CP3, codebook.items, truth.cp3.data) truth.cp3.data = truthCalc("TSK.PRB.CP3.OT2.004.MAY.", "TSK.PRB.ANS.CP3.OT2.004.MAY.", OTdataRaw.CP3, codebook.items, truth.cp3.data) truth.cp3.data = truthCalc("TSK.PRB.CP3.OT2.004.JUN.", "TSK.PRB.ANS.CP3.OT2.004.JUN.", OTdataRaw.CP3, codebook.items, truth.cp3.data) truth.cp3.data = truthCalc("TSK.PRB.CP3.OT2.004.JUL.", "TSK.PRB.ANS.CP3.OT2.004.JUL.", OTdataRaw.CP3, codebook.items, truth.cp3.data) truth.cp3.data = truthCalc("TSK.PRB.CP3.OT2.004.AUG.", "TSK.PRB.ANS.CP3.OT2.004.AUG.", OTdataRaw.CP3, codebook.items, truth.cp3.data) truth.cp3.data = truthCalc("TSK.PRB.CP3.OT2.004.SEP.", "TSK.PRB.ANS.CP3.OT2.004.SEP.", OTdataRaw.CP3, codebook.items, truth.cp3.data) truth.cp3.data = truthCalc("TSK.PRB.CP3.OT2.004.OCT.", "TSK.PRB.ANS.CP3.OT2.004.OCT.", OTdataRaw.CP3, codebook.items, truth.cp3.data) truth.cp3.data = truthCalc("TSK.PRB.CP3.OT2.004.NOV.", "TSK.PRB.ANS.CP3.OT2.004.NOV.", OTdataRaw.CP3, codebook.items, truth.cp3.data) truth.cp3.data = truthCalc("TSK.PRB.CP3.OT2.004.DEC.", "TSK.PRB.ANS.CP3.OT2.004.DEC.", OTdataRaw.CP3, codebook.items, truth.cp3.data) truth.cp3.data = truthCalc("TSK.PRB.CP3.OT2.005.GHIL.", "TSK.PRB.ANS.CP3.OT2.005.GHIL.", OTdataRaw.CP3, codebook.items, truth.cp3.data) truth.cp3.data = truthCalc("TSK.PRB.CP3.OT2.005.IFLM.", "TSK.PRB.ANS.CP3.OT2.005.IFLM.", OTdataRaw.CP3, codebook.items, truth.cp3.data) truth.cp3.data = truthCalc("TSK.PRB.CP3.OT2.005.FNRG.", "TSK.PRB.ANS.CP3.OT2.005.FNRG.", OTdataRaw.CP3, codebook.items, truth.cp3.data) truth.cp3.data = truthCalc("TSK.PRB.CP3.OT2.005.CTOT.", "TSK.PRB.ANS.CP3.OT2.005.CTOT.", OTdataRaw.CP3, codebook.items, truth.cp3.data) truth.cp3.data = truthCalc("TSK.PRB.CP3.OT2.005.CMGO.", "TSK.PRB.ANS.CP3.OT2.005.CMGO.", OTdataRaw.CP3, codebook.items, truth.cp3.data) truth.cp3.data = truthCalc("TSK.PRB.CP3.OT2.005.MYRY.", "TSK.PRB.ANS.CP3.OT2.005.MYRY.", OTdataRaw.CP3, codebook.items, truth.cp3.data) truth.cp3.data = cbind(truth.cp3.data,rowSums(subset(truth.cp3.data, select = c(TSK.PRB.ANS.CP3.OT1.005.CGBI.,TSK.PRB.ANS.CP3.OT1.005.PGFY.), na.rm = TRUE))) names(truth.cp3.data)[ncol(truth.cp3.data)] <- "TSK.PRB.ANS.CP3.OT1.005." truth.cp3.data = cbind(truth.cp3.data,rowSums(subset(truth.cp3.data, select = (grepl("TSK.PRB.ANS.CP3.OT2.001.", names(truth.cp3.data))==TRUE)), na.rm = TRUE)) names(truth.cp3.data)[ncol(truth.cp3.data)] <- "TSK.PRB.ANS.CP3.OT2.001." truth.cp3.data = cbind(truth.cp3.data,rowSums(subset(truth.cp3.data, select = (grepl("TSK.PRB.ANS.CP3.OT2.002.", names(truth.cp3.data))==TRUE)), na.rm = TRUE)) names(truth.cp3.data)[ncol(truth.cp3.data)] <- "TSK.PRB.ANS.CP3.OT2.002." truth.cp3.data = cbind(truth.cp3.data,rowSums(subset(truth.cp3.data, select = c(TSK.PRB.ANS.CP3.OT2.004.OCT.,TSK.PRB.ANS.CP3.OT2.004.NOV.), na.rm = TRUE))) names(truth.cp3.data)[ncol(truth.cp3.data)] <- "TSK.PRB.ANS.CP3.OT2.004." truth.cp3.data = cbind(truth.cp3.data,rowSums(subset(truth.cp3.data, select = (grepl("TSK.PRB.ANS.CP3.OT2.005.", names(truth.cp3.data))==TRUE)), na.rm = TRUE)) names(truth.cp3.data)[ncol(truth.cp3.data)] <- "TSK.PRB.ANS.CP3.OT2.005." truth.cp3.data.agg <- subset(truth.cp3.data, select= unlist(lapply(gregexpr("\\.",names(truth.cp3.data)),length)) < 7) #write.csv(truth.cp3.data, file = "CP3_Truthv3_Check.csv", row.names=FALSE) #------------------------------------------------------------------------------ # CP4. Population Movements for GEQE #------------------------------------------------------------------------------ truth.cp4.data = truthCalc("TSK.PRB.CP4.OT1.001.1ST.", "TSK.PRB.ANS.CP4.OT1.001.1ST.", OTdataRaw.CP4, codebook.items, truth.cp4.data) truth.cp4.data = truthCalc("TSK.PRB.CP4.OT1.001.2ND.", "TSK.PRB.ANS.CP4.OT1.001.2ND.", OTdataRaw.CP4, codebook.items, truth.cp4.data) truth.cp4.data = truthCalc("TSK.PRB.CP4.OT1.002.", "TSK.PRB.ANS.CP4.OT1.002.", OTdataRaw.CP4, codebook.items, truth.cp4.data) truth.cp4.data = truthCalc("TSK.PRB.CP4.OT1.003.", "TSK.PRB.ANS.CP4.OT1.003.", OTdataRaw.CP4, codebook.items, truth.cp4.data) #truth.cp4.data = truthCalc("TSK.PRB.CP4.OT1.004.", "TSK.PRB.ANS.CP4.OT1.004.", OTdataRaw.CP4, codebook.items, truth.cp4.data) #truth.cp4.data = truthCalc("TSK.PRB.CP4.OT1.005.", "TSK.PRB.ANS.CP4.OT1.005.", OTdataRaw.CP4, codebook.items, truth.cp4.data) truth.cp4.data = truthCalc("TSK.PRB.CP4.OT2.001.1ST.", "TSK.PRB.ANS.CP4.OT2.001.1ST.", OTdataRaw.CP4, codebook.items, truth.cp4.data) truth.cp4.data = truthCalc("TSK.PRB.CP4.OT2.001.2ND.", "TSK.PRB.ANS.CP4.OT2.001.2ND.", OTdataRaw.CP4, codebook.items, truth.cp4.data) truth.cp4.data = truthCalc("TSK.PRB.CP4.OT2.002.", "TSK.PRB.ANS.CP4.OT2.002.", OTdataRaw.CP4, codebook.items, truth.cp4.data) truth.cp4.data = truthCalc("TSK.PRB.CP4.OT2.003.", "TSK.PRB.ANS.CP4.OT2.003.", OTdataRaw.CP4, codebook.items, truth.cp4.data) #truth.cp4.data = truthCalc("TSK.PRB.CP4.OT2.004.", "TSK.PRB.ANS.CP4.OT2.004.", OTdataRaw.CP4, codebook.items, truth.cp4.data) #truth.cp4.data = truthCalc("TSK.PRB.CP4.OT2.005.", "TSK.PRB.ANS.CP4.OT2.005.", OTdataRaw.CP4, codebook.items, truth.cp4.data) #write.csv(truth.cp1.data, file = "CP1_Truthv3_Check.csv", row.names=FALSE) # write out the data #------------------------------------------------------------------------------ # CP5. Population Movements for NEON (NYC Only) #------------------------------------------------------------------------------ truth.cp5.data = truthCalc("TSK.PRB.CP5.OT1.001.", "TSK.PRB.ANS.CP5.OT1.001.", OTdataRaw.CP5, codebook.items, truth.cp5.data) truth.cp5.data = truthCalc("TSK.PRB.CP5.OT1.002.", "TSK.PRB.ANS.CP5.OT1.002.", OTdataRaw.CP5, codebook.items, truth.cp5.data) truth.cp5.data = truthCalc("TSK.PRB.CP5.OT1.003.", "TSK.PRB.ANS.CP5.OT1.003.", OTdataRaw.CP5, codebook.items, truth.cp5.data) truth.cp5.data = truthCalc("TSK.PRB.CP5.OT1.004.", "TSK.PRB.ANS.CP5.OT1.004.", OTdataRaw.CP5, codebook.items, truth.cp5.data) #truth.cp5.data = truthCalc("TSK.PRB.CP5.OT1.005.", "TSK.PRB.ANS.CP5.OT1.005.", OTdataRaw.CP5, codebook.items, truth.cp5.data) truth.cp5.data = truthCalc("TSK.PRB.CP5.OT2.001.", "TSK.PRB.ANS.CP5.OT2.001.", OTdataRaw.CP5, codebook.items, truth.cp5.data) truth.cp5.data = truthCalc("TSK.PRB.CP5.OT2.002.", "TSK.PRB.ANS.CP5.OT2.002.", OTdataRaw.CP5, codebook.items, truth.cp5.data) truth.cp5.data = truthCalc("TSK.PRB.CP5.OT2.003.", "TSK.PRB.ANS.CP5.OT2.003.", OTdataRaw.CP5, codebook.items, truth.cp5.data) truth.cp5.data = truthCalc("TSK.PRB.CP5.OT2.004.", "TSK.PRB.ANS.CP5.OT2.004.", OTdataRaw.CP5, codebook.items, truth.cp5.data) truth.cp5.data = truthCalc("TSK.PRB.CP5.OT2.005.", "TSK.PRB.ANS.CP5.OT2.005.", OTdataRaw.CP5, codebook.items, truth.cp5.data) #write.csv(truth.cp1.data, file = "CP1_Truthv3_Check.csv", row.names=FALSE) # write out the data #------------------------------------------------------------------------------- #Merge Operations across new Data Frames #------------------------------------------------------------------------------- truth.cp1.data <- subset(truth.cp1.data, is.na(truth.cp1.data[,"SYS.IND.SESS."])==FALSE) truth.cp2.data <- subset(truth.cp2.data, is.na(truth.cp2.data[,"SYS.IND.SESS."])==FALSE) truth.cp3.data.agg <- subset(truth.cp3.data.agg, is.na(truth.cp3.data.agg[,"SYS.IND.SESS."])==FALSE) truth.cp4.data <- subset(truth.cp4.data, is.na(truth.cp4.data[,"SYS.IND.SESS."])==FALSE) truth.cp5.data <- subset(truth.cp5.data, is.na(truth.cp5.data[,"SYS.IND.SESS."])==FALSE) CP.truth.data =list(truth.cp1.data,truth.cp2.data,truth.cp3.data.agg,truth.cp4.data,truth.cp5.data) #add truthed dataframes to single list CP.truth.data.merged = Reduce(function(...) merge(..., by = "SYS.IND.SESS.",all.y = TRUE), CP.truth.data) #simultaneously merge all dataframes indexed by case identifier #Merge with Raw Data mongo.data.truthed <- merge(raw.data,CP.truth.data.merged,by= "SYS.IND.SESS.", all =TRUE) # merge with old User-Ale log data # comment out if no longer needed xdatalog.data <- read.csv("xdatatimelog.csv", header=TRUE, stringsAsFactors=FALSE) colnames(xdatalog.data)[colnames(xdatalog.data)=="sessionID"] <- "SYS.IND.SESS." xdatalog.data<-xdatalog.data[!duplicated(xdatalog.data["SYS.IND.SESS."]),] #remove dupe cases by SESS ID mongo.data.truthed <- merge(mongo.data.truthed,xdatalog.data,by= "SYS.IND.SESS.", all.x =TRUE) mongo.data.truthed["SYS.FIL.STD."][is.na(mongo.data.truthed["SYS.FIL.STD."])] <- as.character(mongo.data.truthed["timestamp"][is.na(mongo.data.truthed["SYS.FIL.STD."])]) # save the raw plus truthed data #write.csv(mongo.data.truthed, file = "mongo.data.truthed.csv", row.names=FALSE) #-------------------------------------------------------------------------------------------------------------- #Temporal Variables Computation; Authors: Joshua C. Poore, Eric M. Jones. #This script ingests stout start time output, adjusts time synchronization between STOUT and other procs and prepares it for additional processing within R #v1 Eric Jones: #v2 Joshua Poore: Updated data handling, subsetting based on varname parsing. Generalized code to work for numerous variables, rather than 2. #v3 Joshua Poore, Fei Sun: Updated Sync Operations to include data from STOUT-USER ALE for timing params. Updated data handling for fewer loops. #Dependencies ##Paste Index Fucntion Paste.Index = function(text.name, index){ #this function pastes a new index term to a text value. Inputs = text.name (value I want to print to), index (new index I want to print onto name) paste(text.name,index, sep = "", collapse = "") } ##Time Extract Function # 2015-12-28 21:48:34 Time.Extract = function(time.value, timezone){ #this function strips time from a value, and formats it in POSIX time, Inputs = time.value (value I want formated), timezone (timezone of value) format(as.POSIXct(strptime(time.value,"%Y-%m-%d %H:%M:%S", tz = timezone))) } # 2016-03-26T19:31:46.562Z Timez.Extract = function(time.value, timezone){ #this function strips time from a value, and formats it in POSIX time, Inputs = time.value (value I want formated), timezone (timezone of value) format(as.POSIXct(strptime(time.value,"%Y-%m-%dT%H:%M:%S", tz = timezone))) } Sync.Conversion = function(time.value, sync.delta.time, timezone){ format(as.POSIXct(time.value, tz = timezone) - sync.delta.time) } client.tz = "utc" surveymonkey.tz = "utc" #Data Ingest #Create new dataframe with index values (SessID and STOUT Session Time) and times for converstion time.data<- cbind(subset(mongo.data.truthed, select = c(SYS.IND.SESS.,SYS.FIL.STD.)),subset(mongo.data.truthed, select = (grepl("TSK.FIL.STD.",names(raw.data)) | (grepl("TSK.FIL.END.",names(raw.data)) ==TRUE)))) #subset and bind dataframe together colnames(time.data)[3:ncol(time.data)] <- sapply(colnames(time.data)[3:ncol(time.data)],Paste.Index, "CORR.") #apply new index on colnames time.data[,3:ncol(time.data)] = sapply(time.data[,3:ncol(time.data)],Time.Extract, surveymonkey.tz) #reformat into POSIX time format (gmt) time.data[,"SYS.FIL.STD."] = sapply(time.data[,"SYS.FIL.STD."],Timez.Extract, client.tz) #reformat STOUT Session time for (i in 1:nrow(time.data)){ times.order<-order(time.data[i,3:ncol(time.data)],decreasing = FALSE, na.last = NA) #find the "start date" for non-client times (e.g., forms), should be first for each session # for missing time data, not able to sort, times.order=length(0) if(length(times.order)<=0) { times.order<-c(1); } sync.diff<- as.numeric(difftime(time.data[i,"SYS.FIL.STD."],time.data[i,2+(times.order[1])], units="secs")) #calculate the difference in time by subtracting non-client "start date" from client start date (SYS.FIL.STD.) time.data[i,3:ncol(time.data)] = sapply(time.data[i,3:ncol(time.data)],Sync.Conversion, sync.diff, client.tz) #substracts the sync difference from each value in times.to.sync, prints new values over old. } #Computes delta between end and start times. #new data frame from END times, start times will be subtracted from these values. *MOVE TO SAPPLY LATER time.data.delta <- cbind(subset(time.data, select= c(SYS.IND.SESS.,SYS.FIL.STD.)), subset(time.data, select = (grepl("TSK.FIL.END.",names(time.data))==TRUE))) for (i in 3:ncol(time.data.delta)){ #Assign new column names to the new data frame to dindicate they are deltas colnames(time.data.delta)[i] <- paste("TSK.TIME.DIFF.",substr(colnames(time.data.delta[i]),start=13,stop=24), sep = "", collapse = "") } for(j in names(time.data.delta)[3:ncol(time.data.delta)]){ #if(is.na(time.data.delta[,j])==FALSE){ x = time.data[,paste("TSK.FIL.STD.",substr(colnames(time.data.delta[j]),start=15,stop=29),"CORR.",sep = "", collapse = "")] y = time.data.delta[,j] time.data.delta[,j] = as.numeric(difftime(y,x,units="secs")) } #merge data files and write out colnames(mongo.data.truthed)[colnames(mongo.data.truthed)=="SYS.FIL.STD."] <- "SYS.FIL.STD.UTC." time.data.delta <- subset(time.data.delta, select=-c(SYS.FIL.STD.)) working.truthed.timed.data = list(mongo.data.truthed,time.data,time.data.delta) #add truthed dataframes to single list working.truthed.timed.data = Reduce(function(...) merge(..., by = "SYS.IND.SESS."), working.truthed.timed.data) working.truthed.timed.data <- as.data.frame(working.truthed.timed.data, stringsAsFactors = FALSE) #write.csv(working.truthed.timed.data, file = "working.truthed.timed.data.csv", row.names=FALSE) #______________________________________________________________________________________________________________ #SCO+CH #Scale Computation Operations + Codebook Handling (SCO+CH); Authors:Joshua C. Poore, Eric M. Jones. #This script produces aggregates across questionnaire data, such as scale and subscale means. Ends with reporting out descriptive statistics. #v1 Joshua Poore: Core data ingest, variable substring decomposition, variable substring matching, core means loop, output bind to dataframes, write out functions, documentation #v2 Eric Jones: Created dataPull() function, wrote reverse scoring code, incorporated dataPull() function in code to calcualte scale and ... # subscale means, wrote code to make sure no redundant columns are appended to the intake data, documentation #v3 Joshua Poore: Added row indexing for easy reference by PID & Variable, removed dataPull function in favor of base R subsetting functions; # added codebook ingest and output to reverse coding code and weighting; additional loop for computing scales from subscales; documentation #v5 Eric Jones: wrote and tested Reverse Coding, Weighting, and Aggregated Means functions #v6 Joshua Poore: Integrated sequential aggregation, "saverage,ssum" operation functionality. Revised object naming conventions for clarity. #Dependencies: coefficientalpha(resm,lavaan),xlsx(rJava,xlsxjars),write.xls{xlsReadWrite},gdata #-------------------------------------------------------------------------------------------------------------- # Reverse Coding Function # if a variable is flagged for reverse scoring (as indicated in the codebook), reverse the scores, replacing the values in the column # Arguments: # data - dataframe of raw (all) data # metadata - dataframe of codebook data # revCodeName - name of the column in the codebook that flags a variable for reverse coding # scaleMaxName - name of the column in the codebook that holds the maximum scale value for each variable reverseCode = function(data, metadata, varCol, revCol, scaleMaxCol){ row.names(metadata) <- make.names(metadata[,varCol], unique=TRUE) for(j in names(data)){ # for each column [j], i.e., for each variable if(!is.na(metadata[j, revCol])){ # only if the reverse code designation cell is not blank if(metadata[j, revCol] == 1){ # if the variable is designated for reverse coding for(i in 1:nrow(data)){ # for all elements in each row within the column if(!is.na(data[i,j])){ # but only if the elements are not missing data[i,j] = as.numeric(metadata[j, scaleMaxCol]) + 1 - as.numeric(data[i,j]) # reverse code by subtracting raw value from 1 + the scale maximum } } } } } #return the modified set of data reverseCode = data } #-------------------------------------------------------------------------------------------------------------- # Weighting Function # if a variable is flagged for weighting (as indicated in the codebook), multiply the value by the weight # Arguments: # data - dataframe of raw (all) data # metadata - dataframe of codebook data # wtName - name of the column in the codebook that holds the weighting value for each variable weighting = function(data, metadata, varCol, wtCol){ row.names(metadata) <- make.names(metadata[,varCol], unique=TRUE) for(j in names(data)){ # for each column [j], i.e., for each variable if(!is.na(metadata[j, wtCol])){ # but only for weights that are not missing for(i in 1:nrow(data)){ # for all elements in each row within the column if(!is.na(data[i,j])){ # but only if the elements are not missing data[i,j] = as.numeric(data[i,j])*as.numeric(metadata[j, wtCol]) # weight the item by multiplying it by the weight } } } } #return the modified set of data weighting = data } #-------------------------------------------------------------------------------------------------------------- # Scale Computation Function # Based on index terms embedded in variable names in a codebook, function will extract the correct data, and aggregate them appropriately. # Arguments: # data - dataframe of raw (all) data # varIndices - a list containing an indeterminate number of indices, separated by a delimiter, that are contained in all the variables across which we want to calculate a mean # opNames - name of the column in the codebook that holds the operation to be performed for each variable # checkMat - returns a matrix of booleans indicated which variable in the raw dataset were included for aggregation calcScales = function(data, varIndices, opNames, checkMat){ # initialize dataframes to hold the data the data to aggregate and the aggregates VarsToAgg = data.frame(matrix(0, nrow(data),1)) # variables extracted for aggregation ScaleAgg = data.frame(matrix(0, nrow(data),1)) # aggregated variables #create a flag to check if the variable name contains all the desired descriptors, and should be selected for aggregation. VarIndCheck = TRUE for (col in 1:ncol(data)){ # for all the columns in the data matrix for(m in 1:length(varIndices)){ # for all the descriptors that I wish to match # if I previously determined that a desciptor is not in the variable name, or if the current descriptor is not in the variable name if(VarIndCheck == FALSE | grepl(varIndices[m], names(data[col])) == FALSE){ VarIndCheck = FALSE # set my flag to false because the variable does not meet my criteria } } if(VarIndCheck == TRUE){ # if my flag is true, meaning the variable does meet my criteria VarsToAgg=cbind(VarsToAgg,data[,col]) # extract relevant data columns pull the data from that column and put in the new matrix names(VarsToAgg)[ncol(VarsToAgg)] = names(data)[col] # change the name of that new column checkMat[paste(varIndices, sep="", collapse = ""), names(data)[col]] = checkMat[paste(varIndices, sep="", collapse = ""), names(data)[col]] + 1 } # reset the flag for the next variable VarIndCheck = TRUE } if(ncol(VarsToAgg) >= 3){ # if more than 2 columns of data are pulled VarsToAgg = VarsToAgg[,2:ncol(VarsToAgg)] # remove the column of zeroes that was created when initializing the temporary dataframe if(opNames == "average"){ ScaleAgg = rowMeans(VarsToAgg, na.rm = TRUE) # calculate the row means and append the column of means to the raw data file } else if(opNames == "sum"){ ScaleAgg = rowSums(VarsToAgg, na.rm = TRUE) # calculate the row means and append the column of means to the raw data file } else if(opNames == "saverage"){ ScaleIndexLength <- length(gregexpr("\\.", paste(varIndices,sep='',collapse=''))[[1]]) #find the number of indices in the scale variable (to compute) by index delimiter (".") AggIndices <- rev(1:max(unlist(lapply(gregexpr("\\.",names(VarsToAgg)),length)))) #find the number of indices in the strings of variables selected to aggregate as array for (i in AggIndices){ if(i == max(AggIndices)){ # if this is the first step of aggregation (Step1) SortAggVars <- as.data.frame(sort(names(VarsToAgg)), stringsToFactors = FALSE) #sort subset of vars to aggregate by name, ascending, coerce to dataframe for reference CommonVarInd <-substr(SortAggVars[,1],start=1,stop=sapply(gregexpr("\\.",SortAggVars[,1]),"[[",i-1)) #extract common strings amongst variable selections SubsetIndToAgg <-subset(CommonVarInd,duplicated(substr(SortAggVars[,1],start=1,stop=sapply(gregexpr("\\.",SortAggVars[,1]),"[[", i-1)))==FALSE) #remove duplicates from CommonVarInd ScaleAggStep <- data.frame(matrix(0, nrow(data), ncol = length(SubsetIndToAgg))) #initialize dataframe for step-wise aggregates names(ScaleAggStep) <- SubsetIndToAgg[1:length(SubsetIndToAgg)] #give names to dataframe columns for step-wise aggregates for(k in 1:length(SubsetIndToAgg)){ # for each element in subset array of indices for step 1 aggregation VarsAggStep <- subset(data, select = (grepl(SubsetIndToAgg[k], names(data))==TRUE)) # raw data variables names subset from Step 1 aggregation vars AggStep <- as.data.frame(rowMeans(VarsAggStep, na.rm = TRUE), stringsAsFactors=FALSE) #format averages from RowMeans across Step 1[1] vars into new column names(AggStep) = SubsetIndToAgg[k] ScaleAggStep[,names(AggStep)]<-AggStep } } else if(i < max(AggIndices) & i > ScaleIndexLength + 1){ SortAggVars <- as.data.frame(sort(names(ScaleAggStep)), stringsToFactors = FALSE) #sort subset of vars to aggregate by name, ascending, coerce to dataframe for reference CommonVarInd <-substr(SortAggVars[,1],start=1,stop=sapply(gregexpr("\\.",SortAggVars[,1]),"[[",i-1)) #extract common strings amongst Step 1 selections SubsetIndToAgg <-subset(CommonVarInd,duplicated(substr(SortAggVars[,1],start=1,stop=sapply(gregexpr("\\.",SortAggVars[,1]),"[[", i-1)))==FALSE) #remove duplicates from CommonVarInd for(k in 1:length(SubsetIndToAgg)){ # for each element in subset array of indices for step n aggregation VarsAggStep <- subset(ScaleAggStep, select = (grepl(SubsetIndToAgg[k], names(ScaleAggStep))==TRUE)) # raw data variables names subset from Step 1 aggregation vars AggStep <- as.data.frame(rowMeans(VarsAggStep, na.rm = TRUE), stringsAsFactors=FALSE) #format averages from RowMeans across Step 1[1] vars into new column names(AggStep) = SubsetIndToAgg[k] ScaleAggStep[,names(AggStep)]<-AggStep } } else if(i == ScaleIndexLength + 1){ SortAggVars <- as.data.frame(sort(names(ScaleAggStep)), stringsToFactors = FALSE) #sort subset of vars to aggregate by name, ascending, coerce to working.proc.dataframe for reference CommonVarInd <-substr(SortAggVars[,1],start=1,stop=sapply(gregexpr("\\.",SortAggVars[,1]),"[[",i)) #extract common strings amongst Step 1 selections SubsetIndToAgg <-subset(CommonVarInd,duplicated(substr(SortAggVars[,1],start=1,stop=sapply(gregexpr("\\.",SortAggVars[,1]),"[[", i)))==FALSE) #remove duplicates from CommonVarInd VarsAggStep <- subset(ScaleAggStep, select = names(ScaleAggStep) %in% SubsetIndToAgg) # raw working.proc.data variables names subset from Step 1 aggregation vars AggStep <- as.data.frame(rowMeans(VarsAggStep, na.rm = TRUE), stringsAsFactors=FALSE) #format averages from RowMeans across Step 1[1] vars into new column names(AggStep) = paste(varIndices,sep='',collapse='') ScaleAggStep[,names(AggStep)]<-AggStep } else if(i == ScaleIndexLength | i < ScaleIndexLength){ ScaleAgg = ScaleAggStep[,paste(varIndices,sep='',collapse='')] #write.csv(ScaleAggStep,paste("saverage_",paste(varIndices,sep='',collapse=''),".csv",sep='',collapse=''), append = TRUE) } } } else if(opNames == "ssum"){ ScaleIndexLength <- length(gregexpr("\\.", paste(varIndices,sep='',collapse=''))[[1]]) #find the number of indices in the scale variable (to compute) by index delimiter (".") AggIndices <- rev(1:max(unlist(lapply(gregexpr("\\.",names(VarsToAgg)),length)))) #find the number of indices in the strings of variables selected to aggregate as array for (i in AggIndices){ if(i == max(AggIndices)){ # if this is the first step of aggregation SortAggVars <- as.data.frame(sort(names(VarsToAgg)), stringsToFactors = FALSE) #sort subset of vars to aggregate by name, ascending, coerce to dataframe for reference CommonVarInd <-substr(SortAggVars[,1],start=1,stop=sapply(gregexpr("\\.",SortAggVars[,1]),"[[",i-1)) #extract common strings amongst variable selections SubsetIndToAgg <-subset(CommonVarInd,duplicated(substr(SortAggVars[,1],start=1,stop=sapply(gregexpr("\\.",SortAggVars[,1]),"[[", i-1)))==FALSE) #remove duplicates from CommonVarInd ScaleAggStep <- data.frame(matrix(0, nrow(data), ncol = length(SubsetIndToAgg))) #initialize dataframe for names(ScaleAggStep) <- SubsetIndToAgg[1:length(SubsetIndToAgg)] for(k in 1:length(SubsetIndToAgg)){ # for each element in subset array of indices for step 1 aggregation VarsAggStep <- subset(data, select = (grepl(SubsetIndToAgg[k], names(data))==TRUE)) # raw data variables names subset from Step 1 aggregation vars AggStep <- as.data.frame(rowSums(VarsAggStep, na.rm = TRUE), stringsAsFactors=FALSE) #format averages from RowMeans across Step 1[1] vars into new column names(AggStep) = SubsetIndToAgg[k] ScaleAggStep[,names(AggStep)]<-AggStep } } else if(i < max(AggIndices) & i > ScaleIndexLength +1 ){ SortAggVars <- as.data.frame(sort(names(ScaleAggStep)), stringsToFactors = FALSE) #sort subset of vars to aggregate by name, ascending, coerce to dataframe for reference CommonVarInd <-substr(SortAggVars[,1],start=1,stop=sapply(gregexpr("\\.",SortAggVars[,1]),"[[",i-1)) #extract common strings amongst Step 1 selections SubsetIndToAgg <-subset(CommonVarInd,duplicated(substr(SortAggVars[,1],start=1,stop=sapply(gregexpr("\\.",SortAggVars[,1]),"[[", i-1)))==FALSE) #remove duplicates from CommonVarInd for(k in 1:length(SubsetIndToAgg)){ # for each element in subset array of indices for step 1 aggregation VarsAggStep <- subset(ScaleAggStep, select = (grepl(SubsetIndToAgg[k], names(ScaleAggStep))==TRUE)) # raw data variables names subset from Step 1 aggregation vars AggStep <- as.data.frame(rowSums(VarsAggStep, na.rm = TRUE), stringsAsFactors=FALSE) #format averages from RowMeans across Step 1[1] vars into new column names(AggStep) = SubsetIndToAgg[k] ScaleAggStep[,names(AggStep)]<-AggStep } } else if(i == ScaleIndexLength + 1){ SortAggVars <- as.data.frame(sort(names(ScaleAggStep)), stringsToFactors = FALSE) #sort subset of vars to aggregate by name, ascending, coerce to working.proc.dataframe for reference CommonVarInd <-substr(SortAggVars[,1],start=1,stop=sapply(gregexpr("\\.",SortAggVars[,1]),"[[",i)) #extract common strings amongst Step 1 selections SubsetIndToAgg <-subset(CommonVarInd,duplicated(substr(SortAggVars[,1],start=1,stop=sapply(gregexpr("\\.",SortAggVars[,1]),"[[", i)))==FALSE) #remove duplicates from CommonVarInd VarsAggStep <- subset(ScaleAggStep, select = names(ScaleAggStep) %in% SubsetIndToAgg) # raw working.proc.data variables names subset from Step 1 aggregation vars AggStep <- as.data.frame(rowSums(VarsAggStep, na.rm = TRUE), stringsAsFactors=FALSE) #format averages from RowMeans across Step 1[1] vars into new column names(AggStep) = paste(varIndices,sep='',collapse='') ScaleAggStep[,names(AggStep)]<-AggStep } else if(i == ScaleIndexLength | i < ScaleIndexLength){ ScaleAgg = ScaleAggStep[,paste(varIndices,sep='',collapse='')] #write.csv(ScaleAggStep,paste("saverage_",paste(varIndices,sep='',collapse=''),".csv",sep='',collapse=''), append = TRUE) } } } else if(ncol(VarsToAgg) == 2){ # if only 1 column of data is pulled ScaleAgg = VarsToAgg[,2] # append that column of data to the raw data file } } calcScales = list(ScaleAgg, checkMat) } #-------------------------------------------------------------------------------------------------------------- # Reverse Code - Function Call working.truthed.timed.data = reverseCode(working.truthed.timed.data, codebook.items, "varnames", "reverse.code", "scale.max") #-------------------------------------------------------------------------------------------------------------- # Item Weighting - Function Call working.truthed.timed.data = weighting(working.truthed.timed.data, codebook.items, "varnames", "weight") #-------------------------------------------------------------------------------------------------------------- # Aggregated Means Using Codebook working.proc.data.scale = working.truthed.timed.data # create a new dataframe which will hold the means varIndices = list() # initialize a list containing the descriptors that will be found aggCheck = matrix(0, length(codebook.scales[,1]), length(names(working.truthed.timed.data))) rownames(aggCheck) = codebook.scales[,1] colnames(aggCheck) = names(working.truthed.timed.data) for(k in 1:nrow(codebook.scales)){ # for all the variables in the codebook if ((codebook.scales[k,1] %in% names(working.truthed.timed.data )) == FALSE ){ # if the variable is not in the dataset, we need to calculate the means and append the column delimiter = gregexpr("\\.", codebook.scales[k,1]) # determine the locations of all the delimiters (periods) for(p in 1:length(delimiter[[1]])){ # for as many indices as there are in the variable name if(p == 1){ # special case when pulling out the first descriptor varIndices = c(varIndices, substr(codebook.scales[k,1],start=1,stop=delimiter[[1]][[p]])) # code for pulling out the decriptor and adding to the list } else{ varIndices = c(varIndices, substr(codebook.scales[k,1],start=delimiter[[1]][[p-1]]+1,stop=delimiter[[1]][[p]])) # code for pulling out the decriptor and adding to the list } } listReturn = calcScales(working.truthed.timed.data, varIndices, codebook.scales[k, "operation"], aggCheck) # calculate the mean of the new variable, and append to the working dataset working.proc.data.scale = cbind(working.proc.data.scale, listReturn[[1]]) names(working.proc.data.scale)[ncol(working.proc.data.scale)] = codebook.scales[k,1] # change the name of the column aggCheck = listReturn[[2]] # reset the list that contains the indices varIndices = list() } } write.csv(working.proc.data.scale, file = matFile, row.names=FALSE) write.csv(working.proc.data.scale, file="MasterAnswerTable.csv", row.names=FALSE) #write.csv(aggCheck, file = paste(Sys.time(),"aggCheck.csv",sep = "_", collapse="")) #write.csv(aggCheck, file = "aggCheck.csv", collapse="") write.csv(aggCheck, file = aggCheckFile) # Save a simple version in JSON format for D3 histogram library(rjson) histData <- working.proc.data.scale[,c("SYS.FIL.APP.","SYS.FIL.TSK.","PST.EXP.CLD.","PST.EXP.BED.","TSK.PRB.ANS.","TSK.CON.","TSK.TIME.DIFF.")] sink("2015_public_xdataonline.json") cat( toJSON(unname(split(histData, 1:nrow(histData)))) ) sink()