Блог

У меня есть фрейм данных с начальными и конечными датами / временем, например:

 start_date <- c("20/09/2016 01:20" , "22/09/2016 01:20", "28/09/2016 22:16",  "16/09/2016 21:01")
end_date <- c("20/09/2016 06:20" , "24/09/2016 22:40", "29/09/2016 03:20", "16/09/2016 23:01")
df <- data.frame(start_date, end_date)
  

И некоторые временные интервалы:

 interval_start <- "21:00"
interval_end   <- "02:00"
  

Я хотел бы создать новый столбец в df, который вычисляет общее количество минут, затраченных каждым экземпляром в течение интервального периода. Например, строка 1 потратила 40 минут на период интервала.

Кто-нибудь знает, как этого можно достичь? Спасибо.

Вот мое короткое решение (в отличие от других ответов;-)) Я также использовал lubridate пакет:

 library(lubridate)
df$start_date <- dmy_hm(df$start_date)
df$end_date <- dmy_hm(df$end_date)

df$ diff <- unlist(lapply(1:nrow(df), function(x){

   sequence <- seq(df$start_date[x],df$end_date[x], by = "min")
   cum_sum <- cumsum(format(sequence, format = "%H:%M") <= "02:00" | format(sequence, format = "%H:%M") >= "21:00")
   sum <- sum(format(sequence, format = "%H:%M") <= "02:00" | format(sequence, format = "%H:%M") >= "21:00")
   n_intervals <- length(unique(cum_sum[cum_sum %in% unique(cum_sum[duplicated(cum_sum)])]))

   ifelse(cum_sum[length(cum_sum)] - cum_sum[length(cum_sum)-1] != 0, return(sum - n_intervals-1), return(sum-1))
}))

#            start_date            end_date diff
# 1 2016-09-20 01:20:00 2016-09-20 06:20:00   40
# 2 2016-09-22 01:20:00 2016-09-24 22:40:00  740
# 3 2016-09-28 22:16:00 2016-09-29 03:20:00  224
# 4 2016-09-16 21:01:00 2016-09-16 23:01:00  120
  

Идея заключается в следующем (код в lapply ):

1. создайте последовательность от начала до конца каждого интервала на одну минуту
2. Вычислите sum и cumsum из условия, что все времена из этой последовательности находятся в интервале от «21:00» до «02:00».
3. Вычислите количество интервалов в cumsum , чтобы увидеть, сколько разных интервалов в этой последовательности.
4. Сложность в том, что при sum длине 2 разница в минутах составляет всего 1, поэтому нам всегда приходится вычитать 1. Мы должны делать это для каждого найденного нами интервала. В случае, когда последнее значение cum_sum отличается от предпоследнего, это интервал сложения, и мы должны вычесть еще 1.

Это выглядит очень сложно, но идея должна быть понятна (я надеюсь).

Пакет lubridate помогает выполнять работу. Основная проблема, которую нужно решить, — это длительные периоды времени, когда интервал повторяется несколько раз (я решил его с помощью внутреннего for цикла), и ключевая функция intersect , которая дает простой ответ на проблему «Пересечение двух интервалов». Суммирование всех пересечений дает решение для каждой строки.

 library(lubridate)

start_date <- c("20/09/2016 01:20" , "22/09/2016 01:20", "28/09/2016 22:16",  "16/09/2016 21:01")
end_date <- c("20/09/2016 06:20" , "24/09/2016 22:40", "29/09/2016 03:20", "16/09/2016 23:01")

start_date <- dmy_hm(start_date)
end_date <- dmy_hm(end_date)

df <- data.frame(start_date, end_date)

time_spent <- c()

# loop through each row
for (i in 1:nrow(df)){
  row <- df[i,]
  out <- 0

  period <- interval(row$start_date, row$end_date)

  #1. Set as many intervals for this time periods as there are days
  for(day in seq(day(row$start_date) - 1, day(row$end_date), 1)){
    myInterval <- interval(dmy_hm(paste(day, 
                                        month(row$start_date), 
                                        year(row$start_date),
                                        "21:00")),
                           dmy_hm(paste(day 1, 
                                        month(row$start_date), 
                                        year(row$start_date),
                                        "02:00")))

    # calculate intersection
    timedifference <- intersect(period, myInterval)

    if(!is.na(timedifference)){
      out <- out   as.numeric(timedifference)/60
    }

  }

  time_spent <- c(time_spent, out)
}

df$time_spent <- time_spent
  

Решение таково

 > df$time_spent
[1]  40 740 224 120
  

Пожалуйста, смотрите комментарии к коду по пути. Я использовал lubridate пакет.

 start_date <- c("20/09/2016 01:20" , "22/09/2016 01:20", "28/09/2016 22:16",  "16/09/2016 21:01")
end_date <- c("20/09/2016 06:20" , "24/09/2016 22:40", "29/09/2016 03:20", "16/09/2016 23:01")
df <- data.frame(start_date, end_date)


interval_start <- "21:00"
interval_end   <- "02:00"

# Convert strings to dates
library(lubridate)
df$start_date <- dmy_hm(df$start_date)
df$end_date   <- dmy_hm(df$end_date)

# Helper columns
df$day  <- day(df$start_date)
df$mo   <- month(df$start_date)
df$yr   <- year(df$start_date)
df$day1 <- day(df$end_date)
df$mo1  <- month(df$end_date)
df$yr1  <- year(df$end_date)

# Add custom start/end for first day in row
df$interval_start <- dmy_hm(paste0(df$day-1,"/",df$mo,"/",df$yr," ", interval_start))
df$interval_end   <- dmy_hm(paste0(df$day,"/",df$mo,"/",df$yr," ", interval_end))


# Add custom start/end for last day in row, if it is different
df$interval_start1 <- df$interval_start # this is just to initialize the column with the proper class
df$interval_end1   <- df$interval_end

for(i in 1:nrow(df)){
  if(!(df$mo[i] == df$mo1[i] amp; df$day[i] == df$day1[i])){
    df$interval_start1[i] <- dmy_hm(paste0(df$day1[i],"/",df$mo1[i],"/",df$yr1[i]," ", interval_start))
    df$interval_end1[i]   <- dmy_hm(paste0(df$day1[i],"/",df$mo1[i],"/",df$yr1[i]," ", interval_end))
  }else{
    df$interval_start1[i] <- NA
    df$interval_end1[i]   <- NA
  } 
} 

# Calculate time in intervals for first day
time1     <- difftime(df$start_date,df$interval_end, units="mins")
time1.cap <- difftime(df$interval_start, df$interval_end, units="mins")
time1[abs(time1) > abs(time1.cap)] <- time1.cap[abs(time1) > abs(time1.cap)]

# initialize class of new col
df$time1 <- difftime(df$interval_start, df$interval_end, units="mins")

# Update time1
for(i in 1:nrow(df)){
  if(df$start_date[i] < df$interval_end[i]){
    time1     <- difftime(df$start_date,df$interval_end, units="mins")
    time1.cap <- difftime(df$interval_start, df$interval_end, units="mins")
    time1[abs(time1) > abs(time1.cap)] <- time1.cap[abs(time1) > abs(time1.cap)]

    df$time1[i] <- time1[i]*-1
  } else{

    if(df$start_date[i] > df$interval_end[i])  {
      time1     <- difftime(df$start_date,df$interval_end 86400, units="mins")
      time1.cap <- difftime(df$interval_start, df$interval_end 86400, units="mins")
      time1[abs(time1) > abs(time1.cap)] <- time1.cap[abs(time1) > abs(time1.cap)]

      df$time1[i] <- time1[i]*-1
    }
  }
}

# initialize class of new col

df1 <- df[!is.na(df$interval_start1),]
df1$time2 <- difftime(df1$interval_start, df1$interval_end, units="mins")

# create time2 for last day, if different
for(i in 1:nrow(df1)){
  if(df1$end_date[i] < df1$interval_end1[i]){
    time2     <- difftime(df1$end_date,df1$interval_end1, units="mins")
    time2.cap <- difftime(df1$interval_start1, df1$interval_end1, units="mins")
    time2[abs(time2) > abs(time2.cap)] <- time2.cap[abs(time2) > abs(time2.cap)]

    df1$time2[i] <- time2[i]*-1
  } else{

    if(df1$end_date[i] > df1$interval_end1[i])  {
      time2     <- difftime(df1$interval_start1,df1$end_date, units="mins")
      time2.cap <- difftime(df1$interval_start1, df1$interval_end1 86400, units="mins")
      time2[abs(time2) > abs(time2.cap)] <- time2.cap[abs(time2) > abs(time2.cap)]

      df1$time2[i] <- time2[i]*-1
    }
  }
}

# See if there were any days in between first and last and if so add time
time2 <- minutes(300 * round(difftime(df1$end_date,df1$start_date, units = "days"))) minutes(time2)*-1

df$time2 <- as.period(NA)
df$time2[!is.na(df$interval_start1)]  <- time2
df$time2[is.na(df$interval_start1)]   <- 0

df$time_in_interval <- minutes(df$time1) df$time2
df$time_in_interval
  

Обратите внимание, что 86 400 — это количество секунд в день, так что это было именно то число.