(Left) join with custom comparator

fun_join.R

#' (Left) join with a custom comparator
#'
#' @param left  data.frame
#' @param right data.frame
#' @param by    names of columns to join by
#' @param fun   custom comparator (see examples)
#'
#' @examples
#' my_df <- data.frame(cyl = c(4, 4, 6, 8), vs = c(0, 1, NA, NA), foo = c("A", "B", "C", "D"))
#' my_fun <- function (e1, e2) (e1 == e2) | is.na(e2)
#' fun_join(mtcars, my_df, by = c("cyl", "vs"), fun = my_fun)
#'
#' @export
fun_join <- function (left, right, by = intersect(names(left), names(right)), fun = `==`) {

  left_data <- as.data.frame(left)
  right_data <- as.data.frame(right)

  # Stack of (logical) matrices. FIXME: Optimize this!
  dn <- list(left = row.names(left_data), right = row.names(right_data), by = by)
  A <- array(NA, dim = lengths(dn), dimnames = as.vector(dn))
  for (j in by) {
    xl <- left_data[, j, drop = TRUE]
    xr <- right_data[, j, drop = TRUE]
    A[, , j] <- outer(xl, xr, fun)
  }

  # Matching rows
  i <- which(apply(A, c("left", "right"), all), arr.ind = TRUE)
  ir <- i[, "right", drop = TRUE]
  il <- i[, "left", drop = TRUE]

  # Don't need any `by` columns from right_data
  jr <- setdiff(names(right_data), by)
  jl <- names(left_data)

  joined <- cbind(left_data[il, jl], right_data[ir, jr, drop = FALSE])
  return(joined)

}

My immediate use case was to allow wildcard matching --- as in the example, where NA is effectively treated as a wildcard.