diff --git a/DESCRIPTION b/DESCRIPTION index bf99b9165..929fe0c13 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: TreeSearch Title: Phylogenetic Analysis with Discrete Character Data -Version: 1.5.1.9005 +Version: 1.5.1.9006 Authors@R: c( person( "Martin R.", 'Smith', diff --git a/NAMESPACE b/NAMESPACE index 98ce38262..4c658dfc7 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,6 +6,9 @@ S3method(MaximumLength,phyDat) S3method(MinimumLength,character) S3method(MinimumLength,numeric) S3method(MinimumLength,phyDat) +S3method(PlotCharacter,list) +S3method(PlotCharacter,multiPhylo) +S3method(PlotCharacter,phylo) S3method(SPRMoves,matrix) S3method(SPRMoves,phylo) S3method(TBRMoves,matrix) @@ -140,8 +143,10 @@ importFrom(TreeTools,AddUnconstrained) importFrom(TreeTools,CharacterInformation) importFrom(TreeTools,CladisticInfo) importFrom(TreeTools,CompatibleSplits) +importFrom(TreeTools,Consensus) importFrom(TreeTools,ConstrainedNJ) importFrom(TreeTools,DescendantEdges) +importFrom(TreeTools,DescendantTips) importFrom(TreeTools,DoubleFactorial) importFrom(TreeTools,DropTip) importFrom(TreeTools,EdgeAncestry) diff --git a/NEWS.md b/NEWS.md index 4b8fa9af3..e598f405d 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,8 @@ +# TreeSearch 1.5.1.9006 (2025-02) + +- `PlotCharacter()` performs ancestral state reconstruction on consensus trees + [#179](https://github.com/ms609/TreeSearch/issues/179) + # TreeSearch 1.5.1.9005 (2025-02) - Support for ordered (additive) characters diff --git a/R/MaximizeParsimony.R b/R/MaximizeParsimony.R index 9f8178ee6..f3af826b3 100644 --- a/R/MaximizeParsimony.R +++ b/R/MaximizeParsimony.R @@ -79,7 +79,7 @@ #' returned trees will be perfectly compatible with each character in #' `constraint`; or a tree of class `phylo`, all of whose nodes will occur #' in any output tree. -#' See \link[TreeTools:ImposeConstraint]{`ImposeConstraint()`} and +#' See \code{\link[TreeTools:ImposeConstraint]{ImposeConstraint()}} and #' [vignette](https://ms609.github.io/TreeSearch/articles/tree-search.html) #' for further examples. #' @param verbosity Integer specifying level of messaging; higher values give diff --git a/R/PlotCharacter.R b/R/PlotCharacter.R index 8eae2fdb7..14d31a7ca 100644 --- a/R/PlotCharacter.R +++ b/R/PlotCharacter.R @@ -4,7 +4,8 @@ #' modified Fitch algorithm presented in #' \insertCite{Brazeau2019;textual}{TreeSearch}. #' -#' @template treeParam +#' @param tree A bifurcating tree of class `phylo`, or a list or `multiPhylo` +#' object containing such trees. #' @template datasetParam #' @param char Index of character to plot. #' @param updateTips Logical; if `FALSE`, tips will be labelled with their @@ -17,12 +18,17 @@ #' [graphical parameter] for details of line styles. Overrides `tokenCol`. #' @param tipOffset Numeric: how much to offset tips from their labels. #' @param unitEdge Logical: Should all edges be plotted with a unit length? +#' @param Display Function that takes argument `tree` and returns a tree +#' of class `phylo`, formatted as it will be plotted. #' @param \dots Further arguments to pass to `plot.phylo()`. #' #' @return `PlotCharacter()` invisibly returns a matrix in which each row #' corresponds to a numbered tip or node of `tree`, and each column corresponds #' to a token; the tokens that might parsimoniously be present at each point #' on a tree are denoted with `TRUE`. +#' If multiple trees are supplied, the strict consensus of all trees and +#' reconstructions will be returned; i.e. if a node is reconstructed as $0$ +#' in one tree, and $2$ in another, it will be labelled $(02)$. #' #' @references #' \insertAllCited{} @@ -48,24 +54,49 @@ #' @importFrom graphics par #' @importFrom TreeTools PostorderOrder #' @export -PlotCharacter <- function (tree, dataset, char = 1L, - updateTips = FALSE, - plot = TRUE, - - tokenCol = NULL, - ambigCol = "grey", - inappCol = "lightgrey", - - ambigLty = "dotted", - inappLty = "dashed", - plainLty = par("lty"), - - tipOffset = 1, - unitEdge = FALSE, - ...) { +PlotCharacter <- function(tree, dataset, char = 1L, + updateTips = FALSE, + plot = TRUE, + + tokenCol = NULL, + ambigCol = "grey", + inappCol = "lightgrey", + + ambigLty = "dotted", + inappLty = "dashed", + plainLty = par("lty"), + + tipOffset = 1, + unitEdge = FALSE, + Display = function(tree) tree, + ... +) { + UseMethod("PlotCharacter") +} + +#' @rdname PlotCharacter +#' @export +PlotCharacter.phylo <- function(tree, dataset, char = 1L, + updateTips = FALSE, + plot = TRUE, + + tokenCol = NULL, + ambigCol = "grey", + inappCol = "lightgrey", + + ambigLty = "dotted", + inappLty = "dashed", + plainLty = par("lty"), + + tipOffset = 1, + unitEdge = FALSE, + Display = function(tree) tree, + ... +) { # Reconcile labels datasetTaxa <- names(dataset) + tree <- Display(tree) treeTaxa <- tree[["tip.label"]] if(!all(treeTaxa %fin% datasetTaxa)) { stop("Taxa in tree missing from dataset:\n ", @@ -81,6 +112,9 @@ PlotCharacter <- function (tree, dataset, char = 1L, } nNode <- tree[["Nnode"]] nTip <- NTip(tree) + if (nNode != nTip - 1) { + stop("`tree` must be bifurcating. Try TreeTools::MakeTreeBinary(tree).") + } edge <- tree[["edge"]][postorder, ] parent <- edge[, 1] child <- edge[, 2] @@ -346,56 +380,173 @@ PlotCharacter <- function (tree, dataset, char = 1L, } anywhere <- as.logical(colSums(state[hasToken, , drop = FALSE])) slimState <- state[, anywhere, drop = FALSE] - if (plot) { - tokens <- colnames(slimState) - if (is.null(tokenCol)) { - tokenCol <- tokens - tokenCol[tokens != "-"] <- c("#00bfc6", - "#ffd46f", - "#ffbcc5", - "#c8a500", - "#ffcaf5", - "#d5fb8d", - "#e082b4", - "#25ffd3", - "#a6aaff", - "#e6f3cc", - "#67c4ff", - "#9ba75c", - "#60b17f")[seq_along(setdiff(tokens, "-"))] - tokenCol[tokens == "-"] <- inappCol - } - nodeStyle <- apply(slimState, 1, function (tkn) { - if (length(tkn) == 0) { - c(col = ambigCol, lty = ambigLty) - } else if (sum(tkn) > 1L) { - c(col = ambigCol, lty = ambigLty) - } else { - c(col = tokenCol[tkn], - lty = ifelse(tokens[tkn] == "-", inappLty, plainLty)) - } - }) - if (unitEdge) { - tree[["edge.length"]] <- rep_len(1, dim(tree[["edge"]])[1]) - } - plot.phylo(tree, - node.color = nodeStyle["col", , drop = FALSE], - node.lty = nodeStyle["lty", , drop = FALSE], - label.offset = tipOffset, - ...) - - NodeText <- function (n) { - if (length(n) == 0 || ( - sum(n) > 1L && all(n[anywhere & names(n) != "-"]))) { - "?" - } else { - paste0(levels[n], collapse = "") - } - } - nodelabels(apply(state, 1, NodeText), - seq_len(nTip + nNode), bg = nodeStyle["col", , drop = FALSE]) + + if (isTRUE(plot)) { + .PlotCharacter(tree, nTip, state, levels, tokenCol, ambigCol, inappCol, + ambigLty, inappLty, plainLty, tipOffset, unitEdge, ...) } # Return: invisible(slimState) } + +.PlotCharacter <- function(tree, nTip, state, tokens, + tokenCol, ambigCol, inappCol, + ambigLty, inappLty, plainLty, + tipOffset, unitEdge, ...) { + tokens <- colnames(state) + + hasToken <- if (length(setdiff(colnames(state), "-")) > 1L) { + as.logical(rowSums(!state[, colnames(state) != "-", drop = FALSE])) + } else { + !logical(nrow(state)) + } + anywhere <- as.logical(colSums(state[hasToken, , drop = FALSE])) + slimState <- state[, anywhere, drop = FALSE] + + if (is.null(tokenCol)) { + tokenCol <- tokens + tokenCol[tokens != "-"] <- c("#00bfc6", + "#ffd46f", + "#ffbcc5", + "#c8a500", + "#ffcaf5", + "#d5fb8d", + "#e082b4", + "#25ffd3", + "#a6aaff", + "#e6f3cc", + "#67c4ff", + "#9ba75c", + "#60b17f")[seq_along(setdiff(tokens, "-"))] + tokenCol[tokens == "-"] <- inappCol + } + nodeStyle <- apply(state, 1, function (tkn) { + if (length(tkn) == 0) { + c(col = ambigCol, lty = ambigLty) + } else if (sum(tkn) > 1L) { + c(col = ambigCol, lty = ambigLty) + } else { + c(col = tokenCol[tkn], + lty = ifelse(tokens[tkn] == "-", inappLty, plainLty)) + } + }) + if (unitEdge) { + tree[["edge.length"]] <- rep_len(1, dim(tree[["edge"]])[1]) + } + plot.phylo(tree, + node.color = nodeStyle["col", , drop = FALSE], + node.lty = nodeStyle["lty", , drop = FALSE], + label.offset = tipOffset, + ...) + + .NodeText <- function (n) { + if (length(n) == 0 || ( + sum(n) > 1L && all(n[anywhere & names(n) != "-"]))) { + "?" + } else { + paste0(tokens[n], collapse = "") + } + } + nodelabels(apply(state, 1, .NodeText), + seq_len(nTip + tree[["Nnode"]]), + bg = nodeStyle["col", , drop = FALSE]) +} + +#' @rdname PlotCharacter +#' @importFrom TreeTools as.Splits Consensus DescendantTips TipLabels +#' @export +PlotCharacter.multiPhylo <- function(tree, dataset, char = 1L, + updateTips = FALSE, + plot = TRUE, + + tokenCol = NULL, + ambigCol = "grey", + inappCol = "lightgrey", + + ambigLty = "dotted", + inappLty = "dashed", + plainLty = par("lty"), + + tipOffset = 1, + unitEdge = FALSE, + Display = function(tree) tree, + ...) { + + if (length(tree) == 1) { + return(PlotCharacter(tree[[1]], dataset, char, updateTips, plot, + tokenCol, ambigCol, inappCol, + ambigLty, inappLty, plainLty, + tipOffset, unitEdge, Display, ...)) + } + + tipLabels <- unique(lapply(lapply(tree, TipLabels), sort)) + if (length(tipLabels) != 1) { + stop("All trees must have the same tip labels") + } + tipLabels <- tipLabels[[1]] + nTip <- length(tipLabels) + tokens <- attr(dataset, "levels") + reconstructions <- lapply(tree, PlotCharacter, + dataset = dataset, char = char, + updateTips = updateTips, plot = FALSE, + Display = function(tree) tree, ...) + # Check labels: definitely identical, possibly in different sequence + consTree <- Display(Consensus(tree, p = 1, check.labels = TRUE)) + .TreeClades <- function(tr) { + ed <- tr[["edge"]] + lab <- TipLabels(tr) + apply(DescendantTips(ed[, 1], ed[, 2], + node = seq_len(nTip + tr[["Nnode"]])), + 1, function (tips) { + paste0(sort(lab[tips]), collapse = " @||@ ") + }) + } + consClades <- .TreeClades(consTree) + .Recon <- function(i) { + reconstructions[[i]][ + match(consClades, .TreeClades(tree[[i]])), , drop = FALSE] + } + recon <- matrix(FALSE, nrow = length(consClades), ncol = length(tokens), + dimnames = list(NULL, tokens)) + for (i in seq_along(tree)) { + ri <- .Recon(i) + recon[, colnames(ri)] <- recon[, colnames(ri)] | ri + } + + if (isTRUE(plot)) { + .PlotCharacter(consTree, nTip, recon, tokens, tokenCol, ambigCol, inappCol, + ambigLty, inappLty, plainLty, tipOffset, unitEdge, ...) + } + + invisible(recon) +} + +#' @rdname PlotCharacter +#' @export +PlotCharacter.list <- function(tree, dataset, char = 1L, + updateTips = FALSE, + plot = TRUE, + + tokenCol = NULL, + ambigCol = "grey", + inappCol = "lightgrey", + + ambigLty = "dotted", + inappLty = "dashed", + plainLty = par("lty"), + + tipOffset = 1, + unitEdge = FALSE, + Display = function(tree) tree, + ... +) { + if (all(vapply(tree, inherits, logical(1), "phylo"))) { + PlotCharacter.multiPhylo(tree, dataset, char, updateTips, plot, + tokenCol, ambigCol, inappCol, + ambigLty, inappLty, plainLty, + tipOffset, unitEdge, Display, ...) + } else { + stop("Elements of `tree` must be of class `phylo`") + } +} diff --git a/R/TaxonInfluence.R b/R/TaxonInfluence.R index d7be0e3e3..d4a520226 100644 --- a/R/TaxonInfluence.R +++ b/R/TaxonInfluence.R @@ -44,16 +44,17 @@ #' If `NULL`, an optimal tree will be sought using parsimony search with #' the parameters provided in \code{\dots}. #' @param Distance Function to calculate tree distance; default: -#' \link[TreeDist:ClusteringInfoDistance]{`ClusteringInfoDistance()`}. +#' \code{\link[TreeDist:ClusteringInfoDistance]{ClusteringInfoDistance()}}. #' @param calcWeighted Logical specifying whether to compute the #' distance-weighted mean value. #' @param savePath Character giving prefix of path to which reduced trees will -#' be saved (with \link[ape:write.nexus]{`write.nexus()`}). +#' be saved (with \code{\link[ape:write.nexus]{write.nexus()}}). #' File names will follow the pattern #' `paste0(savePath, droppedTaxonName, ".nex")`; `savePath` should thus contain #' a trailing `/` if writing to a directory, which will be created if it does #' not exist. Special characters will be removed from leaf labels when -#' creating the file path (using \link[fs:path_sanitize]{`path_sanitize()`}). +#' creating the file path (using +#' \code{\link[fs:path_sanitize]{path_sanitize()}}). #' If `NULL`, computed trees will not be saved. #' @param useCache Logical vector; if `TRUE`, previous tree search results will #' be loaded from the location given by `savePath`, instead of running a fresh diff --git a/R/data.R b/R/data.R index 9057d60ea..5ba9a21db 100644 --- a/R/data.R +++ b/R/data.R @@ -6,7 +6,7 @@ #' Datasets are sorted into two subsets, each sorted alphabetically; #' the first subset comprise simpler datasets with faster processing times. #' `inapplicable.datasets` provide the data in the matrix format generated by -#' \link[ape:read.nexus.data]{`read.nexus.data()`}; +#' \code{\link[ape:read.nexus.data]{read.nexus.data()}}; #' `inapplicable.phyData` are in \code{phyDat} format. #' `inapplicable.trees` lists for each dataset a sample of up to 50 trees #' obtained by tree search under each inapplicable treatment, named accordingly. diff --git a/inst/Parsimony/app.R b/inst/Parsimony/app.R index 097d1f446..b348e73de 100644 --- a/inst/Parsimony/app.R +++ b/inst/Parsimony/app.R @@ -337,8 +337,8 @@ ui <- fluidPage( "Tree space" = "space"), # "ind"), "cons"), - hidden(sliderInput("whichTree", "Tree to plot", value = 1L, - min = 1L, max = 1L, step = 1L)), + hidden(sliderInput("whichTree", "Tree to plot", value = 0L, + min = 0L, max = 1L, step = 1L)), hidden(tags$div(id = "treePlotConfig", selectizeInput("outgroup", "Root on:", multiple = TRUE, choices = list()), @@ -1127,8 +1127,8 @@ server <- function(input, output, session) { } } - updateSliderInput(session, "whichTree", min = 1L, - max = length(r$trees), value = 1L) + updateSliderInput(session, "whichTree", min = 0L, + max = length(r[["trees"]]), value = 0L) UpdateKeepNTipsRange() # Updates Rogues() UpdateDroppedTaxaDisplay() if (maxProjDim() > 0) { @@ -1662,8 +1662,8 @@ server <- function(input, output, session) { attr(r$trees[[1]], "firstHit") <- NULL } - updateSliderInput(session, "whichTree", min = 1L, - max = length(r$trees), value = 1L) + updateSliderInput(session, "whichTree", min = 0L, + max = length(r[["trees"]]), value = 0L) updateActionButton(session, "go", "Continue") updateActionButton(session, "modalGo", "Continue search") @@ -1684,7 +1684,7 @@ server <- function(input, output, session) { UserRoot <- function(tree) { outgroupTips <- intersect(r$outgroup, tree$tip.label) if (length(outgroupTips)) { - tr <- deparse(substitute(tree)) + # DELETE? tr <- deparse(substitute(tree)) RootTree(tree, outgroupTips) } else { tree @@ -1729,18 +1729,25 @@ server <- function(input, output, session) { PlottedTree <- reactive({ if (length(r$trees) > 0L) { - plottedTree <- r$trees[[whichTree()]] + plottedTree <- if (whichTree() > 0) { + r$trees[[whichTree()]] + } else { + Consensus(r$trees, p = 1) + } plottedTree <- UserRoot(plottedTree) plottedTree <- SortEdges(plottedTree) - if (!("tipsRight" %in% input$mapDisplay)) { - plottedTree$edge.length <- rep_len(2, dim(plottedTree$edge)[1]) + plottedTree$edge.length <- rep_len(2, dim(plottedTree[["edge"]])[[1]]) } plottedTree } }) LogPlottedTree <- function() { - LogCodeP(paste0("plottedTree <- trees[[", whichTree(), "]]")) + if (whichTree() > 0) { + LogCodeP(paste0("plottedTree <- trees[[", whichTree(), "]]")) + } else { + LogCodeP("plottedTree <- Consensus(trees, p = 1)") + } LogUserRoot("plottedTree") if (!("tipsRight" %in% input$mapDisplay)) { LogCommentP("Set uniform edge length", 0) @@ -2109,7 +2116,9 @@ server <- function(input, output, session) { CharacterwisePlot <- function() { par(mar = rep(0, 4), cex = 0.9) n <- PlottedChar() - LogMsg("Plotting PlottedTree(", whichTree(), ", ", n, ")") + if (whichTree() > 0) { + LogMsg("Plotting PlottedTree(", whichTree(), ", ", n, ")") + } r$plottedTree <- PlottedTree() if (length(n) && n > 0L) { pc <- tryCatch({ @@ -2121,10 +2130,21 @@ server <- function(input, output, session) { (192 * extraLen[r$plottedTree$tip.label] / max(extraLen)) + 1 ] } - PlotCharacter(r$plottedTree, r$dataset, n, - edge.width = 2.5, - updateTips = "updateTips" %in% input$mapDisplay, - tip.color = roguishness) + PlotCharacter( + if (whichTree() > 0) r$plottedTree else lapply(r$trees, UserRoot), + r$dataset, + n, + edge.width = 2.5, + updateTips = "updateTips" %in% input$mapDisplay, + tip.color = roguishness, + Display = function(tr) { + tr <- UserRoot(tr) + if (unitEdge()) { + tr$edge.length <- rep.int(1, dim(tr$edge)[[1]]) + } + SortEdges(tr) + } + ) if (max(extraLen) > 0) { PlotTools::SpectrumLegend( "bottomleft", bty = "n", @@ -2137,6 +2157,8 @@ server <- function(input, output, session) { } }, error = function (cond) { + message("ASHOGAIH") + message(cond) cli::cli_alert_danger(cond) Notification(type = "error", "Could not match dataset to taxa in trees") @@ -2167,16 +2189,28 @@ server <- function(input, output, session) { BeginLogP() LogPar() n <- PlottedChar() - LogComment(paste("Select tree", whichTree(), "from tree set")) + if (whichTree() > 0) { + LogComment(paste("Select tree", whichTree(), "from tree set")) + } LogPlottedTree() if (length(n) && n > 0L) { - LogCommentP(paste("Map character", n, "onto tree", whichTree())) + if (whichTree() > 0) { + LogCommentP(paste("Map character", n, "onto tree", whichTree())) + } else { + LogCommentP(paste("Map character", n, "onto consensus tree")) + } LogCodeP( "PlotCharacter(", - " tree = plottedTree,", + if (whichTree() > 0) " tree = plottedTree," else + paste0(" tree = RootTree(trees, ", EnC(r$outgroup), "),"), " dataset = dataset,", paste0(" char = ", n, ","), paste0(" updateTips = ", "updateTips" %in% input$mapDisplay, ","), + " Display = function(tr) {", + paste0(" tr <- RootTree(tr, ", EnC(r$outgroup), ")"), + " tr$edge.length <- rep.int(2, nrow(tr$edge))", + " SortTree(tr)", + " },", " edge.width = 2.5", ")" ) diff --git a/inst/Parsimony/log.lg b/inst/Parsimony/log.lg new file mode 100644 index 000000000..2d5135556 --- /dev/null +++ b/inst/Parsimony/log.lg @@ -0,0 +1,84 @@ +2025-02-14 13:02:01 + Started server +2025-02-14 13:02:02 + UpdateDroppedTaxaDisplay() +2025-02-14 13:02:02 + DroppedTips() +2025-02-14 13:02:02 + KeptTips() +2025-02-14 13:02:02 + dropSeq() +2025-02-14 13:02:02 + UpdateData(): from package +2025-02-14 13:02:03 + UpdateAllTrees() +2025-02-14 13:02:03 + UpdateTreeRange([1, 1] -> [1, 125]) +2025-02-14 13:02:03 + UpdateNTree(0 -> 48) +2025-02-14 13:02:03 + UpdateActiveTrees() +2025-02-14 13:02:03 + DisplayTreeScores() +2025-02-14 13:02:03 + scores(): Recalculating scores with k = 10 +2025-02-14 13:02:03 + UpdateKeepNTipsRange(0 -> 54) +2025-02-14 13:02:03 + nNonRogues() +2025-02-14 13:02:03 + nNonRogues: 49 +2025-02-14 13:02:03 + UpdateDroppedTaxaDisplay() +2025-02-14 13:02:03 + DroppedTips() +2025-02-14 13:02:03 + KeptTips() +2025-02-14 13:02:03 + dropSeq() +2025-02-14 13:02:03 + UpdateExcludedTipsInput() +2025-02-14 13:02:03 + UpdateOutgroupInput() +2025-02-14 13:02:03 + /UpdateAllTrees() +2025-02-14 13:02:03 + DisplayTreeScores() +2025-02-14 13:02:03 + renderUI(branchLegend) +2025-02-14 13:02:03 + /renderUI(branchLegend) +2025-02-14 13:02:03 + MainPlot() +2025-02-14 13:02:03 + ConsensusPlot() +2025-02-14 13:02:03 + LabelConcordance() +2025-02-14 13:02:03 + /ConsensusPlot() +2025-02-14 13:02:03 + renderUI(branchLegend) +2025-02-14 13:02:03 + /renderUI(branchLegend) +2025-02-14 13:02:03 + MainPlot() +2025-02-14 13:02:03 + ConsensusPlot() +2025-02-14 13:02:03 + LabelConcordance() +2025-02-14 13:02:03 + /ConsensusPlot() +2025-02-14 13:02:05 + MainPlot() +2025-02-14 13:02:06 + LabelConcordance() +2025-02-14 13:02:06 + UpdateDroppedTaxaDisplay() +2025-02-14 13:02:07 + MainPlot() +2025-02-14 13:02:07 + Plotting PlottedTree(5, 1) +2025-02-14 13:02:07 + LabelConcordance() +2025-02-14 13:02:13 + Session has ended diff --git a/man/AdditionTree.Rd b/man/AdditionTree.Rd index 837d76fe7..0f211a640 100644 --- a/man/AdditionTree.Rd +++ b/man/AdditionTree.Rd @@ -25,7 +25,7 @@ approaches returned trees will be perfectly compatible with each character in \code{constraint}; or a tree of class \code{phylo}, all of whose nodes will occur in any output tree. -See \link[TreeTools:ImposeConstraint]{\code{ImposeConstraint()}} and +See \code{\link[TreeTools:ImposeConstraint]{ImposeConstraint()}} and \href{https://ms609.github.io/TreeSearch/articles/tree-search.html}{vignette} for further examples.} diff --git a/man/MaximizeParsimony.Rd b/man/MaximizeParsimony.Rd index 5c476c19d..9af184e8a 100644 --- a/man/MaximizeParsimony.Rd +++ b/man/MaximizeParsimony.Rd @@ -110,7 +110,7 @@ in search results, which may improve the accuracy of the consensus tree returned trees will be perfectly compatible with each character in \code{constraint}; or a tree of class \code{phylo}, all of whose nodes will occur in any output tree. -See \link[TreeTools:ImposeConstraint]{\code{ImposeConstraint()}} and +See \code{\link[TreeTools:ImposeConstraint]{ImposeConstraint()}} and \href{https://ms609.github.io/TreeSearch/articles/tree-search.html}{vignette} for further examples.} diff --git a/man/PlotCharacter.Rd b/man/PlotCharacter.Rd index 094859f81..4458c6157 100644 --- a/man/PlotCharacter.Rd +++ b/man/PlotCharacter.Rd @@ -2,6 +2,9 @@ % Please edit documentation in R/PlotCharacter.R \name{PlotCharacter} \alias{PlotCharacter} +\alias{PlotCharacter.phylo} +\alias{PlotCharacter.multiPhylo} +\alias{PlotCharacter.list} \title{Plot the distribution of a character on a tree} \usage{ PlotCharacter( @@ -18,11 +21,67 @@ PlotCharacter( plainLty = par("lty"), tipOffset = 1, unitEdge = FALSE, + Display = function(tree) tree, + ... +) + +\method{PlotCharacter}{phylo}( + tree, + dataset, + char = 1L, + updateTips = FALSE, + plot = TRUE, + tokenCol = NULL, + ambigCol = "grey", + inappCol = "lightgrey", + ambigLty = "dotted", + inappLty = "dashed", + plainLty = par("lty"), + tipOffset = 1, + unitEdge = FALSE, + Display = function(tree) tree, + ... +) + +\method{PlotCharacter}{multiPhylo}( + tree, + dataset, + char = 1L, + updateTips = FALSE, + plot = TRUE, + tokenCol = NULL, + ambigCol = "grey", + inappCol = "lightgrey", + ambigLty = "dotted", + inappLty = "dashed", + plainLty = par("lty"), + tipOffset = 1, + unitEdge = FALSE, + Display = function(tree) tree, + ... +) + +\method{PlotCharacter}{list}( + tree, + dataset, + char = 1L, + updateTips = FALSE, + plot = TRUE, + tokenCol = NULL, + ambigCol = "grey", + inappCol = "lightgrey", + ambigLty = "dotted", + inappLty = "dashed", + plainLty = par("lty"), + tipOffset = 1, + unitEdge = FALSE, + Display = function(tree) tree, ... ) } \arguments{ -\item{tree}{A tree of class \code{\link{phylo}}.} +\item{tree}{A bifurcating tree of class \code{phylo}, or a list or \code{multiPhylo} +object containing such trees.} \item{dataset}{A phylogenetic data matrix of \pkg{phangorn} class \code{phyDat}, whose names correspond to the labels of any accompanying tree. @@ -46,6 +105,9 @@ to apply to ambiguous, inapplicable and applicable tokens. See the \code{lty} \item{unitEdge}{Logical: Should all edges be plotted with a unit length?} +\item{Display}{Function that takes argument \code{tree} and returns a tree +of class \code{phylo}, formatted as it will be plotted.} + \item{\dots}{Further arguments to pass to \code{plot.phylo()}.} } \value{ @@ -53,6 +115,9 @@ to apply to ambiguous, inapplicable and applicable tokens. See the \code{lty} corresponds to a numbered tip or node of \code{tree}, and each column corresponds to a token; the tokens that might parsimoniously be present at each point on a tree are denoted with \code{TRUE}. +If multiple trees are supplied, the strict consensus of all trees and +reconstructions will be returned; i.e. if a node is reconstructed as $0$ +in one tree, and $2$ in another, it will be labelled $(02)$. } \description{ Reconstructs the distribution of a character on a tree topology using the diff --git a/man/TaxonInfluence.Rd b/man/TaxonInfluence.Rd index 96e708314..6c1875d4f 100644 --- a/man/TaxonInfluence.Rd +++ b/man/TaxonInfluence.Rd @@ -27,18 +27,19 @@ If \code{NULL}, an optimal tree will be sought using parsimony search with the parameters provided in \code{\dots}.} \item{Distance}{Function to calculate tree distance; default: -\link[TreeDist:ClusteringInfoDistance]{\code{ClusteringInfoDistance()}}.} +\code{\link[TreeDist:ClusteringInfoDistance]{ClusteringInfoDistance()}}.} \item{calcWeighted}{Logical specifying whether to compute the distance-weighted mean value.} \item{savePath}{Character giving prefix of path to which reduced trees will -be saved (with \link[ape:write.nexus]{\code{write.nexus()}}). +be saved (with \code{\link[ape:write.nexus]{write.nexus()}}). File names will follow the pattern \code{paste0(savePath, droppedTaxonName, ".nex")}; \code{savePath} should thus contain a trailing \code{/} if writing to a directory, which will be created if it does not exist. Special characters will be removed from leaf labels when -creating the file path (using \link[fs:path_sanitize]{\code{path_sanitize()}}). +creating the file path (using +\code{\link[fs:path_sanitize]{path_sanitize()}}). If \code{NULL}, computed trees will not be saved.} \item{useCache}{Logical vector; if \code{TRUE}, previous tree search results will diff --git a/man/inapplicable.datasets.Rd b/man/inapplicable.datasets.Rd index b8383f699..3357379e7 100644 --- a/man/inapplicable.datasets.Rd +++ b/man/inapplicable.datasets.Rd @@ -146,7 +146,7 @@ The name of each item corresponds to the datasets listed below. Datasets are sorted into two subsets, each sorted alphabetically; the first subset comprise simpler datasets with faster processing times. \code{inapplicable.datasets} provide the data in the matrix format generated by -\link[ape:read.nexus.data]{\code{read.nexus.data()}}; +\code{\link[ape:read.nexus.data]{read.nexus.data()}}; \code{inapplicable.phyData} are in \code{phyDat} format. \code{inapplicable.trees} lists for each dataset a sample of up to 50 trees obtained by tree search under each inapplicable treatment, named accordingly. diff --git a/tests/testthat/_snaps/PlotCharacter/plotchar-consensus.svg b/tests/testthat/_snaps/PlotCharacter/plotchar-consensus.svg new file mode 100644 index 000000000..98a79de57 --- /dev/null +++ b/tests/testthat/_snaps/PlotCharacter/plotchar-consensus.svg @@ -0,0 +1,80 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +a +b +c +d +g +h +e +f + + + + + + + + + + + + + +0 +0 +0 +1 +1 +1 +1 +0 +0 +0 +0 +? +1 + + diff --git a/tests/testthat/_snaps/PlotCharacter/plotchar-invar-ambig.svg b/tests/testthat/_snaps/PlotCharacter/plotchar-invar-ambig.svg new file mode 100644 index 000000000..93be3ac5a --- /dev/null +++ b/tests/testthat/_snaps/PlotCharacter/plotchar-invar-ambig.svg @@ -0,0 +1,80 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +a +b +c +d +g +h +e +f + + + + + + + + + + + + + +0 +0 +0 +0 +0 +0 +0 +0 +0 +0 +0 +0 +0 + + diff --git a/tests/testthat/_snaps/PlotCharacter/plotchar-invariant.svg b/tests/testthat/_snaps/PlotCharacter/plotchar-invariant.svg new file mode 100644 index 000000000..93be3ac5a --- /dev/null +++ b/tests/testthat/_snaps/PlotCharacter/plotchar-invariant.svg @@ -0,0 +1,80 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +a +b +c +d +g +h +e +f + + + + + + + + + + + + + +0 +0 +0 +0 +0 +0 +0 +0 +0 +0 +0 +0 +0 + + diff --git a/tests/testthat/test-PlotCharacter.R b/tests/testthat/test-PlotCharacter.R index 90cb6e223..9f6c4dba6 100644 --- a/tests/testthat/test-PlotCharacter.R +++ b/tests/testthat/test-PlotCharacter.R @@ -1,8 +1,10 @@ -test_that("PlotCharacter()", { +test_that("PlotCharacter.phylo()", { dataset <- TreeTools::StringToPhyDat("1111 1111 0000", tips = 12) expect_error(PlotCharacter(TreeTools::BalancedTree(14), dataset), "Taxa in tree missing from dataset:\\s*t13, t14$") + expect_error(PlotCharacter(TreeTools::StarTree(12), dataset), + "bifurcating") Character <- function (str, plot = FALSE, edges = FALSE, ...) { tree <- ape::read.tree(text = @@ -131,3 +133,42 @@ test_that("Out-of-sequence works", { )} ) }) + +test_that("PlotCharacter.multi()", { + Bal <- TreeTools::BalancedTree + a..h <- letters[1:8] + expect_error(PlotCharacter(list(Bal(8), 9), "dataset"), "class `phylo`") + expect_error(PlotCharacter(list(Bal(8), Bal(9)), "dataset"), + "same tip labels") + expect_error(PlotCharacter(list(Bal(8), Bal(a..h)), "dataset"), + "same tip labels") + + trees <- ape::read.tree(text = c("(a, (b, (c, (d, ((g, h), (e, f))))));", + "(a, (b, (c, ((d, e), (f, (g, h))))));")) + + dat <- TreeTools::StringToPhyDat("00011011", tips = a..h) + expect_equal(PlotCharacter(trees[1], dat, plot = FALSE), + PlotCharacter(trees[[1]], dat, plot = FALSE)) + + + state1 <- PlotCharacter(trees[[1]], dat, plot = FALSE) + state2 <- PlotCharacter(trees[[2]], dat, plot = FALSE) + stateCons <- PlotCharacter(trees, dat, plot = FALSE) + expect_equal(stateCons, state1[-c(13, 15), ] | + state2[c(match(TipLabels(trees[[1]]), TipLabels(trees[[2]])), + 9:12, 15), ]) + + + skip_if_not_installed("vdiffr") + vdiffr::expect_doppelganger("PlotChar_consensus", function() { + PlotCharacter(trees, dat) + }) + vdiffr::expect_doppelganger("PlotChar_invariant", function() { + inv <- TreeTools::StringToPhyDat("00000000", tips = a..h) + PlotCharacter(trees, inv) + }) + vdiffr::expect_doppelganger("PlotChar_invar_ambig", function() { + invq <- TreeTools::StringToPhyDat("000?00?{01}", tips = a..h) + PlotCharacter(trees, invq) + }) +})