tests/testthat/test-heat.R

context("heat")
library(ggplot2)

test_that("heat checks arguments properly", {
  data("relhaz", package = "rsimsum")
  data("frailty", package = "rsimsum")
  s <- simsum(data = relhaz, estvarname = "theta", true = -0.5, se = "se", methodvar = "model", by = c("n", "baseline"))
  sm <- multisimsum(data = frailty, par = "par", true = c(trt = -0.50, fv = 0.75), estvarname = "b", se = "se", methodvar = "model")
  expect_error(heat(obj = relhaz))
  expect_error(heat(obj = s, sstat = "something"))
  expect_error(heat(obj = s, sstat = "bias", y = "y"))
  expect_error(heat(obj = s, gpars = list(wrong.parameter = 1)))
  expect_error(heat(obj = sm, sstat = "hello"))
  expect_error(heat(obj = sm, par = "trt", sstat = "hello", y = "y"))
  expect_error(heat(obj = sm, par = "trt", y = "y"))
  expect_error(heat(obj = sm, gpars = list(wrong.parameter = 1)))
})

test_that("heat returns a ggplot object", {
  data("relhaz", package = "rsimsum")
  data("frailty", package = "rsimsum")
  s <- simsum(data = relhaz, estvarname = "theta", true = -0.5, se = "se", methodvar = "model", by = c("n", "baseline"))
  sm <- multisimsum(data = frailty, par = "par", true = c(trt = -0.50, fv = 0.75), estvarname = "b", se = "se", methodvar = "model", by = "fv_dist")
  expect_s3_class(heat(s, sstat = "bias", y = "n"), class = c("gg", "ggplot"))
  expect_s3_class(heat(sm, sstat = "bias", par = "trt", y = "fv_dist"), class = c("gg", "ggplot"))
})

test_that("heat works when changing graphical parameters", {
  data("relhaz", package = "rsimsum")
  s <- simsum(data = relhaz, estvarname = "theta", true = -0.5, se = "se", methodvar = "model", by = c("n", "baseline"))
  heat(s, sstat = "bias", y = "n", gpars = list(target.colour = 1))
  heat(s, sstat = "bias", y = "n", gpars = list(low.colour = 2))
  heat(s, sstat = "bias", y = "n", gpars = list(high.colour = 3))
  heat(s, sstat = "bias", y = "n", gpars = list(fmt = "%.2f"))
  heat(s, sstat = "bias", y = "n", text = TRUE, gpars = list(text.size = 3))
  heat(s, sstat = "bias", y = "n", text = TRUE, gpars = list(text.size = 1))
  heat(s, sstat = "bias", y = "n", text = TRUE, gpars = list(text.size = 0))
  data("frailty", package = "rsimsum")
  sm <- multisimsum(data = frailty, par = "par", true = c(trt = -0.50, fv = 0.75), estvarname = "b", se = "se", methodvar = "model", by = "fv_dist")
  heat(sm, par = "trt", sstat = "bias", y = "fv_dist", gpars = list(target.colour = 1))
  heat(sm, par = "trt", sstat = "bias", y = "fv_dist", gpars = list(low.colour = 2))
  heat(sm, par = "trt", sstat = "bias", y = "fv_dist", gpars = list(high.colour = 3))
  heat(sm, par = "trt", sstat = "bias", y = "fv_dist", gpars = list(fmt = "%.2f"))
  heat(sm, par = "trt", sstat = "bias", y = "fv_dist", text = TRUE, gpars = list(text.size = 3))
  heat(sm, par = "trt", sstat = "bias", y = "fv_dist", text = TRUE, gpars = list(text.size = 1))
  heat(sm, par = "trt", sstat = "bias", y = "fv_dist", text = TRUE, gpars = list(text.size = 0))
})

test_that("heat works with text or not", {
  data("relhaz", package = "rsimsum")
  data("frailty", package = "rsimsum")
  s <- simsum(data = relhaz, estvarname = "theta", true = -0.5, se = "se", methodvar = "model", by = c("n", "baseline"))
  sm <- multisimsum(data = frailty, par = "par", true = c(trt = -0.50, fv = 0.75), estvarname = "b", se = "se", methodvar = "model", by = "fv_dist")
  heat(s, sstat = "bias", y = "n")
  heat(sm, sstat = "bias", par = "trt", y = "fv_dist")
  heat(s, sstat = "se2mean", y = "n")
  heat(sm, sstat = "se2mean", par = "trt", y = "fv_dist")
  heat(s, sstat = "cover", y = "n")
  heat(sm, sstat = "cover", par = "trt", y = "fv_dist")
  heat(s, sstat = "bias", y = "n", text = TRUE)
  heat(sm, sstat = "bias", par = "trt", y = "fv_dist", text = TRUE)
  heat(s, sstat = "se2mean", y = "n", text = TRUE)
  heat(sm, sstat = "se2mean", par = "trt", y = "fv_dist", text = TRUE)
  heat(s, sstat = "cover", y = "n", text = TRUE)
  heat(sm, sstat = "cover", par = "trt", y = "fv_dist", text = TRUE)
})

test_that("heat works with different summary statistics", {
  data("relhaz", package = "rsimsum")
  data("frailty", package = "rsimsum")
  s <- simsum(data = relhaz, estvarname = "theta", true = -0.5, se = "se", methodvar = "model", by = c("n", "baseline"))
  sm <- multisimsum(data = frailty, par = "par", true = c(trt = -0.50, fv = 0.75), estvarname = "b", se = "se", methodvar = "model", by = "fv_dist")
  heat(s, sstat = "nsim", y = "n", target = 1000)
  heat(s, sstat = "thetamean", y = "n")
  heat(s, sstat = "thetamedian", y = "n")
  heat(s, sstat = "se2mean", y = "n")
  heat(s, sstat = "se2median", y = "n")
  heat(s, sstat = "bias", y = "n")
  heat(s, sstat = "empse", y = "n")
  heat(s, sstat = "mse", y = "n")
  heat(s, sstat = "modelse", y = "n")
  heat(s, sstat = "relerror", y = "n")
  heat(s, sstat = "relprec", y = "n")
  heat(s, sstat = "cover", y = "n")
  heat(s, sstat = "bccover", y = "n")
  heat(s, sstat = "power", y = "n")
  heat(sm, sstat = "nsim", par = "trt", y = "fv_dist", target = 1000)
  heat(sm, sstat = "thetamean", par = "trt", y = "fv_dist")
  heat(sm, sstat = "thetamedian", par = "trt", y = "fv_dist")
  heat(sm, sstat = "se2mean", par = "trt", y = "fv_dist")
  heat(sm, sstat = "se2median", par = "trt", y = "fv_dist")
  heat(sm, sstat = "bias", par = "trt", y = "fv_dist")
  heat(sm, sstat = "empse", par = "trt", y = "fv_dist")
  heat(sm, sstat = "mse", par = "trt", y = "fv_dist")
  heat(sm, sstat = "modelse", par = "trt", y = "fv_dist")
  heat(sm, sstat = "relerror", par = "trt", y = "fv_dist")
  heat(sm, sstat = "relprec", par = "trt", y = "fv_dist")
  heat(sm, sstat = "cover", par = "trt", y = "fv_dist")
  heat(sm, sstat = "bccover", par = "trt", y = "fv_dist")
  heat(sm, sstat = "power", par = "trt", y = "fv_dist")
})

test_that("heat throws an error if asking for nsim without target", {
  data("relhaz", package = "rsimsum")
  data("frailty", package = "rsimsum")
  s <- simsum(data = relhaz, estvarname = "theta", true = -0.5, se = "se", methodvar = "model", by = c("n", "baseline"))
  expect_error(heat(s, sstat = "nsim", y = "n"))
  sm <- multisimsum(data = frailty, par = "par", true = c(trt = -0.50, fv = 0.75), estvarname = "b", se = "se", methodvar = "model", by = "fv_dist")
  expect_error(heat(sm, sstat = "nsim", y = "n"))
})

Try the rsimsum package in your browser

Any scripts or data that you put into this service are public.

rsimsum documentation built on June 21, 2018, 5:04 p.m.