R: последовательность дней между датами

Question

У меня есть следующие dataframes:

AllDays 
2012-01-01 
2012-01-02 
2012-01-03 
... 
2015-08-18 

Leases 
StartDate EndDate 
2012-01-01 2013-01-01 
2012-05-07 2013-05-06 
2013-09-05 2013-12-01 

То, что я хочу сделать это, для каждой даты в dataframe Alldays, рассчитать количество договоров аренды, которые в действительности. например если есть 4 договора аренды с датой начала < = 2015-01-01 и дата окончания> = 2015-01-01, то я хотел бы разместить 4 в этом фрейме данных.

У меня есть следующий код

for (i in 1:nrow(leases)) 
    { 
    occupied = seq(leases$StartDate[i],leases$EndDate[i],by="days") 
    occupied = occupied[occupied < dateOfInt] 
    matching = match(occupied,allDays$Date) 
    allDays$Occupancy[matching] = allDays$Occupancy[matching] + 1 
    } 

, который работает, но у меня около 5000 договоров аренды, она занимает около 1,1 секунды. Кто-нибудь имеет более эффективный метод, который потребует меньше времени вычисления? Датой интереса является только текущая дата и используется просто для того, чтобы не считать даты аренды в будущем.

Answer 1

Использование seq почти наверняка неэффективно - представьте, что у вас есть аренда в ваших данных, которая составляет 10000 лет. seq возьмет навсегда и вернет 10000 * 365-1 дней, что не имеет значения для нас. Затем мы должны использовать %in%, который также делает такое же количество ненужных сравнений.

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

данных

set.seed(102349) 
days<-data.frame(AllDays=seq(as.Date("2012-01-01"), 
          as.Date("2015-08-18"),"day")) 

leases<-data.frame(StartDate=sample(days$AllDays,5000L,T)) 
leases$EndDate<-leases$StartDate+round(rnorm(5000,mean=365,sd=100)) 

подход

Использование data.table и sapply:

library(data.table) 
setDT(leases); setDT(days) 

days[,lease_count:= 
     sapply(AllDays,function(x) 
     leases[StartDate<=x&EndDate>=x,.N])][] 
     AllDays lease_count 
    1: 2012-01-01   5 
    2: 2012-01-02   8 
    3: 2012-01-03   11 
    4: 2012-01-04   16 
    5: 2012-01-05   18 
    ---      
1322: 2015-08-14  1358 
1323: 2015-08-15  1358 
1324: 2015-08-16  1360 
1325: 2015-08-17  1363 
1326: 2015-08-18  1359 

Answer 2

Альтернативный подход, но я не уверен, что это быстрее.

library(lubridate) 
library(dplyr) 

AllDays = data.frame(dates = c("2012-02-01","2012-03-02","2012-04-03")) 

Lease = data.frame(start = c("2012-01-03","2012-03-01","2012-04-02"), 
        end = c("2012-02-05","2012-04-15","2012-07-11")) 

# transform to dates 
AllDays$dates = ymd(AllDays$dates) 
Lease$start = ymd(Lease$start) 
Lease$end = ymd(Lease$end) 

# create the range id 
Lease$id = 1:nrow(Lease) 

AllDays 

#  dates 
# 1 2012-02-01 
# 2 2012-03-02 
# 3 2012-04-03 

Lease 

#  start  end id 
# 1 2012-01-03 2012-02-05 1 
# 2 2012-03-01 2012-04-15 2 
# 3 2012-04-02 2012-07-11 3 


data.frame(expand.grid(AllDays$dates,Lease$id)) %>%  # create combinations of dates and ranges 
    select(dates=Var1, id=Var2) %>% 
    inner_join(Lease, by="id") %>%       # join information 
    rowwise %>% 
    do(data.frame(dates=.$dates, 
       flag = ifelse(.$dates %in% seq(.$start,.$end,by="1 day"),1,0))) %>%  # create ranges and check if the date is in there 
    ungroup %>% 
    group_by(dates) %>% 
    summarise(N=sum(flag)) 

#  dates N 
# 1 2012-02-01 1 
# 2 2012-03-02 1 
# 3 2012-04-03 2 

Answer 3

Попробуйте пакет lubridate. Создайте интервал для каждой аренды. Затем посчитайте интервалы аренды, которые каждый день попадает в.

# make some data 
AllDays <- data.frame("Days" = seq.Date(as.Date("2012-01-01"), as.Date("2012-02-01"), by = 1)) 
Leases <- data.frame("StartDate" = as.Date(c("2012-01-01", "2012-01-08")), 
       "EndDate" = as.Date(c("2012-01-10", "2012-01-21"))) 
library(lubridate) 

x <- new_interval(Leases$StartDate, Leases$EndDate, tzone = "UTC") 
AllDays$NumberInEffect <- sapply(AllDays$Days, function(a){sum(a %within% x)}) 

выходного

head(AllDays) 
     Days NumberInEffect 
1 2012-01-01    1 
2 2012-01-02    1 
3 2012-01-03    1 
4 2012-01-04    1 
5 2012-01-05    1 
6 2012-01-06    1 

Answer 4

Без ваших данных, я не могу проверить, является ли это происходит быстрее, но он получает работу с меньше кода:

for (i in 1:nrow(AllDays)) AllDays$tally[i] = sum(AllDays$AllDays[i] >= Leases$Start.Date & AllDays$AllDays[i] <= Leases$End.Date) 

Я использовал следующее, чтобы проверить его; отметить, что соответствующие столбцы в обоих кадрах данных отформатированы как даты:

AllDays = data.frame(AllDays = seq(from=as.Date("2012-01-01"), to=as.Date("2015-08-18"), by=1)) 
Leases = data.frame(Start.Date = as.Date(c("2013-01-01", "2012-08-20", "2014-06-01")), End.Date = as.Date(c("2013-12-31", "2014-12-31", "2015-05-31"))) 

Answer 5

Это именно та проблема, где foverlaps светит: Подменю в data.frame, основанный на другом data.frame (foverlaps, кажется, специально для этой цели).

Основано на данных @ MichaelChirico.

setkey(days[, AllDays1:=AllDays,], AllDays, AllDays1) 
setkey(leases, StartDate, EndDate) 
foverlaps(leases, days)[, .(lease_count=.N), AllDays] 
# user system elapsed 
# 0.114 0.018 0.136 
# @MichaelChirico's approach 
# user system elapsed 
# 0.909 0.000 0.907 

Here краткое объяснение о том, как она работает @Arun, что когда я начал с data.table.