tests/testthat/test-xlr_integer.R

In xlr: Create Table Summaries and Export Neat Tables to 'Excel'

test_that("xlr_integer() empty intialisation works correctly", {
  # it should have class xlr_integer
  expect_s3_class(xlr_integer(),"xlr_integer")
  # it should be length zero
  expect_true(length(xlr_integer())==0)
  # it should have the default attributes
  expect_equal(pull_style(xlr_integer()),xlr_format_numeric())
})

test_that("xlr_integer() initialisation works", {
  # it should have class xlr_integer
  expect_s3_class(xlr_integer(1),"xlr_integer")
  # it should have the correct vector length
  expect_equal(length(xlr_integer(1)),1)
  expect_equal(length(xlr_integer(1:100)),100)
  # we can update the attributes
  expect_equal(pull_style(xlr_integer(1,xlr_format(font_size=11))),
               xlr_format(font_size=11))
})

test_that("is_xlr_integer() works",{
  var <- 1
  expect_true(is_xlr_integer(xlr_integer(1)))
  expect_true(is_xlr_integer(xlr_integer(1:10)))
  expect_true(is_xlr_integer(xlr_integer(var)))
  expect_true(is_xlr_integer(xlr_integer(NA)))
  expect_false(is_xlr_integer(NA))
  expect_false(is_xlr_integer(mtcars))
})


test_that("as_xlr_integer() converts numerics correctly",{
  expect_s3_class(as_xlr_integer(1),
                  class = "xlr_integer",
                  exact = FALSE)
  expect_s3_class(as_xlr_integer(1L),
                  class = "xlr_integer",
                  exact = FALSE)
  expect_s3_class(as_xlr_integer(1:10),
                  class = "xlr_integer",
                  exact = FALSE)
})

test_that("as_xlr_integer() converts characters() correctly",{
  expect_s3_class(as_xlr_integer("1"),
                  class = "xlr_integer",
                  exact = FALSE)
  expect_s3_class(as_xlr_integer(paste0(1:100)),
                  class = "xlr_integer",
                  exact = FALSE)
  expect_warning(as_xlr_integer("a"))
  expect_warning(as_xlr_integer("a"))
  expect_warning(as_xlr_integer("a1"))
})


test_that("xlr_integer.format prints the way we want it",{
  # verify_output is very cool, it helps us see if it works
  expect_snapshot(xlr_integer(1:100))
  expect_snapshot(tibble::tibble(test=xlr_integer(0:99)))
})

test_that("symmetry for the prototyping (and that vec_c conversion works)",{
  expect_s3_class(vec_c(xlr_integer(1),1L),
                  class = "xlr_integer",
                  exact = FALSE)
  expect_s3_class(vec_c(1L,xlr_integer(1)),
                  class = "xlr_integer",
                  exact = FALSE)
})

test_that("casting works as expected",{
  expect_s3_class(vec_cast(xlr_integer(1),xlr_integer()),
                  class = "xlr_integer",
                  exact = FALSE)

  # Not sure about the casting behaviour, it doesn't worry about changing
  # to a lower decimal places
  # to be fare this is just styling so it is probably ok

  expect_s3_class(vec_cast(xlr_integer(1),xlr_integer()),
                  class = "xlr_integer",
                  exact = FALSE)
  expect_s3_class(vec_cast(xlr_integer(1),xlr_integer()),
                  class = "xlr_integer",
                  exact = FALSE)
  expect_s3_class(vec_cast(1,xlr_integer(1)),
                  class = "xlr_integer",
                  exact = FALSE)
  expect_type(vec_cast(xlr_integer(1),1L),
              type = "integer")

  # expect that it all works correctly for casting to and
  # from doubles
  expect_type(vec_cast(xlr_integer(1),double()),
              type = "double")
  expect_s3_class(vec_cast(as.double(1),xlr_integer(1)),
                  class = "xlr_integer",
                  exact = FALSE)

})

test_that("Casting within a function works as expected, when casting from a
          xlr_integer to a double()",{
  foo <- function(x){
    new_x <- vec_cast(x, double())
    class(new_x)
  }
  expect_equal(foo(xlr_integer(100)),
               "numeric")
})

# Arithmetic-----------------------------------
test_that("xlr_integers work with different operations n",{
  # test every operation works
  expect_equal(xlr_integer(1)+xlr_integer(1),xlr_integer(2))
  expect_equal(xlr_integer(1)-xlr_integer(0),xlr_integer(1))
  expect_equal(xlr_integer(2)*xlr_integer(1),xlr_integer(2))
  expect_equal(xlr_integer(1)^xlr_integer(2),xlr_integer(1))
  expect_equal(xlr_integer(3)%%xlr_integer(2),xlr_integer(1))

})

test_that("when an operation involves a coersion into a numeric, it
          gives back an xlr_numeric",{

  expect_silent(xlr_integer(1)/xlr_integer(2))
  expect_s3_class(xlr_integer(1)/xlr_integer(2),"xlr_numeric")
  expect_equal(xlr_integer(1)/xlr_integer(2),xlr_numeric(0.5))
})

test_that("xlr_integers should work with all numerics and
          return it's type (we lose the other info)",{

  expect_equal(1+xlr_integer(1),2)
  expect_equal(xlr_integer(1)+1,2)
})

test_that("vec_arith.xlr_integer.xlr_integer raises warning when things don't match",{
  # first check it raises a warning
  expect_snapshot(xlr_integer(1)+xlr_integer(1,style = xlr_format()))
})


test_that("vec_arith.xlr_integer.xlr_integer raises an error when things don't match",{
  # first check it raises a warning
  expect_error(xlr_integer(1)+TRUE,class = "vctrs_error_incompatible")
})

test_that("we can create a ggplot silently",{
  df <- mtcars
  df$test <- xlr_integer(df$cyl)
  expect_silent(ggplot2::ggplot(df,ggplot2::aes(x = test,y=test)))
})

test_that("xlr_integer works with vec_math, median and quantile",{

  expect_equal(sum(xlr_integer(c(1,1))),2)
  expect_equal(median(xlr_integer(c(1,1))),1)

  quant_out <- 1
  names(quant_out) <- "50%"
  expect_equal(quantile(xlr_integer(c(1,1)),0.5),quant_out)
})


test_that("xlr_integer casting can work between xlr types",{
  expect_s3_class(vec_cast(xlr_percent(dp=4),xlr_integer(1)),
                  class = "xlr_integer",
                  exact = FALSE)
  expect_s3_class(c(xlr_integer(1), xlr_percent(dp=4)),
                  class = "xlr_integer",
                  exact = FALSE)

  expect_s3_class(vec_cast(xlr_numeric(1),xlr_integer(1)),
                  class = "xlr_integer",
                  exact = FALSE)
  expect_s3_class(c(xlr_integer(1), xlr_numeric(1)),
                  class = "xlr_integer",
                  exact = FALSE)
})

test_that("xlr_integer casting throughs an error when you lose precision",{
  expect_snapshot(vec_cast(c(1.2,4.2,4.5),xlr_integer()),
                  error = TRUE)
})