R计算开始结束时间之间的时间间隔内的时间

Question

I have a dataframe as below

timedf <- data.frame(spaceNum=c(1,1,1,2,2,2), starttime= c("2015-09-03 00:00",
    "2015-09-04 23:18", "2015-09-05 05:59", "2015-09-03 06:19",
    "2015-09-06 09:03", "2015-09-06 09:10"), endtime = c("2015-09-04 20:05", "2015-09-05 05:52", 
    "2015-09-05 06:15", "2015-09-05 16:36",
    "2015-09-06 09:06", "2015-09-06 20:42"))

timedf$staytime <- round(as.numeric(difftime(as.POSIXct(timedf$endtime), as.POSIXct(timedf$starttime),units="hours")), digits=2)
timedf
      spaceNum        starttime          endtime staytime
    1        1 2015-09-03 00:00 2015-09-04 20:05    44.08
    2        1 2015-09-04 23:18 2015-09-05 05:52     6.57
    3        1 2015-09-05 05:59 2015-09-05 06:15     0.27
    4        2 2015-09-03 06:19 2015-09-05 16:36    58.28
    5        2 2015-09-06 09:03 2015-09-06 09:06     0.05
    6        2 2015-09-06 09:10 2015-09-06 20:42    11.53

I want to calculate the time period of 0To7, 7To19 and 19To24 respectively, ie, I would expect to get below result

spaceNum        starttime          endtime          staytime    0To7  7To19  19To24
        1        1 2015-09-03 00:00 2015-09-04 20:05   44.08     14     24      6.08
        2        1 2015-09-04 23:18 2015-09-05 05:52    6.57     5.87   0       0.7
        3        1 2015-09-05 05:59 2015-09-05 06:15    0.27     0.27   0        0
        4        2 2015-09-03 06:19 2015-09-05 16:36   58.28    14.683  33.6    10
        5        2 2015-09-06 09:03 2015-09-06 09:06   0.05       0     0.05     0
        6        2 2015-09-06 09:10 2015-09-06 20:42   11.53      0     9.83    1.7

Please comment how can I do this this, I am looking for lubridate that have powerful time function, but I still can't get the answer.

Answer 1

IMO this whole process is more efficient if you use data.tables:

# your data as provided in the question
timedf <- data.frame(spaceNum=c(1,1,1,2,2,2), 
                     starttime= c("2015-09-03 00:00","2015-09-04 23:18", "2015-09-05 05:59", "2015-09-03 06:19","2015-09-06 09:03", "2015-09-06 09:10"), 
                     endtime = c("2015-09-04 20:05", "2015-09-05 05:52", "2015-09-05 06:15", "2015-09-05 16:36","2015-09-06 09:06", "2015-09-06 20:42"))

library(data.table)
# convert starttime and endtime to POSIXct - note that you need tz="GMT"
setDT(timedf)[,c("starttime","endtime"):=lapply(.SD, as.POSIXct, tz="GMT"), .SDcols=2:3]
# add staytime column
timedf[,staytime:=round(as.numeric(difftime(endtime,starttime,units="hours")),digits=2)]
# this does the main work
brks <- c(0,7*3600,19*3600,24*3600)
lbls <- c("0To7","7To19","19To24")
sec.per.day <- 24*60*60
get.cuts <- function(x,y) as.list(table(cut((x:y)%%sec.per.day, breaks=brks, labels=lbls))/3600)
timedf[,c(lbls):=get.cuts(starttime,endtime), by=1:nrow(timedf)]
timedf
#    spaceNum           starttime             endtime staytime       0To7       7To19   19To24
# 1:        1 2015-09-03 00:00:00 2015-09-04 20:05:00    44.08 14.0000000 24.00000000 6.083056
# 2:        1 2015-09-04 23:18:00 2015-09-05 05:52:00     6.57  5.8666667  0.00000000 0.700000
# 3:        1 2015-09-05 05:59:00 2015-09-05 06:15:00     0.27  0.2669444  0.00000000 0.000000
# 4:        2 2015-09-03 06:19:00 2015-09-05 16:36:00    58.28 14.6836111 33.60000000 9.999444
# 5:        2 2015-09-06 09:03:00 2015-09-06 09:06:00     0.05  0.0000000  0.05027778 0.000000
# 6:        2 2015-09-06 09:10:00 2015-09-06 20:42:00    11.53  0.0000000  9.83361111 1.700000

This approach takes advantage of the fact the POSIXct variables are just the number of seconds since 1970-01-01. The get.cuts(...) function produces a vector of integers from starttime:endtime , then takes each element modulo 24*60*60, which divides out the number of seconds in a day and leaves the remainder. Then we use cut(...) to assign each element to a bin based on the ranges 00:00:00 - 07:00:00, 07:00:01 - 19:00:00, and 19:00:01 - 24:00:00, and we use table(...) to count the number of seconds in each bin. Then we convert to hours by dividing by 3600 and return the result as a list (which is necessary for data.table).

Finally, we call get.cuts(...) for each row in the data.table.

As you can see, the code is shorter than the explanation...

Answer 2

Finally I write a function for this, I know the function is ugly and not optimize, but this is what currently I can obtained the result, it will be great if someone can provide a more simple solution.

    getp1TOp2 <- function(x,y,p1,p2) { 
   #Calcuate the numofdays
   numdays <- as.numeric(difftime( update(as.POSIXct(y), hour=0, min=0, sec=0),  update(as.POSIXct(x), hour=0, min=0, sec=0),units = "days"))
   #Calculate the FirstdayStart, FirstdayEnd, LastdayStart and LastdayEnd
   FirstdayStart <- update(as.POSIXct(x), hour=p1, min=0, sec=0)  
   FirstdayEnd <- update(as.POSIXct(x), hour=p2, min=0, sec=0)   
   LastdayStart <- update(as.POSIXct(y), hour=p1, min=0, sec=0)      
   LastdayEnd <- update(as.POSIXct(y), hour=p2, min=0, sec=0) 

   # For case Start and End in the same day , eg (2015-09-07 03:00, 2015-09-07 06:00)
   if (numdays==0)
   {
       #For case StartTime >= FirstdayStart
       if (as.POSIXct(x) >= FirstdayStart)
       {

           #For case EndTime < FirstdayEnd
           if (as.POSIXct(y) <= FirstdayEnd)
           {
               #Example fall into this case  (2015-09-07 08:00-2015-09-07 18:32), just return diff of start/end time
               outval<- as.numeric(difftime(as.POSIXct(y), as.POSIXct(x), units="hours"))
           }
           else
           {
               #Example fall into this case  (2015-09-07 08:00-2015-09-07 20:11 ), return diff of start/ FirstdayEnd time
               outval<- as.numeric(difftime(FirstdayEnd, as.POSIXct(x), units="hours"))
           }
       }
       else  #For case StartTime < FirstdayStart
       {

            #For case EndTime < FirstdayEnd
           if (as.POSIXct(y) <= FirstdayEnd)
           {
               #Example fall into this case  (2015-09-07 06:00-2015-09-07 18:32), just return diff of FirstdayStart/end time
               outval<- as.numeric(difftime(as.POSIXct(y), FirstdayStart, units="hours"))
           }
           else
           {
               #Example fall into this case  (2015-09-07 06:00-2015-09-07 20:11 ), return diff of FirstdayStart/ FirstdayEnd time
               outval<- as.numeric(difftime(FirstdayEnd, FirstdayStart, units="hours"))
           }

       }

   }
   else  # For case Start and End not in the  same day , eg (2015-09-07 03:00", 2015-09-07 06:00)
   {


       # For case starttime < FirstdayStart Calculate the Firstday period first, 2015-09-03 02:00 2015-09-04 16:00
       if (as.POSIXct(x)< FirstdayStart )
       {
           #Example fall into this case  (2015-09-07 06:00 2015-09-08 20:11 ), firstdayPeriod return diff of FirstdayStart/ FirstdayEnd time
           firstdayPeriod <- as.numeric(difftime(FirstdayEnd, FirstdayStart, units="hours"))
       }
       else
       {
           if (as.POSIXct(x) <= FirstdayEnd)
           {
               #Example fall into this case  (2015-09-07 08:00 2015-09-08 20:11 ), firstdayPeriod = of Startime/ FirstdayEnd time
               firstdayPeriod <- as.numeric(difftime(FirstdayEnd, as.POSIXct(x), units="hours"))
           }
           else
           {   #Example fall into this case  (2015-09-07 20:00 2015-09-08 20:11 ), firstdayPeriod=0
               firstdayPeriod <- c(0)
           }

       }

       #Calculate the last day period
       if (as.POSIXct(y) > LastdayEnd)
       {
           #Example fall into this case  (2015-09-07 08:00 2015-09-08 21:00 ), lastdayPeriod = of LastdayEnd/ LastdayStart time
           lastdayPeriod <- as.numeric(difftime(FirstdayEnd, FirstdayStart, units="hours"))
       }
       else
       {
           if (as.POSIXct(y) >= LastdayStart)
           {
                #Example fall into this case  (2015-09-07 08:00 2015-09-08 18:00 ), lastdayPeriod = of LastdayEnd/ endtime time
               lastdayPeriod <- as.numeric(difftime(as.POSIXct(y),LastdayStart, units="hours"))
           }
           else
           {
              lastdayPeriod <- c(0)
           }
       }


       #Calculate the overrall time         
       outval <- lastdayPeriod +firstdayPeriod + (numdays-1)* as.numeric(difftime(FirstdayEnd,FirstdayStart, units="hours"))

   }

   outval <- round(outval, digits=2)
   if (outval < 0)
   {
       outval <- c(0)
   }
   outval
 }

I get the result as below

timedf$P0To7 <- apply(timedf[,c(2,3)], 1, function(x) getp1TOp2(x[1], x[2], 0, 7))
timedf$P7To19 <- apply(timedf[,c(2,3)], 1, function(x) getp1TOp2(x[1], x[2], 7, 19))
timedf$P19To24 <- apply(timedf[,c(2,3)], 1, function(x) getp1TOp2(x[1], x[2], 19, 24))

    > timedf
      spaceNum        starttime          endtime staytime P0To7 P7To19 P19To24
    1        1 2015-09-03 00:00 2015-09-04 20:05    44.08 14.00  24.00    6.08
    2        1 2015-09-04 23:18 2015-09-05 05:52     6.57  5.87   0.00    0.70
    3        1 2015-09-05 05:59 2015-09-05 06:15     0.27  0.27   0.00    0.00
    4        2 2015-09-03 06:19 2015-09-05 16:36    58.28 14.68  33.60   10.00
    5        2 2015-09-06 09:03 2015-09-06 09:06     0.05  0.00   0.05    0.00
    6        2 2015-09-06 09:10 2015-09-06 20:42    11.53  0.00   9.83    1.70