test-join-cols.R
In dplyr: A Grammar of Data Manipulation

test_that("key vars are found", {
  vars <- join_cols(c("x", "y"), c("x", "z"), by = join_by(x))
  expect_equal(vars$x$key, c(x = 1L))
  expect_equal(vars$y$key, c(x = 1L))

  vars <- join_cols(c("a", "x", "b"), c("x", "a"), by = join_by(x))
  expect_equal(vars$x$key, c(x = 2L))
  expect_equal(vars$y$key, c(x = 1L))

  vars <- join_cols(c("x", "y"), c("a", "x", "z"), by = join_by(y == z))
  expect_equal(vars$x$key, c(y = 2L))
  expect_equal(vars$y$key, c(z = 3L))

  vars <- join_cols(c("x", "y"), c("a", "x", "z"), by = join_by(y >= z))
  expect_equal(vars$x$key, c(y = 2L))
  expect_equal(vars$y$key, c(z = 3L))
})

test_that("y key matches order and names of x key", {
  vars <- join_cols(c("x", "y", "z"), c("c", "b", "a"), by = join_by(x == a, y == b))
  expect_equal(vars$x$key, c(x = 1L, y = 2L))
  expect_equal(vars$y$key, c(a = 3L, b = 2L))
})

test_that("duplicate column names are given suffixes", {
  vars <- join_cols(c("x", "y"), c("x", "y"), by = join_by(x))
  expect_equal(vars$x$out, c("x" = 1, "y.x" = 2))
  expect_equal(vars$y$out, c("y.y" = 2))

  # including join vars when keep = TRUE
  vars <- join_cols(c("x", "y"), c("x", "y"), by = join_by(x), keep = TRUE)
  expect_equal(vars$x$out, c("x.x" = 1, "y.x" = 2))
  expect_equal(vars$y$out, c("x.y" = 1, "y.y" = 2))

  vars <- join_cols(c("x", "y"), c("x", "y"), by = join_by(x < x), keep = TRUE)
  expect_equal(vars$x$out, c("x.x" = 1, "y.x" = 2))
  expect_equal(vars$y$out, c("x.y" = 1, "y.y" = 2))

  # suffixes don't create duplicates
  vars <- join_cols(c("x", "y", "y.x"), c("x", "y"), by = join_by(x))
  expect_equal(vars$x$out, c("x" = 1, "y.x" = 2, "y.x.x" = 3))
  expect_equal(vars$y$out, c("y.y" = 2))

  # but not when they're the join vars
  vars <- join_cols(c("A", "A.x"), c("B", "A.x", "A"), by = join_by(A.x))
  expect_named(vars$x$out, c("A.x.x", "A.x"))
  expect_named(vars$y$out, c("B", "A.y"))

  # or when no suffix is requested
  vars <- join_cols(c("x", "y"), c("x", "y"), by = join_by(x), suffix = c("", ".y"))
  expect_equal(vars$x$out, c("x" = 1, "y" = 2))
  expect_equal(vars$y$out, c("y.y" = 2))
})

test_that("duplicate non-equi key columns are given suffixes", {
  vars <- join_cols(c("a", "y", "z"), c("b", "y", "z"), by = join_by(y >= y, z <= z))
  expect_equal(vars$x$out, c("a" = 1, "y.x" = 2, "z.x" = 3))
  expect_equal(vars$y$out, c("b" = 1, "y.y" = 2, "z.y" = 3))
})

test_that("NA names are preserved", {
  vars <- join_cols(c("x", NA), c("x", "z"), by = join_by(x))
  expect_named(vars$x$out, c("x", NA))

  vars <- join_cols(c("x", NA), c("x", NA), by = join_by(x))
  expect_named(vars$x$out, c("x", "NA.x"))
  expect_named(vars$y$out, "NA.y")
})

test_that("by default, `by` columns omitted from `y` with equi-conditions, but not non-equi conditions" , {
  # equi keys always keep the LHS name, regardless of whether of not a duplicate exists in the RHS
  # non-equi keys will get a suffix if a duplicate exists
  vars <- join_cols(c("x", "y", "z"), c("x", "y", "z"), by = join_by(x == y, y > z))
  expect_equal(vars$x$out, c("x" = 1, "y" = 2, "z.x" = 3))
  expect_equal(vars$y$out, c("x.y" = 1, "z.y" = 3))

  # unless specifically requested with `keep = TRUE`
  vars <- join_cols(c("x", "y", "z"), c("x", "y", "z"), by = join_by(x == y, y > z), keep = TRUE)
  expect_equal(vars$x$out, c("x.x" = 1, "y.x" = 2, "z.x" = 3))
  expect_equal(vars$y$out, c("x.y" = 1, "y.y" = 2, "z.y" = 3))
})

test_that("can't mix non-equi conditions with `keep = FALSE` (#6499)", {
  expect_snapshot(error = TRUE, {
    join_cols(c("x", "y"), c("x", "z"), by = join_by(x, y > z), keep = FALSE)
  })
  expect_snapshot(error = TRUE, {
    join_cols(c("xl", "xu"), c("yl", "yu"), by = join_by(xl >= yl, xu < yu), keep = FALSE)
  })

  # Doesn't make sense here.
  # With right/full joins we'd have to merge both `yl` and `yu` into `x` somehow.
  expect_snapshot(error = TRUE, {
    join_cols("x", c("yl", "yu"), by = join_by(between(x, yl, yu)), keep = FALSE)
  })

  # Doesn't make sense here.
  # With right/full joins, based on how the binary conditions are generated
  # we'd merge:
  # - `yu` into `xl`
  # - `yl` into `xu`
  # Which can result in `xl` and `xu` columns that don't maintain a `xl <= xu`
  # invariant.
  expect_snapshot(error = TRUE, {
    join_cols(c("xl", "xu"), c("yl", "yu"), by = join_by(overlaps(xl, xu, yl, yu)), keep = FALSE)
  })
})

test_that("can duplicate key between non-equi conditions", {
  vars <- join_cols("x", c("xl", "xu"), by = join_by(x > xl, x < xu))

  expect_identical(vars$x$key, c(x = 1L, x = 1L))
  expect_identical(vars$x$out, c(x = 1L))

  expect_identical(vars$y$key, c(xl = 1L, xu = 2L))
  expect_identical(vars$y$out, c(xl = 1L, xu = 2L))

  expect_identical(
    join_cols("x", c("xl", "xu"), by = join_by(x > xl, x < xu), keep = NULL),
    join_cols("x", c("xl", "xu"), by = join_by(x > xl, x < xu), keep = TRUE)
  )
})

test_that("can't duplicate key between equi condition and non-equi condition", {
  expect_snapshot(error = TRUE, join_cols("x", c("xl", "xu"), by = join_by(x > xl, x == xu)))
  expect_snapshot(error = TRUE, join_cols(c("xl", "xu"), "x", by = join_by(xl < x, xu == x)))
})

test_that("emits useful messages", {
  # names
  expect_snapshot(error = TRUE, join_cols(c("x", "y"), c("y", "y"), join_by(y)))
  expect_snapshot(error = TRUE, join_cols(c("y", "y"), c("x", "y"), join_by(y)))

  xy <- c("x", "y")
  xyz <- c("x", "y", "z")

  # join vars errors
  expect_snapshot(error = TRUE, join_cols(xy, xy, by = as_join_by(list("1", y = "2"))))
  expect_snapshot(error = TRUE, join_cols(xy, xy, by = as_join_by(list(x = "1", "2"))))
  expect_snapshot(error = TRUE, join_cols(xy, xy, by = as_join_by(c("x", NA))))
  expect_snapshot(error = TRUE, join_cols(xy, xy, by = as_join_by(c("aaa", "bbb"))))

  # join vars uniqueness
  expect_snapshot(error = TRUE, join_cols(xy, xy, by = as_join_by(c("x", "x", "x"))))
  expect_snapshot(error = TRUE, join_cols(xyz, xyz, by = join_by(x, x > y, z)))

  # suffixes
  expect_snapshot(error = TRUE, join_cols(xy, xy, by = join_by(x), suffix = "x"))
  expect_snapshot(error = TRUE, join_cols(xy, xy, by = join_by(x), suffix = c("", NA)))
})

# ------------------------------------------------------------------------------
# join_cast_common()

test_that("takes common type", {
  x <- tibble(a = 1, b = 2L)
  y <- tibble(a = 1L, b = 3)

  vars <- join_cols(names(x), names(y), by = join_by(a, b))

  out <- join_cast_common(x, y, vars)

  expect_identical(out$x, tibble(a = 1, b = 2))
  expect_identical(out$y, tibble(a = 1, b = 3))
})

test_that("finalizes unspecified columns (#6804)", {
  vars <- join_cols(x_names = "x", y_names = "x", by = join_by(x))

  x <- tibble(x = NA)
  y <- tibble(x = NA)
  out <- join_cast_common(x, y, vars)
  expect_identical(out$x, tibble(x = NA))
  expect_identical(out$y, tibble(x = NA))

  x <- tibble(x = NA)
  y <- tibble(x = unspecified())
  out <- join_cast_common(x, y, vars)
  expect_identical(out$x, tibble(x = NA))
  expect_identical(out$y, tibble(x = logical()))

  x <- tibble(x = unspecified())
  y <- tibble(x = unspecified())
  out <- join_cast_common(x, y, vars)
  expect_identical(out$x, tibble(x = logical()))
  expect_identical(out$y, tibble(x = logical()))
})

test_that("references original column in `y` when there are type errors (#6465)", {
  x <- tibble(a = 1)
  y <- tibble(b = "1")

  x_key <- x
  y_key <- set_names(y, names(x))

  vars <- join_cols(names(x), names(y), by = join_by(a == b))

  expect_snapshot({
    (expect_error(join_cast_common(x_key, y_key, vars)))
  })
})