更快的 For 循环？

Question

我有这段代码，我在其中循环了 250,000 个项目。 以下是代码中的步骤： 1. 给定产品的子集数据 2. 将数据与月份数据框合并（左）。 3. 用该特定产品名称替换空产品名称 4. 将销售额的 NA 值替换为 0

这是两个产品的示例数据集。 数据：

data2 <- data.frame(product_no = c("A", "A", "A", "B","B","B"), 
                           sales = c(200, 130, 221, 310,109, 98), month = c(1, 4, 5, 8,1, 12), stringsAsFactors=FALSE)

month_unique <- as.data.frame(seq(1,12, by=1))
colnames(month_unique)[colnames(month_unique)=="seq(1, 12, by = 1)"] <- "month"

代码：

unique_product <- unique(data2$product_no)
data3 <- data.frame()

process_time <- Sys.time()
for (i in 1:length(unique_product)){
  step1 <- subset(data2, product_no==unique_product[i])
  step2 <- merge(month_unique,step1, by="month", all.x = TRUE)
  step2$product_no <- unique_product[i]
  step2[is.na(step2)] <- 0
  data3 <- rbind(data3, step2)
}
Sys.time() - process_time

预期结果：

data3

有更快的方法吗？

谢谢。

Answer 1

您可以使用 expand.grid 创建月份和 product_no 的所有组合，然后将 NA 替换为 0。

library(tidyr)

combinations <- expand.grid(month = 1:12,
                            product_no = unique(data2$product_no),
                            stringsAsFactors = FALSE)

result <- merge(combinations, data2, all.x = TRUE)
result <- replace_na(result, list(sales = 0))

请注意，我使用的是 tidyr 包中的 replace_na 函数，但您也可以这样做

result$sales[is.na(result$sales)] <- 0

你也可以在 dplyr 中使用left_join 函数，它通常比merge 更快。在 dplyr 中，函数通常（尽管不一定）与 %>% 链接在一起：

library(dplyr)

result <- combinations %>%
    left_join(data2) %>%
    replace_na(list(sales = 0))

Answer 2

只是因为我很好奇，并且因为你说你有很多产品要迭代，所以我使用 for 循环运行了这个，使用 lapply，使用 David 的代码，然后并行运行它（在 4 个内核上）。这是我想出的：

> library(dplyr)
> library(tidyr)
> library(parallel)
> 
> data2 <- data.frame(productId = c("A", "A", "A", "B","B","B"), 
+                     sales = c(200, 130, 221, 310,109, 98), 
+                     month = c(1, 4, 5, 8,1, 12), 
+                     stringsAsFactors=FALSE)
> data2 <- do.call("rbind", lapply(1:1000, function(i) data2))
> data2$productId <- rep(1:2000, each = 3)
> 
> month_unique <- as.data.frame(seq(1,12, by=1))
> colnames(month_unique)[colnames(month_unique)=="seq(1, 12, by = 1)"] <- "month"
> 
> 
> #* For running the original code
> unique_product <- unique(data2$productId)
> data3 <- data.frame()
> 
> 
> system.time({
+   for (i in 1:length(unique_product)){
+     step1 <- subset(data2, productId==unique_product[i])
+     step2 <- merge(month_unique,step1, by="month", all.x = TRUE)
+     step2$productId <- unique_product[i]
+     step2[is.na(step2)] <- 0
+     data3 <- rbind(data3, step2)
+   }
+ })
   user  system elapsed 
   4.79    0.01    4.81 
> 
> 
> #* Function that is equivalent to the for loop
> dataFn <- function(up, data2, month_unique){
+   step1 <- subset(data2, productId==up)
+   step2 <- merge(month_unique,step1, by="month", all.x = TRUE)
+   step2$product_no <- up
+   step2[is.na(step2)] <- 0
+   step2
+ }
> 
> system.time({
+   data3 <- do.call("rbind", 
+                    lapply(unique_product, dataFn, data2, month_unique))
+ })
   user  system elapsed 
    2.1     0.0     2.1 
>   
> #David's code
> system.time({
+   combinations <- expand.grid(month = 1:12,
+                               productId = unique(data2$productId),
+                               stringsAsFactors = FALSE)
+   result <- left_join(combinations, data2, 
+                       by = c("month" = "month",
+                              "productId" = "productId"))
+   result <- replace_na(result, list(sales = 0))
+ })
   user  system elapsed 
      0       0       0 
> 
> # run in parallel
> system.time({
+   cl <- makeCluster(4)
+     clusterExport(cl, "dataFn")
+     clusterExport(cl, "data2")
+     clusterExport(cl, "month_unique")
+     data3_parallel <- 
+       do.call("rbind",
+             parLapply(cl, unique_product, dataFn, data2, month_unique))
+     stopCluster(cl)
+ })
   user  system elapsed 
   0.27    0.03    1.99 
>

所以使用 apply 函数似乎可以提高速度；并行化似乎没有什么好处（也许任务的大小太小了？），而且 David 的代码快如闪电。