#' Function producing the overview of whole object.
#'
#' @keywords internal
#'
overview_taxlist <- function(object, units, check_validity) {
cat("object size:", format(object.size(object), units = units),
sep = " ",
"\n"
)
if (check_validity) {
cat("validation of 'taxlist' object:", validObject(object),
sep = " ",
"\n"
)
}
cat("\n")
cat("number of taxon usage names:", nrow(object@taxonNames), sep = " ", "\n")
cat("number of taxon concepts:", nrow(object@taxonRelations), sep = " ", "\n")
cat("trait entries:", nrow(object@taxonTraits), sep = " ", "\n")
cat("number of trait variables:", ncol(object@taxonTraits) - 1,
sep = " ",
"\n"
)
cat("taxon views:", nrow(object@taxonViews), sep = " ", "\n")
if (any(!is.na(object@taxonRelations$Parent))) {
cat("\n")
cat("concepts with parents:",
length(object@taxonRelations$Parent[
!is.na(object@taxonRelations$Parent)
]),
sep = " ",
"\n"
)
cat("concepts with children:",
length(unique(object@taxonRelations$Parent[
!is.na(object@taxonRelations$Parent)
])),
sep = " ", "\n"
)
}
if (any(!is.na(object@taxonRelations$Level))) {
cat("\n")
cat("hierarchical levels:", paste(levels(object), collapse = " < "),
sep = " ", "\n"
)
for (i in base::levels(object@taxonRelations$Level)) {
cat("number of concepts in level ", i, ": ",
sum(paste(object@taxonRelations$Level) == i),
sep = "", "\n"
)
}
}
cat("\n")
}
#' Function producing the overview of single taxon concepts.
#'
#' @keywords internal
#'
overview_taxon <- function(object, ConceptID, display, maxsum,
secundum = NULL) {
if (length(ConceptID > 0)) {
if (!all(ConceptID %in% object@taxonRelations$TaxonConceptID)) {
stop("Some requested concepts are not included in 'object'")
}
Names <- accepted_name(object)
Names$Parent <- object@taxonRelations$Parent[match(
Names$TaxonConceptID,
object@taxonRelations$TaxonConceptID
)]
Names$Basionym <- object@taxonRelations$Basionym[match(
Names$TaxonConceptID,
object@taxonRelations$TaxonConceptID
)]
# Create index for synonyms
Synonym <- list()
for (i in ConceptID) {
temp_name <- object@taxonNames[object@taxonNames$TaxonConceptID == i, ]
temp_name <- temp_name[!temp_name$TaxonUsageID %in%
Names$TaxonUsageID[Names$TaxonConceptID == i], ]
if (length(temp_name) > 0) Synonym[[paste(i)]] <- temp_name
}
# display option
display <- pmatch(display[1], c("name", "author", "both"))
if (!display %in% c(1:3)) {
stop(paste(
"Invalid value for 'display', use \"name\", \"author\"",
"or \"both\""
))
}
if (display == 1) display <- c("TaxonUsageID", "TaxonName")
if (display == 2) display <- c("TaxonUsageID", "AuthorName")
if (display == 3) display <- c("TaxonUsageID", "TaxonName", "AuthorName")
# Now print
for (i in ConceptID) {
cat("------------------------------", "\n")
# Head
cat("concept ID:", i, sep = " ", "\n")
temp_name <- Names$ViewID[Names$TaxonConceptID == i]
if (is.na(temp_name)) {
temp_name <- "none"
} else {
if (!is.null(secundum)) {
if (!secundum %in% colnames(object@taxonViews)) {
stop(paste(
"Value of 'secundum' is not included as",
"column in slot 'taxonViews'"
))
} else {
temp_name <- paste(
temp_name, "-",
object@taxonViews[object@taxonViews$ViewID ==
temp_name, secundum]
)
}
}
}
cat("view ID:", temp_name, sep = " ", "\n")
temp_name <- paste(Names$Level[Names$TaxonConceptID == i])
if (is.na(temp_name) | temp_name == "NA") temp_name <- "none"
cat("level:", temp_name, sep = " ", "\n")
temp_name <- Names$Parent[Names$TaxonConceptID == i]
if (is.na(temp_name)) {
temp_name <- "none"
} else {
temp_name <-
c(temp_name, paste(Names[
Names$TaxonConceptID == temp_name,
display[-1]
], collapse = " "))
}
cat("parent:", temp_name, sep = " ", "\n")
cat("\n")
# Accepted name
temp_name <- Names[Names$TaxonConceptID == i, display]
cat("# accepted name:", "\n")
cat(paste(temp_name, collapse = " "), "\n")
# Basionym
temp_name <- Names$Basionym[Names$TaxonConceptID == i]
if (!is.na(temp_name)) {
temp_name <- Names[Names$TaxonConceptID == temp_name, display]
cat("\n")
cat("# basionym:", "\n")
cat(paste(temp_name, collapse = " "), "\n")
}
# Synonyms
if (nrow(Synonym[[paste(i)]]) > 0) {
cat("\n")
cat("# synonyms (", nrow(Synonym[[paste(i)]]), "): ",
sep = "",
"\n"
)
for (j in seq_len(nrow(Synonym[[paste(i)]]))) {
temp_name <- Synonym[[paste(i)]][j, display]
cat(paste(temp_name, collapse = " "), "\n")
}
}
}
cat("------------------------------\n")
} else {
cat("No concept selected\n")
}
}
#' @name summary
#'
#' @rdname summary
#'
#' @title Print overviews for taxlist Objects and their content
#'
#' @description
#' A method to display either an overview of the content of
#' [taxlist-class] objects or an overview of selected taxa.
#'
#' @param object,x A [taxlist-class] object.
#' @param ConceptID IDs of concepts to be displayed in the summary.
#' @param units Character value indicating the units shown in the object's
#' allocated space.
#' @param check_validity Logical value indicating whether the validity of
#' `object` should be checked or not.
#' @param display Character value indicating the field to be displayed (see
#' details).
#' @param maxsum Integer indicating the maximum number of displayed taxa.
#' @param secundum A character value indicating the column from slot`taxonViews`
#' to be displayed in the summary.
#' @param exact A logical value indicating whether taxon names should match the
#' exact argument in parameter 'ConceptID'. It works only if 'ConceptID' is
#' provided as character value and is not the keyword 'all'.
#' @param ... Further arguments passed to or from another methods.
#'
#' @details
#' A general overview indicating number of names, concepts and taxon views
#' included in [taxlist-class] objects.
#' If argument `ConceptID` is a vector with concept IDs or names to be matched
#' by [grepl()], then a display of all names included in each concept will be
#' produced.
#' Alternative you can use `taxon="all"` in order to get the listing of names
#' for all concepts included in the object (truncated to the input number of
#' `maxsum`).
#'
#' For summaries applied to concepts, there are three alternative displays of
#' names using the argument `display`.
#' Use `display="name"` to show the value `TaxonName`, `display="author"` to
#' show the value `AuthorName` or `display="both"` to show both values.
#' Such values are taken from slot `taxonNames`.
#'
#' For big objects it will be recommended to set `units="Mb"` (see also
#' [object.size()] for further alternatives).
#'
#' @author Miguel Alvarez \email{kamapu78@@gmail.com}
#'
#' @seealso [taxlist-class]
#'
#' @example examples/summary.R
#'
#' @aliases summary,taxlist-method
#'
#' @exportMethod summary
#'
setMethod(
"summary", signature(object = "taxlist"),
function(object, ConceptID, units = "Kb", check_validity = TRUE,
display = "both", maxsum = 5, secundum = NULL, exact = FALSE, ...) {
if (missing(ConceptID)) {
overview_taxlist(object, units, check_validity)
} else {
if (is.character(ConceptID)) {
if (ConceptID[1] == "all") {
ConceptID <- object@taxonRelations$TaxonConceptID[1:maxsum]
} else {
if (exact) {
ConceptID <- object@taxonNames$TaxonConceptID[
object@taxonNames$TaxonName %in% ConceptID
]
} else {
Names <- list()
for (i in seq_along(ConceptID)) {
Names[[i]] <- object@taxonNames$TaxonConceptID[
grepl(ConceptID[i],
object@taxonNames$TaxonName,
fixed = TRUE
)
]
}
ConceptID <- do.call(c, Names)
}
}
}
ConceptID <- na.omit(ConceptID)
ConceptID <- unique(ConceptID) # Just in case of duplicates
overview_taxon(object, ConceptID, display, maxsum, secundum)
}
}
)
#' @rdname summary
#'
#' @aliases show,taxlist-method
#'
#' @exportMethod show
#'
setMethod(
"show", signature(object = "taxlist"),
function(object) {
summary(object)
}
)
#' @exportMethod print
if (!isGeneric("print")) {
setGeneric(
"print",
function(x, ...) {
standardGeneric("print")
}
)
}
#' @rdname summary
#'
#' @aliases print print,taxlist-method
setMethod(
"print", signature(x = "taxlist"),
function(x, ...) {
summary(x, ...)
}
)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.