R：日期之間的天數順序

Question

我有以下數據框：

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   

我想要做的是，針對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幾乎肯定效率不高-假設您的數據租約長達10,000年。 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

這正是foverlap閃耀的問題：基於另一個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 

這是@Arun對其工作方式的簡要說明，這使我從data.table開始。

Answer 3

沒有您的數據，我無法測試這是否更快，但是可以用更少的代碼來完成工作：

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 4

一種替代方法，但我不確定它是否更快。

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 5

嘗試潤滑包裝。 為每個租約創建一個間隔。 然后計算每個日期的租賃間隔。

# 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