From 3e6ce50f6e3e8a29a6c719728c827f5871fd5ded Mon Sep 17 00:00:00 2001 From: Winston Chang Date: Tue, 23 Sep 2014 23:41:44 -0500 Subject: [PATCH] Revamp compute_bin tests --- tests/testthat/test-compute-bin.r | 185 ++++++++++++++++++++++++------ 1 file changed, 147 insertions(+), 38 deletions(-) diff --git a/tests/testthat/test-compute-bin.r b/tests/testthat/test-compute-bin.r index 5d43e092..6482cc47 100644 --- a/tests/testthat/test-compute-bin.r +++ b/tests/testthat/test-compute-bin.r @@ -1,49 +1,158 @@ context("compute_bin") -test_that("bin_vector preserves dates and times", { - dates <- as.Date("2013-06-01") + 0:100 - UTCtimes <- as.POSIXct('2001-06-01 21:00', tz = 'UTC') + seq(0, 1000, by = 10) - NYtimes <- as.POSIXct('2001-06-01 21:00', tz = 'America/New_York') + 0:10 * 100 +comp_bin <- function(...) { + suppressMessages(compute_bin(...)) +} - res <- bin_vector(dates, width = 30) +test_that("compute_bin preserves dates and times", { + dates <- data.frame(val = as.Date("2013-06-01") + 0:100) + NYtimes <- data.frame( + val = as.POSIXct('2001-06-01 21:00', tz = 'America/New_York') + 0:10 * 100 + ) + UTCtimes <- data.frame( + val = as.POSIXct('2001-06-01 21:00', tz = 'UTC') + seq(0, 1000, by = 10) + ) + + res <- comp_bin(dates, ~val, width = 30) expect_true(inherits(res$x_, "Date")) expect_true(inherits(res$xmin_, "Date")) expect_true(inherits(res$xmax_, "Date")) - expect_identical(sum(res$count_), length(dates)) + expect_identical(sum(res$count_), length(dates$val)) - res <- bin_vector(NYtimes, width = 120) + res <- comp_bin(NYtimes, ~val, width = 120) expect_true(inherits(res$x_, "POSIXct")) expect_true(inherits(res$xmin_, "POSIXct")) expect_true(inherits(res$xmax_, "POSIXct")) - expect_identical(sum(res$count_), length(NYtimes)) - expect_identical(attr(NYtimes, "tzone"), attr(res$x_, "tzone")) - - res <- bin_vector(UTCtimes, width = 120) - expect_identical(sum(res$count_), length(UTCtimes)) - expect_identical(attr(UTCtimes, "tzone"), attr(res$x_, "tzone")) - - - # Can set boundary - res <- bin_vector(dates, width = 30, boundary = as.Date("2013-06-01"), - pad = FALSE) - expect_identical(sum(res$count_), length(dates)) - expect_identical(res$xmin_[1], as.Date("2013-06-01")) - - res <- bin_vector(UTCtimes, width = 120, - boundary = as.POSIXct('2001-06-01 21:07', tz = 'UTC'), - pad = FALSE) - expect_identical(sum(res$count_), length(UTCtimes)) - expect_identical(res$xmin_[5], as.POSIXct('2001-06-01 21:07', tz = 'UTC')) - - # Can set center - res <- bin_vector(dates, width = 30, center=as.Date("2013-07-01"), - pad = FALSE) - expect_identical(sum(res$count_), length(dates)) - expect_identical(res$x_[2], as.Date("2013-07-01")) - - res <- bin_vector(UTCtimes, width = 120, - center = as.POSIXct('2001-06-01 21:15', tz = 'UTC'), - pad = FALSE) - expect_identical(sum(res$count_), length(UTCtimes)) - expect_identical(res$x_[8], as.POSIXct('2001-06-01 21:15', tz = 'UTC')) + expect_identical(sum(res$count_), length(NYtimes$val)) + expect_identical(attr(NYtimes$val, "tzone"), attr(res$x_, "tzone")) + + res <- comp_bin(UTCtimes, ~val, width = 120) + expect_identical(sum(res$count_), length(UTCtimes$val)) + expect_identical(attr(UTCtimes$val, "tzone"), attr(res$x_, "tzone")) +}) + +test_that("width in lubridate::Period", { + UTCtimes <- data.frame( + val = as.POSIXct('2001-06-01 21:00', tz = 'UTC') + seq(0, 1000, by = 10) + ) + + # width specified as a Period from lubridate + expect_identical( + comp_bin(UTCtimes, ~val, width = lubridate::ms("1 42")), + comp_bin(UTCtimes, ~val, width = 102) + ) +}) + +test_that("Closed left or right", { + dat <- data.frame(x = c(0, 10)) + + res <- comp_bin(dat, ~x, width = 10, pad = FALSE) + expect_identical(res$count_, c(1L, 1L)) + res <- comp_bin(dat, ~x, width = 10, boundary = 5, pad = FALSE) + expect_identical(res$count_, c(1L, 1L)) + res <- comp_bin(dat, ~x, width = 10, boundary = 0, pad = FALSE) + expect_identical(res$count_, 2L) + res <- comp_bin(dat, ~x, width = 5, boundary = 0, pad = FALSE) + expect_identical(res$count_, c(1L, 1L)) + + res <- comp_bin(dat, ~x, width = 10, pad = FALSE, closed = "left") + expect_identical(res$count_, c(1L, 1L)) + res <- comp_bin(dat, ~x, width = 10, boundary = 5, pad = FALSE, closed = "left") + expect_identical(res$count_, c(1L, 1L)) + res <- comp_bin(dat, ~x, width = 10, boundary = 0, pad = FALSE, closed = "left") + expect_identical(res$count_, c(2L)) + res <- comp_bin(dat, ~x, width = 5, boundary = 0, pad = FALSE, closed = "left") + expect_identical(res$count_, c(1L, 1L)) +}) + + +test_that("Setting boundary and center", { + # numeric + dat <- data.frame(x = c(0, 30)) + + # Error if both boundary and center are specified + expect_error(comp_bin(dat, ~x, width = 10, bondary = 5, center = 0, pad = FALSE)) + + res <- comp_bin(dat, ~x, width = 10, boundary = 0, pad = FALSE) + expect_identical(res$count, c(1L, 0L, 1L)) + expect_identical(res$xmin_[1], 0) + expect_identical(res$xmax_[3], 30) + + res <- comp_bin(dat, ~x, width = 10, center = 0, pad = FALSE) + expect_identical(res$count, c(1L, 0L, 0L, 1L)) + expect_identical(res$xmin_[1], dat$x[1] - 5) + expect_identical(res$xmax_[4], dat$x[2] + 5) + + + # Date + dat <- data.frame(x = as.Date("2013-06-01") + c(0, 30)) + + res <- comp_bin(dat, ~x, width = 10, boundary = as.Date("2013-06-01"), pad = FALSE) + expect_identical(res$count_, c(1L, 0L, 1L)) + expect_identical(res$xmin_[1], dat$x[1]) + expect_identical(res$xmax_[3], dat$x[2]) + + res <- comp_bin(dat, ~x, width = 10, center = as.Date("2013-06-01"), pad = FALSE) + expect_identical(res$count, c(1L, 0L, 0L, 1L)) + expect_identical(res$xmin_[1], dat$x[1] - 5) + expect_identical(res$xmax_[4], dat$x[2] + 5) + + + # POSIXct + dat <- data.frame( + x = as.POSIXct('2001-06-01 21:00', tz = 'America/New_York') + c(0, 30000) + ) + + res <- comp_bin(dat, ~x, width = 10000, boundary = dat$x[1], pad = FALSE) + expect_identical(res$count_, c(1L, 0L, 1L)) + expect_identical(res$xmin_[1], dat$x[1]) + expect_identical(res$xmax_[3], dat$x[2]) + + res <- comp_bin(dat, ~x, width = 10000, center = dat$x[1], pad = FALSE) + expect_identical(res$count, c(1L, 0L, 0L, 1L)) + expect_identical(res$xmin_[1], dat$x[1] - 5000) + expect_identical(res$xmax_[4], dat$x[2] + 5000) +}) + + +test_that("Automatic width", { + dat <- data.frame( + num = c(0, 25.0), + num2 = c(0, 50.0), + int = c(1L, 25L), + int2 = c(1L, 50L), + date = as.Date("2013-06-01") + c(0, 100), + posixct = as.POSIXct('2001-06-01 21:00', tz = 'UTC') + c(0, 1000) + ) + + # numeric + res <- suppressMessages(compute_bin(dat, ~num)) + # Need to use expect_equal to deal with FP error + expect_equal(res$width_, rep(25/30, length(res$width_))) + res <- suppressMessages(compute_bin(dat, ~num2)) + expect_equal(res$width_, rep(50/30, length(res$width_))) + + # integer + res <- suppressMessages(compute_bin(dat, ~int)) + expect_true(all(res$width_ == 1L)) + res <- suppressMessages(compute_bin(dat, ~int2)) + expect_true(all(res$width_ == 2L)) + + # Date + res <- suppressMessages(compute_bin(dat, ~date)) + expect_equal(res$width_, rep(100/30, length(res$width_))) + + # POSIXct + res <- suppressMessages(compute_bin(dat, ~posixct)) + expect_equal(res$width_, rep(1000/30, length(res$width_))) +}) + + +test_that("Bin boundaries across groups", { + # Bins should be the same across groups + dat <- data.frame(x = c(0:2, 0:2+0.5), g=c('a','a','a', 'b','b','b')) + res <- dat %>% group_by(g) %>% compute_bin(~x, width = 1, pad = FALSE) + expect_identical(range(res$x_[res$g =='a']), range(res$x_[res$g =='b'])) + expect_identical(dplyr::groups(res), list(quote(g))) + expect_identical(res$count_, rep(1L, 6)) })