tests/testthat/test-functions.R

In connected: Visualize and Improve Connectedness of Factors in Tables

test_that("con_check works", {
  expect_equal(
    con_check(data_eccleston, ~ row + trt),
    structure(
      c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L),
      levels = "1",
      class = "factor"
    )
  )

  expect_equal(
    con_check(data_eccleston, ~ row + col + trt),
    structure(
      c(16L, 1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 12L, 13L, 14L, 15L),
      levels = c(
        "1",
        "2",
        "3",
        "4",
        "5",
        "6",
        "7",
        "8",
        "9",
        "10",
        "11",
        "12",
        "13",
        "14",
        "15",
        "16"
      ),
      class = "factor"
    )
  )
})

test_that("con_check errors on formula names not in data", {
  expect_error(
    con_check(data_eccleston, ~ row + bogus),
    "bogus"
  )
})

test_that("con_view", {
  set.seed(42)
  data_fernando <- transform(data_fernando, y = stats::rnorm(9, mean = 100))
  expect_warning(con_view(
    data_fernando,
    y ~ gen * herd,
    cluster = FALSE,
    main = "Fernando unsorted"
  ))
})

test_that("con_view errors on formula names not in data", {
  expect_error(
    con_view(data_fernando, y ~ gen * bogus),
    "bogus"
  )
})

test_that("con_concur errors on formula names not in data", {
  bar <- transform(lattice::barley, env = factor(paste(site, year)))
  expect_error(
    con_concur(bar, yield ~ variety / bogus),
    "bogus"
  )
})

test_that("con_filter", {
  tab <- data.frame(
    gen = c("G1", "G1", "G1", "G1", "G2", "G2", "G2", "G3"),
    state = c("S1", "S2", "S3", "S4", "S1", "S2", "S4", "S1")
  )
  expect_warning(con_filter(tab, ~ 2 * state / gen))
})

test_that("con_concur", {
  require(lattice)
  bar <- transform(lattice::barley, env = factor(paste(site, year)))
  set.seed(123)
  bar <- bar[sample(1:nrow(bar), 70, replace = TRUE), ]
  expect_silent(
    con_concur(bar, yield ~ variety / env, cex.x = 0.75, cex.y = .3)
  )
})

test_that("aggregating reps", {
  dat <- data.frame(
    y = c(1, 1, 1, 1, 5),
    gen = c('a', 'a', 'b', 'b', 'b'),
    env = c('e1', 'e2', 'e1', 'e2', 'e2')
  )
  library(connected)
  expect_silent(con_view(dat, y ~ gen * env))
  expect_silent(con_view(dat, y ~ gen * env, fun.aggregate = length))
})

test_that("missing values dropped", {
  dat <- data.frame(
    y = c(NA, 1, 1, NA, NA),
    gen = c('a', 'a', 'b', 'b', 'b'),
    env = c('e1', 'e2', 'e1', 'e2', 'e2')
  )
  library(connected)
  expect_warning(con_view(dat, y ~ gen * env))
})

test_that("row/col ticks are the same on multiple plots", {
  # Vanessa asked how multiple "heat" maps could be made to have the same
  # ticks on every plot.  This is why I added the dropNA argument.

  dd1 <- data.frame(
    x = rep(c("E1", "E2"), 2),
    y = rep(c("G1", "G2"), each = 2),
    z1 = c(1, 2, 1.5, 2.5)
  )
  dd2 <- data.frame(
    x = rep(c("E3", "E2"), 2),
    y = rep(c("G3", "G2"), each = 2),
    z2 = c(3, 4, 3.5, 4.5)
  )
  #dd1
  #dd2

  # Create an empty "reference" dataframe with the levels you want
  # to be the same for all plots
  dd0 <- expand.grid(
    x = sort(unique(c(dd1$x, dd2$x))),
    y = sort(unique(c(dd1$y, dd2$y)))
  )

  # Append the trait values to the reference dataframe and plot
  library(dplyr)
  dd1 <- left_join(dd0, dd1)
  library(connected)
  con_view(dd1, z1 ~ x * y, dropNA = FALSE, cluster = FALSE)
  dd2 <- left_join(dd0, dd2)
  expect_silent(con_view(dd2, z2 ~ x * y, dropNA = FALSE, cluster = FALSE))
})