FreesearchR/tests/testthat/test-helpers.R

## 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")
  )
})