tests/testthat/test-colspan.R

library(tibble)

test_that("colspan works as expected", {
  withr::with_options(
    list(tidytlg.add_datetime = FALSE),
    {
      mtcars2 <- mtcars %>%
        rownames_to_column(var = "USUBJID") %>%
        mutate(
          am = factor(am),
          cyl = factor(cyl),
          gear = factor(gear)
        )

      tab <- freq(
        mtcars2,
        colvar = "cyl",
        rowvar = "am"
      ) %>%
        select(-c("row_type", "group_level"))

      withr::with_dir(
        new = test_path("test_outputs"),
        code = {
          gentlg(
            tab,
            file = "colspan1",
            colspan = list(c("", "All", "All", "All"), c("", "Low", "High", "High"))
          )
        }
      )

      tab <- freq(
        mtcars2 %>%
          tlgsetup(
            var = "cyl",
            column_metadata_file = test_path("test_data/column_metadata_mtcars.xlsx"),
            tbltype = "mtcars2"
          ),
        colvar = "colnbr",
        rowvar = "am"
      ) %>%
        bind_table(
          column_metadata_file = test_path("test_data/column_metadata_mtcars.xlsx"),
          tbltype = "mtcars2"
        ) %>%
        select("label", starts_with("col"))

      withr::with_dir(
        new = test_path("test_outputs"),
        code = {
          gentlg(
            tab,
            file = "colspan2"
          )
        }
      )

      tab <- freq(
        mtcars2,
        colvar = "cyl",
        rowvar = "am"
      ) %>%
        select(-c("row_type", "group_level"))

      withr::with_dir(
        new = test_path("test_outputs"),
        code = {
          gentlg(
            tab,
            file = "colspan3",
            colspan = list(c("", "Low", "High", "High"), c("", "All", "All", "All"))
          )
        }
      )
    }
  )
  expect_snapshot_file(test_path("test_outputs/colspan1.rtf"))
  expect_snapshot_file(test_path("test_outputs/colspan2.rtf"))
  expect_snapshot_file(test_path("test_outputs/colspan3.rtf"))
})

Try the tidytlg package in your browser

Any scripts or data that you put into this service are public.

tidytlg documentation built on June 22, 2024, 10:43 a.m.