1#' Extract out common by variables
2#'
3#' @export
4#' @keywords internal
5common_by <- function(by = NULL, x, y) UseMethod("common_by", by)
6
7#' @export
8common_by.character <- function(by, x, y) {
9  by <- common_by_from_vector(by)
10  common_by.list(by, x, y)
11}
12
13common_by_from_vector <- function(by) {
14  by <- by[!duplicated(by)]
15  by_x <- names(by) %||% by
16  by_y <- unname(by)
17
18  # If x partially named, assume unnamed are the same in both tables
19  by_x[by_x == ""] <- by_y[by_x == ""]
20
21  list(x = by_x, y = by_y)
22}
23
24#' @export
25common_by.list <- function(by, x, y) {
26  x_vars <- tbl_vars(x)
27  if (!all(by$x %in% x_vars)) {
28    bad_args("by", "can't contain join column {missing} which is missing from LHS.",
29      missing = fmt_obj(setdiff(by$x, x_vars))
30    )
31  }
32
33  y_vars <- tbl_vars(y)
34  if (!all(by$y %in% y_vars)) {
35    bad_args("by", "can't contain join column {missing} which is missing from RHS.",
36      missing = fmt_obj(setdiff(by$y, y_vars))
37    )
38  }
39
40  by
41}
42
43#' @export
44common_by.NULL <- function(by, x, y) {
45  by <- intersect(tbl_vars(x), tbl_vars(y))
46  by <- by[!is.na(by)]
47  if (length(by) == 0) {
48    bad_args("by", "required, because the data sources have no common variables.")
49  }
50  inform(auto_by_msg(by))
51
52  list(
53    x = by,
54    y = by
55  )
56}
57
58auto_by_msg <- function(by) {
59  by_quoted <- encodeString(by, quote = '"')
60  if (length(by_quoted) == 1L) {
61    by_code <- by_quoted
62  } else {
63    by_code <- paste0("c(", paste(by_quoted, collapse = ", "), ")")
64  }
65  paste0("Joining, by = ", by_code)
66}
67
68#' @export
69common_by.default <- function(by, x, y) {
70  bad_args("by", "must be a (named) character vector, list, or NULL for ",
71    "natural joins (not recommended in production code), not {friendly_type_of(by)}."
72  )
73}
74