Question

我遇到了一段麻烦的代码。在此处稍作修改以用作简单的可复制示例：

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)
  }
}

在这个简单的示例中，它运行非常快，但是在实际应用中，它非常慢。它正在一个非常长的表中工作（但是即使这样，它也比在同一张表中工作的其他循环要慢得多）。

引起问题的代码是否特别有用（例如，润滑“％m-％”位）？

当然更好的是将其“矢量化”，因为我敢肯定它将运行得更快。使得困难的是对下一行（[row_idx + 1]位）的引用。有没有一种方法可以不使用（慢）循环？

谢谢。

Answer 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语句中的数字上，而您想保留它的日期，因此这就是我使用第二个突变的目的（尽管您可以一次完成所有操作）。

Answer 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

R

2 个答案: