tidytlg
Create TLGs using the 'tidyverse'

Package index
Search the tidytlg package
Vignettes
Functions
192
Source code
71
Man pages
33
Home
/
CRAN
/
tidytlg
/
tests/testthat/test-check_args.R

tests/testthat/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)
})

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.

R Package Documentation

rdrr.io home R language documentation Run R code online

Browse R Packages

CRAN packages Bioconductor packages R-Forge packages GitHub packages

We want your feedback!

Note that we can't provide technical support on individual packages. You should contact the package authors for that.
GitHub issue tracker
ian@mutexlabs.com
Personal blog

 
Embedding an R snippet on your website

Add the following code to your website.

For more information on customizing the embed code, read Embedding Snippets.

Close