tests/testthat/test-insert_empty_rows.R

In tidytlg: Create TLGs using the 'tidyverse'

newrows <- "newrows"
cast_to_char <- function(df) {
  lapply(df, as.character)
}

testthat::test_that("Does not insert rows if the newrows column does not exist", {
  i <- iris[1:10, ]
  i[] <- cast_to_char(i)

  actual <- insert_empty_rows(i)
  testthat::expect_identical(insert_empty_rows(i), i)
})

testthat::test_that("Does not insert rows if the newrows column is all 0s", {
  i <- subset(iris[1:10, ], select = -c(Species))
  i[] <- cast_to_char(i)
  i[[newrows]] <- rep(0, nrow(i))

  testthat::expect_identical(insert_empty_rows(i), i)
})

testthat::test_that("Inserts rows when there are 1s in the newrows column", {
  i <- subset(iris[1:10, ], select = -c(Species))
  i[] <- cast_to_char(i)
  i[[newrows]] <- c(0, 1, 0, 1, 1, 0, 0, 0, 0, 0)

  actual <- insert_empty_rows(i)
  expected_rownames <- as.integer(seq_len(nrow(actual)))
  testthat::expect_identical(attr(actual, "row.names", expected_rownames), expected_rownames)
})

testthat::test_that("Inserts an empty row when the 1 is in the last row of newrows", {
  i <- subset(iris[1:10, ], select = -c(Species))
  i[] <- cast_to_char(i)
  i[[newrows]] <- c(rep(0, 9), 1)

  actual <- insert_empty_rows(i)
  expected_rownames <- as.integer(seq_len(nrow(actual)))
  testthat::expect_identical(attr(actual, "row.names", expected_rownames), expected_rownames)
})

testthat::test_that("Inserts empty rows when there are 2 1s in the last two rows of newros", {
  i <- subset(iris[1:10, ], select = -c(Species))
  i[] <- cast_to_char(i)
  i[[newrows]] <- c(rep(0, 8), 1, 1)

  actual <- insert_empty_rows(i)
  expected_rownames <- as.integer(seq_len(nrow(actual)))
  testthat::expect_identical(attr(actual, "row.names", expected_rownames), expected_rownames)
})

testthat::test_that("Zeroes the newrows column", {
  i <- subset(iris[1:10, ], select = -c(Species))
  i[] <- cast_to_char(i)
  i[[newrows]] <- c(rep(0, 8), 1, 1)

  actual <- insert_empty_rows(i)
  testthat::expect_identical(actual$newrows, rep(0, nrow(actual)))
})

testthat::test_that("Preserves the formatting columns", {
  limit <- 9
  i <- subset(iris[1:limit, ], select = -c(Species))
  i[] <- cast_to_char(i)
  i[[newrows]] <- c(rep(0, limit - 1), 1)
  row_type <- sample(c("S", "T"), size = nrow(i), replace = TRUE)
  anbr <- sample(c("1"), size = nrow(i), replace = TRUE)
  indentme <- sample(c("Y", "N"), size = nrow(i), replace = TRUE)
  roworder <- seq_len(nrow(i))
  i$row_type <- row_type
  i$anbr <- anbr
  i$indentme <- indentme
  i$roworder <- roworder

  actual <- insert_empty_rows(i)
  testthat::expect_identical(actual$row_type, c(row_type[-length(row_type)], "EMPTY", row_type[length(row_type)]))
  testthat::expect_identical(actual$anbr, c(anbr, "1"))
  testthat::expect_identical(actual$indentme, c(indentme[-length(row_type)], "0", indentme[length(row_type)]))
  testthat::expect_identical(actual$roworder, seq_len(nrow(actual)))
})

testthat::test_that("Inserts empty rows when the input table has newrows", {
  output_directory <- "test_outputs/emptyrowsinsertions"
  withr::with_options(
    list(tidytlg.add_datetime = FALSE),
    {
      library(dplyr)
      library(tidytlg)

      # Note cdisc_adsl is built into the package for use
      ittpop <- cdisc_adsl %>%
        filter(ITTFL == "Y")

      # frequency of Intend-to-Treat patients by planned treatment
      tbl1 <- freq(ittpop,
        rowvar = "ITTFL",
        statlist = statlist("n"),
        colvar = "TRT01P",
        rowtext = "Analysis Set:  Intend-to-Treat Population",
        subset = ITTFL == "Y"
      )

      # N, MEAN (SD), MEDIAN, RANGE, IQ Range of age by planned treatment
      tbl2 <- univar(ittpop,
        rowvar = "AGE",
        colvar = "TRT01P",
        row_header = "Age (Years)"
      )

      # frequency of Race by planned treatment
      tbl3 <- freq(ittpop,
        rowvar = "RACE",
        statlist = statlist(c("N", "n (x.x%)")),
        colvar = "TRT01P",
        row_header = "Race, n(%)"
      )

      # combine results together
      tbl <- bind_table(tbl1, tbl2, tbl3)

      # conver to hux object
      withr::with_dir(
        new = testthat::test_path(output_directory),
        code = {
          gentlg(
            huxme = tbl,
            orientation = "landscape",
            file = "inserts",
            title = "Custom Method",
            footers = "Produced with tidytlg",
            colspan = list(c("", "", "Xanomeline", "Xanomeline")),
            colheader = c("", "Placebo", "High", "Low"),
            wcol = .30
          )
        }
      )
    }
  )
  expect_snapshot_file(test_path(sprintf("%s/inserts.rtf", output_directory)))
})