1has_names <- function(x) { 2 nms <- names(x) 3 if (is.null(nms)) { 4 rep(FALSE, length(x)) 5 } else { 6 !(is.na(nms) | nms == "") 7 } 8} 9 10bind_args <- function(args, parent) { 11 assign_env <- parent 12 nms <- names(args) 13 for (i in seq_along(args)) { 14 eval_env <- assign_env 15 assign_env <- new.env(parent = eval_env) 16 delayed_assign(nms[[i]], args[[i]], eval.env = eval_env, assign.env = assign_env) 17 } 18 assign_env 19} 20 21# From tibble::recycle_columns 22recycle_columns <- function (x) { 23 if (length(x) == 0) { 24 return(x) 25 } 26 lengths <- vapply(x, NROW, integer(1)) 27 if (any(lengths) == 0) { 28 return(character()) 29 } 30 31 max <- max(lengths) 32 bad_len <- lengths != 1L & lengths != max 33 if (any(bad_len)) { 34 stop(call. = FALSE, 35 ngettext(max, 36 "Variables must be length 1", 37 paste0("Variables must be length 1 or ", max), domain = NA)) 38 } 39 short <- lengths == 1 40 if (max != 1L && any(short)) { 41 x[short] <- lapply(x[short], rep, max) 42 } 43 x 44} 45 46# From https://github.com/hadley/colformat/blob/0a35999e7d77b9b3a47b4a04662d1c2625f929d3/R/styles.R#L19-L25 47colour_na <- function() { 48 grDevices::rgb(5, 5, 2, maxColorValue = 5) 49} 50 51style_na <- function(x) { 52 if (requireNamespace("crayon", quietly = TRUE)) { 53 crayon::style(x, bg = colour_na()) 54 } else { 55 x # nocov 56 } 57} 58 59lengths <- function(x) { 60 vapply(x, length, integer(1L)) 61} 62 63na_rows <- function(res) { 64 Reduce(`|`, lapply(res, is.na)) 65} 66 67"%||%" <- function(x, y) if (is.null(x)) y else x # nocov 68 69drop_null <- function(x) { 70 x[!vapply(x, is.null, logical(1))] 71} 72 73# A version of delayedAssign which does _not_ use substitute 74delayed_assign <- function(x, value, eval.env = parent.frame(1), assign.env = parent.frame(1)) { 75 do.call(delayedAssign, list(x, value, eval.env, assign.env)) 76} 77 78## @export 79compare.glue <- function(x, y, ...) { 80 if (identical(class(y), "character")) { 81 class(x) <- NULL 82 } 83 NextMethod("compare") 84} 85 86## @export 87compare_proxy.glue <- function(x, path = "x") { 88 class(x) <- NULL 89 NextMethod("compare_proxy") 90} 91