tests/testthat/test-test_purely.R

test_that("purely decorated function provides correct result", {
  expect_equal((purely(log)(10))$result, log(10))
})


test_that("purely decorated function provides right result", {
  expect_equal((purely(log)(seq(1, 10)))$result, log(seq(1, 10)))
})

test_that("purely decorated function provides NA if problem", {
  expect_equal((purely(log)(-10))$result, NA)
})

test_that("purely decorated function log", {
  expect_type((purely(log)(-10))$log, "character")
})

test_that("compose purely decorated functions", {

  pure_sqrt <- purely(sqrt)
  pure_mean <- purely(mean)
  pure_exp <- purely(exp)

  result_pipe <- 1:10 |>
    pure_sqrt() %>=%
    pure_exp() %>=%
    pure_mean()

  expect_equal(result_pipe$result, mean(exp(sqrt(1:10))))

})


test_that("compose purely decorated dplyr functions on data.frame", {

  pure_select <- purely(dplyr::select)
  pure_filter <- purely(dplyr::filter)
  pure_summarise <- purely(dplyr::summarise)

  result_pure <- mtcars |>
    pure_select(am, starts_with("c")) %>=%
    pure_filter(am == 1) %>=%
    pure_summarise(mean_cyl = mean(cyl))

  result_impure <- mtcars |>
    dplyr::select(am, starts_with("c")) |>
    dplyr::filter(am == 1) |>
    dplyr::summarise(mean_cyl = mean(cyl))

  expect_equal(result_pure$result, result_impure)

})


test_that("compose purely decorated dplyr functions on tibbles", {

  pure_select <- purely(dplyr::select)
  pure_filter <- purely(dplyr::filter)
  pure_summarise <- purely(dplyr::summarise)

  result_pure <- mtcars |>
    tibble::as_tibble() |>
    pure_select(am, starts_with("c")) %>=%
    pure_filter(am == 1) %>=%
    pure_summarise(mean_cyl = mean(cyl))

  result_impure <- mtcars |>
    tibble::as_tibble() |>
    dplyr::select(am, starts_with("c")) |>
    dplyr::filter(am == 1) |>
    dplyr::summarise(mean_cyl = mean(cyl))

  expect_equal(result_pure$result, result_impure)

})


test_that("test group_by", {

  pure_group_by <- purely(dplyr::group_by)

  expect_equal(dplyr::group_by(mtcars, carb), pure_group_by(mtcars, carb)$result)

})
b-rodrigues/loud documentation built on April 8, 2022, 12:32 p.m.