test-check_args.R
In tidytlg: Create TLGs using the 'tidyverse'

mtcars_test <- mtcars
mtcars_test$negnum <- range(-3, 2, 5)
mtcars_test$allna <- as.numeric(NA)
mtcars_test$somena <- rep(c(NA, 4))
mtcars_test$str <- "string"
mtcars_test$USUBJID <- row.names(mtcars_test)
test_eval <- "am"
test_that("checks for univar function correctly", {
  # df
  expect_visible(univar(mtcars_test, colvar = "gear", rowvar = "wt"))
  expect_visible(univar(mtcars_test, colvar = test_eval, rowvar = "wt"))
  expect_error(
    univar(c(1, 2), colvar = "gear", rowvar = "wt"),
    "Argument df to function univar should be type data.frame"
  )
  # rowvar
  expect_visible(univar(mtcars_test, colvar = "gear", rowvar = "somena"))
  expect_error(univar(mtcars_test, colvar = "gear", rowvar = "allna"))
  # geometric estimable check
  expect_error(univar(mtcars_test, colvar = "gear", rowvar = "negnum", statlist = statlist(c("GSD", "GSE"))))
  # wide bool check
  expect_visible(univar(mtcars_test, colvar = "gear", rowvar = "wt", wide = TRUE))
  expect_error(univar(mtcars_test, colvar = "gear", rowvar = "wt", wide = "str"))
  # check statlist
  expect_error(univar(mtcars_test, colvar = "gear", rowvar = "wt", statlist = statlist(c("NOT A STAT"))))
})

test_that("checks for freq function correctly", {
  # df
  expect_visible(freq(mtcars_test, colvar = "gear", rowvar = "cyl"))
  expect_visible(freq(mtcars_test, colvar = "gear", rowvar = test_eval))
  expect_error(
    freq(c(1, 2), colvar = "gear", rowvar = "cyl"),
    ""
  )
})

test_that("checks for nested_freq function correctly", {
  # df
  expect_visible(nested_freq(mtcars_test, colvar = "gear", rowvar = "cyl*carb"))
  expect_visible(nested_freq(mtcars_test, colvar = test_eval, rowvar = "cyl*carb"))
  expect_error(
    nested_freq(c(1, 2), colvar = "gear", rowvar = "cyl*carb"),
    "Argument df to function nested_freq should be type data.frame"
  )
  # rowvar nesting
  expect_visible(nested_freq(mtcars_test, colvar = "gear", rowvar = "cyl*carb"))
  expect_visible(nested_freq(mtcars_test, colvar = "gear", rowvar = "cyl*carb*am"))
  expect_error(
    nested_freq(mtcars_test, colvar = "gear", rowvar = "cyl"),
    "Argument rowvar to function nested_freq is incorrectly formatted."
  )
  expect_error(
    nested_freq(mtcars_test, colvar = "gear", rowvar = "cyl*am*vs*disp"),
    "Argument rowvar to function nested_freq is incorrectly formatted."
  )
})

test_that("check updates to check gentlg", {
  basefreq <- freq(cdisc_adsl,
    rowvar = "ITTFL",
    colvar = "TRT01PN",
    statlist = statlist(c("n"))
  )

  suppressWarnings(expect_error(gentlg(
    huxme = basefreq,
    file = "vignettes/validation/test_code/test_code_output/test",
    title = "Test",
    format = "RTF",
    opath = "ERROR",
    colheader = c("Test", "One", "Two", "The")
  ), "opath 'ERROR' does not exist for function gentlg"))


  expect_error(gentlg(
    huxme = basefreq,
    file = "vignettes/validation/test_code/test_code_output/test",
    title = "Test",
    format = "ERROR",
    colheader = c("Test", "One", "Two", "The")
  ))


  suppressWarnings(expect_error(gentlg(
    huxme = basefreq,
    file = "vignettes/validation/test_code/test_code_output/test",
    title = "Test",
    format = "RTF",
    wcol = c(1, 1),
    colheader = NA
  )), "wcol's length must be 1 or the length of final output")


  suppressWarnings(expect_error(gentlg(
    huxme = basefreq,
    tlf = "Figure",
    file = "vignettes/validation/test_code/test_code_output/test",
    title = "Test",
    format = "RTF",
    plotnames = "ERROR",
    colheader = NA
  ), "plotnames 'ERROR' does not exist for function gentlg"))


  expect_error(gentlg(
    huxme = basefreq,
    tlf = "Figure",
    file = "vignettes/validation/test_code/test_code_output/test",
    title = "Test",
    format = "RTF",
    idvars = "ERROR",
    colheader = NA
  ), "idvars 'ERROR' does not exist in huxme or is all NA for function: gentlg")


  expect_error(gentlg(
    huxme = basefreq,
    file = "vignettes/validation/test_code/test_code_output/test",
    title = "Test",
    format = "RTF",
    orientation = "ERROR"
  ), "orientation 'ERROR' is not either 'landscape' or 'portrait' for function gentlg")
})


test_that("test freq update", {
  expect_error(
    freq(cdisc_adsl,
      rowvar = "RACE",
      colvar = NA,
      statlist = statlist(c("n"))
    ),
    "colvar to function freq should be type character"
  )

  expect_error(
    suppressWarnings(freq(cdisc_adsl,
      rowvar = "RACE",
      colvar = "",
      statlist = statlist(c("n"))
    )),
    "colvar '' does not exist in df or is all NA for function: freq"
  )

  expect_error(
    suppressWarnings(freq(cdisc_adsl,
      rowvar = "RACE",
      colvar = "MISSING",
      statlist = statlist(c("n"))
    )),
    "colvar 'MISSING' does not exist in df or is all NA for function: freq"
  )

  expect_error(
    suppressWarnings(freq(cdisc_adsl,
      rowvar = NA,
      colvar = "RACE",
      statlist = statlist(c("n"))
    )),
    "Argument rowvar to function freq should be type character"
  )

  expect_error(
    freq(cdisc_adsl,
      rowvar = "",
      colvar = "RACE",
      statlist = statlist(c("n"))
    ),
    "rowvar '' does not exist in df or is all NA for function: freq"
  )

  expect_error(
    freq(cdisc_adsl,
      rowvar = "MISSING",
      colvar = "RACE",
      statlist = statlist(c("n"))
    ),
    "rowvar 'MISSING' does not exist in df or is all NA for function: freq"
  )

  expect_error(
    freq(cdisc_adsl,
      rowvar = "RACE",
      colvar = "TRT01P",
      tablebyvar = "MISSING",
      statlist = statlist(c("n"))
    ),
    "tablebyvar 'MISSING' does not exist in df or is all NA for function: freq"
  )

  expect_error(
    freq(cdisc_adsl,
      rowvar = "RACE",
      colvar = "TRT01P",
      rowbyvar = "MISSING",
      statlist = statlist(c("n"))
    ),
    "rowbyvar 'MISSING' does not exist in df or is all NA for function: freq"
  )


  expect_error(freq(cdisc_adsl,
    rowvar = "ITTFL",
    colvar = "TRT01PN",
    statlist = statlist(c("N"))
  ))

  expect_error(freq(cdisc_adsl,
    rowvar = "ITTFL",
    colvar = "TRT01PN",
    statlist = statlist(c())
  ))
  expect_error(freq(cdisc_adsl,
    rowvar = "ITTFL",
    colvar = "TRT01PN",
    statlist = statlist(c("ERROR"))
  ))

  expect_error(freq(cdisc_adsl,
    rowvar = "ITTFL",
    colvar = "ITTFL"
  ), paste0(paste0(c("colvar", "rowvar"), collapse = ", "), " all have value ", "ITTFL", " for function ", "freq", "\n\n"))

  expect_error(freq(cdisc_adsl,
    rowvar = "ITTFL",
    colvar = "TRT01PN",
    rowbyvar = "ITTFL"
  ), paste0(paste0(c("rowvar", "rowbyvar"), collapse = ", "), " all have value ", "ITTFL", " for function ", "freq", "\n\n"))

  expect_error(freq(cdisc_adsl,
    rowvar = "ITTFL",
    colvar = "TRT01PN",
    tablebyvar = "ITTFL"
  ), paste0(paste0(c("tablebyvar", "rowvar"), collapse = ", "), " all have value ", "ITTFL", " for function ", "freq", "\n\n"))

  expect_error(freq(cdisc_adsl,
    rowvar = "ITTFL",
    colvar = "TRT01PN",
    rowbyvar = "TRT01PN"
  ), paste0(paste0(c("colvar", "rowbyvar"), collapse = ", "), " all have value ", "TRT01PN", " for function ", "freq", "\n\n"))

  expect_error(freq(cdisc_adsl,
    rowvar = "ITTFL",
    colvar = "TRT01PN",
    rowbyvar = "TRT01PN"
  ), paste0(paste0(c("colvar", "rowbyvar"), collapse = ", "), " all have value ", "TRT01PN", " for function ", "freq", "\n\n"))

  expect_error(freq(cdisc_adsl,
    rowvar = "ITTFL",
    colvar = "TRT01PN",
    tablebyvar = "TRT01PN"
  ), paste0(paste0(c("colvar", "tablebyvar"), collapse = ", "), " all have value ", "TRT01PN", " for function ", "freq", "\n\n"))

  expect_error(freq(cdisc_adsl,
    rowvar = "ITTFL",
    colvar = "TRT01PN",
    rowbyvar = "SEX",
    tablebyvar = "SEX"
  ), paste0(paste0(c("tablebyvar", "rowbyvar"), collapse = ", "), " all have value ", "SEX", " for function ", "freq", "\n\n"))
})

#' @editor Aidan Ceney
#' @editDate 2022-03-02
test_that("Test univar new checks", {
  expect_error(
    univar(cdisc_advs %>% filter(PARAMCD %in% c("HEIGHT", "WEIGHT")),
      colvar = NULL,
      rowvar = "AVAL",
      statlist = statlist(c("N", "MEAN_CI", "MIN", "MAX")),
      alpha = .10
    ), "Argument colvar to function univar is required but no value has been supplied"
  )

  expect_error(
    univar(cdisc_advs %>% filter(PARAMCD %in% c("HEIGHT", "WEIGHT")),
      colvar = "TRTA",
      rowvar = NULL,
      statlist = statlist(c("N", "MEAN_CI", "MIN", "MAX")),
      alpha = .10
    ), "Argument rowvar to function univar is required but no value has been supplied"
  )

  expect_error(
    # Supress addtional warning
    suppressWarnings({
      univar(cdisc_advs %>% filter(PARAMCD %in% c("HEIGHT", "WEIGHT")),
        colvar = "MISSING",
        rowvar = "AVAL",
        statlist = statlist(c("N", "MEAN_CI", "MIN", "MAX")),
        alpha = .10
      )
    }), "colvar 'MISSING' does not exist in df or is all NA for function: univar"
  )

  expect_error(
    univar(cdisc_advs %>% filter(PARAMCD %in% c("HEIGHT", "WEIGHT")),
      colvar = "TRTA",
      rowvar = "MISSING",
      statlist = statlist(c("N", "MEAN_CI", "MIN", "MAX")),
      alpha = .10
    ), "rowvar 'MISSING' does not exist in df or is all NA for function: univar"
  )

  expect_error(
    univar(cdisc_advs %>% filter(PARAMCD %in% c("HEIGHT", "WEIGHT")),
      colvar = "TRTA",
      rowvar = "AVAL",
      tablebyvar = "MISSING",
      statlist = statlist(c("N", "MEAN_CI", "MIN", "MAX")),
      alpha = .10
    ), "tablebyvar 'MISSING' does not exist in df or is all NA for function: univar"
  )

  expect_error(
    univar(cdisc_advs %>% filter(PARAMCD %in% c("HEIGHT", "WEIGHT")),
      colvar = "TRTA",
      rowvar = "AVAL",
      rowbyvar = "MISSING",
      statlist = statlist(c("N", "MEAN_CI", "MIN", "MAX")),
      alpha = .10
    ), "rowbyvar 'MISSING' does not exist in df or is all NA for function: univar"
  )


  expect_error(
    univar(cdisc_advs %>% filter(PARAMCD %in% c("HEIGHT", "WEIGHT")),
      colvar = "TRTA",
      rowvar = "AVAL",
      statlist = statlist(c()),
      alpha = .10
    )
  )

  expect_error(
    univar(cdisc_advs %>% filter(PARAMCD %in% c("HEIGHT", "WEIGHT")),
      colvar = "TRTA",
      rowvar = "AVAL",
      statlist = statlist(c("")),
      alpha = .10
    )
  )

  expect_error(
    univar(cdisc_advs %>% filter(PARAMCD %in% c("HEIGHT", "WEIGHT")),
      colvar = "TRTA",
      rowvar = "AVAL",
      statlist = statlist(c("ERROR")),
      alpha = .10
    )
  )


  expect_error(
    univar(cdisc_advs %>% filter(PARAMCD %in% c("HEIGHT", "WEIGHT")),
      colvar = "TRTA",
      rowvar = "AVAL",
      tablebyvar = "TRTA",
      alpha = .10
    ), "colvar, tablebyvar all have value TRTA for function univar"
  )




  expect_error(
    univar(cdisc_advs %>% filter(PARAMCD %in% c("HEIGHT", "WEIGHT")),
      colvar = "TRTA",
      rowvar = "AVAL",
      rowbyvar = "TRTA",
      alpha = .10
    ), "colvar, rowbyvar all have value TRTA for function univar"
  )


  expect_error(
    univar(cdisc_advs %>% filter(PARAMCD %in% c("HEIGHT", "WEIGHT")),
      colvar = "TRTA",
      rowvar = "AVAL",
      rowbyvar = "SEX",
      tablebyvar = "SEX",
      alpha = .10
    ), "tablebyvar, rowbyvar all have value SEX for function univar"
  )





  expect_error(
    univar(cdisc_advs %>% filter(PARAMCD %in% c("HEIGHT", "WEIGHT")),
      colvar = "TRTA",
      rowvar = "AVAL",
      alpha = 1.5
    ), "alpha must be a number in between 0 and 1 for function univar"
  )


  expect_error(
    univar(cdisc_advs %>% filter(PARAMCD %in% c("HEIGHT", "WEIGHT")),
      colvar = "TRTA",
      rowvar = "AVAL",
      alpha = -.5
    ), "alpha must be a number in between 0 and 1 for function univar"
  )


  expect_error(
    univar(cdisc_advs %>% filter(PARAMCD %in% c("HEIGHT", "WEIGHT")),
      colvar = "TRTA",
      rowvar = "AVAL",
      precisionby = "SEX"
    )
  )

  expect_error(
    univar(cdisc_advs %>% filter(PARAMCD %in% c("HEIGHT", "WEIGHT")),
      colvar = "TRTA",
      rowvar = "AVAL",
      precisionon = "MISSING"
    ), "precisionon 'MISSING' does not exist in df or is all NA for function: univar"
  )
})

test_that("new check errors nested freq", {
  expect_error(nested_freq(cdisc_adsl,
    rowvar = "STUDYID*RACE",
    colvar = NA,
    statlist = statlist(c("n"))
  ), "Argument colvar to function nested_freq should be type character")

  expect_error(nested_freq(cdisc_adsl,
    rowvar = "RACE",
    colvar = "",
    statlist = statlist(c("n"))
  ), "Argument rowvar to function nested_freq is incorrectly formatted.")

  expect_error(nested_freq(cdisc_adsl,
    rowvar = "STUDYID*RACE",
    colvar = "MISSING",
    statlist = statlist(c("n"))
  ), "colvar 'MISSING' does not exist in df or is all NA for function: nested_freq")

  expect_error(nested_freq(cdisc_adsl,
    rowvar = NA,
    colvar = "RACE",
    statlist = statlist(c("n"))
  ), "Argument rowvar to function nested_freq should be type character")

  expect_error(nested_freq(cdisc_adsl,
    rowvar = "",
    colvar = "RACE",
    statlist = statlist(c("n"))
  ), "Argument rowvar to function nested_freq is incorrectly formatted.")

  expect_error(nested_freq(cdisc_adsl,
    rowvar = "MISSING",
    colvar = "RACE",
    statlist = statlist(c("n"))
  ), "Argument rowvar to function nested_freq is incorrectly formatted.")

  expect_error(nested_freq(cdisc_adsl,
    rowvar = "STUDYID*RACE",
    colvar = "TRT01P",
    tablebyvar = "MISSING",
    statlist = statlist(c("n"))
  ), "tablebyvar 'MISSING' does not exist in df or is all NA for function: nested_freq")

  expect_error(nested_freq(cdisc_adsl,
    rowvar = "STUDYID*RACE",
    colvar = "TRT01P",
    rowbyvar = "MISSING",
    statlist = statlist(c("n"))
  ), "rowbyvar 'MISSING' does not exist in df or is all NA for function: nested_freq")

  expect_error(nested_freq(cdisc_adsl,
    rowvar = "STUDYID*ITTFL",
    colvar = "TRT01PN",
    statlist = statlist(c("N"))
  ))
  expect_error(nested_freq(cdisc_adsl,
    rowvar = "STUDYID*ITTFL",
    colvar = "TRT01PN",
    statlist = statlist(c())
  ))
  expect_error(nested_freq(cdisc_adsl,
    rowvar = "STUDYID*ITTFL",
    colvar = "TRT01PN",
    statlist = statlist(c("ERROR"))
  ))

  expect_error(nested_freq(cdisc_adsl,
    rowvar = "STUDYID*ITTFL",
    colvar = "TRT01PN",
    cutoff = 2,
    cutoff_stat = "ERROR"
  ), "Cutoff stat ERROR for function nested_freq")

  expect_error(nested_freq(cdisc_adsl,
    rowvar = "STUDYID*ITTFL",
    colvar = "ITTFL"
  ), "colvar, nested rowvar 2 all have value ITTFL for function nested_freq")

  expect_error(nested_freq(cdisc_adsl,
    rowvar = "STUDYID*ITTFL",
    colvar = "TRT01PN",
    rowbyvar = "ITTFL"
  ), "rowbyvar, nested rowvar 2 all have value ITTFL for function nested_freq")

  expect_error(nested_freq(cdisc_adsl,
    rowvar = "STUDYID*ITTFL",
    colvar = "TRT01PN",
    tablebyvar = "ITTFL"
  ), "tablebyvar, nested rowvar 2 all have value ITTFL for function nested_freq")

  expect_error(nested_freq(cdisc_adsl,
    rowvar = "STUDYID*ITTFL",
    colvar = "TRT01PN",
    rowbyvar = "TRT01PN"
  ), "colvar, rowbyvar all have value TRT01PN for function nested_freq")

  expect_error(nested_freq(cdisc_adsl,
    rowvar = "STUDYID*ITTFL",
    colvar = "TRT01PN",
    rowbyvar = "TRT01PN"
  ), "colvar, rowbyvar all have value TRT01PN for function nested_freq")

  expect_error(nested_freq(cdisc_adsl,
    rowvar = "STUDYID*ITTFL",
    colvar = "TRT01PN",
    tablebyvar = "TRT01PN"
  ), "tablebyvar all have value TRT01PN for function nested_freq")

  expect_error(nested_freq(cdisc_adsl,
    rowvar = "STUDYID*ITTFL",
    colvar = "TRT01PN",
    rowbyvar = "SEX",
    tablebyvar = "SEX"
  ), "tablebyvar, rowbyvar all have value SEX for function nested_freq")
})


test_that("Errors for check generate results", {
  expect_error(generate_results(NULL))

  expect_error(generate_results(table_metadata))


  expect_error(generate_results(tibble::tribble(~Test, ~tbltype, "TEST", "Test")))


  table_metadata <- tibble::tribble(
    ~anbr, ~func, ~tbltype, ~df, ~colvar, ~rowvar,
    1, "freq", "Test", "Missing", "TRT01PN", "ITTFL"
  )
  col_metadata <- tibble::tribble(
    ~tbltype, ~coldef, ~decode, ~span1,
    "Test", "Xanomeline High Dose", "High Dose", "Xanomeline"
  )
  expect_error(generate_results(tibble::tribble(
    ~anbr, ~func, ~tbltype, ~df, ~colvar, ~rowvar,
    1, "freq", "Test", "Missing", "TRT01PN", "ITTFL"
  ), column_metadata = col_metadata, tbltype = "Test"))


  table_metadata <- tibble::tribble(
    ~anbr, ~func, ~tbltype, ~df, ~colvar, ~rowvar,
    1, "ERROR", "Test", "cdisc_adsl", "TRT01PN", "ITTFL"
  )
  col_metadata <- tibble::tribble(
    ~tbltype, ~coldef, ~decode, ~span1,
    "Test", "Xanomeline High Dose", "High Dose", "Xanomeline"
  )
  expect_error(generate_results(tibble::tribble(
    ~anbr, ~func, ~tbltype, ~df, ~colvar, ~rowvar,
    1, "ERROR", "Test", "cdisc_adsl", "TRT01PN", "ITTFL"
  ), column_metadata = col_metadata, tbltype = "Test"))
})

test_that("Test add_format", {
  basefreq <- freq(cdisc_adsl,
    rowvar = "ITTFL",
    colvar = "TRT01PN",
    statlist = statlist(c("n"))
  )


  expect_error(basefreq %>% add_format(tableby = ""), "tableby '' does not exist in df or is all NA for function: add_format")
  expect_error(basefreq %>% add_format(tableby = NA), "Argument tableby to function add_format should be type character")
  expect_error(basefreq %>% add_format(tableby = "MISSING"), "tableby 'MISSING' does not exist in df or is all NA for function: add_format")
  expect_error(basefreq %>% add_format(groupby = ""), "groupby '' does not exist in df or is all NA for function: add_format")
  expect_error(basefreq %>% add_format(groupby = NA), "Argument groupby to function add_format should be type character")
  expect_error(basefreq %>% add_format(groupby = "MISSING"), "groupby 'MISSING' does not exist in df or is all NA for function: add_format")

  expect_error(basefreq %>% dplyr::select(-row_type) %>% add_format(), "Reqiured fields anbr,  for function add_format")
})

test_that("Sparse dfs pass check_wcol works as expected with sparse dfs", {
  a_freq <- freq(cdisc_adsl,
    rowvar = "ITTFL",
    colvar = "TRT01PN"
  ) %>%
    select(-c("row_type", "group_level"))

  expect_equal(check_wcol(a_freq, c(1, 1, 1, 1)), NULL)
})