dplyr и предыдущие наблюдения

Question

Мне нужно запустить набор линейных моделей для каждого уникального идентификатора, но сначала мне нужно сделать чек. Для каждого уникального идентификатора и года мне нужно проверить, что есть не менее 24 месяцев предыдущих ежемесячных данных, но не более 60 месяцев. Поэтому, когда я запускаю регрессию, он должен включать от 24 до 60 наблюдений за предыдущие месячные (годы) данные за каждый год каждого человека. Если в течение этого года имеется менее 24 месяцев данных, год для этого человека снижается, но если их более 60, то используются только 60 месяцев.

Благодаря сообщению this (спасибо @akrun), мне удалось настроить линейные модели для каждого пользователя, запустить их, а затем вывести бета-версию в виде суммы обеих бета-версий. Проблема в том, что это только регрессия в текущем году (12 сб), а не предыдущие 24-60.

Edit: я понял, что был неправ dput ... извините

Single CUSIP dput:

tdata <- structure(list(cusip = c(101L, 101L, 101L, 101L, 101L, 101L, 
101L, 101L, 101L, 101L, 101L, 101L, 101L, 101L, 101L, 101L, 101L, 
101L, 101L, 101L, 101L, 101L, 101L, 101L, 101L, 101L, 101L, 101L, 
101L, 101L, 101L, 101L, 101L, 101L, 101L, 101L, 101L, 101L, 101L, 
101L, 101L, 101L, 101L, 101L, 101L, 101L, 101L, 101L, 101L, 101L, 
101L, 101L, 101L), date = c(19901130L, 19901031L, 19900928L, 
19900831L, 19900731L, 19900629L, 19900531L, 19900430L, 19900330L, 
19900228L, 19900131L, 19891229L, 19891130L, 19891031L, 19890929L, 
19890831L, 19890731L, 19890630L, 19890531L, 19890428L, 19890331L, 
19890228L, 19890131L, 19881230L, 19881130L, 19881031L, 19880930L, 
19880831L, 19880729L, 19880630L, 19880531L, 19880429L, 19880331L, 
19880229L, 19880129L, 19871231L, 19871130L, 19871030L, 19870930L, 
19870831L, 19870731L, 19870630L, 19870529L, 19870430L, 19870331L, 
19870227L, 19870130L, 19861231L, 19861128L, 19861031L, 19860930L, 
19860829L, 19860731L), fyear = c("1990", "1990", "1990", "1990", 
"1990", "1990", "1990", "1990", "1990", "1990", "1990", "1989", 
"1989", "1989", "1989", "1989", "1989", "1989", "1989", "1989", 
"1989", "1989", "1989", "1988", "1988", "1988", "1988", "1988", 
"1988", "1988", "1988", "1988", "1988", "1988", "1988", "1987", 
"1987", "1987", "1987", "1987", "1987", "1987", "1987", "1987", 
"1987", "1987", "1987", "1986", "1986", "1986", "1986", "1986", 
"1986"), month = c("11", "10", "09", "08", "07", "06", "05", 
"04", "03", "02", "01", "12", "11", "10", "09", "08", "07", "06", 
"05", "04", "03", "02", "01", "12", "11", "10", "09", "08", "07", 
"06", "05", "04", "03", "02", "01", "12", "11", "10", "09", "08", 
"07", "06", "05", "04", "03", "02", "01", "12", "11", "10", "09", 
"08", "07"), ret = c("0.117647", "0.030303", "-0.161017", "-0.186207", 
"-0.131737", "0.128378", "0.027778", "-0.162791", "0.131579", 
"0.178295", "-0.091549", "0.163934", "-0.089552", "0.007519", 
"0.117647", "0.155340", "0.211765", "0.024096", "0.338710", "0.377778", 
"0.071429", "-0.176471", "0.378378", "-0.026316", "-0.050000", 
"-0.047619", "-0.086957", "-0.061224", "0.088889", "-0.062500", 
"-0.040000", "-0.056604", "0.081633", "0.042553", "-0.096154", 
"0.238095", "-0.263158", "-0.393617", "-0.160714", "0.400000", 
"-0.090909", "-0.200000", "-0.098361", "-0.152778", "0.000000", 
"0.107692", "0.460674", "-0.101010", "-0.019802", "0.246914", 
"-0.052632", "0.179310", "-0.064516"), ewretd = c(0.035468, -0.057155, 
-0.080468, -0.108911, -0.025732, 0.005359, 0.045675, -0.028117, 
0.021315, 0.015434, -0.046408, -0., -0.0058, -0.049934, 
0.005532, 0.018626, 0.031017, -0.007744, 0.025054, 0.029089, 
0.01806, 0.002988, 0.062124, 0.018872, -0.036484, -0.011485, 
0.016951, -0.025001, 0.000289, 0.047677, -0.017671, 0.014016, 
0.03569, 0.060265, 0.077392, 0.026065, -0.05085, -0.272248, -0.015876, 
0.014544, 0.035123, 0.021487, 0.000573, -0.017709, 0.036283, 
0.074612, 0.117565, -0.034609, -0.006263, 0.023777, -0.059071, 
0.023269, -0.073128), lagewretd = c(-0.004526, 0.035468, -0.057155, 
-0.080468, -0.108911, -0.025732, 0.005359, 0.045675, -0.028117, 
0.021315, 0.015434, -0.046408, -0., -0.0058, -0.049934, 
0.005532, 0.018626, 0.031017, -0.007744, 0.025054, 0.029089, 
0.01806, 0.002988, 0.062124, 0.018872, -0.036484, -0.011485, 
0.016951, -0.025001, 0.000289, 0.047677, -0.017671, 0.014016, 
0.03569, 0.060265, 0.077392, 0.026065, -0.05085, -0.272248, -0.015876, 
0.014544, 0.035123, 0.021487, 0.000573, -0.017709, 0.036283, 
0.074612, 0.117565, -0.034609, -0.006263, 0.023777, -0.059071, 
0.023269)), class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA, 
-53L), .Names = c("cusip", "date", "fyear", "month", "ret", "ewretd", 
"lagewretd")) 

dplyr код:

res1 <- tdata %>% 
    group_by(cusip, fyear) %>% 
    arrange(desc(date)) %>% 
    mutate(n=n()) %>% 
    do(data.frame(., beta=ifelse(.$n > 2, 
    sum(coef(lm(ret~ewretd+lagewretd, data=.))[-1]), NA))) 

Update 2: 04/13/2015

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

for (i : unique(cusip)){ 
    for (j : unique(fyear)){ 
    check <- filter(tdata, fyear == i & fyear == i-1 & fyear == i-2 & fyear == i-3 & fyear == i-4) 
    ifelse(length(check$month < 24), tdata$beta == NA, if(length(check$month >= 60)){ 
                 arrange(check, desc(date)), 
                 filter(check, month[1:60,]), 
                 check$beta <- sum(coef(lm(ret~ewretd+lagewretd, data = check))[-1])), 
                 left_join(tdata, check, by=c("cusip", fyear == j))} 

Update 3: Полный образец набор

Это включает в себя все набл, что является достаточно большим (323mb)

Full Sample

Answer 1

В конечном счете, вы, вероятно, хотите использовать соответствующие даты , Я сделал небольшой шаг в этом направлении, преобразовывая fyear от символа в целое.

library(dplyr) 

## convert fyear to a proper number and then exploit for sorting 
tdata <- tdata %>% 
    mutate(fyear = fyear %>% as.integer) %>% 
    arrange(fyear, month) 

Тогда я сделать tbl резюмировать на уровне fyear, вычисляя, сколько кумулятивные месяцев данных вы бы для подгонки модели. (Я тащу cusip вокруг, но так как ваши данные включают в себя только один cusip, я не могу быть уверен, что это все работает правильно.)

## figure out cumulative months available for each year (for each cusip) 
yearstuff <- tdata %>% 
    group_by(cusip, fyear) %>% 
    summarize(n = n()) %>% 
    mutate(n_cum = cumsum(n)) 
yearstuff 
# Source: local data frame [5 x 4] 
# Groups: cusip 
# 
# cusip fyear n n_cum 
# 1 101 1986 6  6 
# 2 101 1987 12 18 
# 3 101 1988 12 30 
# 4 101 1989 12 42 
# 5 101 1990 11 53 

Я не нахожу модель фитинга быть очень естественным задача для dplyr, так как она не очень хорошо вписывается в парадигму group_by. Вместо этого я отключаю вещи от yearstuff, используя plyr::ddply(), и вытаскиваю данные, которые мне нужны для каждой комбинации cusip * fyear. Я отказываюсь соответствовать модели, если данных недостаточно, и если данных слишком много, я занимаю последние 60 месяцев.

## iterate over rows of yearstuff (for each cusip) 
models <- plyr::ddply(yearstuff, ~ cusip + fyear, function(y) { 
    if(y$n_cum < 24) { 
    c('(Intercept)' = NA_real_, ewretd = NA_real_, lagewretd = NA_real_) 
    } else { 
    my_dat <- tdata %>% 
     filter(cusip == y$cusip, fyear <= y$fyear) %>% 
     mutate(rn = row_number(desc(date))) 
    lm(ret ~ ewretd + lagewretd, my_dat, subset = rn < 61) %>% coef 
    } 
}) 
models 
# cusip fyear (Intercept) ewretd lagewretd 
# 1 101 1986   NA  NA   NA 
# 2 101 1987   NA  NA   NA 
# 3 101 1988 -0.01138861 1.614342 0.14885911 
# 4 101 1989 0.02467139 1.878295 0.00598857 
# 5 101 1990 0.02529068 1.900389 0.05766020 

Это дает вам приблизительные оценочные коэффициенты для использования по вашему желанию. Я думаю, что это должно масштабироваться до нескольких cusip, но кто знает ?. Также этот набор данных не содержит более 60 месяцев. Очевидно, вы должны сделать некоторые выборочные проверки этих результатов «вручную»!