source("library.R") date_seq <- function(interval){ set.seed(1234) # only use a wide interval to test year, all others less wide for performance if (interval == "year") { start_date <- as.POSIXlt(strftime("2005-01-01")) } else { start_date <- as.POSIXlt(strftime("2015-01-01")) } sequence <- seq(start_date, as.POSIXlt(strftime("2017-01-01")), by = interval) set.seed(12345) if (length(sequence) > 100) { sampled_dates <- sample(sequence, 100) } else { sampled_dates <- sample(sequence, length(sequence) / 2) } return(sampled_dates) } x_month <- date_seq("month") x_day <- date_seq("DSTday") x_hour <- date_seq("hour") x_min <- date_seq("min") x_sec <- date_seq("sec") equal_dist <- c(as.POSIXct("2014-01-01 23:00:00"), as.POSIXct("2014-01-02 01:00:00")) df_with_one_date <- data.frame(dt_var1 = date_seq("month"), y = 1:6) df_with_one_date_sorted <- df_with_one_date %>% arrange(dt_var1) df_with_two_dates <- data.frame(dt_var1 = date_seq("month"), dt_var2 = date_seq("month"), y = 1:6) x_month <- data.frame(x = ymd(c(20160201, 20160301))) x_month_unordered <- data.frame(x = ymd(c(20160301, 20160201))) sw <- suppressWarnings context("thicken function errors and warnings") test_that("thicken only accepts data frames", { expect_error(thicken(x_month %>% as.character)) expect_error(thicken(x_month %>% as.numeric)) expect_error(suppressWarnings(thicken(df_with_one_date, interval = "quarter")), NA) }) test_that("thicken throws warning when asked interval is lower", { expect_warning(thicken(x_month, interval = "month")) expect_warning(thicken(x_month, interval = "day")) expect_error(thicken(x_month, interval = "year"), NA) }) test_that("thicken gives informed error when start_val is wrong class", { expect_error(thicken(x_month, start_val = "2017-01-01", "start_val should be of class Date, POSIXlt, or POSIXct")) }) test_that("thicken removes when start_val is larger than min(dt)", { x <- data.frame(dt = as.Date(c("2016-01-01", "2016-01-03", "2016-01-04")), y = 1:3) expect_equal(thicken(x, start_val = as.Date("2016-01-02"), interval = "year") %>% nrow, 2) }) context("thicken integration tests") test_that("thicken gives correct interval", { x_df <- data.frame(x_sec = x_sec) expect_equal(sw(thicken(x_df, interval = "year"))$x_sec_year %>% get_interval, "year") expect_equal(sw(thicken(x_df, interval = "month"))$x_sec_month %>% get_interval, "month") expect_equal(sw(thicken(x_df, interval = "day"))$x_sec_day %>% get_interval, "day") expect_equal(sw(thicken(x_df, interval = "hour"))$x_sec_hour %>% get_interval, "hour") expect_equal(sw(thicken(x_df, interval = "min"))$x_sec_min %>% get_interval, "min") }) test_that("thicken gives correct output when x is a vector", { day_sorted <- sort(x_day) day_to_year <- thicken(day_sorted %>% as.data.frame, colname = "x", interval = "year")$x day_to_year2 <- thicken(day_sorted %>% as.data.frame, "x", interval = "year", rounding = "up")$x expect_equal(day_to_year %>% length, 100) expect_equal(lubridate::year(day_to_year[1]), 2015) expect_equal(lubridate::year(day_to_year[100]), 2016) expect_equal(lubridate::year(day_to_year2[1]), 2016) expect_equal(lubridate::year(day_to_year2[100]), 2017) }) test_that("thicken gives correct ouput when x is a df", { X <- data.frame(day_var = seq(as.Date("2016-01-01"), as.Date("2016-12-31"), by = "day"), #nolint value = runif(366, 50, 100)) expect_equal(thicken(X, interval = "month") %>% nrow, 366) expect_equal( lubridate::month(thicken(X, interval = "month")$day_var_month) %>% max, 12) #nolint expect_error( (thicken(dplyr::as_tibble(X), interval = "month")), NA) expect_error( thicken(data.table::as.data.table(X), interval = "month"), NA) }) test_that("column naming works properly", { a <- sort(x_day) a_df <- data.frame(a = a, b = 42) expect_equal(colnames(thicken(a_df, interval = "week"))[3], "a_week") expect_equal(colnames(thicken(a_df, interval = "2 days", colname = "jos"))[3], "jos") }) context("test set_to_original_type") test_that("set_to_original_type returns tbl or data.table", { expect_equal(sw(dplyr::as_tibble(df_with_one_date) %>% thicken("2 mon") %>% class), c("tbl_df", "tbl", "data.frame")) expect_equal(sw(data.table::as.data.table(df_with_one_date) %>% thicken("2 mon") %>% class), c("data.table", "data.frame")) }) context("thicken with missing values") test_that("thicken works properly on NA values", { coffee_na <- coffee %>% thicken("day", "d") %>% count(d) %>% pad() %>% fill_by_value() coffee_na[3, 1] <- NA coffee_na_thickened <- sw(coffee_na %>% thicken("week")) expect_error(sw(coffee_na %>% thicken("week")), NA) expect_warning(coffee_na %>% thicken("week"), "There are NA values in the column d. Returned dataframe contains original observations, with NA values for d and d_week.") expect_equal(coffee_na_thickened %>% nrow, 4) expect_equal(coffee_na_thickened %>% filter(is.na(d)) %>% nrow, 1) expect_equal(coffee_na_thickened %>% filter(is.na(d_week)) %>% nrow, 1) expect_equal(coffee_na_thickened$d[3] %>% as.character(), NA_character_) coffee_two_nas <- coffee %>% thicken("day", "d") %>% count(d) %>% pad() %>% fill_by_value() coffee_two_nas[c(2, 3), 1] <- NA expect_equal(sw(thicken(coffee_two_nas, "week"))$d_week, c(as.Date("2016-07-03"), NA, NA, as.Date("2016-07-10"))) }) test_that("add_na_to_thicken unit tests", { thickened_date <- ymd(c(20180101, 20180101)) thickened_datetime <- ymd_h(c("20180101 01", "20180101 04")) expect_equal(add_na_to_thicken(thickened_date, 2), ymd(c(20180101, NA, 20180101))) expect_equal(add_na_to_thicken(thickened_datetime, 2), ymd_h(c("20180101 01", NA, "20180101 04"))) expect_equal(add_na_to_thicken(thickened_date, c(2, 4)), ymd(c(20180101, NA, 20180101, NA))) expect_equal(add_na_to_thicken(thickened_datetime, c(2, 4)), ymd_h(c("20180101 01", NA, "20180101 04", NA))) }) context("thicken drop argument") test_that("the drop argument gives the desired result", { day <- as.Date(c("2016-07-07", "2016-07-07", "2016-07-09", "2016-07-10")) coffee_day <- coffee %>% mutate(time_stamp_day = day) no_drop <- coffee_day with_drop <- coffee_day %>% select(-time_stamp) expect_equal(thicken(coffee, "day"), no_drop) expect_equal(thicken(coffee, "day", drop = FALSE), no_drop) expect_equal(thicken(coffee, "day", drop = TRUE), with_drop) }) test_that("thicken will return a data frame when drop = TRUE", { x <- as.data.frame(coffee[ ,1]) x_ret <- data.frame(time_stamp_hour = ymd_hms(c("2016-07-07 09:00:00", "2016-07-07 09:00:00", "2016-07-09 13:00:00", "2016-07-10 10:00:00"))) expect_s3_class(thicken(x, interval = "hour", drop = TRUE), "data.frame") }) context("ties_to_earlier argument to thicken") x <- data.frame( dt = ymd_hm("20171021 1631", "20171021 1700", "20171021 1731")) test_that("ties_to_earlier works with rounding down regular",{ expect_equal(thicken(x, "hour", ties_to_earlier = TRUE)$dt_hour, ymd_h("20171021 16", "20171021 16", "20171021 17")) }) test_that("ties_to_earlier works with rounding up regular", { expect_equal(thicken(x, "hour", rounding = "up", ties_to_earlier = TRUE)$dt_hour, ymd_h("20171021 17", "20171021 17", "20171021 18")) }) test_that("ties_to_earlier works with rounding down ties on edges", { expect_equal(thicken(x[2:3, ,drop = FALSE], "hour", ties_to_earlier = TRUE)$dt_hour, ymd_h("20171021 16", "20171021 17")) }) test_that("ties_to_earlier works with rounding up ties on edges", { expect_equal(thicken(x[1:2, ,drop = FALSE], "hour", rounding = "up", ties_to_earlier = TRUE)$dt_hour, ymd_h("20171021 17", "20171021 17")) }) context("informative error for Year 2038 problem") x <- data.frame(dt = ymd_h("20381201 01", "20381202 01")) expect_error(thicken(x, "hour"), "thicken does not work on POSIX data after 2038, due to Year 2038 problem. https://en.wikipedia.org/wiki/Year_2038_problem") y <- data.frame(d = as.Date(c("2038-12-10", "2038-12-13"))) expect_error(thicken(y, interval = "1 month"), NA)