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