tests/testthat/test-xlr_table.R

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

test_that("new_xlr_table() creates an S3 class with the correct types", {

  test_object <- new_xlr_table(mtcars,
                                title = "test_title",
                                footnote = "test_footnote")

  expect_s3_class(test_object,"xlr_table")
})

test_that("xlr_table() does not lose xlr_types if they exist already", {


  x <- data.frame(b_int = xlr_integer(1:100,xlr_format(font_size=11)),
                  b_pct = xlr_percent(1:100/100),
                  b_dbl = xlr_numeric(1:100),
                  d_vctr = xlr_vector(as.character(1:100)))
  x_xlr <- xlr_table(x)

  expect_s3_class(x_xlr$b_int,"xlr_integer")
  expect_s3_class(x_xlr$b_pct,"xlr_percent")
  expect_s3_class(x_xlr$b_dbl,"xlr_numeric")
  expect_s3_class(x_xlr$d_vctr,"xlr_vector")
})


test_that("xlr_table() converts types appropriately", {


  x <- data.frame(test_int = as.integer(1:100),
                  test_dbl = as.double(1:100/100),
                  test_num = as.double(1:100),
                  test_char = as.character(1:100),
                  test_factor = factor(rep(c("a","b","c","d"),25),
                                       levels = c("a","b","c","d"))
                  )
  x_xlr <- xlr_table(x)

  expect_s3_class(x_xlr$test_int,"xlr_integer")
  expect_s3_class(x_xlr$test_dbl,"xlr_numeric")
  expect_s3_class(x_xlr$test_num,"xlr_numeric")
  expect_s3_class(x_xlr$test_char,"xlr_vector")
  expect_s3_class(x_xlr$test_factor,"xlr_vector")
})

test_that("xlr_table() prints correctly", {

  x <- data.frame(b_int = xlr_integer(1:100,xlr_format(font_size=11)),
                  b_pct = xlr_percent(1:100/100),
                  b_dbl = xlr_numeric(1:100),
                  d_vctr = xlr_vector(as.character(1:100)))
  x_xlr <- xlr_table(x)

  expect_snapshot(print(x_xlr))
  # now test that the title prints correctly
  expect_snapshot(print(xlr_table(x_xlr,title = "test")))
  expect_snapshot(print(xlr_table(x_xlr,footnote = "test")))
  expect_snapshot(print(xlr_table(x_xlr,"test_title","test_footnote")))
})


test_that("is_xlr_table() correctly identifies the class", {

  x <- data.frame(b_int = xlr_integer(1:100,xlr_format(font_size=11)),
                  b_pct = xlr_percent(1:100/100),
                  b_dbl = xlr_numeric(1:100),
                  d_vctr = xlr_vector(as.character(1:100)))
  x_xlr <- xlr_table(x)

  expect_true(is_xlr_table(x_xlr))
  expect_false(is_xlr_table(x))
  expect_false(is_xlr_table(mtcars))
})


test_that("as_xlr_table() correctly converts the class", {

  x <- data.frame(b_int = xlr_integer(1:100,xlr_format(font_size=11)),
                  b_pct = xlr_percent(1:100/100),
                  b_dbl = xlr_numeric(1:100),
                  d_vctr = xlr_vector(as.character(1:100)))

  expect_s3_class(as_xlr_table(x),"xlr_table")
  expect_s3_class(as_xlr_table(mtcars),"xlr_table")
  expect_s3_class(as_xlr_table(tibble::tibble(mtcars)),"xlr_table")
  expect_s3_class(as_xlr_table(data.table::as.data.table(mtcars)),"xlr_table")


})


test_that("xlr_table and dplyr verbs are compatiable", {

  x <- data.frame(b_int = xlr_integer(1:100,xlr_format(font_size=11)),
                  b_pct = xlr_percent(1:100/100),
                  b_dbl = xlr_numeric(1:100),
                  d_vctr = xlr_vector(as.character(1:100)),
                  test_num = as.double(1:100),
                  test_char = as.character(1:100),
                  test_factor = factor(rep(c("a","b","c","d"),25),
                                       levels = c("a","b","c","d"))
  )

  x <- xlr_table(x)

  expect_s3_class(dplyr::mutate(x,test_num=as_xlr_numeric(test_num)),"xlr_table")
  expect_s3_class(dplyr::arrange(x,dplyr::desc(b_dbl)),"xlr_table")
  expect_s3_class(dplyr::filter(x,b_int != 2L),"xlr_table")
  expect_s3_class(dplyr::select(x,b_int),"xlr_table")
  expect_s3_class(dplyr::rename(x,umm = b_int),"xlr_table")
  expect_s3_class(dplyr::slice(x,dplyr::n()),"xlr_table")
  expect_s3_class(dplyr::summarise(x,test = dplyr::n()),"xlr_table")
  expect_s3_class(dplyr::summarize(x,test = dplyr::n()),"xlr_table")
})

test_that("update_theme() updates the theme correctly",{
  x <- data.frame(b_int = xlr_integer(1:100,xlr_format(font_size=11)),
                  b_pct = xlr_percent(1:100/100),
                  b_dbl = xlr_numeric(1:100),
                  d_vctr = xlr_vector(as.character(1:100)),
                  test_num = as.double(1:100),
                  test_char = as.character(1:100),
                  test_factor = factor(rep(c("a","b","c","d"),25),
                                       levels = c("a","b","c","d"))
  )

  x <- xlr_table(x,"title test","footnote test")
  x <- update_theme(x,
                    xlr_format(font_size=11),
                    xlr_format(font_size=12,font_colour = "blue"),
                    xlr_format(font_size=88,font_colour = "red"))
  # now check update footnotes is correct
  expect_equal(pull_title_format(x), xlr_format(font_size=11))
  expect_equal(pull_footnote_format(x), xlr_format(font_size=12,
                                                    font_colour = "blue"))
  expect_equal(pull_column_heading_format(x), xlr_format(font_size=88,
                                                          font_colour = "red"))
})

test_that("convert_to_xlr_types does not change xlr_types",{
  expect_equal(convert_to_xlr_types(xlr_numeric(1:100/100)),xlr_numeric(1:100/100))
  expect_equal(convert_to_xlr_types(xlr_percent(1:100/100)),xlr_percent(1:100/100))
  expect_equal(convert_to_xlr_types(xlr_integer(1:100)),xlr_integer(1:100))
  expect_equal(convert_to_xlr_types(xlr_vector(rep("A",100))),xlr_vector(rep("A",100)))
})

test_that("convert_to_xlr_types converts numerics, integers, and factors correctly",{
  expect_true(convert_to_xlr_types(c(1:100/100)) |>
                is_xlr_numeric())
  expect_true(convert_to_xlr_types(1L:100L) |>
                is_xlr_integer())
  expect_true(convert_to_xlr_types(factor(c("a","b","c","c"))) |>
                is_xlr_vector())
})

test_that("convert_to_xlr_types does not convert date",{
  # check it works with the base R dates
  expect_equal(convert_to_xlr_types(as.Date(c("2023-01-01","2023-01-01"))),
               as.Date(c("2023-01-01","2023-01-01")))
  expect_equal(convert_to_xlr_types(as.POSIXct(c("2023-01-01","2023-01-01"))),
               as.POSIXct(c("2023-01-01","2023-01-01")))
  expect_equal(convert_to_xlr_types(as.POSIXlt(c("2023-01-01","2023-01-01"))),
               as.POSIXlt(c("2023-01-01","2023-01-01")))

  # check it works with lubridate dates
  expect_equal(convert_to_xlr_types(lubridate::as_date(c("2023-01-01","2023-01-01"))),
               lubridate::as_date(c("2023-01-01","2023-01-01")))
  expect_equal(convert_to_xlr_types(lubridate::as_datetime(c("2023-01-01","2023-01-01"))),
               lubridate::as_datetime(c("2023-01-01","2023-01-01")))
})