diff --git a/.github/workflows/R-CMD-check.yml b/.github/workflows/R-CMD-check.yml index f5bd52b9a..4161bbc5e 100644 --- a/.github/workflows/R-CMD-check.yml +++ b/.github/workflows/R-CMD-check.yml @@ -51,8 +51,8 @@ jobs: config: - {os: windows-latest, r: 'release'} - {os: macOS-latest, r: 'release'} - - {os: ubuntu-24.04, r: '3.6', rspm: "https://packagemanager.posit.co/cran/2022-04-01"} - - {os: ubuntu-24.04, r: '4.0', rspm: "https://packagemanager.posit.co/cran/2022-04-01"} + - {os: ubuntu-24.04, r: '3.6', rspm: "https://packagemanager.posit.co/cran/2022-10-11"} + - {os: ubuntu-24.04, r: '4.0', rspm: "https://packagemanager.posit.co/cran/2022-10-11"} - {os: ubuntu-24.04, r: 'release', rspm: "https://packagemanager.posit.co/cran/__linux__/noble/latest"} - {os: ubuntu-24.04, r: 'devel', rspm: "https://packagemanager.posit.co/cran/__linux__/noble/latest"} @@ -86,7 +86,7 @@ jobs: fi echo "Current package version is now: $(grep "Version:" DESCRIPTION | awk '{print $2}')" shell: bash - + - name: Set up R uses: r-lib/actions/setup-r@v2 with: @@ -97,7 +97,6 @@ jobs: run: | sudo apt-get install texlive-latex-base texlive-fonts-recommended - - name: Install system dependencies (R 3.x) if: matrix.config.r < '4.0' run: | @@ -127,11 +126,6 @@ jobs: sed -i '1i#include ' vdiffr-src/src/devSVG.cpp R CMD INSTALL --preclean --no-multiarch --with-keep.source vdiffr-src rm -rf vdiffr-src - - - name: Show installed R packages - run: | - Rscript -e 'sessionInfo()' - Rscript -e 'installed.packages()[, c("Package", "Version")]' - name: Set up R dependencies (R 3.x) if: matrix.config.r < '4.0' @@ -142,7 +136,7 @@ jobs: github::ms609/PlotTools@v0.3.1 rcmdcheck@1.3.3 waldo@0.4.0 - testthat@3.0.4 + testthat@3.1.5 pkgload@1.2.4 pkgdown@2.0.1 bslib@0.3.1 @@ -161,11 +155,6 @@ jobs: needs: | check coverage - - - name: Show installed R packages - run: | - Rscript -e 'sessionInfo()' - Rscript -e 'installed.packages()[, c("Package", "Version")]' - name: Set up R dependencies (Non-Windows) if: ${{runner.os != 'Windows' && matrix.config.r >= '4.0' }} @@ -173,20 +162,11 @@ jobs: with: needs: | check - extra-packages: + extra-packages: | + TreeDist=?ignore-before-r=4.0.0 + vdiffr=?ignore-before-r=4.0.0 phangorn=?ignore-before-r=4.1.0 - - - name: Show installed R packages - run: | - Rscript -e 'sessionInfo()' - Rscript -e 'installed.packages()[, c("Package", "Version")]' - - - name: Debug package requirements - run: | - Rscript -e 'ip <- as.data.frame(installed.packages()[, c("Package","Version")]); print(ip[ip$Package %in% c("rmarkdown","knitr","xfun","htmltools","tinytex"), ])' - Rscript -e 'deps <- tools::package_dependencies("htmltools", db = available.packages(), which = c("Depends","Imports","LinkingTo")); print(deps)' - Rscript -e 'cat("rmarkdown DESCRIPTION:\n"); cat(readLines(system.file("DESCRIPTION", package = "rmarkdown")), sep="\n")' - + - name: Check package uses: r-lib/actions/check-r-package@v2 diff --git a/DESCRIPTION b/DESCRIPTION index f860ecd66..d776a43c5 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: TreeTools Title: Create, Modify and Analyse Phylogenetic Trees -Version: 1.16.1.9001 +Version: 1.16.1.9002 Authors@R: c( person("Martin R.", 'Smith', role = c("aut", "cre", "cph"), email = "martin.smith@durham.ac.uk", diff --git a/NAMESPACE b/NAMESPACE index e79c399f0..e3885c0fc 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -32,6 +32,8 @@ S3method(ApePostorder,multiPhylo) S3method(ApePostorder,phylo) S3method(ArtificialExtinction,matrix) S3method(ArtificialExtinction,phyDat) +S3method(Cherries,numeric) +S3method(Cherries,phylo) S3method(Cladewise,"NULL") S3method(Cladewise,list) S3method(Cladewise,matrix) @@ -270,6 +272,7 @@ export(ArtEx) export(ArtificialExtinction) export(BalancedTree) export(CharacterInformation) +export(Cherries) export(CladeSizes) export(Cladewise) export(CladisticInfo) diff --git a/NEWS.md b/NEWS.md index 22ac2dfd9..f36c02099 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,6 @@ -# TreeTools 1.16.1.9001` (development) # +# TreeTools 1.16.1.9002` (development) # +- `Cherries()` counts the cherries in a binary tree. - New method `as.Splits.integer()`. - Fix `RoguePlot(sort = TRUE)` [Rogue#33](https://github.com/ms609/Rogue/issues/33). diff --git a/R/Cherries.R b/R/Cherries.R new file mode 100644 index 000000000..aa9088d2f --- /dev/null +++ b/R/Cherries.R @@ -0,0 +1,29 @@ +#' Count cherries in a tree +#' +#' `Cherries()` counts the number of vertices in a binary tree whose children +#' are both leaves. +#' +#' @param tree A binary tree, of class `phylo`; or a matrix corresponding to its +#' edge matrix. +#' @param nTip Number of leaves in tree. +#' @return `Cherries()` returns an integer specifying the number of nodes whose +#' children are both leaves. +#' @family tree properties +#' @template MRS +#' @export +Cherries <- function(tree, nTip) UseMethod("Cherries") + +#' @rdname Cherries +#' @export +Cherries.phylo <- function(tree, nTip = NTip(tree)) { + n_cherries_wrapper(tree[["edge"]][, 1], tree[["edge"]][, 2], nTip) +} + +#' @rdname Cherries +#' @export +Cherries.numeric <- function(tree, nTip) { + if (is.null(dim(tree)) || dim(tree)[[2]] != 2) { + stop("`tree` must be the edge matrix of a tree of class phylo") + } + n_cherries_wrapper(tree[, 1], tree[, 2], nTip) +} diff --git a/R/RcppExports.R b/R/RcppExports.R index 3dcca5f13..65c8e627f 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -69,6 +69,10 @@ minimum_spanning_tree <- function(order) { .Call(`_TreeTools_minimum_spanning_tree`, order) } +n_cherries_wrapper <- function(parent, child, nTip) { + .Call(`_TreeTools_n_cherries_wrapper`, parent, child, nTip) +} + path_lengths <- function(edge, weight, init_nas) { .Call(`_TreeTools_path_lengths`, edge, weight, init_nas) } diff --git a/inst/include/TreeTools/n_cherries.h b/inst/include/TreeTools/n_cherries.h new file mode 100644 index 000000000..24305ef64 --- /dev/null +++ b/inst/include/TreeTools/n_cherries.h @@ -0,0 +1,70 @@ +#ifndef TreeTools_n_cherries_ +#define TreeTools_n_cherries_ + +#include /* for std::unique_ptr */ +#include /* for errors */ +#include + +#include "assert.h" /* for ASSERT */ + +namespace TreeTools{ + +// Number of cherries in a binary phylogenetic tree +inline int n_cherries(const int* parent, + const int* child, + const size_t n_edge, + const int n_tip) { + + const size_t n_node = n_edge / 2; + std::unique_ptr internal(new bool[n_node]()); + + const bool unrooted = n_edge % 2; + if (unrooted) { + std::unique_ptr is_child(new bool[n_node + n_tip + 1]()); + + for (size_t ed = 0; ed < n_edge; ++ed) { + is_child[child[ed]] = true; + } + + const int i_limit = n_tip + n_node + 1; + int root_node = n_tip + 1; + for (; root_node <= i_limit; ++root_node) { + if (!is_child[root_node]) break; + } + + if (root_node == i_limit) { + throw std::runtime_error("Tree must be acyclic"); // nocov + } + + bool root_internal_found = false; + for (size_t ed = 0; ed < n_edge; ++ed) { + const int child_i = child[ed]; + if (child_i > n_tip) { + const int node = parent[ed]; + if (!root_internal_found && node == root_node) { + root_internal_found = true; + } else { + internal[node - n_tip] = true; + } + } + } + + } else { + for (size_t ed = 0; ed < n_edge; ++ed) { + if (child[ed] > n_tip) { + const size_t node_idx = parent[ed] - n_tip; + internal[node_idx] = true; + } + } + } + + int n_cherries = 0; + for (size_t i = 0; i < n_node; ++i) { + if (!internal[i]) ++n_cherries; + } + return n_cherries; +} + +} + +#endif \ No newline at end of file diff --git a/man/Cherries.Rd b/man/Cherries.Rd new file mode 100644 index 000000000..b267d8f84 --- /dev/null +++ b/man/Cherries.Rd @@ -0,0 +1,47 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Cherries.R +\name{Cherries} +\alias{Cherries} +\alias{Cherries.phylo} +\alias{Cherries.numeric} +\title{Count cherries in a tree} +\usage{ +Cherries(tree, nTip) + +\method{Cherries}{phylo}(tree, nTip = NTip(tree)) + +\method{Cherries}{numeric}(tree, nTip) +} +\arguments{ +\item{tree}{A binary tree, of class \code{phylo}; or a matrix corresponding to its +edge matrix.} + +\item{nTip}{Number of leaves in tree.} +} +\value{ +\code{Cherries()} returns an integer specifying the number of nodes whose +children are both leaves. +} +\description{ +\code{Cherries()} counts the number of vertices in a binary tree whose children +are both leaves. +} +\seealso{ +Other tree properties: +\code{\link{ConsensusWithout}()}, +\code{\link{LongBranch}()}, +\code{\link{MatchEdges}()}, +\code{\link{NSplits}()}, +\code{\link{NTip}()}, +\code{\link{NodeNumbers}()}, +\code{\link{PathLengths}()}, +\code{\link{SplitsInBinaryTree}()}, +\code{\link{TipLabels}()}, +\code{\link{TreeIsRooted}()}, +\code{\link{Treeness}()} +} +\author{ +\href{https://orcid.org/0000-0001-5660-1727}{Martin R. Smith} +(\href{mailto:martin.smith@durham.ac.uk}{martin.smith@durham.ac.uk}) +} +\concept{tree properties} diff --git a/man/ConsensusWithout.Rd b/man/ConsensusWithout.Rd index 8cc77fe93..a2b5720b1 100644 --- a/man/ConsensusWithout.Rd +++ b/man/ConsensusWithout.Rd @@ -80,6 +80,7 @@ Other tree manipulation: \code{\link{TrivialTree}} Other tree properties: +\code{\link{Cherries}()}, \code{\link{LongBranch}()}, \code{\link{MatchEdges}()}, \code{\link{NSplits}()}, diff --git a/man/LongBranch.Rd b/man/LongBranch.Rd index 79165652c..f8bf310c8 100644 --- a/man/LongBranch.Rd +++ b/man/LongBranch.Rd @@ -45,6 +45,7 @@ tree$tip.label[lb > threshold] } \seealso{ Other tree properties: +\code{\link{Cherries}()}, \code{\link{ConsensusWithout}()}, \code{\link{MatchEdges}()}, \code{\link{NSplits}()}, diff --git a/man/MatchEdges.Rd b/man/MatchEdges.Rd index 732ac6eca..0f6cd0e3c 100644 --- a/man/MatchEdges.Rd +++ b/man/MatchEdges.Rd @@ -48,6 +48,7 @@ Other tree navigation: \code{\link{RootNode}()} Other tree properties: +\code{\link{Cherries}()}, \code{\link{ConsensusWithout}()}, \code{\link{LongBranch}()}, \code{\link{NSplits}()}, diff --git a/man/NSplits.Rd b/man/NSplits.Rd index b27e306ea..5e900f62c 100644 --- a/man/NSplits.Rd +++ b/man/NSplits.Rd @@ -53,6 +53,7 @@ NSplits(as.Splits(BalancedTree(8))) } \seealso{ Other tree properties: +\code{\link{Cherries}()}, \code{\link{ConsensusWithout}()}, \code{\link{LongBranch}()}, \code{\link{MatchEdges}()}, diff --git a/man/NTip.Rd b/man/NTip.Rd index 84a072c8c..0bc777fa5 100644 --- a/man/NTip.Rd +++ b/man/NTip.Rd @@ -41,6 +41,7 @@ objects of class \code{Splits} and \code{list}, and edge matrices } \seealso{ Other tree properties: +\code{\link{Cherries}()}, \code{\link{ConsensusWithout}()}, \code{\link{LongBranch}()}, \code{\link{MatchEdges}()}, diff --git a/man/NodeNumbers.Rd b/man/NodeNumbers.Rd index a836b4d8b..4e25fe858 100644 --- a/man/NodeNumbers.Rd +++ b/man/NodeNumbers.Rd @@ -22,6 +22,7 @@ Numeric index of each node in a tree } \seealso{ Other tree properties: +\code{\link{Cherries}()}, \code{\link{ConsensusWithout}()}, \code{\link{LongBranch}()}, \code{\link{MatchEdges}()}, diff --git a/man/PathLengths.Rd b/man/PathLengths.Rd index 19da3c665..2f355430e 100644 --- a/man/PathLengths.Rd +++ b/man/PathLengths.Rd @@ -39,6 +39,7 @@ PathLengths(tree) } \seealso{ Other tree properties: +\code{\link{Cherries}()}, \code{\link{ConsensusWithout}()}, \code{\link{LongBranch}()}, \code{\link{MatchEdges}()}, diff --git a/man/SplitsInBinaryTree.Rd b/man/SplitsInBinaryTree.Rd index 26b812bc0..1e753b8c3 100644 --- a/man/SplitsInBinaryTree.Rd +++ b/man/SplitsInBinaryTree.Rd @@ -48,6 +48,7 @@ SplitsInBinaryTree(list(tree, tree)) } \seealso{ Other tree properties: +\code{\link{Cherries}()}, \code{\link{ConsensusWithout}()}, \code{\link{LongBranch}()}, \code{\link{MatchEdges}()}, diff --git a/man/TipLabels.Rd b/man/TipLabels.Rd index 7616a85cf..617891096 100644 --- a/man/TipLabels.Rd +++ b/man/TipLabels.Rd @@ -93,6 +93,7 @@ AllTipLabels(c(BalancedTree(4), PectinateTree(8))) } \seealso{ Other tree properties: +\code{\link{Cherries}()}, \code{\link{ConsensusWithout}()}, \code{\link{LongBranch}()}, \code{\link{MatchEdges}()}, diff --git a/man/TreeIsRooted.Rd b/man/TreeIsRooted.Rd index 921138d11..c81103706 100644 --- a/man/TreeIsRooted.Rd +++ b/man/TreeIsRooted.Rd @@ -23,6 +23,7 @@ TreeIsRooted(UnrootTree(BalancedTree(6))) } \seealso{ Other tree properties: +\code{\link{Cherries}()}, \code{\link{ConsensusWithout}()}, \code{\link{LongBranch}()}, \code{\link{MatchEdges}()}, diff --git a/man/Treeness.Rd b/man/Treeness.Rd index 1463c9a89..3a1072a00 100644 --- a/man/Treeness.Rd +++ b/man/Treeness.Rd @@ -37,6 +37,7 @@ Treeness(c(lowTree, highTree)) } \seealso{ Other tree properties: +\code{\link{Cherries}()}, \code{\link{ConsensusWithout}()}, \code{\link{LongBranch}()}, \code{\link{MatchEdges}()}, diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index 8501d3b91..ea8d209df 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -223,6 +223,19 @@ BEGIN_RCPP return rcpp_result_gen; END_RCPP } +// n_cherries_wrapper +Rcpp::IntegerVector n_cherries_wrapper(const Rcpp::IntegerVector parent, const Rcpp::IntegerVector child, const int nTip); +RcppExport SEXP _TreeTools_n_cherries_wrapper(SEXP parentSEXP, SEXP childSEXP, SEXP nTipSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< const Rcpp::IntegerVector >::type parent(parentSEXP); + Rcpp::traits::input_parameter< const Rcpp::IntegerVector >::type child(childSEXP); + Rcpp::traits::input_parameter< const int >::type nTip(nTipSEXP); + rcpp_result_gen = Rcpp::wrap(n_cherries_wrapper(parent, child, nTip)); + return rcpp_result_gen; +END_RCPP +} // path_lengths NumericMatrix path_lengths(const IntegerMatrix edge, const DoubleVector weight, const LogicalVector init_nas); RcppExport SEXP _TreeTools_path_lengths(SEXP edgeSEXP, SEXP weightSEXP, SEXP init_nasSEXP) { @@ -452,6 +465,7 @@ static const R_CallMethodDef CallEntries[] = { {"_TreeTools_mixed_base_to_parent", (DL_FUNC) &_TreeTools_mixed_base_to_parent, 2}, {"_TreeTools_kept_vertices", (DL_FUNC) &_TreeTools_kept_vertices, 2}, {"_TreeTools_minimum_spanning_tree", (DL_FUNC) &_TreeTools_minimum_spanning_tree, 1}, + {"_TreeTools_n_cherries_wrapper", (DL_FUNC) &_TreeTools_n_cherries_wrapper, 3}, {"_TreeTools_path_lengths", (DL_FUNC) &_TreeTools_path_lengths, 3}, {"_TreeTools_cpp_edge_to_splits", (DL_FUNC) &_TreeTools_cpp_edge_to_splits, 3}, {"_TreeTools_duplicated_splits", (DL_FUNC) &_TreeTools_duplicated_splits, 2}, diff --git a/src/n_cherries.cpp b/src/n_cherries.cpp new file mode 100644 index 000000000..902a50fb2 --- /dev/null +++ b/src/n_cherries.cpp @@ -0,0 +1,29 @@ +#include +#include /* for errors */ +#include /* for errors */ +#include "../inst/include/TreeTools/n_cherries.h" + +// [[Rcpp::export]] +Rcpp::IntegerVector n_cherries_wrapper(const Rcpp::IntegerVector parent, + const Rcpp::IntegerVector child, + const int nTip) { + try { + const size_t n_edge = parent.size(); + if (child.size() != (int)n_edge) { + Rcpp::stop("`parent` and `child` must be the same length"); + } + + // Call your C++ function + int result = TreeTools::n_cherries(parent.begin(), child.begin(), + n_edge, nTip); + + // Return the result as an R integer + return Rcpp::wrap(result); + } catch (const std::exception& e) { + // Catch any standard exception and throw it as an R error + Rcpp::stop(e.what()); + } catch (...) { + // Catch any other exceptions + Rcpp::stop("An unknown error occurred in n_cherries_wrapper."); + } +} \ No newline at end of file diff --git a/tests/testthat/test-Cherries.R b/tests/testthat/test-Cherries.R new file mode 100644 index 000000000..4e6a5415f --- /dev/null +++ b/tests/testthat/test-Cherries.R @@ -0,0 +1,12 @@ +test_that("Cherries works", { + expect_equal(Cherries(BalancedTree(8)), 4L) + expect_equal(Cherries(PectinateTree(8)), 1L) + expect_equal(Cherries(UnrootTree(PectinateTree(8))$edge, 8L), 2L) + expect_error(Cherries(matrix(4, 4, 4)), "edge matrix") + expect_error(Cherries(1:3), "edge matrix") + + expect_error(n_cherries_wrapper(1:2, 1:3, 4), "same length") + + skip_if_not_installed("testthat", "3.1.5") # for expect_no_error + expect_no_error(Cherries(BalancedTree(144))) +})