tests/testthat/test-layer.R

In atorus-research/Tplyr: A Traceability Focused Grammar of Clinical Data Summary

## Check empty return ----
test_that("`tplyr_layer` errors when no arguments provided", {
  expect_snapshot_error(tplyr_layer())

})

## Check that the object classes returned are appropriate ----
test_that("tplyr_layer returns a class of `tplyr_layer` and environment when `tplyr_table` is parent", {
  t <- tplyr_table(iris, Sepal.Width)
  l <- group_count(t, target_var=Species)
  expect_s3_class(l, "tplyr_layer")
  expect_s3_class(l, "environment")
})

test_that("tplyr_layer returns a class of `tplyr_subgroup_layer`, `tplyr_layer` and environment when `tplyr_layer` is parent", {
  t <- tplyr_table(iris, Sepal.Width)
  l1 <- group_count(t, target_var=Species)
  l2 <- group_count(l1, target_var=Species)
  expect_s3_class(l2, "tplyr_layer")
  expect_s3_class(l2, "tplyr_subgroup_layer")
  expect_s3_class(l2, "environment")
})

test_that("tplyr_layer returns a class of `tplyr_subgroup_layer`, `tplyr_layer` and environment when `tplyr_subgroup_layer` is parent", {
  t <- tplyr_table(iris, Sepal.Width)
  l1 <- group_count(t, target_var=Species)
  l2 <- group_count(l1, target_var=Species)
  l3 <- group_count(l2, target_var=Species)
  expect_s3_class(l3, "tplyr_layer")
  expect_s3_class(l3, "tplyr_subgroup_layer")
  expect_s3_class(l3, "environment")
})

## Environment checks from a proper call ----

test_that("`Type` attribute is set properly", {
  t <- tplyr_table(iris, Sepal.Width)
  l1 <- group_count(t, target_var=Species)
  expect_s3_class(l1, 'count_layer')
  l2 <- group_desc(t, target_var=Sepal.Length)
  expect_s3_class(l2, 'desc_layer')
  l3 <- group_shift(t, target_var=Species)
  expect_s3_class(l3, 'shift_layer')
})

## Error checks ----
test_that("type field can only contain one of 'count', 'desc', or 'shift'", {
  t <- tplyr_table(iris, Sepal.Width)
  # In order to test type parameter have to test direct access to tplyr_layer
  expect_silent(tplyr_layer(t, target_var=quos(Species), by=quos(NULL), cols=quos(NULL), where=quo(TRUE), type='count'))
  expect_silent(tplyr_layer(t, target_var=quos(Sepal.Length), by=quos(NULL), cols=quos(NULL), where=quo(TRUE), type='desc'))
  expect_silent(tplyr_layer(t, target_var=quos(Species), by=quos(NULL), cols=quos(NULL), where=quo(TRUE), type='shift'))
  expect_snapshot_error(tplyr_layer(t, target_var=quos(Species), by=quos(NULL), cols=quos(NULL), where=quo(TRUE), type=c('shift', 'desc')))
  expect_snapshot_error(tplyr_layer(t, target_var=quos(Species), by=quos(NULL), cols=quos(NULL), where=quo(TRUE), type=c('count', 'desc')))
  expect_snapshot_error(tplyr_layer(t, target_var=quos(Species), by=quos(NULL), cols=quos(NULL), where=quo(TRUE), type=c('count', 'desc', 'shift')))
  expect_snapshot_error(tplyr_layer(t, target_var=quos(Species), by=quos(NULL), cols=quos(NULL), where=quo(TRUE), type="bad"))
})

test_that("Parent must be a `tplyr_table`, `tplyr_layer`, or `tplyr_subgroup_layer`", {
  expect_snapshot_error(group_count(env()))
})

test_that("`by` must me a string, a variable name, or multiple variables submitted using `dplyr::vars`", {
  t <- tplyr_table(iris, Sepal.Width)
  # Safe checks
  expect_silent(group_count(t, target_var=Species, by="character"))
  expect_silent(group_count(t, target_var=Species, by=Petal.Width))
  expect_silent(group_count(t, target_var=Species, by=vars('character', Petal.Width)))
  # Error checks

  expect_snapshot_error(group_count(t, target_var=Species, by=1))
  expect_snapshot_error(group_count(t, target_var=Species, by=list('a', 'b')))
  expect_snapshot_error(group_count(t, target_var=Species, by=c('a', 'b')))
  expect_snapshot_error(group_count(t, target_var=Species, by=vars('character', Petal.Width, 1)))
  expect_snapshot_error(group_count(t, target_var=Species, by=vars('character', Petal.Width, x+y)))
})

test_that("`target_var` must me a string, a variable name, or multiple variables submitted using `dplyr::vars`", {
  t <- tplyr_table(iris, Sepal.Width)
  # Safe checks
  expect_silent(group_count(t, target_var=Species))
  expect_silent(group_count(t, target_var=vars(Petal.Width, Petal.Length)))
  # Error checks
  expect_snapshot_error(group_count(t, target_var=1))
  expect_snapshot_error(group_count(t, target_var=list('a', 'b')))
  expect_snapshot_error(group_count(t, target_var=c('a', 'b')))
  expect_snapshot_error(group_count(t, target_var=vars('character', Petal.Width, 1)))
  expect_snapshot_error(group_count(t, target_var=vars('character', Petal.Width, x+y)))
})


test_that("`target_var` must exist in target dataset", {
  t <- tplyr_table(iris, Sepal.Width)
  # Variable exists
  expect_silent(group_count(t, target_var=Species))
  # Variable does not
  expect_snapshot_error(group_count(t, target_var=BadVar))
  expect_snapshot_error(group_count(t, target_var=vars(Species, BadVar)))
})

test_that("`by` varaibles must exist in the target dataset", {
  t <- tplyr_table(iris, Sepal.Width)
  expect_snapshot_error(group_count(t, target_var=Species, by=BadVars))
  expect_snapshot_error(group_count(t, target_var=Species, by=vars(Species, BadVars)))
})

test_that("`where` must be programming logic (quosure of class 'call')", {
  t <- tplyr_table(iris, Sepal.Width)
  expect_silent(group_count(t, target_var=Species, where=a == b))
  expect_snapshot_error(group_count(t, target_var=Species, where=VARAIBLE))
})

## Coded defaults ----

test_that("`layers` defaults to an empty list with a class of `tplyr_layer_container`", {
  t <- tplyr_table(iris, Sepal.Width)
  l <- group_count(t, target_var=Species)
  expect_s3_class(l$layers, 'tplyr_layer_container')
  expect_s3_class(l$layers, 'list')
  expect_equal(length(l$layers), 0)
})

## Environment checks ----
test_that("Parent of layer is appropraitely parent environment", {
  t <- tplyr_table(iris, Sepal.Width)
  l <- group_count(t, target_var=Species)
  expect_true(identical(env_parent(l), t))
})

# There's some nuance here that makes this tricky so leaving the tests out for now.
# Not much practical use currently anyway.
# test_that("Objects submitted through ellipsis argument appear in environment", {
#   t <- tplyr_table(iris, Sepal.Width)
#   dat <- data.frame(var = c(1,2,3))
#   l <- group_count(t, target_var=Species, dat=dat, a=1, z='c')
#   expect_equal(env_get(l, 'dat'), dat)
#   expect_equal(env_get(l, 'a'), 1)
#   expect_equal(env_get(l, 'z'), 'c')
# })

test_that("Desc layers only accept numeric variables", {

  expect_snapshot_error({tplyr_table(ToothGrowth, dose) %>%
    add_layer(
      group_desc(supp)
    )
  })

  expect_snapshot_error({tplyr_table(ToothGrowth, dose) %>%
      add_layer(
        group_desc(vars(len, supp))
      )
  })

  expect_snapshot_error({tplyr_table(ToothGrowth, dose) %>%
      add_layer(
        group_desc(vars(supp, len))
      )
  })

})