допустим, используя итератор в качестве параметра для функции - PullRequest
Новая
       7

допустим, используя итератор в качестве параметра для функции

0 голосов
/ 15 мая 2018

Я пытаюсь решить проблему с lapply.Будучи SAS-программистом, этот способ мышления является для меня совершенно новым. 

library(data.table)
library(lubridate)

У меня есть таблица данных, похожая на эту 

DT <- data.table(idnum= c(1001,1001,1001,1002,1002,1003,1003,1003,1003),
             a_beg= c(16079, 16700, 17000, 16074, 17000, 16074, 17000, 18081, 19000),
             a_end= c(16500, 16850, 22000, 16900, 22000, 16950, 18000, 18950, 21000))

a_beg и a_end, содержащие номер sas-date (дней с 1960-01-01)

Это моя функция лет.Я хочу применить свою функцию к объекту data.table, сохраняя только строки, интервалы которых перекрывают учебный год 

 years <- function(DT, year) {

 DT <- DT[lubridate::date('1960-01-01')+a_beg <= lubridate::ymd(paste(year, 1, 1, sep = "-"))
        & lubridate::date('1960-01-01')+a_end >= lubridate::ymd(paste(year, 12, 31, sep = "-")), ]
 DT
 }

Выполнение без применения прекрасно работает ... 

year2005 <- years(DT, 2005)

Я хочучтобы сделать что-то вроде этого ... переходя через годы обучения, используя bind_rows и pipe в data.table 

 DT <- bind_rows(lapply(DT, 2004:2015, years())) %>% data.table()

Я хочу использовать итератор в качестве параметра для функции, я не знаю, как.

1 Ответ

0 голосов
/ 16 мая 2018

Я думаю, что вы хотите 

years <- function(year, DTbl) {
    #data.table changes by reference so you do not want your subset to overwrite the original DT
    DTbl[lubridate::date('1960-01-01')+a_beg <= lubridate::ymd(paste(year, 1, 1, sep = "-"))
            & lubridate::date('1960-01-01')+a_end >= lubridate::ymd(paste(year, 12, 31, sep = "-")), ]    
}
bind_rows(lapply(2004:2015, years, DTbl=DT)) %>% data.table()

Или, если мы используем больше синтаксиса , вы можете выполнить неэквиное объединение следующим образом: 

DT[, ':=' (
    a_beg = as.Date(a_beg, origin="1960-01-01"),
    a_end = as.Date(a_end, origin="1960-01-01")
)]

yearRanges <- data.table(beg=seq(as.Date("2004-01-01"), by="1 year", length.out=12), 
    end=seq(as.Date("2004-12-31"), by="1 year", length.out=12))

DT[yearRanges,
    .(YEAR=year(beg), idnum=x.idnum, a_beg=x.a_beg, a_end=x.a_end),
    on=.(a_beg <= beg, a_end >= end),
    allow.cartesian=TRUE]
...