R/tools-txdct.R

In ropensci/phylotaR: Automated Phylogenetic Sequence Cluster Identification from 'GenBank'

#' @name taxtree_gen
#' @title Generate taxonomic tree
#' @description Generate a taxonomic tree for
#' easy look up of taxonomic parents and descendants.
#' @return TreeMan
#' @param prinds Vector of integers indicating preceding node.
#' @param ids Vector of taxonomic IDs
#' @param root ID of root taxon
#' @template ps
#' @family run-private
#' @return TreeMan class
taxtree_gen <- function(prinds, ids, root, ps) {
  .add <- function(i) {
    nd <- vector("list", length = 4)
    names(nd) <- c("id", "ptid", "prid", "spn")
    nd[["id"]] <- ids[i]
    nd[["prid"]] <- ids[prinds[i]]
    nd[["ptid"]] <- ptids[ptnds_pool == i]
    nd[["spn"]] <- 1
    nd
  }
  nonroot_i <- ids != root
  nnds <- length(prinds)
  tinds <- which(!1:nnds %in% prinds)
  ptnds_pool <- prinds[nonroot_i]
  ptids <- ids[nonroot_i]
  ndlst <- lapply(1:nnds, .add)
  names(ndlst) <- ids
  tree <- twoer()
  tree@ndlst <- ndlst
  tree@root <- root
  tree@wtxnyms <- FALSE
  tree@ndmtrx <- NULL
  tree@prinds <- prinds
  tree@tinds <- tinds
  tree <- updateSlts(tree)
  if (!checkNdlst(tree@ndlst, tree@root)) {
    error(ps = ps, "Invalid taxonomy")
  }
  tree
}

#' @name rank_get
#' @title Get rank
#' @description Look-up taxonomic rank from dictionary.
#' @return character
#' @param txid txid
#' @param txdct TaxDict
#' @family run-private
rank_get <- function(txid, txdct) {
  txdct@recs[[txid]]@rnk
}

#' @name descendants_get
#' @title Get descendants
#' @description Look-up either direct or all taxonomic descendants of
#' a node from taxonomic dictionary.
#' @return vector
#' @param id txid
#' @param txdct TaxDict
#' @param direct T/F, return only direct descendants?
#' @family run-private
descendants_get <- function(id, txdct, direct = FALSE) {
  if (direct) {
    ptids <- getNdSlt(
      tree = txdct@txtr, slt_nm = "ptid",
      id = id
    )
  } else {
    ptids <- getNdPtids(tree = txdct@txtr, id = id)
  }
  ptids
}

#' @name parent_get
#' @title Get taxonomic parent
#' @description Look-up MRCA of taxonomic id(s) from taxonomic
#' dictionary
#' @return Character
#' @param id txid(s)
#' @param txdct TaxDict
#' @family run-private
parent_get <- function(id, txdct) {
  if (length(id) > 1) {
    ids <- unique(id)
    ids <- ids[!is.na(ids)]
    res <- getPrnt(tree = txdct@txtr, ids = ids)
  } else {
    res <- getNdSlt(tree = txdct@txtr, slt_nm = "prid", id = id)
  }
  res
}