эффективность в построчном цикле и реализация с purrr

Question

Я фильтрую фрейм данных по разным подмножествам для каждой строки, основываясь на отношении к наблюдению i.в частности, принимая наблюдения о том, что это даты за определенное количество дней до данных наблюдения, т.е.Решил это с помощью цикла for, но не нашел реализации с purrr.Кажется, что посты с построчными решениями решают более простые проблемы.

1. Есть ли какое-нибудь решение с purrr?
2. Может ли код быть более эффективным?

я решил проблему с циклом for и параллельными вычислениями с использованием пакета foreach.
данные выглядят следующим образом:
каждая строка является заимствованием с богатой информацией (240 тыс. Наблюдений).Некоторые заемщики получают помощь брокера.Я рассчитываю в каждой статистической географической зоне долю брокерских ссуд за 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% идентично, идентификаторы, которые не имеют соответствующих критериев, не переносятся Это легко исправить с помощью 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 раз быстрее, чем оригинал, и примерно в 6 раз быстрее, чем соединение dplyr без равенства.

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