docs + tests

tests/testthat/test-baseline_table.R

@@ -2,7 +2,11 @@
 ##
 
 test_that("Creates correct table",{
+  ## This is by far the easiest way to test all functions. Based on examples.
   expect_snapshot(create_baseline(mtcars,by.var = "gear", add.p = "yes" == "yes",add.overall = TRUE, theme = "lancet"))
+  expect_snapshot(create_baseline(mtcars,by.var = "none", add.p = FALSE,add.overall = FALSE, theme = "lancet"))
+  expect_snapshot(create_baseline(mtcars,by.var = "test", add.p = FALSE,add.overall = FALSE, theme = "jama"))
+  expect_snapshot(create_baseline(default_parsing(mtcars),by.var = "am", add.p = FALSE,add.overall = FALSE, theme = "nejm"))
 })
 
 test_that("Creates table", {

tests/testthat/test-contrast_text.R

@@ -0,0 +1,15 @@
+test_that("Contrasting works", {
+  colors <- c("#F2F2F2", "blue","red","black","white","gray35")
+
+  expect_snapshot(
+    contrast_text(colors)
+  )
+
+  expect_snapshot(
+    contrast_text(colors,light_text = "blue",dark_text = "grey10", method = "relative", threshold = .1)
+  )
+
+  expect_snapshot(
+    contrast_text(colors,light_text = "blue",dark_text = "grey10", method = "perceived", threshold = .7)
+  )
+})

tests/testthat/test-helpers.R

@@ -0,0 +1,188 @@
+## getfun
+test_that("getfun works", {
+  expect_snapshot(
+    getfun("stats::lm")
+  )
+})
+
+## argsstring2list
+test_that("argsstring2list works", {
+  expect_snapshot(
+    argsstring2list("A=1:5,b=2:4")
+  )
+})
+
+## factorize
+test_that("factorize works", {
+  expect_snapshot(
+    factorize(mtcars, names(mtcars))
+  )
+})
+
+## default_parsing
+test_that("default_parsing works", {
+  expect_snapshot(
+    default_parsing(mtcars)
+  )
+})
+
+## remove_empty_attr
+test_that("remove_empty_attr works", {
+  ds <- mtcars |> lapply(\(.x) REDCapCAST::set_attr(.x, label = NA, attr = "label"))
+
+  expect_snapshot(
+    remove_empty_attr(ds)
+  )
+
+  expect_snapshot(
+    remove_empty_attr(dplyr::bind_cols(ds))
+  )
+
+  expect_snapshot(
+    remove_empty_attr(ds[[1]])
+  )
+})
+## remove_empty_cols
+test_that("remove_empty_cols works", {
+  expect_snapshot(
+    data.frame(a = 1:10, b = NA, c = c(2, NA)) |> remove_empty_cols(cutoff = .5)
+  )
+})
+## append_list
+test_that("append_list works", {
+  ls_d <- list(test = c(1:20))
+  ls_d <- list()
+
+  expect_snapshot(
+    data.frame(letters[1:20], 1:20) |> append_list(ls_d, "letters")
+  )
+
+  expect_snapshot(
+    letters[1:20] |> append_list(ls_d, "letters")
+  )
+})
+
+
+## missing_fraction
+test_that("missing_fraction works", {
+  expect_snapshot(
+    c(NA, 1:10, rep(NA, 3)) |> missing_fraction()
+  )
+})
+
+
+## data_description
+test_that("data_description works", {
+  expect_snapshot(
+    data.frame(
+      sample(1:8, 20, TRUE),
+      sample(c(1:8, NA), 20, TRUE)
+    ) |> data_description(data_text = "This data")
+  )
+})
+
+## data_type_filter()
+
+test_that("Data type filter works", {
+  expect_snapshot(
+    default_parsing(mtcars) |> data_type_filter(type = c("categorical", "continuous"))
+  )
+
+  expect_snapshot(
+    default_parsing(mtcars) |> data_type_filter(type = NULL)
+  )
+
+  expect_error(default_parsing(mtcars) |> data_type_filter(type = "test"))
+})
+
+## sort_by
+test_that("sort_by works", {
+  expect_snapshot(
+    sort_by(c("Multivariable", "Univariable"), c("Univariable", "Minimal", "Multivariable"))
+  )
+})
+
+## if_not_missing
+test_that("if_not_missing works", {
+  expect_snapshot(
+    NULL |> if_not_missing("new")
+  )
+
+  expect_snapshot(
+    c(2, "a", NA) |> if_not_missing()
+  )
+
+  expect_snapshot(
+    "See" |> if_not_missing()
+  )
+})
+
+## merge_expression + pipe_string + expression_string
+test_that("merge_expression, expression_string and pipe_string works", {
+  expect_snapshot(
+    list(
+      rlang::call2(.fn = "select", !!!list(c("cyl", "disp")), .ns = "dplyr"),
+      rlang::call2(.fn = "default_parsing", .ns = "FreesearchR")
+    ) |> merge_expression()
+  )
+
+  expect_snapshot(
+    list(
+      "mtcars",
+      rlang::call2(.fn = "select", !!!list(c("cyl", "disp")), .ns = "dplyr"),
+      rlang::call2(.fn = "default_parsing", .ns = "FreesearchR")
+    ) |>
+      lapply(expression_string) |>
+      pipe_string() |>
+      expression_string("data<-")
+  )
+
+  expect_snapshot(
+    list(
+      as.symbol(paste0("mtcars$", "mpg")),
+      rlang::call2(.fn = "select", !!!list(c("cyl", "disp")), .ns = "dplyr"),
+      rlang::call2(.fn = "default_parsing", .ns = "FreesearchR")
+    ) |>
+      merge_expression() |>
+      expression_string()
+  )
+})
+
+## remove_nested_list
+test_that("remove_nested_list works", {
+  expect_snapshot(
+    dplyr::tibble(a = 1:10, b = rep(list("a"), 10)) |> remove_nested_list()
+  )
+
+  expect_snapshot(
+    dplyr::tibble(a = 1:10, b = rep(list(c("a", "b")), 10)) |>
+      as.data.frame() |>
+      remove_nested_list()
+  )
+})
+
+## set_column_label
+test_that("set_column_label works", {
+  ls <- list("mpg" = "", "cyl" = "Cylinders", "disp" = "", "hp" = "", "drat" = "", "wt" = "", "qsec" = "", "vs" = "", "am" = "", "gear" = "", "carb" = "")
+  ls2 <- c("mpg" = "", "cyl" = "Cylinders", "disp" = "", "hp" = "Horses", "drat" = "", "wt" = "", "qsec" = "", "vs" = "", "am" = "", "gear" = "", "carb" = "")
+  ls3 <- c("mpg" = "", "cyl" = "", "disp" = "", "hp" = "Horses", "drat" = "", "wt" = "", "qsec" = "", "vs" = "", "am" = "", "gear" = "", "carb" = "")
+
+  expect_snapshot(
+    mtcars |>
+      set_column_label(ls) |>
+      set_column_label(ls2) |>
+      set_column_label(ls3)
+  )
+
+  expect_snapshot(
+    rlang::expr(FreesearchR::set_column_label(label = !!ls3)) |> expression_string()
+  )
+})
+## append_column
+test_that("append_column works", {
+  expect_snapshot(
+    mtcars |>
+      dplyr::mutate(mpg_cut = mpg) |>
+      append_column(mtcars$mpg, "mpg_cutter")
+  )
+})