calendars: Working with Custom Calendars

Description

tind package provides an extensive collection of functions for calendrical computations allowing users to write custom calendar functions that can be used to mark business days, holidays, and other observances. See Writing custom calendar functions for an introduction to such functions and Examples for two real-life examples. These functions can later be used for pretty printing calendars on the console (using calendar function), quick identification of business days, holidays, and other observances (using eval_calendar function) and business day computations (see bizday).

calendar pretty prints a calendar for year(s) or month(s) on the console using user-provided calendar function determining business days and holidays.

eval_calendar applies user-provided calendar function to a sequence of dates. It is designed to be used by developers who wish to implement new applications of custom calendars.

Usage

calendar(ym, calendar = NULL, name = NULL, locale = NULL)
eval_calendar(d, calendar)

Value

calendar returns invisible NULL and is used for its side effects. eval_calendar returns a 3-element list of tind objects representing business days ($bizdays), holidays ($holidays), and other observances ($otherobs).

Arguments

ym: an object of tind class or an R object coercible to it determining the year or month for which calendar is to be printed, current month (and preceding or following months) is the default.
calendar: a function determining working days and holidays (see Details), or NULL.
name: (optional) a character value (a short string) to be printed beside the year or month (or NULL).
locale: (optional) a character value determining locale or NULL (the default, interpreted as the current system locale), see calendar-names for information on locale settings.
d: an object of tind class or an R object coercible to it representing consecutive dates.

Writing Custom Calendar Functions

Calendar function should take a vector of dates as an argument and return logical vector of the same length marking business days (as TRUE) or a list of two or three logical vectors of the same length with the first marking business days (as TRUE), the second marking holidays (as TRUE), and the third marking other observances / events (as TRUE). The second and the third returned logical vectors can be named indicating which observances are marked.

The 4 basic functions to be used when writing calendars are: year, month, day, and day_of_week. These can be used to mark fixed observances and weekends.

nth_dw_in_month and last_dw_in_month can be used to determine dates of movable observances falling on the nth or the last occurrence of a day of week in a particular month.

easter function can be used to determine date of Easter in a year as well as of other movable observances with a fixed distance from Easter.

Two examples of calendar functions are provided below. These two functions can be used as templates for developing custom calendar functions. In the examples, one will also find a programming trick to easily name holidays and other observances.

A Note on the Design

One could argue that a design in which calendar functions should return logical vectors or lists of logical vectors is not intuitive and tind (vectors of dates) should be returned instead (thus making eval_calendar function redundant). Firstly, logical vectors are easy and fast to work with. By definition, a business day or a holiday must satisfy some conditions, which leads to logical values. Secondly, in some applications (for example counting business days) one would have to use matching to get integers or logical values back from time indices.

Details

calendar uses crayon package (when available) for highlighting dates. When calendar function (calendar argument) is not provided, Monday-Friday are marked as working days. Current date is marked by square brackets ([]).

For months, calendar additionally prints information about observances in a month provided that values in the list returned by the function passed as calendar argument are named.

Examples

Run this code

# US (federal) calendar with holiday names
calendar_US <- function(dd)
{
    dd <- as.tind(dd)
    y <- year(dd)
    m <- month(dd)
    d <- day(dd)
    newyear <- (m == 1) & (d == 1)
    martinlking <- (y >= 2000) & (m == 1) & (dd == nth_dw_in_month(3, 1, dd))
    presidentsday <- (m == 2) & (dd == nth_dw_in_month(3, 1, dd))
    memorialday <- (m == 5) & (dd == last_dw_in_month(1, dd))
    juneteenth <- (y >= 2021) & (m == 6) & (d == 19)
    independence <- (m == 7) & (d == 4)
    labor <- (m == 9) & (dd == nth_dw_in_month(1, 1, dd))
    columbus <- (m == 10) & (dd == nth_dw_in_month(2, 1, dd))
    veterans <- (m == 11) & (d == 11)
    thanksgiving <- (m == 11) & (dd == nth_dw_in_month(4, 4, dd))
    christmas <- (m == 12) & (d == 25)
    holiday <- newyear | martinlking | presidentsday |
               memorialday | juneteenth | independence |
               labor | columbus | veterans | thanksgiving |
               christmas
    # holiday names - a programming trick
    # names of holnms should be the same as names of logical vectors above
    names(holiday) <- rep("", length(holiday))
    holnms <- c(newyear = "New Year's Day",
                martinlking = "Birthday of Martin Luther King, Jr.",
                presidentsday = "Washington's Birthday",
                memorialday = "Memorial Day",
                juneteenth = "Juneteenth National Independence Day",
                independence = "Independence Day",
                labor = "Labor Day",
                columbus = "Columbus Day",
                veterans = "Veterans Day",
                thanksgiving = "Thanksgiving Day",
                christmas = "Christmas Day")
    lapply(names(holnms), function(nm) names(holiday)[get(nm)] <<- holnms[nm])
    # business days
    business <- !holiday & (day_of_week(dd) %in% 1:5)
    return (list(bizdays = business, holiday = holiday))
}

# Polish calendar from 1990 on with holiday names as well as other
# observances named
calendar_PL <- function(dd)
{
    dd <- as.tind(dd)
    y <- year(dd)
    m <- month(dd)
    d <- day(dd)
    # public holidays
    newyear <- (m == 1L) & (d == 1L)
    epiphany <- (y >= 2011L) & (m == 1L) & (d == 6L)
    easterd <- easter(dd) == dd
    eastermon <- easter(dd) + 1L == dd
    labour <- (m == 5L) & (d == 1L)
    constitution <- (m == 5L) & (d == 3L)
    pentecost <- easter(dd) + 49L == dd
    corpuschristi <- easter(dd) + 60L == dd
    assumption <- (m == 8L) & (d == 15L)
    allsaints <- (m == 11L) & (d == 1L)
    independence <- (m == 11L) & (d == 11L)
    christmaseve <- (m == 12L) & (d == 24L) & (y >= 2025)
    christmas <- (m == 12L) & (d == 25L)
    christmas2 <- (m == 12L) & (d == 26L)
    holiday <- newyear | epiphany |
               easterd | eastermon |
               labour | constitution |
               pentecost | corpuschristi |
               assumption |
               allsaints | independence |
               christmaseve | christmas | christmas2
    # holiday names
    names(holiday) <- rep("", length(holiday))
    holnms <- c(newyear = "New Year", epiphany = "Epiphany",
                easterd = "Easter", eastermon = "Easter Monday",
                labour = "Labour Day", constitution = "Constitution Day",
                pentecost = "Pentecost", corpuschristi = "Corpus Christi",
                assumption = "Assumption of Mary",
                allsaints = "All Saints Day", independence = "Independence Day",
                christmaseve = "Christmas Eve",
                christmas = "Christmas", christmas2 = "Christmas (2nd day)")
    lapply(names(holnms), function(nm) names(holiday)[get(nm)] <<- holnms[nm])
    # working/business days
    work <- !holiday & (day_of_week(dd) <= 5L)
    # other observances
    fatthursday <- easter(dd) - 52L == dd
    shrovetuesday <- easter(dd) - 47L == dd
    ashwednesday <- easter(dd) - 46L == dd
    goodfriday <- easter(dd) - 2L == dd
    primaaprilis <- (m == 4L) & (d == 1L)
    flagday <- (m == 5L) & (d == 2L)
    mothersday <- (m == 5L) & (d == 26L)
    childrensday <- (m == 6L) & (d == 1L)
    saintjohnseve <- (m == 6L) & (d == 23L)
    allsoulsday <- (m == 11L) & (d == 2L)
    saintandrewseve <- (m == 11L) & (d == 29L)
    saintnicholasday <- (m == 12L) & (d == 6L)
    christmaseve <- (m == 12L) & (d == 24L) & (y < 2025)
    newyeareve <- (m == 12L) & (d == 31L)
    other <- fatthursday | shrovetuesday | ashwednesday |
             goodfriday |
             primaaprilis |
             flagday |
             mothersday | childrensday | saintjohnseve |
             allsoulsday |
             saintandrewseve |
             saintnicholasday | christmaseve |
             newyeareve
    names(other) <- rep("", length(other))
    othernms <- c(fatthursday = "Fat Thursday",
                  shrovetuesday = "Shrove Tuesday",
                  ashwednesday = "Ash Wednesday",
                  goodfriday = "Good Friday",
                  primaaprilis = "All Fool's Day",
                  flagday = "Flag Day",
                  mothersday = "Mother's Day",
                  childrensday = "Children's Day",
                  saintjohnseve = "Saint John's Eve",
                  allsoulsday = "All Souls' Day",
                  saintandrewseve = "Saint Andrew's Eve",
                  saintnicholasday = "Saint Nicholas Day",
                  christmaseve = "Christmas Eve",
                  newyeareve = "New Year's Eve")
    lapply(names(othernms), function(nm) names(other)[get(nm)] <<- othernms[nm])

    return (list(work = work, holiday = holiday, other = other))
}

# print the calendar for the current and the previous/next month and the current year
# (Mon-Fri marked as working days)
calendar()
calendar(as.year(today()))

# print Polish and US calendars for 2020 and the current year
calendar(2020, calendar = calendar_PL)
calendar(2020, calendar = calendar_US)
calendar(as.year(today()), calendar = calendar_PL)
calendar(as.year(today()), calendar = calendar_US)

# print Polish and US calendars for 2020-01 and the current and the previous/next month
calendar("2020-01", calendar = calendar_PL)
calendar("2020-01", calendar = calendar_US)
calendar(calendar = calendar_PL)
calendar(calendar = calendar_US)

# get list of business days, holidays for 2020-01 and the current month
# using Polish and US calendars
d202001 <- seq(as.date("2020-01-01"), "2020-01-31")
dcurrmnth <- seq(floor_t(today(), "m"), last_day_in_month(today()))
eval_calendar(d202001, calendar_PL)
eval_calendar(d202001, calendar_US)
eval_calendar(dcurrmnth, calendar_PL)
eval_calendar(dcurrmnth, calendar_US)

# print calendars with names
calendar(calendar = calendar_PL, name = "PL")
calendar(calendar = calendar_US, name = "US (federal)")

# print Polish calendar using Polish locale
try(
calendar(calendar = calendar_PL, locale = "pl_PL.UTF-8")
)

Run the code above in your browser using DataLab