names_are_invalid <- function(x) {
x == "" | is.na(x)
}
is_named <- function(x) {
nms <- names(x)
if (is.null(nms)) return(FALSE)
if (any(names_are_invalid(nms))) return(FALSE)
TRUE
}
is_df_or_vector <- function(x) {
res <- is.data.frame(x) || is.atomic(x)
if (isFALSE(res)) stop("You must pass vector(s) and/or data.frame(s).")
TRUE
}
is_nested <- function(lst) vapply(lst, function(x) inherits(x[1L], "list"), FALSE)
flatten <- function(lst) {
nested <- is_nested(lst)
res <- c(lst[!nested], unlist(lst[nested], recursive = FALSE))
if (sum(nested)) Recall(res) else return(res)
}
#' @source <https://github.com/nathaneastwood/poorman/blob/master/R/bind.R#L79>
bind_rows <- function(..., .id = NULL) {
lsts <- list(...)
lsts <- flatten(lsts)
lsts <- Filter(Negate(is.null), lsts)
lapply(lsts, function(x) is_df_or_vector(x))
lapply(lsts, function(x) if (is.atomic(x) && !is_named(x)) stop("Vectors must be named."))
if (!missing(.id)) {
lsts <- lapply(seq_along(lsts), function(i) {
nms <- names(lsts)
id_df <- data.frame(id = if (is.null(nms)) as.character(i) else nms[i], stringsAsFactors = FALSE)
colnames(id_df) <- .id
cbind(id_df, lsts[[i]])
})
}
nms <- unique(unlist(lapply(lsts, names)))
lsts <- lapply(
lsts,
function(x) {
if (!is.data.frame(x)) x <- data.frame(as.list(x), stringsAsFactors = FALSE)
for (i in nms[!nms %in% names(x)]) x[[i]] <- NA
x
}
)
names(lsts) <- NULL
do.call(rbind, lsts)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.