Я написал эту функцию, которую я использую все время:

# Give the previous day, or Friday if the previous day is Saturday or Sunday.
previous_business_date_if_weekend = function(my_date) {
    if (length(my_date) == 1) {
        if (weekdays(my_date) == "Sunday") { my_date = lubridate::as_date(my_date) - 2 }
        if (weekdays(my_date) == "Saturday") { my_date = lubridate::as_date(my_date) - 1 }
        return(lubridate::as_date(my_date))
    } else if (length(my_date) > 1) {
        my_date = lubridate::as_date(sapply(my_date, previous_business_date_if_weekend))
        return(my_date)
    }
}

Проблемы возникают, когда я применяю его к столбцу даты в фрейме данных с тысячами строк. Это смехотворно медленно. Есть мысли, почему?

8
lebelinoz 5 Сен 2017 в 06:47

3 ответа

Лучший ответ

Вы перебираете все строки. Не удивительно, что это медленно. Вместо этого вы можете сделать одну операцию замены, где вы берете фиксированную разницу от каждой даты: 0 для M-F, -1 для сб и -2 для вс.

# 'big' sample data
x <- Sys.Date() + 0:100000

bizdays <- function(x) x - match(weekdays(x), c("Saturday","Sunday"), nomatch=0)

# since `weekdays()` is locale-specific, you could also be defensive and do:
bizdays <- function(x) x - match(format(x, "%w"), c("6","0"), nomatch=0)

system.time(bizdays(x))
#   user  system elapsed 
#   0.36    0.00    0.35 

system.time(previous_business_date_if_weekend(x))
#   user  system elapsed 
#  45.45    0.00   45.57 

identical(bizdays(x), previous_business_date_if_weekend(x))
#[1] TRUE
9
thelatemail 5 Сен 2017 в 06:22

Просто чтобы добавить еще одну возможность: реализация на чистом R находится в datetimetutils пакет (из которых я автор). Функция previous_businessday преобразуется в POSIXlt для извлечения дня недели. (Код сравнивает результаты функции с функцией bizdays, предложенной thelatemail.)

library("datetimeutils")

x <- Sys.Date() + 0:100000

system.time(bizdays(x))
## user  system elapsed 
## 0.25    0.00    0.25 

system.time(previous_businessday(x, shift = 0))
## user  system elapsed 
## 0.03    0.00    0.03 

identical(bizdays(x), previous_businessday(x, shift = 0))
## TRUE

Немного упрощенная версия previous_businessday будет выглядеть следующим образом; предполагается, что x принадлежит к классу Date.

previous_bd <- function(x) {
    tmp <- as.POSIXlt(x)
    tmpi <- tmp$wday == 6L
    x[tmpi] <- x[tmpi] - 1L
    tmpi <- tmp$wday == 0L
    x[tmpi] <- x[tmpi] - 2L
    x
}

system.time(previous_bd(x))
## user  system elapsed 
## 0.03    0.00    0.03 


identical(bizdays(x), previous_bd(x))
## TRUE
4
Enrico Schumann 5 Сен 2017 в 06:53

Lubridate немного медленный в моем опыте. Я предлагаю работать с data.table и iDate.

Примерно так должно быть довольно надежно:

library(data.table)

#Make data.table of dates in string format
x = data.table(date = format(Sys.Date() + 0:100000,format='%d/%m/%Y'))

#Convert to IDate (by reference)
set(x, j = "date", value = as.IDate(strptime(x[,date], "%d/%m/%Y")))

#Day zero was a Thursday
originDate = as.IDate(strptime("01/01/1970", "%d/%m/%Y"))
as.integer(originDate)
#[1] 0
weekdays(originDate)
#[1] "Thursday"

previous_business_date_if_weekend_dt = function(x) {

  #Adjust dates so that Sat is 1, Sun is 2, and subtract by reference
  x[,adjustedDate := date]
  x[(as.integer(x[,date]-2) %% 7 + 1)<=2, adjustedDate := adjustedDate - (as.integer(date-2) %% 7 + 1)]

}

bizdays <- function(x) x - match(weekdays(x), c("Saturday","Sunday"), nomatch=0)

system.time(bizdays(y))
# user  system elapsed 
# 0.22    0.00    0.22 

system.time(previous_business_date_if_weekend_dt(x))
# user  system elapsed 
# 0       0       0 

Также обратите внимание, что часть, которая занимает больше всего времени в этом решении, вероятно, извлекает даты из строки, вы можете переформатировать их в целочисленный формат, если вас это беспокоит.

5
thelatemail 5 Сен 2017 в 06:01