1
0
mirror of https://github.com/msberends/AMR.git synced 2025-07-09 23:41:55 +02:00

bind_rows

This commit is contained in:
2023-02-10 17:09:48 +01:00
parent 03294c7901
commit 2007c3eef3
15 changed files with 48 additions and 31 deletions

View File

@ -64,20 +64,26 @@ pm_left_join <- function(x, y, by = NULL, suffix = c(".x", ".y")) {
}
# support where() like tidyverse:
# adapted from https://github.com/nathaneastwood/poorman/blob/52eb6947e0b4430cd588976ed8820013eddf955f/R/where.R#L17-L32
where <- function(fn) {
# adapted from https://github.com/nathaneastwood/poorman/blob/52eb6947e0b4430cd588976ed8820013eddf955f/R/where.R#L17-L32
if (!is.function(fn)) {
stop(pm_deparse_var(fn), " is not a valid predicate function.")
stop_("`", deparse(substitute(fn)), "()` is not a valid predicate function.")
}
df <- pm_select_env$.data
cols <- pm_select_env$get_colnames()
if (is.null(df)) {
df <- get_current_data("where", call = FALSE)
cols <- colnames(df)
}
preds <- unlist(lapply(
pm_select_env$.data,
df,
function(x, fn) {
do.call("fn", list(x))
},
fn
))
if (!is.logical(preds)) stop("`where()` must be used with functions that return `TRUE` or `FALSE`.")
data_cols <- pm_select_env$get_colnames()
if (!is.logical(preds)) stop_("`where()` must be used with functions that return `TRUE` or `FALSE`.")
data_cols <- cols
cols <- data_cols[preds]
which(data_cols %in% cols)
}
@ -156,6 +162,20 @@ quick_case_when <- function(...) {
out
}
bind_rows2 <- function(..., fill = NA) {
# this AMAZING code is from ChatGPT: when I asked for a base R dplyr::bind_rows alternative
dfs <- list(...)
all_cols <- unique(unlist(lapply(dfs, colnames)))
mat_list <- lapply(dfs, function(x) {
mat <- matrix(NA, nrow = nrow(x), ncol = length(all_cols))
colnames(mat) <- all_cols
mat[, colnames(x)] <- as.matrix(x)
mat
})
mat <- do.call(rbind, mat_list)
as.data.frame(mat, stringsAsFactors = FALSE)
}
# No export, no Rd
addin_insert_in <- function() {
import_fn("insertText", "rstudioapi")(" %in% ")