Суммирование данных временного интервала по дням в R с перекрывающимися датами

Может быть, ответ должен быть очевиден, но я немного застрял.

Мои данные выглядят примерно так:

> df <- data.frame(person = c("A", "B", "C"), start = c("2014-01-01", "2014-01-02", "2014-01-03"), stop = c("2014-01-05", "2014-01-06", "2014-01-04") )
> df
  person       start       stop
1      A  2014-01-01 2014-01-05
2      B  2014-01-02 2014-01-06
3      C  2014-01-03 2014-01-04

В конечном итоге я хочу отобразить общее количество людей, выполняющих действие в данный день, но я бы согласился просто подсчитать количество за день (т.е. подсчитать общее количество появлений каждой даты, когда известны даты начала и окончания). Для приведенных выше данных я ищу вот такой ответ:

      Date  Tally
2014-01-01  1
2014-01-02  2
2014-01-03  3
2014-01-04  3
2014-01-05  2
2014-01-06  1

Один из способов, который я пробовал, - использовать seq () для генерации всех дат, но, похоже, это не работает для дат начала / окончания длины> 1:

seq(df$start, df$stop, length = "1 day") ## Does not work

Любая помощь будет принята с благодарностью.


r date time intervals frequency
person BeginR    schedule 25.02.2014    source источник

Ответы (2)


arrow_upward
3
arrow_downward

В гостях могут быть:

as.data.frame(table(unlist(apply(df[-1], 1, 
        function(x) as.character(seq(as.Date(x[1], "%Y-%m-%d"), 
                                     as.Date(x[2], "%Y-%m-%d"), "1 day"))))))
        Var1 Freq
1 2014-01-01    1
2 2014-01-02    2
3 2014-01-03    3
4 2014-01-04    3
5 2014-01-05    2
6 2014-01-06    1

Поскольку вы стремитесь к эффективности, этот же ответ можно ускорить, избегая некоторых узких мест. Во-первых, обратите внимание, что as.Date вызывается каждый раз в цикле apply. Это связано с тем, что его однократный вызов перед циклом не будет иметь никакого эффекта, поскольку apply приводит к матрице и, следовательно, даты переводятся в символ, поэтому seq вызовет ошибку. Во-вторых, вы можете избежать накладных расходов, связанных с использованием метода seq для класса «Date». И в-третьих, вам нужна разница в днях. Все это воодушевляет превращать даты в целые числа и работать с классом "numeric".

f1 = function() {  #keeping dates
  as.data.frame(table(unlist(apply(df[-1], 1, 
       function(x) as.character(seq(as.Date(x[1], "%Y-%m-%d"), 
                                    as.Date(x[2], "%Y-%m-%d"), "1 day"))))))
}                                     
f2 = function() {  #using numeric
  df$start = as.numeric(as.Date(df$start, "%Y-%m-%d"))
  df$stop = as.numeric(as.Date(df$stop, "%Y-%m-%d"))
  res = as.data.frame(table(unlist(apply(df[-1], 1, 
                        function(x) seq(x[1], x[2])))))
  res$Var1 = factor(as.Date(as.numeric(as.character(res$Var1)), 
                            origin = "1970-01-01"))
  res                      
}
f1()
#        Var1 Freq
#1 2014-01-01    1
#2 2014-01-02    2
#3 2014-01-03    3
#4 2014-01-04    3
#5 2014-01-05    2
#6 2014-01-06    1
f2()
#        Var1 Freq
#1 2014-01-01    1
#2 2014-01-02    2
#3 2014-01-03    3
#4 2014-01-04    3
#5 2014-01-05    2
#6 2014-01-06    1

И сравнительный анализ на более крупном data.frame:

df = data.frame(person = paste("ID", 1:1e3, sep = ""),
                start = as.Date(sample(Sys.Date() : (Sys.Date()+10), 1e3, T), 
                                origin = "1970-01-01"))
df$stop = df$start + 5
head(df)
#  person      start       stop
#1    ID1 2014-03-07 2014-03-12
#2    ID2 2014-03-01 2014-03-06
#3    ID3 2014-03-04 2014-03-09
#4    ID4 2014-02-28 2014-03-05
#5    ID5 2014-02-27 2014-03-04
#6    ID6 2014-03-07 2014-03-12
identical(f1(), f2())
#[1] TRUE
library(microbenchmark)
microbenchmark(f1(), f2(), times = 10)
#Unit: milliseconds
# expr       min        lq    median        uq       max neval
# f1() 366.90895 368.36777 379.78573 395.82724 410.17782    10
# f2()  31.66473  32.11122  33.04891  33.62642  35.75063    10
person alexis_laz    schedule 25.02.2014
comment
@BeginR Посмотрите, могут ли быть полезны некоторые правки, которые я внес в ваш комментарий - person alexis_laz; 26.02.2014

arrow_upward
2
arrow_downward

Это работает:

df[, -1] <- lapply(df[-1], as.Date)

data.frame(table(unlist(lapply(1:nrow(df), function(i) {
    as.character(seq.Date(df$start[i], df$stop[i], "day"))
}))))

##         Var1 Freq
## 1 2014-01-01    1
## 2 2014-01-02    2
## 3 2014-01-03    3
## 4 2014-01-04    3
## 5 2014-01-05    2
## 6 2014-01-06    1
person Tyler Rinker    schedule 25.02.2014
comment
Это также работает, но при использовании с большим набором данных для вычисления потребовалось много времени. - person BeginR; 26.02.2014