Nothing

```
# ------------------------------------------------------------------------------
# `join_by()`
test_that("works with equi conditions", {
by <- join_by(x == y, a == b)
expect_identical(by$x, c("x", "a"))
expect_identical(by$y, c("y", "b"))
expect_identical(by$condition, c("==", "=="))
expect_identical(by$filter, c("none", "none"))
})
test_that("works with non-equi conditions", {
by <- join_by(x == y, a > b, a >= b, a < b, a <= b)
expect_identical(by$x, c("x", rep("a", 4)))
expect_identical(by$y, c("y", rep("b", 4)))
expect_identical(by$condition, c("==", ">", ">=", "<", "<="))
})
test_that("works with `closest()`", {
by <- join_by(x == y, closest(a >= b))
expect_identical(by$x, c("x", "a"))
expect_identical(by$y, c("y", "b"))
expect_identical(by$filter, c("none", "max"))
expect_identical(by$condition, c("==", ">="))
by <- join_by(x == y, closest(a > b))
expect_identical(by$x, c("x", "a"))
expect_identical(by$y, c("y", "b"))
expect_identical(by$filter, c("none", "max"))
expect_identical(by$condition, c("==", ">"))
by <- join_by(x == y, closest(a <= b))
expect_identical(by$x, c("x", "a"))
expect_identical(by$y, c("y", "b"))
expect_identical(by$filter, c("none", "min"))
expect_identical(by$condition, c("==", "<="))
by <- join_by(x == y, closest(a < b))
expect_identical(by$x, c("x", "a"))
expect_identical(by$y, c("y", "b"))
expect_identical(by$filter, c("none", "min"))
expect_identical(by$condition, c("==", "<"))
})
test_that("works with single arguments", {
by <- join_by(a, b)
expect_identical(by$x, c("a", "b"))
expect_identical(by$y, c("a", "b"))
})
test_that("works with character strings", {
by1 <- join_by("a", "b" == "c", closest("d" >= "e"))
by2 <- join_by(a, b == c, closest(d >= e))
expect_identical(by1$condition, by2$condition)
expect_identical(by1$filter, by2$filter)
expect_identical(by1$x, by2$x)
expect_identical(by1$y, by2$y)
})
test_that("works with explicit referencing", {
by <- join_by(x$a == y$b)
expect_identical(by$x, "a")
expect_identical(by$y, "b")
by <- join_by(y$a == x$b)
expect_identical(by$x, "b")
expect_identical(by$y, "a")
})
test_that("join condition is correctly reversed with explicit referencing", {
by <- join_by(y$a == x$a, y$a >= x$a, y$a > x$a, y$a <= x$a, y$a < x$a)
expect_identical(by$condition, c("==", "<=", "<", ">=", ">"))
})
test_that("`closest()` works with explicit referencing", {
by <- join_by(closest(y$a <= x$b), closest(y$a > x$b))
expect_identical(by$x, c("b", "b"))
expect_identical(by$y, c("a", "a"))
expect_identical(by$filter, c("max", "min"))
expect_identical(by$condition, c(">=", "<"))
})
test_that("between conditions expand correctly", {
by <- join_by(between(a, b, c))
expect_identical(by$x, c("a", "a"))
expect_identical(by$y, c("b", "c"))
by <- join_by(between(y$a, x$b, x$c))
expect_identical(by$x, c("b", "c"))
expect_identical(by$y, c("a", "a"))
by <- join_by(between(a, b, c, bounds = "[]"))
expect_identical(by$condition, c(">=", "<="))
by <- join_by(between(a, b, c, bounds = "[)"))
expect_identical(by$condition, c(">=", "<"))
by <- join_by(between(a, b, c, bounds = "(]"))
expect_identical(by$condition, c(">", "<="))
by <- join_by(between(a, b, c, bounds = "()"))
expect_identical(by$condition, c(">", "<"))
by <- join_by(between(y$a, x$b, x$c, bounds = "[]"))
expect_identical(by$condition, c("<=", ">="))
by <- join_by(between(y$a, x$b, x$c, bounds = "[)"))
expect_identical(by$condition, c("<=", ">"))
by <- join_by(between(y$a, x$b, x$c, bounds = "(]"))
expect_identical(by$condition, c("<", ">="))
by <- join_by(between(y$a, x$b, x$c, bounds = "()"))
expect_identical(by$condition, c("<", ">"))
})
test_that("within conditions expand correctly", {
by <- join_by(within(a, b, c, d))
expect_identical(by$x, c("a", "b"))
expect_identical(by$y, c("c", "d"))
expect_identical(by$condition, c(">=", "<="))
by <- join_by(within(y$a, y$b, x$b, x$c))
expect_identical(by$x, c("b", "c"))
expect_identical(by$y, c("a", "b"))
expect_identical(by$condition, c("<=", ">="))
})
test_that("overlaps conditions expand correctly", {
by <- join_by(overlaps(a, b, c, d))
expect_identical(by$x, c("a", "b"))
expect_identical(by$y, c("d", "c"))
by <- join_by(overlaps(y$a, y$b, x$b, x$c))
expect_identical(by$x, c("c", "b"))
expect_identical(by$y, c("a", "b"))
by <- join_by(overlaps(a, b, c, d, bounds = "[]"))
expect_identical(by$condition, c("<=", ">="))
by <- join_by(overlaps(a, b, c, d, bounds = "[)"))
expect_identical(by$condition, c("<", ">"))
by <- join_by(overlaps(a, b, c, d, bounds = "(]"))
expect_identical(by$condition, c("<", ">"))
by <- join_by(overlaps(a, b, c, d, bounds = "()"))
expect_identical(by$condition, c("<", ">"))
by <- join_by(overlaps(y$a, y$b, x$b, x$c, bounds = "[]"))
expect_identical(by$condition, c(">=", "<="))
by <- join_by(overlaps(y$a, y$b, x$b, x$c, bounds = "[)"))
expect_identical(by$condition, c(">", "<"))
by <- join_by(overlaps(y$a, y$b, x$b, x$c, bounds = "(]"))
expect_identical(by$condition, c(">", "<"))
by <- join_by(overlaps(y$a, y$b, x$b, x$c, bounds = "()"))
expect_identical(by$condition, c(">", "<"))
})
test_that("between / overlaps / within / closest can use named arguments", {
by <- join_by(between(a, y_upper = b, y_lower = c))
expect_identical(by$x, c("a", "a"))
expect_identical(by$y, c("c", "b"))
by <- join_by(overlaps(y_lower = c, y_upper = d, x_lower = a, x_upper = b))
expect_identical(by$x, c("a", "b"))
expect_identical(by$y, c("d", "c"))
expect_identical(by$condition, c("<=", ">="))
by <- join_by(overlaps(y_lower = x$c, y_upper = x$d, x_lower = y$a, x_upper = y$b))
expect_identical(by$x, c("d", "c"))
expect_identical(by$y, c("a", "b"))
expect_identical(by$condition, c(">=", "<="))
by <- join_by(within(y_lower = c, y_upper = d, x_lower = a, x_upper = b))
expect_identical(by$x, c("a", "b"))
expect_identical(by$y, c("c", "d"))
expect_identical(by$condition, c(">=", "<="))
by <- join_by(within(y_lower = x$c, y_upper = x$d, x_lower = y$a, x_upper = y$b))
expect_identical(by$x, c("c", "d"))
expect_identical(by$y, c("a", "b"))
expect_identical(by$condition, c("<=", ">="))
by <- join_by(closest(expr = a > b))
expect_identical(by$x, "a")
expect_identical(by$y, "b")
})
test_that("joining by nothing is an error", {
expect_snapshot(error = TRUE, {
join_by()
})
})
test_that("can pass `...` on to wrapped `join_by()`", {
fn <- function(...) {
join_by(...)
}
fn2 <- function(x) {
fn({{x}} == y)
}
expect_identical(fn(x == y, a <= b), join_by(x == y, a <= b))
expect_identical(fn2(a), join_by(a == y))
})
test_that("can wrap `join_by()` and use embracing to inject columns (#6469)", {
fn <- function(x) {
join_by({{x}} == y)
}
expect_identical(fn("foo"), join_by("foo" == y))
# Expression substitution, not quosure evaluation
a <- "foo"
expect_identical(fn(a), join_by(a == y))
# But you can inline with `!!`
expect_identical(fn(!!a), join_by("foo" == y))
fn <- function(x, top) {
join_by(between({{x}}, lower, {{top}}))
}
expect_identical(fn(x, y), join_by(between(x, lower, y)))
})
test_that("can wrap `join_by()` and use embracing to inject expressions", {
fn <- function(expr) {
join_by({{expr}}, a <= b)
}
expect_identical(fn(a == b), join_by(a == b, a <= b))
})
test_that("nicely catches required missing arguments when wrapped", {
fn <- function(x, y) {
join_by({{x}} == {{y}})
}
expect_snapshot(error = TRUE, fn(a))
})
test_that("allows for namespaced helpers (#6838)", {
# Captures namespaced expression for printing
expect_snapshot(join_by(dplyr::between(x, left, right)))
expect_snapshot(join_by(dplyr::within(xl, xu, yl, yu)))
expect_snapshot(join_by(dplyr::overlaps(xl, xu, yl, yu)))
expect_snapshot(join_by(dplyr::closest(x < y)))
# Underlying values are otherwise the same as non-namespaced version
by <- join_by(dplyr::between(x, left, right))
reference <- join_by(between(x, left, right))
expect_identical(by$condition, reference$condition)
expect_identical(by$filter, reference$filter)
expect_identical(by$x, reference$x)
expect_identical(by$y, reference$y)
})
test_that("has an informative print method", {
expect_snapshot(join_by(a, b))
expect_snapshot(join_by("a", "b"))
expect_snapshot(join_by(a == a, b >= c))
expect_snapshot(join_by(a == a, b >= "c"))
expect_snapshot(join_by(a == a, closest(b >= c), closest(d < e)))
})
test_that("has informative error messages", {
# `=` rather than `==`
expect_snapshot(error = TRUE, join_by(a = b))
# Empty expression
expect_snapshot(error = TRUE, join_by(NULL))
# Improper helper specification
expect_snapshot(error = TRUE, join_by(foo(x > y)))
# Improper separator
expect_snapshot(error = TRUE, join_by(x == y, x ^ y))
# Improper LHS
expect_snapshot(error = TRUE, join_by(x + 1 == y))
# Improper RHS
expect_snapshot(error = TRUE, join_by(x == y + 1))
# Garbage input
expect_snapshot(error = TRUE, join_by(1))
# Call with non-symbol first element
expect_snapshot(error = TRUE, join_by(1()))
# Namespace prefixed helper with non-dplyr namespace
# (typo or re-export, which currently isn't allowed)
expect_snapshot(error = TRUE, join_by(dplyrr::between(x, left, right)))
# Top level usage of `$`
expect_snapshot(error = TRUE, join_by(x$a))
# `$` must only contain x/y on LHS
expect_snapshot(error = TRUE, join_by(z$a == y$b))
expect_snapshot(error = TRUE, join_by(x$a == z$b))
# Extra cautious check for horrible usage of `$`
expect_snapshot(error = TRUE, join_by(`$`(x+1, y) == b))
# Referencing the same table
expect_snapshot(error = TRUE, join_by(x$a == x$b))
expect_snapshot(error = TRUE, join_by(y$a == b))
expect_snapshot(error = TRUE, join_by(between(x$a, x$a, x$b)))
expect_snapshot(error = TRUE, join_by(within(x$a, x$b, x$a, x$b)))
expect_snapshot(error = TRUE, join_by(overlaps(a, b, x$a, x$b)))
expect_snapshot(error = TRUE, join_by(closest(x$a >= x$b)))
# Referencing different tables in lower/upper bound pairs
expect_snapshot(error = TRUE, join_by(between(a, x$a, y$b)))
expect_snapshot(error = TRUE, join_by(within(x$a, y$b, y$a, y$b)))
expect_snapshot(error = TRUE, join_by(overlaps(x$a, x$b, y$a, x$b)))
# Too few arguments
expect_snapshot(error = TRUE, join_by(`>`(x)))
expect_snapshot(error = TRUE, join_by(between(x)))
expect_snapshot(error = TRUE, join_by(within(x)))
expect_snapshot(error = TRUE, join_by(overlaps(x)))
expect_snapshot(error = TRUE, join_by(closest()))
expect_snapshot(error = TRUE, join_by(`$`(x) > y))
# Too many arguments
expect_snapshot(error = TRUE, join_by(closest(a >= b, 1)))
# `==` in `closest()`
expect_snapshot(error = TRUE, join_by(closest(a == b)))
# Non-expression in `closest()`
expect_snapshot(error = TRUE, join_by(closest(x)))
expect_snapshot(error = TRUE, join_by(closest(1)))
# Invalid expression in `closest()`
expect_snapshot(error = TRUE, join_by(closest(x + y)))
# Invalid `bounds` in `between()` and `overlaps()`
expect_snapshot(error = TRUE, join_by(between(x, lower, upper, bounds = 1)))
expect_snapshot(error = TRUE, join_by(between(x, lower, upper, bounds = "a")))
expect_snapshot(error = TRUE, join_by(overlaps(x, y, lower, upper, bounds = 1)))
expect_snapshot(error = TRUE, join_by(overlaps(x, y, lower, upper, bounds = "a")))
# Non-empty dots in `between()` and `overlaps()`
expect_snapshot(error = TRUE, join_by(between(x, lower, upper, foo = 1)))
expect_snapshot(error = TRUE, join_by(overlaps(x, y, lower, upper, foo = 1)))
})
# ------------------------------------------------------------------------------
# `as_join_by()`
test_that("as_join_by() emits useful errors", {
expect_snapshot(error = TRUE, as_join_by(FALSE))
})
# ------------------------------------------------------------------------------
# `join_by_common()`
test_that("automatically finds common variables", {
x_names <- c("x", "y")
y_names <- c("x", "z")
expect_message(by <- join_by_common(x_names, y_names))
expect_identical(by$x, "x")
expect_identical(by$y, "x")
})
test_that("join_by_common() emits useful information", {
# Common by message
expect_snapshot(by <- join_by_common(c("x", "y"), c("x", "y")))
# Works with names that need backticks
expect_snapshot(by <- join_by_common(c("_x", "foo bar"), c("_x", "foo bar")))
# No common variables error
expect_snapshot(error = TRUE, join_by_common(c("x", "y"), c("w", "z")))
})
```

**Any scripts or data that you put into this service are public.**

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.