Question

我需要编写一个计算工作天数的函数（减去周末，以及其他当地银行假日的向量），但我遇到的问题更简单地说明了工作日数。

这是一个函数，它将给出两个日期之间的工作日数：

removeWeekends <- function(end, start){

  range <- as.Date(start:end, "1970-01-01")

  range<- range[sapply(range, function(x){
                                if(!chron::is.weekend(x)){
                                  return(TRUE)
                                }else{
                                  return(FALSE)
                                }
                              })]

  return(NROW(range))

}

当为每个参数指定一个日期时，哪个有效：

removeWeekends(as.Date("2018-05-08"), as.Date("2018-06-08"))
#[1] 24

但是当从数据帧给出两个向量时它会失败：

one <- as.Date("2017-01-01"):as.Date("2017-01-08")
two <- as.Date("2018-06-08"):as.Date("2018-06-15")
df <- data.frame(one, two)
removeWeekends(df$two, df$one)
#[1] 375
#Warning messages:
#1: In start:end : numerical expression has 8 elements: only the first used
#2: In start:end : numerical expression has 8 elements: only the first used

我也尝试过（我认为这种语法似乎无效）：

lapply(df, removeWeekends, df$two, df$one)
#Error in FUN(X[[i]], ...) : unused argument (17167:17174)

和

lapply(df[,c("two", "one")], removeWeekends)
#Error in as.Date(start:end, "1970-01-01") :   argument "start" is missing,
# with no default

我假设我误解了矢量化的概念。

我唯一知道的另一个想法是将函数嵌套在一个条件中以查看它是否是一个向量，然后调用它上面的apply函数，如果它虽然我不太确定如何我也会构建它。

Answer 1

您有几个选项可以在函数中支持vectorized参数。因为，您已经编写了函数，最简单的选择是使用Vectorize并将函数转换为支持向量化参数。另一个选项是修改你的函数并重新编写它以支持矢量化参数。

选项＃1：使用Vectorize

# Function will support vectorized argument with single statement
vremoveWeekends  <- Vectorize(removeWeekends)

# Try vremoveWeekends  function 
df$dayswithoutweekends <- vremoveWeekends(df$two, df$one)

选项＃2：重写函数以支持向量化参数。我更喜欢这个选项，因为OP有两个参数，预计长度相同。因此，如果我们重写它，将更容易对参数执行错误检查。

# Modified function 
removeWeekendsNew <- function(end, start){
  if(length(start) != length(end)){
    return(0L)  #Error condition
  }
  result <- rep(0L, length(start)) #store the result for each row

  #One can use mapply instead of for-loop. But for-loop will be faster
  for(i in seq_along(start)){     
    range      = seq(start[i], end[i], by="day")
    result[i]  = length(range[!chron::is.weekend(range)])
  }

  return(result)
}

#Use new function:
df$dayswithoutweekends <- removeWeekendsNew(df$two, df$one)

结果：上述两个选项都相同。

df
#          one        two dayswithoutweekends
# 1 2017-01-01 2018-06-08                 375
# 2 2017-01-02 2018-06-09                 375
# 3 2017-01-03 2018-06-10                 374
# 4 2017-01-04 2018-06-11                 374
# 5 2017-01-05 2018-06-12                 374
# 6 2017-01-06 2018-06-13                 374
# 7 2017-01-07 2018-06-14                 374
# 8 2017-01-08 2018-06-15                 375

数据：

one <- seq(as.Date("2017-01-01"),as.Date("2017-01-08"), by="day") two <- seq(as.Date("2018-06-08"),as.Date("2018-06-15"), by="day") df <- data.frame(one, two) df # one two # 1 2017-01-01 2018-06-08 # 2 2017-01-02 2018-06-09 # 3 2017-01-03 2018-06-10 # 4 2017-01-04 2018-06-11 # 5 2017-01-05 2018-06-12 # 6 2017-01-06 2018-06-13 # 7 2017-01-07 2018-06-14 # 8 2017-01-08 2018-06-15

Answer 2

如果你想完全向量化这个，你需要开箱即用。 chron::is.weekend所做的只是检查在某个时间段内星期日和星期六的天数。我们可以用矢量化方式自己计算，因为每周有两个周末，唯一棘手的部分是左边的。

我写了以下函数来实现这一点，虽然我确信它可以改进

frw <- function(two, one) {

  diff_d <- two - one ## difference in days
  l_d <- (two + 4L) %% 7L + 1L ## last day of the remainder 
  weeks <- diff_d %/% 7L ## number of weeks between
  days <- diff_d %% 7L ## days left

  ## calculate how many work days left
  diff_d - 
    ((weeks * 2L) + ((l_d - days < 1) + ((l_d - days < 2) - (l_d == 1L))) +
    (l_d %in% c(1L, 7L))) + 1L

}

您可以按如下方式运行

frw(two, one)
## [1] 375 375 374 374 374 374 374 375

它远远快于mapply版本（几乎是即时的），对更大的数据进行了一些基准测试：

one <- as.Date("2017-01-01"):as.Date("2030-01-08")
two <- as.Date("2017-05-01"):as.Date("2030-05-08")
df <- data.frame(one, two)

system.time(res_mapply <- vremoveWeekends(df$two, df$one)) # taken from the other answer
#  user  system elapsed 
# 76.46    0.06   77.25 

system.time(res_vectorized <- frw(df$two, df$one))
# user  system elapsed 
#    0       0       0

identical(res_mapply, res_vectorized)
# [1] TRUE

R~用户定义函数的矢量化

2 个答案: