tests/testthat/test08-select-args.R

In fjoin: Data Frame Joins Leveraging 'data.table'

# test select args
# do in one shot using fjoin funcs

desc <- "fjoin_inner with select"
if (PRINT_TEST_NAME) cat("\nTest: ", desc, "\n")
test_that(desc, {
  result <-
    fjoin_inner(DF_A, DF_B, on=c("id_A == id_B", "t_A > t_B"), select="c")
  compare <-
    dplyr::inner_join(DF_A, DF_B, by=dplyr::join_by(id_A == id_B, t_A > t_B), relationship = "many-to-many", na_matches = "never") |>
    dplyr::select(id_A, t_A, t_B, c.x, c.y)
  if (PRINT_TEST_OBJECTS) {print(result); print(compare)}
  expect_true(all.equal(result, compare, check.attributes = FALSE))
})

desc <- "fjoin_left with select"
if (PRINT_TEST_NAME) cat("\nTest: ", desc, "\n")
test_that(desc, {
  result <-
    fjoin_left(DF_A, DF_B, on=c("id_A == id_B", "t_A > t_B"), select="c")
  compare <-
    dplyr::left_join(DF_A, DF_B, by=dplyr::join_by(id_A == id_B, t_A > t_B), relationship = "many-to-many", na_matches = "never") |>
    dplyr::select(id_A, t_A, t_B, c.x, c.y)
  if (PRINT_TEST_OBJECTS) {print(result); print(compare)}
  expect_true(all.equal(result, compare, check.attributes = FALSE))
})

desc <- "fjoin_right with select"
if (PRINT_TEST_NAME) cat("\nTest: ", desc, "\n")
test_that(desc, {
  result <-
    fjoin_right(DF_A, DF_B, on=c("id_A == id_B", "t_A > t_B"), select="c")
  compare <-
    dplyr::right_join(DF_A, DF_B, by=dplyr::join_by(id_A == id_B, t_A > t_B), relationship = "many-to-many", na_matches = "never") |>
    dplyr::select(id_A, t_A, t_B, c.x, c.y)
  if (PRINT_TEST_OBJECTS) {print(result); print(compare)}
  expect_true(all.equal(result, compare, check.attributes = FALSE))
})

desc <- "fjoin_full with select"
if (PRINT_TEST_NAME) cat("\nTest: ", desc, "\n")
test_that(desc, {
  result <-
    fjoin_full(DF_A, DF_B, on=c("id_A == id_B", "t_A > t_B"), select="c")
  compare <-
    dplyr::full_join(DF_A, DF_B, by=dplyr::join_by(id_A == id_B, t_A > t_B), relationship = "many-to-many", na_matches = "never") |>
    dplyr::select(id_A, t_A, t_B, c.x, c.y)
  if (PRINT_TEST_OBJECTS) {print(result); print(compare)}
  expect_true(all.equal(result, compare, check.attributes = FALSE))
})

desc <- "fjoin_left_semi with select"
if (PRINT_TEST_NAME) cat("\nTest: ", desc, "\n")
test_that(desc, {
  result <-
    fjoin_left_semi(DF_A, DF_B, on=c("id_A == id_B", "t_A > t_B"), select="c")
  compare <-
    fjoin_left(DF_A, DF_B, on=c("id_A == id_B", "t_A > t_B"), indicate=TRUE) |>
    data.table::setDT() |>
    _[.join==3, .(id_A, t_A, c)] |>
    unique() |>
    data.table::setDF()
  if (PRINT_TEST_OBJECTS) {print(result); print(compare)}
  expect_true(all.equal(result, compare, check.attributes = FALSE))
})

desc <- "fjoin_right_semi with select"
if (PRINT_TEST_NAME) cat("\nTest: ", desc, "\n")
test_that(desc, {
  result <-
    fjoin_right_semi(DF_A, DF_B, on=c("id_A == id_B", "t_A > t_B"), select="c")
  compare <-
    fjoin_right(DF_A, DF_B, on=c("id_A == id_B", "t_A > t_B"), both=TRUE, indicate=TRUE) |>
    data.table::setDT() |>
    _[.join==3, .(id_B, t_B, c=R.c)] |>
    unique() |>
    data.table::setDF()
  if (PRINT_TEST_OBJECTS) {print(result); print(compare)}
  expect_true(all.equal(result, compare, check.attributes = FALSE))
})

desc <- "fjoin_left_anti with select"
if (PRINT_TEST_NAME) cat("\nTest: ", desc, "\n")
test_that(desc, {
  result <-
    fjoin_left_anti(DF_A, DF_B, on=c("id_A == id_B", "t_A > t_B"), select="c")
  compare <-
    fjoin_left(DF_A, DF_B, on=c("id_A == id_B", "t_A > t_B"), indicate=TRUE) |>
    data.table::setDT() |>
    _[.join==1, .(id_A, t_A, c)] |>
    unique() |>
    data.table::setDF()
  if (PRINT_TEST_OBJECTS) {print(result); print(compare)}
  expect_true(all.equal(result, compare, check.attributes = FALSE))
})

desc <- "fjoin_right_anti with select"
if (PRINT_TEST_NAME) cat("\nTest: ", desc, "\n")
test_that(desc, {
  result <-
    fjoin_right_anti(DF_A, DF_B, on=c("id_A == id_B", "t_A > t_B"), select="c")
  compare <-
    fjoin_right(DF_A, DF_B, on=c("id_A == id_B", "t_A > t_B"), both=TRUE, indicate=TRUE) |>
    data.table::setDT() |>
    _[.join==2, .(id_B, t_B, c=R.c)] |>
    unique() |>
    data.table::setDF()
  if (PRINT_TEST_OBJECTS) {print(result); print(compare)}
  expect_true(all.equal(result, compare, check.attributes = FALSE))
})

# ______________________________________________________________________________

desc <- "fjoin_full with select.x and select.y"
if (PRINT_TEST_NAME) cat("\nTest: ", desc, "\n")
test_that(desc, {
  result <-
    fjoin_full(DF_A, DF_B, on=c("id_A == id_B", "t_A > t_B"), select.x="c", select.y="v_B")
  compare <-
    dplyr::full_join(DF_A, DF_B, by=dplyr::join_by(id_A == id_B, t_A > t_B), relationship = "many-to-many", na_matches = "never") |>
    dplyr::select(id_A, t_A, c.x, t_B, v_B)
  if (PRINT_TEST_OBJECTS) {print(result); print(compare)}
  expect_true(all.equal(result, compare, check.attributes = FALSE))
})

desc <- "fjoin_cross with select.x and select.y"
if (PRINT_TEST_NAME) cat("\nTest: ", desc, "\n")
test_that(desc, {
  result <-
    fjoin_cross(DF_A, DF_B, select.x="c", select.y="v_B")
  compare <-
    dplyr::cross_join(DF_A, DF_B) |>
    dplyr::select(c.x, v_B)
  if (PRINT_TEST_OBJECTS) {print(result); print(compare)}
  expect_true(all.equal(result, compare, check.attributes = FALSE))
})

# ______________________________________________________________________________
# cover dtjoin_semi case-specific DT/DF output class handling that depends on select
# (c.f. dtjoin_anti where common logic for all cases)
test_that("dtjoin_semi (1a) with select, data.table output", {
  # semi 1a
  expect_identical(
    rbind(
      dtjoin_semi(DT_A,DT_B,on="id_A==id_B",select="c"),
      dtjoin_anti(DT_A,DT_B,on="id_A==id_B",select="c")
    )[order(c)],
    DT_A[, .(id_A, c)]
  )
})
test_that("dtjoin_semi (1b) with select, data.table output", {
  # semi 1b
  expect_identical(
    rbind(
      dtjoin_semi(DT_B,DT_A,on="id_B==id_A",select="c"),
      dtjoin_anti(DT_B,DT_A,on="id_B==id_A",select="c")
    )[order(c)],
    DT_B[, .(id_B, c)]
  )
})
test_that("dtjoin_semi (2) with select, data.table output", {
  # semi 2
  expect_identical(
    rbind(
      dtjoin_semi(DT_A,DT_B,on="t_A>t_B",select="c"),
      dtjoin_anti(DT_A,DT_B,on="t_A>t_B",select="c")
    )[order(c)],
    DT_A[, .(t_A, c)]
  )
})
test_that("dtjoin_semi (3) with select, data.table output", {
  # semi 3
  expect_identical(
    rbind(
      dtjoin_semi(DT_A,DT_B,on="t_A>t_B",select="c", mult="first"),
      dtjoin_anti(DT_A,DT_B,on="t_A>t_B",select="c", mult="first")
    )[order(c)],
    DT_A[, .(t_A, c)]
  )
})

# ______________________________________________________________________________
# cover dtjoin with select.DT/select.i, one case not covered by fjoin select.x/select.y tests
test_that("dtjoin with select.DT, data.table output", {
  DT_A2 <- DT_A[, .(id_A, v_A)]
  DT_B2 <- DT_B[, .(id_B, v_B)]
  compare <- dtjoin(DT_A2,DT_B2,on="id_A==id_B")
  expect_identical(
    dtjoin(DT_A2,DT_B2,on="id_A==id_B",select.DT="v_A",select.i=""),
    compare[, .(id_A, v_A)]
  )
  expect_identical(
    dtjoin(DT_A2,DT_B2,on="id_A==id_B",select.DT="",select.i="v_B"),
    compare[, .(id_A, v_B)]
  )
})