R/dlCvrt.R

Defines functions dl2arr dl2ts dl2vbt

Documented in dl2arr dl2ts dl2vbt

#' Convert a double list to vector binary tree
#'
#' @description Convert a double list to vector binary tree. The pure numeric layers will be sorted intrinsically then
#' all elements be exported in character form.
#' @param x A double list to be converted.
#' @param regularize A boolean value to control the treatment of empty layers of double listed to be converted.
#' The default value \code{TRUE} will fill the empty layer by mark "*". The default value is recommanded.
#' @param splt A string pattern to split the binding elements in each layer if the sub-constructure exists.
#' The default pattern uses "-".
#' @return Return a vector binary tree.
#' @export dl2vbt
#' @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:dl2ts]{dl2ts}},
#' \code{\link[VBTree:dl2arr]{dl2arr}}.
#'
#' @examples
#' #Structurize the column names of datatest:
#' colname <- colnames(datatest)
#' colnamedl <- chrvec2dl(colname, "-")
#' colnamevbt <- dl2vbt(colnamedl)
#'
#' #Simple data cleaning for sub-constructure existing double list;
#' #Make unregulated double list:
#' unregdl <- list(c("7", 2, 10), c("chr", "5"), c(),
#' c("var2", "var1", "var3"), c("M-8-9", "3-2"), c("6-3", "2-7"))
#' regvbt <- dl2vbt(unregdl)
#' regvbt2 <- dl2vbt(unregdl, FALSE) # not recommended
#' @keywords Double.List Vector.Binary.Tree
dl2vbt <-
function(x, regularize=TRUE, splt="-"){

  ept_list <- list()
  len_vec <- as.numeric(summary(x)[,1])

  # call itself once to fill empty layers by "*"
  if(regularize){
    vbt <- dl2vbt(x, FALSE)
    x <- vbt2dl(vbt)
  }

  # a) separate the binding elements by the arg splt; default method use "-"
  # b) sort (if it is possible) and characterize all elements in x
  i <- 1
  for (i in 1:(length(len_vec))) {
    splt_temp <- strsplit(as.character(unlist(x[[i]])), split = splt)
    x[[i]] <- as.character(unlist(splt_temp))
    if(any(is.na(suppressWarnings(as.numeric(unlist(x[[i]])))))!=TRUE){
      x[[i]] <- as.character(sort(as.numeric(unlist(x[[i]]))))
    }
    x[[i]] <- as.character(x[[i]])
  }

  # split & reorganize x, make extra space to accept function (pointer)
  i <- 1
  while (i <= length(len_vec)) {
    assign(paste("layer", i, sep = ""), list(unlist(x[[i]]), ept_list))
    i <- i + 1
  }

  t <- length(len_vec)-1
  result <- ept_list

  # connect each layer to make vector binary tree
  i <- 1
  for (i in 1:t) {
    if(i==1){
      l.pre_temp <- eval(parse(text=paste("layer", (t-i+1), sep = ""))[[1]])
      l.next_temp <- eval(parse(text=paste("layer", (t-i+2), sep = ""))[[1]])
    } else {
      l.next_temp <- l.pre_temp
      l.pre_temp <- eval(parse(text=paste("layer", (t-i+1), sep = ""))[[1]])
    }
    l.pre_temp[[2]] <- l.next_temp
  }
  result <- ept_list
  result$tree <- l.pre_temp
  len_vec[which(len_vec==0)] <- 1 # define the dimension of empty layers in 1
  result$dims <- len_vec

  class(result) <- "Vector.Binary.Tree"
  return(result)
}


#' Convert a double list to tensor
#'
#' @description Convert a double list 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 double list to be converted.
#'
#' @return Return a tensor filled with the binding character elements.
#' @importFrom tensorA to.tensor
#' @importFrom tensorA pos.tensor
#' @export dl2ts
#' @seealso \code{\link[VBTree:dl2vbt]{dl2vbt}}, \code{\link[VBTree:dl2arr]{dl2arr}}.
#'
#' @examples
#' #Make column names of datatest into double list:
#' dl <- chrvec2dl(colnames(datatest), "-")
#'
#' #Convert the double list to a tensor:
#' dl2ts(dl)
#' @keywords Double.List tensor
dl2ts <-
function(x){
  # input data diagnose
  if(!inherits(x, "Double.List")){
    stop("x should be a Double.List generated by vbt2dl(), ts2dl() or arr2dl().", call. = FALSE)
  }

  tree <- dl2vbt(x)
  mlt <- trvs(tree)

  dim <- length(mlt[1,2][[1]])
  name_vec <- c()

  len_vec <- tree$dims
  itr.trav <- prod(len_vec)

  # build mapping from mlt index to ts index
  ts <- to.tensor(1:itr.trav, len_vec)
  p <- mlt[,2]

  # in condition of non-matrix structure resulted from one length.
  if (length(p)==1){
    ts.idx.temp <- p[[1]]
    ts.idx.temp <- matrix(ts.idx.temp, nrow = 1)
  } else {
    ts.idx.temp <- pos.tensor(dim(ts))
  }
  ts.idx <- matrix(NA, itr.trav, 1)

  i <- 1
  for (i in 1:itr.trav) {
    ts.idx[i] <- list(as.vector(ts.idx.temp[i,]))
  }

  idx.return <- function(idx, x){
    result <- c()
    i <- 1
    for(i in 1:length(idx)){
      ptr <- all(ts.idx[[i]] == x)
      if(ptr!=TRUE){
        result <- append(result, ptr)
      } else{
        address <- i
      }
    }
    i <- 1
    return(address)
  }

  i <- 1
  address_vec <- c(1:itr.trav)
  for (i in 1:itr.trav) {
    address_vec[i] <- idx.return(ts.idx, p[[i]])
  }

  # assignment into tensor
  i <- 1
  for (i in 1:itr.trav) {
    ts[[address_vec[i]]] <- mlt[,1][[i]]
  }
  return(ts)
}



#' Convert a double list to array
#'
#' @description Convert a double list 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 double list to be converted.
#'
#' @return Return an array filled with the binding character elements.
#' @export dl2arr
#' @seealso \code{\link[VBTree:dl2vbt]{dl2vbt}}, \code{\link[VBTree:dl2ts]{dl2ts}}.
#'
#' @examples
#' #Make column names of datatest into double list:
#' dl <- chrvec2dl(colnames(datatest), "-")
#'
#' #Convert the double list to a tensor:
#' dl2arr(dl)
#' @keywords Double.List array
dl2arr <- function(x){
  # input data diagnose
  if(!inherits(x, "Double.List")){
    stop("x should be a Double.List generated by vbt2dl(), ts2dl() arr2dl(), or chrvec2dl.", call. = FALSE)
  }
  ts <- dl2ts(x)
  dl2array <- array(NA, dim = dim(ts))
  items <- prod(dim(ts))
  i <- 1
  for (i in 1:items) {
    dl2array[[i]] <- ts[[i]]
  }
  return(dl2array)
}
CubicZebra/VBTree documentation built on Feb. 3, 2024, 3:42 p.m.