tests/testthat/test11-misc-and-edge.R

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

# as-is data.table inputs left intact-------------------------------------------
test_that("as-is data.table inputs left intact", {
  addr_A <- data.table::address(DT_A)
  DT_A_copy <- data.table::copy(DT_A)
  DT_B_copy <- data.table::copy(DT_B)

  dtjoin(DT_A, DT_B, on="id_A == id_B", nomatch.DT=NA, mult.DT="first", indicate=TRUE, show=TRUE)
  expect_equal(addr_A, data.table::address(DT_A))
  expect_true(all.equal(DT_A, DT_A_copy))
  expect_true(all.equal(DT_B, DT_B_copy))

  dtjoin_anti(DT_A, DT_B, on="id_A == id_B", mult.DT="first", show=TRUE)
  expect_equal(addr_A, data.table::address(DT_A))
  expect_true(all.equal(DT_A, DT_A_copy))
  expect_true(all.equal(DT_B, DT_B_copy))

  dtjoin_cross(DT_A, DT_B)
  expect_equal(addr_A, data.table::address(DT_A))
  expect_true(all.equal(DT_A, DT_A_copy))
  expect_true(all.equal(DT_B, DT_B_copy))
})

# data.table outputs do not trigger shallow copy when assigned to------------------
test_that("data.table outputs are good to go", {
  ans <- fjoin_inner(data.table::setkey(data.table::copy(DT_A),"id_A"),DT_B,on=c("id_A==id_B"))
  attr(ans, "sorted") <- "id_A" # previously used this, now `setattr(ans, "sorted", key)`
  expect_warning(ans[, new := 1L], "^A shallow copy of this data.table")

  ans <- fjoin_inner(data.table::setkey(data.table::copy(DT_A),"id_A"),DT_B,on=c("id_A==id_B"))
  expect_no_warning(ans[, new := 1L])
  ans <- fjoin_semi(data.table::setkey(data.table::copy(DT_A),"id_A"),DT_B,on=c("id_A==id_B"))
  expect_no_warning(ans[, new := 1L])
  ans <- fjoin_anti(data.table::setkey(data.table::copy(DT_A),"id_A"),DT_B,on=c("id_A==id_B"))
  expect_no_warning(ans[, new := 1L])
  ans <- fjoin_cross(data.table::setkey(data.table::copy(DT_A),"id_A"),DT_B)
  expect_no_warning(ans[, new := 1L])

  rm(ans)
})

# invalid .DT, .i input---------------------------------------------------------
test_that("invalid input", {
  expect_error(dtjoin(DF_A,letters,on="id"), "^'.i' must be")
  expect_error(dtjoin(letters,letters,on="id"), "^'.DT' must be")
})


# zero-length outputs (esp. with indicate and setDF(list()))--------------------
test_that("empty output", {
  x <- data.frame(id=1)
  y <- data.frame(id=2)
  result <- fjoin_inner(x, y, on="id")
  expect_identical(class(result), c("data.frame"))
  expect_true(nrow(result)==0)
})

test_that("empty output with setDF(list()) and indicate", {
  sf1 <- sf::st_sf(id=1:2, geom=sf::st_sfc(sf::st_point(c(1,1)),sf::st_point(c(2,2))))
  sf2 <- sf::st_sf(id=3:4, geom=sf::st_sfc(sf::st_point(c(3,3)),sf::st_point(c(4,4))))
  result <- fjoin_inner(sf1, sf2, on="id", indicate=TRUE)
  expect_true(nrow(result)==0)
})

test_that("right join with empty right anti-join and indicate", {
  x <- data.frame(id=1)
  expect_no_error(fjoin_right(x,x,on="id",indicate=TRUE))
})

test_that("right join with empty inner join and indicate", {
  x <- data.frame(id=1)
  y <- data.frame(id=2)
  expect_no_error(fjoin_right(x,y,on="id",indicate=TRUE))
})

# natural joins-----------------------------------------------------------------
df1 <- data.frame(id=1:3,a=c("a","a","b"),v1=1L)
df2 <- data.frame(id=2:4,a=c("a","a","b"),v2=2L)
df3 <- df2; names(df3) <- c("i","j","k")

test_that("natural joins", {
  expect_identical(dtjoin(df1,df2,on=NA), dtjoin(df1,df2,on=intersect(names(df1),names(df2))))
  expect_identical(dtjoin_semi(df1,df2,on=NA), dtjoin_semi(df1,df2,on=intersect(names(df1),names(df2))))
  expect_identical(dtjoin_anti(df1,df2,on=NA), dtjoin_anti(df1,df2,on=intersect(names(df1),names(df2))))
})
test_that("'on' is a required argument", {
  expected_error <- "argument \"on\" is missing, with no default"
  expect_error(dtjoin(df1,df2), expected_error)
  expect_error(dtjoin_semi(df1,df2), expected_error)
  expect_error(dtjoin_anti(df1,df2), expected_error)
})
test_that("natural join fails if no common names", {
  expected_error <- "Natural join requested \\('on' = NA\\) but there are no columns with common names"
  expect_error(dtjoin(df1,df3,on=NA), expected_error)
  expect_error(dtjoin_semi(df1,df3,on=NA), expected_error)
  expect_error(dtjoin_anti(df1,df3,on=NA), expected_error)
})
test_that("mock natural join is not allowed", {
  expected_error <- "A natural join \\('on' = NA\\) requires non-NULL inputs"
  expect_error(dtjoin(on=NA), expected_error)
  expect_error(dtjoin_semi(on=NA), expected_error)
  expect_error(dtjoin_anti(on=NA), expected_error)
  expected_error <- "'on' must be a non-empty character vector with no empty strings or NAs"
  expect_error(dtjoin(on=c(NA,NA)))
  expect_error(dtjoin_semi(on=c(NA,NA)))
  expect_error(dtjoin_anti(on=c(NA,NA)))
})

# mock joins--------------------------------------------------------------------
test_that("dtjoin mock", {
  expect_output(dtjoin(on="id"))
  expect_null(dtjoin(on="id"))
  expect_no_error(dtjoin(on="id"))
})

test_that("dtjoin_semi mock", {
  expect_output(dtjoin_semi(on="id"))
  expect_null(dtjoin_semi(on="id"))
  expect_no_error(dtjoin_semi(on="id"))
})

test_that("dtjoin_anti mock", {
  expect_output(dtjoin_anti(on="id"))
  expect_null(dtjoin_anti(on="id"))
  expect_no_error(dtjoin_anti(on="id"))
})

test_that("dtjoin_cross mock", {
  expect_output(dtjoin_cross())
  expect_null(dtjoin_cross())
  expect_no_error(dtjoin_cross())
})

# non-valid/reserved column names-----------------------------------------------
test_that("non-valid column name", {
  x <- data.table::data.table(id=1, `non valid`=1L)
  y <- data.table::copy(x)
  dtjoin(x, y, on=c("id")) |> expect_error()
  dtjoin_semi(x, y, on=c("id")) |> expect_error()
  dtjoin_anti(x, y, on=c("id")) |> expect_error()
  dtjoin_cross(x, y, on=c("id")) |> expect_error()
})

test_that("non-valid join column name in mock join", {
  dtjoin(on=c("non valid")) |> expect_error()
  dtjoin_semi(on=c("non valid")) |> expect_error()
  dtjoin_anti(on=c("non valid")) |> expect_error()
  dtjoin_cross(on=c("non valid")) |> expect_error()
})

test_that("reserved column name", {
  x <- data.table::data.table(id=1, fjoin.blah=1L)
  y <- data.table::copy(x)
  dtjoin(x, y, on=c("id")) |> expect_error()
  dtjoin_semi(x, y, on=c("id")) |> expect_error()
  dtjoin_anti(x, y, on=c("id")) |> expect_error()
  dtjoin_cross(x, y, on=c("id")) |> expect_error()
})

test_that("reserved join column name in mock join", {
  dtjoin(on=c("fjoin.blah")) |> expect_error()
  dtjoin(on=c("fjoin_blah")) |> expect_no_error()
  dtjoin(on=c("blah_fjoin.")) |> expect_no_error()
})

# non-existent join columns-----------------------------------------------------
test_that("dtjoin non-existent join column .DT", {
  dtjoin(DF_A, DF_B, on=c("id_A == id_B", "foo == col1")) |>
    expect_error("Join column\\(s\\) not found in `.DT`: foo")
})

test_that("dtjoin non-existent join column .i", {
  dtjoin(DF_A, DF_B, on=c("id_A == id_B", "t_A == foo")) |>
    expect_error("Join column\\(s\\) not found in `.i`: foo")
})

test_that("dtjoin_semi non-existent join column .DT", {
  dtjoin_semi(DF_A, DF_B, on=c("id_A == id_B", "foo == t_B")) |>
    expect_error("Join column\\(s\\) not found in `.DT`: foo")
})

test_that("dtjoin_semi non-existent join column .i", {
  dtjoin_semi(DF_A, DF_B, on=c("id_A == id_B", "t_A == foo")) |>
    expect_error("Join column\\(s\\) not found in `.i`: foo")
})

test_that("dtjoin_anti non-existent join column .DT", {
  dtjoin_anti(DF_A, DF_B, on=c("id_A == id_B", "foo == t_B")) |>
    expect_error("Join column\\(s\\) not found in `.DT`: foo")
})

test_that("dtjoin_anti non-existent join column .i", {
  dtjoin_anti(DF_A, DF_B, on=c("id_A == id_B", "t_A == foo")) |>
    expect_error("Join column\\(s\\) not found in `.i`: foo")
})

# na.match=FALSE but no equality predicates-------------------------------------
test_that("na.match=FALSE with no equality predicates", {
  out <- capture.output(dtjoin(DF_A, DF_B, on=c("t_A > t_B"), do=FALSE))
  expect_false(any(grepl("na\\.omit", out)))
  out <- capture.output(dtjoin_semi(DF_A, DF_B, on=c("t_A > t_B"), do=FALSE))
  expect_false(any(grepl("na\\.omit", out)))
  out <- capture.output(dtjoin_anti(DF_A, DF_B, on=c("t_A > t_B"), do=FALSE))
  expect_false(any(grepl("na\\.omit", out)))
})