tests/testthat/test-compute-model-prediction.r

In ggvis: Interactive Grammar of Graphics

context("compute_model_prediction")

test_that("compute_model_prediction preserves datetimes", {
  # Data frame with POSIXct, and zigzag values
  dat <- data.frame(
    d = as.POSIXct('2001-06-11 21:00', tz = 'UTC') + seq(1, 1000, by = 10),
    value = 1:100 + rep(c(-3, 3), 50)
  )
  res <- dat %>% compute_model_prediction(value ~ d, n = 10, model = "lm")
  expect_equal(range(dat$d), range(res$pred_))
})

test_that("compute_model_prediction preserves dates", {
  # Data frame with Date, and zigzag values
  dat <- data.frame(
    d = as.Date('2001-06-11') + seq(1, 1000, by = 10),
    value = 1:100 + rep(c(-3, 3), 50)
  )
  res <- dat %>% compute_model_prediction(value ~ d, n = 10, model = "lm")
  expect_equal(range(dat$d), range(res$pred_))
})

test_that("compute_model_prediction works with datetimes", {
  # Perfectly linear data
  dat <- data.frame(
    d = as.POSIXct('2001-06-11 21:00', tz = 'America/New_York') + 1:10 * 100,
    value = 1:10
  )

  # Tests with various models
  res <- dat %>% compute_model_prediction(value ~ d, n = 10, model = "loess")
  expect_equal(range(dat$d), range(res$pred_))
  expect_equal(attr(dat$d, "tzone"), attr(res$pred_, "tzone"))
  expect_equal(range(dat$value), range(res$resp_))

  res <- dat %>% compute_model_prediction(value ~ d, n = 10, model = "lm")
  expect_equal(range(dat$d), range(res$pred_))
  expect_equal(attr(dat$d, "tzone"), attr(res$pred_, "tzone"))
  expect_equal(range(dat$value), range(res$resp_))

  res <- dat %>% compute_model_prediction(value ~ d, n = 10, model = "glm")
  expect_equal(range(dat$d), range(res$pred_))
  expect_equal(attr(dat$d, "tzone"), attr(res$pred_, "tzone"))
  expect_equal(range(dat$value), range(res$resp_))
})

test_that("compute_model_prediction works with more complex formulas", {
  dat <- data.frame(x = 1:10, y = (1:10 - 5)^2 + 4 * 1:10 + 100)
  res <- dat %>%
          compute_model_prediction(y ~ I(x^2) + x, n = 10, model = "lm") %>%
          setNames( c("x", "y"))
  expect_equal(dat, res)

  dat <- data.frame(x = 1:10, y = 2.5*(1:10)^3 + 7*(1:10)^2 + 4*(1:10) + 100)
  res <- dat %>%
          compute_model_prediction(y ~ poly(x, 3), n = 10, model = "lm") %>%
          setNames( c("x", "y"))
  expect_equal(dat, res)
})


test_that("Can control domain", {
  dat <- data.frame(x = 1:10, y = 5 * (1:10))
  res <- dat %>%
          compute_model_prediction(y ~ x, n = 10, model = "lm", domain = c(11, 20)) %>%
          setNames( c("x", "y"))
  expect_equal(res, data.frame(x = 11:20, y = 5 * (11:20)))
})


test_that("Zero-row inputs", {
  res <- mtcars[0,] %>% compute_model_prediction(wt ~ mpg, model = "lm")
  expect_equal(nrow(res), 0)
  expect_true(setequal(names(res), c("pred_", "resp_")))

  res <- mtcars[0,] %>% compute_model_prediction(wt ~ mpg, model = "lm", se = TRUE)
  expect_equal(nrow(res), 0)
  expect_true(setequal(
    names(res),
    c("pred_", "resp_", "pred_lwr_", "pred_upr_", "pred_se_" )
  ))

  # Smooth
  res <- mtcars[0,] %>% compute_smooth(wt ~ mpg)
  expect_equal(nrow(res), 0)
  expect_true(setequal(names(res), c("pred_", "resp_")))

  # Grouped
  res <- mtcars[0,] %>% group_by(cyl) %>%
    compute_model_prediction(wt ~ mpg, model = "lm", se = FALSE)
  expect_true(setequal(names(res), c("cyl", "pred_", "resp_")))

  res <- mtcars[0,] %>% group_by(cyl) %>%
    compute_model_prediction(wt ~ mpg, model = "lm", se = TRUE)
  expect_true(setequal(
    names(res),
    c("cyl", "pred_", "resp_", "pred_lwr_", "pred_upr_", "pred_se_" )
  ))
})