tests/testthat/test-do.R

In where: Vectorised Substitution and Evaluation

library(dplyr)
library(ggplot2)

test_that("test run function", {
  # Expression only
  expect_equal(run(1 + 1), list(2))
  # Error, unused value provided
  expect_error(run(1 + 1, a = 1:2), "some values not in expr")
  # Simple expression, 1 value
  expect_equal(run(a + 1, a = 1:2), list(2, 3))
  # Simple expression, 2 values
  expect_equal(run(a + b, a = 1:2, b = 3:4), list(4, 6))
  # Simple expression, 2 expr values
  expect_equal(run(a + 1, a = .(5, 6)), list(6, 7))

  # Typical expressions
  subgroups <- .(all        = TRUE,
                 long_sepal = Sepal.Length > 6,
                 long_petal = Petal.Length > 5.5)
  functions <- .(mean, sum, prod)

  outs1 <- list(
    one = run(# Typical expression, 1 value
      iris %>%
        filter(subgroup) %>%
        summarise(across(Sepal.Length:Petal.Width,
                         mean),
                  .by = Species),
      subgroup = subgroups
    ),
    two = run(# Typical expression, 2 values
      iris %>%
        filter(subgroup) %>%
        summarise(across(Sepal.Length:Petal.Width,
                         summary),
                  .by = Species),
      subgroup = subgroups,
      summary  = functions
    ),
    two_diff = run(# Typical expression, 2 values, 1 of length 1
      iris %>%
        filter(subgroup) %>%
        summarise(across(Sepal.Length:Petal.Width,
                         summary),
                  .by = Species),
      subgroup = subgroups,
      summary  = mean
    )
  )

  for (out in outs1) {
    expect_equal(names(out), names(subgroups))
    expect_true(all(sapply(out, is.data.frame)))
    expect_equal(sapply(out, nrow), c(all = 3, long_sepal = 2, long_petal = 1))
    expect_equal(out[["all"]][["Sepal.Length"]],
                 as.vector(tapply(iris[["Sepal.Length"]], iris[["Species"]], mean)))
  }
  expect_equal(outs1[["two"]][["long_sepal"]][["Sepal.Width"]],
               with(iris[iris[["Sepal.Length"]]  > 6,],
                    as.vector(tapply(Sepal.Width, as.vector(Species), sum))))
  for (i in seq_along(subgroups))
    expect_identical(outs1[["one"]][[i]],
                     outs1[["two_diff"]][[i]])


  # run within a function
  f <- function(df) run(with(df, df[subgroup, ]),
                       subgroup = subgroups)
  outs2 <- list(all        = f(iris),
                versicolor = f(iris[iris[["Species"]] == "versicolor", ]))

  for (out in outs2) {
    expect_equal(names(out), names(subgroups))
    expect_true(all(sapply(out, is.data.frame)))
  }
  expect_identical(outs2[["all"]],
                   run(with(iris, iris[subgroup, ]), subgroup = subgroups))
  expect_identical(outs2[["versicolor"]],
                   run(with(iris, iris[Species == "versicolor" & subgroup, ]),
                      subgroup = subgroups))

  # run within a function, passing expr
  apply_over_groups <- function(expr,
                                populations = subgroups) {
    e <- parent.frame()
    eval(substitute(run(expr, subgroup = populations, e = e),
                    list(expr = substitute(expr))))
  }

  expect_identical(run(with(iris, iris[subgroup, ]),
                          subgroup = subgroups),
                   apply_over_groups(with(iris, iris[subgroup, ])))

  expect_identical(outs1[["one"]],
                   apply_over_groups(
                     iris %>%
                       filter(subgroup) %>%
                       summarise(across(Sepal.Length:Petal.Width,
                                        mean),
                                 .by = Species)))

  expect_identical(run(ggplot(filter(iris, subgroup),
                                 aes(Sepal.Length, Sepal.Width)) +
                            geom_point() +
                            theme_minimal(),
                          subgroup = subgroups),
                   apply_over_groups(
                     ggplot(filter(iris, subgroup),
                            aes(Sepal.Length, Sepal.Width)) +
                       geom_point() +
                       theme_minimal()))

  # Infix functions
  expect_identical(outs1[[1]],
                   (iris %>%
                      filter(x) %>%
                      summarise(across(Sepal.Length:Petal.Width,
                                       mean),
                                .by = Species)) %for% subgroups)

  expect_identical(outs1[["two_diff"]],
                   (iris %>%
                      filter(subgroup) %>%
                      summarise(across(Sepal.Length:Petal.Width,
                                       summary),
                                .by = Species)) %where% list(subgroup = subgroups,
                                                             summary  = mean))

  expect_equal((a + b) %with% {a = 1
                               b = 2},
               3)

  e <- new.env()
  local((a + b) %with% {a = 1
                        b = 2},
        e)
  expect_length(ls(envir = e), 0)
})