Применить функцию к каждой строке data.frame и сохранить классы столбцов

Question

Интересно, есть ли способ применить функцию к каждой строке data.frame, чтобы классы столбцов сохранялись? Давайте посмотрим на пример, чтобы пояснить, что я имею в виду:

test <- data.frame(startdate = as.Date(c("2010-03-07", "2013-09-13", "2011-11-12")), 
        enddate = as.Date(c("2010-03-23", "2013-12-01", "2012-01-05")), 
        nEvents = c(123, 456, 789)) 

Предположим, что я хотел бы расширить data.frame test, вставляя все дни между startdate и enddate и распределить количество событий в течение этих дней. Моя первая попытка сделать это было так:

eventsPerDay1 <- function(row) { 
    n_days <- as.numeric(row$enddate - row$startdate) + 1 
    data.frame(date = seq(row$startdate, row$enddate, by = "1 day"), 
       nEvents = rmultinom(1, row$nEvents, rep(1/n_days, n_days))) 
} 

apply(test, 1, eventsPerDay1) 

Это, однако, не представляется возможным, потому что apply вызовы as.matrix на test и, таким образом, он преобразуется в матрицу символов и все классы столбцов будут потеряны.

Я уже нашел два обходных пути, которые вы можете найти ниже, так что мой вопрос более похож на философию.

library(magrittr) 
############# Workaround 1 
eventsPerDay2 <- function(startdate, enddate, nEvents) { 
    n_days <- as.numeric(enddate - startdate) + 1 
    data.frame(date = seq(startdate, enddate, by = "1 day"), 
       nEvents = rmultinom(1, nEvents, rep(1/n_days, n_days))) 
} 

mapply(eventsPerDay2, test$startdate, test$enddate, test$nEvents, SIMPLIFY = F) %>% 
    do.call(rbind, .) 


############# Workaround 2 
seq_along(test) %>% 
    lapply(function(i) test[i, ]) %>% 
    lapply(eventsPerDay1) %>% 
    do.call(rbind, .) 

Моя «проблема» с обходные заключается в следующем:

• Обход 1: Это может быть не лучшая причина, но я просто не люблю mapply. Он имеет другую подпись, чем другие функции *apply (поскольку порядок аргументов отличается), и я всегда чувствую, что цикл for был бы более ясным.
• Обход проблемы 2: будучи очень гибким, я думаю, что на первый взгляд не ясно, что происходит.

Так кто-нибудь знает функцию, чей вызов будет выглядеть как apply(test, 1, eventsPerDay1), и это сработает?

Answer 1

Мы можем сделать это с data.table

library(data.table) 
res <- setDT(test)[,n_days := as.numeric(enddate - startdate) + 1 
      ][, .(date = seq(startdate, enddate, by= "1 day"), 
      nEvents = c(rmultinom(1, nEvents, rep(1/n_days, n_days)))), 
     by = 1:nrow(test)][, nrow := NULL] 
str(res) 
#Classes ‘data.table’ and 'data.frame': 152 obs. of 2 variables: 
# $ date : Date, format: "2010-03-07" "2010-03-08" "2010-03-09" "2010-03-10" ... 
# $ nEvents: int 5 9 7 11 6 6 10 7 12 3 ... 

выше может быть завернуты в функции

eventsPerDay <- function(dat){ 
     as.data.table(dat)[, n_days:= as.numeric(enddate - startdate) + 1 
     ][, .(date = seq(startdate, enddate, by= "1 day"), 
    nEvents = c(rmultinom(1, nEvents, rep(1/n_days, n_days)))) , 1:nrow(dat) 
     ][, nrow := NULL][] 
    } 

eventsPerDay(test) 

Answer 2

Еще одна идея:

library(dplyr) 
library(tidyr) 

test %>% 
    mutate(id = row_number()) %>% 
    group_by(startdate) %>% 
    complete(startdate = seq.Date(startdate, enddate, 1), nesting(id)) %>% 
    group_by(id) %>% 
    mutate(nEvents = rmultinom(1, first(nEvents), rep(1/n(), n()))) %>% 
    select(startdate, nEvents) 

Что дает:

#Source: local data frame [152 x 3] 
#Groups: id [3] 
# 
#  id startdate nEvents 
# <int>  <date> <int> 
#1  1 2010-03-07  6 
#2  1 2010-03-08  6 
#3  1 2010-03-09  6 
#4  1 2010-03-10  7 
#5  1 2010-03-11  12 
#6  1 2010-03-12  5 
#7  1 2010-03-13  8 
#8  1 2010-03-14  5 
#9  1 2010-03-15  5 
#10  1 2010-03-16  9 
## ... with 142 more rows