R/cbindList.R

In paodan/funcTools: some useful function tools in practice

#' @title cbind all elements in a list\cr
#' @description merge a list in which are all data.frame with one common
#' rowname or one common column number
#' @name cbindList
#' @param List a list of data frame.
#' @param ID  The number of column, or the column name that need to be refered.
#' If ID = 0, then the row names of each data frame will be used.
#' @param replace The value to replace the NAs that generated by cbind of data frame.
#' @param includeColId Logical. Include the refered column if it is TRUE
#' @param sep seperation character of the column names in the data frame
#' and the corresponding list index. The default is sep = ".".
#' @param fast using cbind if the rownames of each element in the \code{List}
#' are the same. The default is FALSE.
#' @return A combined data frame, in which the colnames are the colnames
#' in the original data frame and corresponding list index
#' @export
#' @examples {
#' \dontrun{
#' # The zeros/ones matrix
#' a = data.frame(a = letters[1:5], b = rnorm(5))
#' b = data.frame(a = letters[3:7], c = rnorm(5))
#' x = list(a, b)
#' cbindList(List = x, ID = 1)
#' cbindList(List = x, ID = 0)
#' cbindList(List = x, ID = "a")
#' cbindList(List = x, ID = "a", replace = 0)
#' cbindList(List = x, ID = "a", replace = 0, sep = "_")
#' }
#' }
cbindList = function(List, ID = 0, replace = NA,
                     sep = ".", fast = FALSE){
  stopifnot(is.list(List))
  cName = Reduce("intersect", lapply(List, colnames))
  stopifnot(is.numeric(ID) | (is.character(ID) & (ID %in% cName)))

  nm0 = paste0(sep, 1:length(List))
  if(fast){ # fastly combine
    if (ID == 0){
      sameID = sapply(List, function(x) identical(rownames(x), rownames(List[[1]])))
    } else {
      sameID = sapply(List, function(x) identical(x[, ID], List[[1]][, ID]))
    }
    if (!all(sameID)){
      message("sameID not true, use 'fast = FALSE' instead!")
      y = cbindList(List = List, ID = ID, replace = replace,
                    sep = sep, fast = FALSE)
      return(y)
    }
    List = lapply(setNames(1:length(List), nm = names(List)), function(i){
      colnames(List[[i]]) = paste0(colnames(List[[i]]), nm0[i])
      return(List[[i]])})
    y = Reduce(cbind, List)
  } else { # slowly combine
    # ID is the column name, id is the index of the column
    tmpColName = paste0("tmpColName_", runif(1))
    if (is.numeric(ID)){
      if (ID == 0){
        List = lapply(List, function(x) {
          xx = cbind(rowName = rownames(x), x)
          colnames(xx)[1] = tmpColName
          return(xx)
        })
      }
      id = 1
      ID = colnames(List[[1]])[id]
    } else {
      id = match(ID, colnames(List[[1]]))
    }
    # use the common row names
    rName = unique(unlist(lapply(List, function(i) {i[,id]})))
    t = data.frame(row.names = rName)
    y = lapply(List, function(i) {
      i = i[match(rName, i[,id]),,drop = F]
      rownames(i) = rName
      return(i)
    })
    y = lapply(1:length(y),function(i){
      colnames(y[[i]]) = paste0(colnames(y[[i]]), nm0[i])
      return(y[[i]])})
    # cbind all data.frame in the list
    y = Reduce(cbind, y)
    # remove the refered column
    y = y[, !colnames(y) %in% paste0(tmpColName, nm0)]
  }
  # replace NA
  if(!is.na(replace)) y[is.na(y)] = replace
  return(y)
}