加速R函数获取日期后n个工作日的日期答案

【问题标题】：Speed up R function to get the date of n working days after a date加速R函数获取日期后n个工作日的日期
【发布时间】：2021-04-25 22:00:34
【问题描述】：

我有以下函数n_bus_day_after，它在跳过银行假日和周六/周日的某个日期之后返回第 n 个日期。银行假期被定义为函数的一部分。它工作正常，但速度相当慢。你能给我一些想法如何加快这个功能吗？

n_bus_day_after <- function(.date, .n = 1){
  
  .n <- .n - 1
  following_date <- .date + days(1)
  
  df <- data.frame(following_date) %>%
    mutate(
      following_date = case_when(
        wday(following_date, week_start = 1) %in% c(6, 7) ~ NA_Date_, # weekend days
        # czech bank holidays defined as the day of the month and month number
        day(following_date) ==  1 & month(following_date) ==  1 |
          day(following_date) ==  1 & month(following_date) ==  5 |
          day(following_date) ==  8 & month(following_date) ==  5 |
          day(following_date) ==  5 & month(following_date) ==  7 |
          day(following_date) ==  6 & month(following_date) ==  7 |
          day(following_date) == 28 & month(following_date) ==  9 |
          day(following_date) == 28 & month(following_date) == 10 |
          day(following_date) == 17 & month(following_date) == 11 |
          day(following_date) == 24 & month(following_date) == 12 |
          day(following_date) == 25 & month(following_date) == 12 |
          day(following_date) == 26 & month(following_date) == 12 |
          # easter Friday and Monday defined using timeDate::Easter function
          following_date == as.Date(Easter(year(following_date), shift = -2)) |
          following_date == as.Date(Easter(year(following_date), shift = 1)) ~ NA_Date_,
        T ~ following_date
      )
    )
  
  if(is.na(df$following_date)){
    Recall(following_date, .n + 1) # the following day is a bank holiday/Saturday/Sunday
  }
  else if(!is.na(df$following_date) & .n > 0){
    Recall(following_date, .n = .n) # the following day is a work day, but need to add .n additional days
  }
  else if(!is.na(df$following_date) & .n == 0){
    return(df$following_date) # the following day is a work day, and there are no additional days to add
  }
  else{
    print("unexpected!!!!")
  }
  
}

library(lubridate)
library(timeDate)
library(dplyr)

# an example function call
data.frame(a = today() + 0:1000) %>%
  mutate(
    b = as_date(map_dbl(a, ~n_bus_day_after(.x)))
  )

【问题讨论】：

如果你想要速度，不要使用递归，也不要不必要地使用数据帧。在count <- 0; while (count < .n) { date <- date + 1; if (is.bus.day(date)) count <- count + 1 } 这样的循环中直接处理日期向量。
@user2554330 如果我避免递归和 data.frames，加速会有多重要？
您必须尝试并测量，但函数调用和数据帧索引在 R 中都是非常昂贵的操作。
我只是比较了两个函数，将n 加到x：一个递归加1，另一个通过循环加1 n 次来实现。当n = 10 时，循环快了大约 8 倍。当n = 100 时，它快了大约 25 倍。

标签： r performance date calendar

【解决方案1】：

这是使用Rcpp 的可能加速。

#include <Rcpp.h>
#include <math.h>
using namespace Rcpp;
// [[Rcpp::plugins("cpp11")]]

// [[Rcpp::export]]
Date rcpp_gauss_easter(int Y){
  
  float A, B, C, P, Q, M, N, D, E;
  Date dt_out;
  
  // All calculations done
  // on the basis of
  // Gauss Easter Algorithm
  A = Y % 19;
  B = Y % 4;
  C = Y % 7;
  P = (float)floor(Y / 100);
  Q = (float)floor((13 + 8 * P) / 25);
  M = (int)(15 - Q + P - P / 4) % 30;
  N = (int)(4 + P - P / 4) % 7;
  D = (int)(19 * A + M) % 30;
  E = (int)(2 * B + 4 * C + 6 * D + N) % 7;
  int days = (int)(22 + D + E);
  
  // A corner case,
  // when D is 29
  if ((D == 29) && (E == 6)) {
    dt_out = Date(std::to_string(Y) + "-04-19");
  }
  // Another corner case,
  // when D is 28
  else if ((D == 28) && (E == 6)) {
    dt_out = Date(std::to_string(Y) + "-04-18");
  }
  else {
    // If days > 31, move to April
    // April = 4th Month
    if (days > 31) {
      dt_out = Date(std::to_string(Y) + "-04-" + std::to_string(days - 31));
    }
    else {
      // Otherwise, stay on March
      // March = 3rd Month
      dt_out = Date(std::to_string(Y) + "-03-" + std::to_string(days));
    }
  }
  return(dt_out);
}

// [[Rcpp::export]]
DateVector rcpp_add_n_bus_days(DateVector v1, int n_days) {
  // add one day
  // check if saturday or sunday or bank holiday
  // if not, return the date
  // if bank holiday, go on adding additional days

  DateVector v2(v1.length());
  Date s1;
  bool is_h;
  int n_days_int;


  for (int i = 0; i < v1.length(); i++) {

    n_days_int = n_days;
    s1 = v1[i];

    do {
      s1 = s1 + 1; // -1 needed if also going backward
      n_days_int = n_days_int - 1; // change sign here
      is_h =
        s1.getWeekday() == 1 or
        s1.getWeekday() == 7 or
        (s1.getDay() == 1 and s1.getMonth() == 1) or
        (s1.getDay() == 1 and s1.getMonth() == 5) or
        (s1.getDay() == 8 and s1.getMonth() == 5) or
        (s1.getDay() == 5 and s1.getMonth() == 7) or
        (s1.getDay() == 6 and s1.getMonth() == 7) or
        (s1.getDay() == 28 and s1.getMonth() == 9) or
        (s1.getDay() == 28 and s1.getMonth() == 10) or
        (s1.getDay() == 17 and s1.getMonth() == 11) or
        (s1.getDay() == 24 and s1.getMonth() == 12) or
        (s1.getDay() == 25 and s1.getMonth() == 12) or
        (s1.getDay() == 26 and s1.getMonth() == 12) or
        (rcpp_gauss_easter(s1.getYear()) + 1) == s1 or
        (rcpp_gauss_easter(s1.getYear()) + -2) == s1;


      if (is_h == true) {
        n_days_int = n_days_int + 1; // change sign here
      }
      else {

      }


    } while (n_days_int > 0);

    v2[i] = s1;
  }


  return(v2);
}


/*** R

rcpp_add_n_bus_days(as.Date("2022-01-01") + 0:2000, 1)

*/

【讨论】：