tests/testthat/test-refactoring.R

In grates: Grouped Date Classes

test_that("Refactoring hasn't broke get_year for yearweek objects", {

    # The two functions below were removed during refactoring so we test for
    # compatible results

    .as_utc_posixlt_from_int <- function(x) {
        x <- as.double(x)
        x <- x * 86400 # multiply by seconds in day (24 * 60 * 60)
        as.POSIXlt(x, tz = "UTC", origin = .POSIXct(xx = 0, tz = "UTC"))
    }

    .get_year_grates_yearweek <- function(x, ...) {
        week <- get_week.grates_yearweek(x)
        dat <- .as_utc_posixlt_from_int(as.Date(x))
        december <- dat$mon == 11L
        january <- dat$mon == 0L
        boundary_adjustment <- integer(length(x)) # h/t Zhian Kamvar for boundary adjustment idea in aweek)
        boundary_adjustment[january  & week >= 52L] <- -1L
        boundary_adjustment[december & week == 1L]  <- 1L
        yr <- dat$year + 1900L
        yr + boundary_adjustment
    }

    dat <- fastymd::fymd(1,1,1) + 0:999999
    dat <- as_yearweek(dat)
    expect_identical(get_year(dat), .get_year_grates_yearweek(dat))
})


test_that("Refactoring hasn't broke get_year for yearmonth objects", {

    # The function below was removed during refactoring so we test for
    # compatible results

    .get_year_grates_yearmonth <- function(x, ...) {
        x <- as.POSIXlt(x)
        x$year + 1900L
    }

    dat <- fastymd::fymd(1,1,1) + 0:999999
    dat <- as_yearmonth(dat)
    expect_identical(get_year(dat), .get_year_grates_yearmonth(dat))
})


test_that("Refactoring hasn't broke get_year for yearquarter objects", {

    # The function below was removed during refactoring so we test for
    # compatible results

    .get_year_grates_yearquarter <- function(x, ...) {
        x <- as.POSIXlt(x)
        x$year + 1900L
    }

    dat <- fastymd::fymd(1,1,1) + 0:999999
    dat <- as_yearquarter(dat)
    expect_identical(get_year(dat), .get_year_grates_yearquarter(dat))
})


test_that("utc posixlt conversion still works", {

    # The 'old' function below was removed during refactoring so we test for
    # compatible results

    old <- function(x) as.POSIXlt(x * 86400, tz = "UTC", origin = .POSIXct(0, tz = "UTC"))
    new <- function(x) as.POSIXlt(.POSIXct(x * 86400, tz = "UTC"), tz = "UTC")
    dat <- (-99999):99999
    expect_identical(old(dat),new(dat))
})


test_that("Refactoring hasn't broken as_yearmonth for date objects", {

    # The function below was removed during refactoring so we test for
    # compatible results

    .as_yearmonth_Date <- function(x, ...) {

        # convert to posixlt (this will always be UTC when called on a date)
        x <- as.POSIXlt(x)

        # calculate the year
        yr <- x$year + 1900L

        # calculate the month relative to unix epoch
        mon <- (yr - 1970L) * 12L + x$mon

        # TODO - could mon ever be double here? Maybe call as_yearmonth again?
        .new_yearmonth(mon)
    }


    dat <- fastymd::fymd(1,1,1) + 0:999999
    expect_identical(as_yearmonth(dat), .as_yearmonth_Date(dat))
})


test_that("Refactoring hasn't broken as_yearmonth for date objects", {

    # The function below was removed during refactoring so we test for
    # compatible results

    .as_month_Date <- function(x, n, ...) {

        # trigger warning for missing n at top level
        n <- n

        if (!.is_scalar_whole(n))
            stop("`n` must be an integer of length 1.")
        n <- as.integer(n)
        if (n == 1L)
            stop("`n` must be greater than 1. If single month groupings are required please use `as_yearmonth()`.")

        # convert to posixlt (this will always be UTC when called on a date)
        x <- as.POSIXlt(x)

        # calculate the year
        yr <- x$year + 1900L

        # calculate the month relative to unix epoch
        mon <- (yr - 1970L) * 12L + x$mon

        # scale month by n
        mon <- (mon %/% n)

        # TODO - could mon ever be double here? Is as.integer needed or superfluous?
        .new_month(x = as.integer(mon), n = n)
    }

    dat <- fastymd::fymd(1,1,1) + 0:999999
    expect_identical(as_month(dat, n = 7), .as_month_Date(dat, n = 7))
    expect_identical(as_month(dat, n = 2), .as_month_Date(dat, n = 2))
})