有效地计数和分类在指定间隔内发生的事件。

Question

我试图分析一个大型数据集(>1.5M观测)，以寻找事件的时间和位置之间的相关性。不幸的是，我在创建分析数据集时遇到了性能问题。

从本质上说，一个事件可以发生在几个设施中的一个(A、B和C)、每个设施的几个地点(1-6)以及一系列日期(1990年1月至6月1日)，其结果值为1和0。网站彼此很近，所以站点2的事件可能会影响站点1、2和3。事件也有持续的影响，因此3月10日的事件可能会影响到3月17日左右的未来事件。

以下是一些示例数据：

set.seed(12345)

df <- data.frame(
  facility = sample(
    c("A","B","C"),
    100,
    replace=TRUE),
  
  site = sample(
    1:6,
    100,
    replace=TRUE),
  
  date = as.Date(
    sample(
      c(lubridate::ymd("1990-1-1"):lubridate::ymd("1990-6-1")),
      100,
      replace=TRUE),
    origin = "1970-01-01"
    ),
    
  outcome = sample(
    c(0,1),100,
    replace=TRUE),
  
  stringsAsFactors = FALSE
)

到目前为止，我已经成功地获得了在每次迭代中都能工作的东西：

# A place to put the output
outputdf <- data.frame(
  facility = character(),
  site = numeric(),
  date = as.Date(character()),
  outcome = numeric(),
  recent_success = integer(),
  recent_failures = integer(),
  stringsAsFactors = FALSE
)

# Loop through each iteration
for(i in 1:nrow(df)){
  # Let me know how things are going in the console
  print(paste("Event ",i," of ",nrow(df),sep=""))
  
  #Choose just one event at a time
  EventofInterest <- df[i,]

  # Get site and facility information for that event
  facility_of_interest <- EventofInterest$facility %>%
    unlist()
  
  site_of_interest <- EventofInterest$site %>%
    unlist()
  
 # Count up recent successes
  recent_success <- df %>%
    filter(outcome == 1,
           facility %in% facility_of_interest,
           site %in% c((site-1),site,(site+1)),
           date %within% lubridate::interval(date-7,date)) %>% 
    nrow()
  
  # Count up recent failures
recent_failures <- df %>%
  filter(outcome == 0,
         facility %in% facility_of_interest,
         site %in% c((site-1),site,(site+1)),
         date %within% lubridate::interval(date-7,date)) %>% 
  nrow()
  
  # Create an output dataframe with the tallied successes and failures
  outputdf <- EventofInterest %>%
    mutate(recent_success = recent_success,
           recent_failures = recent_failures
    ) %>%
    # Bind that to the existing output dataframe
    bind_rows(outputdf)
  
  
}

它甚至给了我我想要的输出：

> head(outputdf)
  facility site       date outcome recent_success recent_failures
1        C    4 1990-01-23       1             15              23
2        B    1 1990-02-18       1             16              19
3        B    1 1990-02-01       1             16              19
4        A    5 1990-01-06       1             10              17
5        B    5 1990-01-10       0             16              19
6        C    3 1990-02-26       1             15              23

但随着我的输入数据变得更大(而且更复杂)，它变得不合理地慢了。输入数据约为150 mb。

那么，我的问题是如何加快这一进程？它看起来很适合像dplyr::summarize()这样的东西，甚至更多的处理器(尽管我担心内存的使用)。几乎可以肯定的是，for循环是解决这一问题的较慢方法之一。

我已经尝试了一些基于其他帖子的东西，比如确保在for循环中尽可能少地进行计算。在开始之前，我已经在输入数据中创建了日期间隔，但这似乎只会使输入更大。我也试过把我的成功和失败一分为二，但这似乎占用了更多的记忆而没有加快速度(显然，我的瓶颈不是比较两个数字)。

任何输入都将不胜感激！

Answer 1

我不太确定这是否完全理解了你的问题，但听起来你想要基于一个非马齐连接来计算，那里的设施完全匹配，站点在+/- 1内，日期在过去的一周内。

data.table和sqldf处理非赤道联接，而dplyr不处理。尽管如此，我认为通过复制数据(模拟相邻站点)并使用slider::slide_index_dbl作为滑动时间窗口，我们可以得到一个性能相当好的矢量化dplyr答案。

df %>%
  #make copies shifted site +/- 1
  uncount(3, .id = "version") %>%
  mutate(site_shifted = site + (version-2)) %>%
  
  arrange(date) %>%
  group_by(facility, site_shifted) %>%
  mutate(recent_success = slider::slide_index_dbl(
           outcome, date, ~sum(.x == 1), .before = lubridate::days(6)),
         recent_failure = slider::slide_index_dbl(
           outcome, date, ~sum(.x == 0), .before = lubridate::days(6))) %>%
  ungroup()