R/rbindlistn.R

In kevinushey/data.table.extras: Add-on functions to augment the data.table package.

##' rbindlist with names
##' 
##' This function implements \code{rbindlist} but adds an optional argument,
##' \code{names}, which allows us to keep the names of each
##' sub-list which we \code{rbindlist}-ify.
##' 
##' @param l A list of \code{data.frame}s, \code{data.table}s or 
##'   \code{data.frame} shaped \code{list}s.
##' @param names If \code{names} is:
##' \itemize{
##' \item{\code{FALSE}: Do not generate a vector of names.}
##' \item{\code{TRUE}: Generate a vector of names called \code{.Names}, and
##'   append it to the \code{data.table} generated by \code{rbindlist}.}
##' \item{A string: Generate a vector of names called \code{names}, and
##'   append it to the \code{data.table} generated by \code{rbindlist}.}
##' }
##' @export
##' @examples
##' dfs <- list( a=data.frame(x=1, y=2, z=3), b=data.frame(x=4, y=5, z=6) )
##' rbindlistn(dfs)
##' lists <- list( a=list(x=1, y=2, z=3), b=list(x=4, y=5, z=6) )
##' rbindlistn(lists)
##' df1 <- data.frame(x = 1, y = 2)
##' df2 <- data.frame(x = 3, y = 4)
##' rbindlistn(list(df1, df2))
rbindlistn <- function(l, names = ".Names") {
  
  if (identical(names, FALSE)) {
    return(rbindlist(l))
  }  
  
  if (identical(names, TRUE)) {
    names <- ".Names"
  }
  
  output <- rbindlist(l)
  nm <- names(l)
  
  ## Try to guess the names from the call, if possible
  if (is.null(nm)) {
    
    ## Examine the call to get names, if possible
    call <- match.call()
    listCall <- call[["l"]]
    if (listCall[[1]] == "list") {
      
      for (i in 2:length(listCall)) {
        if (!is.symbol(listCall[[i]])) {
          break
        }
      }
      
      nm <- character(length(listCall) - 1)
      for (i in 2:length(listCall)) {
        nm[[i - 1]] <- as.character(listCall[[i]])
      }
    }
  }
  
  ## Fallback if still NULL
  if (is.null(nm)) {
    warning("The 'names' attribute of your list is NULL")
    nm <- paste0("V", 1:length(l))
  }
  
  if (any(nm == '')) {
    warning("Some elements in your list are unnamed")
    nm[nm == ''] <- paste0("V", 1:length(l))[nm == '']
  }
  output[, (names) := rep(nm, sapply(l, function(x) length(x[[1]]), USE.NAMES=FALSE))]
  return(output)
}