R/trvsvisit.R

Defines functions trvsidxinq trvseleinq trvssubinq

Documented in trvseleinq trvsidxinq trvssubinq

#' Using vector to visit the traversal table
#'
#' @description Visit the traversal table generated from a vector binary tree through the coordinate determined by the argument \code{inq}, and return
#' an inquiry result containing its numeric item index, its corresponding character pattern and the coordinate.
#' @param trvs The traversal table to be visited, which should be generated from the vector binary tree by the function trvs().
#' @param inq An integer vector to assign the coordinate corresponding to the element to be visited.
#'
#' @return Return an inquiry result with a numeric item index, a character pattern and its coordinate in form of integer vector.
#' @export trvsidxinq
#'
#' @examples
#' #Make traversal table:
#' trav <- trvs(dl2vbt(chrvec2dl(colnames(datatest))))
#'
#' #Visit specific element by its coordinate:
#' trvsidxinq(trav,c(1,2,3,1))
#' @keywords Trav.Table Trav.Inq
trvsidxinq <- function(trvs, inq){
  # input diagnose
  if (!class(trvs)=="Trav.Table"){
    stop("trvs must be a Trav.Table generated by the function trvs()", call. = FALSE)
  }
  if (!is.vector(inq)){
    inq <- as.vector(unlist(inq))
    inq <- as.numeric(inq)
  }
  if (length(unlist(trvs[1,2]))!=length(inq)){
    stop("Invalid inquiry. Please ensure the arg inq have proper length.", call. = FALSE)
  }

  # repeat times
  rpt <- length(trvs[,1])

  # return character element
  i <- 1
  for(i in 1:rpt){
    if(all(unlist(trvs[i,2])-inq==0)){
      break
    }
  }
  element <- trvs[i,1][[1]]
  itemidx <- i
  coordinate <- inq
  result <- list("itemid"=itemidx, "colnames"=element, "coordinate"=coordinate)
  class(result) <- "Trav.Inq"

  if(i==rpt & all(unlist(trvs[i,2])-inq!=0)){
    stop("No result matches the inquiry vector.", call. = FALSE)
  } else {
    return(result)
  }
}


#' Using character element to visit the traversal table
#'
#' @description Visit the traversal table generated from a vector binary tree through the character element determined by the argument \code{inq}, and return
#' an inquiry result containing its numeric item index, the character pattern and its corresponding coordinate.
#' @param trvs The traversal table to be visited, which should be generated from the vector binary tree by the function trvs().
#' @param inq A desired character element to match the traversal table.
#'
#' @return Return an inquiry result with a numeric item index, a character pattern and its coordinate in form of integer vector.
#' @export trvseleinq
#'
#' @examples
#' #Make traversal table:
#' trav <- trvs(dl2vbt(chrvec2dl(colnames(datatest))))
#'
#' #Visit specific element by character pattern:
#' trvseleinq(trav,"Strain-1100-0.001-0.6")
#' @keywords Trav.Table Trav.Inq
trvseleinq <- function(trvs, inq){
  # input diagnose
  if (!class(trvs)=="Trav.Table"){
    stop("trvs must be a Trav.Table generated by trvs()", call. = FALSE)
  }
  if (!is.character(inq)){
    inq <- as.character(inq)
  }
  if (length(inq)!=1){
    stop("Invalid inquiry. the arg inq must be a character.", call. = FALSE)
  }

  # repeat times
  rpt <- length(trvs[,1])

  # return character element
  i <- 1
  for(i in 1:rpt){
    if(trvs[[i]]==inq){
      element <- inq
      coordinate <- unlist(trvs[i,2])
      itemidx <- i
      result <- list("itemid"=itemidx, "colnames"=element, "coordinate"=coordinate)
      class(result) <- "Trav.Inq"
      break
    }
  }

  if(i==rpt & trvs[[i]]!=inq){
    stop("No result matches the inquiry character.", call. = FALSE)
  } else {
    return(result)
  }
}


#' Using sub vector binary tree to visit the traversal table
#'
#' @description Visit the traversal table generated from a vector binary tree through the sub vector binary tree determined by the argument \code{inq}, and
#' return an inquiry list containing the numeric index, the character pattern and the corresponding coordinate for each item.
#' @param trvs The traversal table to be visited, which should be generated from the vector binary tree by the function trvs().
#' @param inq A sub tree generated from the original vector binary tree, to determine the subset of elements to be visited.
#'
#' @return Return a list containing the numeric index, the character pattern and the corresponding coordinate for each item.
#' @export trvssubinq
#' @seealso \code{\link[VBTree:vbtsub]{vbtsub}}, \code{\link[VBTree:advbtsub]{advbtsub}}.
#'
#' @examples
#' #Make original vector binary tree and its traversal table:
#' vbt <- dl2vbt(chrvec2dl(colnames(datatest)))
#' trav <- trvs(vbt)
#'
#' #Visit all elements defined by sub vector binary tree:
#' #example 1: visit all "Stress-*-*-*" patterns;
#' #make sub vector binary tree through vbtsub() then execute inquiry:
#' subvbt <- vbtsub(vbt, c(2,-1,-1,-1))
#' trvssubinq(trav, subvbt)
#'
#' #example 2: visit all "Strain-("950", "1050")-("0.001", "0.1")-*" patterns;
#' #make sub vector binary tree through advbtsub() then execute inquiry:
#' subvbt <- advbtsub(vbt, list(1, c(2,4), c(1,3), 1))
#' trvssubinq(trav, subvbt)
#' @keywords Trav.Table Vector.Binary.Tree Trav.Inq
trvssubinq <- function(trvs, inq){
  # input diagnose
  if (!class(trvs)=="Trav.Table"){
    stop("trvs must be a Trav.Table generated by trvs()", call. = FALSE)
  }
  if (!class(inq)=="Vector.Binary.Tree"){
    stop("inq must be a Vector.Binary.Tree generated by sub.vbt(), sub.advbt() and etc.", call. = FALSE)
  }
  trvs_len <- length(trvs[,1])
  trv_dims <- unlist(trvs[trvs_len,2])
  if (any(inq$dims > trv_dims)){
    stop("Invalid inquiry. Please check the dimension of inq", call. = FALSE)
  }

  # export a traversal inquiry list through given sub Vector.Binary.Tree.
  rpt <- prod(inq$dims)
  inqtrav <- trvs(inq)

  inqvec <- as.vector(inqtrav[,1])
  if (rpt==1){
    result <- trvseleinq(trvs = trvs, inq = inqvec[[1]])
  } else{
    result <- trvseleinq(trvs = trvs, inq = inqvec[1])
    k <- 2
    for (k in 2:rpt){
      item <- trvseleinq(trvs = trvs, inq = inqvec[k])
      result <- rbind(result, item)
    }
  }
  if (rpt!=1){
    rownames(result)[1] <- "item"
  }
  class(result) <- "Trav.Inq"
  return(result)
}

Try the VBTree package in your browser

Any scripts or data that you put into this service are public.

VBTree documentation built on May 2, 2019, 12:39 p.m.