# Combining text files into a data frame in R with time windows

I have a very slow function with multiple for loops to read in the following text with the line's data type (Followball or DRT), as well as a time, target position, and cursor position for the Followball lines:

FollowBall,1173,897.3,894.7
FollowBall,1205,897.1,893.9
FollowBall,1236,896.9,893.6
FollowBall,1267,896.7,893.3
FollowBall,1298,896.5,893.2
DRT,1314,583794, 0, 0, -1, 0, 0, 0, miss
FollowBall,1330,896.3,893.1
FollowBall,1361,896.0,893.1
FollowBall,1392,895.8,893.0
FollowBall,1423,895.6,892.9


I read in these files for part a and b with filenames like RemoteChoice_001a_ST.txt,RemoteChoice_001b_ST.txt. There are 40-ish files. In this file there are DRT lines with mode (a factor with 4 levels) at the 4th position and load (a factor with 2 levels) at the 5th position on the line. Right now I'm making a data.frame like the one below and comparing all of the Followball lines to see if they're in the time windows:

   mode load     beg_time     end_time
1     0    0 1.470616e+12 1.470616e+12
2     0    1 1.470616e+12 1.470616e+12
3     2    1 1.470616e+12 1.470616e+12
4     1    1 1.470616e+12 1.470617e+12
5     1    0 1.470617e+12 1.470618e+12
6     2    0 1.470618e+12 1.470618e+12
7     2    1 1.470618e+12 1.470618e+12
8     3    0 1.470618e+12 1.470619e+12
9     3    1 1.470619e+12 1.470619e+12
10    0    1 1.470619e+12 1.470619e+12
11    0    0 1.470619e+12 1.470619e+12


This function currently takes 30 minutes to run:

   ExtractSteering<- function(topdir) {
total = Sys.time()
dirs <- list.dirs(path = topdir, full.names = TRUE) #get directories
files <- list.files(path=dirs, pattern="*.txt", full.names=T, recursive=F) #get files
subids1 <- regmatches(files, regexpr("0\\d*.", files)) #get subject ids
subids <- substr(subids1, 2,3) #get just the id number
day <- substr(subids1, 4,4) #get conditions

for (j in 1:length(files)) { #For every file, open it and read the lines
linesall <- readLines(files[j]) #save all the lines to a vector
time_df <- data.frame() #make an empty data.frame to be filled by time windows
drtmatch <- regexpr("^D.*", linesall) #Get all DRT lines
drts <- regmatches(linesall, drtmatch) #Save all DRT lines
drtdat <- cSplit(data.frame(drts),"drts",",") #Make a data.frame with lines
windows <- dplyr::select(drtdat, time = drts_02, mode = drts_04, load = drts_05) #label columns
for (i in seq_along(windows$mode)) { #for the 902 lines of windows mode if (windows$mode[i] != lag(windows$mode, default = 4)[i] | #see if mode changes windows$load[i] != lag(windows$load, default = 4)[i]) { #see if load changes rows <- c(windows$mode[i],windows$load[i],windows$time[i]) #save out the change point with a time
time_df <- rbind(time_df, rows) #fill the empty data.frame with the mode, load, and timestamp
}
}
colName <- c("mode","load","time") #name the columns
time_windows <- time_df %>% #get a beginning time and end time on the same row
setNames(colName) %>% #column names
mutate(beg_time = time, end_time = lead(time, default = 100000000000)) %>% #same row
select(-time) #get rid of old time
matches <- regexpr("^Follow.*$", linesall) #Get all Followball lines follows <- regmatches(linesall, matches) #save Followball lines dat <- cSplit(data.frame(follows),"follows", ",") #make data.frame dat <- dplyr::select(dat, time = follows_2, ballpos = follows_3, cursorpos = follows_4) %>% mutate(deviation = abs(ballpos - cursorpos)) %>% #labels, create deviation filter(deviation < 100) %>% #get rid of big deviations arrange(time) #arrange by timestamp dat$time <- as.numeric(as.character(dat$time)) #make sure time is numeric dat <- dat[seq(10, nrow(dat), 10), ] #sample every 10 because it takes so damn long df_part <- data.frame() #empty data.frame tic <- Sys.time() #Figure out why it's taking so long for(row in seq_along(time_windows$mode)) { #go back into mode
for(i in seq_along(dat$time)) { #go back into time if(dat$time[i] > time_windows$beg_time[row] & dat$time[i] < time_windows$end_time[row]) { #check if the time is in the window rows <- c(time_windows$mode[row], time_windows$load[row],dat$deviation[i]) #make a row with mode, load, and deviation
df_part <- rbind(df_part, rows) #add to empty dataframe
}
}
print(Sys.time() - tic) #Figure out why it's taking so long
}
df_full <-  df_part %>% #Rename stuff
colnames<-(c("mode", "load", "deviation")) #%>%

infile <- df_full #Don't save over things
infile$subid <- as.factor(subids[j]) #Add subid from file name infile$day <- as.factor(day[j]) #Add day from file name

if(!exists("drt.data")) {
drt.data <- infile #Create ouput data.frame
}
else {
drt.data <- rbind(drt.data,infile) #Append to output dataframe
}
cat("Finished Processing Participant: ", subids[j],day[j],"Total time:", Sys.time() - total) #get feedback
}
return(drt.data) #Return full data.frame
}


Here is my current sessionInfo():

R version 3.3.2 (2016-10-31)
Platform: x86_64-apple-darwin13.4.0 (64-bit)
Running under: macOS Sierra 10.12.6

locale:
[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8

attached base packages:
[1] tcltk     stats     graphics  grDevices utils     datasets  methods   base

other attached packages:
[1] lme4_1.1-13           Matrix_1.2-10         papaja_0.1.0.9492     bindrcpp_0.2
[9] tibble_1.3.3          tidyverse_1.1.1       splitstackshape_1.4.2 data.table_1.10.4
[13] ggplot2_2.2.1         plyr_1.8.4            multcomp_1.4-6        TH.data_1.0-8
[17] MASS_7.3-47           survival_2.41-3       mvtnorm_1.0-6         car_2.1-5
[21] forcats_0.2.0         stringr_1.2.0


head() of output:

  mode load deviation subid day
1    0    0 0.7341692    01   a
2    0    0 0.6613210    01   a
3    0    0 0.9878947    01   a
4    0    0 0.8304713    01   a
5    0    0 0.9878947    01   a
6    0    0 1.0841968    01   a


Is there any other information I can add to receive help with this problem?

If you want to make your code run faster, it is important to know (a) which parts are slow and (b) which parts can be easily improved and how. Regarding (a), I suspect the loops across the rows, (e.g., for (i in seq_along(windows\$mode))) make your code slow. Regarding (b), those loops should probably be avoided, maybe using a dplyr::filter() call.

library(profvis)
profvis({
ExtractSteering()
})


Of course, you should run ExtractSteering() on only one (or a few) TXT files to reduce computation time.

If the for loops indeed are the slow parts, I would propose that you give more details about those few lines at best with a running MWE so that we can help you---if necessary---to improve that part.

Moreover, wouldn't it be easier, safer, and faster to replace readLines(files[j]) with, for example, readr::read_csv(files[j])?

• Good advice about profiling. I bet it will show the culprit is the repeated use of the x <- rbind(x, ...) construct inside for loops. Aug 22, 2017 at 22:51
• Thanks for the advice. I'll be looking through these potential problems and maybe posting the updated function. Aug 24, 2017 at 12:58