Question

我正在根据与观察值i的关系，为每行按不同的子集过滤数据帧。具体来说，以观察为日期的观察是在观察数据i之前的特定天数。用for循环解决了它，但是没有找到使用purrr的实现。似乎逐行解决方案的帖子可以处理更简单的问题。

1。purrr有解决方案吗？
2.代码可以更有效吗？

我使用for循环和使用foreach软件包的并行计算解决了这个问题。
数据如下：
每行都是具有丰富信息的贷款（24万个观察值）。一些借款人得到经纪人的帮助。我在每个统计地理区域中计算每次观察前100天内的经纪贷款比例。（该比例将成为选择经纪人的选择偏见问题的工具）

# define a toy data ----
n <- 10000
df <- data.frame(id = 1:n,
                 broker = rbinom(n,1,0.4) ,
                 date = Sys.Date() + sample(n/100, n, replace = T) ,
                 area = sample(n/200, n, replace = T))
# going parallel ====
# load packages ----
library(tidyverse)
library(parallel)
library(doSNOW) # working on windows platform
library(foreach)
library(progress)
# define cluster ----
n_cores <- detectCores()
cl <- makeCluster(n_cores - 1)
registerDoSNOW(cl)
# define progress bar ----
pb <- txtProgressBar(min=1, max=n/100, style=3)
progress <- function(n) setTxtProgressBar(pb, n)
opts <- list(progress=progress)
# calculate IV variable - count how many times brokered loan appear in borower's statistical zone in the previous 100 days ----
t_par <- Sys.time() # record start time
# to make things more efficient, split the data to small chunks by statistic area 
a <- df %>% split(df$area) 
# nested forloop - the outer loop is parallel, the inner is serial. 
d <- foreach(j = seq_along(a),.packages = "tidyverse",.options.snow=opts) %dopar% {
   setTxtProgressBar(pb, j)
# empty temporary data frame   
   y <- data.frame(n_area_date = numeric(length(nrow(a[[j]]))), 
                   sum_broker = numeric(length(nrow(a[[j]]))),
                   p_broker = numeric(length(nrow(a[[j]]))))
# the inner loop   
   for(i in 1:nrow(a[[j]])){
      y[i,] <-  a[[j]] %>% filter( date < a[[j]][i, "date"],
                                   date >=  a[[j]][i, "date"] -100 ) %>%
         summarise( n_area_date = n(),
                    sum_broker = sum(broker),
                    p_broker = sum_broker / n_area_date)
   }
   cbind(a[[j]], y)
}
# turn result back into a data.frame
e <- map_df(d, rbind) 
(t_par <- Sys.time() - t_par)
# closing ----
stopCluster(cl)

在强大的计算机上获得的结果在时间上令人满意。
但是，代码不像我想要的那样可读。很多次，purrr确实使我能够编写更优雅，更高效的代码。 for循环可以保留这种情况吗？

Answer 1

这似乎是具有过滤条件的交叉联接。如果您喜欢data.table，请研究非等额联接。

这不是100％相同，不符合条件的ID不会结转。使用anti_join和bind_rows可以很容易地弥补这一点。

您的方法在计算机上花费了大约20秒钟。此方法大约需要1秒钟。

df%>%
  inner_join(df, by = 'area')%>%
  filter(date.y < date.x
         , date.y >= date.x - 100)%>%
  group_by(id.x, broker.x, date.x, area)%>%
  summarize(n_area_date = n()
            , sum_broker = sum(broker.y)
            , p_broker = sum_broker / n_area_date)

编辑：这是data.table解决方案。它完成了140毫秒-比原始速度快150倍，比dplyr non-equi join快6倍。

dt[, .(area, date, broker)
   ][dt[, .(area, date, l_date = date - 100, id, broker)]
     ,on = .(area = area
             , date < date
             , date >= l_date)
     , .(id, i.broker, i.date, i.area, x.broker)
     , allow.cartesian = T
     ][, .(n_area_date = .N
           , sum_broker = sum(x.broker)
           , p_broker = sum(x.broker) / .N)
       , by = .(id, i.broker, i.date, i.area)]

性能：

Unit: milliseconds
                expr        min         lq       mean     median         uq       max neval
 dplyr_non_equi_join   781.3828   802.5404   837.2033   810.3655   847.3634  1032.001    10
         dt_non_equi   121.0912   125.1777   137.7371   138.7682   141.9835   175.763    10
            original 19986.1950 20047.2880 20356.4174 20160.2137 20900.4362 21097.170    10

行式高效循环和purrr实现

1 个答案: