Посчитайте, если между диапазоном дат на основе групп

Question

Я застрял, пытаясь найти относительно простой способ подсчета событий в диапазоне дат по группам, используя R. Я понял, что должен быть более простой способ, чем то, что я пытаюсь.

У меня более 6000 групп, в каждой группе от 1 до 100 идентификаторов, каждая с датой начала и окончания с 1 января 1990 г. по сегодняшний день.Я хочу создать фрейм данных, одну группу на столбец и один день на строку, считая количество активных идентификаторов в день с 1 апреля 2013 года по 31 марта 2018 года. По очевидным причинам использование показателей в Excel не приведет к его сокращению.

Я пытался использовать этот вопрос в качестве отправной точки, как таковой:

df1 <- data.frame(group = c(1,1,2,3,3),
              id = c(1,2,1,1,2),
              startdate = c("2016-01-01","2016-04-04","2016-03-02","2016-08-01","2016-04-01"), 
              enddate = c("2016-04-04","2999-01-01","2016-05-02","2016-08-05","2999-01-01"))

report <- data.frame(date = seq(from = as.Date("2016-04-01"),by="1 day", length.out = 7))
report <- cbind(report,matrix(data=NA,nrow=7,ncol=3))
names(report) <- c('date',as.vector(unique(df1$group)))

daily <- function(i,...){
    report[,i+1] <- sapply(report$date, function(x)
    sum(as.Date(df1$startdate) < as.Date(x) &
        as.Date(df1$enddate) > as.Date(x) & 
       df1$group == unique(df1$group)[i]))
        }

for (i in unique(df1$group))
  daily(i)

Однако, похоже, это ничего не делает (и не делаетвыкидывать ошибки).Есть ли более простой способ сделать это?Я далеко от базы?Любая помощь приветствуется для этого непрограммиста!

Запрошена дополнительная помощь : я пытаюсь изменить код Jaap в ответе ниже, чтобы включить время начала и окончания группы, чтобыТаблица данных отображает NA, когда группа не активна.

Пример данных:

df2 <- data.frame(group = c(1,1,2,3,3),
                  groupopendate = c("2016-04-02","2016-04-02","2016-04-01","2016-04-02","2016-04-02"),
                  groupclosedate = c("2016-04-08","2016-04-08","2016-04-10","2016-04-09","2016-04-09"),
                  id = c(1,2,1,1,2),
                  startdate = c("2016-04-02","2016-04-04","2016-04-03","2016-04-02","2016-04-05"), 
                  enddate = c("2016-04-04","2016-04-06","2016-04-10","2016-04-08","2016-04-08"))

Решение Яапа дает мне следующее:

       active grp1 grp2 grp3
1: 2016-04-02    1    0    1
2: 2016-04-03    1    1    1
3: 2016-04-04    1    1    1
4: 2016-04-05    1    1    2
5: 2016-04-06    0    1    2
6: 2016-04-07    0    1    2

Однако я хочу вот что:

        active grp1 grp2 grp3
1:  2016-04-01   NA    0   NA
2:  2016-04-02    1    0    1
3:  2016-04-03    1    1    1
4:  2016-04-04    1    1    1
5:  2016-04-05    1    1    1
6:  2016-04-06    1    1    2
7:  2016-04-07    0    1    2
8:  2016-04-08   NA    1    0
9:  2016-04-09   NA    1   NA
10: 2016-04-10   NA   NA   NA

Любая помощь приветствуется!

Answer 1

Возможное альтернативное решение с использованием data.table :

# load the package & convert 'df1' to a data.table
library(data.table)
setDT(df1)

# convert the date columns to a date format
# not needed if they are 
df1[, `:=` (startdate = as.Date(startdate), enddate = as.Date(enddate))]

# create a new data.table with the 'active' days
DT <- data.table(active = seq(from = as.Date("2016-04-01"), by = "day", length.out = 7))

# use a join and dcast to get the desired result
DT[df1
   , on = .(active > startdate, active < enddate)
   , allow = TRUE
   , nomatch = 0
   , .(active = x.active, group, id)
   ][, dcast(.SD, active ~ paste0("grp",group), value.var = "id", fun = length)]

, которое дает:

       active grp1 grp2 grp3
1: 2016-04-01    1    1    0
2: 2016-04-02    1    1    1
3: 2016-04-03    1    1    1
4: 2016-04-04    0    1    1
5: 2016-04-05    1    1    1
6: 2016-04-06    1    1    1
7: 2016-04-07    1    1    1

ПРИМЕЧАНИЕ.использовал paste0("grp",group) вместо просто group на шаге dcast, поскольку это приводит к лучшим именам столбцов (лучше не использовать только числовые значения в качестве имен столбцов)

---

Что касается вашего дополнительного примераВы можете решить это следующим образом:

setDT(df2)

df2[, c(2:3,5:6) := lapply(.SD, as.Date), .SDcols = c(2:3,5:6)]

DT <- data.table(active = seq(from = min(df2$groupopendate),
                              to = max(df2$groupclosedate),
                              by = "day"))

df2new <- df2[, .(active = seq.Date(startdate, enddate, by = "day"))
              , by = .(group, id)
              ][, .N, by = .(group, active)
                ][df2[, .(active = seq.Date(groupopendate[1], groupclosedate[.N] - 1, by = "day"))
                      , by = .(group)]
                  , on = .(group, active)
                  ][is.na(N), N := 0
                    ][, dcast(.SD, active ~ paste0("grp",group))]

nms <- setdiff(names(df2new), "active")

DT[df2new
   , on = .(active)
   , (nms) := mget(paste0("i.",nms))][]

, что дает:

> DT
        active grp1 grp2 grp3
 1: 2016-04-01   NA    0   NA
 2: 2016-04-02    1    0    1
 3: 2016-04-03    1    1    1
 4: 2016-04-04    2    1    1
 5: 2016-04-05    1    1    2
 6: 2016-04-06    1    1    2
 7: 2016-04-07    0    1    2
 8: 2016-04-08   NA    1    2
 9: 2016-04-09   NA    1   NA
10: 2016-04-10   NA    1   NA

Answer 2

Я понял это!Как обычно, как только вы публикуете вопрос, вы выясняете ответ.Я слишком усложнил это, вставив функцию, когда я мог просто поместить sapply в цикл for.

Если кому-то интересно:

for (i in unique(df1$group))
  {report[,i+1] <- 
  sapply(report$date, function(x)
      sum(as.Date(df1$startdate) < as.Date(x) &
      as.Date(df1$enddate) > as.Date(x) & 
      df1$group == unique(df1$group)[i]))}