tests/testthat/test.plot.xbal.R

In RItools: Randomization Inference Tools

################################################################################
# Tests for plotting functions
################################################################################

library("testthat")

context("Plotting Functions")

shouldplot <- function() {
  Sys.getenv("SHOULDPLOT")[1] == "1"
}

test_that("Basic plot", {
  # create a quick xBalance result
  set.seed(20121119)
  Z <- rep(c(0,1), 10)
  df <- data.frame(Z = Z,
                   X1 = rnorm(20, mean = Z*2),
                   X2 = rnorm(20, mean = Z*3),
                   X3 = rnorm(20, mean = Z * -1),
                   X4 = rnorm(20, mean = Z * -0.5))

  xb <- xBalance(Z ~ ., data = df)

  if (shouldplot()) {

    x11() # this might be more common than quartz
    expect_true(dev.capabilities()$capture)

    plot(xb)
    p1 <- dev.capture()
    dev.off()

    x11()
    plot(xb)
    p2 <- dev.capture()
    expect_true(class(p1) == "matrix" & class(p2) == "matrix")
    expect_identical(p1, p2) # just to prove that the same plot twice is really identical
    dev.off()

    opts <- options(warn = 2)
    # has a an argument to make only a right-sided abs difference plot
    # it will be a warning if absolute isn't a parameter
    x11()
    plot(xb, absolute = T)

    p2 <- dev.capture()
    expect_true(!identical(p1,p2))
    dev.off()

    options(opts)

    x11()
    # has an argument to order the variables (from bottom to bottom)
    plot(subset(xb, vars = c("X1", "X2", "X4", "X3")), ordered = F)
    expect_true(!identical(p1, dev.capture()))
    dev.off()

    # the order the data based on the selected variable
    x11()
    plot(xb, ordered = T)
    expect_true(!identical(p1, dev.capture()))
    dev.off()
    # note: the order should change when absolute = T, but we can't really test it as the plot is then different for two reasons
    # one way to test this would be to have a helper function that creates an array for something else to plot -- and the intermediate data could be checked

    # just a sanity check to make sure that the previous dev.capture tests worked
    x11()
    plot(xb)
    expect_identical(p1, dev.capture())
    dev.off()

    ### Error checking
    expect_error(plot(xb, statistic = "foo"), "statistic")
    expect_error(plot(xb, variable.labels = c("foo")), "labels")
    expect_error(plot(xb, strata.labels = c("foo")), "labels")
  }
  expect_true(TRUE)
})

test_that("Generic balance plots", {
  # the balanceplot function takes a matrix and plots it in the expected fashion
  # this serves as a compliment to the .xbal.plot function

  testmat <- matrix(c(4,3,2,1, 3,-2,-3,2), ncol = 2,
                    dimnames = list(c("Variable 1","Variable Two","Var 3","X4"),
                        c("Stratification 1", "Stratification 2")))
  if (shouldplot()) {

    x11() # this might be more common than quartz
    expect_true(dev.capabilities()$capture)
    dev.off()

    x11()
    balanceplot(testmat)
    p1 <- dev.capture()
    dev.off()

    x11()
    balanceplot(testmat)
    p2 <- dev.capture()
    dev.off()

    expect_identical(p1,p2)

    # no segments between points
    x11()
    balanceplot(testmat, segments = FALSE)
    p.nosegs <- dev.capture()
    dev.off()

    expect_false(identical(p1, p.nosegs))

    # using shapes in the plots
    x11()
    balanceplot(testmat, shapes = 18)
    p.oneshape <- dev.capture()
    dev.off()

    expect_false(identical(p1, p.oneshape))

    x11()
    balanceplot(testmat, shapes = c(18, 18))
    p.oneshape.vec <- dev.capture()
    dev.off()

    expect_true(identical(p.oneshape, p.oneshape.vec))

    x11()
    balanceplot(testmat, shapes = matrix(18, nrow = 4, ncol = 2))
    p.oneshape.mat <- dev.capture()
    dev.off()

    expect_true(identical(p.oneshape.mat, p.oneshape))
               
    x11()
    balanceplot(testmat, shapes = c(15, 16))
    p.twoshapes <- dev.capture()
    dev.off()

    expect_true(identical(p1, p.twoshapes))

    x11()
    balanceplot(testmat, shapes = matrix(c(rep(15, 4), rep(16, 4)), nrow = 4, ncol = 2))
    p.twoshapes.mat <- dev.capture()
    dev.off()

    expect_true(identical(p1, p.twoshapes.mat))
  }
  expect_true(TRUE)
})


test_that("Issue 21: Cairo/pango errors when running plot.xbal", {
  if (capabilities()["cairo"]) {
    set.seed(20130522)

    z <- rbinom(100, size = 1, prob = 1/2)
    x <- rnorm(100)
    y <- 3 * z * x + rnorm(100)
    data <- data.frame(z, x, y)

    xb <- xBalance(z ~ x + y, data = data)
    tmpo <- tempfile()

    # at the moment, I haven't found a way to capture the stderr output from the C level pango function
    # so, we'll just have to know that if the errors appear in the output stream during testing
    # we should come here to see the test case (not the best strategy)

    tmpf <- tempfile()
    svg(tmpf)
    plot(xb)
    dev.off()
    file.remove(tmpf)
  }
  expect_true(TRUE)
})

test_that("balanceplot can group variables", {

  testmat <- matrix(c(4,3,2,1, 3,-2,-3,2), ncol = 2,
                    dimnames = list(c("Variable 1","Variable Two","Var 3","X4"),
                        c("Stratification 1", "Stratification 2")))
  grps <- c("Group 1", "Group 2", "Group 2", "Group 1")

  if (shouldplot()) {

    x11()
    balanceplot(testmat)
    p1 <- dev.capture()
    dev.off()

    x11()
    balanceplot(testmat, groups = grps)
    p2 <- dev.capture()
    dev.off()

    expect_false(identical(p1, p2))

  }
  expect_true(TRUE)
})

test_that("preparing xbalance objects for plotting, includes groups", {

  x <- data.frame(z  = rep(c(TRUE, FALSE), 50),
                  x1 = rnorm(100),
                  x2 = sample(c("A", "B", "C"), 100, replace = T),
                  x3 = sample(c("X", "Y", "Z"), 100, replace = T),
                  x4 = sample(c(T,F), 100, replace = T),
                  x5 = sample(c("A", "B", "C"), 100, replace = T))

  xb <- balanceTest(z ~ x1 * x2 * x3 + strata(x4) + strata(x5), data = x)

  xbp <- RItools:::prepareXbalForPlot(xb)

  grps <- attr(xbp, "groups")

  ### Commenting this out for now.
  ##expect_true(all(grps[!is.na(grps)] %in% c("x2", "x3", "x1:x2", "x2:x3", "x1:x3", "x1:x2:x3")))

  # x1 should not have a group
  expect_equal(sum(is.na(grps)), 1)


})