Calculate the number of weekdays between 2 dates in R

前端 未结 6 990
北海茫月
北海茫月 2020-11-29 02:59

I\'m trying to write an R function to calculate the number of weekdays between two dates. For example, Nweekdays(\'01/30/2011\',\'02/04/2011\') would equal 5.

Simila

相关标签:
6条回答
  • 2020-11-29 03:31

    These modified functions takes into account of date differences of either positive or negative, whereas the accepted solution accounts for positive date difference.

    library("dplyr")
    
    e2 <- structure(list(date.pr = structure(c(16524, 16524, 16524, 16524, 16524, 16524, 16524, 16524, 16524, 16524, 16545, 5974), class = "Date"), 
                         date.po = structure(c(16524, 16525, 16526, 16527, 16528, 16529, 16530, 16531, 16538, 16545, 16524, 15974), class = "Date")), 
                    .Names = c("date.1", "date.2"), class = c("tbl_df", "data.frame"), row.names = c(NA, -12L))
    

    1. Locale Dependent Solution: Nweekdays() function is adapted from @J. Won.'s solution. It works for locale = "English_United States.1252"

    Nweekdays <- Vectorize(
      function(a, b) 
      {
        ifelse(a < b, 
               return(sum(!weekdays(seq(a, b, "days")) %in% c("Saturday", "Sunday")) - 1), 
               return(sum(!weekdays(seq(b, a, "days")) %in% c("Saturday", "Sunday")) - 1))
      })
    

    a. English Locale

    > Sys.setlocale(category="LC_ALL", locale = "English_United States.1252")
    [1] "LC_COLLATE=English_United States.1252;LC_CTYPE=English_United States.1252;LC_MONETARY=English_United States.1252;LC_NUMERIC=C;LC_TIME=English_United States.1252"
    
    > Sys.getlocale()
    [1] "LC_COLLATE=English_United States.1252;LC_CTYPE=English_United States.1252;LC_MONETARY=English_United States.1252;LC_NUMERIC=C;LC_TIME=English_United States.1252"
    
    > e2 %>%
        mutate(wkd1 = format(date.1, "%A"),
               wkd2 = format(date.2, "%A"),
               ndays_with_wkends = ifelse((date.2 > date.1), (date.2 - date.1), (date.1 - date.2)), 
               ndays_no_wkends = Nweekdays(date.1, date.2))
    
    Source: local data frame [12 x 6]
    
           date.1     date.2   wkd1      wkd2 ndays_with_wkends ndays_no_wkends
           (date)     (date)  (chr)     (chr)             (dbl)           (dbl)
    1  2015-03-30 2015-03-30 Monday    Monday                 0               0
    2  2015-03-30 2015-03-31 Monday   Tuesday                 1               1
    3  2015-03-30 2015-04-01 Monday Wednesday                 2               2
    4  2015-03-30 2015-04-02 Monday  Thursday                 3               3
    5  2015-03-30 2015-04-03 Monday    Friday                 4               4
    6  2015-03-30 2015-04-04 Monday  Saturday                 5               4
    7  2015-03-30 2015-04-05 Monday    Sunday                 6               4
    8  2015-03-30 2015-04-06 Monday    Monday                 7               5
    9  2015-03-30 2015-04-13 Monday    Monday                14              10
    10 2015-03-30 2015-04-20 Monday    Monday                21              15
    11 2015-04-20 2015-03-30 Monday    Monday                21              15
    12 1986-05-11 2013-09-26 Sunday  Thursday             10000            7143
    

    b. Chinese Locale

    > Sys.setlocale(category="LC_ALL", locale = "chinese")
    [1] "LC_COLLATE=Chinese (Simplified)_People's Republic of China.936;LC_CTYPE=Chinese (Simplified)_People's Republic of China.936;LC_MONETARY=Chinese (Simplified)_People's Republic of China.936;LC_NUMERIC=C;LC_TIME=Chinese (Simplified)_People's Republic of China.936"
    
    > Sys.getlocale()
    [1] "LC_COLLATE=Chinese (Simplified)_People's Republic of China.936;LC_CTYPE=Chinese (Simplified)_People's Republic of China.936;LC_MONETARY=Chinese (Simplified)_People's Republic of China.936;LC_NUMERIC=C;LC_TIME=Chinese (Simplified)_People's Republic of China.936"
    
    > e2 %>%
        mutate(wkd1 = format(date.1, "%A"),
               wkd2 = format(date.2, "%A"),
               ndays_with_wkends = ifelse((date.2 > date.1), (date.2 - date.1), (date.1 - date.2)), 
               ndays_no_wkends = Nweekdays(date.1, date.2))
    
    Source: local data frame [12 x 6]
    
           date.1     date.2   wkd1   wkd2 ndays_with_wkends ndays_no_wkends
           (date)     (date)  (chr)  (chr)             (dbl)           (dbl)
    1  2015-03-30 2015-03-30 ÐÇÆÚÒ» ÐÇÆÚÒ»                 0               0
    2  2015-03-30 2015-03-31 ÐÇÆÚÒ» ÐÇÆÚ¶þ                 1               1
    3  2015-03-30 2015-04-01 ÐÇÆÚÒ» ÐÇÆÚÈý                 2               2
    4  2015-03-30 2015-04-02 ÐÇÆÚÒ» ÐÇÆÚËÄ                 3               3
    5  2015-03-30 2015-04-03 ÐÇÆÚÒ» ÐÇÆÚÎå                 4               4
    6  2015-03-30 2015-04-04 ÐÇÆÚÒ» ÐÇÆÚÁù                 5               5
    7  2015-03-30 2015-04-05 ÐÇÆÚÒ» ÐÇÆÚÈÕ                 6               6
    8  2015-03-30 2015-04-06 ÐÇÆÚÒ» ÐÇÆÚÒ»                 7               7
    9  2015-03-30 2015-04-13 ÐÇÆÚÒ» ÐÇÆÚÒ»                14              14
    10 2015-03-30 2015-04-20 ÐÇÆÚÒ» ÐÇÆÚÒ»                21              21
    11 2015-04-20 2015-03-30 ÐÇÆÚÒ» ÐÇÆÚÒ»                21              21
    12 1986-05-11 2013-09-26 ÐÇÆÚÈÕ ÐÇÆÚËÄ             10000           10000
    

    2. Locale Independent Solution: Nweekdays() function is adapted from @Sacha Epskamp's solution. It works for all locales, however @Sacha Epskamp used c(0,6) to weed out the weekends, which is different from this solution which uses c(2,3) to extract out weekends.

    Nweekdays <- Vectorize(
      function(a, b) {
               return(sum(!(((as.numeric(b:a)) %% 7) %in% c(2,3))) - 1) # 2: Saturday and 3: Sunday
      })
    

    a. English Locale

    > Sys.setlocale(category="LC_ALL", locale = "English_United States.1252")
    [1] "LC_COLLATE=English_United States.1252;LC_CTYPE=English_United States.1252;LC_MONETARY=English_United States.1252;LC_NUMERIC=C;LC_TIME=English_United States.1252"
    
    > Sys.getlocale()
    [1] "LC_COLLATE=English_United States.1252;LC_CTYPE=English_United States.1252;LC_MONETARY=English_United States.1252;LC_NUMERIC=C;LC_TIME=English_United States.1252"
    
    > e2 %>%
        mutate(wkd1 = format(date.1, "%A"),
               wkd2 = format(date.2, "%A"),
               ndays_with_wkends = ifelse((date.2 > date.1), (date.2 - date.1), (date.1 - date.2)), 
               ndays_no_wkends = Nweekdays(date.1, date.2))
    
    Source: local data frame [12 x 6]
    
           date.1     date.2   wkd1      wkd2 ndays_with_wkends ndays_no_wkends
           (date)     (date)  (chr)     (chr)             (dbl)           (dbl)
    1  2015-03-30 2015-03-30 Monday    Monday                 0               0
    2  2015-03-30 2015-03-31 Monday   Tuesday                 1               1
    3  2015-03-30 2015-04-01 Monday Wednesday                 2               2
    4  2015-03-30 2015-04-02 Monday  Thursday                 3               3
    5  2015-03-30 2015-04-03 Monday    Friday                 4               4
    6  2015-03-30 2015-04-04 Monday  Saturday                 5               4
    7  2015-03-30 2015-04-05 Monday    Sunday                 6               4
    8  2015-03-30 2015-04-06 Monday    Monday                 7               5
    9  2015-03-30 2015-04-13 Monday    Monday                14              10
    10 2015-03-30 2015-04-20 Monday    Monday                21              15
    11 2015-04-20 2015-03-30 Monday    Monday                21              15
    12 1986-05-11 2013-09-26 Sunday  Thursday             10000            7143
    

    b. Chinese Locale

    > Sys.setlocale(category="LC_ALL", locale = "chinese")
    [1] "LC_COLLATE=Chinese (Simplified)_People's Republic of China.936;LC_CTYPE=Chinese (Simplified)_People's Republic of China.936;LC_MONETARY=Chinese (Simplified)_People's Republic of China.936;LC_NUMERIC=C;LC_TIME=Chinese (Simplified)_People's Republic of China.936"
    
    > Sys.getlocale()
    [1] "LC_COLLATE=Chinese (Simplified)_People's Republic of China.936;LC_CTYPE=Chinese (Simplified)_People's Republic of China.936;LC_MONETARY=Chinese (Simplified)_People's Republic of China.936;LC_NUMERIC=C;LC_TIME=Chinese (Simplified)_People's Republic of China.936"
    
    > e2 %>%
        mutate(wkd1 = format(date.1, "%A"),
               wkd2 = format(date.2, "%A"),
               ndays_with_wkends = ifelse((date.2 > date.1), (date.2 - date.1), (date.1 - date.2)), 
               ndays_no_wkends = Nweekdays(date.1, date.2))
    
    Source: local data frame [12 x 6]
    
           date.1     date.2   wkd1   wkd2 ndays_with_wkends ndays_no_wkends
           (date)     (date)  (chr)  (chr)             (dbl)           (dbl)
    1  2015-03-30 2015-03-30 ÐÇÆÚÒ» ÐÇÆÚÒ»                 0               0
    2  2015-03-30 2015-03-31 ÐÇÆÚÒ» ÐÇÆÚ¶þ                 1               1
    3  2015-03-30 2015-04-01 ÐÇÆÚÒ» ÐÇÆÚÈý                 2               2
    4  2015-03-30 2015-04-02 ÐÇÆÚÒ» ÐÇÆÚËÄ                 3               3
    5  2015-03-30 2015-04-03 ÐÇÆÚÒ» ÐÇÆÚÎå                 4               4
    6  2015-03-30 2015-04-04 ÐÇÆÚÒ» ÐÇÆÚÁù                 5               4
    7  2015-03-30 2015-04-05 ÐÇÆÚÒ» ÐÇÆÚÈÕ                 6               4
    8  2015-03-30 2015-04-06 ÐÇÆÚÒ» ÐÇÆÚÒ»                 7               5
    9  2015-03-30 2015-04-13 ÐÇÆÚÒ» ÐÇÆÚÒ»                14              10
    10 2015-03-30 2015-04-20 ÐÇÆÚÒ» ÐÇÆÚÒ»                21              15
    11 2015-04-20 2015-03-30 ÐÇÆÚÒ» ÐÇÆÚÒ»                21              15
    12 1986-05-11 2013-09-26 ÐÇÆÚÈÕ ÐÇÆÚËÄ             10000            7143
    
    0 讨论(0)
  • 2020-11-29 03:43

    I wrote this one, but the other answer is better :)

    Nweekdays <- function(a,b)
    {
    dates <- as.Date(as.Date(a,"%m/%d/%y",origin="1900-01-01"):as.Date(b,"%m/%d/%y",origin="1900-01-01"),origin="1900-01-01")
    days <- format(dates,"%w")[c(-1,-length(dates))]
    return(sum(!days%in%c(0,6)))
    }
    
    Nweekdays('01/30/2011','02/04/2011')
    [1] 3
    

    EDIT: Calculates how many weekdays are in between of the two specified days.

    Edit:

    Taking J. Winchesters advice, the function could be streamlined as:

        Nweekdays <- function(a,b)
    {
    dates <- as.numeric((as.Date(a,"%m/%d/%y")):(as.Date(b,"%m/%d/%y")))
    dates <- dates[- c(1,length(dates))]
    return(sum(!dates%%7%in%c(0,6)))
    }
    

    Some results:

    > Nweekdays('01/30/2011','02/04/2011')
    [1] 4
    > 
    > Nweekdays('01/30/2011','01/30/2011')
    [1] 0
    > 
    > Nweekdays('01/30/2011','01/25/2011')
    [1] 3
    

    Note that this is locale independent. (On that topic, how do I change locale anyway?)

    0 讨论(0)
  • 2020-11-29 03:49

    J. Win.'s answer is good, but can be quite a bit faster with lubridate.

    require(lubridate)
    count_weekdays<- Vectorize(function(from,to) sum(!wday(seq(from, to, "days")) %in% c(1,7)))
    
    

    Here are time results from my machine:

    > v1<- seq(from = ymd(19000101), to = ymd(20000101), by='month')
    > v2<- seq(from = ymd(20000101), to = ymd(21000101), by='month')
    
    > require(tictoc)
    
    > tic(); out<- Nweekdays(v1,v2); toc();
    293.06 sec elapsed
    
    > tic(); out<- count_weekdays(v1,v2); toc();
    9.95 sec elapsed
    
    

    About 30x faster. Meaningful if your doing a lot of periods.

    0 讨论(0)
  • 2020-11-29 03:50

    I use the following approach - first a helper:

    weekDays <- function(UPPER = TRUE) {
        days <- c('MONDAY', 'TUESDAY', 'WEDNESDAY',
          'THURSDAY', 'FRIDAY', 'SATURDAY', 
          'SUNDAY')
        if(!UPPER) return(.Internal(tolower(days))) 
        days
    }
    

    ... and now the main function:

    NumWeekDays <- function(dd, Xdays = c('saturday', 'sunday')) {
        # a function to count the number of non-Xdays in a month
        # >
        # first check if Xdays is of correct format
        stopifnot( all(.Internal(tolower(Xdays)) %in% weekDays(UP = FALSE)))
        # >
        # a helper function to find the number of non-X days between two dates
        NonXDays <- function(startDate, endDate, Xdays) {
            sum(!(.Internal(tolower(weekdays(seq(startDate, endDate, 'day')))) %in% 
                  .Internal(tolower(Xdays))))
        }
        startDate <- as.Date(as.yearmon(index(dd)), frac = 0)
        endDate <- as.Date(as.yearmon(index(dd)), frac = 1)
        vapply(1:nrow(dd), 
               FUN = function(i) NonXDays(startDate[i], 
                                          endDate[i], 
                                          Xdays = c('saturday', 'sunday')), 
               FUN.VALUE = numeric(1))
    }
    

    Example:

    set.seed(1)
    dx <- apply.monthly(xts(rnorm(600), order.by = Sys.Date() + 1:600), mean)
    
    R> NumWeekDays(dx)
     [1] 23 21 22 23 20 23 22 20 22 22 21 22 23 21 22 22 21 23 21 21
    
    0 讨论(0)
  • 2020-11-29 03:52

    Working this out using lubridate you can create a function like:

    library(lubridate)
    
    WorkingDays_function <- function(StartDate,EndDate){
    startDate <- dmy(StartDate)
    endDate <- dmy(EndDate)
    
    #Now build a sequence between the dates:
    myDates <-seq(from = startDate, to = endDate, by = "days")
    
    
    #Week starts on Sunday (1) so to exclude Sun (1) and Sat (7)
    #use > 1 & < 7  
    working_days <- sum(wday(myDates)>1 & wday(myDates)<7)
    
    print(working_days)
    }
    
    WorkingDays_function("11/07/2019","20/07/2019") 
    
    0 讨论(0)
  • 2020-11-29 03:53
    Date1 <- as.Date("2011-01-30")
    Date2 <- as.Date("2011-02-04")    
    sum(!weekdays(seq(Date1, Date2, "days")) %in% c("Saturday", "Sunday"))
    

    EDIT: And Zach said, let there be Vectorize :)

    Dates1 <- as.Date("2011-01-30") + rep(0, 10)
    Dates2 <- as.Date("2011-02-04") + seq(0, 9)
    Nweekdays <- Vectorize(function(a, b) 
      sum(!weekdays(seq(a, b, "days")) %in% c("Saturday", "Sunday")))
    Nweekdays(Dates1, Dates2)
    
    0 讨论(0)
提交回复
热议问题