tests/testthat/test-borders.R

In tidytlg: Create TLGs using the 'tidyverse'

library(tibble)

output_directory <- "test_outputs/borders"
testthat::test_that("default uses old format", {
  withr::with_options(list(tidytlg.add_datetime = FALSE), {
    tab <- iris[1:5, ]
    tab$label <- c("Label", rep("", 4))

    withr::with_dir(
      new = testthat::test_path(output_directory),
      code = {
        gentlg(
          tab,
          file = "oldformat", title = "Title1", colspan = list(c("", rep("Measures", 4), "")), footers = "Footer1"
        )
      }
    )
  })

  expect_snapshot_file(test_path(sprintf("%s/oldformat.rtf", output_directory)))
})

testthat::test_that("No borders generates rtf with no borders", {
  withr::with_options(list(tidytlg.add_datetime = FALSE), {
    tab <- iris[1:5, ]
    tab$label <- c("Label", rep("", 4))

    withr::with_dir(
      new = testthat::test_path(output_directory),
      code = {
        gentlg(
          tab,
          file = "noborders",
          title = "Title1",
          colspan = list(c("", rep("Measures", 4), "")),
          footers = "Footer1",
          border_fns = list(no_borders)
        )
      }
    )
  })

  expect_snapshot_file(test_path(sprintf("%s/noborders.rtf", output_directory)))
})

testthat::test_that("Spanning borders in the first row", {
  withr::with_options(list(tidytlg.add_datetime = FALSE), {
    tab <- iris[1:5, ]
    tab$label <- c("Label", rep("", 4))

    withr::with_dir(
      new = testthat::test_path(output_directory),
      code = {
        gentlg(
          tab,
          file = "spanningbordersrow1",
          title = "Title1",
          colspan = list(c("", rep("Measures", 4), "")),
          footers = "Footer1",
          border_fns = list(no_borders, spanning_borders(1))
        )
      }
    )
  })

  expect_snapshot_file(test_path(sprintf("%s/spanningbordersrow1.rtf", output_directory)))
})

testthat::test_that("Inserts separated borders in the second row", {
  withr::with_options(list(tidytlg.add_datetime = FALSE), {
    bmat2 <- matrix(c(0, 1, 1, 1, 0, 0, 0, 0, 0, 0, 1, 2, 1, 1, 1, 1, 1, 1), nrow = 3, ncol = 6, byrow = TRUE)

    tbl <- data.frame(
      label = "Subjects with ≥ 1 concomitant medication",
      col1 = "1 (100.0%)",
      col2 = "1 (100.0%)",
      col3 = "2 (100.0%)",
      col4 = "1 (100.0%)",
      col5 = "3 (100.0%)",
      row_type = "VALUE"
    )

    withr::with_dir(
      new = testthat::test_path(output_directory),
      code = {
        gentlg(
          huxme = tbl,
          orientation = "landscape",
          file = "stubborntest",
          title = "Summary of Concomitant Medications",
          colspan = list(
            c("", "Active Study Agent", "Active Study Agent", "Active Study Agent", "", ""),
            c("", "Treatment 1", "Treatment 2", "Combined", "Placebo", "Total")
          ),
          colheader = c(" Standardized medication name", "N=1", "N=1", "N=2", "N=1", "N=3"),
          wcol = .30,
          bottom_borders = bmat2,
          border_fns = list()
        )
      }
    )
  })

  expect_snapshot_file(test_path(sprintf("%s/stubborntest.rtf", output_directory)))
})

testthat::test_that("Inserts separated borders under the first row for a listing", {
  withr::with_options(list(tidytlg.add_datetime = FALSE), {
    adsl <- cdisc_adsl
    adae <- cdisc_adae

    adsl <- adsl %>%
      filter(SAFFL == "Y") %>%
      select(USUBJID, SAFFL, TRT01AN, TRT01A)

    adae <- adae %>%
      filter(SAFFL == "Y" & TRTEMFL == "Y") %>%
      mutate(
        BSPT = paste(AEBODSYS, "[", AEDECOD, "]"),
        SAEFL = if_else(AESER == "Y", "Yes", "No"),
        DTHFL = if_else(AEOUT == "FATAL", "Yes", "No")
      ) %>%
      select(USUBJID, ASTDY, TRTA, BSPT, AETERM, SAEFL, DTHFL)

    tbl <- inner_join(adsl, adae, by = "USUBJID") %>%
      arrange(TRT01AN, USUBJID, ASTDY) %>%
      select(TRT01A, USUBJID, ASTDY, TRTA, BSPT, AETERM, SAEFL, DTHFL) %>%
      filter(USUBJID %in% c("01-701-1015", "01-701-1023"))

    withr::with_dir(
      new = testthat::test_path(output_directory),
      code = {
        gentlg(
          huxme = tbl,
          tlf = "l",
          orientation = "landscape",
          file = "oldformatlisting",
          title = "Listing of Adverse Events",
          idvars = c("TRT01A", "USUBJID"),
          wcol = 0.15,
          colheader = c(
            "Treatment Group",
            "Subject ID",
            "Study Day of AE",
            "Treatment Period",
            "Body System [Preferred Term]",
            "Verbatim Term",
            "Serious",
            "Fatal"
          )
        )
      }
    )
  })

  expect_snapshot_file(test_path(sprintf("%s/oldformatlisting.rtf", output_directory)))
})