tests/testthat/test-calendar.R

In bizdays: Business Days Calculations and Utilities

context("handle specific calendars")

test_that("it should call bizdays.default with no default calendar", {
  bizdays.options$set(default.calendar = NULL)
  expect_error(bizdays("2013-07-12", "2014-07-12"))
})

test_that("it should use the default calendar", {
  cal <- Calendar_(weekdays = c("saturday", "sunday"))
  expect_true(cal$start.date == "1970-01-01")
  expect_true(cal$end.date == "2071-01-01")
  expect_true(all(cal$weekdays == c("saturday", "sunday")))
  expect_equal(bizdays("2013-01-02", "2013-01-03", cal), 1)
  expect_equal(bizdays("2013-01-02", "2013-01-04", cal), 2)
  expect_equal(bizdays("2013-01-02", "2013-01-05", cal), 2)
  expect_equal(bizdays("2013-01-02", "2013-01-06", cal), 2)
  expect_equal(bizdays("2013-01-02", "2013-01-07", cal), 3)
  expect_error(
    bizdays("2013-01-02", "2090-01-07", cal),
    "Given date out of range."
  )
  expect_error(
    bizdays("1700-01-02", "2013-01-07", cal),
    "Given date out of range."
  )
})

test_that("it should create a short calendar and test its boundaries", {
  cal <- Calendar_(
    start.date = "2013-01-01", end.date = "2013-12-31",
    weekdays = c("saturday", "sunday")
  )
  expect_true(cal$start.date == "2013-01-01")
  expect_true(cal$end.date == "2013-12-31")
  expect_true(all(cal$weekdays == c("saturday", "sunday")))
  expect_equal(bizdays("2013-01-02", "2013-01-03", cal), 1)
  expect_error(
    bizdays("2013-01-02", "2014-01-02", cal),
    "Given date out of range."
  )
  expect_error(
    bizdays("2012-01-02", "2013-01-02", cal),
    "Given date out of range."
  )
})

test_that("it should create an Actual Calendar", {
  cal <- Calendar_(weekdays = NULL)
  expect_true(length(cal$weekdays) == 0)
  expect_true(cal$start.date == "1970-01-01")
  expect_true(cal$end.date == "2071-01-01")
  difference <- as.integer(as.Date("2013-02-03") - as.Date("2013-01-02"))
  expect_equal(bizdays("2013-01-02", "2013-02-03", cal), difference)
})

test_that("it should create a business Calendar: Brazil's ANBIMA", {
  cal <- calendars()[["Brazil/ANBIMA"]]
  expect_equal(bizdays("2013-07-12", "2014-07-12", cal), 251)
  expect_equal(bizdays("2013-08-21", "2013-08-24", cal), 2)
  expect_equal(bizdays("2013-01-01", "2013-01-31", cal), 21)
  expect_equal(bizdays("2013-01-01", "2014-01-01", cal), 252)
  expect_equal(bizdays("2014-01-01", "2015-01-01", cal), 252)
  expect_equal(bizdays("2014-10-10", "2015-02-11", cal), 86)
  expect_equal(bizdays("2013-08-13", "2013-09-02", cal), 14)
  expect_equal(bizdays("2013-08-13", "2013-10-01", cal), 35)
  expect_equal(bizdays("2013-08-13", "2013-11-01", cal), 58)
  expect_equal(bizdays("2013-08-13", "2013-12-02", cal), 78)
  expect_equal(bizdays("2013-08-13", "2014-01-02", cal), 99)
  expect_equal(bizdays("2013-08-13", "2014-04-01", cal), 160)
  expect_equal(bizdays("2013-08-13", "2014-07-01", cal), 221)
  expect_equal(bizdays("2013-08-13", "2014-10-01", cal), 287)
  expect_equal(bizdays("2013-08-13", "2015-01-02", cal), 352)
  expect_equal(bizdays("2013-08-13", "2015-04-01", cal), 413)
  expect_equal(bizdays("2013-08-13", "2015-07-01", cal), 474)
  expect_equal(bizdays("2013-08-13", "2015-10-01", cal), 539)
  expect_equal(bizdays("2013-08-13", "2016-01-04", cal), 602)
  expect_equal(bizdays("2013-08-13", "2016-04-01", cal), 663)
  expect_equal(bizdays("2013-08-13", "2016-07-01", cal), 726)
  expect_equal(bizdays("2013-08-13", "2016-10-03", cal), 791)
  expect_equal(bizdays("2013-08-13", "2017-01-02", cal), 853)
  expect_equal(bizdays("2013-08-13", "2017-04-03", cal), 916)
  expect_equal(bizdays("2013-08-13", "2017-07-03", cal), 977)
  expect_equal(bizdays("2013-08-13", "2017-10-02", cal), 1041)
  expect_equal(bizdays("2013-08-13", "2018-01-02", cal), 1102)
  expect_equal(bizdays("2013-08-13", "2018-04-02", cal), 1163)
  expect_equal(bizdays("2013-08-13", "2018-07-02", cal), 1226)
  expect_equal(bizdays("2013-08-13", "2018-10-01", cal), 1290)
  expect_equal(bizdays("2013-08-13", "2019-01-02", cal), 1352)
  expect_equal(bizdays("2013-08-13", "2019-04-01", cal), 1413)
  expect_equal(bizdays("2013-08-13", "2019-07-01", cal), 1475)
  expect_equal(bizdays("2013-08-13", "2019-10-01", cal), 1541)
  expect_equal(bizdays("2013-08-13", "2020-01-02", cal), 1605)
  expect_equal(bizdays("2013-08-13", "2020-04-01", cal), 1667)
  expect_equal(bizdays("2013-08-13", "2020-07-01", cal), 1728)
  expect_equal(bizdays("2013-08-13", "2020-10-01", cal), 1793)
  expect_equal(bizdays("2013-08-13", "2021-01-04", cal), 1856)
  expect_equal(bizdays("2013-08-13", "2021-07-01", cal), 1979)
  expect_equal(bizdays("2013-08-13", "2022-01-03", cal), 2107)
  expect_equal(bizdays("2013-08-13", "2022-07-01", cal), 2231)
  expect_equal(bizdays("2013-08-13", "2023-01-02", cal), 2358)
  expect_equal(bizdays("2013-08-13", "2024-01-02", cal), 2607)
  expect_equal(bizdays("2013-08-13", "2025-01-02", cal), 2861)
})

test_that("it should work with unordered calendars", {
  cal <- calendars()[["Brazil/ANBIMA"]]
  cal1 <- Calendar_(cal$holidays, weekdays = c("saturday", "sunday"))
  cal2 <- Calendar_(sample(cal$holidays), weekdays = c("saturday", "sunday"))
  expect_equal(
    bizdays("2013-07-12", "2014-07-12", cal1),
    bizdays("2013-07-12", "2014-07-12", cal2)
  )
})

test_that("it should check consistency", {
  hd <- as.Date(c(
    "2017-01-02", # New Year's Day
    "2017-01-16", # Birthday of Martin Luther King, Jr.
    "2017-02-20", # Washington's Birthday
    "2017-05-29", # Memorial Day
    "2017-07-04", # Independence Day
    "2017-09-04", # Labor Day
    "2017-10-09", # Columbus Day
    "2017-11-10", # Veterans Day
    "2017-11-23", # Thanksgiving Day
    "2017-12-25" # Christmas Day
  ), format = "%Y-%m-%d", tz = "CST6CDT")
  create.calendar("USA2017",
    holidays = hd, start.date = "2017-01-01",
    end.date = "2017-12-31", weekdays = c("saturday", "sunday"),
    financial = TRUE
  )

  # both from and to are non bizdays
  expect_equal(
    bizdays("2017-09-04", "2017-09-08", "USA2017"),
    bizdays("2017-09-04", "2017-09-09", "USA2017")
  )
  # from is non bizdays
  expect_equal(
    bizdays("2017-09-04", "2017-09-08", "USA2017"),
    bizdays("2017-09-05", "2017-09-08", "USA2017")
  )
  # to is non bizdays
  expect_equal(
    bizdays("2017-09-05", "2017-09-09", "USA2017"),
    bizdays("2017-09-05", "2017-09-08", "USA2017")
  )
})

test_that("it should create non financial calendars", {
  create.calendar(
    name = "test", weekdays = c("saturday", "sunday"),
    financial = FALSE
  )
  expect_equal(bizdays("2018-03-02", "2018-03-05", "test"), 2)
  #
  hd <- as.Date(c(
    "2017-01-02", # New Year's Day
    "2017-01-16", # Birthday of Martin Luther King, Jr.
    "2017-02-20", # Washington's Birthday
    "2017-05-29", # Memorial Day
    "2017-07-04", # Independence Day
    "2017-09-04", # Labor Day
    "2017-10-09", # Columbus Day
    "2017-11-10", # Veterans Day
    "2017-11-23", # Thanksgiving Day
    "2017-12-25" # Christmas Day
  ), format = "%Y-%m-%d", tz = "CST6CDT")
  create.calendar("USA2017",
    holidays = hd, start.date = "2017-01-01",
    end.date = "2017-12-31", weekdays = c("saturday", "sunday"),
    financial = FALSE
  )

  # both from and to are non bizdays
  expect_equal(
    bizdays("2017-09-04", "2017-09-08", "USA2017"),
    bizdays("2017-09-04", "2017-09-09", "USA2017")
  )
  # from is non bizdays
  expect_equal(
    bizdays("2017-09-04", "2017-09-08", "USA2017"),
    bizdays("2017-09-05", "2017-09-08", "USA2017")
  )
  # to is non bizdays
  expect_equal(
    bizdays("2017-09-05", "2017-09-09", "USA2017"),
    bizdays("2017-09-05", "2017-09-08", "USA2017")
  )
})

context("check whether or not a date is a business day")

test_that("is business day", {
  cal <- calendars()[["Brazil/ANBIMA"]]
  expect_false(is.bizday("2013-01-01", cal))
  expect_true(is.bizday("2013-01-02", cal))
  dates <- seq(as.Date("2013-01-01"), as.Date("2013-01-05"), by = "day")
  expect_equal(is.bizday(dates, cal), c(FALSE, TRUE, TRUE, TRUE, FALSE))
})

context("adjustment of business days")

cal <- calendars()[["Brazil/ANBIMA"]]

test_that("it should move date to next business day", {
  date <- as.character(adjust.next("2013-01-01", cal))
  expect_equal(date, "2013-01-02")
  date <- as.character(following("2013-01-01", cal))
  expect_equal(date, "2013-01-02")
})

test_that("it should move date to previous business day", {
  date <- as.character(adjust.previous("2013-02-02", cal))
  expect_equal(date, "2013-02-01")
  date <- as.character(preceding("2013-02-02", cal))
  expect_equal(date, "2013-02-01")
})

test_that("it should adjust.next a vector of dates", {
  dates <- c(as.Date("2013-01-01"), as.Date("2013-01-02"))
  adj.dates <- adjust.next(dates, cal)
  expect_equal(adj.dates, c(as.Date("2013-01-02"), as.Date("2013-01-02")))
  adj.dates <- following(dates, cal)
  expect_equal(adj.dates, c(as.Date("2013-01-02"), as.Date("2013-01-02")))
})

test_that("it should adjust.previous a vector of dates", {
  dates <- c(as.Date("2013-01-01"), as.Date("2013-01-02"))
  adj.dates <- adjust.previous(dates, cal)
  expect_equal(adj.dates, c(as.Date("2012-12-31"), as.Date("2013-01-02")))
  adj.dates <- preceding(dates, cal)
  expect_equal(adj.dates, c(as.Date("2012-12-31"), as.Date("2013-01-02")))
})

test_that("it should move date to next business day if it is the same month", {
  date <- as.character(modified.following("2013-01-01", cal))
  expect_equal(date, "2013-01-02")
  date <- as.character(modified.following("2016-01-31", cal))
  expect_equal(date, "2016-01-29")
})

test_that("it should modified.following a vector of dates", {
  dates <- c(as.Date("2013-01-01"), as.Date("2016-01-31"))
  adj.dates <- modified.following(dates, cal)
  expect_equal(adj.dates, c(as.Date("2013-01-02"), as.Date("2016-01-29")))
})

test_that(
  "it should move date to previous business day if it is the same month",
  {
    date <- modified.preceding("2013-01-01", cal)
    expect_equal(as.character(date), "2013-01-02")
    date <- modified.preceding("2016-01-31", cal)
    expect_equal(as.character(date), "2016-01-29")
  }
)

test_that("it should modified.preceding a vector of dates", {
  dates <- c(as.Date("2013-01-01"), as.Date("2016-01-31"))
  adj.dates <- modified.preceding(dates, cal)
  expect_equal(adj.dates, c(as.Date("2013-01-02"), as.Date("2016-01-29")))
})

test_that("it should return the function name for adjust functions", {
  expect_equal(adjust_name(adjust.none), "none")
  expect_equal(adjust_name(adjust.next), "following")
  expect_equal(adjust_name(following), "following")
  expect_equal(adjust_name(adjust.previous), "preceding")
  expect_equal(adjust_name(preceding), "preceding")
})

context("sequence of bizdays")

test_that("it should generate a sequence of bizdays", {
  s <- c(
    "2013-01-02", "2013-01-03", "2013-01-04", "2013-01-07", "2013-01-08",
    "2013-01-09", "2013-01-10"
  )
  expect_true(all(bizseq("2013-01-01", "2013-01-10", cal) == s))
})

context("offset by a number of business days")

test_that("it should offset the date by n business days", {
  expect_equal(add.bizdays("2013-01-02", 1, "Brazil/ANBIMA"), as.Date("2013-01-03"))
  expect_equal(add.bizdays("2013-01-02", 0, "Brazil/ANBIMA"), as.Date("2013-01-02"))
  expect_equal(add.bizdays("2013-01-02", -1, "Brazil/ANBIMA"), as.Date("2012-12-31"))

  expect_equal(add.bizdays("2013-01-01", 2, "Brazil/ANBIMA"), as.Date("2013-01-03"))
  expect_equal(add.bizdays("2013-01-01", 1, "Brazil/ANBIMA"), as.Date("2013-01-02"))
  expect_equal(add.bizdays("2013-01-01", 0, "Brazil/ANBIMA"), as.Date("2013-01-01"))
  expect_equal(add.bizdays("2013-01-01", -1, "Brazil/ANBIMA"), as.Date("2012-12-31"))
  expect_equal(add.bizdays("2013-01-01", -2, "Brazil/ANBIMA"), as.Date("2012-12-28"))

  expect_equal(add.bizdays("2012-02-27", -1, "weekends"), as.Date("2012-02-24"))

  dates <- c(as.Date("2013-01-01"), as.Date("2013-01-02"))
  expect_equal(add.bizdays(dates, 1, "Brazil/ANBIMA"), c(
    as.Date("2013-01-02"),
    as.Date("2013-01-03")
  ))
  expect_equal(
    add.bizdays("2013-01-02", c(1, 3), "Brazil/ANBIMA"),
    c(as.Date("2013-01-03"), as.Date("2013-01-07"))
  )
  expect_equal(
    add.bizdays(dates, c(1, 3), "Brazil/ANBIMA"),
    c(as.Date("2013-01-02"), as.Date("2013-01-07"))
  )

  expect_error(add.bizdays("2090-12-20", 30, "Brazil/ANBIMA"))
})

test_that("it should warn for bad settings", {
  cal <- calendars()[["Brazil/ANBIMA"]]
  expect_warning(
    Calendar_(cal$holidays),
    "You provided holidays without set weekdays.
That setup leads to inconsistencies!"
  )
})

context("POSIX* holidays")

test_that("it should create a calendar with POSIX holidays", {
  dates <- as.POSIXct(c("1970-01-01", "2015-05-14", "2015-05-25", "2037-12-31"),
    tz = "UTC"
  )
  cal <- Calendar_(dates, weekdays = c("saturday", "sunday"))
  x <- as.POSIXct(c("2015-04-13", "2015-05-11", "2015-05-25"), tz = "UTC")
  y <- as.POSIXct(c("2015-04-17", "2015-05-15", "2015-05-29"), tz = "UTC")
  expect_equal(bizdays(x, y, cal), c(4, 3, 3))
})

context("NULL calendar")

test_that("it should pass NULL calendar", {
  expect_error(
    adjust.next(as.Date("2013-01-01"), NULL),
    "Given calendar is NULL"
  )
  expect_error(
    preceding(as.Date("2013-01-01"), NULL),
    "Given calendar is NULL"
  )
  expect_error(
    bizdays("2013-08-13", "2025-01-02", NULL),
    "Given calendar is NULL"
  )
  expect_error(is.bizday("2013-08-13", NULL), "Given calendar is NULL")
  expect_error(
    bizseq("2013-01-01", "2013-01-10", NULL),
    "Given calendar is NULL"
  )
  expect_error(add.bizdays("2013-01-10", 30, NULL), "Given calendar is NULL")
})

context("load calendars from other packages")

if (requireNamespace("RQuantLib", quietly = TRUE)) {
  test_that("it should check if QuantLib calendars have been loaded", {
    expect_null(calendars()[["QuantLib/UnitedStates/NYSE"]])
    expect_null(calendars()[["QuantLib/Argentina"]])

    load_quantlib_calendars(
      c("Argentina", "UnitedStates/NYSE"), "2016-01-01",
      "2016-12-31"
    )

    expect_true(!is.null(calendars()[["QuantLib/UnitedStates/NYSE"]]))
    expect_true(!is.null(calendars()[["QuantLib/Argentina"]]))

    expect_null(calendars()[["QuantLib/UnitedStates/NERC"]])
  })


  test_that("it should check if QuantLib calendars behave correctly", {
    load_quantlib_calendars(
      c("Argentina", "UnitedStates/NYSE"), "2016-01-01",
      "2016-12-31"
    )

    ql_bd <- RQuantLib::businessDaysBetween(
      "Argentina", as.Date("2016-01-01"),
      as.Date("2016-07-12")
    )
    expect_equal(
      bizdays("2016-01-01", "2016-07-12", "QuantLib/Argentina"),
      ql_bd
    )

    ql_bd <- RQuantLib::businessDaysBetween(
      "Argentina", as.Date("2016-01-01"),
      as.Date("2016-07-10")
    )
    expect_equal(
      bizdays("2016-01-01", "2016-07-10", "QuantLib/Argentina"),
      ql_bd
    )

    ql_bd <- RQuantLib::businessDaysBetween(
      "UnitedStates/NYSE",
      as.Date("2016-01-01"),
      as.Date("2016-07-10")
    )
    expect_equal(bizdays(
      "2016-01-01", "2016-07-10",
      "QuantLib/UnitedStates/NYSE"
    ), ql_bd)
  })

  test_that("it should compare bizdays calendar with RQuantLib calendars", {
    load_quantlib_calendars("UnitedStates",
      from = "1996-01-01", to = "2040-12-31",
      financial = FALSE
    )
    x <- bizdays("2020-01-01", "2020-12-31", "QuantLib/UnitedStates")
    y <- RQuantLib::businessDaysBetween(
      calendar = "UnitedStates",
      from = as.Date("2020-01-01"),
      to = as.Date("2020-12-31"),
      includeFirst = TRUE,
      includeLast = TRUE
    )
    expect_equal(x, y)
  })
}

if (requireNamespace("timeDate", quietly = TRUE)) {
  test_that("it should check if Rmetrics calendars have been loaded", {
    expect_null(calendars()[["Rmetrics/LONDON"]])
    expect_null(calendars()[["Rmetrics/NYSE"]])

    load_rmetrics_calendars(2016)

    expect_true(!is.null(calendars()[["Rmetrics/LONDON"]]))
    expect_true(!is.null(calendars()[["Rmetrics/NYSE"]]))
  })

  test_that("it should check if QuantLib calendars behave correctly", {
    load_rmetrics_calendars(2016)

    expect_equal(
      is.bizday("2016-01-01", "Rmetrics/LONDON"),
      as.logical(timeDate::isBizday(
        timeDate::timeDate("2016-01-01"),
        timeDate::holidayLONDON(2016)
      ))
    )

    expect_equal(
      is.bizday("2016-07-10", "Rmetrics/LONDON"),
      as.logical(timeDate::isBizday(
        timeDate::timeDate("2016-01-10"),
        timeDate::holidayLONDON(2016)
      ))
    )

    expect_equal(
      is.bizday("2016-07-12", "Rmetrics/LONDON"),
      as.logical(timeDate::isBizday(
        timeDate::timeDate("2016-01-12"),
        timeDate::holidayLONDON(2016)
      ))
    )

    expect_equal(
      is.bizday("2016-12-31", "Rmetrics/LONDON"),
      as.logical(timeDate::isBizday(
        timeDate::timeDate("2016-12-31"),
        timeDate::holidayLONDON(2016)
      ))
    )

    load_rmetrics_calendars(2017)
    expect_equal(
      is.bizday("2017-01-01", "Rmetrics/LONDON"),
      as.logical(timeDate::isBizday(
        timeDate::timeDate("2017-01-01"),
        timeDate::holidayLONDON(2017)
      ))
    )

    expect_equal(
      is.bizday("2017-12-31", "Rmetrics/LONDON"),
      as.logical(timeDate::isBizday(
        timeDate::timeDate("2017-12-31"),
        timeDate::holidayLONDON(2017)
      ))
    )
  })
}

context("bizdiff")

test_that("it should compute bizdays between dates in a vector", {
  dates <- c("2017-05-10", "2017-05-12", "2017-05-17")
  expect_equal(bizdiff(dates, "Brazil/ANBIMA"), c(2, 3))
})

test_that("it should return an empty vector for a single element vector", {
  expect_equal(bizdiff("2017-01-02", "Brazil/ANBIMA"), numeric())
})

context("import and export calendar")

test_that("it should export a calendar", {
  cnt <- '{
  "name": "weekends",
  "weekdays": ["saturday", "sunday"],
  "financial": true,
  "adjust.from": "following",
  "adjust.to": "preceding"
}
'
  cal <- calendars()[["weekends"]]
  con <- tempfile(fileext = ".json")
  save_calendar(cal, con)
  expect_equal(cnt, gsub("\r", "", readChar(con, 1024 * 1024)))
  cnt <- '{
  "name": "actual",
  "financial": true
}
'
  con <- tempfile(fileext = ".json")
  save_calendar("actual", con)
  expect_equal(cnt, gsub("\r", "", readChar(con, 1024 * 1024)))
})

test_that("it should import a calendar", {
  cnt <- '{
  "name": "weekends",
  "weekdays": ["saturday", "sunday"],
  "financial": true,
  "adjust.from": "following",
  "adjust.to": "preceding"
}
'
  cal <- load_calendar(cnt)
  expect_is(cal, "Calendar")
  expect_equal(cal$name, "weekends")
  expect_equal(cal$financial, TRUE)
  expect_equal(cal$weekdays, c("saturday", "sunday"))
})