Диапазон дат в период анализа в R

Question

У меня есть кадр Data1 данных с тремя колонками: NoContract, IniDate, FinDate представляющий идентификатор контракта, когда начинается договор и при отделки соответственно. С другой стороны, у меня есть период анализа: с 1 января 2012 года по 31 декабря 2014 года. Я хочу найти, сколько контрактов, которые активны в каждом месяце аналитического периода, по активным, я имею в виду, что контракт имеет хотя бы один день от его дат между IniDate и FinDate в месяц анализируемого периода.

Я пытался в R делать:

Позволяет сказать Data1 является:

Data1 <- data.frame(NoContract= 1:3, IniDate= as.Date(c("2011-05-03","2012-03-13","2014-03-26")),FinDate=as.Date(c("2015-01-05","2013-03-13","2015-08-19"))) 
Data1 

    NoContract IniDate FinDate 
1   1 2011-05-03 2015-01-05 
2   2 2012-03-13 2013-03-13 
3   3 2014-03-26 2015-08-19 

I've создал еще один кадр данных DatesCalc как:

DatesCalc<-data.frame(monthI=seq(as.Date("2012-01-01"), as.Date("2014-12-31"), by="1 month"), monthF=(seq(as.Date("2012-02-01"), as.Date("2015-01-01"), by="1 month")-1)) 
head(DatesCalc) 

     monthI  monthF 
1 2012-01-01 2012-01-31 
2 2012-02-01 2012-02-29 
3 2012-03-01 2012-03-31 
4 2012-04-01 2012-04-30 
5 2012-05-01 2012-05-31 
6 2012-06-01 2012-06-30 

Далее я написал функцию

myfun<-function(X,Y){ 
    d1<-numeric() 
    d2<-numeric() 
    for (i in 1:36){ #36 num of rows on DatesCalc 
    d1<-numeric() 
    for (j in 1:3){ #3 num of rows of my Data1 (my actual case near 550K rows) 
     d1<-c(d1,sum(seq(X[i,1],X[i,2],by=1)%in%seq(Y[j,2],Y[j,3],by=1),na.rm=TRUE)>0) 
    } 
d2<-cbind(d2,d1) 
    } 
    return(d2) 
} 

Итак, что он делает, для каждой строки Data1 создает последовательность дат каждой строки DatesCalc и доказывает, что это, находится в последовательности дат текущей строки Data1. Эта функция возвращает матрицу, в которой строки представляют собой контракт и столбцы месяцев с января 2012 года по декабрь 2014 года, и каждая ячейка имеет 1, если в течение месяца был активен контракт, а 0, если нет (см. Res). Наконец, я использовал применить к сумме по столбцу и получил то, что хочу.

Res<-myfun(DatesCalc,Data1) 
Res 
    d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 
[1,] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 
[2,] 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 
[3,] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 

apply(Res,2,sum) 
d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 d1 
1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 

Дело в том, что у меня есть сотни тысяч строк (550K) в моей фактической Data1, и работает myfun на ней неэффективно. Мой вопрос, может быть, это способ сделать это эффективным в R? Или любые предложения о том, как улучшить мой код. Спасибо, Comunnity.

Answer 1

Здесь используется опция data.table foverlaps.

1. Первый, foverlaps - слияние с использованием интервала. У вас должны быть одинаковые имена столбцов для слияния. Вы также должны установить ключи второй таблицы.
2. LThe желаемый результат равен матрица, где строки представляют собой контракт и столбцы месяцев с января 2012 по декабрь 2014 года, поэтому я создал новый период столбца, который является годом месяца контракта.
3. Измените результат в широком формате с помощью dcast.data.table.

Код:

library(data.table) 
setDT(Data1) 
setDT(DatesCalc) 
setkey(Data1, IniDate, FinDate) ## Set keys for merge 
setnames(DatesCalc,names(DatesCalc),c('IniDate','FinDate')) ## rename for merge 
dcast.data.table(  ## wide format 
    foverlaps(DatesCalc, Data1, type="within")[, 
     period := format(i.IniDate,'%Y-%m')], ## create a new variable here 
    NoContract~period,fun=length) ## the aggregate function is the length (T/F) 

    NoContract 2012-01 2012-02 2012-03 2012-04 2012-05 2012-06 2012-07 2012-08 2012-09 2012-10 2012-11 2012-12 2013-01 2013-02 2013-03 2013-04 2013-05 2013-06 2013-07 
1:   1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1 
2:   2  0  0  0  1  1  1  1  1  1  1  1  1  1  1  0  0  0  0  0 
3:   3  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0 
    2013-08 2013-09 2013-10 2013-11 2013-12 2014-01 2014-02 2014-03 2014-04 2014-05 2014-06 2014-07 2014-08 2014-09 2014-10 2014-11 2014-12 
1:  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1 
2:  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0 
3:  0  0  0  0  0  0  0  0  1  1  1  1  1  1  1  1  1