Compute histrogram bins for a large data.frame fast

Question

I know about apply, but I'm not sure how to write it so that it works for embedded for loops with if statements and so forth. It gets messy. I am a novice so if you can show me how to properly rewrite the following efficiently it should help a lot.

This is an example of what the dataframe inFile() should look like. In the code below I subset on the dataframe so that rows are between two dates, abs_start and abs_end (you'll notice the CSV has a dates column). I then am trying bin the rows into bins that are input$binning seconds long. I simply iterate through all the dates and for each date I iterate through all the bins until I find the one that a particular row belongs to. Then I add this bin's number to a list. After doing this for all rows in the dataframe I add the list as a new column to the data.frame as it now specifies which bin each row belongs to.

This is slow though. The user specifies the bin length and then I want the histrogram to automatically update (using R Shiny framework). How can I speed it up?

 # Subset between start and end with bin column and selected mice
 subsetTable<-reactive({
 subsetMice<-inFile()[inFile()[,TAG_COL]%in%input$tagChooser,]
 abs_start <- strptime(input$abs_start,"%Y-%m-%d %H:%M:%S",tz='US/Pacific')
 abs_end <- strptime(input$abs_end,"%Y-%m-%d %H:%M:%S",tz='US/Pacific')
 if(is.null(subsetMice)||nrow(subsetMice)<=0){
 return()
 }
 # subset between abs_start and abs_end 
 convertedDates<-strptime(as.character(subsetMice[,DATE_COL]),"%Y-%m-%d %H:%M:%S",tz='US/Pacific')
 inF<-subsetMice[convertedDates>abs_start&convertedDates<abs_end,]
 convertedDates<-convertedDates[convertedDates>abs_start&convertedDates<abs_end]
 bins<-seq(abs_start,abs_end,by=as.integer(input$binning))
 bin_no<-length(bins)
 bin_nos<-c(NULL)
 bin_starts<-c(NULL)
 for(i in 1:length(convertedDates)){
 for(j in 1:length(bins)){
 # Check if at right bin
 if(!is.na(bins[j+1])){
 if(bins[j]<=convertedDates[i]&&convertedDates[i]<bins[j+1]){
 bin_nos[i] <- j
 bin_starts[i] <- bins[j]
 break
 }
 }
 else{
 stopifnot(bins[j]<=convertedDates[i])
 bin_nos[i] <- j
 bin_starts[i] <- bins[j]
 }
 }
 }
 cbind(inF,bin_starts,bin_nos) 
 })

• Frikster: Title amended. And I also added an actual explanation of what my code is trying to do.

Answer 1

Within the algorithm you post you can take advantage of a few features:

1. if(bins[j]<=convertedDates[i]&&convertedDates[i]<bins[j+1]) - as you check the bins in order there is no need to check that the previous bin.

As explanation say if j is 5 then you check bins[5]<=convertedDates[i]&&convertedDates[i]<bins[6] But in the next step j is 6 and you check. bins[6]<=convertedDates[i]&&convertedDates[i]<bins[7]

So you twice compare with bins[6] - if you think about it you only reach j=6 if bins[6]<=convertedDates[i]. So no need to check that again.

2. if you would sort the convertedDates before the comparison you can use that you can start the search of bins by the last found bin - instead of the first.

3. actually there is no need to loop over all bins - instead if you calculate (convertedDates - absStart) %/% input$binning it should tell you exactly which bin the date belongs.

4. it may also help slightly if you preallocate the output lists as shown here.

It might also help to read the source code of the hist function and see what "tricks" they use there.

• Frikster: 1. I'm not understand your point one. I have a break statement so I don't check any further after bin is found 2. I should have specified: convertedDates are already sorted. 3 . I've tried your point 3 before. Except I get: Error in Ops.difftime((convertedDates - abs_start), input$binning) : '%/%' not defined for "difftime" objects :( Guess I'll start looking into applying %/% on difftime objects then if there's no other way 4. Haven't tried that, thanx
• flodel: Try as.numeric(difftime(convertedDates, absStart, units = "secs")) %/% input$binning
• bdecaf: @DirkHaupt - I added an example to explain point 1.