R/vbtCvrt.R

In VBTree: Vector Binary Tree to Make Your Data Management More Efficient

#' Convert a vector binary tree to double list
#'
#' @description Recover a vector binary tree to double list for easy visualization. Empty layers in vector binary
#' tree will be marked by the symbol "*" as default.
#' @param x A vector binary tree to be converted.
#'
#' @return Return a double list based on input vector binary tree.
#' @export vbt2dl
#' @seealso \code{\link[VBTree:vbtinq]{vbtinq}}, \code{\link[VBTree:vbtsub]{vbtsub}}, \code{\link[VBTree:advbtinq]{advbtinq}},
#' \code{\link[VBTree:advbtsub]{advbtsub}}, \code{\link[VBTree:trvssubinq]{trvssubinq}}, \code{\link[VBTree:vbt2ts]{vbt2ts}},
#' \code{\link[VBTree:vbt2arr]{vbt2arr}}.
#'
#' @examples
#' #Recover vector binary tree to a double list for easy visualization:
#' vbt <- dl2vbt(chrvec2dl(colnames(datatest))) #make vector binary tree
#' vbt2dl(vbt)
#' @keywords Vector.Binary.Tree Double.List
vbt2dl <- function(x){
  # diagnose input data
  if(class(x)!="Vector.Binary.Tree"){
    stop("x should be a Vector.Binary.Tree generated by arr2vbt(), ts2vbt() or dl2vbt().", call. = FALSE)
  }

  # execute x1 when x1 (str) exists
  exec <- function(x1=NULL){
    eval(parse(text=x1))
  }

  # save x2 (R object) as str without execute
  encode <- function(x2=NULL){
    deparse(substitute(x2))
  }

  pref <- encode(x$tree)
  suff <- paste("[[",1,"]]", sep = "", collapse = "")
  dims <- length(x$dims)

  layer <- length(dims)
  ept_list <- list()

  result <- list(ept_list)[rep(1,layer)]

  i <- 1
  while (i <= dims) {
    if(i==1){
      layer1temp <- ""
    } else {
      assign(paste("layer", i, "temp", sep = ""), paste("[[",rep(2,(i-1)),"]]", sep = "", collapse = ""))
    }
    temp <- paste(pref, exec(paste("layer", i, "temp", sep = "")), suff, sep = "", collapse = "")
    assign(paste("L",i, sep = ""), exec(temp))
    result[[i]] <- exec(paste("L",i, sep = ""))
    i <- i + 1
  }

  # empty layer will be filled by "*"
  i <- 1
  while(i <= dims){
    if(length(result[[i]])==0){
      result[[i]] <- "*"
    }
    i <- i +1
  }
  class(result) <- "Double.List"
  return(result)
}


#' Convert a vector binary tree to tensor
#'
#' @description Convert a vector binary tree to a tensor. The pure numeric layers will be sorted intrinsically then all
#' elements will be bound in certain order as one character element, and filled into the proper location in the tensor.
#' @param x A vector binary tree to be converted.
#'
#' @return Return a tensor filled with the binding character elements.
#' @export vbt2ts
#' @seealso \code{\link[VBTree:vbt2dl]{vbt2dl}}, \code{\link[VBTree:vbt2arr]{vbt2arr}}.
#'
#' @examples
#' #Make column names of datatest into vector binary tree:
#' vbt <- dl2vbt(chrvec2dl(colnames(datatest), "-"))
#'
#' #Convert the vector binary tree to a tensor:
#' vbt2ts(vbt)
#' @keywords Vector.Binary.Tree tensor
vbt2ts <- function(x){
  if(class(x)!="Vector.Binary.Tree"){
    stop("x should be a Vector.Binary.Tree generated by arr2vbt(), ts2vbt() or dl2vbt().", call. = FALSE)
  }
  x <- vbt2dl(x)
  result <- dl2ts(x)
  return(result)
}


#' Convert a vector binary tree to array
#'
#' @description Convert a vector binary tree to an array. The pure numeric layers will be sorted intrinsically then all
#' elements will be bound in certain order as one character element, and filled into the proper location in the array.
#' @param x A vector binary tree to be converted.
#'
#' @return Return an array filled with the binding character elements.
#' @export vbt2arr
#' @seealso \code{\link[VBTree:vbt2dl]{vbt2dl}}, \code{\link[VBTree:vbt2ts]{vbt2ts}}.
#'
#' @examples
#' #Make column names of datatest into vector binary tree:
#' vbt <- dl2vbt(chrvec2dl(colnames(datatest), "-"))
#'
#' #Convert the vector binary tree to an array:
#' vbt2arr(vbt)
#' @keywords Vector.Binary.Tree array
vbt2arr <- function(x){
  # diagnose input data
  if(class(x)!="Vector.Binary.Tree"){
    stop("x should be a Vector.Binary.Tree generated by arr2vbt(), ts2vbt() or dl2vbt().", call. = FALSE)
  }
  x <- vbt2dl(x)
  result <- dl2arr(x)
  return(result)
}