#' @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
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.