R中的非常慢的循环答案

【问题标题】：Very Slow Loop in RR中的非常慢的循环
【发布时间】：2019-12-16 15:35:36
【问题描述】：

我有一段代码遇到了问题。此处稍作修改，作为一个简单的可重现示例：

df <- data.frame(
  "ID" = c(1, 2, 3, 4, 5, 6),
  "max_ID" = c(6, 6, 6, 6, 6, 6),
  "start_date" = as.Date(c("2015-01-01", "2016-01-01", "2017-01-01", "2018-01-01", "2019-01-01", "2020-01-01")),
  "end_date_1" = as.Date(c("2015-12-31", "2016-12-31", "2019-12-31", "2019-12-31", "2019-12-31", "2019-12-31")),
  "end_date_2" = as.Date(c(NA, NA, NA, NA, NA, NA))
)

num_rows <- nrow(df) #6

for(row_idx in 1:num_rows)
{
  if(df$ID[row_idx] == df$max_ID[row_idx])
  {
    df$end_date_2[row_idx] <- df$end_date_1[row_idx]
  }
  else
  {
    df$end_date_2[row_idx] <- df$start_date[row_idx + 1] %m-% days(1)
  }
}

在这个简单的示例中，它运行得非常快，但在实际应用中却非常慢。它在一个很长的表中运行（但即便如此，它也比在同一个表中运行的其他一些循环慢得多）。

导致问题的代码有什么特别的地方吗（例如 lubridate "%m-%" 位）？

当然更好的是“矢量化”它，因为我确信它会运行得更快。使它变得困难的是对下一行的引用（[row_idx + 1] 位）。有没有办法在不使用（慢）循环的情况下做到这一点？

谢谢。

【问题讨论】：

这将引用以下行 c(tail(df$start_date, -1), NA)。有一些包将其作为函数提供（例如，data.table::shift 和 afaik，dplyr 中也有一些东西）。
谢谢。我经常使用 dplyr，所以也许我应该查看该软件包的文档并看看我能找到什么......

标签： r loops

【解决方案1】：

我认为您不需要 for 循环，dplyr 包更容易（读写）

df <- df %>% mutate(end_date_2 = ifelse(ID == max_ID, end_date_1 , lead(start_date) %m-% days(1)),
                    end_date_2 = as.Date(end_date_2, origin="1970-01-01" ))

我使用引线替换您的 [row_idx + 1] 部分。唯一的问题（对我而言）是 end_date2 在 ifelse 语句中被设置为数字，而您希望将其保留为日期，所以这就是我使用第二个突变的目的（尽管您可能一次完成所有操作）。

【讨论】：

啊，好的，dplyr 中有“领先”和“滞后”...我会调查的。谢谢。

【解决方案2】：

除了已经在使用的 lubridate 包之外，您不需要循环或外部库。只需使用内置的which.max 函数

require(lubridate)

df <- data.frame(
  "ID" = c(1, 2, 3, 4, 5, 6),
  "max_ID" = c(6, 6, 6, 6, 6, 6),
  "start_date" = as.Date(c("2015-01-01", "2016-01-01", "2017-01-01", "2018-01-01", "2019-01-01", "2020-01-01")),
  "end_date_1" = as.Date(c("2015-12-31", "2016-12-31", "2019-12-31", "2019-12-31", "2019-12-31", "2019-12-31")),
  "end_date_2" = as.Date(c(NA, NA, NA, NA, NA, NA))
)

simple_method <- function(df)
{
  df$end_date_2[-num_rows] <- df$start_date[-1] - days(1)
  df$end_date_2[which.max(df$ID)] <- df$end_date_1[which.max(df$ID)]
  return(df)
}

original_method <- function(df)
{
  num_rows <- nrow(df)
  for(row_idx in 1:num_rows)
  {
    if(df$ID[row_idx] == df$max_ID[row_idx])
    {
      df$end_date_2[row_idx] <- df$end_date_1[row_idx]
    }
    else
    {
      df$end_date_2[row_idx] <- df$start_date[row_idx + 1] %m-% days(1)
    }
  }
  return(df)
}

它给出了以下基准测试结果：

> microbenchmark(original_method(df), simple_method(df))
Unit: milliseconds
                expr       min       lq      mean   median        uq      max neval
 original_method(df) 13.977496 14.18948 14.879323 14.26715 14.577343 26.44665   100
   simple_method(df)  2.562268  2.59546  2.966167  2.61582  2.722923 10.52761   100

【讨论】：