[med-svn] [r-cran-phylobase] 04/06: New upstream version 0.8.4
Andreas Tille
tille at debian.org
Mon Oct 2 20:43:25 UTC 2017
This is an automated email from the git hooks/post-receive script.
tille pushed a commit to branch master
in repository r-cran-phylobase.
commit 7b6b9ef0c3d268c4195de270df311863821c768a
Author: Andreas Tille <tille at debian.org>
Date: Mon Oct 2 22:34:09 2017 +0200
New upstream version 0.8.4
---
DESCRIPTION | 37 ++
MD5 | 145 +++++
NAMESPACE | 97 ++++
NEWS.md | 298 ++++++++++
R/MRCA-methods.R | 73 +++
R/RcppExports.R | 79 +++
R/addData-methods.R | 98 ++++
R/ancestors.R | 234 ++++++++
R/checkdata.R | 318 +++++++++++
R/edgeLength-methods.R | 310 ++++++++++
R/extractTree.R | 37 ++
R/formatData.R | 213 +++++++
R/getNode-methods.R | 206 +++++++
R/internal-constructors.R | 87 +++
R/labels-methods.R | 298 ++++++++++
R/multiphylo4-class.R | 53 ++
R/nodeId-methods.R | 100 ++++
R/oldclasses-class.R | 13 +
R/pdata.R | 149 +++++
R/phylo4-accessors.R | 177 ++++++
R/phylo4-class.R | 35 ++
R/phylo4-methods.R | 178 ++++++
R/phylo4d-accessors.R | 82 +++
R/phylo4d-class.R | 39 ++
R/phylo4d-methods.R | 414 ++++++++++++++
R/phylobase-package.R | 137 +++++
R/phylobase.options.R | 54 ++
R/phylomats-class.R | 136 +++++
R/print-methods.R | 126 +++++
R/readNCL.R | 435 ++++++++++++++
R/reorder-methods.R | 149 +++++
R/root-methods.R | 64 +++
R/setAs-methods.R | 321 +++++++++++
R/shortestPath-methods.R | 67 +++
R/subset-methods.R | 429 ++++++++++++++
R/summary-methods.R | 251 +++++++++
R/tbind.R | 44 ++
R/tdata-methods.R | 212 +++++++
R/treePlot.R | 784 ++++++++++++++++++++++++++
R/treestruc.R | 87 +++
R/zzz.R | 16 +
build/vignette.rds | Bin 0 -> 233 bytes
data/geospiza.rda | Bin 0 -> 1541 bytes
data/geospiza_raw.rda | Bin 0 -> 1212 bytes
data/owls4.rda | Bin 0 -> 345 bytes
debian/README.source | 22 -
debian/README.test | 9 -
debian/changelog | 15 -
debian/compat | 1 -
debian/control | 29 -
debian/copyright | 33 --
debian/docs | 3 -
debian/rules | 8 -
debian/source/format | 1 -
debian/tests/control | 3 -
debian/tests/run-unit-test | 12 -
debian/watch | 3 -
inst/doc/phylobase.Rnw | 674 ++++++++++++++++++++++
inst/doc/phylobase.pdf | Bin 0 -> 203197 bytes
inst/nexmlfiles/comp_analysis.xml | 135 +++++
inst/nexusfiles/ExContData.Rdata | Bin 0 -> 4596 bytes
inst/nexusfiles/MultiLineTrees.nex | 89 +++
inst/nexusfiles/NastyLabels.nex | 56 ++
inst/nexusfiles/NastyLabels2.nex | 52 ++
inst/nexusfiles/co1.nex | 13 +
inst/nexusfiles/minNex.nex | 56 ++
inst/nexusfiles/minSeq.nex | 12 +
inst/nexusfiles/newick.tre | 1 +
inst/nexusfiles/noStateLabels.nex | 36 ++
inst/nexusfiles/shorebird_underscore.nex | 321 +++++++++++
inst/nexusfiles/testSubsetTaxa.nex | 26 +
inst/nexusfiles/test_min.nex | 20 +
inst/nexusfiles/treeRoundingError.nex | 35 ++
inst/nexusfiles/treeWithContinuousData.nex | 365 ++++++++++++
inst/nexusfiles/treeWithDiscAndContData.nex | 413 ++++++++++++++
inst/nexusfiles/treeWithDiscreteData.nex | 354 ++++++++++++
inst/nexusfiles/treeWithPolyExcludedData.nex | 465 +++++++++++++++
inst/nexusfiles/treeWithSpecialCharacters.nex | 35 ++
inst/nexusfiles/treeWithUnderscoreLabels.nex | 354 ++++++++++++
man/MRCA.Rd | 47 ++
man/addData-methods.Rd | 79 +++
man/ancestors.Rd | 110 ++++
man/checkPhylo4.Rd | 59 ++
man/edgeLength-methods.Rd | 150 +++++
man/edges-accessors.Rd | 73 +++
man/extractTree.Rd | 45 ++
man/formatData.Rd | 88 +++
man/geospiza.Rd | 29 +
man/getNode-methods.Rd | 104 ++++
man/labels-methods.Rd | 165 ++++++
man/multiPhylo-class.Rd | 21 +
man/nTips-methods.Rd | 41 ++
man/nodeId-methods.Rd | 46 ++
man/owls4.Rd | 22 +
man/pdata-class.Rd | 26 +
man/pdata.Rd | 33 ++
man/phylo4-class.Rd | 26 +
man/phylo4-methods.Rd | 119 ++++
man/phylo4d-accessors.Rd | 77 +++
man/phylo4d-class.Rd | 33 ++
man/phylo4d-methods.Rd | 290 ++++++++++
man/phyloXXYY.Rd | 50 ++
man/phylobase-package.Rd | 73 +++
man/phylobase.options.Rd | 39 ++
man/phylobubbles.Rd | 61 ++
man/phylomat-class.Rd | 59 ++
man/plotOneTree.Rd | 66 +++
man/print-methods.Rd | 101 ++++
man/readNexus.Rd | 180 ++++++
man/reorder-methods.Rd | 58 ++
man/root-methods.Rd | 47 ++
man/setAs-methods.Rd | 69 +++
man/shortestPath-methods.Rd | 40 ++
man/subset-methods.Rd | 184 ++++++
man/summary-methods.Rd | 100 ++++
man/tdata-methods.Rd | 114 ++++
man/tip.data.plot.Rd | 48 ++
man/treePlot-methods.Rd | 117 ++++
man/treeStructure-methods.Rd | 59 ++
src/Makevars | 2 +
src/Makevars.win | 6 +
src/RcppExports.cpp | 222 ++++++++
src/ancestors.c | 53 ++
src/checkPhylo4.cpp | 415 ++++++++++++++
src/descendants.c | 53 ++
src/phyloXX.c | 97 ++++
src/phylobase_init.c | 74 +++
src/reorderBinary.c | 66 +++
src/reorderRobust.c | 62 ++
tests/misctests.R | 112 ++++
tests/phylo4dtests.R | 29 +
tests/phylosubtest.R | 16 +
tests/phylotorture.R | 129 +++++
tests/plottest.R | 54 ++
tests/roundtrip.R | 41 ++
tests/test-all.R | 3 +
tests/testprune.R | 20 +
tests/testthat/test.badnex.R | 15 +
tests/testthat/test.checkdata.R | 70 +++
tests/testthat/test.class-phylo4.R | 119 ++++
tests/testthat/test.class-phylo4d.R | 317 +++++++++++
tests/testthat/test.formatData.R | 480 ++++++++++++++++
tests/testthat/test.methods-oldclasses.R | 8 +
tests/testthat/test.methods-phylo4.R | 641 +++++++++++++++++++++
tests/testthat/test.pdata.R | 21 +
tests/testthat/test.phylo4.R | 11 +
tests/testthat/test.phylobase.options.R | 32 ++
tests/testthat/test.prune.R | 18 +
tests/testthat/test.readNCL.R | 585 +++++++++++++++++++
tests/testthat/test.setAs-Methods.R | 183 ++++++
tests/testthat/test.subset.R | 133 +++++
tests/testthat/test.tbind.R | 8 +
tests/testthat/test.treePlot.R | 42 ++
tests/testthat/test.treestruc.R | 30 +
tests/testthat/test.treewalk.R | 275 +++++++++
vignettes/auto/developer.el | 19 +
vignettes/auto/phylobase.el | 21 +
vignettes/phylobase.Rnw | 674 ++++++++++++++++++++++
158 files changed, 18898 insertions(+), 139 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
new file mode 100644
index 0000000..ca08ebd
--- /dev/null
+++ b/DESCRIPTION
@@ -0,0 +1,37 @@
+Package: phylobase
+Type: Package
+Title: Base Package for Phylogenetic Structures and Comparative Data
+Version: 0.8.4
+Imports: ade4, ape (>= 3.0), Rcpp (>= 0.11.0), rncl (>= 0.6.0), grid,
+ methods, stats, RNeXML
+LinkingTo: Rcpp
+Suggests: MASS, testthat (>= 0.8.1), knitr
+Author: R Hackathon et al. (alphabetically: Ben Bolker, Marguerite Butler,
+ Peter Cowan, Damien de Vienne, Dirk Eddelbuettel, Mark Holder, Thibaut
+ Jombart, Steve Kembel, Francois Michonneau, David Orme, Brian O'Meara,
+ Emmanuel Paradis, Jim Regetz, Derrick Zwickl)
+Maintainer: Francois Michonneau <francois.michonneau at gmail.com>
+Description: Provides a base S4 class for comparative methods, incorporating
+ one or more trees and trait data.
+License: GPL (>= 2)
+URL: https://github.com/fmichonneau/phylobase
+BugReports: https://github.com/fmichonneau/phylobase/issues
+LazyData: true
+Collate: 'oldclasses-class.R' 'internal-constructors.R'
+ 'phylo4-methods.R' 'RcppExports.R' 'checkdata.R'
+ 'phylo4-class.R' 'getNode-methods.R' 'formatData.R'
+ 'phylo4d-class.R' 'phylo4d-methods.R' 'MRCA-methods.R'
+ 'addData-methods.R' 'ancestors.R' 'phylo4-accessors.R'
+ 'root-methods.R' 'nodeId-methods.R' 'edgeLength-methods.R'
+ 'setAs-methods.R' 'extractTree.R' 'labels-methods.R'
+ 'multiphylo4-class.R' 'pdata.R' 'phylo4d-accessors.R'
+ 'phylobase-package.R' 'phylobase.options.R' 'phylomats-class.R'
+ 'print-methods.R' 'readNCL.R' 'reorder-methods.R'
+ 'shortestPath-methods.R' 'subset-methods.R' 'summary-methods.R'
+ 'tbind.R' 'tdata-methods.R' 'treePlot.R' 'treestruc.R' 'zzz.R'
+VignetteBuilder: knitr
+RoxygenNote: 6.0.1
+NeedsCompilation: yes
+Packaged: 2017-04-21 21:15:46 UTC; francois
+Repository: CRAN
+Date/Publication: 2017-04-21 23:40:13 UTC
diff --git a/MD5 b/MD5
new file mode 100644
index 0000000..5e4740c
--- /dev/null
+++ b/MD5
@@ -0,0 +1,145 @@
+84c6d95134cc50dcd9ac67baea5a0349 *DESCRIPTION
+ed21a2787f823cbe19ebe293ca7c1e0e *NAMESPACE
+86629d3905a161e0e6020647523e1581 *NEWS.md
+5d7d5aaeacdcbb2b7c94e2a7a12c8283 *R/MRCA-methods.R
+2d357445e1f4da60a9e24e6b0a4a91af *R/RcppExports.R
+ee8ad14745e24da2f0ab9ce624116e73 *R/addData-methods.R
+386c93b93dcad28f8ac1f3a2fb179e07 *R/ancestors.R
+f60e16beb8a5551c2c08e486d963c2a7 *R/checkdata.R
+cf200a46cf69d04f04f6b31c80c75bb1 *R/edgeLength-methods.R
+9edcd964c68d44867b019abe4105f093 *R/extractTree.R
+ad9a4f02a254be9bb954601faa4f58c8 *R/formatData.R
+c91b1a7bbcea7047e0370985bbcf4d44 *R/getNode-methods.R
+182ac8ec6285e37b88a9da9c7e1106fa *R/internal-constructors.R
+7bd80915399baa2675528dfed8b193e1 *R/labels-methods.R
+cb2282bb40632e8f7039991482938d11 *R/multiphylo4-class.R
+97bef8bb049e23553a30e9c00f07d6f5 *R/nodeId-methods.R
+c0e2782404632e4e3420ac9520a7eb67 *R/oldclasses-class.R
+016336404f44444178d488798ae5607c *R/pdata.R
+871f687a6a4c9e2b3ca3c7ce787dcc4a *R/phylo4-accessors.R
+4bebc32d3934dce824c054b0ce549be3 *R/phylo4-class.R
+be1814a94cc3b26b66451f236b67cedc *R/phylo4-methods.R
+3a740fa03aa3940f253b321e006fa157 *R/phylo4d-accessors.R
+d28d5cb63f628bc8cf032d226857ceb1 *R/phylo4d-class.R
+2c8a0217d8812d1e3702aa5cee53ae82 *R/phylo4d-methods.R
+f62ece881dccb58654574da40e536d3f *R/phylobase-package.R
+6cfe1b8f4fa6b546480b9b0917e8884b *R/phylobase.options.R
+0c1561e5ae25e50f5811a863450a878e *R/phylomats-class.R
+97b55e8896ba2f87877ee9ee1a81a54a *R/print-methods.R
+3c625fbec9acfd9826bf6a58c49f3da1 *R/readNCL.R
+c01c34a9709736825a787cd382300038 *R/reorder-methods.R
+af36b2ab79cdce9ab7f1c51b99a9120c *R/root-methods.R
+874083ceb7ff2a63d4e31e2dfa9b3f6f *R/setAs-methods.R
+b12e60d130b8617e92ece7cd5e2faa08 *R/shortestPath-methods.R
+d566204cf9829a745739412ce5887963 *R/subset-methods.R
+ddb1f86ef610780a336bdf7473b1cb69 *R/summary-methods.R
+957d6bb59eea50e691c3411bd7c8a455 *R/tbind.R
+54333801e92f6320240187986cf19887 *R/tdata-methods.R
+5baf1c1d1a6a5a7794363dde93257d4b *R/treePlot.R
+a3451a2d297b035ecf6561a4fdb3ae28 *R/treestruc.R
+38747d50f18ac2b910afecf24ed1d92c *R/zzz.R
+3b650f82480d8fb7eb2c702f8a9f97d1 *build/vignette.rds
+7a03af7f836f7bff48f5b9dc83b28ca8 *data/geospiza.rda
+8a843dd8cd966030b246f06adee0ac13 *data/geospiza_raw.rda
+26e3cdf5f9480147fd9ef4a3f8b75c3b *data/owls4.rda
+a7c04f77c4e9ddd2a430207cbaea7281 *inst/doc/phylobase.Rnw
+2770c634f5eee09c8e585babfe617139 *inst/doc/phylobase.pdf
+7cfba1e69724dd93fe4a07525e419ed4 *inst/nexmlfiles/comp_analysis.xml
+1fff9fa62be103e818e88abf156ffacb *inst/nexusfiles/ExContData.Rdata
+c05860e96ba5feab12b1269f43a43f1b *inst/nexusfiles/MultiLineTrees.nex
+a9a55d0e542ea83751c134892a17440f *inst/nexusfiles/NastyLabels.nex
+72b184a406aa23c2e1711df4f3fd0275 *inst/nexusfiles/NastyLabels2.nex
+f8225a526530eabfaa8ea117e2a82aae *inst/nexusfiles/co1.nex
+f0289cdad66a374a438f582e2ab76a29 *inst/nexusfiles/minNex.nex
+f77c8d44a525dbb3b06c335110ad3547 *inst/nexusfiles/minSeq.nex
+4d5d4d71cf83b54eed9811470482e8d2 *inst/nexusfiles/newick.tre
+51849f725c9b6097be5f2b6453c33844 *inst/nexusfiles/noStateLabels.nex
+9fec41c9d01e57b43dc8e55f1547096b *inst/nexusfiles/shorebird_underscore.nex
+d7eeca6e30d22f9a431822452109e922 *inst/nexusfiles/testSubsetTaxa.nex
+ee3bac96ca12af01b3c7610df8339f34 *inst/nexusfiles/test_min.nex
+8c16a312ee724e2a94aecd5b2c6df0ee *inst/nexusfiles/treeRoundingError.nex
+99b2fe340a17a7e8cac9cfb9bdbafe70 *inst/nexusfiles/treeWithContinuousData.nex
+9d27abaf6517ea4ca9881bd9f8c0032a *inst/nexusfiles/treeWithDiscAndContData.nex
+963e6a5568b7fae9291232b8abfd496c *inst/nexusfiles/treeWithDiscreteData.nex
+6deabaca8bbfe8c34e60d06349f31398 *inst/nexusfiles/treeWithPolyExcludedData.nex
+b6390d9653d37f920612cbe3a8d38fe5 *inst/nexusfiles/treeWithSpecialCharacters.nex
+4961bb5af89e1cfd63944af5d8ee8408 *inst/nexusfiles/treeWithUnderscoreLabels.nex
+4fe0019675f205b3f5f2f535870769a8 *man/MRCA.Rd
+fde215307b04dc664d3b6cc0abec351c *man/addData-methods.Rd
+a1480ee4f6973a6d1ca820e5150bda6c *man/ancestors.Rd
+9fca101e88ff5addffa7a211bc8d0e39 *man/checkPhylo4.Rd
+a1de42c72a5c8857aceaedd2aaec99f4 *man/edgeLength-methods.Rd
+76750a52c8492b23eb5509f4f8fa729a *man/edges-accessors.Rd
+c5ff6259f85ca20555d80f07116c0e4e *man/extractTree.Rd
+3f1988b025935317033b46fb0db0bc48 *man/formatData.Rd
+3964c17050f1ae365332e0a176156cc4 *man/geospiza.Rd
+cb4dbc8feab494fe53f74e94162def14 *man/getNode-methods.Rd
+8006f53114ff0b652716075f1322ddf9 *man/labels-methods.Rd
+011b1c840e1f061613ecf356b2f97582 *man/multiPhylo-class.Rd
+b976ab5ef7d5d9d0a348ef16019820c3 *man/nTips-methods.Rd
+5f5619026f03eb92dc7c5a76410ce13a *man/nodeId-methods.Rd
+a613eca88be01b8b404487661f041c8e *man/owls4.Rd
+d07a2bf017b1d937cdbec916190127b1 *man/pdata-class.Rd
+d88a1ee35365662fbeb5dbe4efe6bde3 *man/pdata.Rd
+375b27916734c02363a64ee7c8dba307 *man/phylo4-class.Rd
+691582be9ad3f0ef329b7c5abad71c0c *man/phylo4-methods.Rd
+27cc410eb347b2f7b56d4c144004a383 *man/phylo4d-accessors.Rd
+73b3b7b79cd7bc62c7e9d60a49642256 *man/phylo4d-class.Rd
+02e448fb3fbfab2f134fed86c712f0d9 *man/phylo4d-methods.Rd
+ccb481d77f91417f5a2ff91a53a0670a *man/phyloXXYY.Rd
+439961decd10191d8961540d9c4fb776 *man/phylobase-package.Rd
+32b2159b920d7397b804da4944625b3c *man/phylobase.options.Rd
+5b6744d99b4eafe8a388223af23ce26f *man/phylobubbles.Rd
+6633d9159a49e59ce3f11e0afdc36ac9 *man/phylomat-class.Rd
+4d54de3c810bb062762e6965108c3be2 *man/plotOneTree.Rd
+fb84e8cd95ad2561af081a69dc4794ce *man/print-methods.Rd
+d5418549836069cc4856be319ebf28b1 *man/readNexus.Rd
+b8bac1e95bc7e7ee47077875704aa7be *man/reorder-methods.Rd
+7bd532f87a0e55f7ef75b7f0957a486a *man/root-methods.Rd
+fd538bced5e59b960e704577c3cc24be *man/setAs-methods.Rd
+366c27b381f7c07f2a1498f18fee04eb *man/shortestPath-methods.Rd
+31e45659a09b32a9226e1d2c00a6b93b *man/subset-methods.Rd
+d94fdf7044af2b4852dfd0dd84af84c0 *man/summary-methods.Rd
+63edd06f255dd3cf3814f86267ed5e79 *man/tdata-methods.Rd
+e341698ddd150afd461b7fac0e6b1cfd *man/tip.data.plot.Rd
+c68c822072473542cf615360d46a9f24 *man/treePlot-methods.Rd
+15201a7ee192e8a55b9cca1bd9093e7c *man/treeStructure-methods.Rd
+ed0d19722e28a7d316256f2c247be33e *src/Makevars
+1e0cc7f2ea27756865f63d6758ca90a8 *src/Makevars.win
+a81e1490b4e64835c20a52bfd48c8171 *src/RcppExports.cpp
+2ba5b488a78a904712cdefc6f87307f9 *src/ancestors.c
+c78cc56ae6c035ed9a0a584424eac960 *src/checkPhylo4.cpp
+4b08d7daaf385bd79465aa3e0785967e *src/descendants.c
+1b1d0ecd28d6eb26a29fc576091cc5c3 *src/phyloXX.c
+eaca9d3295c37dd10cfe242678bac37b *src/phylobase_init.c
+dc5efccf4d370c4c7b0801bcbfd74a9b *src/reorderBinary.c
+1944dc3ac77930043bb7ccb02f3718cd *src/reorderRobust.c
+cb2ef3c2e0613221c053e3236b36debd *tests/misctests.R
+9f8cda1294f43f665a0a96aa7b7f7977 *tests/phylo4dtests.R
+fd985e3b18ff2d41e3c213f8b9418f27 *tests/phylosubtest.R
+db2a0aaf0280429619fb99b2855c835e *tests/phylotorture.R
+647bb8fbf0e8266427210598fc3fd21a *tests/plottest.R
+c08c45b2d046fc6386a34c9fe78aea51 *tests/roundtrip.R
+0a268e814b425b9356091afae16a22dc *tests/test-all.R
+38c287fa7b4426eab00c31412ff770be *tests/testprune.R
+c0345feb32ec3fb041e48f6a35c2d653 *tests/testthat/test.badnex.R
+bf3987b5a02228ef385fcb1550254ffa *tests/testthat/test.checkdata.R
+dabcabf70354afc578c5633231a4fb71 *tests/testthat/test.class-phylo4.R
+871e4ed23cfc659f3df4a0648eaca39c *tests/testthat/test.class-phylo4d.R
+7bfa9a811172037df31773779b89cdef *tests/testthat/test.formatData.R
+1275c5c4b612317ed4e6c9f1a7e8eb15 *tests/testthat/test.methods-oldclasses.R
+fb3c95bcfb9297e8a1ec897e3db1ffce *tests/testthat/test.methods-phylo4.R
+9dd09d9e64303c752ed57a7331543854 *tests/testthat/test.pdata.R
+e4d54b4db45a69a5e40811975cc44274 *tests/testthat/test.phylo4.R
+d38fa9feddccd722b1c56a4864dbfc9e *tests/testthat/test.phylobase.options.R
+e1d0fada9b7ed61564f9fb1570d02f4f *tests/testthat/test.prune.R
+d04b3ce36e78bf0b03ea97355b6bb3cc *tests/testthat/test.readNCL.R
+ea0cce4681edbf1067b681bd89327c50 *tests/testthat/test.setAs-Methods.R
+37b1df7381866235003e027eff81e2c7 *tests/testthat/test.subset.R
+7ce9e14f01d0b524e56ec238d90275e0 *tests/testthat/test.tbind.R
+3286fe80846d087c46a36fcf380e42a7 *tests/testthat/test.treePlot.R
+7020fbe04de6da74f575a83039235325 *tests/testthat/test.treestruc.R
+521ece6dcb763bcbfd39c327fff884e2 *tests/testthat/test.treewalk.R
+f3f850c2fd5df4c58e5802d2e8ad01b5 *vignettes/auto/developer.el
+58df4009f4e2c780dc5bcc1324f31bf4 *vignettes/auto/phylobase.el
+a7c04f77c4e9ddd2a430207cbaea7281 *vignettes/phylobase.Rnw
diff --git a/NAMESPACE b/NAMESPACE
new file mode 100644
index 0000000..edfd73a
--- /dev/null
+++ b/NAMESPACE
@@ -0,0 +1,97 @@
+# Generated by roxygen2: do not edit by hand
+
+export("[")
+export("edgeLabels<-")
+export("edgeLength<-")
+export("labels<-")
+export("nodeData<-")
+export("nodeLabels<-")
+export("rootNode<-")
+export("tdata<-")
+export("tipData<-")
+export("tipLabels<-")
+export(MRCA)
+export(addData)
+export(ancestor)
+export(ancestors)
+export(checkPhylo4)
+export(children)
+export(depthTips)
+export(descendants)
+export(edgeId)
+export(edgeLabels)
+export(edgeLength)
+export(edgeOrder)
+export(edges)
+export(extractTree)
+export(getEdge)
+export(getNode)
+export(hasDuplicatedLabels)
+export(hasEdgeLabels)
+export(hasEdgeLength)
+export(hasNodeData)
+export(hasNodeLabels)
+export(hasPoly)
+export(hasRetic)
+export(hasSingle)
+export(hasTipData)
+export(internalEdges)
+export(isRooted)
+export(isUltrametric)
+export(nData)
+export(nEdges)
+export(nNodes)
+export(nTips)
+export(names)
+export(nodeData)
+export(nodeDepth)
+export(nodeHeight)
+export(nodeId)
+export(nodeLabels)
+export(nodeType)
+export(phylo4)
+export(phylo4d)
+export(phyloXXYY)
+export(phylobase.options)
+export(phylobubbles)
+export(plotOneTree)
+export(prune)
+export(readNCL)
+export(readNewick)
+export(readNexus)
+export(rootNode)
+export(shortestPath)
+export(siblings)
+export(sumEdgeLength)
+export(tdata)
+export(terminalEdges)
+export(tip.data.plot)
+export(tipData)
+export(tipLabels)
+export(treePlot)
+exportClasses(phylo4)
+exportClasses(phylo4d)
+exportClasses(phylo4vcov)
+exportMethods("[")
+exportMethods(head)
+exportMethods(labels)
+exportMethods(names)
+exportMethods(plot)
+exportMethods(print)
+exportMethods(reorder)
+exportMethods(show)
+exportMethods(subset)
+exportMethods(summary)
+exportMethods(tail)
+import(RNeXML)
+import(ape)
+import(grid)
+import(methods)
+import(stats)
+importFrom(Rcpp,evalCpp)
+importFrom(ade4,newick2phylog)
+importFrom(graphics,plot)
+importFrom(rncl,rncl)
+importFrom(utils,head)
+importFrom(utils,tail)
+useDynLib(phylobase, .registration = TRUE)
diff --git a/NEWS.md b/NEWS.md
new file mode 100644
index 0000000..46cadf7
--- /dev/null
+++ b/NEWS.md
@@ -0,0 +1,298 @@
+## CHANGES in phylobase VERSION 0.8.4
+
+* CRAN maintenance release
+
+## CHANGES in phylobase VERSION 0.8.2
+
+* Fix typo in examples of phylo4d methods.
+
+## CHANGES IN phylobase VERSION 0.8.0
+
+### New features
+
+* Initial basic support for converting RNeXML objects in phylo4 and phylo4d
+format.
+
+* New methods: `internalEdges()`, `terminalEdges()`
+
+* `descendants()` has now a `"ALL"` argument to include self in results
+
+* New method: `nodeHeight()` provides a consistent and comprehensive way of
+ calculating the distance between a node and either the root or the tips. (fix
+ #3)
+
+* The replacement methods for `labels`, `tipLabels`, `nodeLabels`, `edgeLabels`
+ now accept `NA` or `NULL` to remove labels (fix #2)
+
+### Major changes
+
+* `readNexus` and `readNewick` now internally use the package `rncl` to parse
+ files. They also use a different approach to reconstruct the edge
+ matrix. These changes make file parsing faster. Objects created with this new
+ approach may not exactly be identical to those created in previous versions as
+ node numbering might differ, they should however be fully compatible with each
+ others.
+
+* `readNexus` and `readNewick` can now parse tree files with trees containing a
+ subset of the taxa listed in the TAXA Block.
+
+* Source code for the package is hosted on GitHub at https://github.com/fmichonneau/phylobase
+
+### Minor changes
+
+* All tests done with testthat
+
+* `rootNode` returns the rootNode using the same format as `getNode()`.
+
+* All documentation is in Roxygen format
+
+* `hasPoly`, `hasRetic`, `hasSingle` are now methods instead of functions.
+
+### Deprecated functions
+
+* `nodeDepth` and `depthTips` are now deprecated and are replaced by `nodeHeight`
+
+### Bug fixes
+
+* Fix bug: `NA` in labels were considered duplicated by `checkPhylo4()`.
+
+* Fix bug #605 (R-forge) -- treePlot subsets numeric data for plotting.
+
+* Fix bug #4: `descendants()` behave like `ancestors()` when provided with a
+ vector of nodes and is consistent across all arguments.
+
+
+## CHANGES IN phylobase VERSION 0.6.8
+
+* Not many user-visible changes, most are related to improving speeds
+during test of object validation (most tests done in C++) and to getNode
+that is used by many functions.
+
+* Changes to package structure to make it compatible with devtools
+(switching testing to testthat -- partial at this stage) and docs to
+roxygen format (partial at this stage).
+
+* Changes to package structure to comply with new Rcpp standards
+
+## CHANGES IN phylobase VERSION 0.6.5
+
+* Updates from cout/cerr to Rcpp::Rcout/Rcerr
+
+* Comments in Nexus tree strings are being removed before being processed by
+readNCL
+
+## CHANGES IN phylobase VERSION 0.6.3
+
+* Fixed bugs in getNode in cases where labels included regexpr
+metacharacters and when a tip was labelled 0
+
+* New methods: depthTips, nodeDepth and isUltrametric
+
+
+## CHANGES IN phylobase VERSION 0.6.2
+
+* Improve handling of errors returned by NCL (NxsException)
+
+* Fix bug in case state labels are missing from the NEXUS file
+
+* Upgrade to NCL 2.1.14
+
+## CHANGES IN phylobase VERSION 0.6.1
+
+* Fix bugs that prevented building on Windows 64-bit systems
+
+
+## CHANGES IN phylobase VERSION 0.6
+
+### MAJOR CHANGES
+
+* Updated to the Nexus Class Library (NCL) 2.1.12.
+
+* Changed the way NCL is built during the installation process.
+
+* Complete rewrite of the function readNexus which brings many new
+functionalities.
+
+* Nodes labels do not have to be unique.
+
+
+### NEW FEATURES
+
+* In readNexus, the option return.labels gives the state labels of the
+characters.
+
+* It is now possible to import several types of data blocks in a single
+NEXUS file with readNexus.
+
+* The function phylobase.options() provides global options to control the
+behavior of the phylo4/phylo4d validator.
+
+* The new method hasDuplicatedLabels() indicates whether any node labels
+are duplicated.
+
+* The new method nData() returns the number of datasets associated with
+a tree.
+
+* The column that contains the labels can now be specified by its name in
+the function formatData()
+
+### MINOR CHANGES
+
+* The function getNode() has been modified to allow node matching in the
+case of non-unique labels.
+
+* Many new unit tests.
+
+### BUG FIXES
+
+* Far too many to document. See the SVN log for details.
+
+### KNOWN ISSUES
+
+* Unrooted trees are not supported by all functions, e.g. plot() and
+reorder().
+
+* Factors are not supported by the default plotting method.
+
+
+## CHANGES IN phylobase VERSION 0.5
+
+### MAJOR CHANGES
+
+* A var-cov matrix tree class, phylo4vcov, and methods for converting to
+and from other classes now exists.
+
+* Replaced separate the tip.label and node.label slots with a unified
+label slot in the phylo4 class definition.
+
+* Replaced separate the tip.data and node.data into a single data slot in
+the phylo4d class definition.
+
+* The phylo4 class grew a annotate slot.
+
+* The phylo4d class grew a metadata slot.
+
+* Added an order slot to the phylo4 class definition and updated as()
+methods to assign the proper order (if possible) when converting
+between ape and phylobase tree formats.
+
+* The Nnode slot was removed from the phylo4 class definition.
+
+* An explicit root edge has been added to the edge matrix with 0 as the
+ancestor and nTips(phy) + 1 as the rood node.
+
+* The edgeLabels() and edgeLength() accessors now return vectors with
+named elements in the same order as rows of the edge matrix, even when
+some/all values are missing.
+
+* The labels() accessor and nodeID() methods now always return labels in
+ascending order of node ID
+
+* Many function and argument names and defaults have been changed to make
+them more consistent most functions follow the getNode() pattern.
+
+* The plotting functions have been replaced (see below).
+
+* Now, data are matched against node numbers instead of node labels.
+
+* Tip and internal node labels have now internal names that are character
+strings of the node number they correspond to. Thus it is possible to
+store labels in any order and assignment of labels more robust.
+
+* We now use the RUnit package (not required for normal use) for adding
+unit tests. Adding unit tests to inst/unitTests/ is now preferred over
+the tests/ directory.
+
+* Numerous changes to pruning and tree subsetting code. It is
+considerably more robust and no longer relies on calls to APE.
+
+### NEW FEATURES
+
+* Added a function nodeType() for identifying whether a node is root,
+tip or internal.
+
+* Changed nodeNumbers to nodeId() and extended it abilities.
+
+* Added method reorder() for converting edge matrices into preorder or
+postorder.
+
+* Added the edgeOrder accessor to get the order of a phylobase object.
+
+* Added a package help file accessible from ?phylobase.
+
+* Added labels()<- for assigning labels.
+
+* Added edgeLength()<- for assigning edgeLengths.
+
+* Added a phylo4() method for importing APE phylo objects.
+
+* Added a hasTipData() method.
+
+* Added a edgeId() method.
+
+* Created the addData() method for adding data to phylo4 objects.
+
+* Added tipData and nodeData getter/setter methods
+
+* If all node.labels are numerical values, they are automatically
+converted as data. Useful when importing consensus tree from MrBayes.
+
+* It is now possible to print tree objects in edge order using the
+edgeOrder argument in printphylo4().
+
+* reorder(), descendants(), ancestors(), and portions of the plotting code
+have been recoded in C to improve performance.
+
+* Added a developer vignette to document and guide development of the
+phylobase package.
+
+* The previous plotting functions, based on base graphics, have been
+replaced with function based on the grid graphics device.
+
+* A S4 generic plot() function, calling treePlot() has been added it
+dispatches a plotting function based on object class and arguments.
+
+* Plots using grid based code can be inserted at the tree tips using the
+tip.plot.fun argument in plot()
+
+* The getNode() method has been enhanced to allow matching against
+specific node types, and if the requested node is missing, all nodes of
+specified type are returned.
+
+* Changed getEdge() to allow no node argument, which returns all edges
+appropriate for the given type.
+
+### CHANGES
+
+* Node labels are, if not supplied, a vector of NA.
+
+* printphylo() is now deprecated, print() and summary() now alsow work on
+empty objects.
+
+* phylo4() is now and S4 generic with signature "matrix".
+
+* phylobase now uses a NAMESPACE file.
+
+* Legacy plotting code (0.4) can be found in the SVN repo tags directory.
+
+* The tdata default "type" argument changed to 'all'.
+
+* Row names now stored internally as numeric, not character.
+
+### BUG FIXES
+
+* Far too many to document. See the SVN log for details.
+
+### KNOWN ISSUES
+
+* Unrooted trees are not supported by all functions, e.g. plot() and
+reorder().
+
+* Factors are not supported by the default plotting method.
+
+* The Nexus Class Library is build for the system default ARCH which may
+or may not be the architecture that R and the rest of the package is
+built with. If this occurs the package will fail to load.
+
+* Unique labels are required for internal nodes, this behavior will be
+changed in the future.
diff --git a/R/MRCA-methods.R b/R/MRCA-methods.R
new file mode 100644
index 0000000..2ff43d7
--- /dev/null
+++ b/R/MRCA-methods.R
@@ -0,0 +1,73 @@
+
+##' Most Recent Common Ancestor (MRCA) of 2 or more nodes.
+##'
+##' Given some nodes (i.e., tips and/or internal), this function
+##' returns the node corresponding to the most recent common ancestor.
+##'
+##' If \code{phy} is a \code{phylo4} or \code{phylo4d} object, the
+##' nodes can contain both numeric or character values that will be
+##' used by \code{getNode} to retrieve the correct node. However, if
+##' \code{phy} is a \code{phylo} object, the nodes must be a numeric
+##' vector.
+##'
+##' With \code{phylo4} and \code{phylo4d} objects, if a single node is
+##' provided, it will be returned.
+##'
+##' @title MRCA
+##' @param phy a phylogenetic tree in phylo4, phylo4d or phylo format.
+##' @param ... a vector of nodes
+##' @return the node corresponding to the most recent common ancestor
+##' @export
+##' @include phylo4d-methods.R getNode-methods.R
+##' @include oldclasses-class.R
+##' @rdname MRCA
+##' @examples
+##' data(geospiza)
+##' MRCA(geospiza, 1, 5)
+##' MRCA(geospiza, "fortis", 11)
+##' MRCA(geospiza, 2, 4, "fusca", 3)
+##' geo <- as(geospiza, "phylo")
+##' MRCA(geo, c(1,5))
+setGeneric("MRCA", function(phy, ...) {
+ standardGeneric("MRCA")
+})
+
+##' @rdname MRCA
+##' @aliases MRCA,phylo4-method
+setMethod("MRCA", signature(phy = "phylo4"), function(phy, ...) {
+ nodes <- list(...)
+ ## if length==1 and first element is a vector,
+ ## use it as the list
+ if (length(nodes)==1 && length(nodes[[1]])>1) {
+ nodes <- as.list(nodes[[1]])
+ }
+
+ lNodes <- sapply(nodes, function(nd) {
+ getNode(x=phy, node=nd, missing="fail")
+ })
+
+ ## Correct behavior when the root is part of the nodes
+ uniqueNodes <- unique(lNodes)
+ root <- nodeId(phy, "root")
+ if(root %in% uniqueNodes) {
+ res <- getNode(phy, root)
+ return(res)
+ }
+
+ ## Correct behavior in case of MRCA of identical taxa
+ if(length(uniqueNodes) == 1) {
+ res <- uniqueNodes[[1]]
+ return(res)
+ }
+ else {
+ ancests <- lapply(nodes, ancestors, phy=phy, type="ALL")
+ res <- getNode(phy, max(Reduce(intersect, ancests)))
+ return(res)
+ }
+})
+
+##' @rdname MRCA
+##' @aliases MRCA,phylo-method
+setMethod("MRCA", signature(phy = "phylo"), function(phy, ...) {
+ ape::getMRCA(phy, ...)
+})
diff --git a/R/RcppExports.R b/R/RcppExports.R
new file mode 100644
index 0000000..8f3a2c5
--- /dev/null
+++ b/R/RcppExports.R
@@ -0,0 +1,79 @@
+# Generated by using Rcpp::compileAttributes() -> do not edit by hand
+# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
+
+isLabelName <- function(lblToCheck, lbl) {
+ .Call('phylobase_isLabelName', PACKAGE = 'phylobase', lblToCheck, lbl)
+}
+
+nRoots <- function(ances) {
+ .Call('phylobase_nRoots', PACKAGE = 'phylobase', ances)
+}
+
+tabulateTips <- function(ances) {
+ .Call('phylobase_tabulateTips', PACKAGE = 'phylobase', ances)
+}
+
+nTipsSafe <- function(ances) {
+ .Call('phylobase_nTipsSafe', PACKAGE = 'phylobase', ances)
+}
+
+nTipsFastCpp <- function(ances) {
+ .Call('phylobase_nTipsFastCpp', PACKAGE = 'phylobase', ances)
+}
+
+hasSingleton <- function(ances) {
+ .Call('phylobase_hasSingleton', PACKAGE = 'phylobase', ances)
+}
+
+hasPolytomy <- function(ances) {
+ .Call('phylobase_hasPolytomy', PACKAGE = 'phylobase', ances)
+}
+
+tipsSafe <- function(ances, desc) {
+ .Call('phylobase_tipsSafe', PACKAGE = 'phylobase', ances, desc)
+}
+
+tipsFast <- function(ances) {
+ .Call('phylobase_tipsFast', PACKAGE = 'phylobase', ances)
+}
+
+getAllNodesSafe <- function(edge) {
+ .Call('phylobase_getAllNodesSafe', PACKAGE = 'phylobase', edge)
+}
+
+getAllNodesFast <- function(edge) {
+ .Call('phylobase_getAllNodesFast', PACKAGE = 'phylobase', edge)
+}
+
+testEqInt <- function(x, y) {
+ .Call('phylobase_testEqInt', PACKAGE = 'phylobase', x, y)
+}
+
+all_naC <- function(x) {
+ .Call('phylobase_all_naC', PACKAGE = 'phylobase', x)
+}
+
+any_naC <- function(x) {
+ .Call('phylobase_any_naC', PACKAGE = 'phylobase', x)
+}
+
+nb_naC <- function(x) {
+ .Call('phylobase_nb_naC', PACKAGE = 'phylobase', x)
+}
+
+getRange <- function(x, na_rm) {
+ .Call('phylobase_getRange', PACKAGE = 'phylobase', x, na_rm)
+}
+
+hasDuplicatedLabelsCpp <- function(label) {
+ .Call('phylobase_hasDuplicatedLabelsCpp', PACKAGE = 'phylobase', label)
+}
+
+edgeIdCpp <- function(edge, type) {
+ .Call('phylobase_edgeIdCpp', PACKAGE = 'phylobase', edge, type)
+}
+
+checkTreeCpp <- function(obj, opts) {
+ .Call('phylobase_checkTreeCpp', PACKAGE = 'phylobase', obj, opts)
+}
+
diff --git a/R/addData-methods.R b/R/addData-methods.R
new file mode 100644
index 0000000..a6be0fd
--- /dev/null
+++ b/R/addData-methods.R
@@ -0,0 +1,98 @@
+
+##' Adding data to a phylo4 or a phylo4d object
+##'
+##' \code{addData} adds data to a \code{phylo4} (converting it in a
+##' \code{phylo4d} object) or to a \code{phylo4d} object
+##'
+##' Rules for matching data to tree nodes are identical to those used
+##' by the \code{\link{phylo4d-methods}} constructor.
+##'
+##' If any column names in the original data are the same as columns
+##' in the new data, ".old" is appended to the former column names and
+##' ".new" is appended to the new column names.
+##'
+##' The option \code{pos} is ignored (silently) if \code{x} is a
+##' \code{phylo4} object. It is provided for compatibility reasons.
+##'
+##' @param x a phylo4 or a phylo4d object
+##' @param tip.data a data frame (or object to be coerced to one)
+##' containing only tip data
+##' @param node.data a data frame (or object to be coerced to one)
+##' containing only node data
+##' @param all.data a data frame (or object to be coerced to one)
+##' containing both tip and node data
+##' @param merge.data if both \code{tip.data} and \code{node.data} are
+##' provided, it determines whether columns with common names will be
+##' merged together (default TRUE). If FALSE, columns with common
+##' names will be preserved separately, with ".tip" and ".node"
+##' appended to the names. This argument has no effect if
+##' \code{tip.data} and \code{node.data} have no column names in
+##' common.
+##' @param pos should the new data provided be bound \code{before} or
+##' \code{after} the pre-existing data?
+##' @param \dots additional arguments to control how matching between
+##' data and tree (see Details section of
+##' \code{\link{phylo4d-methods}} for more details).
+##' @return \code{addData} returns a \code{phylo4d} object.
+##' @author Francois Michonneau
+##' @seealso \code{\link{tdata}} for extracting or updating data and
+##' \code{\link{phylo4d-methods}} constructor.
+##' @keywords methods
+##' @rdname addData-methods
+##' @include phylo4d-class.R
+##' @export
+##' @examples
+##' data(geospiza)
+##' nDt <- data.frame(a=rnorm(nNodes(geospiza)), b=1:nNodes(geospiza),
+##' row.names=nodeId(geospiza, "internal"))
+##' t1 <- addData(geospiza, node.data=nDt)
+setGeneric("addData", function(x, ...) {
+ standardGeneric("addData")
+})
+
+##' @rdname addData-methods
+##' @aliases addData-methods addData,phylo4-method
+setMethod("addData", signature(x="phylo4d"),
+ function(x, tip.data=NULL, node.data=NULL, all.data=NULL,
+ merge.data=TRUE, pos=c("after", "before"), ...) {
+
+ pos <- match.arg(pos)
+
+ ## apply formatData to ensure data have node number rownames and
+ ## correct dimensions
+ tip.data <- formatData(phy=x, dt=tip.data, type="tip", ...)
+ node.data <- formatData(phy=x, dt=node.data, type="internal", ...)
+ all.data <- formatData(phy=x, dt=all.data, type="all", ...)
+ ## combine data as needed
+ new.data <- .phylo4Data(x=x, tip.data=tip.data, node.data=node.data,
+ all.data=all.data, merge.data=merge.data)
+
+ if (all(dim(new.data) == 0)) {
+ return(x)
+ }
+ if (all(dim(x at data) == 0)) {
+ x at data <- new.data
+ return(x)
+ }
+
+ if (identical(pos, "after")) {
+ new.data <- merge(x at data, new.data, by=0, all=TRUE,
+ sort=FALSE, suffixes=c(".old", ".new"))
+ } else {
+ new.data <- merge(new.data, x at data, by=0, all=TRUE,
+ sort=FALSE, suffixes=c(".new", ".old"))
+ }
+ row.names(new.data) <- new.data[["Row.names"]]
+ x at data <- new.data[, -match("Row.names", names(new.data)), drop = FALSE]
+
+ x
+})
+
+##' @rdname addData-methods
+##' @aliases addData,phylo4d-method
+setMethod("addData", signature(x="phylo4"),
+ function(x, tip.data=NULL, node.data=NULL, all.data=NULL,
+ merge.data=TRUE, pos=c("after", "before"), ...) {
+ phylo4d(x, tip.data=tip.data, node.data=node.data, all.data=all.data,
+ merge.data=merge.data, ...)
+})
diff --git a/R/ancestors.R b/R/ancestors.R
new file mode 100644
index 0000000..43d1abd
--- /dev/null
+++ b/R/ancestors.R
@@ -0,0 +1,234 @@
+
+##' Tree traversal and utility functions
+##'
+##' Functions for describing relationships among phylogenetic nodes (i.e.
+##' internal nodes or tips).
+##'
+##' \code{ancestors} and \code{descendants} can take \code{node} vectors of
+##' arbitrary length, returning a list of output vectors if the number of valid
+##' input nodes is greater than one. List element names are taken directly from
+##' the input node vector.
+##'
+##' If any supplied nodes are not found in the tree, the behavior currently
+##' varies across functions.
+##' \itemize{
+##' \item Invalid nodes are automatically omitted by \code{ancestors}
+##' and \code{descendants}, with a warning.
+##'
+##' \item \code{ancestor}
+##' will return \code{NA} for any invalid nodes, with a warning.
+##'
+##' \item Both \code{children} and \code{siblings} will return an empty
+##' vector, again with a warning.
+##' }
+##' @param phy a \linkS4class{phylo4} object (or one inheriting from
+##' \linkS4class{phylo4}, e.g. a \linkS4class{phylo4d} object)
+##' @param node either an integer corresponding to a node ID number, or a
+##' character corresponding to a node label; for \code{ancestors} and
+##' \code{descendants}, this may be a vector of multiple node numbers or names
+##' @param type (\code{ancestors}) specify whether to return just direct
+##' ancestor ("parent"), all ancestor nodes ("all"), or all ancestor nodes
+##' including self ("ALL"); (\code{descendants}) specify whether to return just
+##' direct descendants ("children"), all extant descendants ("tips"), or all
+##' descendant nodes ("all") or all descendant nodes including self ("ALL").
+##' @param include.self whether to include self in list of siblings
+##' @param \dots a list of node numbers or names, or a vector of node numbers or
+##' names
+##' @return \describe{
+##' \item{\code{ancestors}}{ return a named vector (or a list
+##' of such vectors in the case of multiple input nodes) of the
+##' ancestors and descendants of a node}
+##'
+##' \item{\code{descendants}}{ return a named vector (or a list of
+##' such vectors in the case of multiple input nodes) of the ancestors
+##' and descendants of a node}
+##'
+##' \item{\code{ancestor}}{ \code{ancestor} is analogous to
+##' \code{ancestors(\dots{}, type="parent")} (i.e. direct ancestor
+##' only), but returns a single concatenated vector in the case of
+##' multiple input nodes}
+##'
+##' \item{\code{children}}{is analogous to \code{descendants(\dots{},
+##' type="children")} (i.e. direct descendants only), but is not
+##' currently intended to be used with multiple input nodes }
+##'
+##' \item{\code{siblings}}{ returns sibling nodes (children of the same
+##' parent)}
+##' }
+##' @seealso \code{\link[ape]{mrca}}, in the ape package, gives a list of all
+##' subtrees
+##' @export
+##' @rdname ancestors
+##' @include phylo4-class.R
+##' @include phylo4-methods.R
+##' @include getNode-methods.R
+##' @examples
+##'
+##' data(geospiza)
+##' nodeLabels(geospiza) <- LETTERS[1:nNodes(geospiza)]
+##' plot(as(geospiza, "phylo4"), show.node.label=TRUE)
+##' ancestor(geospiza, "E")
+##' children(geospiza, "C")
+##' descendants(geospiza, "D", type="tips")
+##' descendants(geospiza, "D", type="all")
+##' ancestors(geospiza, "D")
+##' MRCA(geospiza, "conirostris", "difficilis", "fuliginosa")
+##' MRCA(geospiza, "olivacea", "conirostris")
+##'
+##' ## shortest path between 2 nodes
+##' shortestPath(geospiza, "fortis", "fuliginosa")
+##' shortestPath(geospiza, "F", "L")
+##'
+##' ## branch length from a tip to the root
+##' sumEdgeLength(geospiza, ancestors(geospiza, "fortis", type="ALL"))
+ancestor <- function(phy,node) {
+ node2 <- getNode(phy,node)
+ ## r <- which(edges(phy)[,2]==node)
+ r <- match(node2,edges(phy)[,2])
+ return(getNode(phy,edges(phy)[r,1],missing="OK"))
+}
+
+
+##' @rdname ancestors
+##' @aliases children
+##' @export
+children <- function(phy,node) {
+ node2 <- getNode(phy,node)
+ r <- which(edges(phy)[,1]==node2)
+ getNode(phy,edges(phy)[r,2])
+}
+
+##' @rdname ancestors
+##' @aliases descendants
+##' @export
+descendants <- function (phy, node, type=c("tips","children","all", "ALL")) {
+ type <- match.arg(type)
+
+ ## look up nodes, warning about and excluding invalid nodes
+ oNode <- node
+ node <- getNode(phy, node, missing="warn")
+ isValid <- !is.na(node)
+ node <- as.integer(node[isValid])
+
+ if (type == "children") {
+ res <- lapply(node, function(x) children(phy, x))
+ names(res) <- node
+ } else {
+ ## edge matrix must be in preorder for the C function!
+ if (phy at order=="preorder") {
+ edge <- phy at edge
+ } else {
+ edge <- reorder(phy, order="preorder")@edge
+ }
+ ## extract edge columns
+ ancestor <- as.integer(edge[, 1])
+ descendant <- as.integer(edge[, 2])
+
+ ## return indicator matrix of ALL descendants (including self)
+ isDes <- .Call("descendants_c", node, ancestor, descendant)
+ storage.mode(isDes) <- "logical"
+
+ if (type == "all") {
+ i <- match(intersect(node, nodeId(phy, "internal")), descendant)
+ isDes[i, seq_along(node)] <- FALSE
+ }
+
+ ## if only tips desired, drop internal nodes
+ if (type=="tips") {
+ isDes[descendant %in% nodeId(phy, "internal"),] <- FALSE
+ }
+ res <- lapply(seq_along(node), function(n) {
+ getNode(phy, descendant[isDes[,n]])
+ })
+ names(res) <- node
+ }
+
+ ## if just a single node, return as a single vector
+ if (length(res)==1) res <- res[[1]]
+ res
+
+ ## Original pure R implementation of the above
+ ## (note that it does not require preorder ordering)
+ ##n <- nTips(phy)
+ ##if (node <= n) {
+ ## return(node)
+ ##}
+ ##l <- numeric()
+ ##d <- children(phy, node)
+ ##for (j in d) {
+ ## if (j <= n)
+ ## l <- c(l,j)
+ ## else if (type=="all") l <- c(l,j,
+ ## descendants(phy,j,type="all"))
+ ## else l <- c(l, descendants(phy,j,type=type))
+ ##}
+}
+
+##' @rdname ancestors
+##' @aliases siblings
+##' @export
+siblings <- function(phy, node, include.self=FALSE) {
+ v <- children(phy,ancestor(phy,node))
+ if (!include.self) v <- v[v!=getNode(phy,node)]
+ v
+}
+
+##' @rdname ancestors
+##' @aliases siblings
+##' @export
+ancestors <- function (phy, node, type=c("all","parent","ALL")) {
+
+ type <- match.arg(type)
+
+ ## look up nodes, warning about and excluding invalid nodes
+ oNode <- node
+ node <- getNode(phy, node, missing="warn")
+ isValid <- !is.na(node)
+ node <- as.integer(node[isValid])
+
+ if (length(node) == 0) {
+ return(NA)
+ }
+
+ if (type == "parent") {
+ res <- lapply(node, function(x) ancestor(phy, x))
+ } else {
+ ## edge matrix must be in postorder for the C function!
+ if (phy at order=="postorder") {
+ edge <- phy at edge
+ } else {
+ edge <- reorder(phy, order="postorder")@edge
+ }
+ ## extract edge columns
+ ancestor <- as.integer(edge[, 1])
+ descendant <- as.integer(edge[, 2])
+
+ ## return indicator matrix of ALL ancestors (including self)
+ isAnc <- .Call("ancestors_c", node, ancestor, descendant)
+ storage.mode(isAnc) <- "logical"
+
+ ## drop self if needed
+ if (type=="all") {
+ isAnc[cbind(match(node, descendant), seq_along(node))] <- FALSE
+ }
+ res <- lapply(seq_along(node), function(n) getNode(phy,
+ descendant[isAnc[,n]]))
+ }
+ names(res) <- as.character(oNode[isValid])
+
+ ## if just a single node, return as a single vector
+ if (length(res)==1) res <- res[[1]]
+ res
+
+ ## Original pure R implementation of the above
+ ## (note that it does not require preorder ordering)
+ ##if (node == rootNode(phy))
+ ## return(NULL)
+ ##repeat {
+ ## anc <- ancestor(phy, node)
+ ## res <- c(res, anc)
+ ## node <- anc
+ ## if (anc == n + 1)
+ ## break
+ ##}
+}
diff --git a/R/checkdata.R b/R/checkdata.R
new file mode 100644
index 0000000..75765f5
--- /dev/null
+++ b/R/checkdata.R
@@ -0,0 +1,318 @@
+## REQUIRED for all trees
+
+
+##' Validity checking for phylo4 objects
+##'
+##' Basic checks on the validity of S4 phylogenetic objects
+##'
+##'
+##' @aliases checkPhylo4 checkTree checkPhylo4Data
+##' @param object A prospective phylo4 or phylo4d object
+##' @return As required by \code{\link[methods]{validObject}}, returns an error
+##' string (describing problems) or TRUE if everything is OK.
+##' @note
+##'
+##' These functions are only intended to be called by other phylobase functions.
+##'
+##' \code{checkPhylo4} is an (inflexible) wrapper for
+##' \code{checkTree}. The rules for \code{phylo4} objects essentially
+##' follow those for \code{phylo} objects from the \code{ape} package,
+##' which are in turn defined in
+##' \url{http://ape-package.ird.fr/misc/FormatTreeR_24Oct2012.pdf}.
+##' These are essentially that: \itemize{ \item if the tree has edge
+##' lengths defined, the number of edge lengths must match the number
+##' of edges; \item the number of tip labels must match the number of
+##' tips; \item in a tree with \code{ntips} tips and \code{nnodes}
+##' (total) nodes, nodes 1 to \code{ntips} must be tips \item if the
+##' tree is rooted, the root must be node number \code{ntips+1} and
+##' the root node must be the first row of the edge matrix \item tip
+##' labels, node labels, edge labels, edge lengths must have proper
+##' internal names (i.e. internal names that match the node numbers
+##' they document) \item tip and node labels must be unique }
+##'
+##' You can alter some of the default options by using the function
+##' \code{phylobase.options}.
+##'
+##' For \code{phylo4d} objects, \code{checkTree} also calls
+##' \code{checkPhylo4Data} to check the validity of the data associated with the
+##' tree. It ensures that (1) the data associated with the tree have the correct
+##' dimensions, (2) that the row names for the data are correct.
+##' @author Ben Bolker, Steven Kembel, Francois Michonneau
+##' @seealso the \code{\link{phylo4}} constructor and
+##' \linkS4class{phylo4} class; the \code{\link{phylo4d-methods}} constructor
+##' and the \linkS4class{phylo4d} class do checks for the data
+##' associated with trees. See \code{\link{coerce-methods}} for
+##' translation functions and \code{\link{phylobase.options} to change
+##' some of the default options of the validator.}
+##' @include RcppExports.R
+##' @include phylo4-class.R
+##' @include phylo4-methods.R
+##' @export
+##' @keywords misc
+checkPhylo4 <- function(object) {
+ ct <- checkTree(object)
+
+ if (class(object) == "phylo4d")
+ ## checkPhyo4Data returns TRUE or fail
+ cd <- checkPhylo4Data(object)
+
+ return(ct)
+}
+
+checkTree <- function(object) {
+
+ ## case of empty phylo4 object
+ if(nrow(object at edge) == 0 && length(object at edge.length) == 0 &&
+ length(object at label) == 0 && length(object at edge.label) == 0)
+ return(TRUE)
+
+ ## get options
+ opt <- phylobase.options()
+
+ ## Storage of error/warning messages
+ err <- wrn <- character(0)
+
+ ## Matrix is integer
+ if (!is.integer(object at edge)) {
+ err <- c(err, "Edge matrix needs to be integer.")
+ }
+
+ ## Matrix doesn't have NAs
+ if (any(is.na(object at edge))) {
+ err <- c(err, "Edge matrix cannot have NAs at this time.",
+ "This could only happen if singletons were allowed",
+ "but this is not supported by phylobase yet.")
+ }
+
+ ## Having non-integer or NAs cause cryptic messages, so stop here
+ ## if it's the case
+ if (length(err)) return(err)
+
+ ## Named slots
+ if (is.null(attributes(object at label)$names)) {
+ err <- c(err, "The label slot needs to be a named vector.")
+ attributes(object at label) <- list(names=character(0))
+ }
+ if (is.null(attributes(object at edge.length)$names)) {
+ err <- c(err, "The edge.length slot needs to be a named vector.")
+ attributes(object at edge.length) <- list(names=character(0))
+ }
+ if (is.null(attributes(object at edge.label)$names)) {
+ err <- c(err, "The edge.label slot needs to be a named vector.")
+ attributes(object at edge.label) <- list(names=character(0))
+ }
+
+ res <- checkTreeCpp(object, opts=opt)
+
+ if (hasRetic(object)) {
+ msg <- "Tree is reticulated."
+ if (identical(opt$retic, "fail")) {
+ err <- c(err, msg)
+ }
+ if (identical(opt$retic, "warn")) {
+ wrn <- c(wrn, msg)
+ }
+ }
+
+ if (hasEdgeLength(object) && any(is.na(edgeLength(object)))) {
+ naElen <- names(which(is.na(object at edge.length)))
+ if (! identical(naElen, edgeId(object, "root")))
+ err <- c(err, "Only the root can have NA as edge length. ")
+ }
+
+ if (!object at order %in% phylo4_orderings) {
+ err <- c(err, paste("unknown order: allowed values are",
+ paste(phylo4_orderings,collapse=",")))
+ }
+
+ err <- ifelse(nzchar(res[[1]]), c(err, res[[1]]), err)
+ wrn <- ifelse(nzchar(res[[2]]), c(wrn, res[[2]]), wrn)
+
+ if (!is.na(wrn)) {
+ wrn <- paste(wrn, collapse=", ")
+ warning(wrn)
+ }
+ if (!is.na(err)) {
+ err <- paste(err, collapse=", ")
+ return(err) #failures are returned as text
+ }
+ else {
+ return(TRUE)
+ }
+
+}
+
+## checkTreeOld <- function(object) {
+
+## ## case of empty phylo4 object
+## if(nrow(object at edge) == 0 && length(object at edge.length) == 0 &&
+## length(object at label) == 0 && length(object at edge.label) == 0)
+## return(TRUE)
+
+## ## get options
+## opt <- phylobase.options()
+
+## ## Storage of error/warning messages
+## err <- wrn <- character(0)
+
+## ## Define variables
+## nedges <- nEdges(object)
+## ntips <- nTips(object)
+## E <- edges(object)
+## tips <- unique(sort(E[,2][!E[,2] %in% E[,1]]))
+## nodes <- unique(sort(c(E)))
+## intnodes <- nodes[!nodes %in% tips]
+## nRoots <- length(which(E[,1] == 0))
+
+## ## Check edge lengths
+## if (hasEdgeLength(object)) {
+## if (length(object at edge.length) != nedges)
+## err <- c(err, "edge lengths do not match number of edges")
+## ##if(!is.numeric(object at edge.length)) # not needed
+## ## err <- c(err, "edge lengths are not numeric")
+## ## presumably we shouldn't allow NAs mixed
+## ## with numeric branch lengths except at the root
+## if (sum(is.na(object at edge.length)) > (nRoots + 1))
+## err <- c(err, "NAs in edge lengths")
+## ## Strip root edge branch length (if set to NA)
+## if (any(object at edge.length[!is.na(object at edge.length)] < 0))
+## err <- c(err, "edge lengths must be non-negative")
+## ## Check edge length labels
+## elen.msg <- "Use edgeLength<- to update them."
+## if (is.null(names(object at edge.length))) {
+## err <- c(err, paste("Edge lengths must have names matching edge IDs.",
+## elen.msg))
+## }
+## if (!all(names(object at edge.length) %in% edgeId(object, "all"))) {
+## err <- c(err, paste("One or more edge lengths has an unmatched ID name.",
+## elen.msg))
+## }
+## }
+
+## ## Make sure tips and
+## if (!(all(tips==1:ntips) && all(nodes=(ntips+1):(ntips+length(intnodes)))))
+## err <- c(err, "tips and nodes incorrectly numbered")
+
+## ##careful - nAncest does not work for counting nRoots in unrooted trees
+## nAncest <- tabulate(na.omit(E)[, 2],nbins=max(nodes)) ## bug fix from Jim Regetz
+## nDesc <- tabulate(na.omit(E[,1]))
+## nTips <- sum(nDesc==0)
+## if (!all(nDesc[1:nTips]==0))
+## err <- c(err, "nodes 1 to nTips must all be tips")
+
+## if (nRoots > 0) {
+## if (sum(E[, 1] == 0) != 1) {
+## err <- c(err, "for a rooted tree, edge matrix must contain (exactly one) explicit root edge with ancestor==0")
+## }
+## root.node <- unname(E[which(E[,1] == 0), 2])
+## }
+
+## ## Check that nodes are correctly numbered
+## if (!all(nDesc[(nTips+1):(nTips+nNodes(object))]>0))
+## err <- c(err, "nodes (nTips+1) to (nTips+nNodes) must all be internal nodes")
+
+## ## how do we identify loops???
+## ## EXPERIMENTAL: could be time-consuming for large trees?
+## if (FALSE) {
+## Emat <- matrix(0,nrow=max(E),ncol=max(E))
+## Emat[E] <- 1
+## }
+## if (!object at order %in% phylo4_orderings) {
+## err <- c(err, paste("unknown order: allowed values are",
+## paste(phylo4_orderings,collapse=",")))
+## }
+
+## ## make sure tip/node labels have internal names that match node IDs
+## lab.msg <- "Use tipLabels<- (and nodeLabels<- if needed) to update them."
+## if (is.null(names(object at label))) {
+## err <- c(err, paste("Tip and node labels must have names matching node IDs.",
+## lab.msg))
+
+## } else {
+## if (!all(tips %in% names(na.omit(object at label)))) {
+## err <- c(err, paste("All tips must have associated tip labels.",
+## lab.msg))
+## }
+## if (!all(names(object at label) %in% nodeId(object, "all"))) {
+## err <- c(err, paste("One or more tip/node label has an unmatched ID name",
+## lab.msg))
+## }
+## }
+
+## ## make sure edge labels have internal names that match the edges
+## elab.msg <- "Use edgeLabels<- to update them."
+## if(hasEdgeLabels(object)) {
+## if (is.null(names(object at edge.label))) {
+## err <- c(err, paste("Edge labels must have names matching edge IDs.",
+## elab.msg))
+## }
+## if (!all(names(object at edge.label) %in% edgeId(object, "all"))) {
+## err <- c(err, paste("One or more edge labels has an unmatched ID name.",
+## elab.msg))
+## }
+## }
+
+## ## make sure that tip and node labels are unique
+## if (hasDuplicatedLabels(object)) {
+## currmsg <- "Labels are not unique"
+## if (opt$allow.duplicated.labels == "fail")
+## err <- c(err, currmsg)
+## if (opt$allow.duplicated.labels == "warn")
+## wrn <- c(wrn, currmsg)
+## }
+
+## if (any(nDesc>2)) {
+## currmsg <- "tree includes polytomies"
+## if (opt$poly == "fail")
+## err <- c(err, currmsg)
+## if (opt$poly == "warn")
+## wrn <- c(wrn, currmsg)
+## }
+
+## if (nRoots>1) {
+## currmsg <- "tree has more than one root"
+## if (opt$multiroot == "fail")
+## err <- c(err, currmsg)
+## if (opt$multiroot == "warn")
+## wrn <- c(wrn,currmsg)
+## }
+## if (any(nDesc==1)) {
+## currmsg <- "tree contains singleton nodes"
+## if (opt$singleton == "fail")
+## err <- c(err, currmsg)
+## if (opt$singleton == "warn")
+## wrn <- c(wrn, currmsg)
+## }
+## if (any(nAncest>1)) {
+## currmsg <- paste("tree is reticulated [most functions in phylobase haven't",
+## "been tested with reticulated trees]")
+## if (opt$retic == "fail")
+## err <- c(err, currmsg)
+## if (opt$retic == "warn")
+## wrn <- c(wrn, currmsg)
+## }
+## if (length(wrn) > 0) {
+## wrn <- paste(wrn, collapse=", ")
+## warning(wrn)
+## }
+## if (length(err) > 0) {
+## err <- paste(err, collapse=", ")
+## return(err) #failures are returned as text
+## }
+## else {
+## return(TRUE)
+## }
+## }
+
+checkPhylo4Data <- function(object) {
+
+ ## These are just some basic tests to make sure that the user does not
+ ## alter the object in a significant way
+
+ ## Check rownames
+ if (nrow(object at data) > 0 &&
+ !all(row.names(object at data) %in% nodeId(object, "all")))
+ stop("The row names of tree data do not match the node numbers")
+
+ return(TRUE)
+}
diff --git a/R/edgeLength-methods.R b/R/edgeLength-methods.R
new file mode 100644
index 0000000..87e43d0
--- /dev/null
+++ b/R/edgeLength-methods.R
@@ -0,0 +1,310 @@
+
+## TODO -- the behavior of edgeLength needs to be made more consistent
+## with other functions like MRCA. The user should be able to specify a
+## vector of nodes, of edges, or both.
+
+##### This file contains
+## hasEdgeLength
+## edgeLength and edgeLength<-
+## isUltrametric
+## nodeDepth
+## sumEdgeLength
+
+##' edgeLength methods
+##'
+##' These functions give information about and allow replacement of edge lengths.
+##'
+##' The \code{edgeLength} function returns the edge length in the same
+##' order as the edges in the matrix.
+##'
+##' @param x a \code{phylo4} or \code{phylo4d} object.
+##' @param value a numeric vector indicating the new values for the edge lengths
+##' @param node optional numeric or character vector indicating the
+##' nodes for which edge
+##' @param use.names should the the name attributes of \code{value} be
+##' used to match the length to a given edge.
+##' @param tol the tolerance to decide whether all the tips have the
+##' same depth to test if the tree is ultrametric. Default is
+##' \code{.Machine$double.eps^0.5}.
+##' @param \dots optional arguments (none used at present).
+##' @return \describe{
+##'
+##' \item{hasEdgeLength}{whether or not the object has edge lengths
+##' (logical)}
+##'
+##' \item{edgeLength}{a named vector of the edge length for the
+##' object}
+##'
+##' \item{isUltrametric}{whether or not the tree is ultrametric (all
+##' the tips are have the same depth (distance from the root) (logical)}
+##'
+##' \item{sumEdgeLength}{the sum of the edge lengths for a set of
+##' nodes (intended to be used with \code{ancestors} or \code{descendants})}
+##'
+##' \item{nodeHeight}{the distance between a node and the root or the
+##' tips. The format of the result will depend on the options and the
+##' number of nodes provided, either a vector or a list.}
+##'
+##' \item{nodeDepth}{Deprecated, now replaced by \code{nodeHeight}. A
+##' named vector indicating the \dQuote{depth} (the distance between
+##' the root and a given node).}
+##'
+##' \item{depthTip}{Deprecated, now replaced by \code{nodeHeight}.}
+##'
+##' }
+##' @seealso \code{ancestors}, \code{descendants}, \code{.Machine} for
+##' more information about tolerance.
+##' @export
+##' @docType methods
+##' @aliases hasEdgeLength
+##' @rdname edgeLength-methods
+##' @include phylo4-class.R
+##' @include phylo4-methods.R
+##' @include nodeId-methods.R
+##' @examples
+##' data(geospiza)
+##' hasEdgeLength(geospiza) # TRUE
+##' topoGeo <- geospiza
+##' edgeLength(topoGeo) <- NULL
+##' hasEdgeLength(topoGeo) # FALSE
+##'
+##' edgeLength(geospiza)[2] # use the position in vector
+##' edgeLength(geospiza)["16-17"] # or the name of the edge
+##' edgeLength(geospiza, 17) # or the descendant node of the edge
+##'
+##' ## The same methods can be used to update an edge length
+##' edgeLength(geospiza)[2] <- 0.33
+##' edgeLength(geospiza)["16-17"] <- 0.34
+##' edgeLength(geospiza, 17) <- 0.35
+##'
+##' ## Test if tree is ultrametric
+##' isUltrametric(geospiza) # TRUE
+##' ## indeed all tips are at the same distance from the root
+##' nodeHeight(geospiza, nodeId(geospiza, "tip"), from="root")
+##' ## compare distances from tips of two MRCA
+##' nodeHeight(geospiza, MRCA(geospiza, c("pallida", "psittacula")), from="min_tip")
+##' nodeHeight(geospiza, MRCA(geospiza, c("fortis", "difficilis")), from="min_tip")
+##' ## or the same but from the root
+##' nodeHeight(geospiza, MRCA(geospiza, c("pallida", "psittacula")), from="root")
+##' nodeHeight(geospiza, MRCA(geospiza, c("fortis", "difficilis")), from="root")
+setGeneric("hasEdgeLength", function(x) {
+ standardGeneric("hasEdgeLength")
+})
+
+##' @rdname edgeLength-methods
+##' @aliases hasEdgeLength,phylo4-method
+setMethod("hasEdgeLength", signature(x="phylo4"),
+ function(x) {
+ !all(is.na(x at edge.length))
+})
+
+#### ----- edgeLength
+
+##' @rdname edgeLength-methods
+##' @aliases edgeLength
+##' @export
+setGeneric("edgeLength", function(x, ...) {
+ standardGeneric("edgeLength")
+})
+
+##' @rdname edgeLength-methods
+##' @aliases edgeLength,phylo4-method
+setMethod("edgeLength", signature(x="phylo4"),
+ function(x, node) {
+ ## [JR: below, using match for ordering rather than direct character
+ ## indexing b/c the latter is slow for vectors of a certain size]
+ if (!missing(node)) {
+ id <- getEdge(x, node)
+ } else {
+ id <- edgeId(x, "all")
+ }
+ elen <- x at edge.length[match(id, names(x at edge.length))]
+ names(elen) <- id
+ return(elen)
+})
+
+##' @rdname edgeLength-methods
+##' @aliases edgeLength<-
+##' @export
+setGeneric("edgeLength<-", function(x, use.names=TRUE, ..., value) {
+ standardGeneric("edgeLength<-")
+})
+
+##' @name edgeLength<-
+##' @rdname edgeLength-methods
+##' @aliases edgeLength<-,phylo4-method edgeLength<-,phylo4,ANY-method
+setReplaceMethod("edgeLength", signature(x="phylo4", value="ANY"),
+ function(x, use.names=TRUE, ..., value) {
+ len <- .createEdge(value, x at edge, type="lengths", use.names)
+ ## return empty vector if all values are NA
+ if (all(is.na(len))) {
+ emptyVec <- numeric()
+ attributes(emptyVec) <- list(names=character(0))
+ x at edge.length <- emptyVec
+ } else {
+ x at edge.length <- len
+ }
+ if(is.character(checkval <- checkPhylo4(x))) stop(checkval)
+ x
+})
+
+##### ------ depthTips
+
+##' @rdname edgeLength-methods
+##' @aliases depthTips
+##' @export
+setGeneric("depthTips", function(x) {
+ standardGeneric("depthTips")
+})
+
+##' @rdname edgeLength-methods
+##' @aliases depthTips,phylo4-methods
+setMethod("depthTips", signature(x="phylo4"), function(x) {
+ .Deprecated("nodeHeight")
+ nodeDepth(x, 1:nTips(x))
+})
+
+##### ----- nodeDepth
+
+##' @rdname edgeLength-methods
+##' @aliases nodeDepth
+##' @export
+setGeneric("nodeDepth", function(x, node) {
+ standardGeneric("nodeDepth")
+})
+
+##' @rdname edgeLength-methods
+##' @aliases nodeDepth,phylo4-method
+setMethod("nodeDepth", signature(x="phylo4"),
+ function(x, node) {
+ .Deprecated("nodeHeight")
+ if (!hasEdgeLength(x))
+ return(NULL)
+ else {
+ node <- getNode(x, node, missing="warn")
+ node <- node[!is.na(node)]
+ res <- sapply(node, function(n)
+ sumEdgeLength(x, ancestors(x, n, "ALL")))
+ if (length(res) == 1) {
+ res <- res[[1]]
+ names(res) <- names(node)
+ }
+ res
+ }
+})
+
+###### ----- nodeHeight
+
+##' @param from The point of reference for calculating the height of
+##' the node. \code{root} calculates the distance between the root of
+##' the tree and the node. \code{all_tip} return the distance between
+##' the node and all the tips descending from it. \code{min_tip} the
+##' distance between the node and its closest tip. \code{max_tip} the
+##' distance between the node and its farther tip. \code{min_tip} and
+##' \code{max_tip} will be identical if the tree is ultrametric. If
+##' more than one tip is equidistant from the node, the tip with the
+##' lowest node id will be returned.
+##' @rdname edgeLength-methods
+##' @aliases nodeHeight
+##' @export
+setGeneric("nodeHeight", function(x, node, from) {
+ standardGeneric("nodeHeight")
+ })
+
+##' @rdname edgeLength-methods
+##' @aliases nodeHeight,phylo4-method
+setMethod("nodeHeight", signature(x = "phylo4"),
+ function(x, node, from = c("root", "all_tip", "min_tip", "max_tip")) {
+ from <- match.arg(from)
+ if (!hasEdgeLength(x))
+ return(NULL)
+ else {
+ node <- getNode(x, node, missing = "warn")
+ node <- node[!is.na(node)]
+ tip_id <- nodeId(x, "tip")
+ if (from != "root") {
+ ## Get the full paths to the tips from the node
+ res <- lapply(node, function(n) {
+ if (n %in% tip_id) {
+ ## tips are always at 0
+ tmp_res <- stats::setNames(0, tipLabels(x)[n])
+ } else {
+ desc_pths <- descendants(x, n, "all")
+ ## Get the paths in the other direction
+ anc_pths <- lapply(desc_pths[desc_pths %in% tip_id],
+ function(n) {
+ ancestors(x, n, "ALL")
+ })
+ ## Shortest paths for each tip
+ pths <- lapply(anc_pths, function(anc_pth) {
+ intersect(desc_pths, anc_pth)
+ })
+ tmp_res <- sapply(pths, function(n) {
+ sumEdgeLength(x, n)
+ })
+
+ tmp_res <- switch(from,
+ "all_tip" = tmp_res,
+ "min_tip" = tmp_res[which.min(tmp_res)],
+ "max_tip" = tmp_res[which.max(tmp_res)])
+ }
+ tmp_res
+ })
+ } else {
+ res <- sapply(node, function(n) {
+ sumEdgeLength(x, ancestors(x, n, "ALL"))
+ })
+ }
+ names(res) <- node
+ if (length(res) == 1) {
+ res <- res[[1]]
+ }
+ }
+ res
+ })
+
+
+###### ----- sumEdgeLength
+
+##' @rdname edgeLength-methods
+##' @aliases sumEdgeLength
+##' @export
+setGeneric("sumEdgeLength", function(x, node) {
+ standardGeneric("sumEdgeLength")
+})
+
+##' @rdname edgeLength-methods
+##' @aliases sumEdgeLength,phylo4-method
+setMethod("sumEdgeLength", signature(x="phylo4"),
+ function(x, node) {
+ if(!hasEdgeLength(x))
+ NULL
+ else {
+ nd <- getNode(x, node)
+ iEdges <- which(x at edge[,2] %in% nd)
+ sumEdges <- sum(x at edge.length[iEdges], na.rm=TRUE)
+ sumEdges
+ }
+})
+
+###### ----- isUltrametric
+
+##' @rdname edgeLength-methods
+##' @aliases isUltrametric
+##' @export
+setGeneric("isUltrametric", function(x, tol=.Machine$double.eps^.5) {
+ standardGeneric("isUltrametric")
+})
+
+##' @rdname edgeLength-methods
+##' @aliases isUltrametric,phylo4-method
+setMethod("isUltrametric", signature(x="phylo4"),
+ function(x, tol=.Machine$double.eps^.5) {
+ if (!hasEdgeLength(x)) {
+ stop("The tree has no edge lengths.")
+ }
+ if (identical(all.equal.numeric(stats::var(nodeHeight(x, nodeId(x, "tip"), "root")), 0, tolerance=tol), TRUE)) {
+ TRUE
+ }
+ else FALSE
+ })
diff --git a/R/extractTree.R b/R/extractTree.R
new file mode 100644
index 0000000..4f69a04
--- /dev/null
+++ b/R/extractTree.R
@@ -0,0 +1,37 @@
+## extract the phylo4 part of phylo4d; relies on implicit coerce method
+
+##' Get tree from tree+data object
+##'
+##' Extracts a \code{phylo4} tree object from a \code{phylo4d}
+##' tree+data object.
+##'
+##' \code{extractTree} extracts just the phylogeny from a tree+data
+##' object. The phylogeny contains the topology (how the nodes are
+##' linked together), the branch lengths (if any), and any tip and/or
+##' node labels. This may be useful for extracting a tree from a
+##' \code{phylo4d} object, and associating with another phenotypic
+##' dataset, or to convert the tree to another format.
+##'
+##' @param from a \code{phylo4d} object, containing a phylogenetic
+##' tree plus associated phenotypic data. Created by the
+##' \code{phylo4d()} function.
+##' @author Ben Bolker
+##' @seealso \code{\link{phylo4-methods}},
+##' \code{\link{phylo4d-methods}}, \code{\link{coerce-methods}} for
+##' translation functions.
+##' @keywords methods
+##' @export
+##' @include setAs-methods.R
+##' @examples
+##' tree.phylo <- ape::read.tree(text = "((a,b),c);")
+##' tree <- as(tree.phylo, "phylo4")
+##' plot(tree)
+##' tip.data <- data.frame(size = c(1, 2, 3), row.names = c("a", "b", "c"))
+##' (treedata <- phylo4d(tree, tip.data))
+##' plot(treedata)
+##' (tree1 <- extractTree(treedata))
+##' plot(tree1)
+##'
+extractTree <- function(from) {
+ as(from, "phylo4")
+}
diff --git a/R/formatData.R b/R/formatData.R
new file mode 100644
index 0000000..608c58c
--- /dev/null
+++ b/R/formatData.R
@@ -0,0 +1,213 @@
+##' Format data for use in phylo4d objects
+##'
+##' Associates data with tree nodes and applies consistent formatting
+##' rules.
+##'
+##'
+##' \code{formatData} is an internal function that should not be
+##' called directly by the user. It is used to format data provided by
+##' the user before associating it with a tree, and is called
+##' internally by the \code{phylo4d}, \code{tdata}, and \code{addData}
+##' methods. However, users may pass additional arguments to these
+##' methods in order to control how the data are matched to nodes.
+##'
+##' Rules for matching rows of data to tree nodes are determined
+##' jointly by the \code{match.data} and \code{rownamesAsLabels}
+##' arguments. If \code{match.data} is TRUE, data frame rows will be
+##' matched exclusively against tip and node labels if
+##' \code{rownamesAsLabels} is also TRUE, whereas any all-digit row
+##' names will be matched against tip and node numbers if
+##' \code{rownamesAsLabels} is FALSE (the default). If
+##' \code{match.data} is FALSE, \code{rownamesAsLabels} has no effect,
+##' and row matching is purely positional with respect to the order
+##' returned by \code{nodeId(phy, type)}.
+##'
+##' \code{formatData} (1) converts labels provided in the data into
+##' node numbers, (2) makes sure that the data are appropriately
+##' matched against tip and/or internal nodes, (3) checks for
+##' differences between data and tree, (4) creates a data frame with
+##' the correct dimensions given a tree.
+##'
+##' @param phy a valid \code{phylo4} object
+##' @param dt a data frame, matrix, vector, or factor
+##' @param type type of data to attach
+##' @param match.data (logical) should the rownames of the data frame
+##' be used to be matched against tip and internal node identifiers?
+##' See details.
+##' @param rownamesAsLabels (logical), should the row names of the
+##' data provided be matched only to labels (TRUE), or should any
+##' number-like row names be matched to node numbers (FALSE and
+##' default)
+##' @param label.type character, \code{rownames} or \code{column}:
+##' should the labels be taken from the row names of \code{dt} or from
+##' the \code{label.column} column of \code{dt}?
+##' @param label.column if \code{label.type=="column"}, column
+##' specifier (number or name) of the column containing tip labels
+##' @param missing.data action to take if there are missing data or if
+##' there are data labels that don't match
+##' @param extra.data action to take if there are extra data or if
+##' there are labels that don't match
+##' @param keep.all (logical), should the returned data have rows for
+##' all nodes (with NA values for internal rows when type='tip', and
+##' vice versa) (TRUE and default) or only rows corresponding to the
+##' type argument
+##' @return \code{formatData} returns a data frame having node numbers
+##' as row names. The data frame is also formatted to have the correct
+##' dimension given the \code{phylo4} object provided.
+##' @author Francois Michonneau
+##' @seealso the \code{\link{phylo4d-methods}} constructor, the
+##' \linkS4class{phylo4d} class. See \code{\link{coerce-methods}} for
+##' translation functions.
+##' @keywords misc
+formatData <- function(phy, dt, type=c("tip", "internal", "all"),
+ match.data=TRUE, rownamesAsLabels=FALSE,
+ label.type=c("rownames", "column"),
+ label.column=1, missing.data=c("fail", "warn", "OK"),
+ extra.data=c("warn", "OK", "fail"), keep.all=TRUE
+ ) {
+
+ ## determine whether to return rows for all nodes, or just 'type'
+ type <- match.arg(type)
+ if (keep.all) {
+ ids.out <- nodeId(phy, "all")
+ } else {
+ ids.out <- nodeId(phy, type)
+ }
+
+ ## if null, return empty data frame with node numbers as row names
+ if (is.null(dt)) {
+ return(data.frame(row.names=ids.out))
+ }
+ ## if vector, coerce to data.frame
+ if (is.vector(dt) || is.factor(dt) || is.matrix(dt)) {
+ dt <- as.data.frame(dt)
+ }
+ ## before proceeding, make sure that data provided are a data frame
+ if (!is.data.frame(dt)) {
+ stop(paste(deparse(substitute(dt)),
+ "must be a vector, factor, matrix, or data frame"))
+ }
+ ## if lacking rows or columns, return a placeholder data frame with
+ ## node numbers as row names
+ if (any(dim(dt)==0)) {
+ return(data.frame(row.names=ids.out))
+ }
+
+ label.type <- match.arg(label.type)
+ ## Make sure the column specified for the labels is appropriate
+ if (label.type == "column") {
+ if (is.numeric(label.column))
+ stopifnot(label.column %in% 1:ncol(dt))
+ else
+ stopifnot(label.column %in% names(dt))
+ }
+
+ missing.data <- match.arg(missing.data)
+ extra.data <- match.arg(extra.data)
+
+ if(match.data) {
+ ## extract values to be matched to nodes
+ ndNames <- switch(label.type,
+ rownames = rownames(dt),
+ column = dt[,label.column])
+ if (rownamesAsLabels) {
+ ids.in <- lapply(ndNames, function(ndnm) {
+ getNode(phy, as.character(ndnm), missing="OK")
+ })
+ }
+ else {
+ ids.in <- lapply(ndNames, function(ndnm) {
+ if (nchar(gsub("[0-9]", "", ndnm)) == 0) {
+ getNode(phy, as.integer(ndnm), missing="OK")
+ }
+ else {
+ getNode(phy, as.character(ndnm), missing="OK")
+ }
+ })
+ }
+ ids.list <- ids.in
+ ids.in <- unlist(ids.in)
+
+ ## Make sure that data are matched to appropriate nodes
+ if (type=="tip" && any(stats::na.omit(ids.in) %in% nodeId(phy,
+ "internal"))) {
+ stop("Your tip data are being matched to internal ",
+ "nodes. Make sure that your data identifiers ",
+ "are correct.")
+ }
+ if (type=="internal" && any(stats::na.omit(ids.in) %in% nodeId(phy,
+ "tip"))) {
+ stop("Your node data are being matched to tip ",
+ "nodes. Make sure that your data identifiers ",
+ "are correct.")
+ }
+
+ ## Check differences between tree and data
+ mssng <- setdiff(nodeId(phy, type), ids.in)
+ if(length(mssng) > 0 && missing.data != "OK") {
+ ## provide label if it exists and node number otherwise
+ mssng <- getNode(phy, mssng)
+ mssng <- ifelse(is.na(names(mssng)), mssng, names(mssng))
+ msg <- "The following nodes are not found in the dataset: "
+ msg <- paste(msg, paste(mssng, collapse=", "))
+ switch(missing.data,
+ warn = warning(msg),
+ fail = stop(msg))
+ }
+ extra <- ndNames[is.na(ids.in)]
+ if(length(extra) > 0 && extra.data != "OK") {
+ msg <- "The following names are not found in the tree: "
+ msg <- paste(msg, paste(extra, collapse=", "))
+ switch(extra.data,
+ warn = warning(msg),
+ fail = stop(msg))
+ }
+
+ ## Format data to have correct dimensions
+ ids.list <- ids.list[!is.na(ids.list)]
+ dt <- dt[!is.na(ids.in), , drop=FALSE]
+ if (hasDuplicatedLabels(phy)) {
+ dtTmp <- array(, dim=c(length(ids.in[!is.na(ids.in)]), ncol(dt)),
+ dimnames=list(ids.in[!is.na(ids.in)], names(dt)))
+ dtTmp <- data.frame(dtTmp)
+ j <- 1
+ for (i in 1:length(ids.list)) {
+ for (k in 1:length(ids.list[[i]])) {
+ dtTmp[j, ] <- dt[i, , drop=FALSE]
+ j <- j + 1
+ }
+ }
+ dt <- dtTmp
+ }
+ rownames(dt) <- ids.in[!is.na(ids.in)]
+ dt.out <- dt[match(ids.out, rownames(dt)), , drop=FALSE]
+ rownames(dt.out) <- ids.out
+ if(label.type == "column") {
+ dt.out <- subset(dt.out, select=-eval(parse(text=label.column)))
+ }
+
+ } else {
+ ## Check if too many or not enough rows in input data
+ expected.nrow <- length(nodeId(phy, type))
+ diffNr <- nrow(dt) - expected.nrow
+ if(nrow(dt) > expected.nrow && extra.data != "OK") {
+ msg <- paste("There are", diffNr, "extra rows.")
+ switch(extra.data,
+ warn = warning(msg),
+ fail = stop(msg))
+ }
+ if(nrow(dt) < expected.nrow && missing.data != "OK") {
+ msg <- paste("There are", abs(diffNr), "missing rows.")
+ switch(missing.data,
+ warn = warning(msg),
+ fail = stop(msg))
+ }
+ ## truncate rows of input data frame if necessary
+ dt <- dt[1:min(nrow(dt), expected.nrow) ,, drop = FALSE]
+ rownames(dt) <- nodeId(phy, type)[seq_len(nrow(dt))]
+ dt.out <- dt[match(ids.out, rownames(dt)) ,, drop=FALSE]
+ rownames(dt.out) <- ids.out
+ }
+
+ dt.out
+}
diff --git a/R/getNode-methods.R b/R/getNode-methods.R
new file mode 100644
index 0000000..da48fab
--- /dev/null
+++ b/R/getNode-methods.R
@@ -0,0 +1,206 @@
+## matching node labels with node numbers ...
+## e.g.
+## 14 tips, 13 int nodes
+## N04 = nodeLabels[4]
+## <-> node 18
+## x = n-nTips(phy)
+## so: n = x+nTips(phy)
+
+
+##' Node and Edge look-up functions
+##'
+##' Functions for retrieving node and edge IDs (possibly with corresponding
+##' labels) from a phylogenetic tree.
+##'
+##' \code{getNode} and \code{getEdge} are primarily intended for looking up the
+##' IDs either of nodes themselves or of edges associated with those nodes. Note
+##' that they behave quite differently. With \code{getNode}, any input nodes are
+##' looked up against tree nodes of the specified type, and those that match are
+##' returned as numeric node IDs with node labels (if they exist) as element
+##' names. With \code{getEdge}, any input nodes are looked up against edge ends
+##' of the specified type, and those that match are returned as character edge
+##' IDs with the corresponding node ID as element names.
+##'
+##' If \code{missing} is \dQuote{warn} or \dQuote{OK}, \code{NA} is returned for
+##' any nodes that are unmatched for the specified type. This can provide a
+##' mechanism for filtering a set of nodes or edges.
+##'
+##' \code{nodeId} provides similar output to \code{getNode} in the case when no
+##' node is supplied, but it is faster and returns an unnamed vector of the
+##' numeric IDs of all nodes of the specified node type. Similarly,
+##' \code{edgeId} simply returns an unnamed vector of the character IDs of all
+##' edges for which the descendant node is of the specified node type.
+##'
+##' @param x a \linkS4class{phylo4} object (or one inheriting from
+##' \linkS4class{phylo4}, e.g. a \linkS4class{phylo4d} object)
+##' @param node either an integer vector corresponding to node ID numbers, or a
+##' character vector corresponding to node labels; if missing, all nodes
+##' appropriate to the specified type will be returned by \code{getNode}, and
+##' all edges appropriate to the specified type will be returned by
+##' \code{getEdge}.
+##' @param type (\code{getNode}) specify whether to return nodes matching "all"
+##' tree nodes (default), only "tip" nodes, or only "internal" nodes;
+##' (\code{nodeId, edgeId}) specify whether to return "all" tree nodes, or only
+##' those corresponding to "tip", "internal", or "root" nodes; (\code{getEdge})
+##' specify whether to look up edges based on their descendant node
+##' ("descendant") or ancestral node ("ancestor")
+##' @param missing what to do if some requested node IDs or names are not in the
+##' tree: warn, do nothing, or stop with an error
+##' @return \item{list("getNode")}{returns a named integer vector of node IDs,
+##' in the order of input nodes if provided, otherwise in nodeId order}
+##' \item{list("getEdge")}{returns a named character vector of edge IDs, in the
+##' order of input nodes if provide, otherwise in nodeId order}
+##' \item{list("nodeId")}{returns an unnamed integer vector of node IDs, in
+##' ascending order} \item{list("getEdge")}{returns an unnamed character vector
+##' of edge IDs, in edge matrix order}
+##' @keywords misc
+##' @export
+##' @rdname getNode-methods
+##' @include phylo4-class.R
+##' @examples
+##'
+##' data(geospiza)
+##' nodeLabels(geospiza) <- LETTERS[1:nNodes(geospiza)]
+##' plot(as(geospiza, "phylo4"), show.node.label=TRUE)
+##' getNode(geospiza, 18)
+##' getNode(geospiza, "D")
+##' getEdge(geospiza, "D")
+##' getEdge(geospiza, "D", type="ancestor")
+##'
+##' ## match nodes only to tip nodes, flagging invalid cases as NA
+##' getNode(geospiza, c(1, 18, 999), type="tip", missing="OK")
+##'
+##' ## get all edges that descend from internal nodes
+##' getEdge(geospiza, type="ancestor")
+##'
+##' ## identify an edge from its terminal node
+##' getEdge(geospiza, c("olivacea", "B", "fortis"))
+##' getNode(geospiza, c("olivacea", "B", "fortis"))
+##' edges(geospiza)[c(26, 1, 11),]
+##'
+##' ## quickly get all tip node IDs and tip edge IDs
+##' nodeId(geospiza, "tip")
+##' edgeId(geospiza, "tip")
+##'
+setGeneric("getNode", function(x, node, type=c("all", "tip", "internal"),
+ missing=c("warn", "OK", "fail")) {
+ standardGeneric("getNode")
+})
+
+##' @rdname getNode-methods
+##' @aliases getNode,phylo4-method
+setMethod("getNode", signature(x="phylo4", node="ANY"),
+ function(x, node, type=c("all", "tip", "internal"),
+ missing=c("warn","OK","fail")) {
+
+ type <- match.arg(type)
+ missing <- match.arg(missing)
+
+ ## if missing node arg, get all nodes of specified type
+ if (missing(node)) {
+ node <- nodeId(x, type)
+ }
+
+ if (length(node) == 0) {
+ rval <- integer(0)
+ names(rval) <- character(0)
+ return(rval)
+ }
+
+ lblTmp <- labels(x, type)
+
+ ## match node to tree
+ if (is.character(node)) {
+ ndTmp <- paste("^\\Q", node, "\\E$", sep="")
+ irval <- lapply(ndTmp, function(ND) {
+ grep(ND, lblTmp, perl=TRUE)
+ })
+ irvalL <- sapply(irval, length)
+ irval[irvalL == 0] <- 0
+ irval <- unlist(irval)
+ } else if (is.numeric(node) && all(floor(node) == node, na.rm=TRUE)) {
+ irval <- match(as.character(node), names(lblTmp))
+ } else {
+ stop("Node must be a vector of class \'integer\' or \'character\'.")
+ }
+
+ ## node numbers
+ rval <- names(lblTmp)[irval]
+ rval[is.na(node)] <- NA # return NA for any NA_character_ inputs, not needed but ensure rval has correct length
+ rval <- as.integer(rval)
+
+ ## node labels
+ nmNd <- lblTmp[irval]
+ names(rval) <- nmNd
+
+ ## deal with nodes that don't match
+ if (any(is.na(rval))) {
+ missnodes <- node[is.na(rval)]
+ msg <- paste("Some nodes not found among", type, "nodes in tree:",
+ paste(missnodes,collapse=", "))
+ if (missing=="fail") {
+ stop(msg)
+ } else if (missing=="warn") {
+ warning(msg)
+ }
+ }
+ return(rval)
+})
+
+##' @rdname getNode-methods
+##' @aliases getEdge-methods
+##' @export
+setGeneric("getEdge", function(x, node, type=c("descendant", "ancestor"),
+ missing=c("warn", "OK", "fail")) {
+ standardGeneric("getEdge")
+})
+
+##' @name getEdge
+##' @rdname getNode-methods
+##' @aliases getEdge,phylo4-method
+setMethod("getEdge", signature(x="phylo4", node="ANY"),
+ function(x, node, type=c("descendant", "ancestor"),
+ missing=c("warn", "OK", "fail")) {
+
+ type <- match.arg(type)
+ missing <- match.arg(missing)
+ if (missing(node)) {
+ if (type=="descendant") {
+ node <- nodeId(x, "all")
+ } else if (type=="ancestor") {
+ node <- nodeId(x, "internal")
+ }
+ }
+
+ node.id <- getNode(x, node, missing="OK")
+
+ nd <- lapply(node.id, function(nid) {
+ if (is.na(nid)) {
+ res <- NA
+ } else {
+ res <- switch(type,
+ descendant = edgeId(x)[edges(x)[,2] %in% nid],
+ ancestor = edgeId(x)[edges(x)[,1] %in% nid])
+ ## hack to return NA for tip nodes when type='ancestor'
+ if(length(res)==0) res <- NA
+ names(res) <- rep(nid, length(res))
+ }
+ names(res) <- rep(nid, length(res))
+ res
+ })
+
+ ## warn or stop if necessary
+ is.missing <- is.na(nd)
+ if (missing!="OK" && any(is.missing)) {
+ msg <- paste("Not all nodes are ", type, "s in this tree: ",
+ paste(node[is.missing], collapse=", "), sep="")
+ if (missing=="fail") {
+ stop(msg)
+ } else if (missing=="warn") {
+ warning(msg)
+ }
+ }
+
+ return(unlist(unname(nd)))
+
+})
diff --git a/R/internal-constructors.R b/R/internal-constructors.R
new file mode 100644
index 0000000..0941cb4
--- /dev/null
+++ b/R/internal-constructors.R
@@ -0,0 +1,87 @@
+
+#####################
+## Labels constructor
+#####################
+
+## (formerly) recursive function to have labels of constant length
+## base = a character string
+## n = number of labels
+.genlab <- function(base, n) {
+ if(n <= 0) return("")
+ s <- seq(length.out=n)
+ fw <- max(nchar(as.character(s)))
+ numstr <- formatC(s, flag="0", width=fw)
+ paste(base, numstr, sep="")
+}
+
+.createLabels <- function(value, ntips, nnodes, use.names = TRUE,
+ type = c("all", "tip", "internal")) {
+
+ type <- match.arg(type)
+
+ ## set up final length of object to return
+ lgthRes <- switch(type, tip=ntips, internal=nnodes, all=ntips+nnodes)
+
+ ## create NA character vector of node labels
+ res <- character(lgthRes)
+ is.na(res) <- TRUE
+
+ ## create internal names
+ names(res) <- switch(type,
+ tip = 1:ntips,
+ internal = seq(from=ntips+1, length=lgthRes),
+ all = 1:(ntips+nnodes))
+
+ ## Convert empty labels to NA
+ value[!nzchar(value)] <- NA
+
+ ## if no values are provided
+ if(missing(value) || is.null(value) || all(is.na(value))) {
+ ## tip labels can't be NULL
+ if(!identical(type, "internal")) {
+ tipLbl <- .genlab("T", ntips)
+ res[1:ntips] <- tipLbl
+ }
+ }
+
+ ## if labels are provided
+ else {
+ ## check that lengths match
+ if(length(value) != lgthRes)
+ stop("Number of labels does not match number of nodes.")
+
+ ## check if vector 'value' has name, and if so match with node.label names
+ if(use.names && !is.null(names(value))) {
+ if(!all(names(value) %in% names(res)))
+ stop("Names provided don't match internal labels names.")
+ res[match(names(value), names(res))] <- value
+ }
+ else
+ res[1:lgthRes] <- value
+ }
+
+ res
+}
+
+
+.createEdge <- function(value, edgeMat, type=c("lengths", "labels"),
+ use.names=TRUE) {
+ type <- match.arg(type)
+
+ lgthRes <- nrow(edgeMat)
+ res <- switch(type, lengths=numeric(lgthRes), labels=character(lgthRes))
+ is.na(res) <- TRUE
+ names(res) <- paste(edgeMat[,1], edgeMat[,2], sep="-")
+
+ if(!(missing(value) || is.null(value) || all(is.na(value)))) {
+ if(use.names && !is.null(names(value))) {
+ if(!all(names(value) %in% names(res)))
+ stop("Names provided don't match internal edge labels names.")
+ res[match(names(value), names(res))] <- value
+ }
+ else
+ res[1:lgthRes] <- value
+ }
+
+ res
+}
diff --git a/R/labels-methods.R b/R/labels-methods.R
new file mode 100644
index 0000000..fb6ed6b
--- /dev/null
+++ b/R/labels-methods.R
@@ -0,0 +1,298 @@
+
+#########################################################
+### Label accessors
+#########################################################
+
+##' Labels for phylo4/phylo4d objects
+##'
+##' Methods for creating, accessing and updating labels in
+##' phylo4/phylo4d objects
+##'
+##' In phylo4/phylo4d objects, tips must have labels (that's why there
+##' is no method for hasTipLabels), internal nodes and edges can have
+##' labels.
+##'
+##' Labels must be provided as a vector of class \code{character}. The
+##' length of the vector must match the number of elements they label.
+##'
+##' The option \code{use.names} allows the user to match a label to a
+##' particular node. In this case, the vector must have names that
+##' match the node numbers.
+##'
+##' The function \code{labels} is mostly intended to be used
+##' internally.
+##'
+##' @name phylo4-labels
+##' @aliases labels
+##' @docType methods
+##' @param x a phylo4 or phylo4d object.
+##' @param object a phylo4 or phylo4d object.
+##' @param type which type of labels: \code{all} (tips and internal nodes),
+##' \code{tip} (tips only), \code{internal} (internal nodes only).
+##' @param \dots additional optional arguments (not in use)
+##' @param value a vector of class \code{character}, see Details for more
+##' information.
+##' @param use.names should the names of the vector used to create/update labels
+##' be used to match the labels? See Details for more information.
+##' @section Methods: \describe{ \item{labels}{\code{signature(object =
+##' "phylo4")}: tip and/or internal node labels, ordered by node ID}
+##'
+##' \item{hasDuplicatedLabels}{\code{signature(object = "phylo4")}: are any
+##' labels duplicated?}
+##'
+##' \item{tipLabels}{\code{signature(object = "phylo4")}: tip labels, ordered by
+##' node ID}
+##'
+##' \item{hasNodeLabels}{\code{signature(object = "phylo4")}: whether tree has
+##' (internal) node labels} \item{nodeLabels}{\code{signature(object =
+##' "phylo4")}: internal node labels, ordered by node ID}
+##'
+##' \item{hasEdgeLabels}{\code{signature(object = "phylo4")}: whether tree has
+##' (internal) edge labels} \item{edgeLabels}{\code{signature(object =
+##' "phylo4")}: internal edge labels, ordered according to the edge matrix} }
+##' @exportMethod labels
+##' @rdname labels-methods
+##' @include phylo4-class.R phylo4-methods.R phylo4-accessors.R nodeId-methods.R
+##' @author Ben Bolker, Peter Cowan, Steve Kembel, Francois Michonneau
+##' @return labels in ascending order.
+##' @examples
+##'
+##' data(geospiza)
+##'
+##' ## Return labels from geospiza
+##' tipLabels(geospiza)
+##'
+##' ## Internal node labels in geospiza are empty
+##' nodeLabels(geospiza)
+##'
+##' ## Creating internal node labels
+##' ndLbl <- paste("n", 1:nNodes(geospiza), sep="")
+##' nodeLabels(geospiza) <- ndLbl
+##' nodeLabels(geospiza)
+##'
+##' ## naming the labels
+##' names(ndLbl) <- nodeId(geospiza, "internal")
+##'
+##' ## shuffling the labels
+##' (ndLbl <- sample(ndLbl))
+##'
+##' ## by default, the labels are attributed in the order
+##' ## they are given:
+##' nodeLabels(geospiza) <- ndLbl
+##' nodeLabels(geospiza)
+##'
+##' ## but use.names puts them in the correct order
+##' labels(geospiza, "internal", use.names=TRUE) <- ndLbl
+##' nodeLabels(geospiza)
+setGeneric("labels")
+
+##' @rdname labels-methods
+##' @aliases labels,phylo4-method
+setMethod("labels", signature(object="phylo4"),
+ function(object, type = c("all", "tip", "internal")) {
+ type <- match.arg(type)
+ ## [JR: below, using match for ordering rather than direct character
+ ## indexing b/c the latter is slow for vectors of a certain size]
+ label <- object at label
+ id <- nodeId(object, type)
+ lbl <- label[match(id, names(label))]
+ # reassign names b/c any unmatched will be NA (could instead assign
+ # names only to the unmatched ones, but this seems simpler)
+ names(lbl) <- id
+ return(lbl)
+})
+
+##' @rdname labels-methods
+##' @export
+setGeneric("labels<-",
+ function(x, type, use.names, ..., value) {
+ standardGeneric("labels<-")
+ })
+
+##' @rdname labels-methods
+setReplaceMethod("labels",
+ signature(x="phylo4", type="ANY",
+ use.names="ANY", value="ANY"),
+ function(x, type = c("all", "tip", "internal"),
+ use.names, ..., value) {
+
+ ## Default options
+ if(missing(type))
+ type <- "all"
+ if (missing(use.names))
+ use.names <- FALSE
+
+ type <- match.arg(type)
+
+ ## generate new labels of the desired type
+ new.label <- .createLabels(value, nTips(x), nNodes(x), use.names,
+ type=type)
+
+ ## replace existing labels and add new ones as needed
+ old.label <- x at label
+ old.index <- match(names(new.label), names(old.label))
+ isNew <- is.na(old.index)
+ old.label[old.index[!isNew]] <- new.label[!isNew]
+ updated.label <- c(old.label, new.label[isNew])
+
+ ## for efficiency, drop any NA labels
+ x at label <- updated.label[!is.na(updated.label)]
+
+ if(is.character(checkval <- checkPhylo4(x)))
+ stop(checkval)
+ else
+ return(x)
+ })
+
+##### -------- hasDuplicatedLabels
+
+##' @rdname labels-methods
+##' @aliases hasDuplicatedLabels
+##' @export
+setGeneric("hasDuplicatedLabels",
+ function(x, type) {
+ standardGeneric("hasDuplicatedLabels")
+ })
+
+##' @rdname labels-methods
+##' @aliases hasDuplicatedLabels,phylo4,ANY-method
+setMethod("hasDuplicatedLabels", signature(x="phylo4", type="ANY"),
+ function(x, type=c("all", "tip", "internal")) {
+ ## Default options
+ if (missing(type)) {
+ type <- "all"
+ }
+ type <- match.arg(type)
+ hasDuplicatedLabelsCpp(labels(x, type))
+})
+
+##### --------- hasNodeLabels
+
+##' @rdname labels-methods
+##' @aliases hasNodeLabels
+##' @export
+setGeneric("hasNodeLabels", function(x) {
+ standardGeneric("hasNodeLabels")
+})
+
+##' @rdname labels-methods
+##' @aliases hasNodeLabels,phylo4-method
+setMethod("hasNodeLabels", signature(x="phylo4"),
+ function(x) {
+ !all(is.na(nodeLabels(x)))
+})
+
+##### ---------- nodeLabels
+
+##' @rdname labels-methods
+##' @aliases nodeLabels
+##' @export
+setGeneric("nodeLabels", function(x) {
+ standardGeneric("nodeLabels")
+})
+
+##' @rdname labels-methods
+##' @aliases nodeLabels,phylo4-method
+setMethod("nodeLabels", signature(x="phylo4"),
+ function(x) {
+ labels(x, type="internal")
+})
+
+##' @rdname labels-methods
+##' @export
+setGeneric("nodeLabels<-",
+ function(x, ..., value) {
+ standardGeneric("nodeLabels<-")
+ })
+
+##' @rdname labels-methods
+setReplaceMethod("nodeLabels", signature(x="phylo4", value="ANY"),
+ function(x, ..., value) {
+ labels(x, type="internal", ...) <- value
+ if(is.character(checkval <- checkPhylo4(x))) stop(checkval)
+ x
+ })
+
+##### ---------- tipLabels
+
+##' @rdname labels-methods
+##' @aliases tipLabels
+##' @export
+setGeneric("tipLabels", function(x) {
+ standardGeneric("tipLabels")
+})
+
+##' @rdname labels-methods
+setMethod("tipLabels", signature(x="phylo4"),
+ function(x) {
+ labels(x, type="tip")
+ })
+
+##' @rdname labels-methods
+##' @export
+setGeneric("tipLabels<-",
+ function(x, ..., value) {
+ standardGeneric("tipLabels<-")
+})
+
+##' @rdname labels-methods
+setReplaceMethod("tipLabels", signature(x="phylo4", value="ANY"),
+ function(x, ..., value) {
+ labels(x, type="tip", ...) <- value
+ if(is.character(checkval <- checkPhylo4(x))) stop(checkval)
+ return(x)
+ })
+
+
+##### ---------- hasEdgeLabels
+
+##' @rdname labels-methods
+##' @aliases hasEdgeLabels
+##' @export
+setGeneric("hasEdgeLabels", function(x) {
+ standardGeneric("hasEdgeLabels")
+})
+
+##' @rdname labels-methods
+setMethod("hasEdgeLabels", signature(x="phylo4"),
+ function(x) {
+ !all(is.na(x at edge.label))
+})
+
+##### ---------- edgeLabels
+
+##' @rdname labels-methods
+##' @aliases edgeLabels
+##' @export
+setGeneric("edgeLabels", function(x) {
+ standardGeneric("edgeLabels")
+})
+
+##' @rdname labels-methods
+##' @aliases edgeLabels,phylo4-method
+setMethod("edgeLabels", signature(x="phylo4"),
+ function(x) {
+ ## [JR: below, using match for ordering rather than direct character
+ ## indexing b/c the latter is slow for vectors of a certain size]
+ id <- edgeId(x, "all")
+ lbl <- x at edge.label[match(id, names(x at edge.label))]
+ names(lbl) <- id
+ return(lbl)
+})
+
+##' @rdname labels-methods
+##' @aliases edgeLabels<-
+##' @export
+setGeneric("edgeLabels<-",
+ function(x, ..., value) {
+ standardGeneric("edgeLabels<-")
+ })
+
+##' @rdname labels-methods
+setReplaceMethod("edgeLabels", signature(x="phylo4", value="ANY"),
+ function(x, ..., value) {
+ lbl <- .createEdge(value, x at edge, type="labels")
+ x at edge.label <- lbl[!is.na(lbl)]
+ if(is.character(checkval <- checkPhylo4(x))) stop(checkval)
+ x
+ })
diff --git a/R/multiphylo4-class.R b/R/multiphylo4-class.R
new file mode 100644
index 0000000..e87fb8e
--- /dev/null
+++ b/R/multiphylo4-class.R
@@ -0,0 +1,53 @@
+## classes for holding multiple tree objects
+
+##' multiPhylo4 and extended classes
+##'
+##' Classes for lists of phylogenetic trees. These classes and methods are
+##' planned for a future version of \code{phylobase}.
+##'
+##'
+##' @name multiPhylo-class
+##' @aliases multiPhylo-class multiPhylo4-class multiPhylo4d-class tbind
+##' @docType class
+##' @keywords classes
+## @export
+setClass("multiPhylo4", representation(phylolist = "list",
+ tree.names = "character"), prototype = list(phylolist = list(),
+ tree.names = character(0)))
+
+setClass("multiPhylo4d", representation(tip.data = "data.frame"),
+ contains = "multiPhylo4")
+
+setMethod("initialize", "multiPhylo4", function(.Object, ...) {
+ message("multiPhylo and multiphylo4d not yet implemented",
+ "Try using a list of phylo4(d) objects and lapply().")
+})
+
+##' multiPhylo4 and extended classes
+##'
+##' Classes for lists of phylogenetic trees. These classes and methods are
+##' planned for a future version of \code{phylobase}.
+##'
+##'
+##' @name multiPhylo-class
+##' @aliases multiPhylo-class multiPhylo4-class multiPhylo4d-class tbind
+##' @docType class
+##' @keywords classes
+setAs("multiPhylo", "multiPhylo4", function(from, to) {
+ trNm <- names(from)
+ if(is.null(trNm)) trNm <- character(0)
+ newobj <- new("multiPhylo4", phylolist = lapply(from, function(x)
+ as(x, "phylo4")),
+ tree.names = trNm)
+ newobj
+})
+
+
+setAs("multiPhylo4", "multiPhylo", function(from, to) {
+ y <- lapply(from at phylolist, function(x) as(x, "phylo"))
+ names(y) <- from at tree.names
+ if (hasTipData(from))
+ warning("discarded tip data")
+ class(y) <- "multiPhylo"
+ y
+})
diff --git a/R/nodeId-methods.R b/R/nodeId-methods.R
new file mode 100644
index 0000000..a5c430f
--- /dev/null
+++ b/R/nodeId-methods.R
@@ -0,0 +1,100 @@
+
+##' nodeId methods
+##'
+##' These functions gives the node (\code{nodeId}) or edge
+##' (\code{edgeId}) identity.
+##'
+##' \code{nodeId} returns the node in ascending order, and
+##' \code{edgeId} in the same order as the edges are stored in the
+##' edge matrix.
+##'
+##' @param x a \code{phylo4} or \code{phylo4d} object.
+##' @param type a character vector indicating which subset of the
+##' nodes or edges you are interested in.
+##' @return \describe{
+##' \item{nodeId}{an integer vector indicating node numbers}
+##' \item{edgeId}{a character vector indicating the edge identity}
+##' }
+##' @export
+##' @docType methods
+##' @rdname nodeId-methods
+##' @include phylo4-class.R phylo4-methods.R phylo4-accessors.R root-methods.R
+##' @examples
+##' data(geospiza)
+##' identical(nodeId(geospiza, "tip"), 1:nTips(geospiza))
+##' nodeId(geospiza, "internal")
+##' edgeId(geospiza, "internal")
+##' nodeId(geospiza, "root")
+setGeneric("nodeId", function(x, type=c("all", "tip", "internal",
+ "root")) {
+ standardGeneric("nodeId")
+})
+
+##' @rdname nodeId-methods
+##' @aliases nodeId,phylo4-method
+setMethod("nodeId", signature(x="phylo4"),
+ function(x, type=c("all",
+ "tip","internal","root")) {
+
+ type <- match.arg(type)
+ E <- edges(x)
+
+ ## Note: this implementation will still work even if tips are not
+ ## 1:nTips and nodes are not (nTips+1):nNodes
+ nid <- switch(type,
+ ## all nodes appear at least once in the edge matrix
+ ## twice slower: all = unique(as.vector(E)[as.vector(E) != 0]),
+ ## but maybe should be used if tree is not "normal"
+ all = {
+ if (isRooted(x)) {
+ res <- getAllNodesFast(x at edge)[-1]
+ }
+ else {
+ res <- getAllNodesFast(x at edge)
+ }
+ res
+ },
+ ## tips are nodes that do not appear in the ancestor column
+ ## three times slower: setdiff(E[, 2], E[, 1]),
+ tip = tipsFast(x at edge[,1]),
+ ## internals are nodes that *do* appear in the ancestor column
+ ## about 0.5 faster than: setdiff(getAllNodesFast(x at edge, isRooted(x)), tipsFast(x at edge[,1])),
+ internal = unique(E[E[, 1] != 0, 1]),
+ ## roots are nodes that have NA as ancestor
+ root = if (!isRooted(x)) return(NA) else unname(E[E[, 1] == 0, 2]))
+
+ return(sort(nid))
+
+})
+
+#### ----- edgeId
+
+##' @rdname nodeId-methods
+##' @aliases edgeId
+##' @export
+setGeneric("edgeId", function(x, type=c("all", "tip", "internal",
+ "root")) {
+ standardGeneric("edgeId")
+})
+
+##' @rdname nodeId-methods
+##' @aliases edgeId,phylo4-method
+setMethod("edgeId", signature(x="phylo4"),
+ function(x, type=c("all", "tip",
+ "internal", "root")) {
+ type <- match.arg(type)
+ edge <- edges(x)
+ if (type=="tip") {
+ isTip <- !(edge[, 2] %in% edge[, 1])
+ edge <- edge[isTip, , drop=FALSE]
+ } else if (type=="internal") {
+ isInt <- (edge[, 2] %in% edge[, 1])
+ edge <- edge[isInt, , drop=FALSE]
+ } else if (type=="root") {
+ isRoot <- edge[, 1] == 0
+ edge <- edge[isRoot, , drop=FALSE]
+ } # else just use complete edge matrix if type is "all"
+ id <- paste(edge[, 1], edge[, 2], sep="-")
+ return(id)
+})
+
diff --git a/R/oldclasses-class.R b/R/oldclasses-class.R
new file mode 100644
index 0000000..0c76fd6
--- /dev/null
+++ b/R/oldclasses-class.R
@@ -0,0 +1,13 @@
+## This file contains the old class definitions needed
+## better interoperation with other packages
+
+
+## ape classes
+setOldClass("phylo")
+
+setOldClass("multiPhylo")
+
+## setOldClass("multi.tree") ## obsolete
+
+## ade4 classes
+setOldClass("phylog")
diff --git a/R/pdata.R b/R/pdata.R
new file mode 100644
index 0000000..57bfde0
--- /dev/null
+++ b/R/pdata.R
@@ -0,0 +1,149 @@
+## define class for traits
+ptypes <- c("multitype","binary","continuous","DNA","RNA","aacid",
+ "other","unknown")
+
+##' Class "pdata"
+##'
+##' Data class for phylo4d objects
+##'
+##'
+##' @name pdata-class
+##' @aliases ptypes pdata-class [<-,pdata-method [,pdata-method
+##' [,pdata,ANY,ANY,ANY-method [[,pdata-method [[<-,pdata-method
+##' [[,pdata,ANY,ANY-method [[,pdata,ANY,missing-method
+##' @docType class
+##' @section Objects from the Class: Objects can be created by calls of the form
+##' \code{new("pdata", ...)}.
+##' @author Ben Bolker
+##' @keywords classes
+#### @export
+setClass("pdata", representation(data="data.frame",
+ type="factor",
+ comment="character",
+ metadata="list"),
+ prototype=list(data=data.frame(),type=factor(),
+ comment=character(0),metadata=list()))
+
+## pdata constructor
+
+
+##' Constructor for pdata (phylogenetic data) class
+##'
+##' Combine data, type, comments, and metadata information to create a new pdata
+##' object, or check such an object for consistency
+##'
+##'
+##' @aliases pdata check_pdata
+##' @param data a data frame
+##' @param type a factor with levels as specified by \linkS4class{pdata}, the
+##' same length as \code{ncol(data)}
+##' @param comment a character vector, the same length as \code{ncol(data)}
+##' @param metadata an arbitrary list
+## @param object an object of class \code{pdata}
+##' @return An object of class \code{pdata}
+##' @author Ben Bolker
+##' @seealso \linkS4class{pdata}
+##' @keywords misc
+pdata <- function(data,type,comment,metadata) {
+ nvar <- ncol(data)
+ if (missing(type)) {
+ type <- factor(rep("unknown",nvar),levels=ptypes)
+ }
+ if (length(type)==1) type <- rep(type,length.out=nvar)
+ type <- factor(as.character(type),levels=ptypes)
+ if (length(comment)==1) comment <- rep(comment,length.out=nvar)
+ obj <- new("pdata",data=data,type=type,comment=comment,metadata)
+ check_pdata(obj)
+ obj
+}
+
+
+check_pdata <- function(object) {
+ nvar <- ncol(object at data)
+ badlevels <- levels(object at type)[!levels(object at type) %in% ptypes]
+ if (length(badlevels)>0)
+ stop(paste("bad levels in types:",paste(badlevels,collapse=",")))
+ if (length(object at comment)>1 && length(object at comment)!=nvar) {
+ stop("wrong number of comments")
+ }
+ if (length(object at type)>1 && length(object at type)!=nvar) {
+ stop("wrong number of types")
+ }
+}
+
+## setMethod("[","pdata",function(x,i, j,...,drop=FALSE) {
+## xd <- x at data[i,j,...,drop=drop]
+## xd2 <- as.data.frame(xd)
+## xd2
+## })
+
+## #### @exportMethod [<-
+## setGeneric("[<-")
+
+## setMethod("[<-","pdata",function(x,i, j,...,drop=FALSE,value) {
+## "[<-"(x at data,i,j,...,drop=drop,value)
+## })
+
+## ### @exportMethod [[
+## setGeneric("[[")
+## setMethod("[[","pdata",
+## function(x,i,j,...,exact=NA) {
+## x at data[[i,j,...,exact=exact]]
+## })
+
+## #### @exportMethod [[<-
+## setGeneric("[[<-")
+## setMethod("[[<-","pdata",
+## function(x,i,j,...,exact=NA,value) {
+## "[[<-"(x at data,i,j,...,exact=exact,value)
+## })
+
+## setMethod("plot",signature(x="pdata",y="missing"), function(x,...){
+## return(plot(x at data, ...))
+## }) # end plot phylo4
+
+
+## od = data.frame(a=1:3,b=4:6)
+## z = new("pdata",
+## data=od,type=factor("a","b"),
+## comment=c("",""),metadata=list())
+
+## z[2,]
+## z[,"a"]
+## z[[2]]
+
+## test conflict resolution error
+
+#######
+### old code retrieved from misc/ folder
+
+## setClass("pdata", representation(x="vector", y="vector"))
+## setMethod("[","pdata",function(x,i, j,...,drop=TRUE)new("pdata",x=x at x[i],y=x at y[i]))
+
+# x <- new("pdata", x=c("a","b", "c", "d", "3"), y=c(1:5))
+#>x[c(2,4)]
+#An object of class pdata
+#Slot "x":
+#[1] "b" "d"
+#
+#Slot "y":
+#[1] 2 4
+
+
+
+# doesn't work
+#setClass("track", representation("list", comment="character", metadata="vector"), contains="list", prototype(list(), comment="", metadata=NA))
+#setMethod("[","track",function(x,i, j,...,drop=TRUE)new("track", list(lapply(x, function(x, i, j, ..., drop=TRUE) x at .Data[i]))))
+
+# this works, how to incorporate into method above?
+#> lapply(x, function(x, i=2, j, ..., drop=TRUE) x at .Data[i])
+#$x
+#[1] "b"
+
+#$y
+#[1] 2
+
+# this works, but list structure is destroyed
+#> mapply(function(x, i, j, ..., drop=TRUE) x at .Data[i], x, 2)
+# x y
+#"b" "2"
diff --git a/R/phylo4-accessors.R b/R/phylo4-accessors.R
new file mode 100644
index 0000000..fed8efb
--- /dev/null
+++ b/R/phylo4-accessors.R
@@ -0,0 +1,177 @@
+
+##' Number of tips, nodes and edges found in a tree.
+##'
+##' Function to return the number of tips, nodes and edges found in a
+##' tree in the \code{phylo4} or \code{phylo4d} format.
+##' @title nTips, nNodes, nEdges
+##' @aliases nTips
+##' @param x a \code{phylo4} or \code{phylo4d} object
+##' @return a numeric vector indicating the number of tips, nodes or
+##' edge respectively.
+##' @docType methods
+##' @export
+##' @include phylo4-class.R phylo4-methods.R
+##' @include oldclasses-class.R
+##' @rdname nTips-methods
+setGeneric("nTips", function(x) {
+ standardGeneric("nTips")
+})
+
+##' @rdname nTips-methods
+##' @aliases nTips,phylo4-method
+setMethod("nTips", signature(x="phylo4"), function(x) {
+ E <- edges(x)
+ if(nrow(E) == 0)
+ return(0)
+ else {
+ ## at this time NAs are not allowed in edge matrix
+ ## sum(tabulate(E[, 1]) == 0)
+ nTipsFastCpp(E[, 1])
+ }
+})
+
+##' @rdname nTips-methods
+##' @aliases nTips,phylo-method
+setMethod("nTips", signature(x="phylo"),
+ function(x) {
+ Ntip(x)
+})
+
+##' @rdname nTips-methods
+##' @aliases nNodes
+##' @export
+setGeneric("nNodes", function(x) {
+ standardGeneric("nNodes")
+})
+
+##' @rdname nTips-methods
+##' @aliases nNodes,phylo4-method
+setMethod("nNodes", signature(x="phylo4"), function(x) {
+ E <- edges(x, drop.root=TRUE)
+ if(nrow(E) == 0) {
+ return(0)
+ } else {
+ return(length(unique(E[, 1])))
+ }
+})
+
+##' @rdname nTips-methods
+##' @aliases nEdges
+##' @export
+setGeneric("nEdges", function(x) {
+ standardGeneric("nEdges")
+})
+
+##' @rdname nTips-methods
+##' @aliases nEdges,phylo4-method
+setMethod("nEdges", signature(x="phylo4"),
+ function(x) {
+ nrow(x at edge)
+})
+
+
+#########################################################
+### Edge accessors
+#########################################################
+
+##' Edges accessors
+##'
+##' Access or modify information about the edges.
+##'
+##' @param x a \code{phylo4} or \code{phylo4d} object.
+##' @param drop.root logical (default FALSE), should the edge
+##' connecting the root be included in the edge matrix?
+##' @param \dots Optional arguments used by specific methods. (None
+##' used at present).
+##' @return \describe{
+##' \item{\code{edges}}{returns the edge matrix that represent the
+##' ancestor-descendant relationships among the nodes of the tree.}
+##'
+##' \item{\code{edgeOrder}}{returns the order in which the edge matrix
+##' is in.}
+##'
+##' \item{\code{internalEdges}}{returns a logical vector indicating
+##' internal edges (edges that connect an internal node to
+##' another). This vector is named with the \code{edgeId}}.
+##'
+##' \item{\code{terminalEdges}}{returns a logical vector indicating
+##' terminal edges (edges that connect an internal node to a
+##' tip). This vector is named with the \code{edgeId} }}
+##' @author Ben Bolker, Francois Michonneau, Thibaut Jombart
+##' @seealso reorder, edgeId
+##' @examples
+##' data(geospiza)
+##' edges(geospiza)
+##' edgeOrder(geospiza)
+##' geoPost <- reorder(geospiza, "postorder")
+##' edgeOrder(geoPost)
+##' ## with a binary tree this should always be true
+##' identical(!terminalEdges(geospiza), internalEdges(geospiza))
+##' @export
+##' @docType methods
+##' @rdname edges-accessors
+##' @include phylo4-methods.R
+setGeneric("edges", function(x, ...) {
+ standardGeneric("edges")
+})
+
+##' @rdname edges-accessors
+##' @aliases edges,phylo4-method
+setMethod("edges", signature(x="phylo4"),
+ function(x, drop.root=FALSE) {
+ e <- x at edge
+ if (drop.root) e <- e[e[, 1] != 0, ]
+ e
+})
+
+##### -------- edgeOrder
+
+##' @rdname edges-accessors
+##' @aliases edgeOrder
+##' @export
+setGeneric("edgeOrder", function(x, ...) {
+ standardGeneric("edgeOrder")
+})
+
+##' @rdname edges-accessors
+##' @aliases edgeOrder,phylo4-method
+setMethod("edgeOrder", signature(x="phylo4"),
+ function(x) {
+ x at order
+})
+
+##### -------- internalEdges
+
+##' @rdname edges-accessors
+##' @aliases internalEdges
+##' @export
+setGeneric("internalEdges", function(x) {
+ standardGeneric("internalEdges")
+})
+
+##' @rdname edges-accessors
+##' @aliases internalEdges,phylo4-method
+setMethod("internalEdges", signature(x="phylo4"),
+ function(x) {
+ res <- edges(x)[, 2] %in% nodeId(x, "internal")
+ names(res) <- edgeId(x, "all")
+ res
+})
+
+##### -------- terminalEdges
+
+##' @rdname edges-accessors
+##' @aliases terminalEdges
+##' @export
+setGeneric("terminalEdges", function(x) {
+ standardGeneric("terminalEdges")
+})
+
+##' @rdname edges-accessors
+##' @aliases terminalEdges,phylo4-method
+setMethod("terminalEdges", signature(x="phylo4"),
+ function(x) {
+ res <- edges(x)[, 2] %in% nodeId(x, "tip")
+ names(res) <- edgeId(x, "all")
+ res
+})
diff --git a/R/phylo4-class.R b/R/phylo4-class.R
new file mode 100644
index 0000000..b1d50a5
--- /dev/null
+++ b/R/phylo4-class.R
@@ -0,0 +1,35 @@
+##' The phylo4 class
+##'
+##' Classes for phylogenetic trees
+##'
+##' @name phylo4-class
+##' @docType class
+##' @section Objects from the Class: Phylogenetic tree objects can be created by
+##' calls to the \code{\link{phylo4}} constructor function. Translation
+##' functions from other phylogenetic packages are also available. See
+##' \code{\link{coerce-methods}}.
+##' @author Ben Bolker, Thibaut Jombart
+##' @seealso The \code{\link{phylo4-methods}} constructor, the
+##' \code{\link{checkPhylo4}} function to check the validity of
+##' \code{phylo4} objects. See also the \code{\link{phylo4d-methods}}
+##' constructor and the \linkS4class{phylo4d} class.
+##' @keywords classes
+##' @include RcppExports.R checkdata.R
+##' @export
+setClass("phylo4",
+ representation(edge = "matrix",
+ edge.length = "numeric",
+ label = "character",
+ edge.label = "character",
+ order = "character",
+ annote = "list"),
+ prototype = list(
+ edge = matrix(nrow = 0, ncol = 2,
+ dimname = list(NULL, c("ancestor", "descendant"))),
+ edge.length = numeric(0),
+ label = character(0),
+ edge.label = character(0),
+ order = "unknown",
+ annote = list()
+ ),
+ validity = checkPhylo4)
diff --git a/R/phylo4-methods.R b/R/phylo4-methods.R
new file mode 100644
index 0000000..a936c7f
--- /dev/null
+++ b/R/phylo4-methods.R
@@ -0,0 +1,178 @@
+
+##' Create a phylogenetic tree
+##'
+##' \code{phylo4} is a generic constructor that creates a phylogenetic tree
+##' object for use in phylobase methods. Phylobase contains functions for input
+##' of phylogenetic trees and data, manipulation of these objects including
+##' pruning and subsetting, and plotting. The phylobase package also contains
+##' translation functions to forms used in other comparative phylogenetic method
+##' packages.
+##'
+##' The minimum information necessary to create a phylobase tree object is a
+##' valid edge matrix. The edge matrix describes the topology of the phylogeny.
+##' Each row describes a branch of the phylogeny, with the (descendant) node
+##' number in column 2 and its ancestor's node number in column 1. These numbers
+##' are used internally and must be unique for each node.
+##'
+##' The labels designate either nodes or edges. The vector \code{node.label}
+##' names internal nodes, and together with \code{tip.label}, name all nodes in
+##' the tree. The vector \code{edge.label} names all branches in the tree. All
+##' label vectors are optional, and if they are not given, internally-generated
+##' labels will be assigned. The labels, whether user-specified or internally
+##' generated, must be unique as they are used to join species data with
+##' phylogenetic trees.
+##'
+##' \code{phylobase} also allows to create \code{phylo4} objects using
+##' the function \code{phylo4()} from objects of the classes:
+##' \code{phylo} (from \code{ape}), and \code{nexml} (from \code{RNeXML}).
+##'
+##' @name phylo4-methods
+##' @docType methods
+##' @param x a matrix of edges or an object of class \code{phylo} (see above)
+##' @param edge A numeric, two-column matrix with as many rows as branches in
+##' the phylogeny.
+##' @param edge.length Edge (branch) length. (Optional)
+##' @param tip.label A character vector of species names (names of "tip" nodes).
+##' (Optional)
+##' @param node.label A character vector of internal node names. (Optional)
+##' @param edge.label A character vector of edge (branch) names. (Optional)
+##' @param order character: tree ordering (allowable values are listed in
+##' \code{phylo4_orderings}, currently "unknown", "preorder" (="cladewise" in
+##' \code{ape}), and "postorder", with "cladewise" and "pruningwise" also
+##' allowed for compatibility with \code{ape})
+##' @param check.node.labels if \code{x} is of class \code{phylo}, either "keep"
+##' (the default) or "drop" node labels. This argument is useful if the
+##' \code{phylo} object has non-unique node labels.
+##' @param annote any additional annotation data to be passed to the new object
+##' @param \dots optional arguments (none used at present).
+##' @note Translation functions are available from many valid tree formats. See
+##' \link{coerce-methods}.
+##' @author phylobase team
+##' @seealso \code{\link{coerce-methods}} for translation
+##' functions. The \linkS4class{phylo4} class. See also the
+##' \code{\link{phylo4d-methods}} constructor, and
+##' \linkS4class{phylo4d} class.
+##' @export
+##' @aliases phylo4
+##' @rdname phylo4-methods
+##' @include internal-constructors.R phylo4-class.R oldclasses-class.R
+##' @examples
+##'
+##' # a three species tree:
+##' mytree <- phylo4(x=matrix(data=c(4,1, 4,5, 5,2, 5,3, 0,4), ncol=2,
+##' byrow=TRUE), tip.label=c("speciesA", "speciesB", "speciesC"))
+##' mytree
+##' plot(mytree)
+##'
+##' # another way to specify the same tree:
+##' mytree <- phylo4(x=cbind(c(4, 4, 5, 5, 0), c(1, 5, 2, 3, 4)),
+##' tip.label=c("speciesA", "speciesB", "speciesC"))
+##'
+##' # another way:
+##' mytree <- phylo4(x=rbind(c(4, 1), c(4, 5), c(5, 2), c(5, 3), c(0, 4)),
+##' tip.label=c("speciesA", "speciesB", "speciesC"))
+##'
+##' # with branch lengths:
+##' mytree <- phylo4(x=rbind(c(4, 1), c(4, 5), c(5, 2), c(5, 3), c(0, 4)),
+##' tip.label=c("speciesA", "speciesB", "speciesC"), edge.length=c(1, .2,
+##' .8, .8, NA))
+##' plot(mytree)
+##'
+setGeneric("phylo4", function(x, ...) { standardGeneric("phylo4")} )
+
+## ape orderings should be allowed for so we can import trees from ape
+## e.g. during subsetting
+##' @rdname phylo4-methods
+##' @aliases phylo4_orderings
+phylo4_orderings <- c("unknown", "preorder", "postorder",
+ "pruningwise", "cladewise")
+
+##' @rdname phylo4-methods
+##' @aliases phylo4,matrix-method
+setMethod("phylo4", "matrix",
+ function(x, edge.length = NULL, tip.label = NULL, node.label = NULL,
+ edge.label = NULL, order="unknown", annote = list()) {
+
+ ## edge
+ edge <- x
+ mode(edge) <- "integer"
+
+ if(ncol(edge) > 2)
+ warning("The edge matrix has more than two columns, ",
+ "only the first two columns are considered.")
+ edge <- as.matrix(edge[, 1:2])
+ colnames(edge) <- c("ancestor", "descendant")
+
+ ## create new phylo4 object and insert edge matrix
+ res <- new("phylo4")
+ res at edge <- edge
+
+ ## get number of tips and number of nodes
+ ## (these accessors work fine now that edge matrix exists)
+ ntips <- nTips(res)
+ nnodes <- nNodes(res)
+
+ ## edge.length (drop elements if all are NA but keep the vector named)
+ edge.length <- .createEdge(value=edge.length, edgeMat=edge, type="lengths",
+ use.names=FALSE)
+ if (all(is.na(edge.length))) {
+ edge.length <- numeric()
+ attributes(edge.length) <- list(names=character(0))
+ }
+
+ ## edge.label (drop NA elements)
+ edge.label <- .createEdge(value=edge.label, edgeMat=edge, type="labels",
+ use.names=FALSE)
+ edge.label <- edge.label[!is.na(edge.label)]
+
+ ## tip.label (leave NA elements; let checkTree complain about it)
+ tip.label <- .createLabels(value=tip.label, ntips=ntips, nnodes=nnodes,
+ type="tip")
+
+ ## node.label (drop NA elements)
+ node.label <- .createLabels(node.label, ntips=ntips, nnodes=nnodes,
+ type="internal")
+ node.label <- node.label[!is.na(node.label)]
+
+ ## populate the slots
+ res at edge.length <- edge.length
+ res at label <- c(tip.label, node.label)
+ res at edge.label <- edge.label
+ res at order <- order
+ res at annote <- annote
+
+ ## checkPhylo4 will return a character string if object is
+ ## bad, otherwise TRUE
+ if (is.character(checkval <- checkPhylo4(res))) stop(checkval)
+ return(res)
+})
+
+##' @rdname phylo4-methods
+##' @aliases phylo4,phylo-method
+setMethod("phylo4", c("phylo"), function(x, check.node.labels=c("keep",
+ "drop"), annote=list()){
+
+ check.node.labels <- match.arg(check.node.labels)
+ if (check.node.labels == "drop") x$node.label <- NULL
+ res <- as(x, "phylo4")
+ #TODO?: make default annote arg NULL, and only assign if !is.null;
+ # then update phylo4d methods accordingly (same thing with metadata?)
+ res at annote <- annote
+
+ return(res)
+})
+
+##' @rdname phylo4-methods
+##' @aliases nexml,phylo4-method
+setMethod("phylo4", c("nexml"), function(x) {
+ tr <- RNeXML::get_trees_list(x)
+ if (is.null(tr)) {
+ new("phylo4")
+ }
+ else {
+ if (length(tr) > 1) {
+ warning("Only the first tree has been imported.")
+ }
+ phylo4(x=tr[[1]][[1]])
+ }
+})
diff --git a/R/phylo4d-accessors.R b/R/phylo4d-accessors.R
new file mode 100644
index 0000000..ac5ac92
--- /dev/null
+++ b/R/phylo4d-accessors.R
@@ -0,0 +1,82 @@
+
+##' Tests for presence of data associated with trees stored as phylo4d objects
+##'
+##' Methods that test for the presence of data associated with trees stored as
+##' \code{phylo4d} objects.
+##'
+##' \code{nData} tests for the presence of data associated with the object.
+##'
+##' \code{hasTipData} and \code{hasNodeData} tests for the presence of
+##' data associated with the tips and the internal nodes
+##' respectively. The outcome of the test is based on row names of the
+##' data frame stored in the \code{data} slot. If no rows have names
+##' from the set \code{nodeId(x, "tip")}, then \code{hasTipData}
+##' returns FALSE. Likewise, if no rows have names from the set
+##' \code{nodeId(x, "internal")}, then \code{hasNodeData} returns
+##' FALSE.
+##'
+##' @param x a \code{phylo4d} object
+##' @return \describe{
+##'
+##' \item{\code{nData}}{returns the number of datasets (i.e.,
+##' columns) associated with the object.}
+##'
+##' \item{\code{hasTipData}, \code{hasNodeData}}{return \code{TRUE}
+##' or \code{FALSE} depending whether data associated with the
+##' tree are associated with either tips or internal nodes respectively.}}
+##' @section Methods: \describe{ \item{hasNodeData}{\code{signature(object =
+##' "phylo4d")}: whether tree has internal node data}
+##' \item{hasTipData}{\code{signature(object = "phylo4d")}: whether tree has
+##' data associated with its tips} }
+##' @author Ben Bolker, Thibault Jombart, Francois Michonneau
+##' @seealso \code{\link{phylo4d-methods}} constructor and
+##' \code{\linkS4class{phylo4d}} class.
+##' @rdname phylo4d-accessors
+##' @aliases hasTipData
+##' @keywords methods
+##' @docType methods
+##' @include phylo4d-class.R phylo4d-methods.R
+##' @export
+##' @examples
+##' data(geospiza)
+##' nData(geospiza) ## 5
+##' hasTipData(geospiza) ## TRUE
+##' hasNodeData(geospiza) ## FALSE
+##'
+setGeneric("hasTipData", function(x) {
+ standardGeneric("hasTipData")
+})
+
+##' @rdname phylo4d-accessors
+##' @aliases hasTipData-method,phylo4d-method
+setMethod("hasTipData", signature(x="phylo4d"),
+ function(x) {
+ ncol(tdata(x, type="tip", empty.columns=FALSE)) > 0
+})
+
+##' @rdname phylo4d-accessors
+##' @aliases hasNodeData-methods
+##' @export
+setGeneric("hasNodeData", function(x) {
+ standardGeneric("hasNodeData")
+})
+
+##' @rdname phylo4d-accessors
+##' @aliases hasNodeData,phylo4d-method
+setMethod("hasNodeData", signature(x="phylo4d"),
+ function(x) {
+ ncol(tdata(x, type="internal", empty.columns=FALSE)) > 0
+})
+
+##' @rdname phylo4d-accessors
+##' @aliases nData
+##' @export
+setGeneric("nData", function(x) {
+ standardGeneric("nData")
+})
+
+##' @rdname phylo4d-accessors
+##' @aliases nData,phylo4d-method
+setMethod("nData", signature(x="phylo4d"), function(x) {
+ ncol(x at data)
+})
diff --git a/R/phylo4d-class.R b/R/phylo4d-class.R
new file mode 100644
index 0000000..aaaef19
--- /dev/null
+++ b/R/phylo4d-class.R
@@ -0,0 +1,39 @@
+###################################
+## phylo4d class
+## extend: phylo with data
+##' phylo4d class
+##'
+##' S4 class for phylogenetic tree and data.
+##'
+##'
+##' @name phylo4d-class
+##' @docType class
+##' @section Objects from the Class: Objects can be created from various trees
+##' and a data.frame using the constructor \code{phylo4d}, or using
+##' \code{new("phylo4d", \dots{})} for empty objects.
+##' @author Ben Bolker, Thibaut Jombart
+##' @seealso \code{\link{coerce-methods}} for translation
+##' functions. The \code{\link{phylo4d-methods}} constructor. See also
+##' the \code{\link{phylo4-methods}} constructor, the
+##' \linkS4class{phylo4} class, and the \code{\link{checkPhylo4}}
+##' function to check the validity of \code{phylo4} trees.
+##' @keywords classes
+##' @export
+##' @include phylo4-methods.R formatData.R
+##' @examples
+##' example(read.tree, "ape")
+##' obj <- phylo4d(as(tree.owls.bis,"phylo4"), data.frame(wing=1:3))
+##' obj
+##' names(obj)
+##' summary(obj)
+setClass("phylo4d",
+ representation(data="data.frame",
+ metadata = "list"),
+
+ prototype = list(
+ data = data.frame(NULL),
+ metadata = list()),
+
+ validity = checkPhylo4,
+ contains = "phylo4")
+
diff --git a/R/phylo4d-methods.R b/R/phylo4d-methods.R
new file mode 100644
index 0000000..b8948a0
--- /dev/null
+++ b/R/phylo4d-methods.R
@@ -0,0 +1,414 @@
+######################
+## phylo4d constructor
+######################
+
+## TEST ME
+## '...' recognized args for data are tipdata and nodedata.
+## other recognized options are those known by the phylo4 constructor
+
+
+##' Combine a phylogenetic tree with data
+##'
+##' \code{phylo4d} is a generic constructor which merges a
+##' phylogenetic tree with data frames to create a combined object of
+##' class \code{phylo4d}
+##'
+##' You can provide several data frames to define traits associated
+##' with tip and/or internal nodes. By default, data row names are
+##' used to link data to nodes in the tree, with any number-like names
+##' (e.g., \dQuote{10}) matched against node ID numbers, and any
+##' non-number-like names (e.g., \dQuote{n10}) matched against node
+##' labels. Alternative matching rules can be specified by passing
+##' additional arguments (listed in the Details section); these
+##' include positional matching, matching exclusively on node labels,
+##' and matching based on a column of data rather than on row
+##' names.
+##'
+##' Matching rules will apply the same way to all supplied data
+##' frames. This means that you need to be consistent with the row
+##' names of your data frames. It is good practice to use tip and
+##' node labels (or node numbers if you use duplicated labels) when
+##' you combine data with a tree.
+##'
+##' If you provide both \code{tip.data} and \code{node.data}, the
+##' treatment of columns with common names will depend on the
+##' \code{merge.data} argument. If TRUE, columns with the same name in
+##' both data frames will be merged; when merging columns of different
+##' data types, coercion to a common type will follow standard R
+##' rules. If \code{merge.data} is FALSE, columns with common names
+##' will be preserved independently, with \dQuote{.tip} and
+##' \dQuote{.node} appended to the names. This argument has no effect
+##' if \code{tip.data} and \code{node.data} have no column names in
+##' common.
+##'
+##' If you provide \code{all.data} along with either of
+##' \code{tip.data} and \code{node.data}, it must have distinct column
+##' names, otherwise an error will result. Additionally, although
+##' supplying columns with the same names \emph{within} data frames is
+##' not illegal, automatic renaming for uniqeness may lead to
+##' surprising results, so this practice should be avoided.
+##'
+##' @name phylo4d-methods
+##' @aliases phylo4d
+##' @param x an object of class \code{phylo4}, \code{phylo},
+##' \code{nexml} or a matrix of edges (see above)
+##' @param tip.data a data frame (or object to be coerced to one)
+##' containing only tip data (Optional)
+##' @param node.data a data frame (or object to be coerced to one)
+##' containing only node data (Optional)
+##' @param all.data a data frame (or object to be coerced to one)
+##' containing both tip and node data (Optional)
+##' @param merge.data if both \code{tip.data} and \code{node.data} are
+##' provided, should columns with common names will be merged together
+##' (default TRUE) or not (FALSE)? See details.
+##' @param metadata any additional metadata to be passed to the new object
+##' @param edge.length Edge (branch) length. (Optional)
+##' @param tip.label A character vector of species names (names of
+##' "tip" nodes). (Optional)
+##' @param node.label A character vector of internal node
+##' names. (Optional)
+##' @param edge.label A character vector of edge (branch)
+##' names. (Optional)
+##' @param order character: tree ordering (allowable values are listed
+##' in \code{phylo4_orderings}, currently "unknown", "preorder"
+##' (="cladewise" in \code{ape}), and "postorder", with "cladewise"
+##' and "pruningwise" also allowed for compatibility with \code{ape})
+##' @param annote any additional annotation data to be passed to the
+##' new object
+##' @param check.node.labels if \code{x} is of class \code{phylo}, use
+##' either \dQuote{keep} (the default) to retain internal node labels,
+##' \dQuote{drop} to drop them, or \dQuote{asdata} to convert them to
+##' numeric tree data. This argument is useful if the \code{phylo}
+##' object has non-unique node labels or node labels with informative
+##' data (e.g., posterior probabilities).
+##' @param \dots further arguments to control the behavior of the
+##' constructor in the case of missing/extra data and where to look
+##' for labels in the case of non-unique labels that cannot be stored
+##' as row names in a data frame (see Details).
+##' @details This is the list of additional arguments that can be used
+##' to control matching between the tree and the data:
+##'
+##' \itemize{
+##'
+##' \item{match.data}{(logical) should the rownames of the data frame
+##' be used to be matched against tip and internal node identifiers?}
+##'
+##' \item{rownamesAsLabels}{(logical), should the row names of the
+##' data provided be matched only to labels (TRUE), or should any
+##' number-like row names be matched to node numbers (FALSE and
+##' default)}
+##'
+##' \item{label.type}{character, \code{rownames} or \code{column}:
+##' should the labels be taken from the row names of \code{dt} or from
+##' the \code{label.column} column of \code{dt}?}
+##'
+##' \item{label.column}{iff \code{label.type=="column"}, column
+##' specifier (number or name) of the column containing tip labels}
+##'
+##' \item{missing.data}{action to take if there are missing data or if
+##' there are data labels that don't match}
+##'
+##' \item{extra.data}{action to take if there are extra data or if
+##' there are labels that don't match}
+##'
+##' \item{keep.all}{(logical), should the returned data have rows for
+##' all nodes (with NA values for internal rows when type='tip', and
+##' vice versa) (TRUE and default) or only rows corresponding to the
+##' type argument}
+##'
+##' }
+##'
+##' Rules for matching rows of data to tree nodes are determined
+##' jointly by the \code{match.data} and \code{rownamesAsLabels}
+##' arguments. If \code{match.data} is TRUE, data frame rows will be
+##' matched exclusively against tip and node labels if
+##' \code{rownamesAsLabels} is also TRUE, whereas any all-digit row
+##' names will be matched against tip and node numbers if
+##' \code{rownamesAsLabels} is FALSE (the default). If
+##' \code{match.data} is FALSE, \code{rownamesAsLabels} has no effect,
+##' and row matching is purely positional with respect to the order
+##' returned by \code{nodeId(phy, type)}.
+##'
+##' @return An object of class \linkS4class{phylo4d}.
+##' @note Checking on matches between the tree and the data will be
+##' done by the validity checker (label matches between data and tree
+##' tips, number of rows of data vs. number of nodes/tips/etc.)
+##' @section Methods: \describe{ \item{x = "phylo4"}{merges a tree of
+##' class \code{phylo4} with a data.frame into a \code{phylo4d}
+##' object} \item{x = "matrix"}{merges a matrix of tree edges similar
+##' to the edge slot of a \code{phylo4} object (or to \$edge of a
+##' \code{phylo} object) with a data.frame into a \code{phylo4d}
+##' object} \item{x = "phylo"}{merges a tree of class \code{phylo}
+##' with a data.frame into a \code{phylo4d} object } }
+##' @author Ben Bolker, Thibaut Jombart, Steve Kembel, Francois
+##' Michonneau, Jim Regetz
+##' @seealso \code{\link{coerce-methods}} for translation
+##' functions. The \linkS4class{phylo4d} class; \linkS4class{phylo4}
+##' class and \link{phylo4} constructor.
+##' @keywords misc
+##' @export
+##' @docType methods
+##' @rdname phylo4d-methods
+##' @include phylo4d-class.R
+##' @include oldclasses-class.R
+##' @examples
+##'
+##' treeOwls <- "((Strix_aluco:4.2,Asio_otus:4.2):3.1,Athene_noctua:7.3);"
+##' tree.owls.bis <- ape::read.tree(text=treeOwls)
+##' try(phylo4d(as(tree.owls.bis,"phylo4"),data.frame(wing=1:3)), silent=TRUE)
+##' obj <- phylo4d(as(tree.owls.bis,"phylo4"),data.frame(wing=1:3), match.data=FALSE)
+##' obj
+##' print(obj)
+##'
+##' ####
+##'
+##' data(geospiza_raw)
+##' geoTree <- geospiza_raw$tree
+##' geoData <- geospiza_raw$data
+##'
+##' ## fix differences in tip names between the tree and the data
+##' geoData <- rbind(geoData, array(, dim = c(1,ncol(geoData)),
+##' dimnames = list("olivacea", colnames(geoData))))
+##'
+##' ### Example using a tree of class 'phylo'
+##' exGeo1 <- phylo4d(geoTree, tip.data = geoData)
+##'
+##' ### Example using a tree of class 'phylo4'
+##' geoTree <- as(geoTree, "phylo4")
+##'
+##' ## some random node data
+##' rNodeData <- data.frame(randomTrait = rnorm(nNodes(geoTree)),
+##' row.names = nodeId(geoTree, "internal"))
+##'
+##' exGeo2 <- phylo4d(geoTree, tip.data = geoData, node.data = rNodeData)
+##'
+##' ### Example using 'merge.data'
+##' data(geospiza)
+##' trGeo <- extractTree(geospiza)
+##' tDt <- data.frame(a=rnorm(nTips(trGeo)), row.names=nodeId(trGeo, "tip"))
+##' nDt <- data.frame(a=rnorm(nNodes(trGeo)), row.names=nodeId(trGeo, "internal"))
+##'
+##' (matchData1 <- phylo4d(trGeo, tip.data=tDt, node.data=nDt, merge.data=FALSE))
+##' (matchData2 <- phylo4d(trGeo, tip.data=tDt, node.data=nDt, merge.data=TRUE))
+##'
+##' ## Example with 'all.data'
+##' nodeLabels(geoTree) <- as.character(nodeId(geoTree, "internal"))
+##' rAllData <- data.frame(randomTrait = rnorm(nTips(geoTree) + nNodes(geoTree)),
+##' row.names = labels(geoTree, 'all'))
+##'
+##' exGeo5 <- phylo4d(geoTree, all.data = rAllData)
+##'
+##' ## Examples using 'rownamesAsLabels' and comparing with match.data=FALSE
+##' tDt <- data.frame(x=letters[1:nTips(trGeo)],
+##' row.names=sample(nodeId(trGeo, "tip")))
+##' tipLabels(trGeo) <- as.character(sample(1:nTips(trGeo)))
+##' (exGeo6 <- phylo4d(trGeo, tip.data=tDt, rownamesAsLabels=TRUE))
+##' (exGeo7 <- phylo4d(trGeo, tip.data=tDt, rownamesAsLabels=FALSE))
+##' (exGeo8 <- phylo4d(trGeo, tip.data=tDt, match.data=FALSE))
+##'
+##' ## generate a tree and some data
+##' set.seed(1)
+##' p3 <- ape::rcoal(5)
+##' dat <- data.frame(a = rnorm(5), b = rnorm(5), row.names = p3$tip.label)
+##' dat.defaultnames <- dat
+##' row.names(dat.defaultnames) <- NULL
+##' dat.superset <- rbind(dat, rnorm(2))
+##' dat.subset <- dat[-1, ]
+##'
+##' ## create a phylo4 object from a phylo object
+##' p4 <- as(p3, "phylo4")
+##'
+##' ## create phylo4d objects with tip data
+##' p4d <- phylo4d(p4, dat)
+##' ###checkData(p4d)
+##' p4d.sorted <- phylo4d(p4, dat[5:1, ])
+##' try(p4d.nonames <- phylo4d(p4, dat.defaultnames))
+##' p4d.nonames <- phylo4d(p4, dat.defaultnames, match.data=FALSE)
+##'
+##' \dontrun{
+##' p4d.subset <- phylo4d(p4, dat.subset)
+##' p4d.subset <- phylo4d(p4, dat.subset)
+##' try(p4d.superset <- phylo4d(p4, dat.superset))
+##' p4d.superset <- phylo4d(p4, dat.superset)
+##' }
+##'
+##' ## create phylo4d objects with node data
+##' nod.dat <- data.frame(a = rnorm(4), b = rnorm(4))
+##' p4d.nod <- phylo4d(p4, node.data = nod.dat, match.data=FALSE)
+##'
+##'
+##' ## create phylo4 objects with node and tip data
+##' p4d.all1 <- phylo4d(p4, node.data = nod.dat, tip.data = dat, match.data=FALSE)
+##' nodeLabels(p4) <- as.character(nodeId(p4, "internal"))
+##' p4d.all2 <- phylo4d(p4, all.data = rbind(dat, nod.dat), match.data=FALSE)
+setGeneric("phylo4d", function(x, ...) { standardGeneric("phylo4d")} )
+
+## first arg is a phylo4
+##' @rdname phylo4d-methods
+##' @aliases phylo4d,phylo4,phylo4-method
+setMethod("phylo4d", "phylo4",
+ function(x, tip.data=NULL, node.data=NULL, all.data=NULL,
+ merge.data=TRUE, metadata = list(), ...) {
+ ## coerce tree to phylo4d
+ res <- as(x, "phylo4d")
+
+ ## apply formatData to ensure data have node number rownames and
+ ## correct dimensions
+ tip.data <- formatData(phy=x, dt=tip.data, type="tip", ...)
+ node.data <- formatData(phy=x, dt=node.data, type="internal", ...)
+ all.data <- formatData(phy=x, dt=all.data, type="all", ...)
+
+ ## add any data
+ res at data <- .phylo4Data(x=x, tip.data=tip.data, node.data=node.data,
+ all.data=all.data, merge.data=merge.data)
+ ## add any metadata
+ res at metadata <- metadata
+ return(res)
+})
+
+
+### first arg is a matrix of edges
+##' @rdname phylo4d-methods
+##' @aliases phylo4d,matrix,matrix-method
+setMethod("phylo4d", "matrix",
+ function(x, tip.data=NULL, node.data=NULL, all.data=NULL,
+ merge.data=TRUE, metadata=list(), edge.length=NULL,
+ tip.label=NULL, node.label=NULL, edge.label=NULL,
+ order="unknown", annote=list(), ...) {
+ tree <- phylo4(x, edge.length=edge.length, tip.label=tip.label,
+ node.label=node.label, edge.label=edge.label, order=order,
+ annote=annote)
+ res <- phylo4d(tree, tip.data, node.data, all.data,
+ merge.data=merge.data, metadata=metadata, ...)
+ return(res)
+})
+
+
+label_to_data <- function(nlab.data, ...) {
+ ## convert number-like labels to numeric, other keep as it is
+ nlab.data.test <- gsub("[0-9]|\\.", "", nlab.data[!is.na(nlab.data)])
+ if (all(nchar(nlab.data.test) == 0 )) {
+ nlab.data <- data.frame(labelValues=as.numeric(nlab.data), ...)
+ }
+ else {
+ nlab.data <- data.frame(labelValues=nlab.data, ...)
+ }
+ nlab.data
+}
+
+### first arg is a phylo
+##' @rdname phylo4d-methods
+##' @aliases phylo4d,phylo,phylo-method
+setMethod("phylo4d", "phylo",
+ function(x, tip.data=NULL,
+ node.data=NULL, all.data=NULL,
+ check.node.labels=c("keep", "drop", "asdata"),
+ annote=list(), metadata=list(), ...) {
+
+ check.node.labels <- match.arg(check.node.labels)
+
+ if (check.node.labels == "asdata") {
+ # FIXME? use.node.names=TRUE won't work with this option b/c
+ # node labels are dropped; assumes node.data (if any), phylo
+ # node.label, and phylo4 internal nodes are in the same order?
+
+ nlab.data <- x$node.label
+ x$node.label <- NULL
+ nlab.data[!nzchar(nlab.data)] <- NA
+
+ ## convert number-like labels to numeric, other keep as it is
+ nlab.data <- label_to_data(nlab.data)
+
+ tree <- phylo4(x, check.node.labels="drop", annote=annote)
+ res <- phylo4d(tree, tip.data=tip.data, node.data=node.data,
+ all.data=all.data, metadata=metadata, ...)
+ res <- addData(res, node.data=nlab.data, pos="before", match.data=FALSE)
+ }
+ else {
+ tree <- phylo4(x, check.node.labels=check.node.labels, annote=annote)
+ res <- phylo4d(tree, tip.data=tip.data, node.data=node.data,
+ all.data=all.data, metadata=metadata, ...)
+ }
+
+ return(res)
+})
+
+### first arg is a phylo4d
+##' @rdname phylo4d-methods
+##' @aliases phylo4d,phylo4d,phylo4d-method
+setMethod("phylo4d", c("phylo4d"), function(x, ...) {
+ stop("Your object is already a phylo4d object. If you want to modify",
+ " the data attached to it look at the help for tdata()<-,")
+ })
+
+### first arg is nexml
+##' @rdname phylo4d-methods
+##' @aliases nexml,phylo4d-method
+setMethod("phylo4d", c("nexml"), function(x) {
+ tr <- RNeXML::get_trees_list(x)
+ chr <- RNeXML::get_characters(x)
+ if (is.null(tr[[1]])) {
+ new("phylo4d")
+ } else {
+ if (length(tr) > 1) {
+ warning("Only the first tree has been imported.")
+ }
+ phylo4d(x=tr[[1]][[1]], chr)
+ }
+})
+
+
+### Core function that takes care of the data
+.phylo4Data <- function(x, tip.data=NULL, node.data=NULL, all.data=NULL,
+ merge.data=TRUE) {
+
+ ## Check validity of phylo4 object
+ if (is.character(checkval <- checkPhylo4(x))) stop(checkval)
+
+ ## Create placeholder data frames for any null data arguments
+ if (is.null(tip.data)) tip.data <- formatData(x, NULL, "tip")
+ if (is.null(node.data)) node.data <- formatData(x, NULL, "internal")
+ if (is.null(all.data)) all.data <- formatData(x, NULL, "all")
+
+ # don't allow all.data columns of same name as tip.data or node.data
+ colnamesTipOrNode <- union(names(tip.data), names(node.data))
+ if (any(names(all.data) %in% colnamesTipOrNode)) {
+ stop("all.data column names must be distinct from ",
+ "tip.data and node.data column names")
+ }
+
+ ## combine common columns and move into all.data if merging,
+ ## otherwise rename them
+ colsToMerge <- intersect(names(tip.data), names(node.data))
+ if (merge.data && length(colsToMerge)>0) {
+ ##TODO could really just index rows directly on 1:nTip and
+ ## (nTip+1):(nTip+nNode) in the next two statements for speed,
+ ## but this is more robust to changes in node numbering rules
+ tip.rows <- tip.data[match(nodeId(x, "tip"),
+ row.names(tip.data)), colsToMerge, drop=FALSE]
+ node.rows <- node.data[match(nodeId(x, "internal"),
+ row.names(tip.data)), colsToMerge, drop=FALSE]
+ merge.data <- rbind(tip.rows, node.rows)
+ all.data <- data.frame(all.data, merge.data)
+ } else {
+ names(tip.data)[names(tip.data) %in% colsToMerge] <-
+ paste(colsToMerge, "tip", sep=".")
+ names(node.data)[names(node.data) %in% colsToMerge] <-
+ paste(colsToMerge, "node", sep=".")
+ }
+ ## now separate tips-only and nodes-only data
+ tip.only.data <- tip.data[setdiff(names(tip.data), names(node.data))]
+ node.only.data <- node.data[setdiff(names(node.data), names(tip.data))]
+
+ ## combine all data
+ complete.data <- data.frame(all.data, tip.only.data, node.only.data)
+
+ ## drop any rows that only contain NAs
+ if (ncol(complete.data)==0) {
+ return(data.frame())
+ } else {
+ empty.rows <- as.logical(rowSums(!is.na(complete.data)))
+ return(complete.data[empty.rows, , drop=FALSE])
+ }
+
+}
diff --git a/R/phylobase-package.R b/R/phylobase-package.R
new file mode 100644
index 0000000..91ffaad
--- /dev/null
+++ b/R/phylobase-package.R
@@ -0,0 +1,137 @@
+
+
+##' Utilities and Tools for Phylogenetics
+##'
+##' Base package for phylogenetic structures and comparative data.
+##'
+##' \code{phylobase} provides a set of functions to associate and
+##' manipulate phylogenetic information and data about the
+##' species/individuals that are in the tree.
+##'
+##' \code{phylobase} intends to be robust, fast and efficient. We hope
+##' other people use the data structure it provides to develop new
+##' comparative methods in R.
+##'
+##' With \code{phylobase} it is easy to ensure that all your data are
+##' represented and associated with the tips or the internal nodes of
+##' your tree. \code{phylobase} provides functions to:
+##' \itemize{
+##'
+##' \item prune (subset) your trees, find ancestor(s) a
+##' descendant(s)
+##'
+##' \item find the most common recent ancestor of 2 nodes (MRCA)
+##'
+##' \item calculate the distance of a given node from the tip or
+##' between two nodes in your tree
+##'
+##' \item robust functions to import data from NEXUS and Newick files
+##' using the NEXUS Class Library (\url{https://github.com/mtholder/ncl/})
+##' }
+##'
+##' @section History:
+##'
+##' \code{phylobase} was started during a Hackathlon at NESCent on
+##' December 10-14 2007.
+##'
+##' Peter Cowan was a Google Summer of Code fellow in 2008 and
+##' developed all the code for plotting.
+##'
+##' In December 2008, a mini-virtual Hackathlon was organized to clean
+##' up and make the code more robust.
+##'
+##' In the spring and summer of 2009, Jim Regetz made several
+##' contributions that made the code faster (in particular with the
+##' re-ordering parts), found many bugs, and wrote most of the testing
+##' code.
+##'
+##' \code{phylobase} was first released on CRAN on November 1st, 2009
+##' with version 0.5.
+##'
+##' Since then, several releases have followed adding new
+##' functionalities: better support of NEXUS files, creation of
+##' \code{phylobase.options()} function that controls the \code{phylo4}
+##' validator, rewrite of the validator in C++.
+##'
+##' Starting with 0.6.8, Francois Michonneau succeeds to Ben Bolker as
+##' the maintainer of the package.
+##'
+##' @name phylobase-package
+##' @aliases phylobase-package phylobase
+##' @docType package
+##' @section More Info:
+##' See the help index \code{help(package="phylobase")} and run
+##' \code{vignette("phylobase", "phylobase")} for further details and
+##' examples about how to use \code{phylobase}.
+##' @keywords package
+##'
+##' @useDynLib phylobase, .registration = TRUE
+##' @import methods
+##' @import ape
+##' @import RNeXML
+##' @import grid
+##' @import stats
+##' @importFrom Rcpp evalCpp
+##' @importFrom graphics plot
+##' @importFrom utils head tail
+##' @importFrom ade4 newick2phylog
+##' @importFrom rncl rncl
+##'
+##' @exportMethod print head tail reorder plot summary
+##'
+## exportMethod should only be used for generics defined outside the package!
+## @exportMethod phylo4 phylo4d
+## @exportMethod edges edgeId hasEdgeLength edgeLength edgeLength<- sumEdgeLength edgeOrder
+## @exportMethod isRooted rootNode rootNode<-
+## @exportMethod isUltrametric
+## @exportMethod subset prune [
+## @exportMethod [<- [[ [[<-
+## @exportMethod labels labels<- nodeLabels nodeLabels<- tipLabels tipLabels<- edgeLabels edgeLabels<-
+## @exportMethod hasNodeLabels hasEdgeLabels hasDuplicatedLabels
+NULL
+
+
+##' Data from Darwin's finches
+##'
+##' Phylogenetic tree and morphological data for Darwin's finches, in different
+##' formats
+##'
+##'
+##' @name geospiza
+##' @aliases geospiza geospiza_raw
+##' @docType data
+##' @format \code{geospiza} is a \code{phylo4d} object; \code{geospiza_raw} is a
+##' list containing \code{tree}, a \code{phylo} object (the tree), \code{data},
+##' and a data frame with the data (for showing examples of how to merge tree
+##' and data)
+##' @note Stolen from Luke Harmon's Geiger package, to avoid unnecessary
+##' dependencies
+##' @source Dolph Schluter via Luke Harmon
+##' @keywords datasets
+##' @examples
+##'
+##' data(geospiza)
+##' plot(geospiza)
+##'
+NULL
+
+
+
+##' 'Owls' data from ape
+##'
+##' A tiny tree, for testing/example purposes, using one of the examples from
+##' the \code{ape} package
+##'
+##'
+##' @name owls4
+##' @docType data
+##' @format This is the standard 'owls' tree from the \code{ape} package, in
+##' \code{phylo4} format.
+##' @source From various examples in the \code{ape} package
+##' @keywords datasets
+##' @examples
+##'
+##' data(owls4)
+##' plot(owls4)
+##'
+NULL
diff --git a/R/phylobase.options.R b/R/phylobase.options.R
new file mode 100644
index 0000000..b57f470
--- /dev/null
+++ b/R/phylobase.options.R
@@ -0,0 +1,54 @@
+##' Set or return options of phylobase
+##'
+##' Provides a mean to control the validity of \code{phylobase}
+##' objects such as singletons, reticulated trees, polytomies, etc.
+##'
+##' The parameter values set via a call to this function will remain
+##' in effect for the rest of the session, affecting the subsequent
+##' behavior of phylobase.
+##'
+##' @param \dots a list may be given as the only argument, or any
+##' number of arguments may be in the \code{name=value} form, or no
+##' argument at all may be given. See the Value and Details sections
+##' for explanation.
+##' @return A list with the updated values of the parameters. If
+##' arguments are provided, the returned list is invisible.
+##' @author Francois Michonneau (adapted from the package \code{sm})
+##' @keywords phylobase validator
+##' @examples
+##' \dontrun{
+##' phylobase.options(poly="fail")
+##' # subsequent trees with polytomies will fail the validity check
+##' }
+##'
+##' @export
+phylobase.options <- function (...) {
+ if (nargs() == 0) return(.phylobase.Options)
+ current <- .phylobase.Options
+ temp <- list(...)
+ if (length(temp) == 1 && is.null(names(temp))) {
+ arg <- temp[[1]]
+ switch(mode(arg),
+ list = temp <- arg,
+ character = return(.phylobase.Options[arg]),
+ stop("invalid argument: ", sQuote(arg)))
+ }
+ if (length(temp) == 0) return(current)
+ n <- names(temp)
+ if (is.null(n)) stop("options must be given by name")
+
+ if (!all(names(temp) %in% names(current)))
+ stop("Option name invalid: ", sQuote(names(temp)))
+ changed <- current[n]
+ current[n] <- temp
+ current <- lapply(current, function(foo) {
+ foo <- match.arg(foo, c("warn", "fail", "ok"))
+ })
+ if (!identical(current$retic, "fail")) {
+ stop("Currently reticulated trees are not handled by phylobase.")
+ }
+ ## options are always global
+ env <- asNamespace("phylobase")
+ assign(".phylobase.Options", current, envir = env)
+ invisible(current)
+}
diff --git a/R/phylomats-class.R b/R/phylomats-class.R
new file mode 100644
index 0000000..79504a3
--- /dev/null
+++ b/R/phylomats-class.R
@@ -0,0 +1,136 @@
+
+##' matrix classes for phylobase
+##'
+##' Classes representing phylogenies as matrices
+##'
+##'
+##' @name phylomat-class
+##' @aliases phylo4vcov-class as_phylo4vcov
+##' @docType class
+##' @param from a \code{phylo4} object
+##' @param \dots optional arguments, to be passed to \code{vcov.phylo} in
+##' \code{ape} (the main useful option is \code{cor}, which can be set to
+##' \code{TRUE} to compute a correlation rather than a variance-covariance
+##' matrix)
+##' @section Objects from the Class: These are square matrices (with rows and
+##' columns corresponding to tips, and internal nodes implicit) with different
+##' meanings depending on the type (variance-covariance matrix, distance matrix,
+##' etc.).
+##' @author Ben Bolker
+##' @rdname phylomat-class
+##' @keywords classes
+##' @export
+##' @examples
+##' tree_string <- "(((Strix_aluco:4.2,Asio_otus:4.2):3.1,Athene_noctua:7.3):6.3,Tyto_alba:13.5);"
+##' tree.owls <- ape::read.tree(text=tree_string)
+##' o2 <- as(tree.owls,"phylo4")
+##' ov <- as(o2,"phylo4vcov")
+##' o3 <- as(ov,"phylo4")
+##' ## these are not completely identical, but are
+##' ## topologically identical ...
+##'
+##' ## edge matrices are in a different order:
+##' ## cf. edges(o2) and edges(o3)
+##' ## BUT the edge matrices are otherwise identical
+##' o2edges <- edges(o2)
+##' o3edges <- edges(o3)
+##' identical(o2edges[order(o2edges[,2]),],
+##' o3edges[order(o3edges[,2]),])
+##'
+##' ## There is left/right ambiguity here in the tree orders:
+##' ## in o2 the 5->6->7->1 lineage
+##' ## (terminating in Strix aluco)
+##' ## is first, in o3 the 5->6->3 lineage
+##' ## (terminating in Athene noctua) is first.
+##'
+##'
+## define class for phylogenetic var-cov matrices
+setClass("phylo4vcov",
+ representation("matrix",
+ edge.label="character",
+ order="character"))
+
+## phylo4 -> var-cov: simply wrap ape::vcv.phylo
+## and add other slots
+as_phylo4vcov <- function(from,...) {
+ m <- ape::vcv.phylo(as(from,"phylo"),...)
+ new("phylo4vcov",
+ m,
+ edge.label=from at edge.label,
+ order=from at order)
+}
+##' @name phylomat-setAs
+##' @rdname phylomat-class
+##' @aliases setAs,phylo,phylo4vcov-method
+setAs("phylo4","phylo4vcov",
+ function(from,to) {
+ as_phylo4vcov(from)})
+
+##' @name phylomat-setAs
+##' @rdname phylomat-class
+##' @aliases setAs,phylo4vcov,phylo4-method
+setAs("phylo4vcov","phylo4",
+ function(from,to) {
+ matrix2tree <- function(v,reorder=TRUE) {
+ ## no polytomies allowed
+ va <- v
+ tipnames <- rownames(v)
+ ntip <- nrow(v)
+ dimnames(v) <- list(as.character(1:ntip),
+ as.character(1:ntip))
+ diag(va) <- 0
+ edgemat <- matrix(ncol=2,nrow=0)
+ ## termlens <- diag(v)-colSums(va)
+ edgelens <- numeric(0)
+ ## maxnode <- ntip
+ curnode <- 2*ntip ## one greater than total number of nodes
+ ## can we do this in a different order?
+ while (nrow(v)>1) {
+ mva <- max(va) ## find pair with max shared evolution
+ nextpr <- if (nrow(v)==2) c(1,2) else which(va==mva,arr.ind=TRUE)[1,]
+ ## maxnode <- maxnode+1 ## new node
+ curnode <- curnode-1
+ ## points to both of current identified nodes
+ ## (indexed by names)
+ edgemat <- rbind(edgemat,
+ c(curnode,as.numeric(rownames(v)[nextpr[1]])),
+ c(curnode,as.numeric(rownames(v)[nextpr[2]])))
+ ## descending edges are amount of *unshared* evolution
+ edgelens <- c(edgelens,
+ diag(v)[nextpr]-mva)
+ ## this clade has total evolution = shared evolution
+ diag(v)[nextpr] <- mva
+ ## assign new node name
+ rownames(v)[nextpr[1]] <- colnames(v)[nextpr[1]] <- curnode
+ ## drop rows/cols from matrix
+ v <- v[-nextpr[2],-nextpr[2],drop=FALSE]
+ va <- va[-nextpr[2],-nextpr[2],drop=FALSE]
+ }
+ ## switch order of node numbers to put root in the right place:
+ ## much plotting code seems to assume root = node # (ntips+1)
+ ## browser()
+ reorder <- FALSE
+ if (reorder) {
+ nn <- nrow(edgemat)
+ nnode <- nn-ntip+1
+ newedge <- edgemat
+ for (i in 2:nnode) {
+ newedge[edgemat==(ntip+i)] <- nn-i+2
+ }
+ edgemat <- newedge
+ }
+ list(edgemat=edgemat,
+ edgelens=edgelens)
+ }
+ temptree <- matrix2tree(from)
+ ## browser()
+ ## add explicit root
+ rootnode <- which(tabulate(temptree$edgemat[,2])==0)
+ ## add root node to edge matrix and branch lengths
+ temptree$edgemat <- rbind(temptree$edgemat, c(0, rootnode))
+ temptree$edgelens <- c(temptree$edgelens,NA)
+ reorder(phylo4(temptree$edgemat,edge.length=temptree$edgelens,
+ tip.label=rownames(from),
+ edge.label=from at edge.label,order="unknown"),
+ "preorder")
+ })
diff --git a/R/print-methods.R b/R/print-methods.R
new file mode 100644
index 0000000..b6b3fba
--- /dev/null
+++ b/R/print-methods.R
@@ -0,0 +1,126 @@
+
+##' print a phylogeny
+##'
+##' Prints a phylo4 or phylo4d object in data.frame format with user-friendly
+##' column names
+##'
+##' This is a user-friendly version of the tree representation, useful for
+##' checking that objects were read in completely and translated correctly. The
+##' phylogenetic tree is represented as a list of numbered nodes, linked in a
+##' particular way through time (or rates of evolutionary change). The topology
+##' is given by the pattern of links from each node to its ancestor. Also given
+##' are the taxon names, node type (root/internal/tip) and phenotypic data (if
+##' any) associated with the node, and the branch length from the node to its
+##' ancestor. A list of nodes (descendants) and ancestors is minimally required
+##' for a phylo4 object.
+##'
+##' @param x a \code{phylo4} tree or \code{phylo4d} tree+data object
+##' @param object a \code{phylo4} or \code{phylo4d} object
+##' @param edgeOrder in the data frame returned, the option 'pretty' returns the
+##' internal nodes followed by the tips, the option 'real' returns the nodes in
+##' the order they are stored in the edge matrix.
+##' @param printall default prints entire tree. printall=FALSE returns the first
+##' 6 rows
+##' @param n for head() and tail(), the number of lines to print
+##' @param \dots optional additional arguments (not in use)
+##' @return A data.frame with a row for each node (descendant), sorted as
+##' follows: root first, then other internal nodes, and finally tips.\cr The
+##' returned data.frame has the following columns:\cr \item{label}{Label for the
+##' taxon at the node (usually species name).} \item{node}{Node number, i.e. the
+##' number identifying the node in edge matrix.} \item{ancestor}{Node number
+##' of the node's ancestor.} \item{branch.length}{The branch length connecting
+##' the node to its ancestor (NAs if missing).} \item{node.type}{"root",
+##' "internal", or "tip". (internally generated)} \item{data}{phenotypic data
+##' associated with the nodes, with separate columns for each variable.}
+##' @note This is the default show() method for phylo4, phylo4d. It prints the
+##' user-supplied information for building a phylo4 object. For a full
+##' description of the phylo4 S4 object and slots, see \code{\link{phylo4}}.
+##' @author Marguerite Butler, Thibaut Jombart \email{jombart@@biomserv.univ-lyon1.fr}, Steve Kembel
+##' @include setAs-methods.R
+##' @keywords methods
+##' @examples
+##'
+##'
+##' tree.phylo <- ape::read.tree(text="((a,b),c);")
+##' tree <- as(tree.phylo, "phylo4")
+##' ##plot(tree,show.node=TRUE) ## plotting broken with empty node labels: FIXME
+##' tip.data <- data.frame(size=c(1,2,3), row.names=c("a", "b", "c"))
+##' treedata <- phylo4d(tree, tip.data)
+##' plot(treedata)
+##' print(treedata)
+##'
+##'
+##' @aliases print
+##' @rdname print-methods
+setGeneric("print")
+
+##' @rdname print-methods
+##' @aliases print,phylo4-method
+##' @exportMethod print
+setMethod("print", signature(x="phylo4"),
+ function(x, edgeOrder=c("pretty", "real"),
+ printall=TRUE) {
+ if(!nrow(edges(x))) {
+ msg <- paste("Empty \'", class(x), "\' object\n", sep="")
+ cat(msg)
+ }
+ else {
+ toRet <- .phylo4ToDataFrame(x, edgeOrder)
+ if (printall) {
+ print(toRet)
+ }
+ else {
+ print(head(toRet))
+ }
+ }
+})
+
+##' @rdname print-methods
+##' @aliases show
+##' @exportMethod show
+setGeneric("show")
+
+##' @rdname print-methods
+##' @aliases show,phylo4-method
+setMethod("show", signature(object="phylo4"),
+ function(object) {
+ print(object)
+ })
+
+##' @rdname print-methods
+##' @aliases names
+##' @exportMethod names
+##' @export
+setGeneric("names")
+
+##' @rdname print-methods
+##' @aliases names,phylo4-method
+setMethod("names", signature(x="phylo4"),
+ function(x) {
+ temp <- rev(names(attributes(x)))[-1]
+ return(rev(temp))
+})
+
+##' @rdname print-methods
+##' @aliases head
+##' @exportMethod head
+setGeneric("head")
+
+##' @rdname print-methods
+##' @aliases head,phylo4-method
+setMethod("head", signature(x="phylo4"),
+ function(x, n=20) {
+ head(as(x,"data.frame"),n=n)
+ })
+
+##' @rdname print-methods
+##' @aliases tail
+##' @exportMethod tail
+setGeneric("tail")
+
+##' @rdname print-methods
+##' @aliases tail,phylo4-method
+setMethod("tail", signature(x="phylo4"),
+ function(x, n=20) {
+ tail(as(x, "data.frame"), n=n)
+ })
diff --git a/R/readNCL.R b/R/readNCL.R
new file mode 100644
index 0000000..0e258cb
--- /dev/null
+++ b/R/readNCL.R
@@ -0,0 +1,435 @@
+### This file contains the source code for the functions:
+### - readNCL (generic function)
+### - readNexus (wrapper for readNCL importing Nexus files)
+### - readNewick (wrapper for readNCL importing Newick files)
+
+##' Create a \code{phylo4}, \code{phylo4d} or \code{data.frame} object
+##' from a NEXUS or a Newick file
+##'
+##' \code{readNexus} reads a NEXUS file and outputs a \code{phylo4},
+##' \code{phylo4d} or \code{data.frame} object.
+##'
+##' \code{readNewick} reads a Newick file and outputs a \code{phylo4}
+##' or \code{phylo4d} object.
+##'
+##' \code{readNexus} is used internally by both \code{readNexus} and
+##' \code{readNewick} to extract data held in a tree files,
+##' specifically in NEXUS files from DATA, CHARACTER or TREES
+##' blocks.
+##'
+##' The \code{type} argument specifies which of these is returned:
+##'
+##' \describe{
+##'
+##' \item{data}{will only return a \code{data.frame} of the contents
+##' of all DATA and CHARACTER blocks.}
+##'
+##' \item{tree}{will only return a \code{phylo4} object of the
+##' contents of the TREES block.}
+##'
+##' \item{all}{if only data or a tree are present in the file, this
+##' option will act as the options above, returning either a
+##' \code{data.frame} or a \code{phylo4} object respectively. If both
+##' are present then a \code{phylo4d} object is returned containing
+##' both.}
+##'
+##' }
+##'
+##' The function returns \code{NULL} if the \code{type} of
+##' data requested is not present in the file, or if neither data nor
+##' tree blocks are present.
+##'
+##' Depending on the context \code{readNexus} will call either the
+##' \code{phylo4} or \code{phylo4d} constructor. The \code{phylo4d}
+##' constructor will be used with \code{type="all"}, or if the option
+##' \code{check.node.labels="asdata"} is invoked.
+##'
+##' \code{readNewick} imports Newick formatted tree files and will
+##' return a \code{phylo4} or a \code{phylo4d} object if the option
+##' \code{check.node.labels="asdata"} is invoked.
+##'
+##' For both \code{readNexus} and \code{readNewick}, the options for
+##' \code{check.node.labels} can take the values:
+##'
+##' \describe{
+##'
+##' \item{keep}{the node labels of the trees will be passed as node
+##' labels in the \code{phylo4} object}
+##'
+##' \item{drop}{the node labels of the trees will be ignored in the
+##' \code{phylo4} object}
+##'
+##' \item{asdata}{the node labels will be passed as data and a
+##' \code{phylo4d} object will be returned.}
+##'
+##' }
+##'
+##' If you use the option \code{asdata} on a file with no node labels,
+##' a warning message is issued, and is thus equivalent to the value
+##' \code{drop}.
+##'
+##' For both \code{readNexus} and \code{readNewick}, additional
+##' arguments can be passed to the constructors such as \code{annote},
+##' \code{missing.data} or \code{extra.data}. See the \sQuote{Details}
+##' section of \code{\link{phylo4d-methods}} for the complete list of
+##' options.
+##'
+##' @name Import Nexus and Newick files
+##' @docType methods
+##' @param file a NEXUS file for \code{readNexus} or a file that
+##' contains Newick formatted trees for \code{readNewick}.
+##' @param simplify If TRUE, if there are multiple trees in the file,
+##' only the first one is returned; otherwise a list of
+##' \code{phylo4(d)} objects is returned if the file contains multiple
+##' trees.
+##' @param type Determines which type of objects to return, if present
+##' in the file (see Details).
+##' @param spacesAsUnderscores In the NEXUS file format white spaces
+##' are not allowed in taxa labels and are represented by
+##' underscores. Therefore, NCL converts underscores found in taxa
+##' labels in the NEXUS file into white spaces
+##' (e.g. \code{species_1} will become \code{"species 1"}. If you
+##' want to preserve the underscores, set as TRUE, the default).
+##' @param char.all If \code{TRUE}, returns all characters, even those
+##' excluded in the NEXUS file
+##' @param polymorphic.convert If \code{TRUE}, converts polymorphic
+##' characters to missing data
+##' @param levels.uniform If \code{TRUE}, uses the same levels for all
+##' characters
+##' @param quiet If \code{FALSE} the output of the NCL interface is
+##' printed. This is mainly for debugging purposes. This option
+##' can considerably slow down the process if the tree is big or
+##' there are many trees in the file.
+##' @param check.node.labels Determines how the node labels in the
+##' NEXUS or Newick files should be treated in the phylo4 object,
+##' see Details for more information.
+##' @param return.labels Determines whether state names (if
+##' \code{TRUE}) or state codes should be returned.
+##' @param file.format character indicating the format of the
+##' specified file (either \dQuote{\code{newick}} or
+##' \dQuote{\code{nexus}}). It's more convenient to just use
+##' \code{readNexus} or \code{readNewick}.
+##' @param check.names logical. If \sQuote{TRUE} then the names of the
+##' characters from the NEXUS file are checked to ensure that they
+##' are syntactically valid variable names and are not duplicated.
+##' If necessary they are adjusted using \sQuote{make.names}.
+##' @param convert.edge.length logical. If \code{TRUE} negative edge
+##' lengths are replaced with 0. At this time \code{phylobase}
+##' does not accept objects with negative branch lengths, this
+##' workaround allows to import trees with negative branch
+##' lengths.
+##' @param \dots Additional arguments to be passed to phylo4 or
+##' phylo4d constructor (see Details)
+##' @return Depending on the value of \code{type} and the contents of
+##' the file, one of: a \code{data.frame}, a \linkS4class{phylo4}
+##' object, a \linkS4class{phylo4d} object or \code{NULL}. If
+##' several trees are included in the NEXUS file and the option
+##' \code{simplify=FALSE} a list of \linkS4class{phylo4} or
+##' \linkS4class{phylo4d} objects is returned.
+##' @note Underscores in state labels (i.e. trait or taxon names) will
+##' be translated to spaces. Unless \code{check.names=FALSE}, trait
+##' names will be converted to valid R names (see
+##' \code{\link{make.names}}) on input to R, so spaces will be
+##' translated to periods.
+##' @author Brian O'Meara, Francois Michonneau, Derrick Zwickl
+##' @seealso the \linkS4class{phylo4d} class, the \linkS4class{phylo4}
+##' class
+##' @export
+##' @rdname readNexus
+##' @aliases readNCL
+##' @keywords misc
+
+readNCL <- function(file, simplify=FALSE, type=c("all", "tree","data"),
+ spacesAsUnderscores = TRUE, char.all=FALSE,
+ polymorphic.convert=TRUE, levels.uniform=FALSE, quiet=TRUE,
+ check.node.labels=c("keep", "drop", "asdata"), return.labels=TRUE,
+ file.format=c("nexus", "newick"), check.names=TRUE,
+ convert.edge.length=FALSE, ...) {
+
+
+ type <- match.arg(type)
+ file.format <- match.arg(file.format)
+
+ check.node.labels <- match.arg(check.node.labels)
+
+ if (type == "all" || type == "data") {
+ returnData <- TRUE
+ }
+ else {
+ returnData <- FALSE
+ }
+ if (type == "all" || type == "tree") {
+ returnTrees <- TRUE
+ }
+ else {
+ returnTrees <- FALSE
+ }
+
+ ## GetNCL returns a list containing:
+ ## $taxaNames: names of the taxa (from taxa block, implied or declared)
+ ## $treeNames: the names of the trees
+ ## $trees: a vector of (untranslated) Newick strings
+ ## $dataTypes: data type for each character block of the nexus file (length = number of chr blocks)
+ ## $nbCharacters: number of characters in each block (length = number of chr blocks)
+ ## $charLabels: the labels for the characters, i.e. the headers of the data frame to be returned
+ ## (length = number of chr blocks * sum of number of characters in each block)
+ ## $nbStates: the number of states of each character (equals 0 for non-standard types, length = number
+ ## of characters)
+ ## $stateLabels: the labels for the states of the characters, i.e. the levels of the factors to be returned
+ ## $dataChr: string that contains the data to be returned
+
+ ncl <- rncl::rncl(file = file, file.format = file.format, spacesAsUnderscores = spacesAsUnderscores,
+ char.all = char.all, polymorphic.convert = polymorphic.convert,
+ levels.uniform = levels.uniform)
+
+
+ ## Return Error message
+ if (length(ncl) == 1 && names(ncl) == "ErrorMsg") {
+ stop(ncl$ErrorMsg)
+ }
+
+ if (!quiet) message(ncl)
+
+ ## Disclaimer
+ if (!length(grep("\\{", ncl$dataChr)) && return.labels && !polymorphic.convert) {
+ stop("At this stage, it's not possible to use the combination: ",
+ "return.labels=TRUE and polymorphic.convert=FALSE for datasets ",
+ "that contain polymorphic characters.")
+ }
+
+ if (returnData && length(ncl$dataChr)) {
+ tipData <- vector("list", length(ncl$dataChr))
+ for (iBlock in 1:length(ncl$dataTypes)) {
+ chrCounter <- ifelse(iBlock == 1, 0, sum(ncl$nbCharacters[1:(iBlock-1)]))
+ if (ncl$dataTypes[iBlock] == "Continuous") {
+ for (iChar in 1:ncl$nbCharacters[iBlock]) {
+ i <- chrCounter + iChar
+ tipData[[i]] <- eval(parse(text=ncl$dataChr[i]))
+ names(tipData)[i] <- ncl$charLabels[i]
+ }
+ }
+ else {
+ if (ncl$dataTypes[iBlock] == "Standard") {
+ iForBlock <- integer(0)
+ for (iChar in 1:ncl$nbCharacters[iBlock]) {
+ i <- chrCounter + iChar
+ iForBlock <- c(iForBlock, i)
+ lblCounterMin <- ifelse(i == 1, 1, sum(ncl$nbStates[1:(i-1)]) + 1)
+ lblCounter <- seq(lblCounterMin, length.out=ncl$nbStates[i])
+ tipData[[i]] <- eval(parse(text=ncl$dataChr[i]))
+ names(tipData)[i] <- ncl$charLabels[i]
+ tipData[[i]] <- as.factor(tipData[[i]])
+
+ lbl <- ncl$stateLabels[lblCounter]
+ if (return.labels) {
+ if (any(nchar(gsub("\\s|_", "", lbl)) == 0)) {
+ warning("state labels are missing for \'", ncl$charLabels[i],
+ "\', the option return.labels is thus ignored.")
+ }
+ else {
+ levels(tipData[[i]]) <- lbl
+ }
+ }
+ }
+ if (levels.uniform) {
+ allLevels <- character(0)
+ for (j in iForBlock) {
+ allLevels <- union(allLevels, levels(tipData[[j]]))
+ }
+ for (j in iForBlock) {
+ levels(tipData[[j]]) <- allLevels
+ }
+ }
+ }
+ else {
+ warning("This datatype is not currently supported by phylobase")
+ next
+ ## FIXME: different datatypes in a same file isn't going to work
+ }
+ }
+ }
+ tipData <- data.frame(tipData, check.names=check.names)
+ if (length(ncl$taxaNames) == nrow(tipData)) {
+ rownames(tipData) <- ncl$taxaNames
+ }
+ else stop("phylobase doesn't deal with multiple taxa block at this time.")
+ }
+ else {
+ tipData <- NULL
+ }
+
+ if (returnTrees && length(ncl$trees) > 0) {
+ listTrees <- vector("list", length(ncl$trees))
+
+ for (i in 1:length(ncl$trees)) {
+
+ isRooted <- is_rooted(ncl$parentVector[[i]])
+
+ edgeMat <- get_edge_matrix(ncl$parentVector[[i]], isRooted)
+
+ edgeLgth <- get_edge_length(ncl$branchLengthVector[[i]],
+ ncl$parentVector[[i]],
+ isRooted)
+
+ tipLbl <- ncl$taxonLabelVector[[i]]
+
+ if (convert.edge.length) {
+ edgeLgth[edgeLgth < 0] <- 0
+ }
+
+ if (check.node.labels == "asdata" &&
+ !has_node_labels(ncl$nodeLabelsVector[[i]])) {
+ warning("Could not use value \"asdata\" for ",
+ "check.node.labels because there are no ",
+ "labels associated with the tree")
+ check.node.labels <- "drop"
+ }
+
+
+ if (has_node_labels(ncl$nodeLabelsVector[[i]]) &&
+ !identical(check.node.labels, "drop")) {
+ nodeLbl <- ncl$nodeLabelsVector[[i]]
+ rootNd <- attr(edgeMat, "root")
+ nodeLbl[rootNd] <- nodeLbl[1]
+ node_pos <- (length(tipLbl)+1):length(nodeLbl)
+ nodeLbl <- nodeLbl[node_pos]
+
+ if (identical(check.node.labels, "asdata")) {
+ tr <- phylo4(x = edgeMat,
+ edge.length = edgeLgth,
+ tip.label = tipLbl)
+ nodeDt <- label_to_data(nodeLbl, row.names = node_pos)
+ tr <- phylo4d(tr, node.data = nodeDt)
+ } else {
+
+ tr <- phylo4(x = edgeMat,
+ edge.length = edgeLgth,
+ tip.label = tipLbl,
+ node.label = nodeLbl)
+ }
+ } else {
+ tr <- phylo4(x = edgeMat,
+ edge.length = edgeLgth,
+ tip.label = tipLbl)
+
+
+ }
+
+ listTrees[[i]] <- tr
+ if (simplify) break
+ }
+
+ if (length(listTrees) == 1 || simplify)
+ listTrees <- listTrees[[1]]
+
+ } else {
+ listTrees <- NULL
+ }
+
+###
+ switch(type,
+ "data" = {
+ if (is.null(tipData)) {
+ toRet <- NULL
+ }
+ else {
+ toRet <- tipData
+ }
+ },
+ "tree" = {
+ if (is.null(listTrees)) {
+ toRet <- NULL
+ }
+ else {
+ toRet <- listTrees
+ }
+ },
+ "all" = {
+ if (is.null(tipData) && is.null(listTrees)) {
+ toRet <- NULL
+ }
+ else if (is.null(tipData)) {
+ toRet <- listTrees
+ }
+ else if (is.null(listTrees)) {
+ toRet <- tipData
+ }
+ else {
+ if (length(listTrees) > 1) {
+ toRet <- lapply(listTrees, function(tr)
+ addData(tr, tip.data=tipData, ...))
+ }
+ else toRet <- addData(listTrees, tip.data=tipData, ...)
+ }
+ })
+ toRet
+}
+
+
+## check if the implicit root is dichotomous
+is_rooted <- function(parentVector) {
+ tab_edg <- table(parentVector)
+ if (tabulate(parentVector)[which(parentVector == 0)] > 2)
+ FALSE
+ else TRUE
+}
+
+
+## Returns the edge matrix from the parentVector (the i^th element is
+## the descendant element of node i)
+get_edge_matrix <- function(parentVector, isRooted) {
+ edgeMat <- cbind(ancestor = parentVector,
+ descendant = 1:length(parentVector))
+ rootNd <- edgeMat[which(edgeMat[, 1] == 0), 2]
+ if (!isRooted) {
+ edgeMat <- edgeMat[-which(edgeMat[, 1] == 0), ]
+ }
+ attr(edgeMat, "root") <- rootNd
+ edgeMat
+}
+
+## Returns the edge lengths (missing are represented by -999)
+get_edge_length <- function(branchLengthVector, parentVector, isRooted) {
+ edgeLgth <- branchLengthVector
+ if (isRooted) {
+ edgeLgth[which(parentVector == 0)] <- NA
+ } else {
+ edgeLgth <- edgeLgth[which(parentVector != 0)]
+ }
+ edgeLgth[edgeLgth == -999] <- NA
+ edgeLgth
+}
+
+## Tests whether there are node labels
+has_node_labels <- function(nodeLabelsVector) {
+ any(nzchar(nodeLabelsVector))
+}
+
+##' @rdname readNexus
+##' @aliases readNexus
+##' @export
+readNexus <- function (file, simplify=FALSE, type=c("all", "tree", "data"),
+ char.all=FALSE, polymorphic.convert=TRUE,
+ levels.uniform=FALSE, quiet=TRUE,
+ check.node.labels=c("keep", "drop", "asdata"),
+ return.labels=TRUE, check.names=TRUE, convert.edge.length=FALSE,
+ ...) {
+
+ return(readNCL(file=file, simplify=simplify, type=type, char.all=char.all,
+ polymorphic.convert=polymorphic.convert, levels.uniform=levels.uniform,
+ quiet=quiet, check.node.labels=check.node.labels,
+ return.labels=return.labels, file.format="nexus",
+ check.names=check.names, convert.edge.length=convert.edge.length, ...))
+}
+
+##' @rdname readNexus
+##' @aliases readNewick
+##' @export
+readNewick <- function(file, simplify=FALSE, quiet=TRUE,
+ check.node.labels=c("keep", "drop", "asdata"),
+ convert.edge.length=FALSE, ...) {
+
+ return(readNCL(file=file, simplify=simplify, quiet=quiet,
+ check.node.labels=check.node.labels, file.format="newick",
+ convert.edge.length=convert.edge.length, ...))
+}
diff --git a/R/reorder-methods.R b/R/reorder-methods.R
new file mode 100644
index 0000000..ed23b72
--- /dev/null
+++ b/R/reorder-methods.R
@@ -0,0 +1,149 @@
+
+#########################################################
+### Ordering
+#########################################################
+
+##' reordering trees within phylobase objects
+##'
+##' Methods for reordering trees into various traversal orders
+##'
+##' The \code{reorder} method takes a \code{phylo4} or \code{phylo4d}
+##' tree and orders the edge matrix (i.e. \code{edges(x)}) in the
+##' requested traversal order. Currently only two orderings are
+##' permitted, and both require rooted trees. In \code{postorder}, a
+##' node's descendants come before that node, thus the root, which is
+##' ancestral to all nodes, comes last. In \code{preorder}, a node is
+##' visited before its descendants, thus the root comes first.
+##'
+##' @name reorder-methods
+##' @docType methods
+##' @param x a \code{phylo4} or \code{phylo4d} object
+##' @param order The desired traversal order; currently only
+##' \dQuote{preorder} and \dQuote{postorder} are allowed for
+##' \code{phylo4} and \code{phylo4d} objects.
+##' @param \dots additional optional elements (not in use)
+##' @return A \code{phylo4} or \code{phylo4d} object with the edge,
+##' label, length and data slots ordered as \code{order}, which is
+##' itself recorded in the order slot.
+##' @note The \code{preorder} parameter corresponds to
+##' \code{cladewise} in the \code{ape} package, and \code{postorder}
+##' corresponds (almost) to \code{pruningwise}.
+##'
+##' @author Peter Cowan, Jim Regetz
+##' @seealso \code{\link[ape]{reorder.phylo}} in the \code{ape} package.
+##' \code{\link{ancestors}} \code{\link{ancestor}} \code{\link{siblings}}
+##' \code{\link{children}} \code{\link{descendants}}
+##' @keywords methods
+##' @include phylo4-class.R
+##' @include phylo4-methods.R
+##' @exportMethod reorder
+##' @aliases reorder
+##' @examples
+##' phy <- phylo4(ape::rtree(5))
+##' edges(reorder(phy, "preorder"))
+##' edges(reorder(phy, "postorder"))
+setGeneric("reorder")
+
+##' @rdname reorder-methods
+##' @aliases reorder,phylo4-method
+setMethod("reorder", signature(x="phylo4"),
+ function(x, order=c("preorder", "postorder")) {
+ ## call orderIndex and use that index to order edges, labels and lengths
+ order <- match.arg(order)
+ index <- orderIndex(x, order)
+ x at order <- order
+ x at edge <- edges(x)[index, ]
+ if(hasEdgeLabels(x)) {
+ x at edge.label <- x at edge.label[index]
+ }
+ if(hasEdgeLength(x)) {
+ x at edge.length <- x at edge.length[index]
+ }
+ x
+})
+
+## non exported function
+orderIndex <- function(x, order=c("preorder", "postorder")) {
+
+ order <- match.arg(order)
+ if(!isRooted(x)){
+ stop("Tree must be rooted to reorder")
+ }
+ ## get a root node free edge matrix
+ edge <- edges(x, drop.root=TRUE)
+ ## Sort edges -- ensures that starting order of edge matrix doesn't
+ ## affect the order of reordered trees
+ edge <- edge[order(edge[, 2]), ]
+
+ # recast order argument as integer to pass to C
+ if(order == 'postorder') {
+ iOrder <- 0L
+ } else if(order == 'preorder') {
+ iOrder <- 1L
+ } else {stop(paste("Method for", order, "not implemented"))}
+
+ if (!hasPoly(x) & !hasSingle(x)) {
+ # method 1: faster, but only works if all internal nodes have
+ # exactly two children (true binary tree)
+
+ # extract nodes, separating descendants into left (first
+ # encountered) and right (second encountered) for each ancestor
+ isFirst <- !duplicated(edge[, 1])
+ ancestor <- as.integer(edge[isFirst, 1])
+ left <- as.integer(edge[isFirst, 2])
+ right <- as.integer(edge[!isFirst, 2])[match(ancestor,
+ edge[!isFirst, 1])]
+ descendantNew <- rep(0L, nEdges(x))
+ root <- as.integer(rootNode(x))
+ nEdge <- as.integer(length(ancestor))
+
+ descendantReord <- .C("reorderBinary", descendantNew, root,
+ ancestor, left, right, nEdge, iOrder)[[1]]
+
+ } else {
+ # method 2: not as fast, but robust to singletons and polytomies
+
+ # extract ancestors and descendants
+ ancestor <- as.integer(edge[,1])
+ descendant <- as.integer(edge[,2])
+ descendantNew <- rep(0L, nEdges(x))
+ root <- as.integer(rootNode(x))
+ nEdge <- as.integer(nrow(edge))
+
+ descendantReord <- .C("reorderRobust", descendantNew, root,
+ ancestor, descendant, nEdge, iOrder)[[1]]
+
+ }
+
+ ## Original pure R implementation of the above:
+ #### recursive functions are placed first and calls to those functions below
+ ##postOrder <- function(node) {
+ ## ## this function returns a vector of nodes in the post order traversal
+ ## ## get the descendants
+ ## traversal <- NULL
+ ## ## edge -- defined above, outside this function
+ ## ## extensive testing found this loop to be faster than apply() etc.
+ ## for(i in edge[edge[, 1] == node, 2]) {
+ ## traversal <- c(traversal, postOrder(i))
+ ## }
+ ## c(traversal, node)
+ ##}
+ ##preOrder <- function(node) {
+ ## ## see expanded code in comments of postOrder()
+ ## ## only difference here is that we record current node, then descendants
+ ## traversal <- NULL
+ ## for(i in edge[edge[, 1] == node, 2]) {
+ ## traversal <- c(traversal, preOrder(i))
+ ## }
+ ## c(node, traversal)
+ ##}
+ ##if(order == 'postorder') {
+ ## descendantReord <- postOrder(rootNode(x))
+ ##} else if(order == 'preorder') {
+ ## descendantReord <- preOrder(rootNode(x))
+ ##} else {stop(paste("Method for", order, "not implemented"))}
+
+ ## match the new node order to the old order to get an index
+ index <- match(descendantReord, edges(x)[, 2])
+
+}
diff --git a/R/root-methods.R b/R/root-methods.R
new file mode 100644
index 0000000..a0d5874
--- /dev/null
+++ b/R/root-methods.R
@@ -0,0 +1,64 @@
+
+##' Methods to test, access (and modify) the root of a phylo4 object.
+##'
+##' @rdname root-methods
+##' @aliases isRooted
+##' @docType methods
+##' @param x a \code{phylo4} or \code{phylo4d} object.
+##' @param value a character string or a numeric giving the new root.
+##' @return \describe{
+##' \item{isRooted}{logical whether the tree is rooted}
+##' \item{rootNode}{the node corresponding to the root}
+##' }
+##' @include phylo4-class.R phylo4-methods.R phylo4-accessors.R
+##' @export
+##' @author Ben Bolker, Francois Michonneau
+##' @examples
+##' data(geospiza)
+##' isRooted(geospiza)
+##' rootNode(geospiza)
+setGeneric("isRooted", function(x) {
+ standardGeneric("isRooted")
+})
+
+##' @rdname root-methods
+##' @aliases isRooted,phylo4-method
+setMethod("isRooted", signature(x="phylo4"),
+ function(x) {
+ ## hack to avoid failure on an empty object
+ if(nTips(x) == 0) return(FALSE)
+ any(edges(x)[, 1] == 0)
+})
+
+##' @rdname root-methods
+##' @aliases rootNode
+##' @export
+setGeneric("rootNode", function(x) {
+ standardGeneric("rootNode")
+})
+
+##' @rdname root-methods
+##' @aliases rootNode,phylo4-method
+setMethod("rootNode", signature(x="phylo4"),
+ function(x) {
+ if (!isRooted(x))
+ return(NA)
+ rootnd <- unname(edges(x)[which(edges(x)[, 1] == 0), 2])
+ getNode(x, rootnd)
+})
+
+##' @rdname root-methods
+##' @aliases rootNode<-
+##' @export
+setGeneric("rootNode<-", function(x, value) {
+ standardGeneric("rootNode<-")
+})
+
+##' @name rootNode<-
+##' @rdname root-methods
+##' @aliases rootNode<-,phylo4-method
+setReplaceMethod("rootNode", signature(x="phylo4"),
+ function(x, value) {
+ stop("Root node replacement not implemented yet")
+})
+
diff --git a/R/setAs-methods.R b/R/setAs-methods.R
new file mode 100644
index 0000000..69280d1
--- /dev/null
+++ b/R/setAs-methods.R
@@ -0,0 +1,321 @@
+
+##' Converting between phylo4/phylo4d and other phylogenetic tree
+##' formats
+##'
+##' Translation functions to convert between phylobase objects
+##' (\code{phylo4} or \code{phylo4d}), and objects used by other
+##' comparative methods packages in R: \code{ape} objects
+##' (\code{phylo}, \code{multiPhylo}), \code{RNeXML} object
+##' (\code{nexml}), \code{ade4} objects (\code{phylog}, \emph{now
+##' deprecated}), and to \code{data.frame} representation.
+##'
+##' @name setAs
+##' @docType methods
+##' @section Usage: \code{as(object, class)}
+##' @author Ben Bolker, Thibaut Jombart, Marguerite Butler, Steve
+##' Kembel, Francois Michonneau
+##' @seealso generic \code{\link[methods]{as}},
+##' \code{\link{phylo4-methods}}, \code{\link{phylo4d-methods}},
+##' \code{\link{extractTree}}, \code{nexml} class from the
+##' \code{RNeXML} package, \code{\link[ade4]{phylog}} from the
+##' \code{ade4} package and \code{\link[ape]{as.phylo}} from the
+##' \code{ape} package.
+##' @keywords methods
+##' @rdname setAs-methods
+##' @aliases as as-method as,phylo,phylo4-method
+##' @include phylo4-methods.R
+##' @include phylo4d-methods.R
+##' @include oldclasses-class.R
+##' @examples
+##' tree_string <- "(((Strix_aluco:4.2,Asio_otus:4.2):3.1,Athene_noctua:7.3):6.3,Tyto_alba:13.5);"
+##' tree.owls <- ape::read.tree(text=tree_string)
+##' ## round trip conversion
+##' tree_in_phylo <- tree.owls # tree is a phylo object
+##' (tree_in_phylo4 <- as(tree.owls,"phylo4")) # phylo converted to phylo4
+##' identical(tree_in_phylo,as(tree_in_phylo4,"phylo"))
+##' ## test if phylo, and phylo4 converted to phylo are identical
+##' ## (no, because of dimnames)
+##'
+##' ## Conversion to phylog (ade4)
+##' as(tree_in_phylo4, "phylog")
+##'
+##' ## Conversion to data.frame
+##' as(tree_in_phylo4, "data.frame")
+##'
+##' ## Conversion to phylo (ape)
+##' as(tree_in_phylo4, "phylo")
+##'
+##' ## Conversion to phylo4d, (data slots empty)
+##' as(tree_in_phylo4, "phylo4d")
+setAs("phylo", "phylo4", function(from, to) {
+ ## fixme SWK kludgy fix may not work well with unrooted trees
+ ## TODO should we also attempt to get order information?
+ ## BMB horrible kludge to avoid requiring ape explicitly
+ ape_is.rooted <- function(phy) {
+ if (!is.null(phy$root.edge))
+ TRUE
+ else if (tabulate(phy$edge[, 1])[length(phy$tip.label) + 1] > 2)
+ FALSE
+ else TRUE
+ }
+ if (ape_is.rooted(from)) {
+ tip.idx <- 1:nTips(from)
+ if (nTips(from) < nrow(from$edge)) {
+ int.idx <- (nTips(from)+1):dim(from$edge)[1]
+ } else {
+ int.idx <- NULL
+ }
+ root.node <- as.numeric(setdiff(unique(from$edge[,1]),
+ unique(from$edge[,2])))
+
+ from$edge <- rbind(from$edge[tip.idx,],c(0,root.node),
+ from$edge[int.idx,])
+ if (!is.null(from$edge.length)) {
+ if (is.null(from$root.edge)) {
+ from$edge.length <- c(from$edge.length[tip.idx],
+ as.numeric(NA),from$edge.length[int.idx])
+ }
+ else {
+ from$edge.length <- c(from$edge.length[tip.idx],
+ from$root.edge,from$edge.length[int.idx])
+ }
+ }
+ if (!is.null(from$edge.label)) {
+ from$edge.label <- c(from$edge.label[tip.idx], NA,
+ from$edge.label[int.idx])
+ }
+ }
+ newobj <- phylo4(from$edge, from$edge.length, unname(from$tip.label),
+ node.label = from$node.label,
+ edge.label = from$edge.label,
+ order = "unknown")
+ oldorder <- attr(from,"order")
+ neworder <- if (is.null(oldorder)) {
+ "unknown"
+ } else if (!oldorder %in% phylo4_orderings) {
+ stop("unknown ordering '", oldorder, "' in ape object")
+ } else if (oldorder == "cladewise" || oldorder == "preorder") {
+ "preorder"
+ } else if (oldorder == "pruningwise" || oldorder == "postorder") {
+ "postorder"
+ }
+ if (isRooted(newobj)) {
+ if (neworder == "preorder") {
+ newobj <- reorder(newobj, order="preorder")
+ }
+ if (neworder == "postorder") {
+ newobj <- reorder(newobj, order="postorder")
+ }
+ }
+ newobj at order <- neworder
+
+ attr(from,"order") <- NULL
+
+ attribs <- attributes(from)
+ attribs$names <- NULL
+ knownattr <- c("logLik", "origin", "para", "xi")
+ known <- names(attribs)[names(attribs) %in% knownattr]
+ unknown <- names(attribs)[!names(attribs) %in% c(knownattr, "class", "names")]
+ if (length(unknown) > 0) {
+ warning(paste("unknown attributes ignored: ", unknown, collapse = " "))
+ }
+ for (i in known) attr(newobj, i) <- attr(from, i)
+ newobj
+})
+
+##' @name setAs
+##' @rdname setAs-methods
+##' @aliases as,phylo,phylo4d-method
+setAs("phylo", "phylo4d", function(from, to) {
+ phylo4d(as(from, "phylo4"), tip.data = data.frame())
+})
+
+##' @name setAs
+##' @rdname setAs-methods
+##' @aliases as,nexml,phylo4-method
+setAs("nexml", "phylo4", function(from, to) {
+ phylo4(from)
+})
+
+##' @name setAs
+##' @rdname setAs-methods
+##' @aliases as,nexml,phylo4d-method
+setAs("nexml", "phylo4d", function(from, to) {
+ phylo4d(from)
+})
+
+#######################################################
+## Exporting to ape
+
+
+## BMB: adding an explicit as method, and the warning,
+## here is a very bad idea, because
+## even implicit conversions from phylo4d to phylo4 (e.g.
+## to use inherited methods) will produce the warning
+
+## setAs("phylo4d", "phylo4",function(from,to) {
+## warning("losing data while coercing phylo4d to phylo")
+## phylo4(from at edge, from at edge.length, from at tip.label,
+## from at node.label,from at edge.label,from at order)
+## })
+
+##' @name setAs
+##' @rdname setAs-methods
+##' @aliases as,phylo4,phylo-method
+setAs("phylo4", "phylo", function(from, to) {
+
+ if(is.character(checkval <- checkPhylo4(from))) {
+ stop(checkval)
+ }
+
+ if (inherits(from, "phylo4d"))
+ warning("losing data while coercing phylo4d to phylo")
+
+ phy <- list()
+
+ ## Edge matrix (dropping root edge if it exists)
+ edgemat <- unname(edges(from, drop.root=TRUE))
+ storage.mode(edgemat) <- "integer"
+ phy$edge <- edgemat
+
+ ## Edge lengths
+ if(hasEdgeLength(from)) {
+ edge.length <- edgeLength(from)
+ if(isRooted(from)) {
+ iRoot <- match(edgeId(from, "root"), names(edge.length))
+ phy$edge.length <- unname(edge.length[-iRoot])
+ }
+ else {
+ phy$edge.length <- unname(edge.length)
+ }
+ }
+
+ ## Tip labels
+ phy$tip.label <- unname(tipLabels(from))
+
+ ## nNodes
+ phy$Nnode <- as.integer(nNodes(from))
+
+ ## Node labels
+ if(hasNodeLabels(from)) {
+ phy$node.label <- unname(nodeLabels(from))
+ }
+
+ ## Root edge
+ if(isRooted(from) && hasEdgeLength(from)) {
+ root.edge <- unname(edgeLength(from,rootNode(from)))
+ if(!is.na(root.edge)) {
+ phy$root.edge <- root.edge
+ }
+ }
+
+ ## Converting to class phylo
+ class(phy) <- "phylo"
+
+ ## Tree order
+ ## TODO postorder != pruningwise -- though quite similar
+ if (edgeOrder(from) == "unknown") {
+ warning("trees with unknown order may be",
+ " unsafe in ape")
+ }
+ else {
+ attr(phy, "order") <- switch(edgeOrder(from),
+ postorder = "unknown",
+ preorder = "cladewise",
+ pruningwise = "pruningwise")
+ }
+ phy
+})
+
+
+## BMB: redundant????
+## JR: updated (but untested) to reflect slot changes, in case this ever
+## needs to come out of its commented hibernation
+## setAs("phylo4d", "phylo", function(from, to) {
+## y <- list(edge = edges(from, drop.root=TRUE),
+## Nnode = nNodes(from), tip.label = tipLabels(from))
+## class(y) <- "phylo"
+## if (hasEdgeLength(from))
+## y$edge.length <- edgeLength(from)
+## if (hasNodeLabels(from))
+## y$node.label <- nodeLabels(from)
+## #if (!is.na(from at root.edge))
+## # y$root.edge <- from at root.edge
+## warning("losing data while coercing phylo4d to phylo")
+## y
+##})
+
+
+#######################################################
+## Exporting to ade4
+
+##' @name setAs
+##' @rdname setAs-methods
+##' @aliases setAs,phylo4,phylog-method
+setAs("phylo4", "phylog", function(from, to) {
+ x <- as(from, "phylo")
+ xstring <- write.tree(x, file = "")
+ warning("ade4::phylog objects are deprecated, please use the adephylo package instead")
+ ade4::newick2phylog(xstring)
+})
+
+#######################################################
+## Exporting to dataframe
+
+.phylo4ToDataFrame <- function(from, edgeOrder=c("pretty", "real")) {
+
+ edgeOrder <- match.arg(edgeOrder)
+
+ ## Check the phylo4
+ if (is.character(checkval <- checkPhylo4(from)))
+ stop(checkval)
+
+ ## The order of 'node' defines the order of all other elements
+ if (edgeOrder == "pretty") {
+ node <- nodeId(from, "all")
+ ancestr <- ancestor(from, node)
+
+ # ancestor returns an NA, replace this w/ 0 to construct names correctly
+ ancestr[is.na(ancestr)] <- as.integer(0)
+ } else {
+ E <- edges(from)
+ node <- E[, 2]
+ ancestr <- E[, 1]
+ }
+
+ ## extract and reorder (as needed) other object slots
+ nmE <- paste(ancestr, node, sep="-")
+ edge.length <- edgeLength(from)
+ edge.length <- edge.length[match(nmE, names(edge.length))]
+
+ ndType <- nodeType(from)
+ ndType <- ndType[match(node, names(ndType))]
+ label <- labels(from, type="all")
+ label <- label[match(node, names(label))]
+
+ tDf <- data.frame(label, node, ancestor=ancestr, edge.length,
+ node.type=ndType, row.names=node)
+ tDf$label <- as.character(tDf$label)
+
+ if (class(from) == "phylo4d") {
+ dat <- tdata(from, "all", label.type="column") # get data
+
+ ## reorder data to edge matrix order, drop labels (first column)
+ if(nrow(dat) > 0 && ncol(dat) > 1) {
+ dat <- dat[match(rownames(tDf), rownames(dat)), ]
+ tDf <- cbind(tDf, dat[ ,-1 , drop=FALSE])
+ }
+ else {
+ cat("No data associated with the tree\n")
+ }
+ }
+ tDf
+}
+
+##' @name setAs
+##' @rdname setAs-methods
+##' @aliases setAs,phylo4,data.frame-method
+setAs(from = "phylo4", to = "data.frame", def=function(from) {
+ d <- .phylo4ToDataFrame(from, edgeOrder="pretty")
+ d
+})
diff --git a/R/shortestPath-methods.R b/R/shortestPath-methods.R
new file mode 100644
index 0000000..24ae9ff
--- /dev/null
+++ b/R/shortestPath-methods.R
@@ -0,0 +1,67 @@
+
+
+.shortestPathInt <- function(phy, node1, node2){
+ ## some checks
+ ## if (is.character(checkval <- checkPhylo4(x))) stop(checkval) # no need
+ t1 <- getNode(phy, node1)
+ t2 <- getNode(phy, node2)
+ if(any(is.na(c(t1,t2)))) stop("wrong node specified")
+ if(t1==t2) return(NULL)
+
+ ## main computations
+ comAnc <- MRCA(phy, t1, t2) # common ancestor
+ desComAnc <- descendants(phy, comAnc, type="all")
+ ancT1 <- ancestors(phy, t1, type="all")
+ path1 <- intersect(desComAnc, ancT1) # path: common anc -> t1
+
+ ancT2 <- ancestors(phy, t2, type="all")
+ path2 <- intersect(desComAnc, ancT2) # path: common anc -> t2
+
+ res <- union(path1, path2) # union of the path
+ ## add the common ancestor if it differs from t1 or t2
+ if(!comAnc %in% c(t1,t2)){
+ res <- c(comAnc,res)
+ }
+
+ res <- getNode(phy, res)
+
+ return(res)
+}
+
+##' Finds the shortest path between two nodes in a tree
+##'
+##' Given two nodes (i.e, tips or internal nodes), this function
+##' returns the shortest path between them (excluding \code{node1} and
+##' \code{node2} as a vector of nodes.
+##' @title shortestPath-methods
+##' @param x a tree in the phylo4, phylo4d or phylo format
+##' @param node1 a numeric or character (passed to \code{getNode})
+##' indicating the beginning from which the path should be calculated.
+##' @param node2 a numeric or character (passed to \code{getNode})
+##' indicating the end of the path.
+##' @return a vector of nodes indcating the shortest path between 2 nodes
+##' @seealso getNode
+##' @rdname shortestPath-methods
+##' @docType methods
+##' @include MRCA-methods.R
+##' @export
+setGeneric("shortestPath", function(x, node1, node2) {
+ standardGeneric("shortestPath")
+})
+
+##' @name shortestPath-phylo4
+##' @rdname shortestPath-methods
+##' @aliases shortestPath,phylo4-method
+setMethod("shortestPath", signature(x="phylo4", node1="ANY", node2="ANY"),
+ function(x, node1, node2) {
+ .shortestPathInt(phy=x, node1=node1, node2=node2)
+ })
+
+##' @name shortestPath-phylo
+##' @rdname shortestPath-methods
+##' @aliases shortestPath,phylo-method
+setMethod("shortestPath", signature(x="phylo", node1="ANY", node2="ANY"),
+ function(x, node1, node2) {
+ phy <- as(x, "phylo4")
+ .shortestPathInt(phy=phy, node1=node1, node2=node2)
+ })
diff --git a/R/subset-methods.R b/R/subset-methods.R
new file mode 100644
index 0000000..5a4b22f
--- /dev/null
+++ b/R/subset-methods.R
@@ -0,0 +1,429 @@
+################
+## subset phylo4
+################
+
+##' Methods for creating subsets of phylogenies
+##'
+##' Methods for creating subsets of phylogenies, based on pruning a
+##' tree to include or exclude a set of terminal taxa, to include all
+##' descendants of the MRCA of multiple taxa, or to return a subtree
+##' rooted at a given node.
+##'
+##' The \code{subset} methods must be called using no more than one of
+##' the four main subsetting criteria arguments (\code{tips.include},
+##' \code{tips.exclude}, \code{mrca}, or \code{node.subtree}). Each
+##' of these arguments can be either character or numeric. In the
+##' first case, they are treated as node labels; in the second case,
+##' they are treated as node numbers. For the first two arguments,
+##' any supplied tips not found in the tree (\code{tipLabels(x)}) will
+##' be ignored, with a warning. Similarly, for the \code{mrca}
+##' argument, any supplied tips or internal nodes not found in the
+##' tree will be ignored, with a warning. For the \code{node.subtree}
+##' argument, failure to provide a single, valid internal node will
+##' result in an error.
+##'
+##' Although \code{prune} is mainly intended as the workhorse function
+##' called by \code{subset}, it may also be called directly. In
+##' general it should be equivalent to the \code{tips.exclude} form of
+##' \code{subset} (although perhaps with less up-front error
+##' checking).
+##'
+##' The "[" operator, when used as \code{x[i]}, is similar to the
+##' \code{tips.include} form of \code{subset}. However, the indices
+##' used with this operator can also be logical, in which case the
+##' corresponding tips are assumed to be ordered as in \code{nodeId(x,
+##' "tip")}, and recycling rules will apply (just like with a vector
+##' or a matrix). With a \linkS4class{phylo4d} object 'x',
+##' \code{x[i,j]} creates a subset of \code{x} taking \code{i} for a
+##' tip index and \code{j} for the index of data variables in
+##' \code{tdata(geospiza, "all")}. Note that the second index is
+##' optional: \code{x[i, TRUE]}, \code{x[i,]}, and \code{x[i]} are all
+##' equivalent.
+##'
+##' Regardless of which approach to subsetting is used, the argument
+##' values must be such that at least two tips are retained.
+##'
+##' If the most recent common ancestor of the retained tips is not the
+##' original root node, then the root node of the subset tree will be
+##' a descendant of the original root. For rooted trees with non-NA
+##' root edge length, this has implications for the new root edge
+##' length. In particular, the new length will be the summed edge
+##' length from the new root node back to the original root (including
+##' the original root edge). As an alternative, see the examples for
+##' a way to determine the length of the edge that was immediately
+##' ancestral to the new root node in the original tree.
+##'
+##' Note that the correspondance between nodes and labels (and data in
+##' the case of \linkS4class{phylo4d}) will be retained after all
+##' forms of subsetting. Beware, however, that the node numbers (IDs)
+##' will likely be altered to reflect the new tree topology, and
+##' therefore cannot be compared directly between the original tree
+##' and the subset tree.
+##'
+##' @name subset-methods
+##' @docType methods
+##' @param x an object of class \code{"phylo4"} or \code{"phylo4d"}
+##' @param tips.include A vector of tips to include in the subset tree
+##' @param tips.exclude A vector of tips to exclude from the subset
+##' tree
+##' @param mrca A vector of nodes for determining the most recent
+##' common ancestor, which is then used as the root of the subset tree
+##' @param node.subtree A single internal node specifying the root of
+##' the subset tree
+##' @param trim.internal A logical specifying whether to remove
+##' internal nodes that no longer have tip descendants in the subset
+##' tree
+##' @param i (\code{[} method) An index vector indicating tips to
+##' include
+##' @param j (\code{[} method, phylo4d only) An index vector
+##' indicating columns of node/tip data to include
+##' @param drop (not in use: for compatibility with the generic method)
+##' @param \dots optional additional parameters (not in use)
+##' @return an object of class \code{"phylo4"} or \code{"phylo4d"}
+##' @section Methods: \describe{ \item{x = "phylo4"}{subset tree}
+##' \item{x = "phylo4d"}{subset tree and corresponding node and tip
+##' data} }
+##' @author Jim Regetz \email{regetz@@nceas.ucsb.edu}\cr Steven Kembel
+##' \email{skembel@@berkeley.edu}\cr Damien de Vienne
+##' \email{damien.de-vienne@@u-psud.fr}\cr Thibaut Jombart
+##' \email{jombart@@biomserv.univ-lyon1.fr}
+##' @keywords methods
+##' @rdname subset-methods
+##' @aliases subset
+##' @examples
+##' data(geospiza)
+##' nodeLabels(geospiza) <- paste("N", nodeId(geospiza, "internal"), sep="")
+##' geotree <- extractTree(geospiza)
+##'
+##' ## "subset" examples
+##' tips <- c("difficilis", "fortis", "fuliginosa", "fusca", "olivacea",
+##' "pallida", "parvulus", "scandens")
+##' plot(subset(geotree, tips.include=tips))
+##' plot(subset(geotree, tips.include=tips, trim.internal=FALSE))
+##' plot(subset(geotree, tips.exclude="scandens"))
+##' plot(subset(geotree, mrca=c("scandens","fortis","pauper")))
+##' plot(subset(geotree, node.subtree=18))
+##'
+##' ## "prune" examples (equivalent to subset using tips.exclude)
+##' plot(prune(geotree, tips))
+##'
+##' ## "[" examples (equivalent to subset using tips.include)
+##' plot(geotree[c(1:6,14)])
+##' plot(geospiza[c(1:6,14)])
+##'
+##' ## for phylo4d, subset both tips and data columns
+##' geospiza[c(1:6,14), c("wingL", "beakD")]
+##'
+##' ## note handling of root edge length:
+##' edgeLength(geotree)['0-15'] <- 0.1
+##' geotree2 <- geotree[1:2]
+##' ## in subset tree, edge of new root extends back to the original root
+##' edgeLength(geotree2)['0-3']
+##' ## edge length immediately ancestral to this node in the original tree
+##' edgeLength(geotree, MRCA(geotree, tipLabels(geotree2)))
+##' @exportMethod subset
+setGeneric("subset")
+
+##' @rdname subset-methods
+## @aliases subset,phylo4-method
+setMethod("subset", "phylo4", function(x, tips.include=NULL,
+ tips.exclude=NULL, mrca=NULL, node.subtree=NULL, ...) {
+ ## FIXME: could eliminate NULL and make the test
+ ## if (!missing) rather than if (!is.null)
+ ## (might have to change next line?)
+ if (sum(!sapply(list(tips.include, tips.exclude, mrca,
+ node.subtree), is.null))>1) {
+ stop("must specify at most one criterion for subsetting")
+ }
+ all.tips <- nodeId(x, "tip")
+ if (!is.null(tips.include)) {
+ nodes <- getNode(x, tips.include, missing="OK")
+ is.valid.tip <- nodes %in% all.tips
+ kept <- nodes[is.valid.tip]
+ dropped <- setdiff(all.tips, kept)
+ unknown <- tips.include[!is.valid.tip]
+ } else if (!is.null(tips.exclude)) {
+ nodes <- getNode(x, tips.exclude, missing="OK")
+ is.valid.tip <- nodes %in% all.tips
+ dropped <- nodes[is.valid.tip]
+ kept <- setdiff(all.tips, dropped)
+ unknown <- tips.exclude[!is.valid.tip]
+ } else if (!is.null(mrca)) {
+ nodes <- getNode(x, mrca, missing="OK")
+ is.valid.node <- nodes %in% nodeId(x, "all")
+ mnode <- MRCA(x, nodes[is.valid.node])
+ if (length(mnode)!=1) {
+ stop("mrca must include at least one valid node")
+ }
+ kept <- descendants(x, mnode)
+ dropped <- setdiff(all.tips, kept)
+ unknown <- mrca[!is.valid.node]
+ } else if (!is.null(node.subtree)) {
+ node <- getNode(x, node.subtree, missing="OK")
+ if (length(node)!=1 || !(node %in% nodeId(x, "internal"))) {
+ stop("node.subtree must be a single valid internal node")
+ }
+ kept <- descendants(x, node)
+ dropped <- setdiff(all.tips, kept)
+ unknown <- numeric(0)
+ } else {
+ kept <- getNode(x, nodeId(x, "tip"))
+ dropped <- numeric(0)
+ unknown <- numeric(0)
+ }
+ if (length(unknown)>0) {
+ warning("invalid nodes ignored: ", paste(unknown,
+ collapse=", "))
+ }
+ if (length(kept)<2) {
+ stop("0 or 1 tips would remain after subsetting")
+ }
+ if (length(dropped)==0) return(x)
+ return(prune(x, dropped, ...))
+})
+
+###############
+# '[' operator
+###############
+
+## Consider using some combination of these for stricter argument
+## checking? Not implementing now because extra arguments are just
+## ignored, which is fairly common S4 method behavior:
+## * in "[" methods for phylo4:
+## if (nargs()>2) stop("unused arguments")
+## * in "[" methods for both phylo4 and phylo4d:
+## if (!missing(...)) stop("unused argument(s)")
+
+##' @rdname subset-methods
+##' @exportMethod "["
+##' @export
+setGeneric("[")
+
+##### -------- phylo4 '[' methods
+
+##' @rdname subset-methods
+## @aliases [,phylo4,character,missing-method
+setMethod("[", signature(x="phylo4", i="character", j="missing",
+ drop="missing"), function(x, i, j, ..., drop) {
+ subset(x, tips.include=i)
+})
+
+##' @rdname subset-methods
+## @aliases [,phylo4,numeric,missing-method
+setMethod("[", signature(x="phylo4", i="numeric", j="missing",
+ drop="missing"), function(x, i, j, ..., drop) {
+ subset(x, tips.include=i)
+})
+
+##' @rdname subset-methods
+## @aliases [,phylo4,logical,missing-method
+setMethod("[", signature(x="phylo4", i="logical", j="missing",
+ drop="missing"), function(x, i, j, ..., drop) {
+ subset(x, tips.include=nodeId(x, "tip")[i])
+})
+
+##' @rdname subset-methods
+## @aliases [,phylo4,missing,missing-method
+setMethod("[", signature(x="phylo4", i="missing", j="missing",
+ drop="missing"), function(x, i, j, ..., drop) {
+ return(x)
+})
+
+##### -------- phylo4d '[' methods
+
+##' @rdname subset-methods
+## @aliases [,phylo4d,ANY,character,missing-method
+setMethod("[", signature(x="phylo4d", i="ANY", j="character",
+ drop="missing"), function(x, i, j, ..., drop) {
+ if (!missing(i)) x <- x[i]
+ tdata(x, type="all") <- tdata(x, type="all")[j]
+ return(x)
+})
+
+##' @rdname subset-methods
+## @aliases [,phylo4d,ANY,numeric,missing-method
+setMethod("[", signature(x="phylo4d", i="ANY", j="numeric",
+ drop="missing"), function(x, i, j, ..., drop) {
+ if (!missing(i)) x <- x[i]
+ tdata(x, type="all") <- tdata(x, type="all")[j]
+ return(x)
+})
+
+##' @rdname subset-methods
+## @aliases [,phylo4d,ANY,logical,missing-method
+setMethod("[", signature(x="phylo4d", i="ANY", j="logical",
+ drop="missing"), function(x, i, j, ..., drop) {
+ if (!missing(i)) x <- x[i]
+ tdata(x, type="all") <- tdata(x, type="all")[j]
+ return(x)
+})
+
+## borrow from Matrix package approach of trapping invalid usage
+##' @rdname subset-methods
+## @aliases [,phylo4,ANY,ANY,ANY-method
+setMethod("[", signature(x="phylo4", i="ANY", j="ANY", drop="ANY"),
+ function(x, i, j, ..., drop) {
+ stop("invalid argument(s)")
+})
+
+##### -------- prune
+
+##' @rdname subset-methods
+## @aliases prune
+##' @export
+setGeneric("prune", function(x, ...) {
+ standardGeneric("prune")
+})
+
+## return characters, sorted in NUMERIC order
+.chnumsort <- function(x) {
+ as.character(sort(as.numeric(x)))
+}
+
+##' @rdname subset-methods
+## @aliases prune,phylo4-method
+setMethod("prune", "phylo4",
+ function(x, tips.exclude, trim.internal=TRUE) {
+
+ makeEdgeNames <- function(edge) {
+ paste(edge[,1], edge[,2], sep="-")
+ }
+
+ ## drop tips and obsolete internal nodes from edge matrix
+ tip.drop <- getNode(x, tips.exclude, missing="fail")
+ tip.keep <- setdiff(nodeId(x, "tip"), tip.drop)
+ nodes <- nodeId(x, "all")
+ node.keep <- rep(FALSE, length(nodes))
+ node.keep[tip.keep] <- TRUE
+ if (trim.internal) {
+ if (edgeOrder(x) == "postorder") {
+ edge.post <- edges(x)
+ } else {
+ edge.post <- edges(reorder(x, "postorder"))
+ }
+ for (i in seq_along(edge.post[,2])) {
+ if (node.keep[edge.post[i,2]]) {
+ node.keep[edge.post[i,1]] <- TRUE
+ }
+ }
+ } else {
+ node.keep[nodeId(x, "internal")] <- TRUE
+ }
+ edge.new <- edges(x)[edges(x)[,2] %in% nodes[node.keep], ]
+
+ ## remove singletons
+ edge.length.new <- edgeLength(x)
+ edge.label.new <- edgeLabels(x)
+ singletons <- which(tabulate(edge.new[edge.new[, 1] != 0, 1])==1)
+ while (length(singletons)>0) {
+ sing.node <- singletons[1]
+
+ ## update edge matrix
+ edges.drop <- which(edge.new==sing.node, arr.ind=TRUE)[,"row"]
+ sing.edges <- edge.new[edges.drop,]
+ edge.new[edges.drop[2], ] <- c(sing.edges[2,1], sing.edges[1,2])
+ edge.new <- edge.new[-edges.drop[1], ]
+
+ ## update edge lengths and edge labels
+ edge.names.drop <- makeEdgeNames(sing.edges)
+ edge.name.new <- paste(sing.edges[2,1], sing.edges[1,2], sep="-")
+ edge.length.new[edge.name.new] <-
+ sum(edge.length.new[edge.names.drop])
+ edge.length.new <- edge.length.new[-match(edge.names.drop,
+ names(edge.length.new))]
+ edge.label.new[edge.name.new] <- NA
+ edge.label.new <- edge.label.new[-match(edge.names.drop,
+ names(edge.label.new))]
+
+ singletons <- which(tabulate(edge.new[edge.new[, 1] != 0, 1])==1)
+ }
+
+ ## remove dropped elements from labels
+ label.new <- labels(x)[names(labels(x)) %in% edge.new]
+
+ ## subset and order edge.length and edge.label with respect to edge
+ edge.names <- makeEdgeNames(edge.new)
+ edge.length.new <- edge.length.new[edge.names]
+ edge.label.new <- edge.label.new[edge.names]
+
+ if (!trim.internal) {
+ ## make sure now-terminal internal nodes are treated as tips
+ tip.now <- setdiff(edge.new[,2], edge.new[,1])
+ tip.add <- tip.now[tip.now>nTips(x)]
+ if (length(tip.add)>0) {
+ ind <- match(tip.add, names(label.new))
+
+ ## node renumbering workaround to satisfy plot method
+ newid <- sapply(tip.add, function(tip) descendants(x, tip)[1])
+ names(label.new)[ind] <- newid
+ edge.new[match(tip.add, edge.new)] <- newid
+ tip.now[match(tip.add, tip.now)] <- newid
+
+ isTip <- edge.new %in% tip.now
+ edge.new[isTip] <- match(edge.new[isTip],
+ sort(unique.default(edge.new[isTip])))
+ }
+ }
+
+ ## renumber nodes in the edge matrix
+ edge.new[] <- match(edge.new, sort(unique.default(edge.new))) - 1L
+
+ ## update corresponding element names in the other slots
+ edge.names <- makeEdgeNames(edge.new)
+ names(edge.length.new) <- edge.names
+ names(edge.label.new) <- edge.names
+ label.new <- label.new[order(as.numeric(names(label.new)))]
+ names(label.new) <- seq_along(label.new)
+
+ ## update, check, then return the pruned phylo4 object
+ x at edge <- edge.new
+ ##TODO would prefer to leave out NA from edge.length slot, but can't
+ x at edge.length <- edge.length.new
+ x at edge.label <- edge.label.new[!is.na(edge.label.new)]
+ x at label <- label.new[!is.na(label.new)]
+ if(is.character(checkval <- checkPhylo4(x))) {
+ stop(checkval)
+ } else {
+ return(x)
+ }
+
+})
+
+##' @rdname subset-methods
+## @aliases prune,phylo4d-method
+setMethod("prune", "phylo4d",
+ function(x, tips.exclude, trim.internal=TRUE) {
+
+ tree <- extractTree(x)
+ phytr <- prune(tree, tips.exclude, trim.internal)
+
+ ## create temporary phylo4 object with complete and unique labels
+ tmpLbl <- .genlab("n", nTips(x)+nNodes(x))
+ tmpPhy <- tree
+ labels(tmpPhy, "all") <- tmpLbl
+ tmpPhytr <- prune(tmpPhy, getNode(x, tips.exclude), trim.internal)
+
+ ## get node numbers to keep
+ oldLbl <- labels(tmpPhy, "all")
+ newLbl <- labels(tmpPhytr, "all")
+ wasKept <- oldLbl %in% newLbl
+ nodesToKeep <- as.numeric(names(oldLbl[wasKept]))
+
+ ## subset original data, and update names
+ allDt <- x at data[match(nodesToKeep, rownames(x at data)), , drop=FALSE]
+ rownames(allDt) <- match(newLbl, oldLbl[wasKept])
+
+ phytr <- phylo4d(phytr, all.data=allDt, match.data=TRUE)
+
+ phytr
+})
+
+## setMethod("prune","ANY",
+## function(phy, tip, trim.internal = TRUE, subtree = FALSE,
+## ,...) {
+## if (class(phy)=="phylo") {
+## ape::prune(phy, tip, trim.internal, subtree)
+## } else stop("no prune method available for",
+## deparse(substitute(phy)),
+## "(class",class(phy),")")
+## })
diff --git a/R/summary-methods.R b/R/summary-methods.R
new file mode 100644
index 0000000..a481a78
--- /dev/null
+++ b/R/summary-methods.R
@@ -0,0 +1,251 @@
+
+##' Summary for phylo4/phylo4d objects
+##'
+##' Summary of information for the tree (\code{phylo4} only) and/or the
+##' associated data (\code{phylo4d}).
+##'
+##' @name summary-methods
+##' @docType methods
+##' @param object a phylo4d object
+##' @param quiet Should the summary be displayed on screen?
+##' @param \dots optional additional elements (not in use)
+##'
+##' @return The \code{nodeType} method returns named vector which has
+##' the type of node (internal, tip, root) for value, and the node number
+##' for name
+##'
+##' The \code{summary} method invisibly returns a list with the
+##' following components: \item{list("name")}{the name of the object}
+##'
+##' \item{list("nb.tips")}{the number of tips}
+##'
+##' \item{list("nb.nodes")}{the number of nodes}
+##'
+##' \item{list("mean.el")}{mean of edge lengths}
+##'
+##' \item{list("var.el")}{variance of edge lengths (estimate for population) }
+##'
+##' \item{list("sumry.el")}{summary (i.e. range and quartiles) of the
+##' edge lengths}
+##'
+##' \item{list("degree")}{(optional) type of polytomy for each node:
+##' \sQuote{node}, \sQuote{terminal} (all descendants are tips) or
+##' \sQuote{internal} (at least one descendant is an internal node);
+##' displayed only when there are polytomies}
+##'
+##' \item{list("sumry.tips")}{(optional) summary for the data
+##' associated with the tips}
+##'
+##' \item{list("sumry.nodes")}{(optional) summary for the data
+##' associated with the internal nodes}
+##'
+##' @author Ben Bolker, Thibaut Jombart, Francois Michonneau
+##' @seealso \code{\link{phylo4d-methods}} constructor and
+##' \code{\linkS4class{phylo4d}} class.
+##' @keywords methods
+##' @aliases summary
+##' @include phylo4-methods.R
+##' @include phylo4d-methods.R
+##' @exportMethod summary
+##' @examples
+##' tOwls <- "(((Strix_aluco:4.2,Asio_otus:4.2):3.1,Athene_noctua:7.3):6.3,Tyto_alba:13.5);"
+##' tree.owls <- ape::read.tree(text=tOwls)
+##' P1 <- as(tree.owls, "phylo4")
+##' P1
+##' summary(P1)
+##' nodeType(P1)
+##'
+##' ## summary of a polytomous tree
+##' E <- matrix(c(
+##' 8, 9,
+##' 9, 10,
+##' 10, 1,
+##' 10, 2,
+##' 9, 3,
+##' 9, 4,
+##' 8, 11,
+##' 11, 5,
+##' 11, 6,
+##' 11, 7,
+##' 0, 8), ncol=2, byrow=TRUE)
+##'
+##' P2 <- phylo4(E)
+##' nodeLabels(P2) <- as.character(nodeId(P2, "internal"))
+##' plot(P2, show.node.label=TRUE)
+##' sumryP2 <- summary(P2)
+##' sumryP2
+##'
+setGeneric("summary")
+
+##' @rdname summary-methods
+##' @aliases summary,phylo4-method
+setMethod("summary", signature(object="phylo4"),
+ function(object, quiet=FALSE) {
+
+ res <- list()
+
+ ## build the result object
+ res$name <- deparse(substitute(object, sys.frame(-1)))
+ res$nb.tips <- nTips(object)
+ res$nb.nodes <- nNodes(object)
+
+ if(hasEdgeLength(object)) {
+ edge.length <- edgeLength(object)
+ res$mean.el <- mean(edge.length, na.rm=TRUE)
+ res$var.el <- stats::var(edge.length, na.rm=TRUE)
+ if (isRooted(object) && is.na(edgeLength(object, rootNode(object)))) {
+ root.index <- match(edgeId(object, "root"), names(edge.length))
+ res$sumry.el <- summary(edge.length[-root.index])
+ } else {
+ res$sumry.el <- summary(edge.length)
+ }
+ }
+
+ ## check for polytomies
+ if (hasPoly(object)) {
+ E <- edges(object)
+ temp <- tabulate(E[,1][!is.na(E[, 1])])
+ degree <- temp[E[,1][!is.na(E[, 1])]] # contains the degree of the ancestor for all edges
+ endsAtATip <- !(E[,2] %in% E[,1])
+ terminPoly <- (degree>2) & endsAtATip
+ internPoly <- (degree>2) & !endsAtATip
+ res$degree <- degree
+ res$polytomy <- rep("none",nrow(E))
+ res$polytomy[terminPoly] <- "terminal"
+ res$polytomy[internPoly] <- "internal"
+ ## now just keep information about nodes (not all edges)
+ nod <- unique(E[,1])
+ idx <- match(nod,E[,1])
+ res$degree <- res$degree[idx]
+ names(res$degree) <- nodeLabels(object)
+ res$polytomy <- res$polytomy[idx]
+ names(res$polytomy) <- nodeLabels(object)
+ }
+
+ ## model info
+ res$loglik <- attr(object, "loglik")
+ res$para <- attr(object, "para")
+ res$xi <- attr(object, "xi")
+
+ ## if quiet, stop here
+ if(quiet) return(invisible(res))
+
+ ## now, print to screen is !quiet
+ cat("\n Phylogenetic tree :", res$name, "\n\n")
+ cat(" Number of tips :", res$nb.tips, "\n")
+ cat(" Number of nodes :", res$nb.nodes, "\n")
+ ## cat(" ")
+ if(hasEdgeLength(object)) {
+ cat(" Branch lengths:\n")
+ cat(" mean :", res$mean.el, "\n")
+ cat(" variance :", res$var.el, "\n")
+ cat(" distribution :\n")
+ print(res$sumry.el)
+ }
+ else {
+ cat(" Branch lengths : No branch lengths.\n")
+ }
+ if (hasPoly(object)) {
+ cat("\nDegree of the nodes :\n")
+ print(res$degree)
+ cat("\n")
+ cat("Types of polytomy:\n")
+ print(res$polytomy)
+ cat("\n")
+ }
+
+ if (!is.null(attr(object, "loglik"))) {
+ cat("Phylogeny estimated by maximum likelihood.\n")
+ cat(" log-likelihood:", attr(object, "loglik"), "\n\n")
+ npart <- length(attr(object, "para"))
+ for (i in 1:npart) {
+ cat("partition ", i, ":\n", sep = "")
+ print(attr(object, "para")[[i]])
+ if (i == 1)
+ next
+ else cat(" contrast parameter (xi):", attr(object,"xi")[i - 1], "\n")
+ }
+ }
+ return(invisible(res))
+
+ })
+
+
+##' @rdname summary-methods
+##' @aliases summary,phylo4d-method
+setMethod("summary", signature(object="phylo4d"),
+ function(object, quiet=FALSE) {
+ x <- object
+ res <- summary(as(x, "phylo4"), quiet=quiet)
+ res$name <- deparse(substitute(object, sys.frame(-1)))
+ tips <- tdata(object, "tip")
+ nodes <- tdata(object, "internal")
+
+ if (!quiet)
+ cat("\nComparative data:\n")
+
+ if (nrow(tips) > 0) {
+ if(!quiet) {
+ cat("\nTips: data.frame with", nTips(object), "taxa and",
+ ncol(tips), "variable(s) \n\n")
+ }
+ sumry.tips <- summary(tips)
+ res$sumry.tips <- sumry.tips
+ if (!quiet)
+ print(sumry.tips)
+ }
+ else {
+ if (!quiet)
+ cat("\nObject contains no tip data.")
+ }
+ if (nrow(nodes) > 0) {
+ if (!quiet) {
+ cat("\nNodes: data.frame with", nNodes(object), "internal nodes and",
+ ncol(nodes), "variables \n\n")
+ }
+ sumry.nodes <- summary(nodes)
+ res$sumry.nodes <- sumry.nodes
+ if (!quiet)
+ print(sumry.nodes)
+ }
+ else {
+ if(!quiet)
+ cat("\nObject contains no node data.\n")
+ }
+ invisible(res)
+})
+
+##' @rdname summary-methods
+##' @aliases nodeType
+##' @export
+setGeneric("nodeType", function(object) {
+ standardGeneric("nodeType")
+})
+
+##' @rdname summary-methods
+##' @aliases nodeType,phylo4-method
+setMethod("nodeType", signature(object="phylo4"),
+ function(object) {
+ if(nTips(object) == 0)
+ return(NULL)
+ else {
+ ## strip out the root ancestor
+ nodesVect <- as.vector(edges(object))
+ nodesVect <- nodesVect[nodesVect != 0]
+ ## get a sorted list of the unique nodes
+ listNodes <- sort(unique(nodesVect))
+ t <- rep("internal", length(listNodes)) # FM: internal is default (I think it's safer)
+ names(t) <- listNodes
+
+ ## node number of real internal nodes
+ iN <- names(table(edges(object)[,1]))
+ ## node number that are not internal nodes (ie that are tips)
+ tN <- names(t)[!names(t) %in% iN]
+ t[tN] <- "tip"
+
+ ## if the tree is rooted
+ if(isRooted(object)) t[rootNode(object)] <- "root"
+
+ return(t)
+ }
+})
diff --git a/R/tbind.R b/R/tbind.R
new file mode 100644
index 0000000..2e9f04a
--- /dev/null
+++ b/R/tbind.R
@@ -0,0 +1,44 @@
+## appropriate behavior ???
+
+## IF all missing data -- create multiPhylo4
+## IF some have data -- create multiPhylo4d (user can coerce to multiPhylo4)
+## IF (checkData) then stop if all data not identical to first data
+##
+## need constructors for multiPhylo4, multiPhylo4d!!
+## FIXME: need code to construct tree.names ...
+
+## function to bind trees together into a multi-tree object
+tbind <- function(...,checkData=TRUE) {
+ L <- list(...)
+ namevec <- names(L)
+ treeclasses <- c("multiPhylo4d","multiPhylo4","phylo4","phylo4d")
+ tdataclasses <- c("multiPhylo4d","phylo4d")
+ classes <- sapply(L,class)
+ if (!all(classes %in% treeclasses)) {
+ stop("all elements must be trees or multitrees")
+ }
+ hasData <- any(classes %in% tdataclasses)
+ allData <- all(classes %in% tdataclasses)
+ xfun <- function(x) {
+ switch(class(x),
+ phylo4=x,
+ phylo4d=extractTree(x),
+ multiPhylo4=x at phylolist,
+ multiPhylo4d=suppressWarnings(as("multiPhylo4",x)@phylolist))}
+ ## decompose multi-trees into lists
+ treelist <- unlist(lapply(L,xfun))
+ if (hasData) alldat <- lapply(L[classes %in% tdataclasses], tdata,
+ type="tip")
+ hasNodeData <- sapply(L[classes %in% tdataclasses], hasNodeData)
+ if (any(hasNodeData)) warning("internal node data discarded")
+ if (checkData) {
+ ident <- sapply(alldat,identical,y=alldat[[1]])
+ if (!all(ident)) stop(paste("tip data sets differ"))
+ } ## ?? implement code to check which ones differ (taking
+ ## null/multiple values in original set into account)
+ if (hasData) return(new("multiPhylo4d",phylolist=treelist,
+ tip.data=alldat[[1]]))
+ return(new("multiPhylo4",phylolist=treelist))
+}
+
+
diff --git a/R/tdata-methods.R b/R/tdata-methods.R
new file mode 100644
index 0000000..e775dc4
--- /dev/null
+++ b/R/tdata-methods.R
@@ -0,0 +1,212 @@
+##' Retrieving or updating tip and node data in phylo4d objects
+##'
+##' Methods to retrieve or update tip, node or all data associated with a
+##' phylogenetic tree stored as a phylo4d object
+##'
+##' @param x A \code{phylo4d} object
+##' @param type The type of data to retrieve or update: \dQuote{\code{all}}
+##' (default) for data associated with both tip and internal nodes,
+##' \dQuote{\code{tip}} for data associated with tips only,
+##' \dQuote{\code{internal}} for data associated with internal nodes only.
+##' @param label.type How should the tip/node labels from the tree be returned?
+##' \dQuote{\code{row.names}} returns them as row names of the data frame,
+##' \dQuote{\code{column}} returns them in the first column of the data frame.
+##' This options is useful in the case of missing (\code{NA}) or non-unique
+##' labels.
+##' @param empty.columns Should columns filled with \code{NA} be returned?
+##' @param merge.data if tip or internal node data are provided and data already
+##' exists for the other type, this determines whether columns with common names
+##' will be merged together (default TRUE). If FALSE, columns with common names
+##' will be preserved separately, with \dQuote{.tip} and \dQuote{.node} appended
+##' to the names. This argument has no effect if tip and node data have no
+##' column names in common, or if type=\dQuote{all}.
+##' @param clear.all If only tip or internal node data are to be replaced,
+##' should data of the other type be dropped?
+##' @param \dots For the \code{tipData} and \code{nodeData} accessors,
+##' further arguments to be used by \code{tdata}. For the replacement
+##' forms, further arguments to be used to control matching between
+##' tree and data (see Details section of \code{\link{phylo4d-methods}}).
+##' @param value a data frame (or object to be coerced to one) to replace the
+##' values associated with the nodes specified by the argument \code{type}
+##' @return \code{tdata} returns a data frame
+##' @section Methods: \describe{
+##' \item{tdata}{\code{signature(object="phylo4d")}: retrieve or update data
+##' associated with a tree in a \code{phylo4d} object} }
+##' @author Ben Bolker, Thibaut Jombart, Francois Michonneau
+##' @seealso \code{\link{phylo4d-methods}}, \code{\linkS4class{phylo4d}}
+##' @export
+##' @keywords methods
+##' @include phylo4d-methods.R
+##' @rdname tdata-methods
+##' @examples
+##' data(geospiza)
+##' tdata(geospiza)
+##' tipData(geospiza) <- 1:nTips(geospiza)
+##' tdata(geospiza)
+setGeneric("tdata", function(x, ...) {
+ standardGeneric("tdata")
+})
+
+##' @rdname tdata-methods
+##' @aliases tdata,phylo4d-method
+setMethod("tdata", signature(x="phylo4d"),
+ function(x, type=c("all", "tip", "internal"),
+ label.type=c("row.names","column"),
+ empty.columns=TRUE) {
+
+ ## Returns data associated with the tree
+ ## Note: the function checks for unique labels. It's currently unecessary
+ ## but could be useful in the future if non-unique labels are allowed.
+
+ type <- match.arg(type)
+ label.type <- match.arg(label.type)
+
+ ids <- nodeId(x, type)
+ labs <- labels(x, type)
+ ## replace any missing labels with node numbers
+ labs[is.na(labs)] <- names(labs)[is.na(labs)]
+ tdata <- x at data[match(ids, row.names(x at data)), , drop=FALSE]
+ row.names(tdata) <- ids
+ data.names <- labs[match(names(labs), rownames(tdata))]
+
+ if (label.type == "row.names") {
+ if (!any(duplicated(data.names)) &&
+ ## length(data.names) > 0 &&
+ !any(is.na(data.names)) ) {
+ row.names(tdata) <- data.names
+ }
+ else {
+ warning("Non-unique or missing labels found, ",
+ "labels cannot be coerced to tdata row.names. ",
+ "Use the label.type argument to include labels ",
+ "as first column of data.")
+ }
+ }
+ if (identical(label.type,"column")) {
+ tdata <- data.frame(label=data.names, tdata)
+ }
+
+ ## remove empty columns (filled with NAs)
+ if(!empty.columns) {
+ emptyCol <- apply(tdata, 2, function(x) all(is.na(x)))
+ tdata <- tdata[, !emptyCol, drop=FALSE]
+ }
+
+ tdata
+ })
+
+##' @rdname tdata-methods
+##' @aliases tdata<-
+##' @export
+setGeneric("tdata<-", function(x, ..., value) {
+ standardGeneric("tdata<-")
+})
+
+##' @name tdata<-
+##' @rdname tdata-methods
+##' @aliases tdata<-,phylo4d-method tdata<-,phylo4d,ANY-method
+setReplaceMethod("tdata", signature(x="phylo4d", value="ANY"),
+ function(x, type = c("all", "tip", "internal"), merge.data = TRUE,
+ clear.all = FALSE, ..., value) {
+
+ type <- match.arg(type)
+
+ ## format new data
+ value <- formatData(x, value, type, keep.all=TRUE, ...)
+
+ ## get old data to keep (if any)
+ if (clear.all || type=="all") {
+ keep <- NULL
+ } else {
+ if (type=="tip") {
+ keep <- tdata(x, type="internal", empty.column=FALSE)
+ keep <- formatData(x, keep, "internal", match.data=FALSE)
+ } else if (type=="internal") {
+ keep <- tdata(x, type="tip", empty.column=FALSE)
+ keep <- formatData(x, keep, "tip", match.data=FALSE)
+ }
+ }
+
+ ## create updated data
+ updated.data <- switch(type,
+ tip = .phylo4Data(x, tip.data=value, node.data=keep,
+ merge.data=merge.data),
+ internal = .phylo4Data(x, tip.data=keep, node.data=value,
+ merge.data=merge.data),
+ all = .phylo4Data(x, all.data=value, merge.data=merge.data))
+
+ ## try to arrange new columns after old columns
+ kept <- names(updated.data) %in% names(keep)
+ old.cols <- names(updated.data)[kept]
+ new.cols <- names(updated.data)[!kept]
+ x at data <- updated.data[c(old.cols, new.cols)]
+
+ if(is.character(checkval <- checkPhylo4(x))) stop(checkval)
+ return(x)
+})
+
+### Tip data wrappers
+##' @rdname tdata-methods
+##' @aliases tipData tipData-method
+##' @export
+setGeneric("tipData", function(x, ...) {
+ standardGeneric("tipData")
+})
+
+##' @name tipData
+##' @rdname tdata-methods
+##' @aliases tipData,phylo4d-method
+setMethod("tipData", signature(x="phylo4d"), function(x, ...) {
+ tdata(x, type="tip", ...)
+})
+
+## tipData<-
+##' @rdname tdata-methods
+##' @aliases tipData<-
+##' @export
+setGeneric("tipData<-", function(x, ..., value) {
+ standardGeneric("tipData<-")
+})
+
+##' @name tipData<-
+##' @rdname tdata-methods
+##' @aliases tipData<-,phylo4d-method tipData<-,phylo4d,ANY-method
+setReplaceMethod("tipData", signature(x="phylo4d", value="ANY"),
+ function(x, ..., value) {
+ tdata(x, type="tip", ...) <- value
+ if(is.character(checkval <- checkPhylo4(x))) stop(checkval)
+ return(x)
+})
+
+### Node data wrappers
+##' @rdname tdata-methods
+##' @aliases nodeData nodeData-method
+##' @export
+setGeneric("nodeData", function(x, ...) {
+ standardGeneric("nodeData")
+})
+
+##' @name nodeData
+##' @rdname tdata-methods
+##' @aliases nodeData,phylo4d-method
+setMethod("nodeData", signature(x="phylo4d"), function(x, ...) {
+ tdata(x, type="internal", ...)
+})
+
+## nodeData<-
+##' @rdname tdata-methods
+##' @aliases nodeData<-
+##' @export
+setGeneric("nodeData<-", function(x, ..., value) {
+ standardGeneric("nodeData<-")
+})
+
+##' @name nodeData<-
+##' @rdname tdata-methods
+##' @aliases nodeData<-,phylo4d-method nodeData<-,phylo4d,ANY-method
+setReplaceMethod("nodeData", signature(x="phylo4d", value="ANY"),
+ function(x, ..., value) {
+ tdata(x, type="internal", ...) <- value
+ if(is.character(checkval <- checkPhylo4(x))) stop(checkval)
+ return(x)
+})
diff --git a/R/treePlot.R b/R/treePlot.R
new file mode 100644
index 0000000..3e0aa1a
--- /dev/null
+++ b/R/treePlot.R
@@ -0,0 +1,784 @@
+##' Phylogeny plotting
+##'
+##' Plot \code{phylo4} or \code{phylo4d} objects, including associated data.
+##'
+##'
+##' @name treePlot-methods
+##' @aliases treePlot plot,ANY,ANY-method plot,pdata,missing-method
+##' plot,phylo4,missing-method treePlot-method treePlot,phylo4,phylo4d-method
+##' @docType methods
+##' @details Currently, \code{treePlot} can only plot numeric values
+##' for tree-associated data. The dataset will be subset to only
+##' include columns of class \code{numeric}, \code{integer} or
+##' \code{double}. If a \code{phylo4d} object is passed to the
+##' function and it contains no data, or if the data is in a format
+##' that cannot be plotted, the function will produce a warning. You
+##' can avoid this by using the argument \code{plot.data=FALSE}.
+##' @param phy A \code{phylo4} or \code{phylo4d} object
+##' @param x A \code{phylo4} or \code{phylo4d} object
+##' @param y (only here for compatibility)
+##' @param type A character string indicating the shape of plotted tree
+##' @param show.tip.label Logical, indicating whether tip labels should be shown
+##' @param show.node.label Logical, indicating whether node labels should be
+##' shown
+##' @param tip.order If NULL the tree is plotted with tips in preorder, if "rev"
+##' this is reversed. Otherwise, it is a character vector of tip labels,
+##' indicating their order along the y axis (from top to bottom). Or, a numeric
+##' vector of tip node IDs indicating the order.
+##' @param plot.data Logical indicating whether \code{phylo4d} data should be
+##' plotted
+##' @param rot Numeric indicating the rotation of the plot in degrees
+##' @param tip.plot.fun A function used to generate plot at the each tip of the
+##' phylogenetic trees
+##' @param edge.color A vector of colors in the order of \code{edges(phy)}
+##' @param node.color A vector of colors indicating the colors of the node
+##' labels
+##' @param tip.color A vector of colors indicating the colors of the tip labels
+##' @param edge.width A vector in the order of \code{edges(phy)} indicating the
+##' widths of edge lines
+##' @param newpage Logical indicating whether the page should be cleared before
+##' plotting
+##' @param plot.at.tip should the data plots be at the tip? (logical)
+##' @param margins number of lines around the plot (similar to \code{par(mar)}).
+##' @param \dots additional arguments
+##' @return No return value, function invoked for plotting side effect
+##' @section Methods: \describe{ \item{phy = "phylo4"}{plots a tree of class
+##' \linkS4class{phylo4}} \item{phy = "phylo4d"}{plots a tree with one or more
+##' quantitative traits contained in a \linkS4class{phylo4d} object.} }
+##' @author Peter Cowan \email{pdc@@berkeley.edu}, Francois Michonneau
+##' @seealso \code{\link{phylobubbles}}
+##' @keywords methods
+##' @export
+##' @examples
+##'
+##' ## example of plotting two grid plots on the same page
+##' library(grid)
+##' data(geospiza)
+##' geotree <- extractTree(geospiza)
+##' grid.newpage()
+##' pushViewport(viewport(layout=grid.layout(nrow=1, ncol=2), name="base"))
+##' pushViewport(viewport(layout.pos.col=1, name="plot1"))
+##' treePlot(geotree, newpage=FALSE)
+##' popViewport()
+##'
+##' pushViewport(viewport(layout.pos.col=2, name="plot2"))
+##' treePlot(geotree, newpage=FALSE, rot=180)
+##' popViewport(2)
+`treePlot` <- function(phy,
+ type = c('phylogram', 'cladogram', 'fan'),
+ show.tip.label = TRUE,
+ show.node.label = FALSE,
+ tip.order = NULL,
+ plot.data = is(phy, 'phylo4d'),
+ rot = 0,
+ tip.plot.fun = 'bubbles',
+ plot.at.tip = TRUE,
+ edge.color = 'black',
+ node.color = 'black', # TODO what do with node.color parameter
+ tip.color = 'black',
+ edge.width = 1, # TODO line-type modification hack
+ newpage = TRUE,
+ margins = c(1.1, 1.1, 1.1, 1.1), # number of lines, same as par(mar)
+ ...
+ )
+{
+ ## TODO three dimensional histogram as example, compute values on full dataset
+ ## then generate phylo4d object with summary data and plot
+
+ ## TODO factors not handled in data plots
+ ## TODO add symbols at the nodes, allow coloirng and sizing downViewport approach?
+ ## TODO cladogram methods incorrect
+ ## because we may reoder the tip, we need to update the phy objec
+
+ if (!inherits(phy, 'phylo4')) stop('treePlot requires a phylo4 or phylo4d object')
+ if (!isRooted(phy)) stop("treePlot function requires a rooted tree.")
+ if (plot.data) {
+ if (!hasTipData(phy)) {
+ warning("tree has no tip data to plot")
+ plot.data <- FALSE
+ }
+ else {
+ ## if new plotting functions are developped that allow users to plot other type of data
+ ## this needs to be removed/adjusted
+ ## other checks are being made in phylobubbles()
+ if (!any(sapply(tdata(phy, "tip"), function(x) class(x) %in% c("numeric", "double", "integer")))) {
+ warning("only numeric data can be plotted at this time")
+ plot.data <- FALSE
+ }
+ }
+ }
+ if (hasRetic(phy))
+ stop("treePlot requires non-reticulated trees.")
+
+ if(newpage) grid::grid.newpage()
+ type <- match.arg(type)
+ Nedges <- nEdges(phy)
+ Ntips <- nTips(phy)
+ if(!is.null(tip.order) && length(tip.order) > 1) { ## if length of tip.order is more than 1 it can't be "rev"
+ if(length(tip.order) != Ntips) {stop('tip.order must be the same length as nTips(phy)')}
+ if(is.numeric(tip.order)) {
+ tip.order <- tip.order
+ }
+ else {
+ if(is.character(tip.order)) {
+ tip.order <- as.numeric(names(tipLabels(phy))[match(tip.order, tipLabels(phy))])
+ }
+ }
+ tip.order <- rev(tip.order)
+ }
+ ## TODO remove the false cladogram option?
+ if(!hasEdgeLength(phy) || type == 'cladogram') {
+ edgeLength(phy) <- rep(1, Nedges)
+ }
+ xxyy <- phyloXXYY(phy, tip.order)
+ if(type == 'cladogram') {
+ xxyy$xx[edges(xxyy$phy)[, 2] <= Ntips] <- 1
+ }
+
+ ## plotViewport is a convience function that provides margins in lines
+ grid::pushViewport(grid::plotViewport(margins=margins))
+
+ if(!plot.data) {
+ plotOneTree(xxyy, type, show.tip.label, show.node.label, edge.color,
+ node.color, tip.color, edge.width, rot)
+ } else {
+ if(!is.function(tip.plot.fun)) {
+ if(tip.plot.fun == "bubbles") {
+ phylobubbles(
+ type = type,
+ show.node.label = show.node.label,
+ rot = 0,
+ edge.color = edge.color,
+ node.color = node.color, # TODO what do with node.color parameter
+ tip.color = tip.color,
+ edge.width = edge.width, # TODO line-type modification hack
+ newpage = TRUE,
+ ..., XXYY = xxyy
+ )
+ } else {
+ stop(paste(tip.plot.fun, 'is neither a function or a recognized plot type'))
+ }
+ } else { ## from -- if(tip.plot.fun == "bubbles")
+ ## plot.at.tip <- TRUE
+ if (plot.at.tip) {
+ tip.data.plot(
+ xxyy = xxyy,
+ type = type,
+ show.tip.label = show.tip.label,
+ show.node.label = show.node.label,
+ rot = 0,
+ tip.plot.fun = tip.plot.fun,
+ edge.color = edge.color,
+ node.color = node.color, # TODO what do with node.color parameter
+ tip.color = tip.color,
+ edge.width = edge.width, # TODO line-type modification hack
+ newpage = TRUE,
+ ...
+ )
+ return(invisible())
+ } ## if (plot.at.tip)
+ } ## else
+ } ## else
+ grid::upViewport() # margins
+}
+
+
+
+##' Plot a phylo4 object
+##'
+##' Plots the phylogenetic tree contained in a \code{phylo4} or \code{phylo4d}
+##' object.
+##'
+##'
+##' @param xxyy A list created by the \code{\link{phyloXXYY}} function
+##' @param type A character string indicating the shape of plotted tree
+##' @param show.tip.label Logical, indicating whether tip labels should be shown
+##' @param show.node.label Logical, indicating whether node labels should be
+##' shown
+##' @param edge.color A vector of colors in the order of \code{edges(phy)}
+##' @param node.color A vector of colors indicating the colors of the node
+##' labels
+##' @param tip.color A vector of colors indicating the colors of the tip labels
+##' @param edge.width A vector in the order of \code{edges(phy)} indicating the
+##' widths of edge lines
+##' @param rot Numeric indicating the rotation of the plot in degrees
+##' @return Returns no values, function invoked for the plotting side effect.
+##' @author Peter Cowan \email{pdc@@berkeley.edu}
+##' @seealso \code{treePlot}, \code{\link{phyloXXYY}}
+##' @export
+##' @keywords methods
+##' @examples
+##' library(grid)
+##' data(geospiza)
+##' grid.newpage()
+##' xxyy <- phyloXXYY(geospiza)
+##' plotOneTree(xxyy, type = 'phylogram',
+##' show.tip.label = TRUE, show.node.label = TRUE,
+##' edge.color = 'black', node.color = 'orange', tip.color = 'blue',
+##' edge.width = 1, rot = 0
+##' )
+##'
+##' grid.newpage()
+##' pushViewport(viewport(w = 0.8, h = 0.8))
+##' plotOneTree(xxyy, type = 'phylogram',
+##' show.tip.label = TRUE, show.node.label = TRUE,
+##' edge.color = 'black', node.color = 'orange', tip.color = 'blue',
+##' edge.width = 1, rot = 0
+##' )
+##' popViewport()
+##'
+
+plotOneTree <- function(xxyy, type, show.tip.label, show.node.label, edge.color,
+ node.color, tip.color, edge.width, rot)
+{
+ # TODO switch to phylobase abstractions
+ phy <- xxyy$phy
+ Nedges <- nEdges(phy)
+ Nnodes <- nNodes(phy)
+ Ntips <- nTips(phy)
+ pedges <- edges(phy)
+ tindex <- pedges[pedges[, 2] <= Ntips, 2]
+ eindex <- xxyy$eorder
+ segs <- xxyy$segs
+
+ ## TODO check that colors are valid?
+ if(length(edge.color) != Nedges) {
+ edge.color <- rep(edge.color, length.out = Nedges)
+ }
+ edge.color <- edge.color[eindex]
+
+ if(length(edge.width) != Nedges) {
+ edge.width <- rep(edge.width, length.out = Nedges)
+ }
+ edge.width <- edge.width[eindex]
+
+ ## TODO check that colors are valid?
+ if(length(node.color) != Nnodes) {
+ node.color <- rep(node.color, length.out = Nnodes)
+ }
+
+ if(show.tip.label) {
+ ## calculate several lab dimesisions
+ ## labw -- a vector of string widths
+ ## adjlabw -- the max width for adjusting the size of viewports
+ ## laboff -- a vector of half string widths for
+ ## offsetting center justified labels, handy for vp rotation
+ labw <- grid::stringWidth(tipLabels(phy))
+ adjlabw <- max(labw) + grid::unit(0.1, 'inches')
+ laboff <- labw * 0.5 + grid::unit(0.1, 'inches')
+ ## print(foo <<- laboff)
+ treelayout <- grid.layout(nrow = 1, ncol = 2,
+ widths = grid::unit.c(grid::unit(1, 'null', NULL), grid::convertUnit(adjlabw, 'inches'))
+ )
+ tindex <- pedges[pedges[, 2] <= Ntips, 2]
+ if(length(tip.color) != Ntips) {
+ tip.color <- rep(tip.color, length.out = Ntips)
+ }
+ # keep labels horizontal unless plot is upwards or downwards
+ lrot <- ifelse(rot %% 360 %in% c(90, 270), 0, -rot)
+ } else {
+ treelayout <- grid::grid.layout(nrow = 1, ncol = 1)
+ }
+ # grid.show.layout(treelayout)
+ grid::pushViewport(grid::viewport(
+ x = 0.5, y = 0.5,
+ width = 1, height = 1,
+ layout = treelayout, angle = rot, name = 'treelayout'))
+ grid::pushViewport(grid::viewport(
+ layout.pos.col = 1,
+ name = 'tree'))
+ if (type == "fan") {
+ dseg <- grid::grid.segments( # draws diag lines
+ x0 = segs$v0x, y0 = segs$v0y,
+ x1 = segs$h1x, y1 = segs$h1y,
+ name = "diag", gp = grid::gpar(col = edge.color, lwd = edge.width))
+ } else {
+ vseg <- grid::grid.segments( # draws vertical lines
+ x0 = segs$v0x, y0 = segs$v0y,
+ x1 = segs$v1x, y1 = segs$v1y,
+ name = "vert", gp = grid::gpar(col = edge.color, lwd = edge.width))
+ hseg <- grid::grid.segments( # draws horizontal lines
+ x0 = segs$h0x, y0 = segs$h0y,
+ x1 = segs$h1x, y1 = segs$h1y,
+ name = "horz", gp = grid::gpar(col = edge.color, lwd = edge.width))
+ }
+ grid::upViewport() # tree
+ if(show.tip.label) {
+ grid::pushViewport(grid::viewport(layout.pos.col = 1,
+ name = 'tiplabelvp'))
+ labtext <- grid::grid.text(
+ tipLabels(phy)[tindex],
+ x = grid::unit(xxyy$xx[pedges[, 2] %in% tindex], "native") + laboff[tindex],
+ y = xxyy$yy[pedges[, 2] %in% tindex], rot = lrot,
+ default.units = 'native', name = 'tiplabels',
+ just = 'center', gp = grid::gpar(col = tip.color[tindex])
+ )
+ grid::upViewport() #tiplabelvp
+ }
+ # TODO probably want to be able to adjust the location of these guys
+ if(show.node.label) {
+ grid::pushViewport(grid::viewport(layout = treelayout, layout.pos.col = 1, name = 'nodelabelvp'))
+ theLabels <- nodeLabels(phy)[match(pedges[pedges[, 2] > Ntips, 2], names(nodeLabels(phy)))]
+ ## don't plot NAs
+ theLabels[is.na(theLabels)] <- ""
+ labtext <- grid::grid.text(
+ theLabels,
+ x = c(xxyy$xx[pedges[, 2] > Ntips]),
+ y = c(xxyy$yy[pedges[, 2] > Ntips]),
+ default.units = 'npc', name = 'nodelabels', rot = -rot,
+ just = 'center', gp = grid::gpar(col = node.color)
+ )
+ grid::upViewport() #nodelabelvp
+ }
+ grid::upViewport() # treelayout
+ # grobTree(vseg, hseg, labtext)
+}
+
+
+
+##' Calculate node x and y coordinates
+##'
+##' Calculates the node x and y locations for plotting a phylogenetic tree.
+##'
+##' The y coordinates of the tips are evenly spaced from 0 to 1 in pruningwise
+##' order. Ancestor y nodes are given the mean value of immediate descendants.
+##' The root is given the x coordinate 0 and descendant nodes are placed
+##' according to the cumulative branch length from the root, with a maximum x
+##' value of 1.
+##'
+##' @param phy A \code{phylo4} or \code{phylo4d} object.
+##' @param tip.order A character vector of tip labels, indicating their order
+##' along the y axis (from top to bottom). Or, a numeric vector of tip node IDs
+##' indicating the order.
+##' @return \item{yy}{Internal node and tip y coordinates} \item{xx}{Internal
+##' node and tip x coordinates} \item{phy}{A \code{phylo4} or \code{phylo4d}
+##' object} \item{segs}{A list of \code{h0x, h1x, v0x, v1x} and \code{h0y, h1y,
+##' v0y, v1y} describing the start and end points for the plot line segments}
+##' \item{torder}{The tip order provided as \code{tip.order} or if NULL the
+##' preoder tip order} \item{eorder}{The an index of the reordered edges
+##' compared to the result of \code{edges(phy)}}
+##' @author Peter Cowan \email{pdc@@berkeley.edu}
+##' @seealso \code{treePlot}, \code{\link{plotOneTree}}
+##' @export
+##' @keywords methods
+##' @examples
+##'
+##'
+##' data(geospiza)
+##' coor <- phyloXXYY(geospiza)
+##' plot(coor$xx, coor$yy, pch = 20)
+##'
+##'
+phyloXXYY <- function(phy, tip.order=NULL)
+{
+ phy.orig <- phy
+ ## initalize the output
+ phy <- reorder(phy, 'preorder')
+ pedges <- edges(phy)
+ eindex <- match(pedges[,2], edges(phy.orig)[,2])
+ Nedges <- nrow(pedges) ## TODO switch to the accessor once stablized
+ Ntips <- nTips(phy)
+ tips <- pedges[, 2] <= Ntips
+ xx <- numeric(Nedges)
+ yy <- numeric(Nedges)
+
+ treelen <- rep(NA, nEdges(phy))
+ segs <- list(v0x = treelen, v0y = treelen, v1x = treelen, v1y = treelen,
+ h0x = treelen, h0y = treelen, h1x = treelen, h1y = treelen)
+
+ ## Set root x value to zero and calculate x positions
+ xx[1] <- 0
+ segs$v0x[1] <- segs$v1x[1] <- segs$h0x[1] <- 0
+ edge1 <- as.integer(pedges[,1])
+ edge2 <- as.integer(pedges[,2])
+ edgeLen <- edgeLength(phy)
+ edgeLen[is.na(edgeLen)] <- 0
+ edgeLen <- as.numeric(edgeLen)
+ nedges <- as.integer(nEdges(phy))
+ segsv0x <- as.numeric(rep.int(0, Nedges))
+ xPos <- .C("phyloxx", edge1, edge2,
+ edgeLen, nedges, xx, segsv0x)
+ xx <- xPos[[5]]
+ segs$v0x <- xPos[[6]]
+
+ ## Set y positions for terminal nodes and calculate remaining y positions
+ if(!is.null(tip.order)) {
+ if(length(tip.order) == 1 && tip.order == "rev") {
+ yy[tips] <- seq(1, 0, length = Ntips)
+ tip.order <- rev(edge2[edge2 <= Ntips])
+ } else {
+ yy[tips][match(tip.order, edge2[tips])] <- seq(0, 1, length = Ntips)
+ }
+ } else {
+ yy[tips] <- seq(0, 1, length = Ntips)
+ tip.order <- edge2[edge2 <= Ntips]
+ }
+ segs$h0y[tips] <- segs$h1y[tips] <- yy[tips]
+ segs$v1y[tips] <- segs$v0y[tips] <- yy[tips]
+ phyloyy <- function() {
+ for(i in rev((Ntips + 1):nEdges(phy))) {
+ dex <- pedges[, 1] == i
+ cur <- pedges[, 2] == i
+ yy[cur] <- segs$v0y[dex] <- mean(yy[dex])
+ }
+ return(list(segs=segs, yy=yy))
+ }
+
+ yPos <- phyloyy()
+ segs <- yPos$segs
+ yy <- yPos$yy
+
+ ## edgeLen[is.na(edgeLen)] <- 0
+ ## edgeLen <- as.numeric(edgeLen)
+ ## ntips <- as.integer(nTips(phy))
+ ## yy <- as.numeric(yy)
+ ## segsv0y <- as.numeric(yy)
+
+ ## yPos <- .C("phyloyy", edge1, edge2,
+ ## ntips, nedges, yy, segsv0y)
+
+ segs$h0y <- segs$h1y <- segs$v1y <- yy
+
+ ## scale the x values so they range from 0 to 1
+ Xmax <- max(xx)
+ segs$v0x <- segs$v0x / Xmax
+ xx <- xx / Xmax
+
+ segs$h1x <- xx
+ segs$v1x <- segs$h0x <- segs$v0x
+
+ # TODO return an index vector instead of a second phy object
+ list(xx = xx, yy = yy, phy = phy, segs = segs, torder=tip.order, eorder=eindex)
+}
+
+.bubLegendGrob <- function(tipdata, tipdataS) {
+ grid::grob(tipdata=tipdata, tipdataS=tipdataS, cl='bubLegend')
+}
+
+drawDetails.bubLegend <- function(x, ...) {
+ ## number of bubbles in legend
+ leglen <- 4
+ ## the raw tip data
+ tipdata <- x$tipdata
+ ## the tip data as scaled for bubble plot
+ ts <- x$tipdataS
+ ## return to the bubble plot viewport to get properly scaled values
+ ## this relies on having well named unique viewports
+ grid::seekViewport("bubble_plots")
+ ## retreive the min and max non-zero bubbles as numerics not units
+ bubrange <- grid::convertUnit(
+ grid::unit(c(min(ts[ts != 0], na.rm=TRUE), max(ts[ts != 0], na.rm=TRUE)), "native"),
+ "mm", valueOnly=TRUE)
+ grid::seekViewport("bubblelegend")
+ ## grid.rect()
+ ## Generate the sequence of legend bubble sizes and convert to grid mm units
+ legcirS <- grid::unit(seq(bubrange[1], bubrange[2], length.out=leglen), "mm")
+ ## get the corresponding sequence of actual data values
+ legcir <- seq(min(tipdata[tipdata != 0], na.rm=TRUE),
+ max(tipdata[tipdata != 0], na.rm=TRUE), length.out=leglen)
+ ccol <- ifelse(legcir < 0, 'black', 'white')
+
+ leftedge <- abs(grid::convertUnit(legcirS[1], 'npc', valueOnly=TRUE)) + 0.1
+ xloc <- seq(leftedge, 0.5, length.out=leglen)
+ textsp <- grid::convertUnit(max(abs(legcirS)), axisFrom="y", axisTo="y", 'npc', valueOnly=TRUE)
+ strsp <- grid::convertUnit(unit(1, "strheight", "TTT"), axisFrom="y", 'npc', valueOnly=TRUE)
+ grid::grid.circle(x=xloc, y=0.9 - textsp - strsp, r=legcirS, gp = grid::gpar(fill=ccol), default.units = 'npc')
+ grid::grid.text(as.character(signif(legcir, digits = 2)),
+ x=xloc, y=0.75 - 2 * textsp - strsp,
+ gp=grid::gpar(cex=0.75),
+ default.units='npc'
+ )
+}
+
+
+
+##' Bubble plots for phylo4d objects
+##'
+##' Plots either circles or squares corresponding to the magnitude of each cell
+##' of a \code{phylo4d} object.
+##'
+##'
+##' @param type the type of plot
+##' @param place.tip.label A string indicating whether labels should be plotted
+##' to the right or to the left of the bubble plot
+##' @param show.node.label A logical indicating whether internal node labels
+##' should be plotted
+##' @param rot The number of degrees that the plot should be rotated
+##' @param edge.color A vector of colors for the tree edge segments
+##' @param node.color A vector of colors for the coloring the nodes
+##' @param tip.color A vector of colors for the coloring the tip labels
+##' @param edge.width A vector of line widths for the tree edges
+##' @param newpage Logical to control whether the device is cleared before
+##' plotting, useful for adding plot inside other plots
+##' @param \dots Additional parameters passed to the bubble plotting functions
+##' @param XXYY The out put from the phyloXXYY function
+##' @param square Logical indicating whether the plot 'bubbles' should be
+##' squares
+##' @param grid A logical indicating whether a grey grid should be plotted
+##' behind the bubbles
+##' @author Peter Cowan \email{pdc@@berkeley.edu}
+##' @export
+##' @seealso \code{\link{phyloXXYY}}, \code{treePlot}
+##' @keywords methods
+##' @examples
+##'
+##' ##---- Should be DIRECTLY executable !! ----
+##' ##-- ==> Define data, use random,
+##' ##-- or do help(data=index) for the standard data sets.
+##'
+phylobubbles <- function(type = type,
+ place.tip.label = "right",
+ show.node.label = show.node.label,
+ rot = 0,
+ edge.color = edge.color,
+ node.color = node.color, # TODO what do with node.color parameter
+ tip.color = tip.color,
+ edge.width = edge.width, # TODO line-type modification hack
+ newpage = TRUE,
+ ...,
+ XXYY, square = FALSE, grid = TRUE)
+{
+ ## TODO add legend command
+ ## tys -- tip y coordinates
+ ## nVars -- number of traits/characters
+ ## maxr -- maximum circle radius, based on nVars or nTips
+ ## torder -- the order of tips in the reordered edge matrix
+ if(rot != 0) {stop("Rotation of bubble plots not yet implemented")}
+ lab.right <- ifelse(place.tip.label %in% c("right", "both"), TRUE, FALSE)
+ lab.left <- ifelse(place.tip.label %in% c("left", "both"), TRUE, FALSE)
+
+ phy <- XXYY$phy
+ tip.order <- XXYY$torder
+ tipdata <- tdata(phy, type = "tip")[tip.order,, drop=FALSE]
+ tipClass <- sapply(tipdata, function(x) class(x) %in% c("double", "integer", "numeric"))
+ tipdata <- tipdata[, tipClass, drop=FALSE]
+ tmin <- min(tipdata, na.rm = TRUE)
+ tmax <- max(tipdata, na.rm = TRUE)
+ pedges <- edges(phy)
+
+ nVars <- ncol(tipdata) # number of bubble columns
+
+ dlabwdth <- max(grid::stringWidth(colnames(tipdata))) * 1.2
+ if(grid::convertWidth(dlabwdth, 'cm', valueOnly=TRUE) < 2) {dlabwdth <- grid::unit(2, 'cm')}
+ phyplotlayout <- grid::grid.layout(nrow = 2, ncol = 2,
+ heights = grid::unit.c(grid::unit(1, 'null'), dlabwdth),
+ widths = grid::unit(c(1, 1), c('null', 'null'), list(NULL, NULL)))
+ grid::pushViewport(viewport(layout = phyplotlayout, name = 'phyplotlayout'))
+ grid::pushViewport(viewport(layout.pos.row = 1:2, layout.pos.col = 2,
+ height = grid::unit(1, 'npc') +
+ grid::convertUnit(dlabwdth, 'npc'),
+ name = 'bubbleplots', default.units = 'native'))
+
+ # tip y coordinates
+ tys <- XXYY$yy[pedges[, 2] <= nTips(phy)]
+ tys <- tys[match(names(tipLabels(phy))[tip.order], XXYY$torder)]
+
+ maxr <- ifelse(ncol(tipdata) > nTips(phy), 1 / ncol(tipdata), 1 / nTips(phy))
+ tipdataS <- apply(tipdata, 2,
+ function(x) (maxr * x) / max(abs(x), na.rm = TRUE))
+ if(nVars == 1) {
+ xpos <- 0.5
+ } else {
+ xpos <- seq(0 + maxr + 0.02, 1 - maxr - 0.02, length.out = nVars)
+ }
+
+ ## rep coordinates for filling a matrix columnwise
+ xrep <- rep(xpos, each = length(tys))
+ yrep <- rep(tys, nVars)
+ ## color bubbles
+
+ ccol <- ifelse(tipdata < 0, 'black', 'white')
+
+ ## generate matrices of every x and y by filling the repd value columnwise
+ ## then subset for datapoints that are NA
+ naxs <- matrix(xrep, ncol = nVars)
+ nays <- matrix(yrep, ncol = nVars)
+ dnas <- is.na(tipdataS)
+ naxs <- naxs[dnas]
+ nays <- nays[dnas]
+ ## set the NA points to zero so that grid.circle doesn't crash
+ tipdataS[is.na(tipdataS)] <- 0 + 0.001 # workaround negative circles on PDF
+
+ ## get label widths
+ if(lab.right) {
+ tiplabwidth <- max(grid::stringWidth(tipLabels(phy)))
+ } else {tiplabwidth <- grid::unit(0, 'null', NULL)}
+
+ ## 2x2 layout -- room at the bottom for data labels, and legend
+ bublayout <- grid::grid.layout(nrow = 2, ncol = 2,
+ widths = grid::unit.c(grid::unit(1, 'null', NULL), tiplabwidth),
+ heights = grid::unit.c(grid::unit(1, 'null', NULL), dlabwdth))
+ grid::pushViewport(viewport(
+ x = 0.5, y = 0.5,
+ width = 0.95, height = 1,
+ layout = bublayout, name = 'bublayout'
+ ))
+ grid::pushViewport(viewport(
+ name = 'bubble_plots',
+ layout = bublayout,
+ layout.pos.col = 1,
+ layout.pos.row = 1
+ ))
+ if(grid) {
+ ## draw light grey grid behind bubbles
+ grid::grid.segments(x0 = 0, x1 = 1,
+ y0 = tys, y1 = tys, gp = grid::gpar(col = 'grey'))
+ grid::grid.segments(x0 = xpos, x1 = xpos,
+ y0 = 0, y1 = 1, gp = grid::gpar(col = 'grey'))
+ }
+ if (length(naxs) > 0) {
+ ## if ther are missing values plot Xs
+ grid::grid.points(naxs, nays, pch = 4)
+ }
+
+ if(square) {
+ ## alternative to circles
+ ## to keep the squares square, yet resize nicely use the square npc
+ sqedge <- grid::unit(unlist(tipdataS), 'snpc')
+ grid::grid.rect(x = xrep, y = yrep,
+ width = sqedge,
+ height = sqedge,
+ gp=grid::gpar(fill = ccol))
+ } else {
+ ## plot bubbles
+ grid::grid.circle(xrep, yrep, r = unlist(tipdataS), gp = grid::gpar(fill = ccol))
+ }
+ grid::upViewport()
+
+ ## push view ports for tip and data labels fixed locations
+ if(lab.right) {
+ grid::pushViewport(viewport(
+ name = 'bubble_tip_labels',
+ layout = bublayout,
+ layout.pos.col = 2,
+ layout.pos.row = 1
+ ))
+ tt <- tipLabels(phy)[tip.order] # phy at tip.label
+ grid::grid.text(tt, 0.1, tys, just = 'left')
+ grid::upViewport()
+ }
+ grid::pushViewport(viewport(
+ name = 'bubble_data_labels',
+ layout = bublayout,
+ layout.pos.col = 1,
+ layout.pos.row = 2
+ ))
+ ## ideas, for nicer sizing of the data labels
+ ## data.label.space <- convertX(unit(1, 'npc'), "points", valueOnly = TRUE)
+ ## data.label.fontsize <- data.label.space / ncol(tipdata)
+ ## , gp=gpar(fontsize=data.label.fontsize))
+ ## offset the data labels from the bottom bubble
+ datalaboffset <- grid::convertUnit(grid::unit(15, "mm"), 'npc', valueOnly=TRUE)
+ grid::grid.text(colnames(tipdata), xpos, 1-datalaboffset, rot = 90, just = 'right')
+
+ grid::upViewport(3)
+ grid::pushViewport(viewport(layout.pos.row=2, layout.pos.col=1,
+ name='bubblelegend'))
+ yyy <- .bubLegendGrob(tipdata, tipdataS)
+ grid::grid.draw(yyy)
+ grid::upViewport()
+
+ grid::pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 1,
+ name = 'tree'))
+ plotOneTree(XXYY, type, show.tip.label=lab.left, show.node.label, edge.color,
+ node.color, tip.color, edge.width, rot)
+ grid::upViewport(2)
+
+ # to make a nice legend, return the biggest smallest and a scaling factor
+ # translate the scale of the current vp to a fixed value
+ ## ensure the min is not a zero (or NA) that's replaced by a zero
+ ## print(convertUnit(bubscale, 'inches', valueOnly = TRUE))
+ ## return(list(max = max(tipdata, na.rm = TRUE),
+ ## min = min(tipdata[tipdata != 0], na.rm = TRUE),
+ ## has.na = length(naxs) > 0,
+ ## bubscale = bubscale))
+}
+
+
+
+##' Plotting trees and associated data
+##'
+##' Plotting phylogenetic trees and associated data
+##'
+##'
+##' @param xxyy A list created by the \code{\link{phyloXXYY}} function
+##' @param type A character string indicating the shape of plotted tree
+##' @param show.tip.label Logical, indicating whether tip labels should be shown
+##' @param show.node.label Logical, indicating whether node labels should be
+##' shown
+##' @param rot Numeric indicating the rotation of the plot in degrees
+##' @param tip.plot.fun A function used to plot the data elements of a
+##' \code{phylo4d} object
+##' @param edge.color A vector of colors in the order of \code{edges(phy)}
+##' @param node.color A vector of colors indicating the colors of the node
+##' labels
+##' @param tip.color A vector of colors indicating the colors of the tip labels
+##' @param edge.width A vector in the order of \code{edges(phy)} indicating the
+##' widths of edge lines
+##' @param \dots Additional parameters passed to \code{tip.plot.fun}
+##' @return creates a plot on the current graphics device.
+##' @author Peter Cowan
+##' @export
+##' @keywords methods
+tip.data.plot <- function(
+ xxyy,
+ type = c('phylogram', 'cladogram', 'fan'),
+ show.tip.label = TRUE,
+ show.node.label = FALSE,
+ rot = 0,
+ tip.plot.fun = grid.points,
+ edge.color = 'black',
+ node.color = 'black', # TODO what do with node.color parameter
+ tip.color = 'black',
+ edge.width = 1, # TODO line-type modification hack
+ ...)
+{
+ phy <- xxyy$phy
+ tip.order <- xxyy$torder
+ pedges <- edges(phy)
+ Ntips <- nTips(phy)
+ datalayout <- grid::grid.layout(ncol = 2, widths = grid::unit(c(1, 1/Ntips), c('null', 'null')))
+ # TODO this is done multiple times,
+ grid::pushViewport(viewport(layout = datalayout, angle = rot,
+ name = 'datalayout'))
+ grid::pushViewport(viewport(
+ yscale = c(-0.5 / Ntips, 1 + 0.5 / Ntips),
+ xscale = c(0, 1 + 1 / Ntips),
+ layout.pos.col = 1,
+ name = 'data_plots'))
+ ## TODO should plots float at tips, or only along edge?
+ hc <- grid::convertY(grid::unit(1 / Ntips, 'snpc'), 'npc')
+ for(i in 1:Ntips) {
+ grid::pushViewport(viewport(
+ y = xxyy$yy[pedges[, 2] == i],
+ x = 1 + 1 / (2 * Ntips), # xxyy$xx[phy at edge[, 2] == i],
+ height = hc,
+ width = hc,
+ # default.units = 'native',
+ name = paste('data_plot', i),
+ just = "center",
+ angle = -rot
+ ))
+ #grid.rect()
+ tvals <- tdata(phy, type = 'tip')[nodeId(phy,'tip'), , drop=FALSE]
+ vals = t(tvals[i, ])
+ if (!all(is.na(vals))) tip.plot.fun(vals, ...)
+ grid::upViewport() # loop viewports
+ }
+ plotOneTree(xxyy, type, show.tip.label, show.node.label, edge.color,
+ node.color, tip.color, edge.width, rot)
+ grid::upViewport(2) ## data_plot & datalayout
+}
+
+# phyloStripchart <- function()
+
+##' @rdname treePlot-methods
+##' @aliases plot
+##' @exportMethod plot
+setGeneric('plot')
+
+##' @rdname treePlot-methods
+##' @aliases plot,phylo4-method
+setMethod('plot', signature(x='phylo4', y='missing'), function(x, y, ...) {
+ treePlot(x, ...)
+})
diff --git a/R/treestruc.R b/R/treestruc.R
new file mode 100644
index 0000000..6f8d359
--- /dev/null
+++ b/R/treestruc.R
@@ -0,0 +1,87 @@
+
+##' Test trees for polytomies, inline nodes (singletons), or reticulation
+##'
+##' Methods to test whether trees have (structural) polytomies, inline
+##' nodes (i.e., nodes with a single descendant), or reticulation
+##' (i.e., nodes with more than one ancestor). \code{hasPoly} only
+##' check for structural polytomies (1 node has more than 2
+##' descendants) and not polytomies that result from having edges with
+##' a length of 0.
+##'
+##' @aliases hasSingle
+##' @param object an object inheriting from class \code{phylo4}
+##' @return Logical value
+##' @note Some algorithms are unhappy with structural polytomies (i.e., >2
+##' descendants from a node), with single-descendant nodes, or with
+##' reticulation; these functions check those properties. We haven't bothered
+##' to check for zero branch lengths: the consensus is that it doesn't come up
+##' much, and that it's simple enough to test \code{any(edgeLength(x) == 0)} in
+##' these cases. (Single-descendant nodes are used e.g. in OUCH, or in other
+##' cases to represent events occurring along a branch.)
+##' @author Ben Bolker
+##' @rdname treeStructure-methods
+##' @export
+##' @keywords misc
+##' @examples
+##'
+##' tree.owls.bis <- ape::read.tree(text="((Strix_aluco:4.2,Asio_otus:4.2):3.1,Athene_noctua:7.3);")
+##' owls4 <- as(tree.owls.bis, "phylo4")
+##' hasPoly(owls4)
+##' hasSingle(owls4)
+##'
+setGeneric("hasSingle", function(object) {
+ standardGeneric("hasSingle")
+})
+
+##' @rdname treeStructure-methods
+##' @aliases hasSingle,phylo4-method
+setMethod("hasSingle", signature(object="phylo4"),
+ function(object) {
+ if (nEdges(object) == 0) {
+ return(FALSE)
+ }
+ ## This is about 3 times slower than using the C++
+ ## function tabulateTips
+ ## degree <- tabulate(edges(object, drop.root=TRUE)[, 1])
+ degree <- tabulateTips(object at edge[, 1])
+ any(degree == 1)
+})
+
+##' @rdname treeStructure-methods
+##' @aliases hasRetic
+##' @export
+setGeneric("hasRetic", function(object) {
+ standardGeneric("hasRetic")
+})
+
+##' @rdname treeStructure-methods
+##' @aliases hasRetic,phylo4-method
+setMethod("hasRetic", signature(object="phylo4"), function(object) {
+ if (nEdges(object)==0) {
+ return(FALSE)
+ }
+ ## this is about the same (slightly faster on 10,000 tips)
+ ## than using the C++ function
+ ancest <- tabulate(edges(object)[, 2])
+ any(ancest > 1)
+})
+
+##' @rdname treeStructure-methods
+##' @aliases hasPoly
+##' @export
+setGeneric("hasPoly", function(object) {
+ standardGeneric("hasPoly")
+})
+
+##' @rdname treeStructure-methods
+##' @aliases hasPoly,phylo4-method
+setMethod("hasPoly", signature(object="phylo4"), function(object) {
+ if (nEdges(object)==0) {
+ return(FALSE)
+ }
+ ## This is about 3 times slower than using the C++
+ ## function tabulateTips
+ ## degree <- tabulate(edges(object, drop.root=TRUE)[, 1])
+ degree <- tabulateTips(object at edge[, 1])
+ any(degree > 2)
+})
diff --git a/R/zzz.R b/R/zzz.R
new file mode 100644
index 0000000..277d514
--- /dev/null
+++ b/R/zzz.R
@@ -0,0 +1,16 @@
+
+".phylobase.Options" <-
+ list(retic = "fail",
+ singleton = "warn",
+ multiroot = "warn",
+ poly = "ok",
+ allow.duplicated.labels = "warn")
+
+
+.onAttach <- function(library, pkg)
+{
+ ## we can't do this in .onLoad
+ unlockBinding(".phylobase.Options", asNamespace("phylobase"))
+}
+
+
diff --git a/build/vignette.rds b/build/vignette.rds
new file mode 100644
index 0000000..90f1fdd
Binary files /dev/null and b/build/vignette.rds differ
diff --git a/data/geospiza.rda b/data/geospiza.rda
new file mode 100644
index 0000000..7a024fe
Binary files /dev/null and b/data/geospiza.rda differ
diff --git a/data/geospiza_raw.rda b/data/geospiza_raw.rda
new file mode 100644
index 0000000..01f2ddc
Binary files /dev/null and b/data/geospiza_raw.rda differ
diff --git a/data/owls4.rda b/data/owls4.rda
new file mode 100644
index 0000000..9be1842
Binary files /dev/null and b/data/owls4.rda differ
diff --git a/debian/README.source b/debian/README.source
deleted file mode 100644
index 2945665..0000000
--- a/debian/README.source
+++ /dev/null
@@ -1,22 +0,0 @@
-Explanation for binary files inside source package according to
- http://lists.debian.org/debian-devel/2013/09/msg00332.html
-
-The source packages contains some binary RData files which are
-documented inside the according manpages
-
-Files: data/geospiza.rda
- data/geospiza_raw.rda
-Documentation: man/geospiza.Rd
- Phylogenetic tree and morphological data for Darwin's finches, in different
- formats. (Dolph Schluter, Luke Harmon)
-
-Files: data/owls4.rda
-Documentation: man/owls4.Rd
- A tiny tree, for testing/example purposes, using one of the examples from
- the r-cran-ape package.
-
-Files: inst/nexusfiles/ExContData.Rdata
- This is just a saved session when running phylobase examples.
- It can be loaded into R to verify its content.
-
- -- Andreas Tille <tille at debian.org> Tue, 22 Mar 2016 12:05:59 +0100
diff --git a/debian/README.test b/debian/README.test
deleted file mode 100644
index 4fe93f7..0000000
--- a/debian/README.test
+++ /dev/null
@@ -1,9 +0,0 @@
-Notes on how this package can be tested.
-────────────────────────────────────────
-
-This package can be tested by running the provided test:
-
-cd tests
-LC_ALL=C R --no-save < test-all.R
-
-in order to confirm its integrity.
diff --git a/debian/changelog b/debian/changelog
deleted file mode 100644
index ec82c4e..0000000
--- a/debian/changelog
+++ /dev/null
@@ -1,15 +0,0 @@
-r-cran-phylobase (0.8.4-1) unstable; urgency=medium
-
- * New upstream version
- * debhelper 10
- * use dh-r instead of cdbs
- * canonical Homepage for CRAN packages
- * Standards-Version: 4.1.0 (no changes needed)
-
- -- Andreas Tille <tille at debian.org> Thu, 07 Sep 2017 22:38:05 +0200
-
-r-cran-phylobase (0.8.2-1) unstable; urgency=low
-
- * Initial release (Closes: #820520)
-
- -- Andreas Tille <tille at debian.org> Sat, 09 Apr 2016 13:54:52 +0200
diff --git a/debian/compat b/debian/compat
deleted file mode 100644
index f599e28..0000000
--- a/debian/compat
+++ /dev/null
@@ -1 +0,0 @@
-10
diff --git a/debian/control b/debian/control
deleted file mode 100644
index d09500c..0000000
--- a/debian/control
+++ /dev/null
@@ -1,29 +0,0 @@
-Source: r-cran-phylobase
-Maintainer: Debian Med Packaging Team <debian-med-packaging at lists.alioth.debian.org>
-Uploaders: Andreas Tille <tille at debian.org>
-Section: gnu-r
-Priority: optional
-Build-Depends: debhelper (>= 10),
- dh-r,
- r-base-dev,
- r-cran-ape,
- r-cran-ade4,
- r-cran-rcpp,
- r-cran-rncl,
- r-cran-rnexml
-Standards-Version: 4.1.0
-Vcs-Browser: https://anonscm.debian.org/viewvc/debian-med/trunk/packages/R/r-cran-phylobase/trunk/
-Vcs-Svn: svn://anonscm.debian.org/debian-med/trunk/packages/R/r-cran-phylobase/trunk/
-Homepage: https://cran.r-project.org/package=phylobase
-
-Package: r-cran-phylobase
-Architecture: any
-Depends: ${shlibs:Depends},
- ${misc:Depends},
- ${R:Depends}
-Recommends: ${R:Recommends}
-Suggests: ${R:Suggests}
-Description: GNU R base package for phylogenetic structures and comparative data
- This R package provides a base S4 class for comparative methods,
- incorporating one or more trees and trait data as these are used in
- other packages dealing with phylogenetic structures and comparative data.
diff --git a/debian/copyright b/debian/copyright
deleted file mode 100644
index 486ce3b..0000000
--- a/debian/copyright
+++ /dev/null
@@ -1,33 +0,0 @@
-Format: https://www.debian.org/doc/packaging-manuals/copyright-format/1.0/
-Upstream-Contact: Francois Michonneau <francois.michonneau at gmail.com>
-Source: https://cran.r-project.org/web/packages/phylobase/
-
-Files: *
-Copyright: 2013-2015 Ben Bolker, Marguerite Butler, Peter Cowan,
- Damien de Vienne, Dirk Eddelbuettel, Mark Holder,
- Thibaut Jombart, Steve Kembel, Francois Michonneau,
- David Orme, Brian O'Meara, Emmanuel Paradis,
- Jim Regetz, Derrick Zwickl
-License: GPL-2+
-
-Files: debian/*
-Copyright: 2016 Andreas Tille <tille at debian.org>
-License: GPL-2+
-
-License: GPL-2+
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- (at your option) any later version.
- .
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
- .
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
- .
- On Debian systems, the complete text of the GNU General Public
- License can be found in `/usr/share/common-licenses/GPL-2'.
diff --git a/debian/docs b/debian/docs
deleted file mode 100644
index 960011c..0000000
--- a/debian/docs
+++ /dev/null
@@ -1,3 +0,0 @@
-tests
-debian/README.test
-debian/tests/run-unit-test
diff --git a/debian/rules b/debian/rules
deleted file mode 100755
index 355ccec..0000000
--- a/debian/rules
+++ /dev/null
@@ -1,8 +0,0 @@
-#!/usr/bin/make -f
-
-%:
- dh $@ --buildsystem R
-
-override_dh_fixperms:
- dh_fixperms
- find debian -name co1.nex -exec chmod -x \{\} \;
diff --git a/debian/source/format b/debian/source/format
deleted file mode 100644
index 163aaf8..0000000
--- a/debian/source/format
+++ /dev/null
@@ -1 +0,0 @@
-3.0 (quilt)
diff --git a/debian/tests/control b/debian/tests/control
deleted file mode 100644
index b044b0c..0000000
--- a/debian/tests/control
+++ /dev/null
@@ -1,3 +0,0 @@
-Tests: run-unit-test
-Depends: @, r-cran-testthat
-Restrictions: allow-stderr
diff --git a/debian/tests/run-unit-test b/debian/tests/run-unit-test
deleted file mode 100644
index 99bb957..0000000
--- a/debian/tests/run-unit-test
+++ /dev/null
@@ -1,12 +0,0 @@
-#!/bin/sh -e
-
-oname=phylobase
-pkg=r-cran-`echo $oname | tr [A-Z] [a-z]`
-
-if [ "$ADTTMP" = "" ] ; then
- ADTTMP=`mktemp -d /tmp/${pkg}-test.XXXXXX`
-fi
-cd $ADTTMP
-cp -a /usr/share/doc/${pkg}/tests/* $ADTTMP
-LC_ALL=C R --no-save < test-all.R
-rm -fr $ADTTMP/*
diff --git a/debian/watch b/debian/watch
deleted file mode 100644
index b077d57..0000000
--- a/debian/watch
+++ /dev/null
@@ -1,3 +0,0 @@
-version=3
-http://cran.r-project.org/src/contrib/phylobase_([-0-9\.]*).tar.gz
-
diff --git a/inst/doc/phylobase.Rnw b/inst/doc/phylobase.Rnw
new file mode 100644
index 0000000..4f81ba6
--- /dev/null
+++ b/inst/doc/phylobase.Rnw
@@ -0,0 +1,674 @@
+\documentclass{article}
+%\VignetteEngine{knitr::knitr}
+%\VignetteIndexEntry{phylo4: classes and methods for phylogenetic trees and data}
+
+\usepackage[utf8]{inputenc} % for UTF-8/single quotes from sQuote()
+\usepackage{graphicx}
+\usepackage{array}
+\usepackage{url}
+
+
+%% Use a little bit more of the page
+%% borrowed from Rd.sty, of r-project.org
+\addtolength{\textheight}{12mm}
+\addtolength{\topmargin}{-9mm} % still fits on US paper
+\addtolength{\textwidth}{24mm} % still fits on US paper
+\setlength{\oddsidemargin}{10mm}
+\setlength{\evensidemargin}{\oddsidemargin}
+
+\newcommand{\code}[1]{{{\tt #1}}}
+
+\title{The \code{phylo4} S4 classes and methods}
+\author{Ben Bolker, Peter Cowan \& Fran\c{c}ois Michonneau}
+\date{\today}
+
+\begin{document}
+
+
+<<setup, include=FALSE>>=
+library(knitr)
+opts_chunk$set(
+ fig.keep='none', dev='pdf', fig.width=6, fig.height=6,
+ latex.options.color="usenames,dvipsnames"
+)
+@
+
+
+\maketitle
+\tableofcontents
+
+\section{Introduction}
+
+This document describes the new \code{phylo4} S4 classes and methods, which are
+intended to provide a unifying standard for the representation of phylogenetic
+trees and comparative data in R. The \code{phylobase} package was developed to
+help both end users and package developers by providing a common suite of tools
+likely to be shared by all packages designed for phylogenetic analysis,
+facilities for data and tree manipulation, and standardization of formats.
+
+This standardization will benefit \emph{end-users} by making it easier to move
+data and compare analyses across packages, and to keep comparative data
+synchronized with phylogenetic trees. Users will also benefit from a repository
+of functions for tree manipulation, for example tools for including or excluding
+subtrees (and associated phenotypic data) or improved tree and data plotting
+facilities. \code{phylobase} will benefit \emph{developers} by freeing them to
+put their programming effort into developing new methods rather than into
+re-coding base tools. We (the \code{phylobase} developers) hope \code{phylobase}
+will also facilitate code validation by providing a repository for benchmark
+tests, and more generally that it will help catalyze community development of
+comparative methods in R.
+
+A more abstract motivation for developing \code{phylobase} was to improve data
+checking and abstraction of the tree data formats. \code{phylobase} can check
+that data and trees are associated in the proper fashion, and protects users and
+developers from accidently reordering one, but not the other. It also seeks to
+abstract the data format so that commonly used information (for example, branch
+length information or the ancestor of a particular node) can be accessed without
+knowledge of the underlying data structure (i.e., whether the tree is stored as
+a matrix, or a list, or a parenthesis-based format). This is achieved through
+generic \code{phylobase} functions which which retrieve the relevant information
+from the data structures. The benefits of such abstraction are multiple: (1)
+\emph{easier access to the relevant information} via a simple function call
+(this frees both users and developers from learning details of complex data
+structures), (2) \emph{freedom to optimize data structures in the future without
+ breaking code.} Having the generic functions in place to ``translate'' between
+the data structures and the rest of the program code allows program and data
+structure development to proceed somewhat independently. The alternative is code
+written for specific data structures, in which modifications to the data
+structure requires rewriting the entire package code (often exacting too high a
+price, which results in the persistence of less-optimal data structures). (3)
+\emph{providing broader access to the range of tools in
+ \code{phylobase}}. Developers of specific packages can use these new tools
+based on S4 objects without knowing the details of S4 programming.
+
+The base \code{phylo4} class is modeled on the the \code{phylo} class in
+\code{ape}. \code{phylo4d} and \code{multiphylo4} extend the \code{phylo4}
+class to include data or multiple trees respectively. In addition to describing
+the classes and methods, this vignette gives examples of how they might be used.
+
+\section{Package overview}
+
+The phylobase package currently implements the following functions and data structures:
+
+\begin{itemize}
+\item Data structures for storing a single tree and multiple trees:
+ \code{phylo4} and \code{multiPhylo4}?
+\item A data structure for storing a tree with associated tip and node data:
+ \code{phylo4d}
+\item A data structure for storing multiple trees with one set of tip data:
+ \code{multiPhylo4d}
+\item Functions for reading nexus files into the above data structures
+\item Functions for converting between the above data structures and \code{ape
+ phylo} objects as well as \code{ade4} \code{phylog} objects (although the
+ latter are now deprecated \ldots)
+\item Functions for editing trees and data (i.e., subsetting and replacing)
+\item Functions for plotting trees and trees with data
+\end{itemize}
+
+\section{Using the S4 help system}
+
+The \code{S4} help system works similarly to the \code{S3} help system with some
+small differences relating to how \code{S4} methods are written. The
+\code{plot()} function is a good example. When we type \code{?plot} we are
+provided the help for the default plotting function which expects \code{x} and
+\code{y}. \code{R} also provides a way to smartly dispatch the right type of
+plotting function. In the case of an \code{ape phylo} object (a \code{S3} class
+object) \code{R} evaluates the class of the object and finds the correct
+functions, so the following works correctly.
+
+<<randtree1,fig.keep='none',tidy=FALSE>>=
+library(ape)
+set.seed(1) ## set random-number seed
+rand_tree <- rcoal(10) ## Make a random tree with 10 tips
+plot(rand_tree)
+@
+
+However, typing \code{?plot} still takes us to the default \code{plot} help. We
+have to type \code{?plot.phylo} to find what we are looking for. This is
+because \code{S3} generics are simply functions with a dot and the class name
+added.
+
+The \code{S4} generic system is too complicated to describe here, but doesn't
+include the same dot notation. As a result \code{?plot.phylo4} doesn't work,
+\code{R} still finds the right plotting function.
+
+<<convtree,fig.keep='none'>>=
+library(phylobase)
+# convert rand_tree to a phylo4 object
+rand_p4_tree <- as(rand_tree, "phylo4")
+plot(rand_p4_tree)
+@
+
+All fine and good, but how to we find out about all the great features of the
+\code{phylobase} plotting function? \code{R} has two nifty ways to find it, the
+first is to simply put a question mark in front of the whole call:
+
+<<doc0, eval=FALSE, purl=FALSE>>=
+`?`(plot(rand_p4_tree))
+@
+
+\code{R} looks at the class of the \code{rand\_p4\_tree} object and takes us to
+the correct help file (note: this only works with \code{S4} objects). The
+second ways is handy if you already know the class of your object, or want to
+compare to generics for different classes:
+
+<<doc1, eval=FALSE, purl=FALSE>>=
+`?`(method, plot("phylo4"))
+@
+
+More information about how \code{S4} documentation works can be found in the
+methods package, by running the following command.
+
+<<doc2,eval=FALSE, purl=FALSE>>=
+help('Documentation', package="methods")
+@
+
+\section{Trees without data}
+
+You can start with a tree --- an object of class \code{phylo} from the
+\code{ape} package (e.g., read in using the \code{read.tree()} or
+\code{read.nexus()} functions), and convert it to a \code{phylo4} object.
+
+For example, load the raw \emph{Geospiza} data:
+<<geodata,tidy=FALSE>>=
+library(phylobase)
+data(geospiza_raw)
+## what does it contain?
+names(geospiza_raw)
+@
+
+Convert the \code{S3} tree to a \code{S4 phylo4} object using the \code{as()}
+function:
+
+<<convgeodata>>=
+(g1 <- as(geospiza_raw$tree, "phylo4"))
+@
+
+The (internal) nodes appear with labels \verb+<NA>+ because
+they are not defined:
+
+<<nodelabelgeodata>>=
+nodeLabels(g1)
+@
+
+You can also retrieve the node labels with \code{labels(g1,"internal")}).
+
+A simple way to assign the node numbers as labels (useful for various checks) is
+
+<<>>=
+nodeLabels(g1) <- paste("N", nodeId(g1, "internal"), sep="")
+head(g1, 5)
+@
+
+The \code{summary} method gives a little extra information, including
+information on the distribution of branch lengths:
+
+<<sumgeodata>>=
+summary(g1)
+@
+
+Print tip labels:
+<<tiplabelgeodata>>=
+tipLabels(g1)
+@
+
+(\code{labels(g1,"tip")} would also work.)
+
+You can modify labels and other aspects of the tree --- for example, to convert
+all the labels to lower case:
+
+<<modlabelsgeodata>>=
+tipLabels(g1) <- tolower(tipLabels(g1))
+@
+
+You could also modify selected labels, e.g. to modify the labels in positions 11
+and 13 (which happen to be the only labels with uppercase letters):
+
+<<eval=FALSE, purl=FALSE>>=
+tipLabels(g1)[c(11, 13)] <- c("platyspiza", "pinaroloxias")
+@
+
+Note that for a given tree, \code{phylobase} always return the \code{tipLabels}
+in the same order.
+
+Print node numbers (in edge matrix order):
+<<nodenumbergeodata>>=
+nodeId(g1, type='all')
+@
+
+Does it have information on branch lengths?
+<<hasbrlengeodata>>=
+hasEdgeLength(g1)
+@
+
+It does! What do they look like?
+<<edgeLength-geodata>>=
+edgeLength(g1)
+@
+
+Note that the root has \verb+<NA>+ as its length.
+
+Print edge labels (also empty in this case --- therefore all \code{NA}):
+
+<<edgelabelgeodata>>=
+edgeLabels(g1)
+@
+
+You can also use this function to label specific edges:
+<<edgelabel-assign-geodata>>=
+edgeLabels(g1)["23-24"] <- "an edge"
+edgeLabels(g1)
+@
+
+The edge labels are named according to the nodes they connect
+(ancestor-descendant). You can get the edge(s) associated with a particular
+node:
+
+<<getEdge-geodata>>=
+getEdge(g1, 24) # default uses descendant node
+getEdge(g1, 24, type="ancestor") # edges using ancestor node
+@
+
+These results can in turn be passed to the function \code{edgeLength} to
+retrieve the length of a given set of edges:
+
+<<getEdge-edgeLength>>=
+edgeLength(g1)[getEdge(g1, 24)]
+edgeLength(g1)[getEdge(g1, 24, "ancestor")]
+@
+
+Is it rooted?
+
+<<rootedgeodata>>=
+isRooted(g1)
+@
+
+Which node is the root?
+<<rootnodegeodata>>=
+rootNode(g1)
+@
+
+Does it contain any polytomies?
+<<polygeodata>>=
+hasPoly(g1)
+@
+
+Is the tree ultrametric?
+<<ultrametric-geodata>>=
+isUltrametric(g1)
+@
+
+You can also get the depth (distance from the root) of any given node or the
+tips:
+<<nodeDepth-geodata>>=
+nodeDepth(g1, 23)
+depthTips(g1)
+@
+
+\section{Trees with data}
+
+The \code{phylo4d} class matches trees with data, or combines them with a data
+frame to make a \code{phylo4d} (tree-with-data) object.
+
+Now we'll take the \emph{Geospiza} data from \verb+geospiza_raw$data+ and merge
+it with the tree. First, let's prepare the data:
+
+<<dataprep>>=
+g1 <- as(geospiza_raw$tree, "phylo4")
+geodata <- geospiza_raw$data
+@
+
+
+However, since \emph{G. olivacea} is included in the tree but
+not in the data set, we will initially run into some trouble:
+
+<<geomergedata, error=TRUE, purl=FALSE>>=
+g2 <- phylo4d(g1, geodata)
+@
+
+<<echo=FALSE, results='hide'>>=
+geodata <- geospiza_raw$data
+@
+
+To deal with \emph{G. olivacea} missing from the data, we have a few
+choices. The easiest is to use \code{missing.data="warn"} to allow \code{R} to
+create the new object with a warning (you can also use \code{missing.data="OK"}
+to proceed without warnings):
+
+<<geomerge2, tidy=FALSE, warning=TRUE, purl=FALSE>>=
+g2 <- phylo4d(g1, geodata, missing.data="warn")
+@
+
+<<echo=FALSE, results='hide'>>=
+g2 <- phylo4d(g1, geodata, missing.data="OK", extra.data="OK")
+@
+
+Another way to deal with this would be to use \code{prune()} to drop the
+offending tip from the tree first:
+
+<<geomerge3, results='hide'>>=
+g1sub <- prune(g1, "olivacea")
+g1B <- phylo4d(g1sub, geodata)
+@
+
+The difference between the two objects is that the species \emph{G. olivacea} is
+still present in the tree but has no data (i.e., \verb+NA+) associated with
+it. In the other case, \textit{G. olivacea} is not included in the tree
+anymore. The approach you choose depends on the goal of your analysis.
+
+You can summarize the new object with the function \code{summary}. It breaks
+down the statistics about the traits based on whether it is associated with the
+tips for the internal nodes:
+<<geomergesum>>=
+summary(g2)
+@
+
+Or use \code{tdata()} to extract the data (i.e., \code{tdata(g2)}). By default,
+\code{tdata()} will retrieve tip data, but you can also get internal node data
+only (\code{tdata(tree, "internal")}) or --- if the tip and node data have the
+same format --- all the data combined (\code{tdata(tree, "allnode")}).
+
+If you want to plot the data (e.g. for checking the input),
+\code{plot(tdata(g2))} will create the default plot for the data --- in this
+case, since it is a data frame [\textbf{this may change in future versions but
+ should remain transparent}] this will be a \code{pairs} plot of the data.
+
+\section{Subsetting}
+
+The \code{subset} command offers a variety of ways of extracting portions of a
+\code{phylo4} or \code{phylo4d} tree, keeping any tip/node data consistent.
+
+\begin{description}
+\item[tips.include]{give a vector of tips (names or numbers) to retain}
+\item[tips.exclude]{give a vector of tips (names or numbers) to drop}
+\item[mrca]{give a vector of node or tip names or numbers; extract the clade
+ containing these taxa}
+\item[node.subtree]{give a node (name or number); extract the subtree starting
+ from this node}
+\end{description}
+
+Different ways to extract the \emph{fuliginosa}-\emph{scandens} clade:
+
+<<geoextract,results='hide'>>=
+subset(g2, tips.include=c("fuliginosa", "fortis", "magnirostris",
+ "conirostris", "scandens"))
+subset(g2, node.subtree=21)
+subset(g2, mrca=c("scandens", "fortis"))
+@
+
+One could drop the clade by doing
+
+<<geodrop, results='hide'>>=
+subset(g2, tips.exclude=c("fuliginosa", "fortis", "magnirostris",
+ "conirostris", "scandens"))
+subset(g2, tips.exclude=names(descendants(g2, MRCA(g2, c("difficilis",
+ "fortis")))))
+
+@
+
+% This isn't implemented yet
+
+% Another approach is to pick the subtree graphically, by plotting the tree and
+% using \code{identify}, which returns the identify of the node you click on
+% with the mouse.
+%
+% <<geoident,eval=FALSE>>=
+% plot(g1)
+% n1 <- identify(g1)
+% subset(g2,node.subtree=n1)
+% @
+
+\section{Tree-walking}
+
+\code{phylobase} provides many functions that allows users to explore
+relationships between nodes on a tree (tree-walking and tree traversal). Most
+functions work by specifying the \code{phylo4} (or \code{phylo4d}) object as the
+first argument, the node numbers/labels as the second argument (followed by some
+additional arguments).
+
+\code{getNode} allows you to find a node based on its node number or its
+label. It returns a vector with node numbers as values and labels as names:
+
+<<getnode>>=
+data(geospiza)
+getNode(geospiza, 10)
+getNode(geospiza, "pauper")
+@
+
+If no node is specified, they are all returned, and if a node can't be found
+it's returned as a \verb+NA+. It is possible to control what happens when a node
+can't be found:
+
+<<getnode2>>=
+getNode(geospiza)
+getNode(geospiza, 10:14)
+getNode(geospiza, "melanogaster", missing="OK") # no warning
+getNode(geospiza, "melanogaster", missing="warn") # warning!
+@
+
+\code{children} and \code{ancestor} give the immediate neighboring nodes:
+
+<<children>>=
+children(geospiza, 16)
+ancestor(geospiza, 16)
+@
+
+while \code{descendants} and \code{ancestors} can traverse the tree up to the
+tips or root respectively:
+
+<<descendants>>=
+descendants(geospiza, 16) # by default returns only the tips
+descendants(geospiza, "all") # also include the internal nodes
+ancestors(geospiza, 20)
+ancestors(geospiza, 20, "ALL") # uppercase ALL includes self
+@
+
+\code{siblings} returns the other node(s) associated with the same ancestor:
+
+<<siblings>>=
+siblings(geospiza, 20)
+siblings(geospiza, 20, include.self=TRUE)
+@
+
+\code{MRCA} returns the most common recent ancestor for a set of tips, and
+shortest path returns the nodes connecting 2 nodes:
+
+<<mrca>>=
+MRCA(geospiza, 1:6)
+shortestPath(geospiza, 4, "pauper")
+@
+
+\section{multiPhylo4 classes}
+
+\code{multiPhylo4} classes are not yet implemented but will be coming soon.
+
+\section{Examples}
+
+\subsection{Constructing a Brownian motion trait simulator}
+
+This section will describe a way of constructing a simulator that generates
+trait values for extant species (tips) given a tree with branch lengths,
+assuming a model of Brownian motion.
+
+We can use \code{as(tree,"phylo4vcov")} to coerce the tree into a
+variance-covariance matrix form, and then use \code{mvrnorm} from the
+\code{MASS} package to generate a set of multivariate normally distributed
+values for the tips. (A benefit of this approach is that we can very quickly
+generate a very large number of replicates.) This example illustrates a common
+feature of working with \code{phylobase} --- combining tools from several
+different packages to operate on phylogenetic trees with data.
+
+We start with a randomly generated tree using \code{rcoal()} from \code{ape} to
+generate the tree topology and branch lengths:
+
+<<rtree2>>=
+set.seed(1001)
+tree <- as(rcoal(12), "phylo4")
+@
+
+Next we generate the phylogenetic variance-covariance matrix (by coercing the
+tree to a \code{phylo4vcov} object) and pick a single set of normally
+distributed traits (using \code{MASS:mvrnorm} to pick a multivariate normal
+deviate with a variance-covariance matrix that matches the structure of the
+tree).
+
+<<vcvphylo>>=
+vmat <- as(tree, "phylo4vcov")
+vmat <- cov2cor(vmat)
+library(MASS)
+trvec <- mvrnorm(1, mu=rep(0, 12), Sigma=vmat)
+@
+
+The last step (easy) is to convert the \code{phylo4vcov} object back to a
+\code{phylo4d} object:
+
+<<plotvcvphylo>>=
+treed <- phylo4d(tree, tip.data=as.data.frame(trvec))
+plot(treed)
+@
+
+% \subsubsection{The hard way}
+
+% <<tidy=FALSE>>=
+% ## add node labels so we can match to data
+% nodeLabels(tree) <- as.character(nodeId(tree, "internal"))
+% ## ordering will make sure that we have ancestor value
+% ## defined before descendant
+% tree <- reorder(tree, "preorder")
+% edgemat <- edges(tree)
+% ## set aside space for values
+% nodevals <- numeric(nrow(edgemat))
+% ## label data in edge matrix order
+% names(nodevals) <- labels(tree, "all")[nodeId(tree, "all")]
+% ## variance is proportional to edge length; drop first
+% ## element of edge length, which is NA
+% dvals <- rnorm(nrow(edgemat) - 1, sd=edgeLength(tree)[-1]^2)
+% ## indexing: ind[node number] gives position in edge matrix
+% ind <- order(nodeId(tree, "all"))
+% for (i in 2:nrow(edgemat)) {
+% ## value of ancestor node plus change
+% nodevals[i] <- nodevals[ind[edgemat[i, 1]]] + dvals[i - 1]
+% }
+% nodevals <- data.frame(nodevals)
+% treed2 <- phylo4d(tree, all.data=nodevals)
+% @
+
+
+% ========================================
+% = Table of commands, worth the effort? =
+% ========================================
+% \begin{tabular}{>{\tt}ll}
+% \hline
+% \rm Method & Description\\
+% \hline
+% tdata & Retrieve tip data\\
+% plot & plot tree with data if present\\
+% \hline
+% \end{tabular}
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% Appendices %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+\appendix
+\section{Definitions/slots}
+
+This section details the internal structure of the \code{phylo4},
+\code{multiphylo4} (coming soon!), \code{phylo4d}, and \code{multiphylo4d}
+(coming soon!) classes. The basic building blocks of these classes are the
+\code{phylo4} object and a dataframe. The \code{phylo4} tree format is largely
+similar to the one used by \code{phylo} class in the package
+\code{ape}\footnote{\url{http://ape.mpl.ird.fr/}}.
+
+We use ``edge'' for ancestor-descendant relationships in the phylogeny
+(sometimes called ``branches'') and ``edge lengths'' for their lengths (``branch
+lengths''). Most generally, ``nodes'' are all species in the tree; species with
+descendants are ``internal nodes'' (we often refer to these just as ``nodes'',
+meaning clear from context); ``tips'' are species with no descendants. The
+``root node'' is the node with no ancestor (if one exists).
+
+\subsection{phylo4}
+Like \code{phylo}, the main components of
+the \code{phylo4} class are:
+\begin{description}
+\item[edge]{a 2-column matrix of integers,
+ with $N$ rows for a rooted tree or
+ $N-1$ rows for an unrooted tree and
+ column names \code{ancestor} and \code{descendant}.
+ Each row contains information on one edge in the tree.
+ See below for further constraints on the edge matrix.}
+\item[edge.length]{numeric list of edge lengths
+ (length $N$ (rooted) or $N-1$ (unrooted) or empty (length 0))}
+\item[tip.label]{character vector of tip labels (required), with length=\# of
+ tips. Tip labels need not be unique, but data-tree matching with non-unique
+ labels will cause an error}
+\item[node.label]{character vector of node labels, length=\# of internal nodes
+ or 0 (if empty). Node labels need not be unique, but data-tree matching
+ with non-unique labels will cause an error}
+\item[order]{character: ``preorder'', ``postorder'', or ``unknown'' (default),
+ describing the order of rows in the edge matrix. , ``pruningwise'' and
+ ``cladewise'' are accepted for compatibility with \code{ape}}
+\end{description}
+
+The edge matrix must not contain \code{NA}s, with the exception of the root
+node, which has an \code{NA} for \code{ancestor}. \code{phylobase} does not
+enforce an order on the rows of the edge matrix, but it stores information on
+the current ordering in the \code{@order} slot --- current allowable values are
+``unknown'' (the default), ``preorder'' (equivalent to ``cladewise'' in
+\code{ape}) or ``postorder'' \footnote{see
+ \url{http://en.wikipedia.org/wiki/Tree_traversal} for more information on
+ orderings. (\code{ape}'s ``pruningwise'' is ``bottom-up'' ordering).}.
+
+The basic criteria for the edge matrix are similar to those of \code{ape}, as
+documented it's tree
+specification\footnote{\url{ape.mpl.ird.fr/misc/FormatTreeR_28July2008.pdf}}. This
+is a modified version of those rules, for a tree with $n$ tips and $m$ internal
+nodes:
+
+\begin{itemize}
+\item Tips (no descendants) are coded $1,\ldots, n$,
+ and internal nodes ($\ge 1$ descendant)
+ are coded $n + 1, \ldots , n + m$
+ ($n + 1$ is the root).
+ Both series are numbered with no gaps.
+\item The first (ancestor)
+ column has only values $> n$ (internal nodes): thus, values $\le n$
+ (tips) appear only in the second (descendant) column)
+\item all internal nodes [not including the root] must appear in the first
+ (ancestor) column at least once [unlike \code{ape}, which nominally requires
+ each internal node to have at least two descendants (although it doesn't
+ absolutely prohibit them and has a \code{collapse.singles} function to get rid
+ of them), \code{phylobase} does allow these ``singleton nodes'' and has a
+ method \code{hasSingle} for detecting them]. Singleton nodes can be useful as
+ a way of representing changes along a lineage; they are used this way in the
+ \code{ouch} package.
+
+\item the number of occurrences of a node in the first column is related to the
+ nature of the node: once if it is a singleton, twice if it is dichotomous
+ (i.e., of degree 3 [counting ancestor as well as descendants]), three times if
+ it is trichotomous (degree 4), and so on.
+\end{itemize}
+
+\code{phylobase} does not technically prohibit reticulations (nodes or tips that
+appear more than once in the descendant column), but they will probably break
+most of the methods. Disconnected trees, cycles, and other exotica are not
+tested for, but will certainly break the methods.
+
+We have defined basic methods for \code{phylo4}:\code{show}, \code{print}, and a
+variety of accessor functions (see help files). \code{summary} does not seem to
+be terribly useful in the context of a ``raw'' tree, because there is not much
+to compute.
+
+\subsection{phylo4d}
+
+The \code{phylo4d} class extends \code{phylo4} with data. Tip data, and
+(internal) node data are stored separately, but can be retrieved together or
+separately with \code{tdata(x,"tip")}, \code{tdata(x,"internal")} or
+\code{tdata(x,"all")}. There is no separate slot for edge data, but these can be
+stored as node data associated with the descendant node.
+
+
+% \subsection{multiphylo4}
+
+\end{document}
diff --git a/inst/doc/phylobase.pdf b/inst/doc/phylobase.pdf
new file mode 100644
index 0000000..d95e221
Binary files /dev/null and b/inst/doc/phylobase.pdf differ
diff --git a/inst/nexmlfiles/comp_analysis.xml b/inst/nexmlfiles/comp_analysis.xml
new file mode 100644
index 0000000..930d6d6
--- /dev/null
+++ b/inst/nexmlfiles/comp_analysis.xml
@@ -0,0 +1,135 @@
+<nex:nexml generator="Bio::Phylo::Project v.0.56" version="0.9" xmlns="http://www.nexml.org/2009" xmlns:dc="http://purl.org/dc/elements/1.1/" xmlns:map="http://purl.org/phylo/phylomap/terms#" xmlns:nex="http://www.nexml.org/2009" xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#" xmlns:xml="http://www.w3.org/XML/1998/namespace" xmlns:xsd="http://www.w3.org/2001/XMLSchema#" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="http://www.nexml.org/2009 http://www. [...]
+ <meta content="rvosa" datatype="xsd:string" id="ma123" property="dc:creator" xsi:type="nex:LiteralMeta"/>
+ <meta content="2013-11-19T21:14:36" datatype="xsd:date" id="ma124" property="dc:date" xsi:type="nex:LiteralMeta"/>
+ <otus id="os2">
+ <otu id="ou3" label="taxon_1"/>
+ <otu id="ou4" label="taxon_2"/>
+ <otu id="ou5" label="taxon_3"/>
+ <otu id="ou6" label="taxon_4"/>
+ <otu id="ou7" label="taxon_5"/>
+ <otu id="ou8" label="taxon_6"/>
+ <otu id="ou9" label="taxon_7"/>
+ <otu id="ou10" label="taxon_8"/>
+ <otu id="ou11" label="taxon_9"/>
+ <otu id="ou12" label="taxon_10"/>
+ </otus>
+ <trees id="ts45" otus="os2">
+ <tree id="te3" xsi:type="nex:FloatTree">
+ <node id="ne4" root="true"/>
+ <node id="ne5"/>
+ <node id="ne18"/>
+ <node id="ne6"/>
+ <node id="ne15"/>
+ <node id="ne19" label="taxon_4" otu="ou6"/>
+ <node id="ne20"/>
+ <node id="ne7"/>
+ <node id="ne10"/>
+ <node id="ne16" label="taxon_1" otu="ou3"/>
+ <node id="ne17" label="taxon_6" otu="ou8"/>
+ <node id="ne21" label="taxon_8" otu="ou10"/>
+ <node id="ne22" label="taxon_2" otu="ou4"/>
+ <node id="ne8" label="taxon_10" otu="ou12"/>
+ <node id="ne9" label="taxon_3" otu="ou5"/>
+ <node id="ne11" label="taxon_9" otu="ou11"/>
+ <node id="ne12"/>
+ <node id="ne13" label="taxon_5" otu="ou7"/>
+ <node id="ne14" label="taxon_7" otu="ou9"/>
+ <edge id="edge5" length="3.696881159256865" source="ne4" target="ne5"/>
+ <edge id="edge18" length="6.52286144622459" source="ne4" target="ne18"/>
+ <edge id="edge6" length="1.969189306433843" source="ne5" target="ne6"/>
+ <edge id="edge15" length="6.014597540831531" source="ne5" target="ne15"/>
+ <edge id="edge19" length="3.4771385537754096" source="ne18" target="ne19"/>
+ <edge id="edge20" length="0.5636952545807309" source="ne18" target="ne20"/>
+ <edge id="edge7" length="3.4347773909168033" source="ne6" target="ne7"/>
+ <edge id="edge10" length="1.1914228015063353" source="ne6" target="ne10"/>
+ <edge id="edge16" length="0.2885212999116033" source="ne15" target="ne16"/>
+ <edge id="edge17" length="0.2885212999116033" source="ne15" target="ne17"/>
+ <edge id="edge21" length="2.9134432991946784" source="ne20" target="ne21"/>
+ <edge id="edge22" length="2.9134432991946784" source="ne20" target="ne22"/>
+ <edge id="edge8" length="0.8991521433924884" source="ne7" target="ne8"/>
+ <edge id="edge9" length="0.8991521433924884" source="ne7" target="ne9"/>
+ <edge id="edge11" length="3.142506732802957" source="ne10" target="ne11"/>
+ <edge id="edge12" length="3.090282850558667" source="ne10" target="ne12"/>
+ <edge id="edge13" length="0.05222388224429004" source="ne12" target="ne13"/>
+ <edge id="edge14" length="0.05222388224429004" source="ne12" target="ne14"/>
+ </tree>
+ </trees>
+ <characters id="cs15" otus="os2" xsi:type="nex:ContinuousCells">
+ <format>
+ <char id="cr19" label="log snout-vent length"/>
+ </format>
+ <matrix>
+ <row id="rw18" label="taxon_1" otu="ou3">
+ <cell char="cr19" state="4.753282394110277"/>
+ </row>
+ <row id="rw20" label="taxon_2" otu="ou4">
+ <cell char="cr19" state="-2.762414626244099"/>
+ </row>
+ <row id="rw21" label="taxon_3" otu="ou5">
+ <cell char="cr19" state="2.1049413318540546"/>
+ </row>
+ <row id="rw22" label="taxon_4" otu="ou6">
+ <cell char="cr19" state="-4.950476985900421"/>
+ </row>
+ <row id="rw23" label="taxon_5" otu="ou7">
+ <cell char="cr19" state="1.2714718119132646"/>
+ </row>
+ <row id="rw24" label="taxon_6" otu="ou8">
+ <cell char="cr19" state="6.259396617506572"/>
+ </row>
+ <row id="rw25" label="taxon_7" otu="ou9">
+ <cell char="cr19" state="0.9099634402363945"/>
+ </row>
+ <row id="rw26" label="taxon_8" otu="ou10">
+ <cell char="cr19" state="-3.27777989906524"/>
+ </row>
+ <row id="rw27" label="taxon_9" otu="ou11">
+ <cell char="cr19" state="2.095943286820963"/>
+ </row>
+ <row id="rw28" label="taxon_10" otu="ou12">
+ <cell char="cr19" state="3.1373971053009555"/>
+ </row>
+ </matrix>
+ </characters>
+ <characters id="cs31" otus="os2" xsi:type="nex:StandardCells">
+ <format>
+ <states id="ss33">
+ <state id="s1" symbol="0"/>
+ <state id="s2" symbol="1"/>
+ </states>
+ <char id="cr35" states="ss33" label="reef-dwelling"/>
+ </format>
+ <matrix>
+ <row id="rw34" label="taxon_1" otu="ou3">
+ <cell char="cr35" state="s2"/>
+ </row>
+ <row id="rw36" label="taxon_2" otu="ou4">
+ <cell char="cr35" state="s1"/>
+ </row>
+ <row id="rw37" label="taxon_3" otu="ou5">
+ <cell char="cr35" state="s1"/>
+ </row>
+ <row id="rw38" label="taxon_4" otu="ou6">
+ <cell char="cr35" state="s1"/>
+ </row>
+ <row id="rw39" label="taxon_5" otu="ou7">
+ <cell char="cr35" state="s2"/>
+ </row>
+ <row id="rw40" label="taxon_6" otu="ou8">
+ <cell char="cr35" state="s2"/>
+ </row>
+ <row id="rw41" label="taxon_7" otu="ou9">
+ <cell char="cr35" state="s2"/>
+ </row>
+ <row id="rw42" label="taxon_8" otu="ou10">
+ <cell char="cr35" state="s1"/>
+ </row>
+ <row id="rw43" label="taxon_9" otu="ou11">
+ <cell char="cr35" state="s2"/>
+ </row>
+ <row id="rw44" label="taxon_10" otu="ou12">
+ <cell char="cr35" state="s1"/>
+ </row>
+ </matrix>
+ </characters>
+</nex:nexml>
diff --git a/inst/nexusfiles/ExContData.Rdata b/inst/nexusfiles/ExContData.Rdata
new file mode 100644
index 0000000..6d5da72
Binary files /dev/null and b/inst/nexusfiles/ExContData.Rdata differ
diff --git a/inst/nexusfiles/MultiLineTrees.nex b/inst/nexusfiles/MultiLineTrees.nex
new file mode 100644
index 0000000..874a201
--- /dev/null
+++ b/inst/nexusfiles/MultiLineTrees.nex
@@ -0,0 +1,89 @@
+#NEXUS
+
+Begin trees;
+ Translate
+ 1 Acorus,
+ 2 Protarum,
+ 3 Biarum,
+ 4 Helicodiceros,
+ 5 Eminium,
+ 6 Dracunculus,
+ 7 Pinellia,
+ 8 Peltandra,
+ 9 Steudnera,
+ 10 Remusatia,
+ 11 Colocasia,
+ 12 Arum,
+ 13 Callopsis,
+ 14 Spathicarpa,
+ 15 Dieffenbachia,
+ 16 Dracontium,
+ 17 Anaphyllopsis,
+ 18 Gonatopus,
+ 19 Epipremnum,
+ 20 Scindapsus,
+ 21 Anadendrum,
+ 22 Stenospermation,
+ 23 Monstera,
+ 24 Rhodospatha,
+ 25 Holochlamys,
+ 26 Heteropsis,
+ 27 Amydrium,
+ 28 Rhaphidophora,
+ 29 Spathiphyllum,
+ 30 Pothos,
+ 31 Anthurium,
+ 32 Cercestis,
+ 33 Aglaonema1,
+ 34 Montrichardia,
+ 35 Philodendron,
+ 36 Anubias,
+ 37 Nephthytis,
+ 38 Rhektophyllum,
+ 39 Anchomanes,
+ 40 Typhonodorum,
+ 41 Typhonium,
+ 42 Spirodela,
+ 43 Landoltia,
+ 44 Asterostigma,
+ 45 Zantedeschia,
+ 46 Calla,
+ 47 Schismatoglottis,
+ 48 Zamioculcas,
+ 49 Culcasia,
+ 50 Cyrtosperma,
+ 51 Aglaonema,
+ 52 Scaphispatha,
+ 53 Chlorospatha,
+ 54 Arophyton,
+ 55 Jasarum,
+ 56 Caladium,
+ 57 Xanthosoma,
+ 58 Hapaline,
+ 59 Ambrosina,
+ 60 Alocasia,
+ 61 Pistia,
+ 62 Homalomena,
+ 63 Amorphophallus,
+ 64 Alloschemone,
+ 65 Arisaema,
+ 66 Symplocarpus,
+ 67 Orontium,
+ 68 Lysichiton,
+ 69 Gymnostachys
+ ;
+tree PAUP_1 = [&U] (1:70,((((((((((((((((((((2:4,(((3:0,((4:1,12:0):0,(5:2,6:0):1):0):2,7:7):1,
+ ((9:1,10:0):1,11:0):1):0):2,61:13):0,(60:3,65:4):1):1,41:3):5,59:20):1,8:4):0,40:8):4,
+ ((((52:5,(53:2,54:6):6):2,58:7):1,((55:4,57:4):0,56:2):2):3,63:6):1):11,((32:2,37:1):3,
+ (33:1,51:0):2):3):1,(35:0,62:2):9):1,34:9):3,(13:5,45:13):4):0,(36:5,(38:0,39:0):4):1):2,
+ ((14:7,15:10):6,44:13):10):4,(46:17,47:6):3):3,(((16:1,17:1):0,50:1):13,(18:2,48:5):2):3):1,49:8):6,
+ ((((19:4,20:1):1,(((21:4,(23:2,(25:5,29:3):3):0):1,28:2):0,27:2):0):1,(((22:3,64:11):0,26:3):1,
+ 24:2):1):7,(30:6,31:31):4):11):11,(42:11,43:14):20):38,(69:17,((66:3,68:3):1,67:0):12):1):36);
+tree PAUP_2 = [&U] (1:70,((((((((((((((((((((2:4,(((3:0,((4:1,12:0):0,(5:2,6:0):1):0):2,7:7):1,
+ ((9:1,10:0):1,11:0):1):0):2,61:13):0,(60:3,65:4):1):1,41:3):5,59:20):1,8:4):0,40:8):4,
+ ((((52:5,(53:2,54:6):6):2,58:7):1,((55:4,57:4):0,56:2):2):3,63:6):1):11,((32:2,37:1):3,
+ (33:1,51:0):2):3):1,(35:0,62:2):9):1,34:9):3,(13:5,45:13):4):0,(36:5,(38:0,39:0):4):1):2,
+ ((14:7,15:10):6,44:13):10):4,(46:17,47:6):3):3,(((16:1,17:1):0,50:1):13,(18:2,48:5):2):3):1,49:8):6,
+ ((((19:4,20:1):1,(((21:4,(23:2,(25:5,29:3):3):0):1,28:2):0,27:2):0):1,(((22:3,64:11):0,26:3):1,
+ 24:2):1):7,(30:6,31:31):4):11):11,(42:11,43:14):20):38,(69:17,((66:3,68:3):1,67:0):12):1):36);
+End;
diff --git a/inst/nexusfiles/NastyLabels.nex b/inst/nexusfiles/NastyLabels.nex
new file mode 100644
index 0000000..1a78ef5
--- /dev/null
+++ b/inst/nexusfiles/NastyLabels.nex
@@ -0,0 +1,56 @@
+#NEXUS
+[Data from Gavin Thomas]
+BEGIN TAXA;
+ DIMENSIONS NTAX = 11;
+ TAXLABELS
+ subterraneus
+ Mus_musculus
+ H._sapiens
+ 'H. sapiens #429'
+ 'Fred''s new sp.'
+ 'rusticus (1)'
+ '"shoal bass"'
+ AMNION
+ _23
+ x21.02
+ myType
+ ;
+end;
+
+BEGIN CHARACTERS;
+ DIMENSIONS NCHAR=1;
+ FORMAT DATATYPE = STANDARD SYMBOLS="0 1";
+ CHARSTATELABELS
+ 1 aCharacter / on off;
+ MATRIX
+ subterraneus 0
+ Mus_musculus 1
+ H._sapiens 0
+ 'H. sapiens #429' 1
+ 'Fred''s new sp.' 0
+ 'rusticus (1)' 1
+ '"shoal bass"' 0
+ AMNION 1
+ _23 0
+ x21.02 1
+ myType 0
+ ;
+END;
+
+BEGIN TREES;
+ TRANSLATE
+ 1 subterraneus,
+ 2 Mus_musculus,
+ 3 H._sapiens,
+ 4 'H. sapiens #429',
+ 5 'Fred''s new sp.',
+ 6 'rusticus (1)',
+ 7 '"shoal bass"',
+ 8 AMNION,
+ 9 _23,
+ 10 x21.02,
+ 11 myType
+ ;
+ TREE * COMB = (1,(2,(3,(4,(5,(6,(7,(8,(9,(10,11))))))))));
+end;
+
diff --git a/inst/nexusfiles/NastyLabels2.nex b/inst/nexusfiles/NastyLabels2.nex
new file mode 100644
index 0000000..e0f1de6
--- /dev/null
+++ b/inst/nexusfiles/NastyLabels2.nex
@@ -0,0 +1,52 @@
+#NEXUS
+
+
+begin data;
+ dimensions ntax=17 nchar=432;
+ format datatype=dna missing=?;
+ matrix
+ 'h uman' ctgactcctgaggagaagtctgccgttactgccctgtggggcaaggtgaacgtggatgaagttggtggtgaggccctgggcaggctgctggtggtctacccttggacccagaggttctttgagtcctttggggatctgtccactcctgatgctgttatgggcaaccctaaggtgaaggctcatggcaagaaagtgctcggtgcctttagtgatggcctggctcacctggacaacctcaagggcacctttgccacactgagtgagctgcactgtgacaagctgcacgtggatcctgagaacttcaggctcctgggcaacgtgctggtctgtgtgctggcccatcactttggcaaagaattcaccccaccagtgcaggctgcctatcagaaagtggtggctggtgtggctaatgccctggcccacaagtatcac
+ t_arsier ctgactgctgaagagaaggccgccgtcactgccctgtggggcaaggtagacgtggaagatgttggtggtgaggccctgggcaggctgctggtcgtctacccatggacccagaggttctttgactcctttggggacctgtccactcctgccgctgttatgagcaatgctaaggtcaaggcccatggcaaaaaggtgctgaacgcctttagtgacggcatggctcatctggacaacctcaagggcacctttgctaagctgagtgagctgcactgtgacaaattgcacgtggatcctgagaatttcaggctcttgggcaatgtgctggtgtgtgtgctggcccaccactttggcaaagaattcaccccgcaggttcaggctgcctatcagaaggtggtggctggtgtggctactgccttggctcacaagtaccac
+ 'b_ushbaby' ctgactcctgatgagaagaatgccgtttgtgccctgtggggcaaggtgaatgtggaagaagttggtggtgaggccctgggcaggctgctggttgtctacccatggacccagaggttctttgactcctttggggacctgtcctctccttctgctgttatgggcaaccctaaagtgaaggcccacggcaagaaggtgctgagtgcctttagcgagggcctgaatcacctggacaacctcaagggcacctttgctaagctgagtgagctgcattgtgacaagctgcacgtggaccctgagaacttcaggctcctgggcaacgtgctggtggttgtcctggctcaccactttggcaaggatttcaccccacaggtgcaggctgcctatcagaaggtggtggctggtgtggctactgccctggctcacaaataccac
+ 'ha re' ctgtccggtgaggagaagtctgcggtcactgccctgtggggcaaggtgaatgtggaagaagttggtggtgagaccctgggcaggctgctggttgtctacccatggacccagaggttcttcgagtcctttggggacctgtccactgcttctgctgttatgggcaaccctaaggtgaaggctcatggcaagaaggtgctggctgccttcagtgagggtctgagtcacctggacaacctcaaaggcaccttcgctaagctgagtgaactgcattgtgacaagctgcacgtggatcctgagaacttcaggctcctgggcaacgtgctggttattgtgctgtctcatcactttggcaaagaattcactcctcaggtgcaggctgcctatcagaaggtggtggctggtgtggccaatgccctggctcacaaataccac
+ 'ra\bbit' ctgtccagtgaggagaagtctgcggtcactgccctgtggggcaaggtgaatgtggaagaagttggtggtgaggccctgggcaggctgctggttgtctacccatggacccagaggttcttcgagtcctttggggacctgtcctctgcaaatgctgttatgaacaatcctaaggtgaaggctcatggcaagaaggtgctggctgccttcagtgagggtctgagtcacctggacaacctcaaaggcacctttgctaagctgagtgaactgcactgtgacaagctgcacgtggatcctgagaacttcaggctcctgggcaacgtgctggttattgtgctgtctcatcattttggcaaagaattcactcctcaggtgcaggctgcctatcagaaggtggtggctggtgtggccaatgccctggctcacaaataccac
+ 'co''w' ctgactgctgaggagaaggctgccgtcaccgccttttggggcaaggtgaaagtggatgaagttggtggtgaggccctgggcaggctgctggttgtctacccctggactcagaggttctttgagtcctttggggacttgtccactgctgatgctgttatgaacaaccctaaggtgaaggcccatggcaagaaggtgctagattcctttagtaatggcatgaagcatctcgatgacctcaagggcacctttgctgcgctgagtgagctgcactgtgataagctgcatgtggatcctgagaacttcaagctcctgggcaacgtgctagtggttgtgctggctcgcaattttggcaaggaattcaccccggtgctgcaggctgactttcagaaggtggtggctggtgtggccaatgccctggcccacagatatcat
+ 'sh"eep' ctgactgctgaggagaaggctgccgtcaccggcttctggggcaaggtgaaagtggatgaagttggtgctgaggccctgggcaggctgctggttgtctacccctggactcagaggttctttgagcactttggggacttgtccaatgctgatgctgttatgaacaaccctaaggtgaaggcccatggcaagaaggtgctagactcctttagtaacggcatgaagcatctcgatgacctcaagggcacctttgctcagctgagtgagctgcactgtgataagctgcacgtggatcctgagaacttcaggctcctgggcaacgtgctggtggttgtgctggctcgccaccatggcaatgaattcaccccggtgctgcaggctgactttcagaaggtggtggctggtgttgccaatgccctggcccacaaatatcac
+ pig ctgtctgctgaggagaaggaggccgtcctcggcctgtggggcaaagtgaatgtggacgaagttggtggtgaggccctgggcaggctgctggttgtctacccctggactcagaggttcttcgagtcctttggggacctgtccaatgccgatgccgtcatgggcaatcccaaggtgaaggcccacggcaagaaggtgctccagtccttcagtgacggcctgaaacatctcgacaacctcaagggcacctttgctaagctgagcgagctgcactgtgaccagctgcacgtggatcctgagaacttcaggctcctgggcaacgtgatagtggttgttctggctcgccgccttggccatgacttcaacccgaatgtgcaggctgcttttcagaaggtggtggctggtgttgctaatgccctggcccacaagtaccac
+ elephseal ttgacggcggaggagaagtctgccgtcacctccctgtggggcaaagtgaaggtggatgaagttggtggtgaagccctgggcaggctgctggttgtctacccctggactcagaggttctttgactcctttggggacctgtcctctcctaatgctattatgagcaaccccaaggtcaaggcccatggcaagaaggtgctgaattcctttagtgatggcctgaagaatctggacaacctcaagggcacctttgctaagctcagtgagctgcactgtgaccagctgcatgtggatcccgagaacttcaagctcctgggcaatgtgctggtgtgtgtgctggcccgccactttggcaaggaattcaccccacagatgcagggtgcctttcagaaggtggtagctggtgtggccaatgccctcgcccacaaatatcac
+ rat ctaactgatgctgagaaggctgctgttaatgccctgtggggaaaggtgaaccctgatgatgttggtggcgaggccctgggcaggctgctggttgtctacccttggacccagaggtactttgatagctttggggacctgtcctctgcctctgctatcatgggtaaccctaaggtgaaggcccatggcaagaaggtgataaacgccttcaatgatggcctgaaacacttggacaacctcaagggcacctttgctcatctgagtgaactccactgtgacaagctgcatgtggatcctgagaacttcaggctcctgggcaatatgattgtgattgtgttgggccaccacctgggcaaggaattcaccccctgtgcacaggctgccttccagaaggtggtggctggagtggccagtgccctggctcacaagtaccac
+ mouse ctgactgatgctgagaagtctgctgtctcttgcctgtgggcaaaggtgaaccccgatgaagttggtggtgaggccctgggcaggctgctggttgtctacccttggacccagcggtactttgatagctttggagacctatcctctgcctctgctatcatgggtaatcccaaggtgaaggcccatggcaaaaaggtgataactgcctttaacgagggcctgaaaaacctggacaacctcaagggcacctttgccagcctcagtgagctccactgtgacaagctgcatgtggatcctgagaacttcaggctcctaggcaatgcgatcgtgattgtgctgggccaccacctgggcaaggatttcacccctgctgcacaggctgccttccagaaggtggtggctggagtggccactgccctggctcacaagtaccac
+ hamster ctgactgatgctgagaaggcccttgtcactggcctgtggggaaaggtgaacgccgatgcagttggcgctgaggccctgggcaggttgctggttgtctacccttggacccagaggttctttgaacactttggagacctgtctctgccagttgctgtcatgaataacccccaggtgaaggcccatggcaagaaggtgatccactccttcgctgatggcctgaaacacctggacaacctgaagggcgccttttccagcctgagtgagctccactgtgacaagctgcacgtggatcctgagaacttcaagctcctgggcaatatgatcatcattgtgctgatccacgacctgggcaaggacttcactcccagtgcacagtctgcctttcataaggtggtggctggtgtggccaatgccctggctcacaagtaccac
+ marsupial ttgacttctgaggagaagaactgcatcactaccatctggtctaaggtgcaggttgaccagactggtggtgaggcccttggcaggatgctcgttgtctacccctggaccaccaggttttttgggagctttggtgatctgtcctctcctggcgctgtcatgtcaaattctaaggttcaagcccatggtgctaaggtgttgacctccttcggtgaagcagtcaagcatttggacaacctgaagggtacttatgccaagttgagtgagctccactgtgacaagctgcatgtggaccctgagaacttcaagatgctggggaatatcattgtgatctgcctggctgagcactttggcaaggattttactcctgaatgtcaggttgcttggcagaagctcgtggctggagttgcccatgccctggcccacaagtaccac
+ duck tggacagccgaggagaagcagctcatcaccggcctctggggcaaggtcaatgtggccgactgtggagctgaggccctggccaggctgctgatcgtctacccctggacccagaggttcttcgcctccttcgggaacctgtccagccccactgccatccttggcaaccccatggtccgtgcccatggcaagaaagtgctcacctccttcggagatgctgtgaagaacctggacaacatcaagaacaccttcgcccagctgtccgagctgcactgcgacaagctgcacgtggaccctgagaacttcaggctcctgggtgacatcctcatcatcgtcctggccgcccacttcaccaaggatttcactcctgactgccaggccgcctggcagaagctggtccgcgtggtggcccacgctctggcccgcaagtaccac
+ chicken tggactgctgaggagaagcagctcatcaccggcctctggggcaaggtcaatgtggccgaatgtggggccgaagccctggccaggctgctgatcgtctacccctggacccagaggttctttgcgtcctttgggaacctctccagccccactgccatccttggcaaccccatggtccgcgcccacggcaagaaagtgctcacctcctttggggatgctgtgaagaacctggacaacatcaagaacaccttctcccaactgtccgaactgcattgtgacaagctgcatgtggaccccgagaacttcaggctcctgggtgacatcctcatcattgtcctggccgcccacttcagcaaggacttcactcctgaatgccaggctgcctggcagaagctggtccgcgtggtggcccatgccctggctcgcaagtaccac
+ xenlaev tggacagctgaagagaaggccgccatcacttctgtatggcagaaggtcaatgtagaacatgatggccatgatgccctgggcaggctgctgattgtgtacccctggacccagagatacttcagtaactttggaaacctctccaattcagctgctgttgctggaaatgccaaggttcaagcccatggcaagaaggttctttcagctgttggcaatgccattagccatattgacagtgtgaagtcctctctccaacaactcagtaagatccatgccactgaactgtttgtggaccctgagaactttaagcgttttggtggagttctggtcattgtcttgggtgccaaactgggaactgccttcactcctaaagttcaggctgcttgggagaaattcattgcagttttggttgatggtcttagccagggctataac
+ xentrop tggacagctgaagaaaaagcaaccattgcttctgtgtgggggaaagtcgacattgaacaggatggccatgatgcattatccaggctgctggttgtttatccctggactcagaggtacttcagcagttttggaaacctctccaatgtctccgctgtctctggaaatgtcaaggttaaagcccatggaaataaagtcctgtcagctgttggcagtgcaatccagcatctggatgatgtgaagagccaccttaaaggtcttagcaagagccatgctgaggatcttcatgtggatcccgaaaacttcaagcgccttgcggatgttctggtgatcgttctggctgccaaacttggatctgccttcactccccaagtccaagctgtctgggagaagctcaatgcaactctggtggctgctcttagccatggctacttc
+ ;
+end;
+
+
+begin mrbayes;
+ [The following block illustrates how to set up two data partitions
+ and use different models for the different partitions.]
+ charset non_coding = 1-90 358-432;
+ charset coding = 91-357;
+ partition region = 2:non_coding,coding;
+ set partition = region;
+
+ [The following lines set a codon model for the second data partition (coding) and
+ allows the non_coding and coding partitions to have different overall rates.]
+ lset applyto=(2) nucmodel=codon;
+ prset ratepr=variable;
+
+ [Codon models are computationally complex so the following lines set the parameters
+ of the MCMC such that only 1 chain is run for 100 generations and results are printed
+ to screen and to file every tenth generation. To start this chain, you need to type
+ 'mcmc' after executing this block. You need to run the chain longer to get adequate
+ convergence.]
+ mcmcp ngen=100 nchains=1 printfreq=10 samplefreq=10;
+end;
+
+
+
+
diff --git a/inst/nexusfiles/co1.nex b/inst/nexusfiles/co1.nex
new file mode 100644
index 0000000..c066e8e
--- /dev/null
+++ b/inst/nexusfiles/co1.nex
@@ -0,0 +1,13 @@
+#NEXUS
+
+[ID: 0916634271]
+begin trees;
+ [Note: This tree contains information on the topology,
+ branch lengths (if present), and the probability
+ of the partition indicated by the branch.]
+ tree con_50_majrule = (Cow:0.143336,Seal:0.225087,((((((Carp:0.171296,Loach:0.222039)1.00:0.194575,Frog:0.237101)0.76:0.073060,Chicken:0.546258)1.00:0.204809,Human:0.533183)0.99:0.124549,(Mouse:0.134574,Rat:0.113163)1.00:0.154442)0.88:0.055934,Whale:0.145592)0.93:0.047441);
+
+ [Note: This tree contains information only on the topology
+ and branch lengths (mean of the posterior probability density).]
+ tree con_50_majrule = (Cow:0.143336,Seal:0.225087,((((((Carp:0.171296,Loach:0.222039):0.194575,Frog:0.237101):0.073060,Chicken:0.546258):0.204809,Human:0.533183):0.124549,(Mouse:0.134574,Rat:0.113163):0.154442):0.055934,Whale:0.145592):0.047441);
+end;
diff --git a/inst/nexusfiles/minNex.nex b/inst/nexusfiles/minNex.nex
new file mode 100644
index 0000000..f07442c
--- /dev/null
+++ b/inst/nexusfiles/minNex.nex
@@ -0,0 +1,56 @@
+#NEXUS
+
+BEGIN TAXA;
+ DIMENSIONS NTAX=4;
+ TAXLABELS
+ spA spB spC spD
+ ;
+
+END;
+
+BEGIN TREES;
+ TRANSLATE
+ 1 spA,
+ 2 spB,
+ 3 spC,
+ 4 spD;
+ TREE testTree = (1,(2,(3,4)));
+END;
+
+BEGIN CHARACTERS;
+ TITLE 'TestContinuous';
+ DIMENSIONS NCHAR=3;
+ FORMAT DATATYPE = CONTINUOUS;
+ CHARSTATELABELS
+ 1 char1,
+ 2 char2,
+ 3 char3;
+ MATRIX
+ spB 0.21 0.22 0.23
+ spA 0.11 0.12 0.13
+ spD 0.41 0.42 0.43
+ spC 0.31 0.32 0.33
+ ;
+END;
+
+BEGIN CHARACTERS;
+ TITLE 'TestStd';
+ DIMENSIONS NCHAR=3;
+ FORMAT DATATYPE = STANDARD
+ MISSING = ?
+ SYMBOLS = "0 1 2";
+ CHARSTATELABELS
+ 1 char1 / state11 state12 state13,
+ 2 char2 / state21 state22 state23,
+ 3 char3 / state31 state32 state33;
+ MATRIX
+ spA 1 (0 1) ?
+ spB 2 (1 2) 0
+ spC 0 (0 1 2) 1
+ spD 1 2 0
+ ;
+END;
+
+[BEGIN ASSUMPTIONS;
+ EXSET * UNTITLED = 3;
+END;]
diff --git a/inst/nexusfiles/minSeq.nex b/inst/nexusfiles/minSeq.nex
new file mode 100644
index 0000000..7a00a6a
--- /dev/null
+++ b/inst/nexusfiles/minSeq.nex
@@ -0,0 +1,12 @@
+#NEXUS
+
+
+begin data;
+ dimensions ntax=3 nchar=4;
+ format datatype=dna missing=?;
+ matrix
+ seq1 atcg
+ seq2 tcga
+ seq3 cgat
+ ;
+end;
diff --git a/inst/nexusfiles/newick.tre b/inst/nexusfiles/newick.tre
new file mode 100644
index 0000000..e36dd9b
--- /dev/null
+++ b/inst/nexusfiles/newick.tre
@@ -0,0 +1 @@
+(a:1,(b:2,c:3)xx:4)yy;
\ No newline at end of file
diff --git a/inst/nexusfiles/noStateLabels.nex b/inst/nexusfiles/noStateLabels.nex
new file mode 100644
index 0000000..344b8ae
--- /dev/null
+++ b/inst/nexusfiles/noStateLabels.nex
@@ -0,0 +1,36 @@
+#NEXUS
+
+BEGIN TAXA;
+ DIMENSIONS NTAX=4;
+ TAXLABELS
+ spA spB spC spD
+ ;
+
+END;
+
+BEGIN TREES;
+ TRANSLATE
+ 1 spA,
+ 2 spB,
+ 3 spC,
+ 4 spD;
+ TREE testTree = (1,(2,(3,4)));
+END;
+
+BEGIN CHARACTERS;
+ TITLE 'TestStd';
+ DIMENSIONS NCHAR=3;
+ FORMAT DATATYPE = STANDARD
+ MISSING = ?
+ SYMBOLS = "0 1 2";
+ CHARSTATELABELS
+ 1 char1,
+ 2 char2,
+ 3 char3;
+ MATRIX
+ spA 1 0 1
+ spB 2 1 0
+ spC 0 1 2
+ spD 1 2 0
+ ;
+END;
diff --git a/inst/nexusfiles/shorebird_underscore.nex b/inst/nexusfiles/shorebird_underscore.nex
new file mode 100644
index 0000000..ab98c7e
--- /dev/null
+++ b/inst/nexusfiles/shorebird_underscore.nex
@@ -0,0 +1,321 @@
+#NEXUS
+[Data from Gavin Thomas]
+BEGIN TAXA;
+ DIMENSIONS NTAX = 71;
+ TAXLABELS
+ Catoptrophorus_semipalmatus
+ Tringa_ochropus
+ Tringa_stagnatilis
+ Tringa_flavipes
+ Tringa_nebularia
+ Tringa_totanus
+ Tringa_erythropus
+ Tringa_melanoleuca
+ Tringa_glareola
+ Steganopus_tricolor
+ Phalaropus_lobatus
+ Phalaropus_fulicaria
+ Micropalama_himantopus
+ Eurynorhynchus_pygmeus
+ Aphriza_virgata
+ Calidris_canutus
+ Calidris_tenuirostris
+ Calidris_temminckii
+ Calidris_maritima
+ Calidris_ptilocnemis
+ Calidris_mauri
+ Calidris_alba
+ Calidris_alpina
+ Calidris_bairdii
+ Calidris_minutilla
+ Calidris_pusilla
+ Calidris_minuta
+ Calidris_ruficollis
+ Calidris_subminuta
+ Arenaria_interpres
+ Arenaria_melanocephala
+ Tringa_hypoleucos
+ Tringa_macularia
+ Limnodromus_griseus
+ Gallinago_gallinago
+ Coenocorypha_aucklandica
+ Coenocorypha_pusilla
+ Limosa_fedoa
+ Limosa_haemastica
+ Limosa_limosa
+ Limosa_lapponica
+ Bartramia_longicauda
+ Numenius_tahitiensis
+ Numenius_phaeopus
+ Numenius_arquata
+ Numenius_americanus
+ Rostratula_benghalensis
+ Jacana_spinosa
+ Jacana_jacana
+ Metopidius_indicus
+ Actophilornis_africanus
+ Pedionomus_torquatus
+ Pluvialis_apricaria
+ Pluvialis_dominica
+ Eudromias_morinellus
+ Charadrius_montanus
+ Charadrius_vociferus
+ Charadrius_wilsonia
+ Charadrius_dubius
+ Charadrius_hiaticula
+ Charadrius_melodus
+ Vanellus_vanellus
+ Vanellus_lugubris
+ Vanellus_armatus
+ Recurvirostra_avosetta
+ Haematopus_longirostris
+ Haematopus_fuliginosus
+ Haematopus_moquini
+ Haematopus_ostralegus
+ Haematopus_unicolor
+ Haematopus_finschi
+ ;
+END;
+
+BEGIN CHARACTERS;
+ TITLE MassClutchSize;
+ DIMENSIONS NCHAR=4;
+ FORMAT DATATYPE = CONTINUOUS;
+ CHARSTATELABELS
+ 1 malemass,
+ 2 femalemass,
+ 3 eggmass,
+ 4 clutchsize;
+ MATRIX
+ Actophilornis_africanus 143.2 260.7 8.6 4.00
+ Aphriza_virgata 186.3 216.3 22.4 4.00
+ Arenaria_interpres 108.0 113.0 17.9 3.50
+ Arenaria_melanocephala 113.6 124.2 17.3 4.00
+ Bartramia_longicauda 151.0 164.0 23.5 3.99
+ Calidris_alba 52.8 55.4 11.2 3.90
+ Calidris_alpina 41.0 45.1 10.7 3.90
+ Calidris_bairdii 39.3 39.7 9.6 4.00
+ Calidris_canutus 126.0 148.0 19.3 3.70
+ Calidris_maritima 67.6 76.3 13.3 3.90
+ Calidris_mauri 28.0 31.0 7.5 3.90
+ Calidris_minuta 24.0 27.1 6.3 3.80
+ Calidris_minutilla 20.3 22.2 6.4 3.90
+ Calidris_ptilocnemis 76.3 83.0 14.2 4.00
+ Calidris_pusilla 25.0 27.0 6.9 4.00
+ Calidris_ruficollis 25.7 26.6 8.3 4.00
+ Calidris_subminuta 29.0 32.0 7.5 4.00
+ Calidris_temminckii 24.3 27.8 5.8 4.00
+ Calidris_tenuirostris 156.0 174.0 22.0 4.00
+ Catoptrophorus_semipalmatus 273.0 301.4 39.5 4.00
+ Charadrius_dubius 38.3 39.2 7.7 3.90
+ Charadrius_hiaticula 63.5 64.7 10.9 3.80
+ Charadrius_melodus 54.9 55.6 9.4 3.30
+ Charadrius_montanus 102.0 114.0 16.5 3.00
+ Charadrius_vociferus 92.1 101.0 14.5 4.00
+ Charadrius_wilsonia 59.0 63.0 12.4 3.00
+ Coenocorypha_aucklandica 101.2 116.1 23.7 2.00
+ Coenocorypha_pusilla 75.9 85.4 16.1 2.10
+ Eudromias_morinellus 100.0 117.0 17.0 2.90
+ Eurynorhynchus_pygmeus 31.0 34.6 8.0 4.00
+ Gallinago_gallinago 111.0 128.0 16.5 3.90
+ Haematopus_finschi 517.0 554.0 44.2 2.33
+ Haematopus_fuliginosus 740.3 778.5 69.5 2.00
+ Haematopus_longirostris 602.3 626.3 49.0 2.50
+ Haematopus_moquini 668.0 730.0 55.8 1.70
+ Haematopus_ostralegus 500.0 536.0 46.7 2.80
+ Haematopus_unicolor 717.0 734.0 48.2 2.40
+ Jacana_jacana 108.3 142.8 9.7 3.50
+ Jacana_spinosa 86.9 145.4 8.3 4.00
+ Limnodromus_griseus 111.0 116.0 17.5 4.10
+ Limosa_fedoa 320.0 421.0 44.5 4.10
+ Limosa_haemastica 222.0 289.0 37.5 4.00
+ Limosa_lapponica 313.0 354.0 37.0 3.72
+ Limosa_limosa 264.0 315.0 39.0 3.90
+ Metopidius_indicus 176.2 282.4 11.9 4.00
+ Micropalama_himantopus 55.8 60.4 11.2 3.90
+ Numenius_americanus 640.1 758.6 73.0 4.00
+ Numenius_arquata 662.0 788.0 76.0 3.90
+ Numenius_phaeopus 368.0 398.0 50.0 3.90
+ Numenius_tahitiensis 378.0 489.0 54.8 4.00
+ Pedionomus_torquatus 54.0 72.4 10.0 3.60
+ Phalaropus_fulicaria 50.8 61.0 7.5 3.80
+ Phalaropus_lobatus 32.4 37.4 6.3 4.00
+ Pluvialis_apricaria 175.0 176.0 32.8 3.90
+ Pluvialis_dominica 145.0 146.0 26.0 4.00
+ Recurvirostra_avosetta 258.0 288.0 31.7 3.90
+ Rostratula_benghalensis 146.0 159.0 12.4 4.00
+ Steganopus_tricolor 50.2 68.1 9.4 4.00
+ Tringa_erythropus 142.0 161.0 24.5 4.00
+ Tringa_flavipes 80.0 83.7 17.4 4.00
+ Tringa_glareola 62.0 73.0 13.5 4.00
+ Tringa_hypoleucos 45.5 50.0 12.5 3.90
+ Tringa_macularia 36.9 48.0 9.0 4.00
+ Tringa_melanoleuca 164.0 176.0 27.9 3.70
+ Tringa_nebularia 172.0 175.0 30.5 3.90
+ Tringa_ochropus 75.0 85.0 15.5 3.90
+ Tringa_stagnatilis 67.1 76.0 14.0 4.00
+ Tringa_totanus 123.0 135.0 22.3 4.00
+ Vanellus_armatus 162.0 167.0 16.5 3.10
+ Vanellus_lugubris 109.5 113.0 13.7 3.00
+ Vanellus_vanellus 211.0 226.0 25.5 3.90
+ ;
+END;
+
+BEGIN CHARACTERS;
+ TITLE MatingSystem;
+ DIMENSIONS NCHAR=1;
+ FORMAT DATATYPE = STANDARD SYMBOLS="0 1 2";
+ CHARSTATELABELS
+ 1 matingSystem / Monogamous Polygynous Polyandrous;
+ MATRIX
+ Actophilornis_africanus 2
+ Aphriza_virgata 0
+ Arenaria_interpres 0
+ Arenaria_melanocephala 0
+ Bartramia_longicauda 0
+ Calidris_alba 2
+ Calidris_alpina 0
+ Calidris_bairdii 0
+ Calidris_canutus 0
+ Calidris_maritima 0
+ Calidris_mauri 0
+ Calidris_minuta 2
+ Calidris_minutilla 0
+ Calidris_ptilocnemis 0
+ Calidris_pusilla 0
+ Calidris_ruficollis 0
+ Calidris_subminuta 0
+ Calidris_temminckii 2
+ Calidris_tenuirostris 0
+ Catoptrophorus_semipalmatus 0
+ Charadrius_dubius 0
+ Charadrius_hiaticula 0
+ Charadrius_melodus 0
+ Charadrius_montanus 2
+ Charadrius_vociferus 0
+ Charadrius_wilsonia 0
+ Coenocorypha_aucklandica 1
+ Coenocorypha_pusilla 0
+ Eudromias_morinellus 2
+ Eurynorhynchus_pygmeus 0
+ Gallinago_gallinago 0
+ Haematopus_finschi 0
+ Haematopus_fuliginosus 0
+ Haematopus_longirostris 0
+ Haematopus_moquini 0
+ Haematopus_ostralegus 0
+ Haematopus_unicolor 0
+ Jacana_jacana 2
+ Jacana_spinosa 2
+ Limnodromus_griseus 0
+ Limosa_fedoa 0
+ Limosa_haemastica 0
+ Limosa_lapponica 0
+ Limosa_limosa 0
+ Metopidius_indicus 2
+ Micropalama_himantopus 0
+ Numenius_americanus 0
+ Numenius_arquata 0
+ Numenius_phaeopus 0
+ Numenius_tahitiensis 0
+ Pedionomus_torquatus 2
+ Phalaropus_fulicaria 2
+ Phalaropus_lobatus 2
+ Pluvialis_apricaria 0
+ Pluvialis_dominica 0
+ Recurvirostra_avosetta 0
+ Rostratula_benghalensis 2
+ Steganopus_tricolor 2
+ Tringa_erythropus 0
+ Tringa_flavipes 0
+ Tringa_glareola 0
+ Tringa_hypoleucos 0
+ Tringa_macularia 2
+ Tringa_melanoleuca 0
+ Tringa_nebularia 0
+ Tringa_ochropus 0
+ Tringa_stagnatilis 0
+ Tringa_totanus 0
+ Vanellus_armatus 0
+ Vanellus_lugubris 0
+ Vanellus_vanellus 1
+ ;
+END;
+
+
+BEGIN TREES;
+ TRANSLATE
+ 1 Catoptrophorus_semipalmatus,
+ 2 Tringa_ochropus,
+ 3 Tringa_stagnatilis,
+ 4 Tringa_flavipes,
+ 5 Tringa_nebularia,
+ 6 Tringa_totanus,
+ 7 Tringa_erythropus,
+ 8 Tringa_melanoleuca,
+ 9 Tringa_glareola,
+ 10 Steganopus_tricolor,
+ 11 Phalaropus_lobatus,
+ 12 Phalaropus_fulicaria,
+ 13 Micropalama_himantopus,
+ 14 Eurynorhynchus_pygmeus,
+ 15 Aphriza_virgata,
+ 16 Calidris_canutus,
+ 17 Calidris_tenuirostris,
+ 18 Calidris_temminckii,
+ 19 Calidris_maritima,
+ 20 Calidris_ptilocnemis,
+ 21 Calidris_mauri,
+ 22 Calidris_alba,
+ 23 Calidris_alpina,
+ 24 Calidris_bairdii,
+ 25 Calidris_minutilla,
+ 26 Calidris_pusilla,
+ 27 Calidris_minuta,
+ 28 Calidris_ruficollis,
+ 29 Calidris_subminuta,
+ 30 Arenaria_interpres,
+ 31 Arenaria_melanocephala,
+ 32 Tringa_hypoleucos,
+ 33 Tringa_macularia,
+ 34 Limnodromus_griseus,
+ 35 Gallinago_gallinago,
+ 36 Coenocorypha_aucklandica,
+ 37 Coenocorypha_pusilla,
+ 38 Limosa_fedoa,
+ 39 Limosa_haemastica,
+ 40 Limosa_limosa,
+ 41 Limosa_lapponica,
+ 42 Bartramia_longicauda,
+ 43 Numenius_tahitiensis,
+ 44 Numenius_phaeopus,
+ 45 Numenius_arquata,
+ 46 Numenius_americanus,
+ 47 Rostratula_benghalensis,
+ 48 Jacana_spinosa,
+ 49 Jacana_jacana,
+ 50 Metopidius_indicus,
+ 51 Actophilornis_africanus,
+ 52 Pedionomus_torquatus,
+ 53 Pluvialis_apricaria,
+ 54 Pluvialis_dominica,
+ 55 Eudromias_morinellus,
+ 56 Charadrius_montanus,
+ 57 Charadrius_vociferus,
+ 58 Charadrius_wilsonia,
+ 59 Charadrius_dubius,
+ 60 Charadrius_hiaticula,
+ 61 Charadrius_melodus,
+ 62 Vanellus_vanellus,
+ 63 Vanellus_lugubris,
+ 64 Vanellus_armatus,
+ 65 Recurvirostra_avosetta,
+ 66 Haematopus_longirostris,
+ 67 Haematopus_fuliginosus,
+ 68 Haematopus_moquini,
+ 69 Haematopus_ostralegus,
+ 70 Haematopus_unicolor,
+ 71 Haematopus_finschi
+ ;
+ TREE * UNTITLED = [&R] ((((((((1:19.701,(2:19.086,((3:13.762,4:13.762,5:13.762,6:13.762,(7:5.324,8:5.324):8.438):3.114,9:16.876):2.21):0.615):2.499,(10:3.42,(11:2.158,12:2.158):1.262):18.78):9.9,((13:17.413,14:17.413,(15:6.019,(16:3.798,17:3.798):2.221):11.394,(18:10.013,((19:2.588,20:2.588):6.989,(21:9.142,(22:8.707,((23:7.836,(24:7.4,(25:6.965,(26:3.483,27:3.483):3.482):0.435):0.436):0.435,(28:2.609,29:2.609):5.662):0.436):0.435):0.435):0.436):7.4):9.287,(30:5.68,31:5.68):21.02):5.4,( [...]
+END;
diff --git a/inst/nexusfiles/testSubsetTaxa.nex b/inst/nexusfiles/testSubsetTaxa.nex
new file mode 100644
index 0000000..2b1b9f0
--- /dev/null
+++ b/inst/nexusfiles/testSubsetTaxa.nex
@@ -0,0 +1,26 @@
+#NEXUS
+
+BEGIN TAXA;
+ DIMENSIONS NTAX=6;
+ TAXLABELS
+ cnidaria
+ porifera
+ ctenophora
+ protostomia
+ deuterostomia
+ xeno
+ ;
+END;
+
+BEGIN TREES;
+ TRANSLATE
+ 1 deuterostomia,
+ 2 protostomia,
+ 3 porifera,
+ 4 ctenophora,
+ 5 cnidaria,
+ 6 xeno;
+ TREE hyp1 = (3,((4,5),(1,2)));
+ TREE hyp2 = (3,(4,(6,(1,2))));
+ TREE hyp3 = (1,(2,(3,(4,(5,6)))));
+END;
diff --git a/inst/nexusfiles/test_min.nex b/inst/nexusfiles/test_min.nex
new file mode 100644
index 0000000..9b7d329
--- /dev/null
+++ b/inst/nexusfiles/test_min.nex
@@ -0,0 +1,20 @@
+#NEXUS
+
+BEGIN TAXA;
+ DIMENSIONS NTAX=4;
+ TAXLABELS
+ cnidaria
+ porifera
+ ctenophora
+ protostomia
+ ;
+END;
+
+BEGIN TREES;
+ TRANSLATE
+ 1 cnidaria,
+ 2 protostomia,
+ 3 porifera,
+ 4 ctenophora;
+ TREE hyp1 = ((1:5,2:5):3,(3:6,4:6):3);
+END;
diff --git a/inst/nexusfiles/treeRoundingError.nex b/inst/nexusfiles/treeRoundingError.nex
new file mode 100644
index 0000000..7045ed4
--- /dev/null
+++ b/inst/nexusfiles/treeRoundingError.nex
@@ -0,0 +1,35 @@
+#NEXUS
+
+BEGIN TAXA;
+ DIMENSIONS NTAX=4;
+ TAXLABELS
+ spA spB spC spD
+ ;
+
+END;
+
+
+BEGIN CHARACTERS;
+ TITLE 'Morphology';
+ DIMENSIONS NCHAR=1;
+ FORMAT DATATYPE = CONTINUOUS;
+CHARSTATELABELS
+ 1 testTest;
+MATRIX
+ spA 0.6263965
+ spB 0.7741235
+ spC 1.0180075
+ spD 1.0856245
+;
+
+END;
+
+BEGIN TREES;
+ TRANSLATE
+ 1 spA,
+ 2 spB,
+ 3 spC,
+ 4 spD;
+ TREE testTree = (1,(2,(3,4)));
+END;
+
diff --git a/inst/nexusfiles/treeWithContinuousData.nex b/inst/nexusfiles/treeWithContinuousData.nex
new file mode 100644
index 0000000..181044e
--- /dev/null
+++ b/inst/nexusfiles/treeWithContinuousData.nex
@@ -0,0 +1,365 @@
+#NEXUS
+[written Tue May 29 18:24:39 PDT 2007 by Mesquite version 1.06 (build g97) at cnidaria-1347.ucdavis.edu/169.237.66.185]
+
+BEGIN TAXA;
+ DIMENSIONS NTAX=18;
+ TAXLABELS
+ Myrmecocystuscfnavajo Myrmecocystuscreightoni Myrmecocystusdepilis Myrmecocystuskathjuli Myrmecocystuskennedyi Myrmecocystusmendax Myrmecocystusmexicanus Myrmecocystusmimicus Myrmecocystusnavajo Myrmecocystusnequazcatl Myrmecocystusplacodops Myrmecocystusromainei Myrmecocystussemirufus Myrmecocystussnellingi Myrmecocystustenuinodis Myrmecocystustestaceus Myrmecocystuswheeleri Myrmecocystusyuma
+ ;
+
+END;
+
+
+BEGIN CHARACTERS;
+ TITLE 'Morphology';
+ DIMENSIONS NCHAR=32;
+ FORMAT DATATYPE = CONTINUOUS;
+CHARSTATELABELS
+ 1 eyewidth,
+ 2 eyelength,
+ 3 headlength,
+ 4 headwidth,
+ 5 mesosomaprofilehaircount,
+ 6 FLfemurlength,
+ 7 FLtibialength,
+ 8 MLfemurlength,
+ 9 MLtibialength,
+ 10 HLfemurlength,
+ 11 HLtibialength,
+ 12 mesosomalength,
+ 13 scapelength,
+ 14 funiculuslength,
+ 15 mesosomamaxwidth,
+ 16 mesosomaminwidth,
+ 17 lneyewidth,
+ 18 lneyelength,
+ 19 lnheadlength,
+ 20 lnheadwidth,
+ 21 lnmesosomaprofilehaircount,
+ 22 lnFLfemurlength,
+ 23 lnFLtibialength,
+ 24 lnMLfemurlength,
+ 25 lnMLtibialength,
+ 26 lnHLfemurlength,
+ 27 lnHLtibialength,
+ 28 lnmesosomalength,
+ 29 lnscapelength,
+ 30 lnfuniculuslength,
+ 31 lnmesosomamaxwidth,
+ 32 lnmesosomaminwidth ;
+ MATRIX
+ Myrmecocystuscfnavajo 0.347 0.433 1.338 1.052 39.0 1.434 1.246 1.515 1.409 2.007 2.126 1.962 1.63 2.464 0.836 0.417 -1.058430499 -0.837017551 0.291175962 0.050693114 3.663561646 0.360467742 0.21993842 0.415415439 0.342880233 0.69664107 0.75424228 0.673964361 0.488580015 0.901786046 -0.179126666 -0.874669057
+ Myrmecocystuscreightoni 0.1622 0.20655 0.82985 0.71865 0.0 0.8226 0.68895 0.7854 0.7704 1.0457 1.05835 1.11875 0.89955 1.4073 0.4955 0.28995 -1.819995314 -1.577954034 -0.187439126 -0.332990376 1.098612289 -0.198226599 -0.374805986 -0.242539085 -0.261554411 0.041684897 0.053820826 0.109048315 -0.106449058 0.340231802 -0.70254289 -1.243482504
+ Myrmecocystusdepilis 0.2345 0.279 1.2125 1.0218 24.0 1.25183 1.0856245 1.31244 1.278025 1.70082 1.77591 1.774585 1.335 2.049 0.7741235 0.438396 -1.453769132 -1.2784033 0.185730051 0.015758636 3.163968392 0.217906079 0.073480925 0.262244849 0.23828925 0.523667061 0.565922636 0.566419189 0.284385731 0.712661014 -0.266387722 -0.827757638
+ Myrmecocystuskathjuli 0.206 0.247 1.1235 0.951 19.5 1.35352 1.101125 1.39927 1.29104 1.708335 1.794895 1.70561 1.379 2.04 0.7319725 0.4122135 -1.579985164 -1.398768684 0.115861323 -0.05067484 2.890371758 0.299777539 0.092762585 0.334283576 0.252849066 0.529578184 0.581198779 0.53251657 0.319877422 0.710946449 -0.315164554 -0.88802496
+ Myrmecocystuskennedyi 0.219 0.277 1.2115 1.075 27.5 1.405 1.176 1.4625 1.456 1.8545 1.9205 1.8345 1.4375 2.1 0.7655 0.455 -1.518693975 -1.283737773 0.191857133 0.072285615 3.314020688 0.339154824 0.16141842 0.379143386 0.373863136 0.615804395 0.650805137 0.606659596 0.362132481 0.741737305 -0.267251876 -0.788424862
+ Myrmecocystusmendax 0.2721 0.3336 1.558 1.4531 85.0 1.8742 1.6042 1.994 1.935 2.6013 2.6829 2.5963 1.9381 2.9722 1.0311 0.5232 -1.301585633 -1.097812608 0.443402947 0.373699205 4.442651256 0.628181902 0.47262519 0.690142672 0.660107326 0.95601132 0.986898299 0.954087355 0.661708112 1.089302419 0.030626194 -0.647791479
+ Myrmecocystusmexicanus 0.4335 0.5285 1.602 1.2705 26.5 2.242 1.8555 2.4795 2.2075 3.0705 3.089 2.597 2.211 3.239 0.916 0.394 -0.837335004 -0.642862653 0.466427394 0.227429133 3.275540168 0.796749683 0.612629812 0.902886082 0.785535617 1.116397202 1.124535193 0.952838633 0.792756695 1.172973609 -0.096394475 -0.93952217
+ Myrmecocystusmimicus 0.2197 0.2733 1.141 1.036 30.0 1.23793 1.027 1.26786 1.1749 1.56482 1.63226 1.67201 1.264 1.881 0.708 0.384 -1.5154923 -1.297185186 0.131905071 0.035367144 3.401197382 0.21344063 0.026641931 0.23733044 0.161183038 0.447770801 0.489965558 0.514026496 0.234281296 0.63180355 -0.345311185 -0.957112726
+ Myrmecocystusnavajo 0.2805 0.3755 1.0525 0.795 18.5 1.168535 1.0180075 1.16102 1.12958 1.634705 1.65155 1.546225 1.3485 1.954 0.6263965 0.314671 -1.272519447 -0.980051192 0.050015872 -0.230223916 2.90855558 0.153682711 0.016748671 0.148877742 0.121090106 0.491448376 0.501633856 0.434955774 0.298626416 0.669236464 -0.468766381 -1.171358882
+ Myrmecocystusnequazcatl 0.238 0.295 1.058 1.118 49.0 1.51118 1.1793 1.60672 1.41636 1.95228 1.96042 2.01975 1.477 2.228 0.84806 0.486044 -1.435484605 -1.220779923 0.056380333 0.111541375 3.891820298 0.412890803 0.164921042 0.474194834 0.3480902 0.66899792 0.673158736 0.702973741 0.390013004 0.801104322 -0.164803891 -0.721456124
+ Myrmecocystusplacodops 0.2805 0.347 1.5425 1.4355 39.5 1.6688 1.474045 1.838315 1.761365 2.349265 2.418685 2.28195 1.8045 2.7645 0.955494 0.484641 -1.271539142 -1.058496944 0.433360292 0.360682154 3.675579114 0.512103438 0.387068202 0.606349823 0.563245783 0.852964487 0.881290662 0.824898518 0.589936973 1.015395403 -0.047278511 -0.724537171
+ Myrmecocystusromainei 0.229 0.271 1.164 1.067 27.0 1.31488 1.06962 1.369 1.278 1.74 1.78517 1.72 1.346 2.081 0.797 0.421 -1.474033275 -1.305636458 0.151862349 0.064850972 3.295836866 0.273745407 0.067303445 0.314080546 0.245296356 0.553885113 0.579513649 0.542324291 0.297137231 0.732848547 -0.2269006 -0.865122445
+ Myrmecocystussemirufus 0.2393 0.295 1.3424 1.2826 69.0 1.548 1.3236 1.626 1.611 2.074 2.272 2.0392 1.572 2.3424 0.8935 0.4917 -1.430037284 -1.220779923 0.294459057 0.248889268 4.234106505 0.436963775 0.280355297 0.486123011 0.476855104 0.72947911 0.820660501 0.712557574 0.452348694 0.851176045 -0.112608944 -0.709886505
+ Myrmecocystussnellingi 0.1626 0.2052 0.786 0.69185 17.0 0.7471 0.5778 0.71195 0.68865 0.95225 0.93645 1.02635 0.83555 1.3684 0.47505 0.2805 -1.819869438 -1.586743338 -0.244666624 -0.374320538 2.83148024 -0.296208766 -0.554168612 -0.349125994 -0.38004857 -0.051854551 -0.071457181 0.020580617 -0.182376816 0.309479365 -0.750825896 -1.272022688
+ Myrmecocystustenuinodis 0.16695 0.2165 0.80965 0.69565 15.5 0.82035 0.79215 0.82915 0.7881 1.02385 1.0765 1.0843 0.89445 1.37155 0.5079 0.2895 -1.794140731 -1.531128383 -0.212724354 -0.364765146 2.714672815 -0.201043311 -0.233005565 -0.188002646 -0.240303423 0.023136261 0.071803358 0.077801384 -0.1121299 0.313462769 -0.679348936 -1.244818912
+ Myrmecocystustestaceus 0.271 0.3475 1.0435 0.8825 23.5 1.11074 0.981997 1.145875 1.10783 1.527625 1.55838 1.505275 1.329 2.018 0.6360145 0.288181 -1.305643267 -1.057223576 0.041499168 -0.125900131 3.14578457 0.102786566 -0.021927567 0.135585284 0.099368885 0.423310977 0.441300868 0.408161226 0.283878423 0.701812041 -0.453369253 -1.244254341
+ Myrmecocystuswheeleri 0.197 0.259 1.153 0.981 32.0 1.34961 1.11238 1.43273 1.26582 1.62673 1.75947 1.77914 1.427 2.058 0.732 0.394545 -1.62455155 -1.350927217 0.142367241 -0.019182819 3.465735903 0.299815662 0.106501864 0.359581715 0.235720134 0.486571865 0.565012627 0.576130101 0.355574338 0.721734637 -0.311974765 -0.930022077
+ Myrmecocystusyuma 0.189 0.237 0.864 0.809 10.0 0.867184 0.783 0.878905 0.757646 1.0528 1.15593 1.14947 0.932 1.437 0.549142 0.319 -1.666008264 -1.439695138 -0.14618251 -0.211956362 2.302585093 -0.142504099 -0.244622583 -0.129078464 -0.277539021 0.051453282 0.144905215 0.139300967 -0.070422464 0.362557607 -0.599398219 -1.142564176
+
+;
+
+END;
+
+
+
+BEGIN TREES;
+ TRANSLATE
+ 1 Myrmecocystuscfnavajo,
+ 2 Myrmecocystuscreightoni,
+ 3 Myrmecocystusdepilis,
+ 4 Myrmecocystuskathjuli,
+ 5 Myrmecocystuskennedyi,
+ 6 Myrmecocystusmendax,
+ 7 Myrmecocystusmexicanus,
+ 8 Myrmecocystusmimicus,
+ 9 Myrmecocystusnavajo,
+ 10 Myrmecocystusnequazcatl,
+ 11 Myrmecocystusplacodops,
+ 12 Myrmecocystusromainei,
+ 13 Myrmecocystussemirufus,
+ 14 Myrmecocystussnellingi,
+ 15 Myrmecocystustenuinodis,
+ 16 Myrmecocystustestaceus,
+ 17 Myrmecocystuswheeleri,
+ 18 Myrmecocystusyuma;
+ TREE bestML = (((((((((13:1.724765,11:1.724765):2.926053,6:4.650818):0.689044,(4:1.08387,17:1.08387):4.255993):0.198842,((8:2.708942,3:2.708942):2.027251,((12:2.193845,10:2.193845):2.257581,18:4.451425):0.284767):0.802512):0.506099,5:6.044804):4.524387,2:10.569191):0.836689,(14:2.770378,15:2.770378):8.635503):0.89482,16:12.300701):1.699299,(7:5.724923,(1:2.869547,9:2.869547):2.855375):8.275077);
+
+END;
+
+BEGIN ASSUMPTIONS;
+ TYPESET * UNTITLED (CHARACTERS = 'Morphology') = Squared: 1 - 32;
+END;
+
+
+
+Begin MESQUITE;
+ MESQUITESCRIPTVERSION 2;
+ TITLE AUTO;
+ tell ProjectCoordinator;
+ getEmployee #mesquite.minimal.ManageTaxa.ManageTaxa;
+ tell It;
+ setID 0 9015005506118934442;
+ endTell;
+ getEmployee #mesquite.charMatrices.ManageCharacters.ManageCharacters;
+ tell It;
+ setID 0 2565950173085067248;
+ checksum 0 389122022;
+ setID 1 1161953040649633474;
+ checksum 1 3582198254;
+ endTell;
+ getEmployee #mesquite.charMatrices.BasicDataWindowCoord.BasicDataWindowCoord;
+ tell It;
+ showDataWindow #2565950173085067248 #mesquite.charMatrices.BasicDataWindowMaker.BasicDataWindowMaker;
+ tell It;
+ getWindow;
+ tell It;
+ setSize 420 280;
+ setLocation 400 156;
+ setFont SanSerif;
+ setFontSize 10;
+ onInfoBar;
+ setExplanationSize 30;
+ setAnnotationSize 20;
+ setFontIncAnnot 0;
+ setFontIncExp 0;
+ getToolPalette;
+ tell It;
+ endTell;
+ setTool mesquite.charMatrices.BasicDataWindowMaker.BasicDataWindow.arrow;
+ colorCells #mesquite.charMatrices.NoColor.NoColor;
+ setBackground White;
+ toggleShowNames on;
+ toggleTight off;
+ toggleShowChanges on;
+ toggleSeparateLines off;
+ toggleShowStates on;
+ toggleAutoWithCharNames on;
+ toggleShowDefaultCharNames off;
+ toggleConstrainCW on;
+ toggleBirdsEye off;
+ toggleColorsPanel off;
+ birdsEyeWidth 2;
+ toggleLinkedScrolling on;
+ toggleScrollLinkedTables off;
+ endTell;
+ showWindow;
+ getWindow;
+ tell It;
+ forceAutosize;
+ endTell;
+ getEmployee #mesquite.charMatrices.AnnotPanel.AnnotPanel;
+ tell It;
+ togglePanel off;
+ endTell;
+ getEmployee #mesquite.charMatrices.ColorCells.ColorCells;
+ tell It;
+ setColor Red;
+ removeColor off;
+ endTell;
+ endTell;
+ showDataWindow #1161953040649633474 #mesquite.charMatrices.BasicDataWindowMaker.BasicDataWindowMaker;
+ tell It;
+ getWindow;
+ tell It;
+ getTable;
+ tell It;
+ rowNamesWidth 232;
+ endTell;
+ setSize 798 748;
+ setLocation 348 22;
+ setFont SanSerif;
+ setFontSize 10;
+ onInfoBar;
+ setExplanationSize 30;
+ setAnnotationSize 20;
+ setFontIncAnnot 0;
+ setFontIncExp 0;
+ getToolPalette;
+ tell It;
+ setTool mesquite.charMatrices.BasicDataWindowMaker.BasicDataWindow.ibeam;
+ endTell;
+ setTool mesquite.charMatrices.BasicDataWindowMaker.BasicDataWindow.ibeam;
+ colorCells #mesquite.charMatrices.NoColor.NoColor;
+ setBackground White;
+ toggleShowNames on;
+ toggleTight off;
+ toggleShowChanges on;
+ toggleSeparateLines off;
+ toggleShowStates on;
+ toggleAutoWithCharNames on;
+ toggleShowDefaultCharNames off;
+ toggleConstrainCW on;
+ toggleBirdsEye off;
+ toggleColorsPanel off;
+ birdsEyeWidth 2;
+ toggleLinkedScrolling on;
+ toggleScrollLinkedTables off;
+ endTell;
+ showWindow;
+ getWindow;
+ tell It;
+ forceAutosize;
+ endTell;
+ getEmployee #mesquite.categ.StateNamesEditor.StateNamesEditor;
+ tell It;
+ makeWindow;
+ tell It;
+ setSize 314 400;
+ setLocation 60 10;
+ setFont SanSerif;
+ setFontSize 10;
+ onInfoBar;
+ setExplanationSize 30;
+ setAnnotationSize 20;
+ setFontIncAnnot 0;
+ setFontIncExp 0;
+ getToolPalette;
+ tell It;
+ setTool mesquite.categ.StateNamesEditor.StateNamesWindow.ibeam;
+ endTell;
+ rowsAreCharacters on;
+ toggleConstrainChar on;
+ toggleConstrainCharNum 3;
+ togglePanel off;
+ endTell;
+ showWindow;
+ endTell;
+ getEmployee #mesquite.categ.StateNamesStrip.StateNamesStrip;
+ tell It;
+ showStrip off;
+ endTell;
+ getEmployee #mesquite.charMatrices.AnnotPanel.AnnotPanel;
+ tell It;
+ togglePanel off;
+ endTell;
+ getEmployee #mesquite.charMatrices.ColorCells.ColorCells;
+ tell It;
+ setColor Red;
+ removeColor off;
+ endTell;
+ getEmployee #mesquite.charMatrices.QuickKeySelector.QuickKeySelector;
+ tell It;
+ autotabOff;
+ endTell;
+ endTell;
+ endTell;
+ getEmployee #mesquite.trees.BasicTreeWindowCoord.BasicTreeWindowCoord;
+ tell It;
+ makeTreeWindow #9015005506118934442 #mesquite.trees.BasicTreeWindowMaker.BasicTreeWindowMaker;
+ tell It;
+ setTreeSource #mesquite.trees.StoredTrees.StoredTrees;
+ tell It;
+ setTreeBlock 1;
+ toggleUseWeights off;
+ endTell;
+ setAssignedID 630.1180487973731.4514395117633566598;
+ getTreeWindow;
+ tell It;
+ setSize 520 400;
+ setLocation 60 10;
+ setFont SanSerif;
+ setFontSize 10;
+ onInfoBar;
+ setExplanationSize 30;
+ setAnnotationSize 20;
+ setFontIncAnnot 0;
+ setFontIncExp 0;
+ getToolPalette;
+ tell It;
+ endTell;
+ setActive;
+ getTreeDrawCoordinator #mesquite.trees.BasicTreeDrawCoordinator.BasicTreeDrawCoordinator;
+ tell It;
+ suppress;
+ setTreeDrawer #mesquite.trees.DiagonalDrawTree.DiagonalDrawTree;
+ tell It;
+ setEdgeWidth 12;
+ orientUp;
+ getEmployee #mesquite.trees.NodeLocsStandard.NodeLocsStandard;
+ tell It;
+ stretchToggle off;
+ branchLengthsToggle off;
+ toggleScale on;
+ toggleCenter off;
+ toggleEven off;
+ namesAngle ?;
+ endTell;
+ endTell;
+ setBackground White;
+ setBranchColor Black;
+ showNodeNumbers off;
+ labelBranchLengths off;
+ desuppress;
+ getEmployee #mesquite.trees.BasicDrawTaxonNames.BasicDrawTaxonNames;
+ tell It;
+ setColor Black;
+ toggleColorPartition on;
+ toggleShadePartition off;
+ toggleNodeLabels on;
+ toggleShowNames on;
+ endTell;
+ endTell;
+ setTreeNumber 1;
+ useSuggestedSize on;
+ toggleTextOnTree off;
+ newAssistant #mesquite.ancstates.TraceCharacterHistory.TraceCharacterHistory;
+ tell It;
+ suspend ;
+ setDisplayMode #mesquite.ancstates.ShadeStatesOnTree.ShadeStatesOnTree;
+ tell It;
+ toggleLabels off;
+ endTell;
+ setHistorySource #mesquite.ancstates.RecAncestralStates.RecAncestralStates;
+ tell It;
+ getCharacterSource #mesquite.charMatrices.CharSrcCoordObed.CharSrcCoordObed;
+ tell It;
+ setCharacterSource #mesquite.charMatrices.StoredCharacters.StoredCharacters;
+ tell It;
+ setDataSet #1161953040649633474;
+ endTell;
+ endTell;
+ setMethod #mesquite.parsimony.ParsAncestralStates.ParsAncestralStates;
+ tell It;
+ setModelSource #mesquite.parsimony.CurrentParsModels.CurrentParsModels;
+ endTell;
+ endTell;
+ setCharacter 1;
+ toggleShowLegend on;
+ toggleGray off;
+ toggleWeights on;
+ setInitialOffsetX -162;
+ setInitialOffsetY -177;
+ setLegendWidth 142;
+ setLegendHeight 177;
+ resume ;
+ endTell;
+ endTell;
+ showWindow;
+ getEmployee #mesquite.ornamental.BranchNotes.BranchNotes;
+ tell It;
+ setAlwaysOn off;
+ endTell;
+ getEmployee #mesquite.trees.ColorBranches.ColorBranches;
+ tell It;
+ setColor Red;
+ removeColor off;
+ endTell;
+ endTell;
+ endTell;
+ endTell;
+end;
+
+begin brownie;
+taxset all=1-18;
+end;
diff --git a/inst/nexusfiles/treeWithDiscAndContData.nex b/inst/nexusfiles/treeWithDiscAndContData.nex
new file mode 100644
index 0000000..c21d680
--- /dev/null
+++ b/inst/nexusfiles/treeWithDiscAndContData.nex
@@ -0,0 +1,413 @@
+#NEXUS
+[written Tue May 29 18:24:39 PDT 2007 by Mesquite version 1.06 (build g97) at cnidaria-1347.ucdavis.edu/169.237.66.185]
+
+BEGIN TAXA;
+ DIMENSIONS NTAX=18;
+ TAXLABELS
+ Myrmecocystuscfnavajo Myrmecocystuscreightoni Myrmecocystusdepilis Myrmecocystuskathjuli Myrmecocystuskennedyi Myrmecocystusmendax Myrmecocystusmexicanus Myrmecocystusmimicus Myrmecocystusnavajo Myrmecocystusnequazcatl Myrmecocystusplacodops Myrmecocystusromainei Myrmecocystussemirufus Myrmecocystussnellingi Myrmecocystustenuinodis Myrmecocystustestaceus Myrmecocystuswheeleri Myrmecocystusyuma
+ ;
+
+END;
+
+
+BEGIN CHARACTERS;
+ TITLE Morphology;
+ DIMENSIONS NCHAR=32;
+ FORMAT DATATYPE = CONTINUOUS;
+CHARSTATELABELS
+ 1 eyewidth,
+ 2 eyelength,
+ 3 headlength,
+ 4 headwidth,
+ 5 mesosomaprofilehaircount,
+ 6 FLfemurlength,
+ 7 FLtibialength,
+ 8 MLfemurlength,
+ 9 MLtibialength,
+ 10 HLfemurlength,
+ 11 HLtibialength,
+ 12 mesosomalength,
+ 13 scapelength,
+ 14 funiculuslength,
+ 15 mesosomamaxwidth,
+ 16 mesosomaminwidth,
+ 17 lneyewidth,
+ 18 lneyelength,
+ 19 lnheadlength,
+ 20 lnheadwidth,
+ 21 lnmesosomaprofilehaircount,
+ 22 lnFLfemurlength,
+ 23 lnFLtibialength,
+ 24 lnMLfemurlength,
+ 25 lnMLtibialength,
+ 26 lnHLfemurlength,
+ 27 lnHLtibialength,
+ 28 lnmesosomalength,
+ 29 lnscapelength,
+ 30 lnfuniculuslength,
+ 31 lnmesosomamaxwidth,
+ 32 lnmesosomaminwidth ;
+ MATRIX
+ Myrmecocystuscfnavajo 0.347 0.433 1.338 1.052 39.0 1.434 1.246 1.515 1.409 2.007 2.126 1.962 1.63 2.464 0.836 0.417 -1.058430499 -0.837017551 0.291175962 0.050693114 3.663561646 0.360467742 0.21993842 0.415415439 0.342880233 0.69664107 0.75424228 0.673964361 0.488580015 0.901786046 -0.179126666 -0.874669057
+ Myrmecocystuscreightoni 0.1622 0.20655 0.82985 0.71865 0.0 0.8226 0.68895 0.7854 0.7704 1.0457 1.05835 1.11875 0.89955 1.4073 0.4955 0.28995 -1.819995314 -1.577954034 -0.187439126 -0.332990376 1.098612289 -0.198226599 -0.374805986 -0.242539085 -0.261554411 0.041684897 0.053820826 0.109048315 -0.106449058 0.340231802 -0.70254289 -1.243482504
+ Myrmecocystusdepilis 0.2345 0.279 1.2125 1.0218 24.0 1.25183 1.0856245 1.31244 1.278025 1.70082 1.77591 1.774585 1.335 2.049 0.7741235 0.438396 -1.453769132 -1.2784033 0.185730051 0.015758636 3.163968392 0.217906079 0.073480925 0.262244849 0.23828925 0.523667061 0.565922636 0.566419189 0.284385731 0.712661014 -0.266387722 -0.827757638
+ Myrmecocystuskathjuli 0.206 0.247 1.1235 0.951 19.5 1.35352 1.101125 1.39927 1.29104 1.708335 1.794895 1.70561 1.379 2.04 0.7319725 0.4122135 -1.579985164 -1.398768684 0.115861323 -0.05067484 2.890371758 0.299777539 0.092762585 0.334283576 0.252849066 0.529578184 0.581198779 0.53251657 0.319877422 0.710946449 -0.315164554 -0.88802496
+ Myrmecocystuskennedyi 0.219 0.277 1.2115 1.075 27.5 1.405 1.176 1.4625 1.456 1.8545 1.9205 1.8345 1.4375 2.1 0.7655 0.455 -1.518693975 -1.283737773 0.191857133 0.072285615 3.314020688 0.339154824 0.16141842 0.379143386 0.373863136 0.615804395 0.650805137 0.606659596 0.362132481 0.741737305 -0.267251876 -0.788424862
+ Myrmecocystusmendax 0.2721 0.3336 1.558 1.4531 85.0 1.8742 1.6042 1.994 1.935 2.6013 2.6829 2.5963 1.9381 2.9722 1.0311 0.5232 -1.301585633 -1.097812608 0.443402947 0.373699205 4.442651256 0.628181902 0.47262519 0.690142672 0.660107326 0.95601132 0.986898299 0.954087355 0.661708112 1.089302419 0.030626194 -0.647791479
+ Myrmecocystusmexicanus 0.4335 0.5285 1.602 1.2705 26.5 2.242 1.8555 2.4795 2.2075 3.0705 3.089 2.597 2.211 3.239 0.916 0.394 -0.837335004 -0.642862653 0.466427394 0.227429133 3.275540168 0.796749683 0.612629812 0.902886082 0.785535617 1.116397202 1.124535193 0.952838633 0.792756695 1.172973609 -0.096394475 -0.93952217
+ Myrmecocystusmimicus 0.2197 0.2733 1.141 1.036 30.0 1.23793 1.027 1.26786 1.1749 1.56482 1.63226 1.67201 1.264 1.881 0.708 0.384 -1.5154923 -1.297185186 0.131905071 0.035367144 3.401197382 0.21344063 0.026641931 0.23733044 0.161183038 0.447770801 0.489965558 0.514026496 0.234281296 0.63180355 -0.345311185 -0.957112726
+ Myrmecocystusnavajo 0.2805 0.3755 1.0525 0.795 18.5 1.168535 1.0180075 1.16102 1.12958 1.634705 1.65155 1.546225 1.3485 1.954 0.6263965 0.314671 -1.272519447 -0.980051192 0.050015872 -0.230223916 2.90855558 0.153682711 0.016748671 0.148877742 0.121090106 0.491448376 0.501633856 0.434955774 0.298626416 0.669236464 -0.468766381 -1.171358882
+ Myrmecocystusnequazcatl 0.238 0.295 1.058 1.118 49.0 1.51118 1.1793 1.60672 1.41636 1.95228 1.96042 2.01975 1.477 2.228 0.84806 0.486044 -1.435484605 -1.220779923 0.056380333 0.111541375 3.891820298 0.412890803 0.164921042 0.474194834 0.3480902 0.66899792 0.673158736 0.702973741 0.390013004 0.801104322 -0.164803891 -0.721456124
+ Myrmecocystusplacodops 0.2805 0.347 1.5425 1.4355 39.5 1.6688 1.474045 1.838315 1.761365 2.349265 2.418685 2.28195 1.8045 2.7645 0.955494 0.484641 -1.271539142 -1.058496944 0.433360292 0.360682154 3.675579114 0.512103438 0.387068202 0.606349823 0.563245783 0.852964487 0.881290662 0.824898518 0.589936973 1.015395403 -0.047278511 -0.724537171
+ Myrmecocystusromainei 0.229 0.271 1.164 1.067 27.0 1.31488 1.06962 1.369 1.278 1.74 1.78517 1.72 1.346 2.081 0.797 0.421 -1.474033275 -1.305636458 0.151862349 0.064850972 3.295836866 0.273745407 0.067303445 0.314080546 0.245296356 0.553885113 0.579513649 0.542324291 0.297137231 0.732848547 -0.2269006 -0.865122445
+ Myrmecocystussemirufus 0.2393 0.295 1.3424 1.2826 69.0 1.548 1.3236 1.626 1.611 2.074 2.272 2.0392 1.572 2.3424 0.8935 0.4917 -1.430037284 -1.220779923 0.294459057 0.248889268 4.234106505 0.436963775 0.280355297 0.486123011 0.476855104 0.72947911 0.820660501 0.712557574 0.452348694 0.851176045 -0.112608944 -0.709886505
+ Myrmecocystussnellingi 0.1626 0.2052 0.786 0.69185 17.0 0.7471 0.5778 0.71195 0.68865 0.95225 0.93645 1.02635 0.83555 1.3684 0.47505 0.2805 -1.819869438 -1.586743338 -0.244666624 -0.374320538 2.83148024 -0.296208766 -0.554168612 -0.349125994 -0.38004857 -0.051854551 -0.071457181 0.020580617 -0.182376816 0.309479365 -0.750825896 -1.272022688
+ Myrmecocystustenuinodis 0.16695 0.2165 0.80965 0.69565 15.5 0.82035 0.79215 0.82915 0.7881 1.02385 1.0765 1.0843 0.89445 1.37155 0.5079 0.2895 -1.794140731 -1.531128383 -0.212724354 -0.364765146 2.714672815 -0.201043311 -0.233005565 -0.188002646 -0.240303423 0.023136261 0.071803358 0.077801384 -0.1121299 0.313462769 -0.679348936 -1.244818912
+ Myrmecocystustestaceus 0.271 0.3475 1.0435 0.8825 23.5 1.11074 0.981997 1.145875 1.10783 1.527625 1.55838 1.505275 1.329 2.018 0.6360145 0.288181 -1.305643267 -1.057223576 0.041499168 -0.125900131 3.14578457 0.102786566 -0.021927567 0.135585284 0.099368885 0.423310977 0.441300868 0.408161226 0.283878423 0.701812041 -0.453369253 -1.244254341
+ Myrmecocystuswheeleri 0.197 0.259 1.153 0.981 32.0 1.34961 1.11238 1.43273 1.26582 1.62673 1.75947 1.77914 1.427 2.058 0.732 0.394545 -1.62455155 -1.350927217 0.142367241 -0.019182819 3.465735903 0.299815662 0.106501864 0.359581715 0.235720134 0.486571865 0.565012627 0.576130101 0.355574338 0.721734637 -0.311974765 -0.930022077
+ Myrmecocystusyuma 0.189 0.237 0.864 0.809 10.0 0.867184 0.783 0.878905 0.757646 1.0528 1.15593 1.14947 0.932 1.437 0.549142 0.319 -1.666008264 -1.439695138 -0.14618251 -0.211956362 2.302585093 -0.142504099 -0.244622583 -0.129078464 -0.277539021 0.051453282 0.144905215 0.139300967 -0.070422464 0.362557607 -0.599398219 -1.142564176
+
+;
+
+END;
+
+
+BEGIN CHARACTERS;
+ TITLE Foraging;
+ DIMENSIONS NCHAR=2;
+ FORMAT DATATYPE = STANDARD GAP = - MISSING = ? SYMBOLS = " 0 1 2";
+ CHARSTATELABELS
+ 1 time / diurnal crepuscular nocturnal, 2 subgenus / Endiodioctes Eremnocystus Myrmecocystus ;
+ MATRIX
+ Myrmecocystuscfnavajo 22
+
+ Myrmecocystuscreightoni 11
+
+ Myrmecocystusdepilis 00
+
+ Myrmecocystuskathjuli 00
+
+ Myrmecocystuskennedyi 00
+
+ Myrmecocystusmendax 00
+
+ Myrmecocystusmexicanus 22
+
+ Myrmecocystusmimicus 00
+
+ Myrmecocystusnavajo 22
+
+ Myrmecocystusnequazcatl 00
+
+ Myrmecocystusplacodops 00
+
+ Myrmecocystusromainei 00
+
+ Myrmecocystussemirufus 00
+
+ Myrmecocystussnellingi 11
+
+ Myrmecocystustenuinodis 11
+
+ Myrmecocystustestaceus 12
+
+ Myrmecocystuswheeleri 00
+
+ Myrmecocystusyuma 11
+
+
+;
+
+END;
+
+
+BEGIN TREES;
+ TRANSLATE
+ 1 Myrmecocystuscfnavajo,
+ 2 Myrmecocystuscreightoni,
+ 3 Myrmecocystusdepilis,
+ 4 Myrmecocystuskathjuli,
+ 5 Myrmecocystuskennedyi,
+ 6 Myrmecocystusmendax,
+ 7 Myrmecocystusmexicanus,
+ 8 Myrmecocystusmimicus,
+ 9 Myrmecocystusnavajo,
+ 10 Myrmecocystusnequazcatl,
+ 11 Myrmecocystusplacodops,
+ 12 Myrmecocystusromainei,
+ 13 Myrmecocystussemirufus,
+ 14 Myrmecocystussnellingi,
+ 15 Myrmecocystustenuinodis,
+ 16 Myrmecocystustestaceus,
+ 17 Myrmecocystuswheeleri,
+ 18 Myrmecocystusyuma;
+ TREE bestML = (((((((((13:1.724765,11:1.724765):2.926053,6:4.650818):0.689044,(4:1.08387,17:1.08387):4.255993):0.198842,((8:2.708942,3:2.708942):2.027251,((12:2.193845,10:2.193845):2.257581,18:4.451425):0.284767):0.802512):0.506099,5:6.044804):4.524387,2:10.569191):0.836689,(14:2.770378,15:2.770378):8.635503):0.89482,16:12.300701):1.699299,(7:5.724923,(1:2.869547,9:2.869547):2.855375):8.275077);
+
+END;
+
+BEGIN ASSUMPTIONS;
+ TYPESET * UNTITLED (CHARACTERS = 'Morphology') = Squared: 1 - 32;
+END;
+
+
+
+Begin MESQUITE;
+ MESQUITESCRIPTVERSION 2;
+ TITLE AUTO;
+ tell ProjectCoordinator;
+ getEmployee #mesquite.minimal.ManageTaxa.ManageTaxa;
+ tell It;
+ setID 0 9015005506118934442;
+ endTell;
+ getEmployee #mesquite.charMatrices.ManageCharacters.ManageCharacters;
+ tell It;
+ setID 0 2565950173085067248;
+ checksum 0 389122022;
+ setID 1 1161953040649633474;
+ checksum 1 3582198254;
+ endTell;
+ getEmployee #mesquite.charMatrices.BasicDataWindowCoord.BasicDataWindowCoord;
+ tell It;
+ showDataWindow #2565950173085067248 #mesquite.charMatrices.BasicDataWindowMaker.BasicDataWindowMaker;
+ tell It;
+ getWindow;
+ tell It;
+ setSize 420 280;
+ setLocation 400 156;
+ setFont SanSerif;
+ setFontSize 10;
+ onInfoBar;
+ setExplanationSize 30;
+ setAnnotationSize 20;
+ setFontIncAnnot 0;
+ setFontIncExp 0;
+ getToolPalette;
+ tell It;
+ endTell;
+ setTool mesquite.charMatrices.BasicDataWindowMaker.BasicDataWindow.arrow;
+ colorCells #mesquite.charMatrices.NoColor.NoColor;
+ setBackground White;
+ toggleShowNames on;
+ toggleTight off;
+ toggleShowChanges on;
+ toggleSeparateLines off;
+ toggleShowStates on;
+ toggleAutoWithCharNames on;
+ toggleShowDefaultCharNames off;
+ toggleConstrainCW on;
+ toggleBirdsEye off;
+ toggleColorsPanel off;
+ birdsEyeWidth 2;
+ toggleLinkedScrolling on;
+ toggleScrollLinkedTables off;
+ endTell;
+ showWindow;
+ getWindow;
+ tell It;
+ forceAutosize;
+ endTell;
+ getEmployee #mesquite.charMatrices.AnnotPanel.AnnotPanel;
+ tell It;
+ togglePanel off;
+ endTell;
+ getEmployee #mesquite.charMatrices.ColorCells.ColorCells;
+ tell It;
+ setColor Red;
+ removeColor off;
+ endTell;
+ endTell;
+ showDataWindow #1161953040649633474 #mesquite.charMatrices.BasicDataWindowMaker.BasicDataWindowMaker;
+ tell It;
+ getWindow;
+ tell It;
+ getTable;
+ tell It;
+ rowNamesWidth 232;
+ endTell;
+ setSize 798 748;
+ setLocation 348 22;
+ setFont SanSerif;
+ setFontSize 10;
+ onInfoBar;
+ setExplanationSize 30;
+ setAnnotationSize 20;
+ setFontIncAnnot 0;
+ setFontIncExp 0;
+ getToolPalette;
+ tell It;
+ setTool mesquite.charMatrices.BasicDataWindowMaker.BasicDataWindow.ibeam;
+ endTell;
+ setTool mesquite.charMatrices.BasicDataWindowMaker.BasicDataWindow.ibeam;
+ colorCells #mesquite.charMatrices.NoColor.NoColor;
+ setBackground White;
+ toggleShowNames on;
+ toggleTight off;
+ toggleShowChanges on;
+ toggleSeparateLines off;
+ toggleShowStates on;
+ toggleAutoWithCharNames on;
+ toggleShowDefaultCharNames off;
+ toggleConstrainCW on;
+ toggleBirdsEye off;
+ toggleColorsPanel off;
+ birdsEyeWidth 2;
+ toggleLinkedScrolling on;
+ toggleScrollLinkedTables off;
+ endTell;
+ showWindow;
+ getWindow;
+ tell It;
+ forceAutosize;
+ endTell;
+ getEmployee #mesquite.categ.StateNamesEditor.StateNamesEditor;
+ tell It;
+ makeWindow;
+ tell It;
+ setSize 314 400;
+ setLocation 60 10;
+ setFont SanSerif;
+ setFontSize 10;
+ onInfoBar;
+ setExplanationSize 30;
+ setAnnotationSize 20;
+ setFontIncAnnot 0;
+ setFontIncExp 0;
+ getToolPalette;
+ tell It;
+ setTool mesquite.categ.StateNamesEditor.StateNamesWindow.ibeam;
+ endTell;
+ rowsAreCharacters on;
+ toggleConstrainChar on;
+ toggleConstrainCharNum 3;
+ togglePanel off;
+ endTell;
+ showWindow;
+ endTell;
+ getEmployee #mesquite.categ.StateNamesStrip.StateNamesStrip;
+ tell It;
+ showStrip off;
+ endTell;
+ getEmployee #mesquite.charMatrices.AnnotPanel.AnnotPanel;
+ tell It;
+ togglePanel off;
+ endTell;
+ getEmployee #mesquite.charMatrices.ColorCells.ColorCells;
+ tell It;
+ setColor Red;
+ removeColor off;
+ endTell;
+ getEmployee #mesquite.charMatrices.QuickKeySelector.QuickKeySelector;
+ tell It;
+ autotabOff;
+ endTell;
+ endTell;
+ endTell;
+ getEmployee #mesquite.trees.BasicTreeWindowCoord.BasicTreeWindowCoord;
+ tell It;
+ makeTreeWindow #9015005506118934442 #mesquite.trees.BasicTreeWindowMaker.BasicTreeWindowMaker;
+ tell It;
+ setTreeSource #mesquite.trees.StoredTrees.StoredTrees;
+ tell It;
+ setTreeBlock 1;
+ toggleUseWeights off;
+ endTell;
+ setAssignedID 630.1180487973731.4514395117633566598;
+ getTreeWindow;
+ tell It;
+ setSize 520 400;
+ setLocation 60 10;
+ setFont SanSerif;
+ setFontSize 10;
+ onInfoBar;
+ setExplanationSize 30;
+ setAnnotationSize 20;
+ setFontIncAnnot 0;
+ setFontIncExp 0;
+ getToolPalette;
+ tell It;
+ endTell;
+ setActive;
+ getTreeDrawCoordinator #mesquite.trees.BasicTreeDrawCoordinator.BasicTreeDrawCoordinator;
+ tell It;
+ suppress;
+ setTreeDrawer #mesquite.trees.DiagonalDrawTree.DiagonalDrawTree;
+ tell It;
+ setEdgeWidth 12;
+ orientUp;
+ getEmployee #mesquite.trees.NodeLocsStandard.NodeLocsStandard;
+ tell It;
+ stretchToggle off;
+ branchLengthsToggle off;
+ toggleScale on;
+ toggleCenter off;
+ toggleEven off;
+ namesAngle ?;
+ endTell;
+ endTell;
+ setBackground White;
+ setBranchColor Black;
+ showNodeNumbers off;
+ labelBranchLengths off;
+ desuppress;
+ getEmployee #mesquite.trees.BasicDrawTaxonNames.BasicDrawTaxonNames;
+ tell It;
+ setColor Black;
+ toggleColorPartition on;
+ toggleShadePartition off;
+ toggleNodeLabels on;
+ toggleShowNames on;
+ endTell;
+ endTell;
+ setTreeNumber 1;
+ useSuggestedSize on;
+ toggleTextOnTree off;
+ newAssistant #mesquite.ancstates.TraceCharacterHistory.TraceCharacterHistory;
+ tell It;
+ suspend ;
+ setDisplayMode #mesquite.ancstates.ShadeStatesOnTree.ShadeStatesOnTree;
+ tell It;
+ toggleLabels off;
+ endTell;
+ setHistorySource #mesquite.ancstates.RecAncestralStates.RecAncestralStates;
+ tell It;
+ getCharacterSource #mesquite.charMatrices.CharSrcCoordObed.CharSrcCoordObed;
+ tell It;
+ setCharacterSource #mesquite.charMatrices.StoredCharacters.StoredCharacters;
+ tell It;
+ setDataSet #1161953040649633474;
+ endTell;
+ endTell;
+ setMethod #mesquite.parsimony.ParsAncestralStates.ParsAncestralStates;
+ tell It;
+ setModelSource #mesquite.parsimony.CurrentParsModels.CurrentParsModels;
+ endTell;
+ endTell;
+ setCharacter 1;
+ toggleShowLegend on;
+ toggleGray off;
+ toggleWeights on;
+ setInitialOffsetX -162;
+ setInitialOffsetY -177;
+ setLegendWidth 142;
+ setLegendHeight 177;
+ resume ;
+ endTell;
+ endTell;
+ showWindow;
+ getEmployee #mesquite.ornamental.BranchNotes.BranchNotes;
+ tell It;
+ setAlwaysOn off;
+ endTell;
+ getEmployee #mesquite.trees.ColorBranches.ColorBranches;
+ tell It;
+ setColor Red;
+ removeColor off;
+ endTell;
+ endTell;
+ endTell;
+ endTell;
+end;
+
+begin brownie;
+taxset all=1-18;
+end;
diff --git a/inst/nexusfiles/treeWithDiscreteData.nex b/inst/nexusfiles/treeWithDiscreteData.nex
new file mode 100644
index 0000000..9cbbdfe
--- /dev/null
+++ b/inst/nexusfiles/treeWithDiscreteData.nex
@@ -0,0 +1,354 @@
+#NEXUS
+[written Tue May 29 18:24:39 PDT 2007 by Mesquite version 1.06 (build g97) at cnidaria-1347.ucdavis.edu/169.237.66.185]
+
+BEGIN TAXA;
+ DIMENSIONS NTAX=18;
+ TAXLABELS
+ Myrmecocystuscfnavajo Myrmecocystuscreightoni Myrmecocystusdepilis Myrmecocystuskathjuli Myrmecocystuskennedyi Myrmecocystusmendax Myrmecocystusmexicanus Myrmecocystusmimicus Myrmecocystusnavajo Myrmecocystusnequazcatl Myrmecocystusplacodops Myrmecocystusromainei Myrmecocystussemirufus Myrmecocystussnellingi Myrmecocystustenuinodis Myrmecocystustestaceus Myrmecocystuswheeleri Myrmecocystusyuma
+ ;
+
+END;
+
+
+BEGIN CHARACTERS;
+ TITLE Foraging;
+ DIMENSIONS NCHAR=2;
+ FORMAT DATATYPE = STANDARD GAP = - MISSING = ? SYMBOLS = " 0 1 2";
+ CHARSTATELABELS
+ 1 time / diurnal crepuscular nocturnal, 2 subgenus / Endiodioctes Eremnocystus Myrmecocystus ;
+ MATRIX
+ Myrmecocystuscfnavajo 22
+
+ Myrmecocystuscreightoni 11
+
+ Myrmecocystusdepilis 00
+
+ Myrmecocystuskathjuli 00
+
+ Myrmecocystuskennedyi 00
+
+ Myrmecocystusmendax 00
+
+ Myrmecocystusmexicanus 22
+
+ Myrmecocystusmimicus 00
+
+ Myrmecocystusnavajo 22
+
+ Myrmecocystusnequazcatl 00
+
+ Myrmecocystusplacodops 00
+
+ Myrmecocystusromainei 00
+
+ Myrmecocystussemirufus 00
+
+ Myrmecocystussnellingi 11
+
+ Myrmecocystustenuinodis 11
+
+ Myrmecocystustestaceus 12
+
+ Myrmecocystuswheeleri 00
+
+ Myrmecocystusyuma 11
+
+
+;
+
+END;
+
+BEGIN TREES;
+ TRANSLATE
+ 1 Myrmecocystuscfnavajo,
+ 2 Myrmecocystuscreightoni,
+ 3 Myrmecocystusdepilis,
+ 4 Myrmecocystuskathjuli,
+ 5 Myrmecocystuskennedyi,
+ 6 Myrmecocystusmendax,
+ 7 Myrmecocystusmexicanus,
+ 8 Myrmecocystusmimicus,
+ 9 Myrmecocystusnavajo,
+ 10 Myrmecocystusnequazcatl,
+ 11 Myrmecocystusplacodops,
+ 12 Myrmecocystusromainei,
+ 13 Myrmecocystussemirufus,
+ 14 Myrmecocystussnellingi,
+ 15 Myrmecocystustenuinodis,
+ 16 Myrmecocystustestaceus,
+ 17 Myrmecocystuswheeleri,
+ 18 Myrmecocystusyuma;
+ TREE bestML = (((((((((13:1.724765,11:1.724765):2.926053,6:4.650818):0.689044,(4:1.08387,17:1.08387):4.255993):0.198842,((8:2.708942,3:2.708942):2.027251,((12:2.193845,10:2.193845):2.257581,18:4.451425):0.284767):0.802512):0.506099,5:6.044804):4.524387,2:10.569191):0.836689,(14:2.770378,15:2.770378):8.635503):0.89482,16:12.300701):1.699299,(7:5.724923,(1:2.869547,9:2.869547):2.855375):8.275077);
+
+END;
+
+
+BEGIN ASSUMPTIONS;
+ TYPESET * UNTITLED (CHARACTERS = Foraging) = unord: 1 - 2;
+END;
+
+BEGIN MESQUITECHARMODELS;
+ ProbModelSet * UNTITLED (CHARACTERS = 'Matrix in file "treepluscharV01.nex"') = Browniandefault: 1 - 32;
+ProbModelSet * UNTITLED (CHARACTERS = Foraging) = 'Mk1 (est.)': 1 - 2;
+END;
+
+Begin MESQUITE;
+ MESQUITESCRIPTVERSION 2;
+ TITLE AUTO;
+ tell ProjectCoordinator;
+ getEmployee #mesquite.minimal.ManageTaxa.ManageTaxa;
+ tell It;
+ setID 0 9015005506118934442;
+ endTell;
+ getEmployee #mesquite.charMatrices.ManageCharacters.ManageCharacters;
+ tell It;
+ setID 0 2565950173085067248;
+ checksum 0 389122022;
+ setID 1 1161953040649633474;
+ checksum 1 3582198254;
+ endTell;
+ getEmployee #mesquite.charMatrices.BasicDataWindowCoord.BasicDataWindowCoord;
+ tell It;
+ showDataWindow #2565950173085067248 #mesquite.charMatrices.BasicDataWindowMaker.BasicDataWindowMaker;
+ tell It;
+ getWindow;
+ tell It;
+ setSize 420 280;
+ setLocation 400 156;
+ setFont SanSerif;
+ setFontSize 10;
+ onInfoBar;
+ setExplanationSize 30;
+ setAnnotationSize 20;
+ setFontIncAnnot 0;
+ setFontIncExp 0;
+ getToolPalette;
+ tell It;
+ endTell;
+ setTool mesquite.charMatrices.BasicDataWindowMaker.BasicDataWindow.arrow;
+ colorCells #mesquite.charMatrices.NoColor.NoColor;
+ setBackground White;
+ toggleShowNames on;
+ toggleTight off;
+ toggleShowChanges on;
+ toggleSeparateLines off;
+ toggleShowStates on;
+ toggleAutoWithCharNames on;
+ toggleShowDefaultCharNames off;
+ toggleConstrainCW on;
+ toggleBirdsEye off;
+ toggleColorsPanel off;
+ birdsEyeWidth 2;
+ toggleLinkedScrolling on;
+ toggleScrollLinkedTables off;
+ endTell;
+ showWindow;
+ getWindow;
+ tell It;
+ forceAutosize;
+ endTell;
+ getEmployee #mesquite.charMatrices.AnnotPanel.AnnotPanel;
+ tell It;
+ togglePanel off;
+ endTell;
+ getEmployee #mesquite.charMatrices.ColorCells.ColorCells;
+ tell It;
+ setColor Red;
+ removeColor off;
+ endTell;
+ endTell;
+ showDataWindow #1161953040649633474 #mesquite.charMatrices.BasicDataWindowMaker.BasicDataWindowMaker;
+ tell It;
+ getWindow;
+ tell It;
+ getTable;
+ tell It;
+ rowNamesWidth 232;
+ endTell;
+ setSize 798 748;
+ setLocation 348 22;
+ setFont SanSerif;
+ setFontSize 10;
+ onInfoBar;
+ setExplanationSize 30;
+ setAnnotationSize 20;
+ setFontIncAnnot 0;
+ setFontIncExp 0;
+ getToolPalette;
+ tell It;
+ setTool mesquite.charMatrices.BasicDataWindowMaker.BasicDataWindow.ibeam;
+ endTell;
+ setTool mesquite.charMatrices.BasicDataWindowMaker.BasicDataWindow.ibeam;
+ colorCells #mesquite.charMatrices.NoColor.NoColor;
+ setBackground White;
+ toggleShowNames on;
+ toggleTight off;
+ toggleShowChanges on;
+ toggleSeparateLines off;
+ toggleShowStates on;
+ toggleAutoWithCharNames on;
+ toggleShowDefaultCharNames off;
+ toggleConstrainCW on;
+ toggleBirdsEye off;
+ toggleColorsPanel off;
+ birdsEyeWidth 2;
+ toggleLinkedScrolling on;
+ toggleScrollLinkedTables off;
+ endTell;
+ showWindow;
+ getWindow;
+ tell It;
+ forceAutosize;
+ endTell;
+ getEmployee #mesquite.categ.StateNamesEditor.StateNamesEditor;
+ tell It;
+ makeWindow;
+ tell It;
+ setSize 314 400;
+ setLocation 60 10;
+ setFont SanSerif;
+ setFontSize 10;
+ onInfoBar;
+ setExplanationSize 30;
+ setAnnotationSize 20;
+ setFontIncAnnot 0;
+ setFontIncExp 0;
+ getToolPalette;
+ tell It;
+ setTool mesquite.categ.StateNamesEditor.StateNamesWindow.ibeam;
+ endTell;
+ rowsAreCharacters on;
+ toggleConstrainChar on;
+ toggleConstrainCharNum 3;
+ togglePanel off;
+ endTell;
+ showWindow;
+ endTell;
+ getEmployee #mesquite.categ.StateNamesStrip.StateNamesStrip;
+ tell It;
+ showStrip off;
+ endTell;
+ getEmployee #mesquite.charMatrices.AnnotPanel.AnnotPanel;
+ tell It;
+ togglePanel off;
+ endTell;
+ getEmployee #mesquite.charMatrices.ColorCells.ColorCells;
+ tell It;
+ setColor Red;
+ removeColor off;
+ endTell;
+ getEmployee #mesquite.charMatrices.QuickKeySelector.QuickKeySelector;
+ tell It;
+ autotabOff;
+ endTell;
+ endTell;
+ endTell;
+ getEmployee #mesquite.trees.BasicTreeWindowCoord.BasicTreeWindowCoord;
+ tell It;
+ makeTreeWindow #9015005506118934442 #mesquite.trees.BasicTreeWindowMaker.BasicTreeWindowMaker;
+ tell It;
+ setTreeSource #mesquite.trees.StoredTrees.StoredTrees;
+ tell It;
+ setTreeBlock 1;
+ toggleUseWeights off;
+ endTell;
+ setAssignedID 630.1180487973731.4514395117633566598;
+ getTreeWindow;
+ tell It;
+ setSize 520 400;
+ setLocation 60 10;
+ setFont SanSerif;
+ setFontSize 10;
+ onInfoBar;
+ setExplanationSize 30;
+ setAnnotationSize 20;
+ setFontIncAnnot 0;
+ setFontIncExp 0;
+ getToolPalette;
+ tell It;
+ endTell;
+ setActive;
+ getTreeDrawCoordinator #mesquite.trees.BasicTreeDrawCoordinator.BasicTreeDrawCoordinator;
+ tell It;
+ suppress;
+ setTreeDrawer #mesquite.trees.DiagonalDrawTree.DiagonalDrawTree;
+ tell It;
+ setEdgeWidth 12;
+ orientUp;
+ getEmployee #mesquite.trees.NodeLocsStandard.NodeLocsStandard;
+ tell It;
+ stretchToggle off;
+ branchLengthsToggle off;
+ toggleScale on;
+ toggleCenter off;
+ toggleEven off;
+ namesAngle ?;
+ endTell;
+ endTell;
+ setBackground White;
+ setBranchColor Black;
+ showNodeNumbers off;
+ labelBranchLengths off;
+ desuppress;
+ getEmployee #mesquite.trees.BasicDrawTaxonNames.BasicDrawTaxonNames;
+ tell It;
+ setColor Black;
+ toggleColorPartition on;
+ toggleShadePartition off;
+ toggleNodeLabels on;
+ toggleShowNames on;
+ endTell;
+ endTell;
+ setTreeNumber 1;
+ useSuggestedSize on;
+ toggleTextOnTree off;
+ newAssistant #mesquite.ancstates.TraceCharacterHistory.TraceCharacterHistory;
+ tell It;
+ suspend ;
+ setDisplayMode #mesquite.ancstates.ShadeStatesOnTree.ShadeStatesOnTree;
+ tell It;
+ toggleLabels off;
+ endTell;
+ setHistorySource #mesquite.ancstates.RecAncestralStates.RecAncestralStates;
+ tell It;
+ getCharacterSource #mesquite.charMatrices.CharSrcCoordObed.CharSrcCoordObed;
+ tell It;
+ setCharacterSource #mesquite.charMatrices.StoredCharacters.StoredCharacters;
+ tell It;
+ setDataSet #1161953040649633474;
+ endTell;
+ endTell;
+ setMethod #mesquite.parsimony.ParsAncestralStates.ParsAncestralStates;
+ tell It;
+ setModelSource #mesquite.parsimony.CurrentParsModels.CurrentParsModels;
+ endTell;
+ endTell;
+ setCharacter 1;
+ toggleShowLegend on;
+ toggleGray off;
+ toggleWeights on;
+ setInitialOffsetX -162;
+ setInitialOffsetY -177;
+ setLegendWidth 142;
+ setLegendHeight 177;
+ resume ;
+ endTell;
+ endTell;
+ showWindow;
+ getEmployee #mesquite.ornamental.BranchNotes.BranchNotes;
+ tell It;
+ setAlwaysOn off;
+ endTell;
+ getEmployee #mesquite.trees.ColorBranches.ColorBranches;
+ tell It;
+ setColor Red;
+ removeColor off;
+ endTell;
+ endTell;
+ endTell;
+ endTell;
+end;
+
+begin brownie;
+taxset all=1-18;
+end;
diff --git a/inst/nexusfiles/treeWithPolyExcludedData.nex b/inst/nexusfiles/treeWithPolyExcludedData.nex
new file mode 100644
index 0000000..43c0ac8
--- /dev/null
+++ b/inst/nexusfiles/treeWithPolyExcludedData.nex
@@ -0,0 +1,465 @@
+#NEXUS
+[written Wed Mar 10 11:51:23 EST 2010 by Mesquite version 2.72 (build 527) at francois-laptop/127.0.1.1]
+
+BEGIN TAXA;
+ TITLE Taxa;
+ DIMENSIONS NTAX=18;
+ TAXLABELS
+ Myrmecocystuscfnavajo Myrmecocystuscreightoni Myrmecocystusdepilis Myrmecocystuskathjuli Myrmecocystuskennedyi Myrmecocystusmendax Myrmecocystusmexicanus Myrmecocystusmimicus Myrmecocystusnavajo Myrmecocystusnequazcatl Myrmecocystusplacodops Myrmecocystusromainei Myrmecocystussemirufus Myrmecocystussnellingi Myrmecocystustenuinodis Myrmecocystustestaceus Myrmecocystuswheeleri Myrmecocystusyuma
+ ;
+
+END;
+
+
+BEGIN CHARACTERS;
+ TITLE testIncomplete;
+ DIMENSIONS NCHAR=3;
+ FORMAT DATATYPE = STANDARD GAP = - MISSING = ? SYMBOLS = "0 1 2";
+ CHARSTATELABELS
+ 1 Test1 /test1A test1B, 2 Test2 /test2A test2B, 3 Test3 /test3A test3B test3C;
+ MATRIX
+ Myrmecocystuscfnavajo 1(0 1)(0 1 2)
+ Myrmecocystuscreightoni ?(0 1)(0 1)
+ Myrmecocystusdepilis 102
+ Myrmecocystuskathjuli 100
+ Myrmecocystuskennedyi 010
+ Myrmecocystusmendax 101
+ Myrmecocystusmexicanus 000
+ Myrmecocystusmimicus ??0
+ Myrmecocystusnavajo ?11
+ Myrmecocystusnequazcatl 100
+ Myrmecocystusplacodops 001
+ Myrmecocystusromainei 11(0 1 2)
+ Myrmecocystussemirufus 001
+ Myrmecocystussnellingi 1?0
+ Myrmecocystustenuinodis 101
+ Myrmecocystustestaceus ??0
+ Myrmecocystuswheeleri 000
+ Myrmecocystusyuma 01?
+
+;
+
+END;
+BEGIN TREES;
+ Title 'Trees from "treepluscharV01.nex"';
+ LINK Taxa = Taxa;
+ TRANSLATE
+ 1 Myrmecocystuscfnavajo,
+ 2 Myrmecocystuscreightoni,
+ 3 Myrmecocystusdepilis,
+ 4 Myrmecocystuskathjuli,
+ 5 Myrmecocystuskennedyi,
+ 6 Myrmecocystusmendax,
+ 7 Myrmecocystusmexicanus,
+ 8 Myrmecocystusmimicus,
+ 9 Myrmecocystusnavajo,
+ 10 Myrmecocystusnequazcatl,
+ 11 Myrmecocystusplacodops,
+ 12 Myrmecocystusromainei,
+ 13 Myrmecocystussemirufus,
+ 14 Myrmecocystussnellingi,
+ 15 Myrmecocystustenuinodis,
+ 16 Myrmecocystustestaceus,
+ 17 Myrmecocystuswheeleri,
+ 18 Myrmecocystusyuma;
+ TREE bestML = (((((((((13:1.724765,11:1.724765):2.926053,6:4.650818):0.689044,(4:1.08387,17:1.08387):4.255993):0.198842,((8:2.708942,3:2.708942):2.027251,((12:2.193845,10:2.193845):2.257581,18:4.451425):0.284767):0.802512):0.506099,5:6.044804):4.524387,2:10.569191):0.836689,(14:2.770378,15:2.770378):8.635503):0.89482,16:12.300701):1.699299,(7:5.724923,(1:2.869547,9:2.869547):2.855375):8.275077);
+
+END;
+
+
+BEGIN ASSUMPTIONS;
+ TYPESET * UNTITLED = unord: 1 - 3;
+
+ EXSET * UNTITLED = 3;
+
+END;
+
+BEGIN MESQUITECHARMODELS;
+ ProbModelSet * UNTITLED = 'Mk1 (est.)': 1 - 3;
+END;
+
+Begin MESQUITE;
+ MESQUITESCRIPTVERSION 2;
+ TITLE AUTO;
+ tell ProjectCoordinator;
+ timeSaved 1268239884091;
+ getEmployee #mesquite.minimal.ManageTaxa.ManageTaxa;
+ tell It;
+ setID 0 9015005506118934442;
+ endTell;
+ getEmployee #mesquite.charMatrices.ManageCharacters.ManageCharacters;
+ tell It;
+ setID 0 2565950173085067248;
+ checksumv 0 2 4144740407 null numChars 3 short true bits 7 states 7 sumSquaresStatesOnly 220.0 NumFiles 1 NumMatrices 1;
+ endTell;
+ getWindow;
+ tell It;
+ suppress;
+ setResourcesState false false 155;
+ setPopoutState 400;
+ setExplanationSize 0;
+ setAnnotationSize 0;
+ setFontIncAnnot 0;
+ setFontIncExp 0;
+ setSize 1278 934;
+ setLocation 1440 0;
+ setFont SanSerif;
+ setFontSize 10;
+ getToolPalette;
+ tell It;
+ endTell;
+ desuppress;
+ endTell;
+ getEmployee #mesquite.trees.BasicTreeWindowCoord.BasicTreeWindowCoord;
+ tell It;
+ makeTreeWindow #9015005506118934442 #mesquite.trees.BasicTreeWindowMaker.BasicTreeWindowMaker;
+ tell It;
+ suppressEPCResponse;
+ setTreeSource #mesquite.trees.StoredTrees.StoredTrees;
+ tell It;
+ setTreeBlock 1;
+ toggleUseWeights off;
+ endTell;
+ setAssignedID 630.1180487973731.4514395117633566598;
+ getTreeWindow;
+ tell It;
+ setExplanationSize 30;
+ setAnnotationSize 20;
+ setFontIncAnnot 0;
+ setFontIncExp 0;
+ setSize 1123 867;
+ setLocation 1440 0;
+ setFont SanSerif;
+ setFontSize 10;
+ getToolPalette;
+ tell It;
+ endTell;
+ getTreeDrawCoordinator #mesquite.trees.BasicTreeDrawCoordinator.BasicTreeDrawCoordinator;
+ tell It;
+ suppress;
+ setTreeDrawer #mesquite.trees.DiagonalDrawTree.DiagonalDrawTree;
+ tell It;
+ setNodeLocs #mesquite.trees.NodeLocsStandard.NodeLocsStandard;
+ tell It;
+ inhibitStretchToggle on;
+ branchLengthsToggle off;
+ toggleScale on;
+ toggleBroadScale off;
+ toggleCenter off;
+ toggleEven off;
+ endTell;
+ setEdgeWidth 12;
+ orientUp;
+ endTell;
+ setBackground White;
+ setBranchColor Black;
+ showNodeNumbers off;
+ showBranchColors on;
+ labelBranchLengths off;
+ centerBrLenLabels on;
+ showBrLensUnspecified on;
+ showBrLenLabelsOnTerminals on;
+ setBrLenLabelColor 0 0 255;
+ setNumBrLenDecimals 6;
+ desuppress;
+ getEmployee #mesquite.trees.BasicDrawTaxonNames.BasicDrawTaxonNames;
+ tell It;
+ setColor Black;
+ toggleColorPartition on;
+ toggleShadePartition off;
+ toggleShowFootnotes on;
+ toggleNodeLabels on;
+ toggleCenterNodeNames off;
+ toggleShowNames on;
+ namesAngle ?;
+ endTell;
+ endTell;
+ setTreeNumber 1;
+ setDrawingSizeMode 0;
+ toggleLegendFloat on;
+ scale 0;
+ toggleTextOnTree off;
+ showWindow;
+ newAssistant #mesquite.ancstates.TraceCharacterHistory.TraceCharacterHistory;
+ tell It;
+ suspend ;
+ setDisplayMode #mesquite.ancstates.ShadeStatesOnTree.ShadeStatesOnTree;
+ tell It;
+ toggleLabels off;
+ toggleGray off;
+ endTell;
+ setHistorySource #mesquite.ancstates.RecAncestralStates.RecAncestralStates;
+ tell It;
+ getCharacterSource #mesquite.charMatrices.CharSrcCoordObed.CharSrcCoordObed;
+ tell It;
+ setCharacterSource #mesquite.charMatrices.StoredCharacters.StoredCharacters;
+ tell It;
+ setDataSet #2565950173085067248;
+ endTell;
+ endTell;
+ setMethod #mesquite.parsimony.ParsAncestralStates.ParsAncestralStates;
+ tell It;
+ setModelSource #mesquite.parsimony.CurrentParsModels.CurrentParsModels;
+ toggleMPRsMode off;
+ endTell;
+ endTell;
+ setCharacter 1;
+ setMapping 1;
+ toggleShowLegend on;
+ toggleGray off;
+ toggleWeights on;
+ setInitialOffsetX 4;
+ setInitialOffsetY -191;
+ setLegendWidth 142;
+ setLegendHeight 191;
+ resume ;
+ endTell;
+ endTell;
+ desuppressEPCResponse;
+ getEmployee #mesquite.trees.ColorBranches.ColorBranches;
+ tell It;
+ setColor Red;
+ removeColor off;
+ endTell;
+ getEmployee #mesquite.ornamental.BranchNotes.BranchNotes;
+ tell It;
+ setAlwaysOn off;
+ endTell;
+ getEmployee #mesquite.ornamental.ColorTreeByPartition.ColorTreeByPartition;
+ tell It;
+ colorByPartition off;
+ endTell;
+ getEmployee #mesquite.ornamental.DrawTreeAssocDoubles.DrawTreeAssocDoubles;
+ tell It;
+ setOn on;
+ setDigits 4;
+ writeAsPercentage off;
+ toggleCentred on;
+ toggleHorizontal on;
+ setFontSize 10;
+ setOffset 0 0;
+ endTell;
+ getEmployee #mesquite.trees.TreeInfoValues.TreeInfoValues;
+ tell It;
+ panelOpen false;
+ endTell;
+ endTell;
+ endTell;
+ getEmployee #mesquite.charMatrices.BasicDataWindowCoord.BasicDataWindowCoord;
+ tell It;
+ showDataWindow #2565950173085067248 #mesquite.charMatrices.BasicDataWindowMaker.BasicDataWindowMaker;
+ tell It;
+ getWindow;
+ tell It;
+ setExplanationSize 30;
+ setAnnotationSize 20;
+ setFontIncAnnot 0;
+ setFontIncExp 0;
+ setSize 1123 867;
+ setLocation 1440 0;
+ setFont SanSerif;
+ setFontSize 10;
+ getToolPalette;
+ tell It;
+ endTell;
+ setTool mesquite.charMatrices.BasicDataWindowMaker.BasicDataWindow.arrow;
+ colorCells #mesquite.charMatrices.NoColor.NoColor;
+ colorRowNames #mesquite.charMatrices.TaxonGroupColor.TaxonGroupColor;
+ colorColumnNames #mesquite.charMatrices.CharGroupColor.CharGroupColor;
+ colorText #mesquite.charMatrices.NoColor.NoColor;
+ setBackground White;
+ toggleShowNames on;
+ toggleShowTaxonNames on;
+ toggleTight off;
+ toggleThinRows off;
+ toggleShowChanges on;
+ toggleSeparateLines off;
+ toggleShowStates on;
+ toggleAutoWCharNames on;
+ toggleAutoTaxonNames off;
+ toggleShowDefaultCharNames off;
+ toggleConstrainCW on;
+ setColumnWidth 70;
+ toggleBirdsEye off;
+ toggleAllowAutosize on;
+ toggleColorsPanel off;
+ toggleDiagonal on;
+ setDiagonalHeight 80;
+ toggleLinkedScrolling on;
+ toggleScrollLinkedTables off;
+ endTell;
+ hideWindow;
+ getEmployee #mesquite.charMatrices.ColorCells.ColorCells;
+ tell It;
+ setColor Red;
+ removeColor off;
+ endTell;
+ getEmployee #mesquite.categ.StateNamesStrip.StateNamesStrip;
+ tell It;
+ showStrip off;
+ endTell;
+ getEmployee #mesquite.charMatrices.AnnotPanel.AnnotPanel;
+ tell It;
+ togglePanel off;
+ endTell;
+ getEmployee #mesquite.charMatrices.CharReferenceStrip.CharReferenceStrip;
+ tell It;
+ showStrip off;
+ endTell;
+ getEmployee #mesquite.charMatrices.QuickKeySelector.QuickKeySelector;
+ tell It;
+ autotabOff;
+ endTell;
+ getEmployee #mesquite.categ.SmallStateNamesEditor.SmallStateNamesEditor;
+ tell It;
+ panelOpen true;
+ endTell;
+ endTell;
+ showExtraDataWindow #2565950173085067248 #mesquite.charMatrices.BasicDataWindowMaker.BasicDataWindowMaker;
+ tell It;
+ getWindow;
+ tell It;
+ setExplanationSize 30;
+ setAnnotationSize 20;
+ setFontIncAnnot 0;
+ setFontIncExp 0;
+ setSize 1123 867;
+ setLocation 1440 0;
+ setFont SanSerif;
+ setFontSize 10;
+ getToolPalette;
+ tell It;
+ setTool mesquite.charMatrices.BasicDataWindowMaker.BasicDataWindow.ibeam;
+ endTell;
+ setTool mesquite.charMatrices.BasicDataWindowMaker.BasicDataWindow.ibeam;
+ colorCells #mesquite.charMatrices.NoColor.NoColor;
+ colorRowNames #mesquite.charMatrices.TaxonGroupColor.TaxonGroupColor;
+ colorColumnNames #mesquite.charMatrices.CharGroupColor.CharGroupColor;
+ colorText #mesquite.charMatrices.NoColor.NoColor;
+ setBackground White;
+ toggleShowNames on;
+ toggleShowTaxonNames on;
+ toggleTight off;
+ toggleThinRows off;
+ toggleShowChanges on;
+ toggleSeparateLines off;
+ toggleShowStates on;
+ toggleAutoWCharNames on;
+ toggleAutoTaxonNames off;
+ toggleShowDefaultCharNames off;
+ toggleConstrainCW on;
+ toggleBirdsEye off;
+ toggleAllowAutosize on;
+ toggleColorsPanel off;
+ toggleDiagonal on;
+ setDiagonalHeight 80;
+ toggleLinkedScrolling on;
+ toggleScrollLinkedTables off;
+ getInfoPanel;
+ tell It;
+ btspOpen true;
+ apOpen true;
+ fpOpen true;
+ endTell;
+ toggleInfoPanel off;
+ endTell;
+ showWindow;
+ getWindow;
+ tell It;
+ forceAutosize;
+ endTell;
+ getEmployee #mesquite.charMatrices.ColorCells.ColorCells;
+ tell It;
+ setColor Red;
+ removeColor off;
+ endTell;
+ getEmployee #mesquite.categ.StateNamesEditor.StateNamesEditor;
+ tell It;
+ makeWindow;
+ tell It;
+ setExplanationSize 30;
+ setAnnotationSize 20;
+ setFontIncAnnot 0;
+ setFontIncExp 0;
+ setSize 1123 867;
+ setLocation 1440 0;
+ setFont SanSerif;
+ setFontSize 10;
+ getToolPalette;
+ tell It;
+ setTool mesquite.categ.StateNamesEditor.StateNamesWindow.ibeam;
+ endTell;
+ setActive;
+ rowsAreCharacters on;
+ toggleConstrainChar on;
+ toggleConstrainCharNum 3;
+ togglePanel off;
+ toggleSummaryPanel off;
+ endTell;
+ showWindow;
+ endTell;
+ getEmployee #mesquite.categ.StateNamesStrip.StateNamesStrip;
+ tell It;
+ showStrip off;
+ endTell;
+ getEmployee #mesquite.charMatrices.AnnotPanel.AnnotPanel;
+ tell It;
+ togglePanel off;
+ endTell;
+ getEmployee #mesquite.charMatrices.CharReferenceStrip.CharReferenceStrip;
+ tell It;
+ showStrip off;
+ endTell;
+ getEmployee #mesquite.charMatrices.QuickKeySelector.QuickKeySelector;
+ tell It;
+ autotabOff;
+ endTell;
+ getEmployee #mesquite.categ.SmallStateNamesEditor.SmallStateNamesEditor;
+ tell It;
+ panelOpen true;
+ endTell;
+ endTell;
+ endTell;
+ getEmployee #mesquite.charMatrices.ManageCharacters.ManageCharacters;
+ tell It;
+ showCharacters #2565950173085067248 #mesquite.lists.CharacterList.CharacterList;
+ tell It;
+ setData 0;
+ getWindow;
+ tell It;
+ newAssistant #mesquite.lists.DefaultCharOrder.DefaultCharOrder;
+ newAssistant #mesquite.lists.CharListInclusion.CharListInclusion;
+ newAssistant #mesquite.lists.CharListPartition.CharListPartition;
+ newAssistant #mesquite.stochchar.CharListProbModels.CharListProbModels;
+ getTable;
+ tell It;
+ columnWidth 1 101;
+ endTell;
+ setExplanationSize 30;
+ setAnnotationSize 20;
+ setFontIncAnnot 0;
+ setFontIncExp 0;
+ setSize 1123 867;
+ setLocation 1440 0;
+ setFont SanSerif;
+ setFontSize 10;
+ getToolPalette;
+ tell It;
+ setTool mesquite.lists.CharacterList.CharacterListWindow.arrow;
+ endTell;
+ endTell;
+ showWindow;
+ getEmployee #mesquite.lists.CharListAnnotPanel.CharListAnnotPanel;
+ tell It;
+ togglePanel off;
+ endTell;
+ endTell;
+ endTell;
+ endTell;
+end;
+
+begin brownie;
+taxset all = 1 -18;
+
+END;
+
diff --git a/inst/nexusfiles/treeWithSpecialCharacters.nex b/inst/nexusfiles/treeWithSpecialCharacters.nex
new file mode 100644
index 0000000..845b9c1
--- /dev/null
+++ b/inst/nexusfiles/treeWithSpecialCharacters.nex
@@ -0,0 +1,35 @@
+#NEXUS
+
+BEGIN TAXA;
+ DIMENSIONS NTAX=6;
+ TAXLABELS
+ Species_1 'Species 2' 'Species 3' 'Species/4' 'Species\5' 'Species"6'
+ ;
+END;
+
+BEGIN CHARACTERS;
+ TITLE TestCharacters;
+ DIMENSIONS NCHAR=2;
+ FORMAT DATATYPE = STANDARD GAP = - MISSING = ? SYMBOLS = " 0 1";
+ CHARSTATELABELS
+ 1 character1 / state1.1 'state 1.2', 2 character2 / state2.1 'state 2 2';
+ MATRIX
+ Species_1 01
+ 'Species 2' 10
+ 'Species 3' 11
+ 'Species/4' 00
+ 'Species\5' 01
+ 'Species"6' ?1
+ ;
+END;
+
+BEGIN TREES;
+ TRANSLATE
+ 1 Species_1,
+ 2 'Species 2',
+ 3 'Species 3',
+ 4 'Species/4',
+ 5 'Species\5',
+ 6 'Species"6';
+ TREE tree1 = ((((1,2),3),4),5);
+END;
diff --git a/inst/nexusfiles/treeWithUnderscoreLabels.nex b/inst/nexusfiles/treeWithUnderscoreLabels.nex
new file mode 100644
index 0000000..e84d6a4
--- /dev/null
+++ b/inst/nexusfiles/treeWithUnderscoreLabels.nex
@@ -0,0 +1,354 @@
+#NEXUS
+[written Tue May 29 18:24:39 PDT 2007 by Mesquite version 1.06 (build g97) at cnidaria-1347.ucdavis.edu/169.237.66.185]
+
+BEGIN TAXA;
+ DIMENSIONS NTAX=18;
+ TAXLABELS
+ Myrmecocystuscfnavajo Myrmecocystus_creightoni Myrmecocystusdepilis Myrmecocystuskathjuli Myrmecocystuskennedyi Myrmecocystusmendax Myrmecocystusmexicanus Myrmecocystusmimicus Myrmecocystusnavajo Myrmecocystusnequazcatl Myrmecocystusplacodops Myrmecocystusromainei Myrmecocystussemirufus Myrmecocystussnellingi Myrmecocystustenuinodis Myrmecocystustestaceus Myrmecocystuswheeleri Myrmecocystusyuma
+ ;
+
+END;
+
+
+BEGIN CHARACTERS;
+ TITLE Foraging;
+ DIMENSIONS NCHAR=2;
+ FORMAT DATATYPE = STANDARD GAP = - MISSING = ? SYMBOLS = " 0 1 2";
+ CHARSTATELABELS
+ 1 time_period / diurnal crepuscular nocturnal, 2 subgenus / Endiodioctes Eremnocystus Myrmecocystus ;
+ MATRIX
+ Myrmecocystuscfnavajo 22
+
+ Myrmecocystus_creightoni 11
+
+ Myrmecocystusdepilis 00
+
+ Myrmecocystuskathjuli 00
+
+ Myrmecocystuskennedyi 00
+
+ Myrmecocystusmendax 00
+
+ Myrmecocystusmexicanus 22
+
+ Myrmecocystusmimicus 00
+
+ Myrmecocystusnavajo 22
+
+ Myrmecocystusnequazcatl 00
+
+ Myrmecocystusplacodops 00
+
+ Myrmecocystusromainei 00
+
+ Myrmecocystussemirufus 00
+
+ Myrmecocystussnellingi 11
+
+ Myrmecocystustenuinodis 11
+
+ Myrmecocystustestaceus 12
+
+ Myrmecocystuswheeleri 00
+
+ Myrmecocystusyuma 11
+
+
+;
+
+END;
+
+BEGIN TREES;
+ TRANSLATE
+ 1 Myrmecocystuscfnavajo,
+ 2 Myrmecocystus_creightoni,
+ 3 Myrmecocystusdepilis,
+ 4 Myrmecocystuskathjuli,
+ 5 Myrmecocystuskennedyi,
+ 6 Myrmecocystusmendax,
+ 7 Myrmecocystusmexicanus,
+ 8 Myrmecocystusmimicus,
+ 9 Myrmecocystusnavajo,
+ 10 Myrmecocystusnequazcatl,
+ 11 Myrmecocystusplacodops,
+ 12 Myrmecocystusromainei,
+ 13 Myrmecocystussemirufus,
+ 14 Myrmecocystussnellingi,
+ 15 Myrmecocystustenuinodis,
+ 16 Myrmecocystustestaceus,
+ 17 Myrmecocystuswheeleri,
+ 18 Myrmecocystusyuma;
+ TREE bestML = (((((((((13:1.724765,11:1.724765):2.926053,6:4.650818):0.689044,(4:1.08387,17:1.08387):4.255993):0.198842,((8:2.708942,3:2.708942):2.027251,((12:2.193845,10:2.193845):2.257581,18:4.451425):0.284767):0.802512):0.506099,5:6.044804):4.524387,2:10.569191):0.836689,(14:2.770378,15:2.770378):8.635503):0.89482,16:12.300701):1.699299,(7:5.724923,(1:2.869547,9:2.869547):2.855375):8.275077);
+
+END;
+
+
+BEGIN ASSUMPTIONS;
+ TYPESET * UNTITLED (CHARACTERS = Foraging) = unord: 1 - 2;
+END;
+
+BEGIN MESQUITECHARMODELS;
+ ProbModelSet * UNTITLED (CHARACTERS = 'Matrix in file "treepluscharV01.nex"') = Browniandefault: 1 - 32;
+ProbModelSet * UNTITLED (CHARACTERS = Foraging) = 'Mk1 (est.)': 1 - 2;
+END;
+
+Begin MESQUITE;
+ MESQUITESCRIPTVERSION 2;
+ TITLE AUTO;
+ tell ProjectCoordinator;
+ getEmployee #mesquite.minimal.ManageTaxa.ManageTaxa;
+ tell It;
+ setID 0 9015005506118934442;
+ endTell;
+ getEmployee #mesquite.charMatrices.ManageCharacters.ManageCharacters;
+ tell It;
+ setID 0 2565950173085067248;
+ checksum 0 389122022;
+ setID 1 1161953040649633474;
+ checksum 1 3582198254;
+ endTell;
+ getEmployee #mesquite.charMatrices.BasicDataWindowCoord.BasicDataWindowCoord;
+ tell It;
+ showDataWindow #2565950173085067248 #mesquite.charMatrices.BasicDataWindowMaker.BasicDataWindowMaker;
+ tell It;
+ getWindow;
+ tell It;
+ setSize 420 280;
+ setLocation 400 156;
+ setFont SanSerif;
+ setFontSize 10;
+ onInfoBar;
+ setExplanationSize 30;
+ setAnnotationSize 20;
+ setFontIncAnnot 0;
+ setFontIncExp 0;
+ getToolPalette;
+ tell It;
+ endTell;
+ setTool mesquite.charMatrices.BasicDataWindowMaker.BasicDataWindow.arrow;
+ colorCells #mesquite.charMatrices.NoColor.NoColor;
+ setBackground White;
+ toggleShowNames on;
+ toggleTight off;
+ toggleShowChanges on;
+ toggleSeparateLines off;
+ toggleShowStates on;
+ toggleAutoWithCharNames on;
+ toggleShowDefaultCharNames off;
+ toggleConstrainCW on;
+ toggleBirdsEye off;
+ toggleColorsPanel off;
+ birdsEyeWidth 2;
+ toggleLinkedScrolling on;
+ toggleScrollLinkedTables off;
+ endTell;
+ showWindow;
+ getWindow;
+ tell It;
+ forceAutosize;
+ endTell;
+ getEmployee #mesquite.charMatrices.AnnotPanel.AnnotPanel;
+ tell It;
+ togglePanel off;
+ endTell;
+ getEmployee #mesquite.charMatrices.ColorCells.ColorCells;
+ tell It;
+ setColor Red;
+ removeColor off;
+ endTell;
+ endTell;
+ showDataWindow #1161953040649633474 #mesquite.charMatrices.BasicDataWindowMaker.BasicDataWindowMaker;
+ tell It;
+ getWindow;
+ tell It;
+ getTable;
+ tell It;
+ rowNamesWidth 232;
+ endTell;
+ setSize 798 748;
+ setLocation 348 22;
+ setFont SanSerif;
+ setFontSize 10;
+ onInfoBar;
+ setExplanationSize 30;
+ setAnnotationSize 20;
+ setFontIncAnnot 0;
+ setFontIncExp 0;
+ getToolPalette;
+ tell It;
+ setTool mesquite.charMatrices.BasicDataWindowMaker.BasicDataWindow.ibeam;
+ endTell;
+ setTool mesquite.charMatrices.BasicDataWindowMaker.BasicDataWindow.ibeam;
+ colorCells #mesquite.charMatrices.NoColor.NoColor;
+ setBackground White;
+ toggleShowNames on;
+ toggleTight off;
+ toggleShowChanges on;
+ toggleSeparateLines off;
+ toggleShowStates on;
+ toggleAutoWithCharNames on;
+ toggleShowDefaultCharNames off;
+ toggleConstrainCW on;
+ toggleBirdsEye off;
+ toggleColorsPanel off;
+ birdsEyeWidth 2;
+ toggleLinkedScrolling on;
+ toggleScrollLinkedTables off;
+ endTell;
+ showWindow;
+ getWindow;
+ tell It;
+ forceAutosize;
+ endTell;
+ getEmployee #mesquite.categ.StateNamesEditor.StateNamesEditor;
+ tell It;
+ makeWindow;
+ tell It;
+ setSize 314 400;
+ setLocation 60 10;
+ setFont SanSerif;
+ setFontSize 10;
+ onInfoBar;
+ setExplanationSize 30;
+ setAnnotationSize 20;
+ setFontIncAnnot 0;
+ setFontIncExp 0;
+ getToolPalette;
+ tell It;
+ setTool mesquite.categ.StateNamesEditor.StateNamesWindow.ibeam;
+ endTell;
+ rowsAreCharacters on;
+ toggleConstrainChar on;
+ toggleConstrainCharNum 3;
+ togglePanel off;
+ endTell;
+ showWindow;
+ endTell;
+ getEmployee #mesquite.categ.StateNamesStrip.StateNamesStrip;
+ tell It;
+ showStrip off;
+ endTell;
+ getEmployee #mesquite.charMatrices.AnnotPanel.AnnotPanel;
+ tell It;
+ togglePanel off;
+ endTell;
+ getEmployee #mesquite.charMatrices.ColorCells.ColorCells;
+ tell It;
+ setColor Red;
+ removeColor off;
+ endTell;
+ getEmployee #mesquite.charMatrices.QuickKeySelector.QuickKeySelector;
+ tell It;
+ autotabOff;
+ endTell;
+ endTell;
+ endTell;
+ getEmployee #mesquite.trees.BasicTreeWindowCoord.BasicTreeWindowCoord;
+ tell It;
+ makeTreeWindow #9015005506118934442 #mesquite.trees.BasicTreeWindowMaker.BasicTreeWindowMaker;
+ tell It;
+ setTreeSource #mesquite.trees.StoredTrees.StoredTrees;
+ tell It;
+ setTreeBlock 1;
+ toggleUseWeights off;
+ endTell;
+ setAssignedID 630.1180487973731.4514395117633566598;
+ getTreeWindow;
+ tell It;
+ setSize 520 400;
+ setLocation 60 10;
+ setFont SanSerif;
+ setFontSize 10;
+ onInfoBar;
+ setExplanationSize 30;
+ setAnnotationSize 20;
+ setFontIncAnnot 0;
+ setFontIncExp 0;
+ getToolPalette;
+ tell It;
+ endTell;
+ setActive;
+ getTreeDrawCoordinator #mesquite.trees.BasicTreeDrawCoordinator.BasicTreeDrawCoordinator;
+ tell It;
+ suppress;
+ setTreeDrawer #mesquite.trees.DiagonalDrawTree.DiagonalDrawTree;
+ tell It;
+ setEdgeWidth 12;
+ orientUp;
+ getEmployee #mesquite.trees.NodeLocsStandard.NodeLocsStandard;
+ tell It;
+ stretchToggle off;
+ branchLengthsToggle off;
+ toggleScale on;
+ toggleCenter off;
+ toggleEven off;
+ namesAngle ?;
+ endTell;
+ endTell;
+ setBackground White;
+ setBranchColor Black;
+ showNodeNumbers off;
+ labelBranchLengths off;
+ desuppress;
+ getEmployee #mesquite.trees.BasicDrawTaxonNames.BasicDrawTaxonNames;
+ tell It;
+ setColor Black;
+ toggleColorPartition on;
+ toggleShadePartition off;
+ toggleNodeLabels on;
+ toggleShowNames on;
+ endTell;
+ endTell;
+ setTreeNumber 1;
+ useSuggestedSize on;
+ toggleTextOnTree off;
+ newAssistant #mesquite.ancstates.TraceCharacterHistory.TraceCharacterHistory;
+ tell It;
+ suspend ;
+ setDisplayMode #mesquite.ancstates.ShadeStatesOnTree.ShadeStatesOnTree;
+ tell It;
+ toggleLabels off;
+ endTell;
+ setHistorySource #mesquite.ancstates.RecAncestralStates.RecAncestralStates;
+ tell It;
+ getCharacterSource #mesquite.charMatrices.CharSrcCoordObed.CharSrcCoordObed;
+ tell It;
+ setCharacterSource #mesquite.charMatrices.StoredCharacters.StoredCharacters;
+ tell It;
+ setDataSet #1161953040649633474;
+ endTell;
+ endTell;
+ setMethod #mesquite.parsimony.ParsAncestralStates.ParsAncestralStates;
+ tell It;
+ setModelSource #mesquite.parsimony.CurrentParsModels.CurrentParsModels;
+ endTell;
+ endTell;
+ setCharacter 1;
+ toggleShowLegend on;
+ toggleGray off;
+ toggleWeights on;
+ setInitialOffsetX -162;
+ setInitialOffsetY -177;
+ setLegendWidth 142;
+ setLegendHeight 177;
+ resume ;
+ endTell;
+ endTell;
+ showWindow;
+ getEmployee #mesquite.ornamental.BranchNotes.BranchNotes;
+ tell It;
+ setAlwaysOn off;
+ endTell;
+ getEmployee #mesquite.trees.ColorBranches.ColorBranches;
+ tell It;
+ setColor Red;
+ removeColor off;
+ endTell;
+ endTell;
+ endTell;
+ endTell;
+end;
+
+begin brownie;
+taxset all=1-18;
+end;
diff --git a/man/MRCA.Rd b/man/MRCA.Rd
new file mode 100644
index 0000000..12b3e89
--- /dev/null
+++ b/man/MRCA.Rd
@@ -0,0 +1,47 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/MRCA-methods.R
+\docType{methods}
+\name{MRCA}
+\alias{MRCA}
+\alias{MRCA,phylo4-method}
+\alias{MRCA,phylo-method}
+\title{MRCA}
+\usage{
+MRCA(phy, ...)
+
+\S4method{MRCA}{phylo4}(phy, ...)
+
+\S4method{MRCA}{phylo}(phy, ...)
+}
+\arguments{
+\item{phy}{a phylogenetic tree in phylo4, phylo4d or phylo format.}
+
+\item{...}{a vector of nodes}
+}
+\value{
+the node corresponding to the most recent common ancestor
+}
+\description{
+Most Recent Common Ancestor (MRCA) of 2 or more nodes.
+}
+\details{
+Given some nodes (i.e., tips and/or internal), this function
+returns the node corresponding to the most recent common ancestor.
+
+If \code{phy} is a \code{phylo4} or \code{phylo4d} object, the
+nodes can contain both numeric or character values that will be
+used by \code{getNode} to retrieve the correct node. However, if
+\code{phy} is a \code{phylo} object, the nodes must be a numeric
+vector.
+
+With \code{phylo4} and \code{phylo4d} objects, if a single node is
+provided, it will be returned.
+}
+\examples{
+ data(geospiza)
+ MRCA(geospiza, 1, 5)
+ MRCA(geospiza, "fortis", 11)
+ MRCA(geospiza, 2, 4, "fusca", 3)
+ geo <- as(geospiza, "phylo")
+ MRCA(geo, c(1,5))
+}
diff --git a/man/addData-methods.Rd b/man/addData-methods.Rd
new file mode 100644
index 0000000..9aa30d2
--- /dev/null
+++ b/man/addData-methods.Rd
@@ -0,0 +1,79 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/addData-methods.R
+\docType{methods}
+\name{addData}
+\alias{addData}
+\alias{addData,phylo4d-method}
+\alias{addData-methods}
+\alias{addData,phylo4-method}
+\alias{addData,phylo4-method}
+\alias{addData,phylo4d-method}
+\title{Adding data to a phylo4 or a phylo4d object}
+\usage{
+addData(x, ...)
+
+\S4method{addData}{phylo4d}(x, tip.data = NULL, node.data = NULL,
+ all.data = NULL, merge.data = TRUE, pos = c("after", "before"), ...)
+
+\S4method{addData}{phylo4}(x, tip.data = NULL, node.data = NULL,
+ all.data = NULL, merge.data = TRUE, pos = c("after", "before"), ...)
+}
+\arguments{
+\item{x}{a phylo4 or a phylo4d object}
+
+\item{\dots}{additional arguments to control how matching between
+data and tree (see Details section of
+\code{\link{phylo4d-methods}} for more details).}
+
+\item{tip.data}{a data frame (or object to be coerced to one)
+containing only tip data}
+
+\item{node.data}{a data frame (or object to be coerced to one)
+containing only node data}
+
+\item{all.data}{a data frame (or object to be coerced to one)
+containing both tip and node data}
+
+\item{merge.data}{if both \code{tip.data} and \code{node.data} are
+provided, it determines whether columns with common names will be
+merged together (default TRUE). If FALSE, columns with common
+names will be preserved separately, with ".tip" and ".node"
+appended to the names. This argument has no effect if
+\code{tip.data} and \code{node.data} have no column names in
+common.}
+
+\item{pos}{should the new data provided be bound \code{before} or
+\code{after} the pre-existing data?}
+}
+\value{
+\code{addData} returns a \code{phylo4d} object.
+}
+\description{
+\code{addData} adds data to a \code{phylo4} (converting it in a
+\code{phylo4d} object) or to a \code{phylo4d} object
+}
+\details{
+Rules for matching data to tree nodes are identical to those used
+by the \code{\link{phylo4d-methods}} constructor.
+
+If any column names in the original data are the same as columns
+in the new data, ".old" is appended to the former column names and
+".new" is appended to the new column names.
+
+The option \code{pos} is ignored (silently) if \code{x} is a
+\code{phylo4} object. It is provided for compatibility reasons.
+}
+\examples{
+ data(geospiza)
+ nDt <- data.frame(a=rnorm(nNodes(geospiza)), b=1:nNodes(geospiza),
+ row.names=nodeId(geospiza, "internal"))
+ t1 <- addData(geospiza, node.data=nDt)
+}
+\seealso{
+\code{\link{tdata}} for extracting or updating data and
+\code{\link{phylo4d-methods}} constructor.
+}
+\author{
+Francois Michonneau
+}
+\keyword{methods}
diff --git a/man/ancestors.Rd b/man/ancestors.Rd
new file mode 100644
index 0000000..39a4ac3
--- /dev/null
+++ b/man/ancestors.Rd
@@ -0,0 +1,110 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ancestors.R
+\name{ancestor}
+\alias{ancestor}
+\alias{children}
+\alias{descendants}
+\alias{siblings}
+\alias{ancestors}
+\alias{siblings}
+\title{Tree traversal and utility functions}
+\usage{
+ancestor(phy, node)
+
+children(phy, node)
+
+descendants(phy, node, type = c("tips", "children", "all", "ALL"))
+
+siblings(phy, node, include.self = FALSE)
+
+ancestors(phy, node, type = c("all", "parent", "ALL"))
+}
+\arguments{
+\item{phy}{a \linkS4class{phylo4} object (or one inheriting from
+\linkS4class{phylo4}, e.g. a \linkS4class{phylo4d} object)}
+
+\item{node}{either an integer corresponding to a node ID number, or a
+character corresponding to a node label; for \code{ancestors} and
+\code{descendants}, this may be a vector of multiple node numbers or names}
+
+\item{type}{(\code{ancestors}) specify whether to return just direct
+ancestor ("parent"), all ancestor nodes ("all"), or all ancestor nodes
+including self ("ALL"); (\code{descendants}) specify whether to return just
+direct descendants ("children"), all extant descendants ("tips"), or all
+descendant nodes ("all") or all descendant nodes including self ("ALL").}
+
+\item{include.self}{whether to include self in list of siblings}
+
+\item{\dots}{a list of node numbers or names, or a vector of node numbers or
+names}
+}
+\value{
+\describe{
+\item{\code{ancestors}}{ return a named vector (or a list
+of such vectors in the case of multiple input nodes) of the
+ancestors and descendants of a node}
+
+\item{\code{descendants}}{ return a named vector (or a list of
+such vectors in the case of multiple input nodes) of the ancestors
+and descendants of a node}
+
+\item{\code{ancestor}}{ \code{ancestor} is analogous to
+\code{ancestors(\dots{}, type="parent")} (i.e. direct ancestor
+only), but returns a single concatenated vector in the case of
+multiple input nodes}
+
+\item{\code{children}}{is analogous to \code{descendants(\dots{},
+type="children")} (i.e. direct descendants only), but is not
+currently intended to be used with multiple input nodes }
+
+\item{\code{siblings}}{ returns sibling nodes (children of the same
+parent)}
+}
+}
+\description{
+Functions for describing relationships among phylogenetic nodes (i.e.
+internal nodes or tips).
+}
+\details{
+\code{ancestors} and \code{descendants} can take \code{node} vectors of
+arbitrary length, returning a list of output vectors if the number of valid
+input nodes is greater than one. List element names are taken directly from
+the input node vector.
+
+If any supplied nodes are not found in the tree, the behavior currently
+varies across functions.
+\itemize{
+\item Invalid nodes are automatically omitted by \code{ancestors}
+and \code{descendants}, with a warning.
+
+\item \code{ancestor}
+will return \code{NA} for any invalid nodes, with a warning.
+
+\item Both \code{children} and \code{siblings} will return an empty
+vector, again with a warning.
+}
+}
+\examples{
+
+ data(geospiza)
+ nodeLabels(geospiza) <- LETTERS[1:nNodes(geospiza)]
+ plot(as(geospiza, "phylo4"), show.node.label=TRUE)
+ ancestor(geospiza, "E")
+ children(geospiza, "C")
+ descendants(geospiza, "D", type="tips")
+ descendants(geospiza, "D", type="all")
+ ancestors(geospiza, "D")
+ MRCA(geospiza, "conirostris", "difficilis", "fuliginosa")
+ MRCA(geospiza, "olivacea", "conirostris")
+
+ ## shortest path between 2 nodes
+ shortestPath(geospiza, "fortis", "fuliginosa")
+ shortestPath(geospiza, "F", "L")
+
+ ## branch length from a tip to the root
+ sumEdgeLength(geospiza, ancestors(geospiza, "fortis", type="ALL"))
+}
+\seealso{
+\code{\link[ape]{mrca}}, in the ape package, gives a list of all
+subtrees
+}
diff --git a/man/checkPhylo4.Rd b/man/checkPhylo4.Rd
new file mode 100644
index 0000000..a5f6c78
--- /dev/null
+++ b/man/checkPhylo4.Rd
@@ -0,0 +1,59 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/checkdata.R
+\name{checkPhylo4}
+\alias{checkPhylo4}
+\alias{checkTree}
+\alias{checkPhylo4Data}
+\title{Validity checking for phylo4 objects}
+\usage{
+checkPhylo4(object)
+}
+\arguments{
+\item{object}{A prospective phylo4 or phylo4d object}
+}
+\value{
+As required by \code{\link[methods]{validObject}}, returns an error
+string (describing problems) or TRUE if everything is OK.
+}
+\description{
+Basic checks on the validity of S4 phylogenetic objects
+}
+\note{
+These functions are only intended to be called by other phylobase functions.
+
+\code{checkPhylo4} is an (inflexible) wrapper for
+\code{checkTree}. The rules for \code{phylo4} objects essentially
+follow those for \code{phylo} objects from the \code{ape} package,
+which are in turn defined in
+\url{http://ape-package.ird.fr/misc/FormatTreeR_24Oct2012.pdf}.
+These are essentially that: \itemize{ \item if the tree has edge
+lengths defined, the number of edge lengths must match the number
+of edges; \item the number of tip labels must match the number of
+tips; \item in a tree with \code{ntips} tips and \code{nnodes}
+(total) nodes, nodes 1 to \code{ntips} must be tips \item if the
+tree is rooted, the root must be node number \code{ntips+1} and
+the root node must be the first row of the edge matrix \item tip
+labels, node labels, edge labels, edge lengths must have proper
+internal names (i.e. internal names that match the node numbers
+they document) \item tip and node labels must be unique }
+
+You can alter some of the default options by using the function
+\code{phylobase.options}.
+
+For \code{phylo4d} objects, \code{checkTree} also calls
+\code{checkPhylo4Data} to check the validity of the data associated with the
+tree. It ensures that (1) the data associated with the tree have the correct
+dimensions, (2) that the row names for the data are correct.
+}
+\seealso{
+the \code{\link{phylo4}} constructor and
+\linkS4class{phylo4} class; the \code{\link{phylo4d-methods}} constructor
+and the \linkS4class{phylo4d} class do checks for the data
+associated with trees. See \code{\link{coerce-methods}} for
+translation functions and \code{\link{phylobase.options} to change
+some of the default options of the validator.}
+}
+\author{
+Ben Bolker, Steven Kembel, Francois Michonneau
+}
+\keyword{misc}
diff --git a/man/edgeLength-methods.Rd b/man/edgeLength-methods.Rd
new file mode 100644
index 0000000..c78d73f
--- /dev/null
+++ b/man/edgeLength-methods.Rd
@@ -0,0 +1,150 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/edgeLength-methods.R
+\docType{methods}
+\name{hasEdgeLength}
+\alias{hasEdgeLength}
+\alias{hasEdgeLength,phylo4-method}
+\alias{edgeLength}
+\alias{edgeLength,phylo4-method}
+\alias{edgeLength<-}
+\alias{edgeLength<-}
+\alias{edgeLength<-,phylo4-method}
+\alias{edgeLength<-,phylo4,ANY-method}
+\alias{depthTips}
+\alias{depthTips,phylo4-method}
+\alias{depthTips,phylo4-methods}
+\alias{nodeDepth}
+\alias{nodeDepth,phylo4-method}
+\alias{nodeHeight}
+\alias{nodeHeight,phylo4-method}
+\alias{sumEdgeLength}
+\alias{sumEdgeLength,phylo4-method}
+\alias{isUltrametric}
+\alias{isUltrametric,phylo4-method}
+\title{edgeLength methods}
+\usage{
+hasEdgeLength(x)
+
+\S4method{hasEdgeLength}{phylo4}(x)
+
+edgeLength(x, ...)
+
+\S4method{edgeLength}{phylo4}(x, node)
+
+edgeLength(x, use.names = TRUE, ...) <- value
+
+\S4method{edgeLength}{phylo4}(x, use.names = TRUE, ...) <- value
+
+depthTips(x)
+
+\S4method{depthTips}{phylo4}(x)
+
+nodeDepth(x, node)
+
+\S4method{nodeDepth}{phylo4}(x, node)
+
+nodeHeight(x, node, from)
+
+\S4method{nodeHeight}{phylo4}(x, node, from = c("root", "all_tip", "min_tip",
+ "max_tip"))
+
+sumEdgeLength(x, node)
+
+\S4method{sumEdgeLength}{phylo4}(x, node)
+
+isUltrametric(x, tol = .Machine$double.eps^0.5)
+
+\S4method{isUltrametric}{phylo4}(x, tol = .Machine$double.eps^0.5)
+}
+\arguments{
+\item{x}{a \code{phylo4} or \code{phylo4d} object.}
+
+\item{\dots}{optional arguments (none used at present).}
+
+\item{node}{optional numeric or character vector indicating the
+nodes for which edge}
+
+\item{use.names}{should the the name attributes of \code{value} be
+used to match the length to a given edge.}
+
+\item{value}{a numeric vector indicating the new values for the edge lengths}
+
+\item{from}{The point of reference for calculating the height of
+the node. \code{root} calculates the distance between the root of
+the tree and the node. \code{all_tip} return the distance between
+the node and all the tips descending from it. \code{min_tip} the
+distance between the node and its closest tip. \code{max_tip} the
+distance between the node and its farther tip. \code{min_tip} and
+\code{max_tip} will be identical if the tree is ultrametric. If
+more than one tip is equidistant from the node, the tip with the
+lowest node id will be returned.}
+
+\item{tol}{the tolerance to decide whether all the tips have the
+same depth to test if the tree is ultrametric. Default is
+\code{.Machine$double.eps^0.5}.}
+}
+\value{
+\describe{
+
+\item{hasEdgeLength}{whether or not the object has edge lengths
+(logical)}
+
+\item{edgeLength}{a named vector of the edge length for the
+object}
+
+\item{isUltrametric}{whether or not the tree is ultrametric (all
+the tips are have the same depth (distance from the root) (logical)}
+
+\item{sumEdgeLength}{the sum of the edge lengths for a set of
+nodes (intended to be used with \code{ancestors} or \code{descendants})}
+
+\item{nodeHeight}{the distance between a node and the root or the
+tips. The format of the result will depend on the options and the
+number of nodes provided, either a vector or a list.}
+
+ \item{nodeDepth}{Deprecated, now replaced by \code{nodeHeight}. A
+named vector indicating the \dQuote{depth} (the distance between
+the root and a given node).}
+
+\item{depthTip}{Deprecated, now replaced by \code{nodeHeight}.}
+
+}
+}
+\description{
+These functions give information about and allow replacement of edge lengths.
+}
+\details{
+The \code{edgeLength} function returns the edge length in the same
+order as the edges in the matrix.
+}
+\examples{
+ data(geospiza)
+ hasEdgeLength(geospiza) # TRUE
+ topoGeo <- geospiza
+ edgeLength(topoGeo) <- NULL
+ hasEdgeLength(topoGeo) # FALSE
+
+ edgeLength(geospiza)[2] # use the position in vector
+ edgeLength(geospiza)["16-17"] # or the name of the edge
+ edgeLength(geospiza, 17) # or the descendant node of the edge
+
+ ## The same methods can be used to update an edge length
+ edgeLength(geospiza)[2] <- 0.33
+ edgeLength(geospiza)["16-17"] <- 0.34
+ edgeLength(geospiza, 17) <- 0.35
+
+ ## Test if tree is ultrametric
+ isUltrametric(geospiza) # TRUE
+ ## indeed all tips are at the same distance from the root
+ nodeHeight(geospiza, nodeId(geospiza, "tip"), from="root")
+ ## compare distances from tips of two MRCA
+ nodeHeight(geospiza, MRCA(geospiza, c("pallida", "psittacula")), from="min_tip")
+ nodeHeight(geospiza, MRCA(geospiza, c("fortis", "difficilis")), from="min_tip")
+ ## or the same but from the root
+ nodeHeight(geospiza, MRCA(geospiza, c("pallida", "psittacula")), from="root")
+ nodeHeight(geospiza, MRCA(geospiza, c("fortis", "difficilis")), from="root")
+}
+\seealso{
+\code{ancestors}, \code{descendants}, \code{.Machine} for
+more information about tolerance.
+}
diff --git a/man/edges-accessors.Rd b/man/edges-accessors.Rd
new file mode 100644
index 0000000..5ed4322
--- /dev/null
+++ b/man/edges-accessors.Rd
@@ -0,0 +1,73 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/phylo4-accessors.R
+\docType{methods}
+\name{edges}
+\alias{edges}
+\alias{edges,phylo4-method}
+\alias{edgeOrder}
+\alias{edgeOrder,phylo4-method}
+\alias{internalEdges}
+\alias{internalEdges,phylo4-method}
+\alias{terminalEdges}
+\alias{terminalEdges,phylo4-method}
+\title{Edges accessors}
+\usage{
+edges(x, ...)
+
+\S4method{edges}{phylo4}(x, drop.root = FALSE)
+
+edgeOrder(x, ...)
+
+\S4method{edgeOrder}{phylo4}(x)
+
+internalEdges(x)
+
+\S4method{internalEdges}{phylo4}(x)
+
+terminalEdges(x)
+
+\S4method{terminalEdges}{phylo4}(x)
+}
+\arguments{
+\item{x}{a \code{phylo4} or \code{phylo4d} object.}
+
+\item{\dots}{Optional arguments used by specific methods. (None
+used at present).}
+
+\item{drop.root}{logical (default FALSE), should the edge
+connecting the root be included in the edge matrix?}
+}
+\value{
+\describe{
+\item{\code{edges}}{returns the edge matrix that represent the
+ancestor-descendant relationships among the nodes of the tree.}
+
+\item{\code{edgeOrder}}{returns the order in which the edge matrix
+is in.}
+
+\item{\code{internalEdges}}{returns a logical vector indicating
+internal edges (edges that connect an internal node to
+another). This vector is named with the \code{edgeId}}.
+
+\item{\code{terminalEdges}}{returns a logical vector indicating
+terminal edges (edges that connect an internal node to a
+tip). This vector is named with the \code{edgeId} }}
+}
+\description{
+Access or modify information about the edges.
+}
+\examples{
+ data(geospiza)
+ edges(geospiza)
+ edgeOrder(geospiza)
+ geoPost <- reorder(geospiza, "postorder")
+ edgeOrder(geoPost)
+ ## with a binary tree this should always be true
+ identical(!terminalEdges(geospiza), internalEdges(geospiza))
+}
+\seealso{
+reorder, edgeId
+}
+\author{
+Ben Bolker, Francois Michonneau, Thibaut Jombart
+}
diff --git a/man/extractTree.Rd b/man/extractTree.Rd
new file mode 100644
index 0000000..3bd93c6
--- /dev/null
+++ b/man/extractTree.Rd
@@ -0,0 +1,45 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/extractTree.R
+\name{extractTree}
+\alias{extractTree}
+\title{Get tree from tree+data object}
+\usage{
+extractTree(from)
+}
+\arguments{
+\item{from}{a \code{phylo4d} object, containing a phylogenetic
+tree plus associated phenotypic data. Created by the
+\code{phylo4d()} function.}
+}
+\description{
+Extracts a \code{phylo4} tree object from a \code{phylo4d}
+tree+data object.
+}
+\details{
+\code{extractTree} extracts just the phylogeny from a tree+data
+object. The phylogeny contains the topology (how the nodes are
+linked together), the branch lengths (if any), and any tip and/or
+node labels. This may be useful for extracting a tree from a
+\code{phylo4d} object, and associating with another phenotypic
+dataset, or to convert the tree to another format.
+}
+\examples{
+tree.phylo <- ape::read.tree(text = "((a,b),c);")
+tree <- as(tree.phylo, "phylo4")
+plot(tree)
+tip.data <- data.frame(size = c(1, 2, 3), row.names = c("a", "b", "c"))
+(treedata <- phylo4d(tree, tip.data))
+plot(treedata)
+(tree1 <- extractTree(treedata))
+plot(tree1)
+
+}
+\seealso{
+\code{\link{phylo4-methods}},
+\code{\link{phylo4d-methods}}, \code{\link{coerce-methods}} for
+translation functions.
+}
+\author{
+Ben Bolker
+}
+\keyword{methods}
diff --git a/man/formatData.Rd b/man/formatData.Rd
new file mode 100644
index 0000000..2cb9e57
--- /dev/null
+++ b/man/formatData.Rd
@@ -0,0 +1,88 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/formatData.R
+\name{formatData}
+\alias{formatData}
+\title{Format data for use in phylo4d objects}
+\usage{
+formatData(phy, dt, type = c("tip", "internal", "all"), match.data = TRUE,
+ rownamesAsLabels = FALSE, label.type = c("rownames", "column"),
+ label.column = 1, missing.data = c("fail", "warn", "OK"),
+ extra.data = c("warn", "OK", "fail"), keep.all = TRUE)
+}
+\arguments{
+\item{phy}{a valid \code{phylo4} object}
+
+\item{dt}{a data frame, matrix, vector, or factor}
+
+\item{type}{type of data to attach}
+
+\item{match.data}{(logical) should the rownames of the data frame
+be used to be matched against tip and internal node identifiers?
+See details.}
+
+\item{rownamesAsLabels}{(logical), should the row names of the
+data provided be matched only to labels (TRUE), or should any
+number-like row names be matched to node numbers (FALSE and
+default)}
+
+\item{label.type}{character, \code{rownames} or \code{column}:
+should the labels be taken from the row names of \code{dt} or from
+the \code{label.column} column of \code{dt}?}
+
+\item{label.column}{if \code{label.type=="column"}, column
+specifier (number or name) of the column containing tip labels}
+
+\item{missing.data}{action to take if there are missing data or if
+there are data labels that don't match}
+
+\item{extra.data}{action to take if there are extra data or if
+there are labels that don't match}
+
+\item{keep.all}{(logical), should the returned data have rows for
+all nodes (with NA values for internal rows when type='tip', and
+vice versa) (TRUE and default) or only rows corresponding to the
+type argument}
+}
+\value{
+\code{formatData} returns a data frame having node numbers
+as row names. The data frame is also formatted to have the correct
+dimension given the \code{phylo4} object provided.
+}
+\description{
+Associates data with tree nodes and applies consistent formatting
+rules.
+}
+\details{
+\code{formatData} is an internal function that should not be
+called directly by the user. It is used to format data provided by
+the user before associating it with a tree, and is called
+internally by the \code{phylo4d}, \code{tdata}, and \code{addData}
+methods. However, users may pass additional arguments to these
+methods in order to control how the data are matched to nodes.
+
+Rules for matching rows of data to tree nodes are determined
+jointly by the \code{match.data} and \code{rownamesAsLabels}
+arguments. If \code{match.data} is TRUE, data frame rows will be
+matched exclusively against tip and node labels if
+\code{rownamesAsLabels} is also TRUE, whereas any all-digit row
+names will be matched against tip and node numbers if
+\code{rownamesAsLabels} is FALSE (the default). If
+\code{match.data} is FALSE, \code{rownamesAsLabels} has no effect,
+and row matching is purely positional with respect to the order
+returned by \code{nodeId(phy, type)}.
+
+\code{formatData} (1) converts labels provided in the data into
+node numbers, (2) makes sure that the data are appropriately
+matched against tip and/or internal nodes, (3) checks for
+differences between data and tree, (4) creates a data frame with
+the correct dimensions given a tree.
+}
+\seealso{
+the \code{\link{phylo4d-methods}} constructor, the
+\linkS4class{phylo4d} class. See \code{\link{coerce-methods}} for
+translation functions.
+}
+\author{
+Francois Michonneau
+}
+\keyword{misc}
diff --git a/man/geospiza.Rd b/man/geospiza.Rd
new file mode 100644
index 0000000..1128dda
--- /dev/null
+++ b/man/geospiza.Rd
@@ -0,0 +1,29 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/phylobase-package.R
+\docType{data}
+\name{geospiza}
+\alias{geospiza}
+\alias{geospiza_raw}
+\title{Data from Darwin's finches}
+\format{\code{geospiza} is a \code{phylo4d} object; \code{geospiza_raw} is a
+list containing \code{tree}, a \code{phylo} object (the tree), \code{data},
+and a data frame with the data (for showing examples of how to merge tree
+and data)}
+\source{
+Dolph Schluter via Luke Harmon
+}
+\description{
+Phylogenetic tree and morphological data for Darwin's finches, in different
+formats
+}
+\note{
+Stolen from Luke Harmon's Geiger package, to avoid unnecessary
+dependencies
+}
+\examples{
+
+data(geospiza)
+plot(geospiza)
+
+}
+\keyword{datasets}
diff --git a/man/getNode-methods.Rd b/man/getNode-methods.Rd
new file mode 100644
index 0000000..28e69a2
--- /dev/null
+++ b/man/getNode-methods.Rd
@@ -0,0 +1,104 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/getNode-methods.R
+\docType{methods}
+\name{getNode}
+\alias{getNode}
+\alias{getNode,phylo4-method}
+\alias{getEdge}
+\alias{getEdge-methods}
+\alias{getEdge}
+\alias{getEdge,phylo4-method}
+\title{Node and Edge look-up functions}
+\usage{
+getNode(x, node, type = c("all", "tip", "internal"), missing = c("warn",
+ "OK", "fail"))
+
+\S4method{getNode}{phylo4}(x, node, type = c("all", "tip", "internal"),
+ missing = c("warn", "OK", "fail"))
+
+getEdge(x, node, type = c("descendant", "ancestor"), missing = c("warn",
+ "OK", "fail"))
+
+\S4method{getEdge}{phylo4}(x, node, type = c("descendant", "ancestor"),
+ missing = c("warn", "OK", "fail"))
+}
+\arguments{
+\item{x}{a \linkS4class{phylo4} object (or one inheriting from
+\linkS4class{phylo4}, e.g. a \linkS4class{phylo4d} object)}
+
+\item{node}{either an integer vector corresponding to node ID numbers, or a
+character vector corresponding to node labels; if missing, all nodes
+appropriate to the specified type will be returned by \code{getNode}, and
+all edges appropriate to the specified type will be returned by
+\code{getEdge}.}
+
+\item{type}{(\code{getNode}) specify whether to return nodes matching "all"
+tree nodes (default), only "tip" nodes, or only "internal" nodes;
+(\code{nodeId, edgeId}) specify whether to return "all" tree nodes, or only
+those corresponding to "tip", "internal", or "root" nodes; (\code{getEdge})
+specify whether to look up edges based on their descendant node
+("descendant") or ancestral node ("ancestor")}
+
+\item{missing}{what to do if some requested node IDs or names are not in the
+tree: warn, do nothing, or stop with an error}
+}
+\value{
+\item{list("getNode")}{returns a named integer vector of node IDs,
+in the order of input nodes if provided, otherwise in nodeId order}
+\item{list("getEdge")}{returns a named character vector of edge IDs, in the
+order of input nodes if provide, otherwise in nodeId order}
+\item{list("nodeId")}{returns an unnamed integer vector of node IDs, in
+ascending order} \item{list("getEdge")}{returns an unnamed character vector
+of edge IDs, in edge matrix order}
+}
+\description{
+Functions for retrieving node and edge IDs (possibly with corresponding
+labels) from a phylogenetic tree.
+}
+\details{
+\code{getNode} and \code{getEdge} are primarily intended for looking up the
+IDs either of nodes themselves or of edges associated with those nodes. Note
+that they behave quite differently. With \code{getNode}, any input nodes are
+looked up against tree nodes of the specified type, and those that match are
+returned as numeric node IDs with node labels (if they exist) as element
+names. With \code{getEdge}, any input nodes are looked up against edge ends
+of the specified type, and those that match are returned as character edge
+IDs with the corresponding node ID as element names.
+
+If \code{missing} is \dQuote{warn} or \dQuote{OK}, \code{NA} is returned for
+any nodes that are unmatched for the specified type. This can provide a
+mechanism for filtering a set of nodes or edges.
+
+\code{nodeId} provides similar output to \code{getNode} in the case when no
+node is supplied, but it is faster and returns an unnamed vector of the
+numeric IDs of all nodes of the specified node type. Similarly,
+\code{edgeId} simply returns an unnamed vector of the character IDs of all
+edges for which the descendant node is of the specified node type.
+}
+\examples{
+
+ data(geospiza)
+ nodeLabels(geospiza) <- LETTERS[1:nNodes(geospiza)]
+ plot(as(geospiza, "phylo4"), show.node.label=TRUE)
+ getNode(geospiza, 18)
+ getNode(geospiza, "D")
+ getEdge(geospiza, "D")
+ getEdge(geospiza, "D", type="ancestor")
+
+ ## match nodes only to tip nodes, flagging invalid cases as NA
+ getNode(geospiza, c(1, 18, 999), type="tip", missing="OK")
+
+ ## get all edges that descend from internal nodes
+ getEdge(geospiza, type="ancestor")
+
+ ## identify an edge from its terminal node
+ getEdge(geospiza, c("olivacea", "B", "fortis"))
+ getNode(geospiza, c("olivacea", "B", "fortis"))
+ edges(geospiza)[c(26, 1, 11),]
+
+ ## quickly get all tip node IDs and tip edge IDs
+ nodeId(geospiza, "tip")
+ edgeId(geospiza, "tip")
+
+}
+\keyword{misc}
diff --git a/man/labels-methods.Rd b/man/labels-methods.Rd
new file mode 100644
index 0000000..19733ca
--- /dev/null
+++ b/man/labels-methods.Rd
@@ -0,0 +1,165 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/labels-methods.R
+\docType{methods}
+\name{phylo4-labels}
+\alias{phylo4-labels}
+\alias{labels}
+\alias{labels,phylo4-method}
+\alias{labels<-}
+\alias{labels<-,phylo4-method}
+\alias{hasDuplicatedLabels}
+\alias{hasDuplicatedLabels,phylo4-method}
+\alias{hasDuplicatedLabels,phylo4,ANY-method}
+\alias{hasNodeLabels}
+\alias{hasNodeLabels,phylo4-method}
+\alias{nodeLabels}
+\alias{nodeLabels,phylo4-method}
+\alias{nodeLabels<-}
+\alias{nodeLabels<-,phylo4-method}
+\alias{tipLabels}
+\alias{tipLabels,phylo4-method}
+\alias{tipLabels<-}
+\alias{tipLabels<-,phylo4-method}
+\alias{hasEdgeLabels}
+\alias{hasEdgeLabels,phylo4-method}
+\alias{edgeLabels}
+\alias{edgeLabels,phylo4-method}
+\alias{edgeLabels<-}
+\alias{edgeLabels<-,phylo4-method}
+\title{Labels for phylo4/phylo4d objects}
+\usage{
+labels(object, ...)
+
+\S4method{labels}{phylo4}(object, type = c("all", "tip", "internal"))
+
+labels(x, type, use.names, ...) <- value
+
+\S4method{labels}{phylo4}(x, type = c("all", "tip", "internal"), use.names,
+ ...) <- value
+
+hasDuplicatedLabels(x, type)
+
+\S4method{hasDuplicatedLabels}{phylo4}(x, type = c("all", "tip", "internal"))
+
+hasNodeLabels(x)
+
+\S4method{hasNodeLabels}{phylo4}(x)
+
+nodeLabels(x)
+
+\S4method{nodeLabels}{phylo4}(x)
+
+nodeLabels(x, ...) <- value
+
+\S4method{nodeLabels}{phylo4}(x, ...) <- value
+
+tipLabels(x)
+
+\S4method{tipLabels}{phylo4}(x)
+
+tipLabels(x, ...) <- value
+
+\S4method{tipLabels}{phylo4}(x, ...) <- value
+
+hasEdgeLabels(x)
+
+\S4method{hasEdgeLabels}{phylo4}(x)
+
+edgeLabels(x)
+
+\S4method{edgeLabels}{phylo4}(x)
+
+edgeLabels(x, ...) <- value
+
+\S4method{edgeLabels}{phylo4}(x, ...) <- value
+}
+\arguments{
+\item{object}{a phylo4 or phylo4d object.}
+
+\item{\dots}{additional optional arguments (not in use)}
+
+\item{type}{which type of labels: \code{all} (tips and internal nodes),
+\code{tip} (tips only), \code{internal} (internal nodes only).}
+
+\item{x}{a phylo4 or phylo4d object.}
+
+\item{use.names}{should the names of the vector used to create/update labels
+be used to match the labels? See Details for more information.}
+
+\item{value}{a vector of class \code{character}, see Details for more
+information.}
+}
+\value{
+labels in ascending order.
+}
+\description{
+Methods for creating, accessing and updating labels in
+phylo4/phylo4d objects
+}
+\details{
+In phylo4/phylo4d objects, tips must have labels (that's why there
+is no method for hasTipLabels), internal nodes and edges can have
+labels.
+
+Labels must be provided as a vector of class \code{character}. The
+length of the vector must match the number of elements they label.
+
+The option \code{use.names} allows the user to match a label to a
+particular node. In this case, the vector must have names that
+match the node numbers.
+
+The function \code{labels} is mostly intended to be used
+internally.
+}
+\section{Methods}{
+ \describe{ \item{labels}{\code{signature(object =
+"phylo4")}: tip and/or internal node labels, ordered by node ID}
+
+\item{hasDuplicatedLabels}{\code{signature(object = "phylo4")}: are any
+labels duplicated?}
+
+\item{tipLabels}{\code{signature(object = "phylo4")}: tip labels, ordered by
+node ID}
+
+\item{hasNodeLabels}{\code{signature(object = "phylo4")}: whether tree has
+(internal) node labels} \item{nodeLabels}{\code{signature(object =
+"phylo4")}: internal node labels, ordered by node ID}
+
+\item{hasEdgeLabels}{\code{signature(object = "phylo4")}: whether tree has
+(internal) edge labels} \item{edgeLabels}{\code{signature(object =
+"phylo4")}: internal edge labels, ordered according to the edge matrix} }
+}
+
+\examples{
+
+data(geospiza)
+
+## Return labels from geospiza
+tipLabels(geospiza)
+
+## Internal node labels in geospiza are empty
+nodeLabels(geospiza)
+
+## Creating internal node labels
+ndLbl <- paste("n", 1:nNodes(geospiza), sep="")
+nodeLabels(geospiza) <- ndLbl
+nodeLabels(geospiza)
+
+## naming the labels
+names(ndLbl) <- nodeId(geospiza, "internal")
+
+## shuffling the labels
+(ndLbl <- sample(ndLbl))
+
+## by default, the labels are attributed in the order
+## they are given:
+nodeLabels(geospiza) <- ndLbl
+nodeLabels(geospiza)
+
+## but use.names puts them in the correct order
+labels(geospiza, "internal", use.names=TRUE) <- ndLbl
+nodeLabels(geospiza)
+}
+\author{
+Ben Bolker, Peter Cowan, Steve Kembel, Francois Michonneau
+}
diff --git a/man/multiPhylo-class.Rd b/man/multiPhylo-class.Rd
new file mode 100644
index 0000000..8dba97f
--- /dev/null
+++ b/man/multiPhylo-class.Rd
@@ -0,0 +1,21 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/multiphylo4-class.R
+\docType{class}
+\name{multiPhylo-class}
+\alias{multiPhylo-class}
+\alias{multiPhylo4-class}
+\alias{multiPhylo4d-class}
+\alias{tbind}
+\alias{multiPhylo-class}
+\alias{multiPhylo4-class}
+\alias{multiPhylo4d-class}
+\alias{tbind}
+\title{multiPhylo4 and extended classes}
+\description{
+Classes for lists of phylogenetic trees. These classes and methods are
+planned for a future version of \code{phylobase}.
+
+Classes for lists of phylogenetic trees. These classes and methods are
+planned for a future version of \code{phylobase}.
+}
+\keyword{classes}
diff --git a/man/nTips-methods.Rd b/man/nTips-methods.Rd
new file mode 100644
index 0000000..c2c2715
--- /dev/null
+++ b/man/nTips-methods.Rd
@@ -0,0 +1,41 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/phylo4-accessors.R
+\docType{methods}
+\name{nTips}
+\alias{nTips}
+\alias{nTips,phylo4-method}
+\alias{nTips,phylo-method}
+\alias{nNodes}
+\alias{nNodes,phylo4-method}
+\alias{nEdges}
+\alias{nEdges,phylo4-method}
+\title{nTips, nNodes, nEdges}
+\usage{
+nTips(x)
+
+\S4method{nTips}{phylo4}(x)
+
+\S4method{nTips}{phylo}(x)
+
+nNodes(x)
+
+\S4method{nNodes}{phylo4}(x)
+
+nEdges(x)
+
+\S4method{nEdges}{phylo4}(x)
+}
+\arguments{
+\item{x}{a \code{phylo4} or \code{phylo4d} object}
+}
+\value{
+a numeric vector indicating the number of tips, nodes or
+edge respectively.
+}
+\description{
+Number of tips, nodes and edges found in a tree.
+}
+\details{
+Function to return the number of tips, nodes and edges found in a
+tree in the \code{phylo4} or \code{phylo4d} format.
+}
diff --git a/man/nodeId-methods.Rd b/man/nodeId-methods.Rd
new file mode 100644
index 0000000..292182f
--- /dev/null
+++ b/man/nodeId-methods.Rd
@@ -0,0 +1,46 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/nodeId-methods.R
+\docType{methods}
+\name{nodeId}
+\alias{nodeId}
+\alias{nodeId,phylo4-method}
+\alias{edgeId}
+\alias{edgeId,phylo4-method}
+\title{nodeId methods}
+\usage{
+nodeId(x, type = c("all", "tip", "internal", "root"))
+
+\S4method{nodeId}{phylo4}(x, type = c("all", "tip", "internal", "root"))
+
+edgeId(x, type = c("all", "tip", "internal", "root"))
+
+\S4method{edgeId}{phylo4}(x, type = c("all", "tip", "internal", "root"))
+}
+\arguments{
+\item{x}{a \code{phylo4} or \code{phylo4d} object.}
+
+\item{type}{a character vector indicating which subset of the
+nodes or edges you are interested in.}
+}
+\value{
+\describe{
+ \item{nodeId}{an integer vector indicating node numbers}
+ \item{edgeId}{a character vector indicating the edge identity}
+}
+}
+\description{
+These functions gives the node (\code{nodeId}) or edge
+(\code{edgeId}) identity.
+}
+\details{
+\code{nodeId} returns the node in ascending order, and
+\code{edgeId} in the same order as the edges are stored in the
+edge matrix.
+}
+\examples{
+ data(geospiza)
+ identical(nodeId(geospiza, "tip"), 1:nTips(geospiza))
+ nodeId(geospiza, "internal")
+ edgeId(geospiza, "internal")
+ nodeId(geospiza, "root")
+}
diff --git a/man/owls4.Rd b/man/owls4.Rd
new file mode 100644
index 0000000..4c42ac3
--- /dev/null
+++ b/man/owls4.Rd
@@ -0,0 +1,22 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/phylobase-package.R
+\docType{data}
+\name{owls4}
+\alias{owls4}
+\title{'Owls' data from ape}
+\format{This is the standard 'owls' tree from the \code{ape} package, in
+\code{phylo4} format.}
+\source{
+From various examples in the \code{ape} package
+}
+\description{
+A tiny tree, for testing/example purposes, using one of the examples from
+the \code{ape} package
+}
+\examples{
+
+data(owls4)
+plot(owls4)
+
+}
+\keyword{datasets}
diff --git a/man/pdata-class.Rd b/man/pdata-class.Rd
new file mode 100644
index 0000000..a00d305
--- /dev/null
+++ b/man/pdata-class.Rd
@@ -0,0 +1,26 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/pdata.R
+\docType{class}
+\name{pdata-class}
+\alias{pdata-class}
+\alias{ptypes}
+\alias{[<-,pdata-method}
+\alias{[,pdata-method}
+\alias{[,pdata,ANY,ANY,ANY-method}
+\alias{[[,pdata-method}
+\alias{[[<-,pdata-method}
+\alias{[[,pdata,ANY,ANY-method}
+\alias{[[,pdata,ANY,missing-method}
+\title{Class "pdata"}
+\description{
+Data class for phylo4d objects
+}
+\section{Objects from the Class}{
+ Objects can be created by calls of the form
+\code{new("pdata", ...)}.
+}
+
+\author{
+Ben Bolker
+}
+\keyword{classes}
diff --git a/man/pdata.Rd b/man/pdata.Rd
new file mode 100644
index 0000000..bc886bf
--- /dev/null
+++ b/man/pdata.Rd
@@ -0,0 +1,33 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/pdata.R
+\name{pdata}
+\alias{pdata}
+\alias{check_pdata}
+\title{Constructor for pdata (phylogenetic data) class}
+\usage{
+pdata(data, type, comment, metadata)
+}
+\arguments{
+\item{data}{a data frame}
+
+\item{type}{a factor with levels as specified by \linkS4class{pdata}, the
+same length as \code{ncol(data)}}
+
+\item{comment}{a character vector, the same length as \code{ncol(data)}}
+
+\item{metadata}{an arbitrary list}
+}
+\value{
+An object of class \code{pdata}
+}
+\description{
+Combine data, type, comments, and metadata information to create a new pdata
+object, or check such an object for consistency
+}
+\seealso{
+\linkS4class{pdata}
+}
+\author{
+Ben Bolker
+}
+\keyword{misc}
diff --git a/man/phylo4-class.Rd b/man/phylo4-class.Rd
new file mode 100644
index 0000000..494f0d2
--- /dev/null
+++ b/man/phylo4-class.Rd
@@ -0,0 +1,26 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/phylo4-class.R
+\docType{class}
+\name{phylo4-class}
+\alias{phylo4-class}
+\title{The phylo4 class}
+\description{
+Classes for phylogenetic trees
+}
+\section{Objects from the Class}{
+ Phylogenetic tree objects can be created by
+calls to the \code{\link{phylo4}} constructor function. Translation
+functions from other phylogenetic packages are also available. See
+\code{\link{coerce-methods}}.
+}
+
+\seealso{
+The \code{\link{phylo4-methods}} constructor, the
+\code{\link{checkPhylo4}} function to check the validity of
+\code{phylo4} objects. See also the \code{\link{phylo4d-methods}}
+constructor and the \linkS4class{phylo4d} class.
+}
+\author{
+Ben Bolker, Thibaut Jombart
+}
+\keyword{classes}
diff --git a/man/phylo4-methods.Rd b/man/phylo4-methods.Rd
new file mode 100644
index 0000000..1f44906
--- /dev/null
+++ b/man/phylo4-methods.Rd
@@ -0,0 +1,119 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/phylo4-methods.R
+\docType{methods}
+\name{phylo4-methods}
+\alias{phylo4-methods}
+\alias{phylo4}
+\alias{phylo4_orderings}
+\alias{phylo4,matrix-method}
+\alias{phylo4,phylo-method}
+\alias{phylo4,nexml-method}
+\alias{nexml,phylo4-method}
+\title{Create a phylogenetic tree}
+\format{An object of class \code{character} of length 5.}
+\usage{
+phylo4(x, ...)
+
+phylo4_orderings
+
+\S4method{phylo4}{matrix}(x, edge.length = NULL, tip.label = NULL,
+ node.label = NULL, edge.label = NULL, order = "unknown",
+ annote = list())
+
+\S4method{phylo4}{phylo}(x, check.node.labels = c("keep", "drop"),
+ annote = list())
+
+\S4method{phylo4}{nexml}(x)
+}
+\arguments{
+\item{x}{a matrix of edges or an object of class \code{phylo} (see above)}
+
+\item{\dots}{optional arguments (none used at present).}
+
+\item{edge.length}{Edge (branch) length. (Optional)}
+
+\item{tip.label}{A character vector of species names (names of "tip" nodes).
+(Optional)}
+
+\item{node.label}{A character vector of internal node names. (Optional)}
+
+\item{edge.label}{A character vector of edge (branch) names. (Optional)}
+
+\item{order}{character: tree ordering (allowable values are listed in
+\code{phylo4_orderings}, currently "unknown", "preorder" (="cladewise" in
+\code{ape}), and "postorder", with "cladewise" and "pruningwise" also
+allowed for compatibility with \code{ape})}
+
+\item{annote}{any additional annotation data to be passed to the new object}
+
+\item{check.node.labels}{if \code{x} is of class \code{phylo}, either "keep"
+(the default) or "drop" node labels. This argument is useful if the
+\code{phylo} object has non-unique node labels.}
+
+\item{edge}{A numeric, two-column matrix with as many rows as branches in
+the phylogeny.}
+}
+\description{
+\code{phylo4} is a generic constructor that creates a phylogenetic tree
+object for use in phylobase methods. Phylobase contains functions for input
+of phylogenetic trees and data, manipulation of these objects including
+pruning and subsetting, and plotting. The phylobase package also contains
+translation functions to forms used in other comparative phylogenetic method
+packages.
+}
+\details{
+The minimum information necessary to create a phylobase tree object is a
+valid edge matrix. The edge matrix describes the topology of the phylogeny.
+Each row describes a branch of the phylogeny, with the (descendant) node
+number in column 2 and its ancestor's node number in column 1. These numbers
+are used internally and must be unique for each node.
+
+The labels designate either nodes or edges. The vector \code{node.label}
+names internal nodes, and together with \code{tip.label}, name all nodes in
+the tree. The vector \code{edge.label} names all branches in the tree. All
+label vectors are optional, and if they are not given, internally-generated
+labels will be assigned. The labels, whether user-specified or internally
+generated, must be unique as they are used to join species data with
+phylogenetic trees.
+
+\code{phylobase} also allows to create \code{phylo4} objects using
+the function \code{phylo4()} from objects of the classes:
+\code{phylo} (from \code{ape}), and \code{nexml} (from \code{RNeXML}).
+}
+\note{
+Translation functions are available from many valid tree formats. See
+\link{coerce-methods}.
+}
+\examples{
+
+# a three species tree:
+mytree <- phylo4(x=matrix(data=c(4,1, 4,5, 5,2, 5,3, 0,4), ncol=2,
+byrow=TRUE), tip.label=c("speciesA", "speciesB", "speciesC"))
+mytree
+plot(mytree)
+
+# another way to specify the same tree:
+mytree <- phylo4(x=cbind(c(4, 4, 5, 5, 0), c(1, 5, 2, 3, 4)),
+tip.label=c("speciesA", "speciesB", "speciesC"))
+
+# another way:
+mytree <- phylo4(x=rbind(c(4, 1), c(4, 5), c(5, 2), c(5, 3), c(0, 4)),
+tip.label=c("speciesA", "speciesB", "speciesC"))
+
+# with branch lengths:
+mytree <- phylo4(x=rbind(c(4, 1), c(4, 5), c(5, 2), c(5, 3), c(0, 4)),
+tip.label=c("speciesA", "speciesB", "speciesC"), edge.length=c(1, .2,
+.8, .8, NA))
+plot(mytree)
+
+}
+\seealso{
+\code{\link{coerce-methods}} for translation
+functions. The \linkS4class{phylo4} class. See also the
+\code{\link{phylo4d-methods}} constructor, and
+\linkS4class{phylo4d} class.
+}
+\author{
+phylobase team
+}
+\keyword{datasets}
diff --git a/man/phylo4d-accessors.Rd b/man/phylo4d-accessors.Rd
new file mode 100644
index 0000000..3bbc38d
--- /dev/null
+++ b/man/phylo4d-accessors.Rd
@@ -0,0 +1,77 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/phylo4d-accessors.R
+\docType{methods}
+\name{hasTipData}
+\alias{hasTipData}
+\alias{hasTipData,phylo4d-method}
+\alias{hasTipData-method,phylo4d-method}
+\alias{hasNodeData}
+\alias{hasNodeData-methods}
+\alias{hasNodeData,phylo4d-method}
+\alias{nData}
+\alias{nData,phylo4d-method}
+\title{Tests for presence of data associated with trees stored as phylo4d objects}
+\usage{
+hasTipData(x)
+
+\S4method{hasTipData}{phylo4d}(x)
+
+hasNodeData(x)
+
+\S4method{hasNodeData}{phylo4d}(x)
+
+nData(x)
+
+\S4method{nData}{phylo4d}(x)
+}
+\arguments{
+\item{x}{a \code{phylo4d} object}
+}
+\value{
+\describe{
+
+ \item{\code{nData}}{returns the number of datasets (i.e.,
+columns) associated with the object.}
+
+ \item{\code{hasTipData}, \code{hasNodeData}}{return \code{TRUE}
+or \code{FALSE} depending whether data associated with the
+tree are associated with either tips or internal nodes respectively.}}
+}
+\description{
+Methods that test for the presence of data associated with trees stored as
+\code{phylo4d} objects.
+}
+\details{
+\code{nData} tests for the presence of data associated with the object.
+
+\code{hasTipData} and \code{hasNodeData} tests for the presence of
+data associated with the tips and the internal nodes
+respectively. The outcome of the test is based on row names of the
+data frame stored in the \code{data} slot. If no rows have names
+from the set \code{nodeId(x, "tip")}, then \code{hasTipData}
+returns FALSE. Likewise, if no rows have names from the set
+\code{nodeId(x, "internal")}, then \code{hasNodeData} returns
+FALSE.
+}
+\section{Methods}{
+ \describe{ \item{hasNodeData}{\code{signature(object =
+"phylo4d")}: whether tree has internal node data}
+\item{hasTipData}{\code{signature(object = "phylo4d")}: whether tree has
+data associated with its tips} }
+}
+
+\examples{
+ data(geospiza)
+ nData(geospiza) ## 5
+ hasTipData(geospiza) ## TRUE
+ hasNodeData(geospiza) ## FALSE
+
+}
+\seealso{
+\code{\link{phylo4d-methods}} constructor and
+\code{\linkS4class{phylo4d}} class.
+}
+\author{
+Ben Bolker, Thibault Jombart, Francois Michonneau
+}
+\keyword{methods}
diff --git a/man/phylo4d-class.Rd b/man/phylo4d-class.Rd
new file mode 100644
index 0000000..ca88c36
--- /dev/null
+++ b/man/phylo4d-class.Rd
@@ -0,0 +1,33 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/phylo4d-class.R
+\docType{class}
+\name{phylo4d-class}
+\alias{phylo4d-class}
+\title{phylo4d class}
+\description{
+S4 class for phylogenetic tree and data.
+}
+\section{Objects from the Class}{
+ Objects can be created from various trees
+and a data.frame using the constructor \code{phylo4d}, or using
+\code{new("phylo4d", \dots{})} for empty objects.
+}
+
+\examples{
+ example(read.tree, "ape")
+ obj <- phylo4d(as(tree.owls.bis,"phylo4"), data.frame(wing=1:3))
+ obj
+ names(obj)
+ summary(obj)
+}
+\seealso{
+\code{\link{coerce-methods}} for translation
+functions. The \code{\link{phylo4d-methods}} constructor. See also
+the \code{\link{phylo4-methods}} constructor, the
+\linkS4class{phylo4} class, and the \code{\link{checkPhylo4}}
+function to check the validity of \code{phylo4} trees.
+}
+\author{
+Ben Bolker, Thibaut Jombart
+}
+\keyword{classes}
diff --git a/man/phylo4d-methods.Rd b/man/phylo4d-methods.Rd
new file mode 100644
index 0000000..c5ff523
--- /dev/null
+++ b/man/phylo4d-methods.Rd
@@ -0,0 +1,290 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/phylo4d-methods.R
+\docType{methods}
+\name{phylo4d-methods}
+\alias{phylo4d-methods}
+\alias{phylo4d}
+\alias{phylo4d,phylo4-method}
+\alias{phylo4d,phylo4,phylo4-method}
+\alias{phylo4d,matrix-method}
+\alias{phylo4d,matrix,matrix-method}
+\alias{phylo4d,phylo-method}
+\alias{phylo4d,phylo,phylo-method}
+\alias{phylo4d,phylo4d-method}
+\alias{phylo4d,phylo4d,phylo4d-method}
+\alias{phylo4d,nexml-method}
+\alias{nexml,phylo4d-method}
+\title{Combine a phylogenetic tree with data}
+\usage{
+phylo4d(x, ...)
+
+\S4method{phylo4d}{phylo4}(x, tip.data = NULL, node.data = NULL,
+ all.data = NULL, merge.data = TRUE, metadata = list(), ...)
+
+\S4method{phylo4d}{matrix}(x, tip.data = NULL, node.data = NULL,
+ all.data = NULL, merge.data = TRUE, metadata = list(),
+ edge.length = NULL, tip.label = NULL, node.label = NULL,
+ edge.label = NULL, order = "unknown", annote = list(), ...)
+
+\S4method{phylo4d}{phylo}(x, tip.data = NULL, node.data = NULL,
+ all.data = NULL, check.node.labels = c("keep", "drop", "asdata"),
+ annote = list(), metadata = list(), ...)
+
+\S4method{phylo4d}{phylo4d}(x, ...)
+
+\S4method{phylo4d}{nexml}(x)
+}
+\arguments{
+\item{x}{an object of class \code{phylo4}, \code{phylo},
+\code{nexml} or a matrix of edges (see above)}
+
+\item{\dots}{further arguments to control the behavior of the
+constructor in the case of missing/extra data and where to look
+for labels in the case of non-unique labels that cannot be stored
+as row names in a data frame (see Details).}
+
+\item{tip.data}{a data frame (or object to be coerced to one)
+containing only tip data (Optional)}
+
+\item{node.data}{a data frame (or object to be coerced to one)
+containing only node data (Optional)}
+
+\item{all.data}{a data frame (or object to be coerced to one)
+containing both tip and node data (Optional)}
+
+\item{merge.data}{if both \code{tip.data} and \code{node.data} are
+provided, should columns with common names will be merged together
+(default TRUE) or not (FALSE)? See details.}
+
+\item{metadata}{any additional metadata to be passed to the new object}
+
+\item{edge.length}{Edge (branch) length. (Optional)}
+
+\item{tip.label}{A character vector of species names (names of
+"tip" nodes). (Optional)}
+
+\item{node.label}{A character vector of internal node
+names. (Optional)}
+
+\item{edge.label}{A character vector of edge (branch)
+names. (Optional)}
+
+\item{order}{character: tree ordering (allowable values are listed
+in \code{phylo4_orderings}, currently "unknown", "preorder"
+(="cladewise" in \code{ape}), and "postorder", with "cladewise"
+and "pruningwise" also allowed for compatibility with \code{ape})}
+
+\item{annote}{any additional annotation data to be passed to the
+new object}
+
+\item{check.node.labels}{if \code{x} is of class \code{phylo}, use
+either \dQuote{keep} (the default) to retain internal node labels,
+\dQuote{drop} to drop them, or \dQuote{asdata} to convert them to
+numeric tree data. This argument is useful if the \code{phylo}
+object has non-unique node labels or node labels with informative
+data (e.g., posterior probabilities).}
+}
+\value{
+An object of class \linkS4class{phylo4d}.
+}
+\description{
+\code{phylo4d} is a generic constructor which merges a
+phylogenetic tree with data frames to create a combined object of
+class \code{phylo4d}
+}
+\details{
+You can provide several data frames to define traits associated
+with tip and/or internal nodes. By default, data row names are
+used to link data to nodes in the tree, with any number-like names
+(e.g., \dQuote{10}) matched against node ID numbers, and any
+non-number-like names (e.g., \dQuote{n10}) matched against node
+labels. Alternative matching rules can be specified by passing
+additional arguments (listed in the Details section); these
+include positional matching, matching exclusively on node labels,
+and matching based on a column of data rather than on row
+names.
+
+Matching rules will apply the same way to all supplied data
+frames. This means that you need to be consistent with the row
+names of your data frames. It is good practice to use tip and
+node labels (or node numbers if you use duplicated labels) when
+you combine data with a tree.
+
+If you provide both \code{tip.data} and \code{node.data}, the
+treatment of columns with common names will depend on the
+\code{merge.data} argument. If TRUE, columns with the same name in
+both data frames will be merged; when merging columns of different
+data types, coercion to a common type will follow standard R
+rules. If \code{merge.data} is FALSE, columns with common names
+will be preserved independently, with \dQuote{.tip} and
+\dQuote{.node} appended to the names. This argument has no effect
+if \code{tip.data} and \code{node.data} have no column names in
+common.
+
+If you provide \code{all.data} along with either of
+\code{tip.data} and \code{node.data}, it must have distinct column
+names, otherwise an error will result. Additionally, although
+supplying columns with the same names \emph{within} data frames is
+not illegal, automatic renaming for uniqeness may lead to
+surprising results, so this practice should be avoided.
+
+This is the list of additional arguments that can be used
+to control matching between the tree and the data:
+
+\itemize{
+
+\item{match.data}{(logical) should the rownames of the data frame
+be used to be matched against tip and internal node identifiers?}
+
+\item{rownamesAsLabels}{(logical), should the row names of the
+data provided be matched only to labels (TRUE), or should any
+number-like row names be matched to node numbers (FALSE and
+default)}
+
+\item{label.type}{character, \code{rownames} or \code{column}:
+should the labels be taken from the row names of \code{dt} or from
+the \code{label.column} column of \code{dt}?}
+
+\item{label.column}{iff \code{label.type=="column"}, column
+specifier (number or name) of the column containing tip labels}
+
+\item{missing.data}{action to take if there are missing data or if
+there are data labels that don't match}
+
+\item{extra.data}{action to take if there are extra data or if
+there are labels that don't match}
+
+\item{keep.all}{(logical), should the returned data have rows for
+all nodes (with NA values for internal rows when type='tip', and
+vice versa) (TRUE and default) or only rows corresponding to the
+type argument}
+
+}
+
+Rules for matching rows of data to tree nodes are determined
+jointly by the \code{match.data} and \code{rownamesAsLabels}
+arguments. If \code{match.data} is TRUE, data frame rows will be
+matched exclusively against tip and node labels if
+\code{rownamesAsLabels} is also TRUE, whereas any all-digit row
+names will be matched against tip and node numbers if
+\code{rownamesAsLabels} is FALSE (the default). If
+\code{match.data} is FALSE, \code{rownamesAsLabels} has no effect,
+and row matching is purely positional with respect to the order
+returned by \code{nodeId(phy, type)}.
+}
+\note{
+Checking on matches between the tree and the data will be
+done by the validity checker (label matches between data and tree
+tips, number of rows of data vs. number of nodes/tips/etc.)
+}
+\section{Methods}{
+ \describe{ \item{x = "phylo4"}{merges a tree of
+class \code{phylo4} with a data.frame into a \code{phylo4d}
+object} \item{x = "matrix"}{merges a matrix of tree edges similar
+to the edge slot of a \code{phylo4} object (or to \$edge of a
+\code{phylo} object) with a data.frame into a \code{phylo4d}
+object} \item{x = "phylo"}{merges a tree of class \code{phylo}
+with a data.frame into a \code{phylo4d} object } }
+}
+
+\examples{
+
+treeOwls <- "((Strix_aluco:4.2,Asio_otus:4.2):3.1,Athene_noctua:7.3);"
+tree.owls.bis <- ape::read.tree(text=treeOwls)
+try(phylo4d(as(tree.owls.bis,"phylo4"),data.frame(wing=1:3)), silent=TRUE)
+obj <- phylo4d(as(tree.owls.bis,"phylo4"),data.frame(wing=1:3), match.data=FALSE)
+obj
+print(obj)
+
+####
+
+data(geospiza_raw)
+geoTree <- geospiza_raw$tree
+geoData <- geospiza_raw$data
+
+## fix differences in tip names between the tree and the data
+geoData <- rbind(geoData, array(, dim = c(1,ncol(geoData)),
+ dimnames = list("olivacea", colnames(geoData))))
+
+### Example using a tree of class 'phylo'
+exGeo1 <- phylo4d(geoTree, tip.data = geoData)
+
+### Example using a tree of class 'phylo4'
+geoTree <- as(geoTree, "phylo4")
+
+## some random node data
+rNodeData <- data.frame(randomTrait = rnorm(nNodes(geoTree)),
+ row.names = nodeId(geoTree, "internal"))
+
+exGeo2 <- phylo4d(geoTree, tip.data = geoData, node.data = rNodeData)
+
+### Example using 'merge.data'
+data(geospiza)
+trGeo <- extractTree(geospiza)
+tDt <- data.frame(a=rnorm(nTips(trGeo)), row.names=nodeId(trGeo, "tip"))
+nDt <- data.frame(a=rnorm(nNodes(trGeo)), row.names=nodeId(trGeo, "internal"))
+
+(matchData1 <- phylo4d(trGeo, tip.data=tDt, node.data=nDt, merge.data=FALSE))
+(matchData2 <- phylo4d(trGeo, tip.data=tDt, node.data=nDt, merge.data=TRUE))
+
+## Example with 'all.data'
+nodeLabels(geoTree) <- as.character(nodeId(geoTree, "internal"))
+rAllData <- data.frame(randomTrait = rnorm(nTips(geoTree) + nNodes(geoTree)),
+row.names = labels(geoTree, 'all'))
+
+exGeo5 <- phylo4d(geoTree, all.data = rAllData)
+
+## Examples using 'rownamesAsLabels' and comparing with match.data=FALSE
+tDt <- data.frame(x=letters[1:nTips(trGeo)],
+ row.names=sample(nodeId(trGeo, "tip")))
+tipLabels(trGeo) <- as.character(sample(1:nTips(trGeo)))
+(exGeo6 <- phylo4d(trGeo, tip.data=tDt, rownamesAsLabels=TRUE))
+(exGeo7 <- phylo4d(trGeo, tip.data=tDt, rownamesAsLabels=FALSE))
+(exGeo8 <- phylo4d(trGeo, tip.data=tDt, match.data=FALSE))
+
+## generate a tree and some data
+set.seed(1)
+p3 <- ape::rcoal(5)
+dat <- data.frame(a = rnorm(5), b = rnorm(5), row.names = p3$tip.label)
+dat.defaultnames <- dat
+row.names(dat.defaultnames) <- NULL
+dat.superset <- rbind(dat, rnorm(2))
+dat.subset <- dat[-1, ]
+
+## create a phylo4 object from a phylo object
+p4 <- as(p3, "phylo4")
+
+## create phylo4d objects with tip data
+p4d <- phylo4d(p4, dat)
+###checkData(p4d)
+p4d.sorted <- phylo4d(p4, dat[5:1, ])
+try(p4d.nonames <- phylo4d(p4, dat.defaultnames))
+p4d.nonames <- phylo4d(p4, dat.defaultnames, match.data=FALSE)
+
+\dontrun{
+p4d.subset <- phylo4d(p4, dat.subset)
+p4d.subset <- phylo4d(p4, dat.subset)
+try(p4d.superset <- phylo4d(p4, dat.superset))
+p4d.superset <- phylo4d(p4, dat.superset)
+}
+
+## create phylo4d objects with node data
+nod.dat <- data.frame(a = rnorm(4), b = rnorm(4))
+p4d.nod <- phylo4d(p4, node.data = nod.dat, match.data=FALSE)
+
+
+## create phylo4 objects with node and tip data
+p4d.all1 <- phylo4d(p4, node.data = nod.dat, tip.data = dat, match.data=FALSE)
+nodeLabels(p4) <- as.character(nodeId(p4, "internal"))
+p4d.all2 <- phylo4d(p4, all.data = rbind(dat, nod.dat), match.data=FALSE)
+}
+\seealso{
+\code{\link{coerce-methods}} for translation
+functions. The \linkS4class{phylo4d} class; \linkS4class{phylo4}
+class and \link{phylo4} constructor.
+}
+\author{
+Ben Bolker, Thibaut Jombart, Steve Kembel, Francois
+Michonneau, Jim Regetz
+}
+\keyword{misc}
diff --git a/man/phyloXXYY.Rd b/man/phyloXXYY.Rd
new file mode 100644
index 0000000..b3698bd
--- /dev/null
+++ b/man/phyloXXYY.Rd
@@ -0,0 +1,50 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/treePlot.R
+\name{phyloXXYY}
+\alias{phyloXXYY}
+\title{Calculate node x and y coordinates}
+\usage{
+phyloXXYY(phy, tip.order = NULL)
+}
+\arguments{
+\item{phy}{A \code{phylo4} or \code{phylo4d} object.}
+
+\item{tip.order}{A character vector of tip labels, indicating their order
+along the y axis (from top to bottom). Or, a numeric vector of tip node IDs
+indicating the order.}
+}
+\value{
+\item{yy}{Internal node and tip y coordinates} \item{xx}{Internal
+node and tip x coordinates} \item{phy}{A \code{phylo4} or \code{phylo4d}
+object} \item{segs}{A list of \code{h0x, h1x, v0x, v1x} and \code{h0y, h1y,
+v0y, v1y} describing the start and end points for the plot line segments}
+\item{torder}{The tip order provided as \code{tip.order} or if NULL the
+preoder tip order} \item{eorder}{The an index of the reordered edges
+compared to the result of \code{edges(phy)}}
+}
+\description{
+Calculates the node x and y locations for plotting a phylogenetic tree.
+}
+\details{
+The y coordinates of the tips are evenly spaced from 0 to 1 in pruningwise
+order. Ancestor y nodes are given the mean value of immediate descendants.
+The root is given the x coordinate 0 and descendant nodes are placed
+according to the cumulative branch length from the root, with a maximum x
+value of 1.
+}
+\examples{
+
+
+data(geospiza)
+coor <- phyloXXYY(geospiza)
+plot(coor$xx, coor$yy, pch = 20)
+
+
+}
+\seealso{
+\code{treePlot}, \code{\link{plotOneTree}}
+}
+\author{
+Peter Cowan \email{pdc at berkeley.edu}
+}
+\keyword{methods}
diff --git a/man/phylobase-package.Rd b/man/phylobase-package.Rd
new file mode 100644
index 0000000..b17853c
--- /dev/null
+++ b/man/phylobase-package.Rd
@@ -0,0 +1,73 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/phylobase-package.R
+\docType{package}
+\name{phylobase-package}
+\alias{phylobase-package}
+\alias{phylobase}
+\title{Utilities and Tools for Phylogenetics}
+\description{
+Base package for phylogenetic structures and comparative data.
+}
+\details{
+\code{phylobase} provides a set of functions to associate and
+manipulate phylogenetic information and data about the
+species/individuals that are in the tree.
+
+\code{phylobase} intends to be robust, fast and efficient. We hope
+other people use the data structure it provides to develop new
+comparative methods in R.
+
+With \code{phylobase} it is easy to ensure that all your data are
+represented and associated with the tips or the internal nodes of
+your tree. \code{phylobase} provides functions to:
+\itemize{
+
+\item prune (subset) your trees, find ancestor(s) a
+descendant(s)
+
+\item find the most common recent ancestor of 2 nodes (MRCA)
+
+\item calculate the distance of a given node from the tip or
+between two nodes in your tree
+
+\item robust functions to import data from NEXUS and Newick files
+using the NEXUS Class Library (\url{https://github.com/mtholder/ncl/})
+}
+}
+\section{History}{
+
+
+\code{phylobase} was started during a Hackathlon at NESCent on
+December 10-14 2007.
+
+Peter Cowan was a Google Summer of Code fellow in 2008 and
+developed all the code for plotting.
+
+In December 2008, a mini-virtual Hackathlon was organized to clean
+up and make the code more robust.
+
+In the spring and summer of 2009, Jim Regetz made several
+contributions that made the code faster (in particular with the
+re-ordering parts), found many bugs, and wrote most of the testing
+code.
+
+\code{phylobase} was first released on CRAN on November 1st, 2009
+with version 0.5.
+
+Since then, several releases have followed adding new
+functionalities: better support of NEXUS files, creation of
+\code{phylobase.options()} function that controls the \code{phylo4}
+validator, rewrite of the validator in C++.
+
+Starting with 0.6.8, Francois Michonneau succeeds to Ben Bolker as
+the maintainer of the package.
+}
+
+\section{More Info}{
+
+See the help index \code{help(package="phylobase")} and run
+\code{vignette("phylobase", "phylobase")} for further details and
+examples about how to use \code{phylobase}.
+}
+
+\keyword{package}
diff --git a/man/phylobase.options.Rd b/man/phylobase.options.Rd
new file mode 100644
index 0000000..c46368e
--- /dev/null
+++ b/man/phylobase.options.Rd
@@ -0,0 +1,39 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/phylobase.options.R
+\name{phylobase.options}
+\alias{phylobase.options}
+\title{Set or return options of phylobase}
+\usage{
+phylobase.options(...)
+}
+\arguments{
+\item{\dots}{a list may be given as the only argument, or any
+number of arguments may be in the \code{name=value} form, or no
+argument at all may be given. See the Value and Details sections
+for explanation.}
+}
+\value{
+A list with the updated values of the parameters. If
+arguments are provided, the returned list is invisible.
+}
+\description{
+Provides a mean to control the validity of \code{phylobase}
+objects such as singletons, reticulated trees, polytomies, etc.
+}
+\details{
+The parameter values set via a call to this function will remain
+in effect for the rest of the session, affecting the subsequent
+behavior of phylobase.
+}
+\examples{
+\dontrun{
+phylobase.options(poly="fail")
+# subsequent trees with polytomies will fail the validity check
+}
+
+}
+\author{
+Francois Michonneau (adapted from the package \code{sm})
+}
+\keyword{phylobase}
+\keyword{validator}
diff --git a/man/phylobubbles.Rd b/man/phylobubbles.Rd
new file mode 100644
index 0000000..720d484
--- /dev/null
+++ b/man/phylobubbles.Rd
@@ -0,0 +1,61 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/treePlot.R
+\name{phylobubbles}
+\alias{phylobubbles}
+\title{Bubble plots for phylo4d objects}
+\usage{
+phylobubbles(type = type, place.tip.label = "right",
+ show.node.label = show.node.label, rot = 0, edge.color = edge.color,
+ node.color = node.color, tip.color = tip.color, edge.width = edge.width,
+ newpage = TRUE, ..., XXYY, square = FALSE, grid = TRUE)
+}
+\arguments{
+\item{type}{the type of plot}
+
+\item{place.tip.label}{A string indicating whether labels should be plotted
+to the right or to the left of the bubble plot}
+
+\item{show.node.label}{A logical indicating whether internal node labels
+should be plotted}
+
+\item{rot}{The number of degrees that the plot should be rotated}
+
+\item{edge.color}{A vector of colors for the tree edge segments}
+
+\item{node.color}{A vector of colors for the coloring the nodes}
+
+\item{tip.color}{A vector of colors for the coloring the tip labels}
+
+\item{edge.width}{A vector of line widths for the tree edges}
+
+\item{newpage}{Logical to control whether the device is cleared before
+plotting, useful for adding plot inside other plots}
+
+\item{\dots}{Additional parameters passed to the bubble plotting functions}
+
+\item{XXYY}{The out put from the phyloXXYY function}
+
+\item{square}{Logical indicating whether the plot 'bubbles' should be
+squares}
+
+\item{grid}{A logical indicating whether a grey grid should be plotted
+behind the bubbles}
+}
+\description{
+Plots either circles or squares corresponding to the magnitude of each cell
+of a \code{phylo4d} object.
+}
+\examples{
+
+##---- Should be DIRECTLY executable !! ----
+##-- ==> Define data, use random,
+##-- or do help(data=index) for the standard data sets.
+
+}
+\seealso{
+\code{\link{phyloXXYY}}, \code{treePlot}
+}
+\author{
+Peter Cowan \email{pdc at berkeley.edu}
+}
+\keyword{methods}
diff --git a/man/phylomat-class.Rd b/man/phylomat-class.Rd
new file mode 100644
index 0000000..ce56afb
--- /dev/null
+++ b/man/phylomat-class.Rd
@@ -0,0 +1,59 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/phylomats-class.R
+\docType{class}
+\name{phylomat-class}
+\alias{phylomat-class}
+\alias{phylo4vcov-class}
+\alias{as_phylo4vcov}
+\alias{phylomat-setAs}
+\alias{setAs,phylo,phylo4vcov-method}
+\alias{phylomat-setAs}
+\alias{setAs,phylo4vcov,phylo4-method}
+\title{matrix classes for phylobase}
+\arguments{
+\item{from}{a \code{phylo4} object}
+
+\item{\dots}{optional arguments, to be passed to \code{vcov.phylo} in
+\code{ape} (the main useful option is \code{cor}, which can be set to
+\code{TRUE} to compute a correlation rather than a variance-covariance
+matrix)}
+}
+\description{
+Classes representing phylogenies as matrices
+}
+\section{Objects from the Class}{
+ These are square matrices (with rows and
+columns corresponding to tips, and internal nodes implicit) with different
+meanings depending on the type (variance-covariance matrix, distance matrix,
+etc.).
+}
+
+\examples{
+ tree_string <- "(((Strix_aluco:4.2,Asio_otus:4.2):3.1,Athene_noctua:7.3):6.3,Tyto_alba:13.5);"
+ tree.owls <- ape::read.tree(text=tree_string)
+ o2 <- as(tree.owls,"phylo4")
+ ov <- as(o2,"phylo4vcov")
+ o3 <- as(ov,"phylo4")
+ ## these are not completely identical, but are
+ ## topologically identical ...
+
+ ## edge matrices are in a different order:
+ ## cf. edges(o2) and edges(o3)
+ ## BUT the edge matrices are otherwise identical
+ o2edges <- edges(o2)
+ o3edges <- edges(o3)
+ identical(o2edges[order(o2edges[,2]),],
+ o3edges[order(o3edges[,2]),])
+
+ ## There is left/right ambiguity here in the tree orders:
+ ## in o2 the 5->6->7->1 lineage
+ ## (terminating in Strix aluco)
+ ## is first, in o3 the 5->6->3 lineage
+ ## (terminating in Athene noctua) is first.
+
+
+}
+\author{
+Ben Bolker
+}
+\keyword{classes}
diff --git a/man/plotOneTree.Rd b/man/plotOneTree.Rd
new file mode 100644
index 0000000..e7101c4
--- /dev/null
+++ b/man/plotOneTree.Rd
@@ -0,0 +1,66 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/treePlot.R
+\name{plotOneTree}
+\alias{plotOneTree}
+\title{Plot a phylo4 object}
+\usage{
+plotOneTree(xxyy, type, show.tip.label, show.node.label, edge.color, node.color,
+ tip.color, edge.width, rot)
+}
+\arguments{
+\item{xxyy}{A list created by the \code{\link{phyloXXYY}} function}
+
+\item{type}{A character string indicating the shape of plotted tree}
+
+\item{show.tip.label}{Logical, indicating whether tip labels should be shown}
+
+\item{show.node.label}{Logical, indicating whether node labels should be
+shown}
+
+\item{edge.color}{A vector of colors in the order of \code{edges(phy)}}
+
+\item{node.color}{A vector of colors indicating the colors of the node
+labels}
+
+\item{tip.color}{A vector of colors indicating the colors of the tip labels}
+
+\item{edge.width}{A vector in the order of \code{edges(phy)} indicating the
+widths of edge lines}
+
+\item{rot}{Numeric indicating the rotation of the plot in degrees}
+}
+\value{
+Returns no values, function invoked for the plotting side effect.
+}
+\description{
+Plots the phylogenetic tree contained in a \code{phylo4} or \code{phylo4d}
+object.
+}
+\examples{
+library(grid)
+data(geospiza)
+grid.newpage()
+xxyy <- phyloXXYY(geospiza)
+plotOneTree(xxyy, type = 'phylogram',
+ show.tip.label = TRUE, show.node.label = TRUE,
+ edge.color = 'black', node.color = 'orange', tip.color = 'blue',
+ edge.width = 1, rot = 0
+)
+
+grid.newpage()
+pushViewport(viewport(w = 0.8, h = 0.8))
+plotOneTree(xxyy, type = 'phylogram',
+ show.tip.label = TRUE, show.node.label = TRUE,
+ edge.color = 'black', node.color = 'orange', tip.color = 'blue',
+ edge.width = 1, rot = 0
+)
+popViewport()
+
+}
+\seealso{
+\code{treePlot}, \code{\link{phyloXXYY}}
+}
+\author{
+Peter Cowan \email{pdc at berkeley.edu}
+}
+\keyword{methods}
diff --git a/man/print-methods.Rd b/man/print-methods.Rd
new file mode 100644
index 0000000..422ac89
--- /dev/null
+++ b/man/print-methods.Rd
@@ -0,0 +1,101 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/print-methods.R
+\docType{methods}
+\name{print}
+\alias{print}
+\alias{print,phylo4-method}
+\alias{show}
+\alias{show,phylo4-method}
+\alias{names}
+\alias{names,phylo4-method}
+\alias{head}
+\alias{head,phylo4-method}
+\alias{tail}
+\alias{tail,phylo4-method}
+\title{print a phylogeny}
+\usage{
+print(x, ...)
+
+\S4method{print}{phylo4}(x, edgeOrder = c("pretty", "real"),
+ printall = TRUE)
+
+show(object)
+
+\S4method{show}{phylo4}(object)
+
+names(x)
+
+\S4method{names}{phylo4}(x)
+
+head(x, ...)
+
+\S4method{head}{phylo4}(x, n = 20)
+
+tail(x, ...)
+
+\S4method{tail}{phylo4}(x, n = 20)
+}
+\arguments{
+\item{x}{a \code{phylo4} tree or \code{phylo4d} tree+data object}
+
+\item{\dots}{optional additional arguments (not in use)}
+
+\item{edgeOrder}{in the data frame returned, the option 'pretty' returns the
+internal nodes followed by the tips, the option 'real' returns the nodes in
+the order they are stored in the edge matrix.}
+
+\item{printall}{default prints entire tree. printall=FALSE returns the first
+6 rows}
+
+\item{object}{a \code{phylo4} or \code{phylo4d} object}
+
+\item{n}{for head() and tail(), the number of lines to print}
+}
+\value{
+A data.frame with a row for each node (descendant), sorted as
+follows: root first, then other internal nodes, and finally tips.\cr The
+returned data.frame has the following columns:\cr \item{label}{Label for the
+taxon at the node (usually species name).} \item{node}{Node number, i.e. the
+number identifying the node in edge matrix.} \item{ancestor}{Node number
+of the node's ancestor.} \item{branch.length}{The branch length connecting
+the node to its ancestor (NAs if missing).} \item{node.type}{"root",
+"internal", or "tip". (internally generated)} \item{data}{phenotypic data
+associated with the nodes, with separate columns for each variable.}
+}
+\description{
+Prints a phylo4 or phylo4d object in data.frame format with user-friendly
+column names
+}
+\details{
+This is a user-friendly version of the tree representation, useful for
+checking that objects were read in completely and translated correctly. The
+phylogenetic tree is represented as a list of numbered nodes, linked in a
+particular way through time (or rates of evolutionary change). The topology
+is given by the pattern of links from each node to its ancestor. Also given
+are the taxon names, node type (root/internal/tip) and phenotypic data (if
+any) associated with the node, and the branch length from the node to its
+ancestor. A list of nodes (descendants) and ancestors is minimally required
+for a phylo4 object.
+}
+\note{
+This is the default show() method for phylo4, phylo4d. It prints the
+user-supplied information for building a phylo4 object. For a full
+description of the phylo4 S4 object and slots, see \code{\link{phylo4}}.
+}
+\examples{
+
+
+tree.phylo <- ape::read.tree(text="((a,b),c);")
+tree <- as(tree.phylo, "phylo4")
+##plot(tree,show.node=TRUE) ## plotting broken with empty node labels: FIXME
+tip.data <- data.frame(size=c(1,2,3), row.names=c("a", "b", "c"))
+treedata <- phylo4d(tree, tip.data)
+plot(treedata)
+print(treedata)
+
+
+}
+\author{
+Marguerite Butler, Thibaut Jombart \email{jombart at biomserv.univ-lyon1.fr}, Steve Kembel
+}
+\keyword{methods}
diff --git a/man/readNexus.Rd b/man/readNexus.Rd
new file mode 100644
index 0000000..f957684
--- /dev/null
+++ b/man/readNexus.Rd
@@ -0,0 +1,180 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/readNCL.R
+\docType{methods}
+\name{Import Nexus and Newick files}
+\alias{Import Nexus and Newick files}
+\alias{readNCL}
+\alias{readNexus}
+\alias{readNewick}
+\title{Create a \code{phylo4}, \code{phylo4d} or \code{data.frame} object
+from a NEXUS or a Newick file}
+\usage{
+readNCL(file, simplify = FALSE, type = c("all", "tree", "data"),
+ spacesAsUnderscores = TRUE, char.all = FALSE,
+ polymorphic.convert = TRUE, levels.uniform = FALSE, quiet = TRUE,
+ check.node.labels = c("keep", "drop", "asdata"), return.labels = TRUE,
+ file.format = c("nexus", "newick"), check.names = TRUE,
+ convert.edge.length = FALSE, ...)
+
+readNexus(file, simplify = FALSE, type = c("all", "tree", "data"),
+ char.all = FALSE, polymorphic.convert = TRUE, levels.uniform = FALSE,
+ quiet = TRUE, check.node.labels = c("keep", "drop", "asdata"),
+ return.labels = TRUE, check.names = TRUE, convert.edge.length = FALSE,
+ ...)
+
+readNewick(file, simplify = FALSE, quiet = TRUE,
+ check.node.labels = c("keep", "drop", "asdata"),
+ convert.edge.length = FALSE, ...)
+}
+\arguments{
+\item{file}{a NEXUS file for \code{readNexus} or a file that
+contains Newick formatted trees for \code{readNewick}.}
+
+\item{simplify}{If TRUE, if there are multiple trees in the file,
+only the first one is returned; otherwise a list of
+\code{phylo4(d)} objects is returned if the file contains multiple
+trees.}
+
+\item{type}{Determines which type of objects to return, if present
+in the file (see Details).}
+
+\item{spacesAsUnderscores}{In the NEXUS file format white spaces
+are not allowed in taxa labels and are represented by
+underscores. Therefore, NCL converts underscores found in taxa
+labels in the NEXUS file into white spaces
+(e.g. \code{species_1} will become \code{"species 1"}. If you
+want to preserve the underscores, set as TRUE, the default).}
+
+\item{char.all}{If \code{TRUE}, returns all characters, even those
+excluded in the NEXUS file}
+
+\item{polymorphic.convert}{If \code{TRUE}, converts polymorphic
+characters to missing data}
+
+\item{levels.uniform}{If \code{TRUE}, uses the same levels for all
+characters}
+
+\item{quiet}{If \code{FALSE} the output of the NCL interface is
+printed. This is mainly for debugging purposes. This option
+can considerably slow down the process if the tree is big or
+there are many trees in the file.}
+
+\item{check.node.labels}{Determines how the node labels in the
+NEXUS or Newick files should be treated in the phylo4 object,
+see Details for more information.}
+
+\item{return.labels}{Determines whether state names (if
+\code{TRUE}) or state codes should be returned.}
+
+\item{file.format}{character indicating the format of the
+specified file (either \dQuote{\code{newick}} or
+\dQuote{\code{nexus}}). It's more convenient to just use
+\code{readNexus} or \code{readNewick}.}
+
+\item{check.names}{logical. If \sQuote{TRUE} then the names of the
+characters from the NEXUS file are checked to ensure that they
+are syntactically valid variable names and are not duplicated.
+If necessary they are adjusted using \sQuote{make.names}.}
+
+\item{convert.edge.length}{logical. If \code{TRUE} negative edge
+lengths are replaced with 0. At this time \code{phylobase}
+does not accept objects with negative branch lengths, this
+workaround allows to import trees with negative branch
+lengths.}
+
+\item{\dots}{Additional arguments to be passed to phylo4 or
+phylo4d constructor (see Details)}
+}
+\value{
+Depending on the value of \code{type} and the contents of
+ the file, one of: a \code{data.frame}, a \linkS4class{phylo4}
+ object, a \linkS4class{phylo4d} object or \code{NULL}. If
+ several trees are included in the NEXUS file and the option
+ \code{simplify=FALSE} a list of \linkS4class{phylo4} or
+ \linkS4class{phylo4d} objects is returned.
+}
+\description{
+\code{readNexus} reads a NEXUS file and outputs a \code{phylo4},
+\code{phylo4d} or \code{data.frame} object.
+}
+\details{
+\code{readNewick} reads a Newick file and outputs a \code{phylo4}
+or \code{phylo4d} object.
+
+\code{readNexus} is used internally by both \code{readNexus} and
+\code{readNewick} to extract data held in a tree files,
+specifically in NEXUS files from DATA, CHARACTER or TREES
+blocks.
+
+The \code{type} argument specifies which of these is returned:
+
+\describe{
+
+\item{data}{will only return a \code{data.frame} of the contents
+of all DATA and CHARACTER blocks.}
+
+\item{tree}{will only return a \code{phylo4} object of the
+contents of the TREES block.}
+
+\item{all}{if only data or a tree are present in the file, this
+option will act as the options above, returning either a
+\code{data.frame} or a \code{phylo4} object respectively. If both
+are present then a \code{phylo4d} object is returned containing
+both.}
+
+}
+
+The function returns \code{NULL} if the \code{type} of
+data requested is not present in the file, or if neither data nor
+tree blocks are present.
+
+Depending on the context \code{readNexus} will call either the
+\code{phylo4} or \code{phylo4d} constructor. The \code{phylo4d}
+constructor will be used with \code{type="all"}, or if the option
+\code{check.node.labels="asdata"} is invoked.
+
+\code{readNewick} imports Newick formatted tree files and will
+return a \code{phylo4} or a \code{phylo4d} object if the option
+\code{check.node.labels="asdata"} is invoked.
+
+For both \code{readNexus} and \code{readNewick}, the options for
+\code{check.node.labels} can take the values:
+
+\describe{
+
+\item{keep}{the node labels of the trees will be passed as node
+labels in the \code{phylo4} object}
+
+\item{drop}{the node labels of the trees will be ignored in the
+\code{phylo4} object}
+
+\item{asdata}{the node labels will be passed as data and a
+\code{phylo4d} object will be returned.}
+
+}
+
+If you use the option \code{asdata} on a file with no node labels,
+a warning message is issued, and is thus equivalent to the value
+\code{drop}.
+
+For both \code{readNexus} and \code{readNewick}, additional
+arguments can be passed to the constructors such as \code{annote},
+\code{missing.data} or \code{extra.data}. See the \sQuote{Details}
+section of \code{\link{phylo4d-methods}} for the complete list of
+options.
+}
+\note{
+Underscores in state labels (i.e. trait or taxon names) will
+be translated to spaces. Unless \code{check.names=FALSE}, trait
+names will be converted to valid R names (see
+\code{\link{make.names}}) on input to R, so spaces will be
+translated to periods.
+}
+\seealso{
+the \linkS4class{phylo4d} class, the \linkS4class{phylo4}
+ class
+}
+\author{
+Brian O'Meara, Francois Michonneau, Derrick Zwickl
+}
+\keyword{misc}
diff --git a/man/reorder-methods.Rd b/man/reorder-methods.Rd
new file mode 100644
index 0000000..9ad0153
--- /dev/null
+++ b/man/reorder-methods.Rd
@@ -0,0 +1,58 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/reorder-methods.R
+\docType{methods}
+\name{reorder-methods}
+\alias{reorder-methods}
+\alias{reorder}
+\alias{reorder,phylo4-method}
+\title{reordering trees within phylobase objects}
+\usage{
+reorder(x, ...)
+
+\S4method{reorder}{phylo4}(x, order = c("preorder", "postorder"))
+}
+\arguments{
+\item{x}{a \code{phylo4} or \code{phylo4d} object}
+
+\item{\dots}{additional optional elements (not in use)}
+
+\item{order}{The desired traversal order; currently only
+\dQuote{preorder} and \dQuote{postorder} are allowed for
+\code{phylo4} and \code{phylo4d} objects.}
+}
+\value{
+A \code{phylo4} or \code{phylo4d} object with the edge,
+label, length and data slots ordered as \code{order}, which is
+itself recorded in the order slot.
+}
+\description{
+Methods for reordering trees into various traversal orders
+}
+\details{
+The \code{reorder} method takes a \code{phylo4} or \code{phylo4d}
+tree and orders the edge matrix (i.e. \code{edges(x)}) in the
+requested traversal order. Currently only two orderings are
+permitted, and both require rooted trees. In \code{postorder}, a
+node's descendants come before that node, thus the root, which is
+ancestral to all nodes, comes last. In \code{preorder}, a node is
+visited before its descendants, thus the root comes first.
+}
+\note{
+The \code{preorder} parameter corresponds to
+\code{cladewise} in the \code{ape} package, and \code{postorder}
+corresponds (almost) to \code{pruningwise}.
+}
+\examples{
+phy <- phylo4(ape::rtree(5))
+edges(reorder(phy, "preorder"))
+edges(reorder(phy, "postorder"))
+}
+\seealso{
+\code{\link[ape]{reorder.phylo}} in the \code{ape} package.
+\code{\link{ancestors}} \code{\link{ancestor}} \code{\link{siblings}}
+\code{\link{children}} \code{\link{descendants}}
+}
+\author{
+Peter Cowan, Jim Regetz
+}
+\keyword{methods}
diff --git a/man/root-methods.Rd b/man/root-methods.Rd
new file mode 100644
index 0000000..413719d
--- /dev/null
+++ b/man/root-methods.Rd
@@ -0,0 +1,47 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/root-methods.R
+\docType{methods}
+\name{isRooted}
+\alias{isRooted}
+\alias{isRooted,phylo4-method}
+\alias{rootNode}
+\alias{rootNode,phylo4-method}
+\alias{rootNode<-}
+\alias{rootNode<-}
+\alias{rootNode<-,phylo4-method}
+\title{Methods to test, access (and modify) the root of a phylo4 object.}
+\usage{
+isRooted(x)
+
+\S4method{isRooted}{phylo4}(x)
+
+rootNode(x)
+
+\S4method{rootNode}{phylo4}(x)
+
+rootNode(x) <- value
+
+\S4method{rootNode}{phylo4}(x) <- value
+}
+\arguments{
+\item{x}{a \code{phylo4} or \code{phylo4d} object.}
+
+\item{value}{a character string or a numeric giving the new root.}
+}
+\value{
+\describe{
+ \item{isRooted}{logical whether the tree is rooted}
+ \item{rootNode}{the node corresponding to the root}
+}
+}
+\description{
+Methods to test, access (and modify) the root of a phylo4 object.
+}
+\examples{
+data(geospiza)
+isRooted(geospiza)
+rootNode(geospiza)
+}
+\author{
+Ben Bolker, Francois Michonneau
+}
diff --git a/man/setAs-methods.Rd b/man/setAs-methods.Rd
new file mode 100644
index 0000000..01f19be
--- /dev/null
+++ b/man/setAs-methods.Rd
@@ -0,0 +1,69 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/setAs-methods.R
+\docType{methods}
+\name{setAs}
+\alias{setAs}
+\alias{as}
+\alias{as-method}
+\alias{as,phylo,phylo4-method}
+\alias{setAs}
+\alias{as,phylo,phylo4d-method}
+\alias{setAs}
+\alias{as,nexml,phylo4-method}
+\alias{setAs}
+\alias{as,nexml,phylo4d-method}
+\alias{setAs}
+\alias{as,phylo4,phylo-method}
+\alias{setAs}
+\alias{setAs,phylo4,phylog-method}
+\alias{setAs}
+\alias{setAs,phylo4,data.frame-method}
+\title{Converting between phylo4/phylo4d and other phylogenetic tree
+formats}
+\description{
+Translation functions to convert between phylobase objects
+(\code{phylo4} or \code{phylo4d}), and objects used by other
+comparative methods packages in R: \code{ape} objects
+(\code{phylo}, \code{multiPhylo}), \code{RNeXML} object
+(\code{nexml}), \code{ade4} objects (\code{phylog}, \emph{now
+deprecated}), and to \code{data.frame} representation.
+}
+\section{Usage}{
+ \code{as(object, class)}
+}
+
+\examples{
+tree_string <- "(((Strix_aluco:4.2,Asio_otus:4.2):3.1,Athene_noctua:7.3):6.3,Tyto_alba:13.5);"
+tree.owls <- ape::read.tree(text=tree_string)
+## round trip conversion
+tree_in_phylo <- tree.owls # tree is a phylo object
+(tree_in_phylo4 <- as(tree.owls,"phylo4")) # phylo converted to phylo4
+identical(tree_in_phylo,as(tree_in_phylo4,"phylo"))
+## test if phylo, and phylo4 converted to phylo are identical
+## (no, because of dimnames)
+
+## Conversion to phylog (ade4)
+as(tree_in_phylo4, "phylog")
+
+## Conversion to data.frame
+as(tree_in_phylo4, "data.frame")
+
+## Conversion to phylo (ape)
+as(tree_in_phylo4, "phylo")
+
+## Conversion to phylo4d, (data slots empty)
+as(tree_in_phylo4, "phylo4d")
+}
+\seealso{
+generic \code{\link[methods]{as}},
+\code{\link{phylo4-methods}}, \code{\link{phylo4d-methods}},
+\code{\link{extractTree}}, \code{nexml} class from the
+\code{RNeXML} package, \code{\link[ade4]{phylog}} from the
+\code{ade4} package and \code{\link[ape]{as.phylo}} from the
+\code{ape} package.
+}
+\author{
+Ben Bolker, Thibaut Jombart, Marguerite Butler, Steve
+Kembel, Francois Michonneau
+}
+\keyword{methods}
diff --git a/man/shortestPath-methods.Rd b/man/shortestPath-methods.Rd
new file mode 100644
index 0000000..c68e2ff
--- /dev/null
+++ b/man/shortestPath-methods.Rd
@@ -0,0 +1,40 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/shortestPath-methods.R
+\docType{methods}
+\name{shortestPath}
+\alias{shortestPath}
+\alias{shortestPath-phylo4}
+\alias{shortestPath,phylo4-method}
+\alias{shortestPath-phylo}
+\alias{shortestPath,phylo-method}
+\title{shortestPath-methods}
+\usage{
+shortestPath(x, node1, node2)
+
+\S4method{shortestPath}{phylo4}(x, node1, node2)
+
+\S4method{shortestPath}{phylo}(x, node1, node2)
+}
+\arguments{
+\item{x}{a tree in the phylo4, phylo4d or phylo format}
+
+\item{node1}{a numeric or character (passed to \code{getNode})
+indicating the beginning from which the path should be calculated.}
+
+\item{node2}{a numeric or character (passed to \code{getNode})
+indicating the end of the path.}
+}
+\value{
+a vector of nodes indcating the shortest path between 2 nodes
+}
+\description{
+Finds the shortest path between two nodes in a tree
+}
+\details{
+Given two nodes (i.e, tips or internal nodes), this function
+returns the shortest path between them (excluding \code{node1} and
+\code{node2} as a vector of nodes.
+}
+\seealso{
+getNode
+}
diff --git a/man/subset-methods.Rd b/man/subset-methods.Rd
new file mode 100644
index 0000000..4f60b6b
--- /dev/null
+++ b/man/subset-methods.Rd
@@ -0,0 +1,184 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/subset-methods.R
+\docType{methods}
+\name{subset-methods}
+\alias{subset-methods}
+\alias{subset}
+\alias{subset,phylo4-method}
+\alias{[}
+\alias{[,phylo4,character,missing,missing-method}
+\alias{[,phylo4,numeric,missing,missing-method}
+\alias{[,phylo4,logical,missing,missing-method}
+\alias{[,phylo4,missing,missing,missing-method}
+\alias{[,phylo4d,ANY,character,missing-method}
+\alias{[,phylo4d,ANY,numeric,missing-method}
+\alias{[,phylo4d,ANY,logical,missing-method}
+\alias{[,phylo4,ANY,ANY,ANY-method}
+\alias{prune}
+\alias{prune,phylo4-method}
+\alias{prune,phylo4d-method}
+\title{Methods for creating subsets of phylogenies}
+\usage{
+subset(x, ...)
+
+\S4method{subset}{phylo4}(x, tips.include = NULL, tips.exclude = NULL,
+ mrca = NULL, node.subtree = NULL, ...)
+
+"["(x, i, j, ..., drop = TRUE)
+
+\S4method{[}{phylo4,character,missing,missing}(x, i, j, ..., drop = TRUE)
+
+\S4method{[}{phylo4,numeric,missing,missing}(x, i, j, ..., drop = TRUE)
+
+\S4method{[}{phylo4,logical,missing,missing}(x, i, j, ..., drop = TRUE)
+
+\S4method{[}{phylo4,missing,missing,missing}(x, i, j, ..., drop = TRUE)
+
+\S4method{[}{phylo4d,ANY,character,missing}(x, i, j, ..., drop = TRUE)
+
+\S4method{[}{phylo4d,ANY,numeric,missing}(x, i, j, ..., drop = TRUE)
+
+\S4method{[}{phylo4d,ANY,logical,missing}(x, i, j, ..., drop = TRUE)
+
+\S4method{[}{phylo4,ANY,ANY,ANY}(x, i, j, ..., drop = TRUE)
+
+prune(x, ...)
+
+\S4method{prune}{phylo4}(x, tips.exclude, trim.internal = TRUE)
+
+\S4method{prune}{phylo4d}(x, tips.exclude, trim.internal = TRUE)
+}
+\arguments{
+\item{x}{an object of class \code{"phylo4"} or \code{"phylo4d"}}
+
+\item{\dots}{optional additional parameters (not in use)}
+
+\item{tips.include}{A vector of tips to include in the subset tree}
+
+\item{tips.exclude}{A vector of tips to exclude from the subset
+tree}
+
+\item{mrca}{A vector of nodes for determining the most recent
+common ancestor, which is then used as the root of the subset tree}
+
+\item{node.subtree}{A single internal node specifying the root of
+the subset tree}
+
+\item{i}{(\code{[} method) An index vector indicating tips to
+include}
+
+\item{j}{(\code{[} method, phylo4d only) An index vector
+indicating columns of node/tip data to include}
+
+\item{drop}{(not in use: for compatibility with the generic method)}
+
+\item{trim.internal}{A logical specifying whether to remove
+internal nodes that no longer have tip descendants in the subset
+tree}
+}
+\value{
+an object of class \code{"phylo4"} or \code{"phylo4d"}
+}
+\description{
+Methods for creating subsets of phylogenies, based on pruning a
+tree to include or exclude a set of terminal taxa, to include all
+descendants of the MRCA of multiple taxa, or to return a subtree
+rooted at a given node.
+}
+\details{
+The \code{subset} methods must be called using no more than one of
+the four main subsetting criteria arguments (\code{tips.include},
+\code{tips.exclude}, \code{mrca}, or \code{node.subtree}). Each
+of these arguments can be either character or numeric. In the
+first case, they are treated as node labels; in the second case,
+they are treated as node numbers. For the first two arguments,
+any supplied tips not found in the tree (\code{tipLabels(x)}) will
+be ignored, with a warning. Similarly, for the \code{mrca}
+argument, any supplied tips or internal nodes not found in the
+tree will be ignored, with a warning. For the \code{node.subtree}
+argument, failure to provide a single, valid internal node will
+result in an error.
+
+Although \code{prune} is mainly intended as the workhorse function
+called by \code{subset}, it may also be called directly. In
+general it should be equivalent to the \code{tips.exclude} form of
+\code{subset} (although perhaps with less up-front error
+checking).
+
+The "[" operator, when used as \code{x[i]}, is similar to the
+\code{tips.include} form of \code{subset}. However, the indices
+used with this operator can also be logical, in which case the
+corresponding tips are assumed to be ordered as in \code{nodeId(x,
+"tip")}, and recycling rules will apply (just like with a vector
+or a matrix). With a \linkS4class{phylo4d} object 'x',
+\code{x[i,j]} creates a subset of \code{x} taking \code{i} for a
+tip index and \code{j} for the index of data variables in
+\code{tdata(geospiza, "all")}. Note that the second index is
+optional: \code{x[i, TRUE]}, \code{x[i,]}, and \code{x[i]} are all
+equivalent.
+
+Regardless of which approach to subsetting is used, the argument
+values must be such that at least two tips are retained.
+
+If the most recent common ancestor of the retained tips is not the
+original root node, then the root node of the subset tree will be
+a descendant of the original root. For rooted trees with non-NA
+root edge length, this has implications for the new root edge
+length. In particular, the new length will be the summed edge
+length from the new root node back to the original root (including
+the original root edge). As an alternative, see the examples for
+a way to determine the length of the edge that was immediately
+ancestral to the new root node in the original tree.
+
+Note that the correspondance between nodes and labels (and data in
+the case of \linkS4class{phylo4d}) will be retained after all
+forms of subsetting. Beware, however, that the node numbers (IDs)
+will likely be altered to reflect the new tree topology, and
+therefore cannot be compared directly between the original tree
+and the subset tree.
+}
+\section{Methods}{
+ \describe{ \item{x = "phylo4"}{subset tree}
+\item{x = "phylo4d"}{subset tree and corresponding node and tip
+data} }
+}
+
+\examples{
+data(geospiza)
+nodeLabels(geospiza) <- paste("N", nodeId(geospiza, "internal"), sep="")
+geotree <- extractTree(geospiza)
+
+## "subset" examples
+tips <- c("difficilis", "fortis", "fuliginosa", "fusca", "olivacea",
+ "pallida", "parvulus", "scandens")
+plot(subset(geotree, tips.include=tips))
+plot(subset(geotree, tips.include=tips, trim.internal=FALSE))
+plot(subset(geotree, tips.exclude="scandens"))
+plot(subset(geotree, mrca=c("scandens","fortis","pauper")))
+plot(subset(geotree, node.subtree=18))
+
+## "prune" examples (equivalent to subset using tips.exclude)
+plot(prune(geotree, tips))
+
+## "[" examples (equivalent to subset using tips.include)
+plot(geotree[c(1:6,14)])
+plot(geospiza[c(1:6,14)])
+
+## for phylo4d, subset both tips and data columns
+geospiza[c(1:6,14), c("wingL", "beakD")]
+
+## note handling of root edge length:
+edgeLength(geotree)['0-15'] <- 0.1
+geotree2 <- geotree[1:2]
+## in subset tree, edge of new root extends back to the original root
+edgeLength(geotree2)['0-3']
+## edge length immediately ancestral to this node in the original tree
+edgeLength(geotree, MRCA(geotree, tipLabels(geotree2)))
+}
+\author{
+Jim Regetz \email{regetz at nceas.ucsb.edu}\cr Steven Kembel
+\email{skembel at berkeley.edu}\cr Damien de Vienne
+\email{damien.de-vienne at u-psud.fr}\cr Thibaut Jombart
+\email{jombart at biomserv.univ-lyon1.fr}
+}
+\keyword{methods}
diff --git a/man/summary-methods.Rd b/man/summary-methods.Rd
new file mode 100644
index 0000000..69c57fb
--- /dev/null
+++ b/man/summary-methods.Rd
@@ -0,0 +1,100 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/summary-methods.R
+\docType{methods}
+\name{summary-methods}
+\alias{summary-methods}
+\alias{summary}
+\alias{summary,phylo4-method}
+\alias{summary,phylo4d-method}
+\alias{nodeType}
+\alias{nodeType,phylo4-method}
+\title{Summary for phylo4/phylo4d objects}
+\usage{
+summary(object, ...)
+
+\S4method{summary}{phylo4}(object, quiet = FALSE)
+
+\S4method{summary}{phylo4d}(object, quiet = FALSE)
+
+nodeType(object)
+
+\S4method{nodeType}{phylo4}(object)
+}
+\arguments{
+\item{object}{a phylo4d object}
+
+\item{\dots}{optional additional elements (not in use)}
+
+\item{quiet}{Should the summary be displayed on screen?}
+}
+\value{
+The \code{nodeType} method returns named vector which has
+the type of node (internal, tip, root) for value, and the node number
+for name
+
+The \code{summary} method invisibly returns a list with the
+following components: \item{list("name")}{the name of the object}
+
+\item{list("nb.tips")}{the number of tips}
+
+\item{list("nb.nodes")}{the number of nodes}
+
+\item{list("mean.el")}{mean of edge lengths}
+
+\item{list("var.el")}{variance of edge lengths (estimate for population) }
+
+\item{list("sumry.el")}{summary (i.e. range and quartiles) of the
+edge lengths}
+
+\item{list("degree")}{(optional) type of polytomy for each node:
+\sQuote{node}, \sQuote{terminal} (all descendants are tips) or
+\sQuote{internal} (at least one descendant is an internal node);
+displayed only when there are polytomies}
+
+\item{list("sumry.tips")}{(optional) summary for the data
+associated with the tips}
+
+\item{list("sumry.nodes")}{(optional) summary for the data
+associated with the internal nodes}
+}
+\description{
+Summary of information for the tree (\code{phylo4} only) and/or the
+associated data (\code{phylo4d}).
+}
+\examples{
+ tOwls <- "(((Strix_aluco:4.2,Asio_otus:4.2):3.1,Athene_noctua:7.3):6.3,Tyto_alba:13.5);"
+ tree.owls <- ape::read.tree(text=tOwls)
+ P1 <- as(tree.owls, "phylo4")
+ P1
+ summary(P1)
+ nodeType(P1)
+
+ ## summary of a polytomous tree
+ E <- matrix(c(
+ 8, 9,
+ 9, 10,
+ 10, 1,
+ 10, 2,
+ 9, 3,
+ 9, 4,
+ 8, 11,
+ 11, 5,
+ 11, 6,
+ 11, 7,
+ 0, 8), ncol=2, byrow=TRUE)
+
+ P2 <- phylo4(E)
+ nodeLabels(P2) <- as.character(nodeId(P2, "internal"))
+ plot(P2, show.node.label=TRUE)
+ sumryP2 <- summary(P2)
+ sumryP2
+
+}
+\seealso{
+\code{\link{phylo4d-methods}} constructor and
+\code{\linkS4class{phylo4d}} class.
+}
+\author{
+Ben Bolker, Thibaut Jombart, Francois Michonneau
+}
+\keyword{methods}
diff --git a/man/tdata-methods.Rd b/man/tdata-methods.Rd
new file mode 100644
index 0000000..05fa32e
--- /dev/null
+++ b/man/tdata-methods.Rd
@@ -0,0 +1,114 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/tdata-methods.R
+\docType{methods}
+\name{tdata}
+\alias{tdata}
+\alias{tdata,phylo4d-method}
+\alias{tdata<-}
+\alias{tdata<-}
+\alias{tdata<-,phylo4d-method}
+\alias{tdata<-,phylo4d,ANY-method}
+\alias{tipData}
+\alias{tipData-method}
+\alias{tipData}
+\alias{tipData,phylo4d-method}
+\alias{tipData<-}
+\alias{tipData<-}
+\alias{tipData<-,phylo4d-method}
+\alias{tipData<-,phylo4d,ANY-method}
+\alias{nodeData}
+\alias{nodeData-method}
+\alias{nodeData}
+\alias{nodeData,phylo4d-method}
+\alias{nodeData<-}
+\alias{nodeData<-}
+\alias{nodeData<-,phylo4d-method}
+\alias{nodeData<-,phylo4d,ANY-method}
+\title{Retrieving or updating tip and node data in phylo4d objects}
+\usage{
+tdata(x, ...)
+
+\S4method{tdata}{phylo4d}(x, type = c("all", "tip", "internal"),
+ label.type = c("row.names", "column"), empty.columns = TRUE)
+
+tdata(x, ...) <- value
+
+\S4method{tdata}{phylo4d}(x, type = c("all", "tip", "internal"),
+ merge.data = TRUE, clear.all = FALSE, ...) <- value
+
+tipData(x, ...)
+
+\S4method{tipData}{phylo4d}(x, ...)
+
+tipData(x, ...) <- value
+
+\S4method{tipData}{phylo4d}(x, ...) <- value
+
+nodeData(x, ...)
+
+\S4method{nodeData}{phylo4d}(x, ...)
+
+nodeData(x, ...) <- value
+
+\S4method{nodeData}{phylo4d}(x, ...) <- value
+}
+\arguments{
+\item{x}{A \code{phylo4d} object}
+
+\item{\dots}{For the \code{tipData} and \code{nodeData} accessors,
+further arguments to be used by \code{tdata}. For the replacement
+forms, further arguments to be used to control matching between
+tree and data (see Details section of \code{\link{phylo4d-methods}}).}
+
+\item{type}{The type of data to retrieve or update: \dQuote{\code{all}}
+(default) for data associated with both tip and internal nodes,
+\dQuote{\code{tip}} for data associated with tips only,
+\dQuote{\code{internal}} for data associated with internal nodes only.}
+
+\item{label.type}{How should the tip/node labels from the tree be returned?
+\dQuote{\code{row.names}} returns them as row names of the data frame,
+\dQuote{\code{column}} returns them in the first column of the data frame.
+This options is useful in the case of missing (\code{NA}) or non-unique
+labels.}
+
+\item{empty.columns}{Should columns filled with \code{NA} be returned?}
+
+\item{value}{a data frame (or object to be coerced to one) to replace the
+values associated with the nodes specified by the argument \code{type}}
+
+\item{merge.data}{if tip or internal node data are provided and data already
+exists for the other type, this determines whether columns with common names
+will be merged together (default TRUE). If FALSE, columns with common names
+will be preserved separately, with \dQuote{.tip} and \dQuote{.node} appended
+to the names. This argument has no effect if tip and node data have no
+column names in common, or if type=\dQuote{all}.}
+
+\item{clear.all}{If only tip or internal node data are to be replaced,
+should data of the other type be dropped?}
+}
+\value{
+\code{tdata} returns a data frame
+}
+\description{
+Methods to retrieve or update tip, node or all data associated with a
+phylogenetic tree stored as a phylo4d object
+}
+\section{Methods}{
+ \describe{
+\item{tdata}{\code{signature(object="phylo4d")}: retrieve or update data
+associated with a tree in a \code{phylo4d} object} }
+}
+
+\examples{
+ data(geospiza)
+ tdata(geospiza)
+ tipData(geospiza) <- 1:nTips(geospiza)
+ tdata(geospiza)
+}
+\seealso{
+\code{\link{phylo4d-methods}}, \code{\linkS4class{phylo4d}}
+}
+\author{
+Ben Bolker, Thibaut Jombart, Francois Michonneau
+}
+\keyword{methods}
diff --git a/man/tip.data.plot.Rd b/man/tip.data.plot.Rd
new file mode 100644
index 0000000..7c497ec
--- /dev/null
+++ b/man/tip.data.plot.Rd
@@ -0,0 +1,48 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/treePlot.R
+\name{tip.data.plot}
+\alias{tip.data.plot}
+\title{Plotting trees and associated data}
+\usage{
+tip.data.plot(xxyy, type = c("phylogram", "cladogram", "fan"),
+ show.tip.label = TRUE, show.node.label = FALSE, rot = 0,
+ tip.plot.fun = grid.points, edge.color = "black", node.color = "black",
+ tip.color = "black", edge.width = 1, ...)
+}
+\arguments{
+\item{xxyy}{A list created by the \code{\link{phyloXXYY}} function}
+
+\item{type}{A character string indicating the shape of plotted tree}
+
+\item{show.tip.label}{Logical, indicating whether tip labels should be shown}
+
+\item{show.node.label}{Logical, indicating whether node labels should be
+shown}
+
+\item{rot}{Numeric indicating the rotation of the plot in degrees}
+
+\item{tip.plot.fun}{A function used to plot the data elements of a
+\code{phylo4d} object}
+
+\item{edge.color}{A vector of colors in the order of \code{edges(phy)}}
+
+\item{node.color}{A vector of colors indicating the colors of the node
+labels}
+
+\item{tip.color}{A vector of colors indicating the colors of the tip labels}
+
+\item{edge.width}{A vector in the order of \code{edges(phy)} indicating the
+widths of edge lines}
+
+\item{\dots}{Additional parameters passed to \code{tip.plot.fun}}
+}
+\value{
+creates a plot on the current graphics device.
+}
+\description{
+Plotting phylogenetic trees and associated data
+}
+\author{
+Peter Cowan
+}
+\keyword{methods}
diff --git a/man/treePlot-methods.Rd b/man/treePlot-methods.Rd
new file mode 100644
index 0000000..f549e63
--- /dev/null
+++ b/man/treePlot-methods.Rd
@@ -0,0 +1,117 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/treePlot.R
+\docType{methods}
+\name{treePlot-methods}
+\alias{treePlot-methods}
+\alias{treePlot}
+\alias{plot,ANY,ANY-method}
+\alias{plot,pdata,missing-method}
+\alias{plot,phylo4,missing-method}
+\alias{treePlot-method}
+\alias{treePlot,phylo4,phylo4d-method}
+\alias{plot}
+\alias{plot,phylo4,missing-method}
+\alias{plot,phylo4-method}
+\title{Phylogeny plotting}
+\usage{
+treePlot(phy, type = c("phylogram", "cladogram", "fan"),
+ show.tip.label = TRUE, show.node.label = FALSE, tip.order = NULL,
+ plot.data = is(phy, "phylo4d"), rot = 0, tip.plot.fun = "bubbles",
+ plot.at.tip = TRUE, edge.color = "black", node.color = "black",
+ tip.color = "black", edge.width = 1, newpage = TRUE, margins = c(1.1,
+ 1.1, 1.1, 1.1), ...)
+
+plot(x, y, ...)
+
+\S4method{plot}{phylo4,missing}(x, y, ...)
+}
+\arguments{
+\item{phy}{A \code{phylo4} or \code{phylo4d} object}
+
+\item{type}{A character string indicating the shape of plotted tree}
+
+\item{show.tip.label}{Logical, indicating whether tip labels should be shown}
+
+\item{show.node.label}{Logical, indicating whether node labels should be
+shown}
+
+\item{tip.order}{If NULL the tree is plotted with tips in preorder, if "rev"
+this is reversed. Otherwise, it is a character vector of tip labels,
+indicating their order along the y axis (from top to bottom). Or, a numeric
+vector of tip node IDs indicating the order.}
+
+\item{plot.data}{Logical indicating whether \code{phylo4d} data should be
+plotted}
+
+\item{rot}{Numeric indicating the rotation of the plot in degrees}
+
+\item{tip.plot.fun}{A function used to generate plot at the each tip of the
+phylogenetic trees}
+
+\item{plot.at.tip}{should the data plots be at the tip? (logical)}
+
+\item{edge.color}{A vector of colors in the order of \code{edges(phy)}}
+
+\item{node.color}{A vector of colors indicating the colors of the node
+labels}
+
+\item{tip.color}{A vector of colors indicating the colors of the tip labels}
+
+\item{edge.width}{A vector in the order of \code{edges(phy)} indicating the
+widths of edge lines}
+
+\item{newpage}{Logical indicating whether the page should be cleared before
+plotting}
+
+\item{margins}{number of lines around the plot (similar to \code{par(mar)}).}
+
+\item{\dots}{additional arguments}
+
+\item{x}{A \code{phylo4} or \code{phylo4d} object}
+
+\item{y}{(only here for compatibility)}
+}
+\value{
+No return value, function invoked for plotting side effect
+}
+\description{
+Plot \code{phylo4} or \code{phylo4d} objects, including associated data.
+}
+\details{
+Currently, \code{treePlot} can only plot numeric values
+for tree-associated data. The dataset will be subset to only
+include columns of class \code{numeric}, \code{integer} or
+\code{double}. If a \code{phylo4d} object is passed to the
+function and it contains no data, or if the data is in a format
+that cannot be plotted, the function will produce a warning. You
+can avoid this by using the argument \code{plot.data=FALSE}.
+}
+\section{Methods}{
+ \describe{ \item{phy = "phylo4"}{plots a tree of class
+\linkS4class{phylo4}} \item{phy = "phylo4d"}{plots a tree with one or more
+quantitative traits contained in a \linkS4class{phylo4d} object.} }
+}
+
+\examples{
+
+## example of plotting two grid plots on the same page
+library(grid)
+data(geospiza)
+geotree <- extractTree(geospiza)
+grid.newpage()
+pushViewport(viewport(layout=grid.layout(nrow=1, ncol=2), name="base"))
+ pushViewport(viewport(layout.pos.col=1, name="plot1"))
+ treePlot(geotree, newpage=FALSE)
+ popViewport()
+
+ pushViewport(viewport(layout.pos.col=2, name="plot2"))
+ treePlot(geotree, newpage=FALSE, rot=180)
+popViewport(2)
+}
+\seealso{
+\code{\link{phylobubbles}}
+}
+\author{
+Peter Cowan \email{pdc at berkeley.edu}, Francois Michonneau
+}
+\keyword{methods}
diff --git a/man/treeStructure-methods.Rd b/man/treeStructure-methods.Rd
new file mode 100644
index 0000000..a335bd7
--- /dev/null
+++ b/man/treeStructure-methods.Rd
@@ -0,0 +1,59 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/treestruc.R
+\docType{methods}
+\name{hasSingle}
+\alias{hasSingle}
+\alias{hasSingle,phylo4-method}
+\alias{hasRetic}
+\alias{hasRetic,phylo4-method}
+\alias{hasPoly}
+\alias{hasPoly,phylo4-method}
+\title{Test trees for polytomies, inline nodes (singletons), or reticulation}
+\usage{
+hasSingle(object)
+
+\S4method{hasSingle}{phylo4}(object)
+
+hasRetic(object)
+
+\S4method{hasRetic}{phylo4}(object)
+
+hasPoly(object)
+
+\S4method{hasPoly}{phylo4}(object)
+}
+\arguments{
+\item{object}{an object inheriting from class \code{phylo4}}
+}
+\value{
+Logical value
+}
+\description{
+Methods to test whether trees have (structural) polytomies, inline
+nodes (i.e., nodes with a single descendant), or reticulation
+(i.e., nodes with more than one ancestor). \code{hasPoly} only
+check for structural polytomies (1 node has more than 2
+descendants) and not polytomies that result from having edges with
+a length of 0.
+}
+\note{
+Some algorithms are unhappy with structural polytomies (i.e., >2
+descendants from a node), with single-descendant nodes, or with
+reticulation; these functions check those properties. We haven't bothered
+to check for zero branch lengths: the consensus is that it doesn't come up
+much, and that it's simple enough to test \code{any(edgeLength(x) == 0)} in
+these cases. (Single-descendant nodes are used e.g. in OUCH, or in other
+cases to represent events occurring along a branch.)
+}
+\examples{
+
+tree.owls.bis <- ape::read.tree(text="((Strix_aluco:4.2,Asio_otus:4.2):3.1,Athene_noctua:7.3);")
+owls4 <- as(tree.owls.bis, "phylo4")
+hasPoly(owls4)
+hasSingle(owls4)
+
+}
+\author{
+Ben Bolker
+}
+\keyword{misc}
diff --git a/src/Makevars b/src/Makevars
new file mode 100644
index 0000000..25844fb
--- /dev/null
+++ b/src/Makevars
@@ -0,0 +1,2 @@
+PKG_CPPFLAGS=-I. -DHAVE_INTTYPES_H -DASSERTS_TO_EXCEPTIONS
+## PKG_LIBS = `$(R_HOME)/bin/Rscript -e "Rcpp:::LdFlags()"`
diff --git a/src/Makevars.win b/src/Makevars.win
new file mode 100644
index 0000000..aa58e22
--- /dev/null
+++ b/src/Makevars.win
@@ -0,0 +1,6 @@
+## PKG_LIBS = -s $(shell Rscript -e 'Rcpp:::LdFlags()') -L"$(RHOME)/bin" -lR --no-export-all-symbols --add-stdcall-alias
+PKG_CXXFLAGS = -I. -DHAVE_INTTYPES_H -DASSERTS_TO_EXCEPTIONS
+## PKG_LIBS = $(shell "${R_HOME}/bin${R_ARCH_BIN}/Rscript.exe" -e "Rcpp:::LdFlags()")
+
+
+
diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp
new file mode 100644
index 0000000..aa426cb
--- /dev/null
+++ b/src/RcppExports.cpp
@@ -0,0 +1,222 @@
+// Generated by using Rcpp::compileAttributes() -> do not edit by hand
+// Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
+
+#include <Rcpp.h>
+
+using namespace Rcpp;
+
+// isLabelName
+bool isLabelName(Rcpp::CharacterVector lblToCheck, Rcpp::CharacterVector lbl);
+RcppExport SEXP phylobase_isLabelName(SEXP lblToCheckSEXP, SEXP lblSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type lblToCheck(lblToCheckSEXP);
+ Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type lbl(lblSEXP);
+ rcpp_result_gen = Rcpp::wrap(isLabelName(lblToCheck, lbl));
+ return rcpp_result_gen;
+END_RCPP
+}
+// nRoots
+int nRoots(Rcpp::IntegerVector ances);
+RcppExport SEXP phylobase_nRoots(SEXP ancesSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< Rcpp::IntegerVector >::type ances(ancesSEXP);
+ rcpp_result_gen = Rcpp::wrap(nRoots(ances));
+ return rcpp_result_gen;
+END_RCPP
+}
+// tabulateTips
+std::vector<int> tabulateTips(Rcpp::IntegerVector ances);
+RcppExport SEXP phylobase_tabulateTips(SEXP ancesSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< Rcpp::IntegerVector >::type ances(ancesSEXP);
+ rcpp_result_gen = Rcpp::wrap(tabulateTips(ances));
+ return rcpp_result_gen;
+END_RCPP
+}
+// nTipsSafe
+int nTipsSafe(Rcpp::IntegerVector ances);
+RcppExport SEXP phylobase_nTipsSafe(SEXP ancesSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< Rcpp::IntegerVector >::type ances(ancesSEXP);
+ rcpp_result_gen = Rcpp::wrap(nTipsSafe(ances));
+ return rcpp_result_gen;
+END_RCPP
+}
+// nTipsFastCpp
+int nTipsFastCpp(Rcpp::IntegerVector ances);
+RcppExport SEXP phylobase_nTipsFastCpp(SEXP ancesSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< Rcpp::IntegerVector >::type ances(ancesSEXP);
+ rcpp_result_gen = Rcpp::wrap(nTipsFastCpp(ances));
+ return rcpp_result_gen;
+END_RCPP
+}
+// hasSingleton
+bool hasSingleton(Rcpp::IntegerVector ances);
+RcppExport SEXP phylobase_hasSingleton(SEXP ancesSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< Rcpp::IntegerVector >::type ances(ancesSEXP);
+ rcpp_result_gen = Rcpp::wrap(hasSingleton(ances));
+ return rcpp_result_gen;
+END_RCPP
+}
+// hasPolytomy
+bool hasPolytomy(Rcpp::IntegerVector ances);
+RcppExport SEXP phylobase_hasPolytomy(SEXP ancesSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< Rcpp::IntegerVector >::type ances(ancesSEXP);
+ rcpp_result_gen = Rcpp::wrap(hasPolytomy(ances));
+ return rcpp_result_gen;
+END_RCPP
+}
+// tipsSafe
+Rcpp::IntegerVector tipsSafe(Rcpp::IntegerVector ances, Rcpp::IntegerVector desc);
+RcppExport SEXP phylobase_tipsSafe(SEXP ancesSEXP, SEXP descSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< Rcpp::IntegerVector >::type ances(ancesSEXP);
+ Rcpp::traits::input_parameter< Rcpp::IntegerVector >::type desc(descSEXP);
+ rcpp_result_gen = Rcpp::wrap(tipsSafe(ances, desc));
+ return rcpp_result_gen;
+END_RCPP
+}
+// tipsFast
+Rcpp::IntegerVector tipsFast(Rcpp::IntegerVector ances);
+RcppExport SEXP phylobase_tipsFast(SEXP ancesSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< Rcpp::IntegerVector >::type ances(ancesSEXP);
+ rcpp_result_gen = Rcpp::wrap(tipsFast(ances));
+ return rcpp_result_gen;
+END_RCPP
+}
+// getAllNodesSafe
+Rcpp::IntegerVector getAllNodesSafe(Rcpp::IntegerMatrix edge);
+RcppExport SEXP phylobase_getAllNodesSafe(SEXP edgeSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< Rcpp::IntegerMatrix >::type edge(edgeSEXP);
+ rcpp_result_gen = Rcpp::wrap(getAllNodesSafe(edge));
+ return rcpp_result_gen;
+END_RCPP
+}
+// getAllNodesFast
+Rcpp::IntegerVector getAllNodesFast(Rcpp::IntegerMatrix edge);
+RcppExport SEXP phylobase_getAllNodesFast(SEXP edgeSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< Rcpp::IntegerMatrix >::type edge(edgeSEXP);
+ rcpp_result_gen = Rcpp::wrap(getAllNodesFast(edge));
+ return rcpp_result_gen;
+END_RCPP
+}
+// testEqInt
+Rcpp::List testEqInt(Rcpp::IntegerVector x, Rcpp::IntegerVector y);
+RcppExport SEXP phylobase_testEqInt(SEXP xSEXP, SEXP ySEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< Rcpp::IntegerVector >::type x(xSEXP);
+ Rcpp::traits::input_parameter< Rcpp::IntegerVector >::type y(ySEXP);
+ rcpp_result_gen = Rcpp::wrap(testEqInt(x, y));
+ return rcpp_result_gen;
+END_RCPP
+}
+// all_naC
+bool all_naC(Rcpp::NumericVector x);
+RcppExport SEXP phylobase_all_naC(SEXP xSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< Rcpp::NumericVector >::type x(xSEXP);
+ rcpp_result_gen = Rcpp::wrap(all_naC(x));
+ return rcpp_result_gen;
+END_RCPP
+}
+// any_naC
+bool any_naC(Rcpp::NumericVector x);
+RcppExport SEXP phylobase_any_naC(SEXP xSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< Rcpp::NumericVector >::type x(xSEXP);
+ rcpp_result_gen = Rcpp::wrap(any_naC(x));
+ return rcpp_result_gen;
+END_RCPP
+}
+// nb_naC
+int nb_naC(Rcpp::NumericVector x);
+RcppExport SEXP phylobase_nb_naC(SEXP xSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< Rcpp::NumericVector >::type x(xSEXP);
+ rcpp_result_gen = Rcpp::wrap(nb_naC(x));
+ return rcpp_result_gen;
+END_RCPP
+}
+// getRange
+Rcpp::NumericVector getRange(Rcpp::NumericVector x, const bool na_rm);
+RcppExport SEXP phylobase_getRange(SEXP xSEXP, SEXP na_rmSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< Rcpp::NumericVector >::type x(xSEXP);
+ Rcpp::traits::input_parameter< const bool >::type na_rm(na_rmSEXP);
+ rcpp_result_gen = Rcpp::wrap(getRange(x, na_rm));
+ return rcpp_result_gen;
+END_RCPP
+}
+// hasDuplicatedLabelsCpp
+bool hasDuplicatedLabelsCpp(Rcpp::CharacterVector label);
+RcppExport SEXP phylobase_hasDuplicatedLabelsCpp(SEXP labelSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type label(labelSEXP);
+ rcpp_result_gen = Rcpp::wrap(hasDuplicatedLabelsCpp(label));
+ return rcpp_result_gen;
+END_RCPP
+}
+// edgeIdCpp
+Rcpp::CharacterVector edgeIdCpp(Rcpp::IntegerMatrix edge, std::string type);
+RcppExport SEXP phylobase_edgeIdCpp(SEXP edgeSEXP, SEXP typeSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< Rcpp::IntegerMatrix >::type edge(edgeSEXP);
+ Rcpp::traits::input_parameter< std::string >::type type(typeSEXP);
+ rcpp_result_gen = Rcpp::wrap(edgeIdCpp(edge, type));
+ return rcpp_result_gen;
+END_RCPP
+}
+// checkTreeCpp
+Rcpp::List checkTreeCpp(Rcpp::S4 obj, Rcpp::List opts);
+RcppExport SEXP phylobase_checkTreeCpp(SEXP objSEXP, SEXP optsSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< Rcpp::S4 >::type obj(objSEXP);
+ Rcpp::traits::input_parameter< Rcpp::List >::type opts(optsSEXP);
+ rcpp_result_gen = Rcpp::wrap(checkTreeCpp(obj, opts));
+ return rcpp_result_gen;
+END_RCPP
+}
diff --git a/src/ancestors.c b/src/ancestors.c
new file mode 100644
index 0000000..f8665ed
--- /dev/null
+++ b/src/ancestors.c
@@ -0,0 +1,53 @@
+/*
+ ancestors.c:
+ Identify all ancestors of each node in the input vector. Function
+ inputs are derived from a phylo4 edge matrix, which *must* be in
+ postorder order. The isAncestor output is an indicator matrix of
+ which nodes (rows, corresponding to the decendant vector) are
+ ancestors of each input node (columns, corresponding to the nodes
+ vector). It will contain 1 for each ancestor of the node, *including
+ itself*, and 0 for all other nodes.
+
+ Jim Regetz (NCEAS)
+*/
+
+#include <R.h>
+#include <Rinternals.h>
+
+SEXP ancestors_c(SEXP nod, SEXP anc, SEXP des) {
+
+ int numEdges = length(anc);
+ int numNodes = length(nod);
+
+ int* nodes = INTEGER(nod);
+ int* ancestor = INTEGER(anc);
+ int* descendant = INTEGER(des);
+
+ int parent = 0;
+ SEXP isAncestor;
+
+ PROTECT(isAncestor = allocMatrix(INTSXP, numEdges, numNodes));
+ for (int n=0; n<numNodes; n++) {
+ for (int i=0; i<numEdges; i++) {
+ if (nodes[n]==descendant[i]) {
+ INTEGER(isAncestor)[i + n*numEdges] = 1;
+ } else {
+ INTEGER(isAncestor)[i + n*numEdges] = 0;
+ }
+ }
+ }
+ for (int n=0; n<numNodes; n++) {
+ for (int i=0; i<numEdges; i++) {
+ if (INTEGER(isAncestor)[i + n*numEdges]==1) {
+ parent = ancestor[i];
+ for (int j=i+1; j<numEdges; j++) {
+ if (descendant[j]==parent) {
+ INTEGER(isAncestor)[j + n*numEdges]=1;
+ }
+ }
+ }
+ }
+ }
+ UNPROTECT(1);
+ return isAncestor;
+}
diff --git a/src/checkPhylo4.cpp b/src/checkPhylo4.cpp
new file mode 100644
index 0000000..6de5495
--- /dev/null
+++ b/src/checkPhylo4.cpp
@@ -0,0 +1,415 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*-
+
+#include <Rcpp.h>
+#include <algorithm> // std::count_if
+#include <vector> // std::vector
+#include <string> //
+
+template <typename T>
+std::string NumberToString ( T Number ) {
+ std::ostringstream ss;
+ ss << Number;
+ return ss.str();
+}
+
+bool isZero(int i) { return (i == 0); }
+bool isOne(int i) { return ( i == 1); }
+bool isSupTwo(int i) { return (i > 2); }
+bool isEqual(int i, int j) { return (i == j); }
+
+Rcpp::IntegerVector getAnces(Rcpp::IntegerMatrix obj) {
+// returns the first column (ancestors) of the edge matrix
+ Rcpp::IntegerMatrix::Column out = obj( Rcpp::_ , 0);
+ return out;
+}
+
+Rcpp::IntegerVector getDesc(Rcpp::IntegerMatrix obj) {
+// returns the second column (descendants) of the edge matrix
+ Rcpp::IntegerMatrix::Column out = obj( Rcpp::_ , 1);
+ return out;
+}
+
+//[[Rcpp::export]]
+bool isLabelName(Rcpp::CharacterVector lblToCheck,
+ Rcpp::CharacterVector lbl ) {
+
+ Rcpp::CharacterVector noLbl = Rcpp::setdiff(lblToCheck, lbl);
+ return noLbl.size() == 0;
+}
+
+//[[Rcpp::export]]
+int nRoots (Rcpp::IntegerVector ances) {
+ int ans = std::count (ances.begin(), ances.end(), 0);
+ return ans;
+}
+
+//[[Rcpp::export]]
+std::vector<int> tabulateTips (Rcpp::IntegerVector ances) {
+// tabulates ancestor nodes that are not the root.
+ int n = Rcpp::max(ances);
+ std::vector<int> ans(n);
+ for (int i=0; i < ances.size(); i++) {
+ int j = ances[i];
+ if (j > 0) {
+ ans[j - 1]++;
+ }
+ }
+ return ans;
+}
+
+//[[Rcpp::export]]
+int nTipsSafe (Rcpp::IntegerVector ances) {
+// count how many zeros are in the tabulated vector of ancestors
+// this gives the number of tips
+ std::vector<int> tabTips = tabulateTips(ances);
+ int j = count_if (tabTips.begin(), tabTips.end(), isZero);
+ return j;
+}
+
+//[[Rcpp::export]]
+int nTipsFastCpp (Rcpp::IntegerVector ances) {
+// if nodes are correctly numbered min(ances) - 1 = nb of tips
+// (after removing the root, which is equal to 0).
+ int nroots = nRoots(ances);
+ if (nroots > 0) {
+ int whichRoot = Rcpp::which_min(ances);
+ ances.erase(whichRoot);
+ }
+ int tmp = Rcpp::min(ances);
+ return tmp - 1;
+}
+
+//[[Rcpp::export]]
+bool hasSingleton (Rcpp::IntegerVector ances) {
+ std::vector<int> tabTips = tabulateTips(ances);
+ int j = count_if (tabTips.begin(), tabTips.end(), isOne);
+ return j > 0;
+}
+
+//[[Rcpp::export]]
+bool hasPolytomy (Rcpp::IntegerVector ances) {
+ std::vector<int> tabTips = tabulateTips(ances);
+ int j = count_if (tabTips.begin(), tabTips.end(), isSupTwo);
+ return j > 0;
+}
+
+
+//[[Rcpp::export]]
+Rcpp::IntegerVector tipsSafe (Rcpp::IntegerVector ances, Rcpp::IntegerVector desc) {
+ Rcpp::IntegerVector res = Rcpp::match(desc, ances);
+ Rcpp::LogicalVector istip = Rcpp::is_na(res);
+ int nedge = ances.size();
+ std::vector<int> y(nedge);
+ int j = 0;
+ for(int i = 0; i < nedge; i++) {
+ if (istip[i]) {
+ y[j] = desc[i];
+ j++;
+ }
+ }
+ Rcpp::IntegerVector ans(j);
+ std::copy (y.begin(), y.begin()+j, ans.begin());
+ std::sort (ans.begin(), ans.end());
+ return ans;
+}
+
+//[[Rcpp::export]]
+Rcpp::IntegerVector tipsFast (Rcpp::IntegerVector ances) {
+ int ntips = nTipsFastCpp(ances);
+ Rcpp::IntegerVector ans = Rcpp::seq_len(ntips);
+ return ans;
+}
+
+
+//[[Rcpp::export]]
+Rcpp::IntegerVector getAllNodesSafe (Rcpp::IntegerMatrix edge) {
+ Rcpp::IntegerVector ans = Rcpp::as_vector(edge);
+ Rcpp::IntegerVector tmp = Rcpp::unique(ans);
+ std::sort(tmp.begin(), tmp.end());
+ return tmp;
+}
+
+//[[Rcpp::export]]
+Rcpp::IntegerVector getAllNodesFast (Rcpp::IntegerMatrix edge) {
+ Rcpp::IntegerVector tmp = Rcpp::as_vector(edge);
+ Rcpp::IntegerVector maxN = Rcpp::range(tmp);
+ Rcpp::IntegerVector ans;
+ if (maxN[0] == 0) {
+ ans = Rcpp::seq_len(maxN[1] + 1);
+ ans = ans - 1;
+ }
+ else {
+ ans = Rcpp::seq_len(maxN[1]);
+ }
+ return ans;
+}
+
+
+// Rcpp::List testNodes (Rcpp::IntegerMatrix edge, bool rooted) {
+// Rcpp::IntegerVector allNodes = Rcpp::as_vector(edge);
+// allNodes = Rcpp::unique(allNodes);
+// std::sort (allNodes.begin(), allNodes.end());
+// Rcpp::IntegerVector supposedNodes = getAllNodesFast(edge, rooted);
+// Rcpp::IntegerVector test = Rcpp::setdiff(supposedNodes, allNodes);
+// Rcpp::LogicalVector res = supposedNodes == allNodes;
+// return Rcpp::List::create(supposedNodes, allNodes, test, res);
+// }
+
+//[[Rcpp::export]]
+Rcpp::List testEqInt (Rcpp::IntegerVector x, Rcpp::IntegerVector y) {
+ Rcpp::LogicalVector xy = x == y;
+ Rcpp::LogicalVector yx = y == x;
+ return Rcpp::List::create(xy, yx);
+}
+
+// Rcpp::IntegerVector getInternalNodes (Rcpp::IntegerMatrix edge, bool rooted) {
+// Rcpp::IntegerVector ances = getAnces(edge);
+// Rcpp::IntegerVector allNodes = getAllNodesFast(edge, rooted);
+// Rcpp::IntegerVector tips = tipsFast(ances);
+// Rcpp::IntegerVector intNodes = Rcpp::setdiff(allNodes, tips);
+// intNodes.erase(intNodes.begin());
+// return intNodes;
+// }
+
+//[[Rcpp::export]]
+bool all_naC (Rcpp::NumericVector x) {
+ return is_true(all(is_na(x)));
+}
+
+//[[Rcpp::export]]
+bool any_naC (Rcpp::NumericVector x) {
+ return is_true(any(is_na(x)));
+}
+
+//[[Rcpp::export]]
+int nb_naC (Rcpp::NumericVector x) {
+ return sum(is_na(x));
+}
+
+
+//[[Rcpp::export]]
+Rcpp::NumericVector getRange(Rcpp::NumericVector x, const bool na_rm) {
+ Rcpp::NumericVector out(2);
+ out[0] = R_PosInf;
+ out[1] = R_NegInf;
+
+ int n = x.length();
+ for(int i = 0; i < n; ++i) {
+ if (!na_rm && R_IsNA(x[i])) {
+ out[0] = NA_REAL;
+ out[1] = NA_REAL;
+ return(out);
+ }
+
+ if (x[i] < out[0]) out[0] = x[i];
+ if (x[i] > out[1]) out[1] = x[i];
+ }
+
+ return(out);
+}
+
+//[[Rcpp::export]]
+bool hasDuplicatedLabelsCpp (Rcpp::CharacterVector label) {
+ return is_true(any(Rcpp::duplicated(na_omit(label))));
+}
+
+Rcpp::CharacterVector edgeIdCppInternal (Rcpp::IntegerVector tmp1, Rcpp::IntegerVector tmp2) {
+ Rcpp::CharacterVector tmpV1 = Rcpp::as< Rcpp::CharacterVector >(tmp1);
+ Rcpp::CharacterVector tmpV2 = Rcpp::as< Rcpp::CharacterVector >(tmp2);
+ int Ne = tmp1.size();
+ Rcpp::CharacterVector res(Ne);
+ for (int i = 0; i < Ne; i++) {
+ std::string tmpS1;
+ tmpS1 = tmpV1[i];
+ std::string tmpS2;
+ tmpS2 = tmpV2[i];
+ std::string tmpS;
+ tmpS = tmpS1.append("-");
+ tmpS = tmpS.append(tmpS2);
+ res[i] = tmpS;
+ }
+ return res;
+}
+
+//[[Rcpp::export]]
+Rcpp::CharacterVector edgeIdCpp (Rcpp::IntegerMatrix edge, std::string type) {
+ Rcpp::IntegerVector ances = getAnces(edge);
+ Rcpp::IntegerVector desc = getDesc(edge);
+ int nedge;
+
+ if (type == "tip" || type == "internal") {
+ Rcpp::IntegerVector tips = tipsFast(ances);
+ nedge = tips.size();
+ Rcpp::IntegerVector ans = match(tips, desc);
+ if (type == "tip") {
+ Rcpp::IntegerVector tmpAnces(nedge);
+ Rcpp::IntegerVector tmpDesc(nedge);
+ for (int j = 0; j < nedge; j++) {
+ tmpAnces[j] = ances[ans[j]-1];
+ tmpDesc[j] = desc[ans[j]-1];
+ }
+ Rcpp::CharacterVector c1(nedge);
+ c1 = edgeIdCppInternal(tmpAnces, tmpDesc);
+ return c1;
+ }
+ else if (type == "internal") {
+ int allEdges = ances.size();
+ Rcpp::IntegerVector idEdge = Rcpp::seq_len(allEdges);
+ Rcpp::IntegerVector intnd = Rcpp::setdiff(idEdge, ans);
+ nedge = intnd.size();
+ Rcpp::IntegerVector tmpAnces(nedge);
+ Rcpp::IntegerVector tmpDesc(nedge);
+ for (int j = 0; j < nedge; j++) {
+ tmpAnces[j] = ances[intnd[j]-1];
+ tmpDesc[j] = desc[intnd[j]-1];
+ }
+ Rcpp::CharacterVector c1(nedge);
+ c1 = edgeIdCppInternal(tmpAnces, tmpDesc);
+ return c1;
+ }
+ }
+ else {
+ nedge = ances.size();
+ Rcpp::IntegerVector tmpAnces = ances;
+ Rcpp::IntegerVector tmpDesc = desc;
+ Rcpp::CharacterVector c1(nedge);
+ c1 = edgeIdCppInternal(tmpAnces, tmpDesc);
+ return c1;
+ }
+ return "";
+}
+
+//[[Rcpp::export]]
+Rcpp::List checkTreeCpp(Rcpp::S4 obj, Rcpp::List opts) {
+
+ std::string err, wrn;
+ Rcpp::IntegerMatrix ed = obj.slot("edge");
+ int nrow = ed.nrow();
+ Rcpp::IntegerVector ances = getAnces(ed);
+ //Rcpp::IntegerVector desc = getDesc(ed);
+ int nroots = nRoots(ances);
+ //bool rooted = nroots > 0;
+ Rcpp::NumericVector edLength = obj.slot("edge.length");
+ Rcpp::CharacterVector edLengthNm = edLength.names();
+ Rcpp::CharacterVector label = obj.slot("label");
+ Rcpp::CharacterVector labelNm = label.names();
+ Rcpp::CharacterVector edLabel = obj.slot("edge.label");
+ Rcpp::CharacterVector edLabelNm = edLabel.names();
+ Rcpp::IntegerVector allnodesSafe = getAllNodesSafe(ed);
+ Rcpp::IntegerVector allnodesFast = getAllNodesFast(ed);
+ int nEdLength = edLength.size();
+ //int nLabel = label.size();
+ //int nEdLabel = edLabel.size();
+ int nEdges = nrow;
+ bool hasEdgeLength = !all_naC(edLength);
+
+ // check tips
+ int ntipsSafe = nTipsSafe(ances);
+ int ntipsFast = nTipsFastCpp(ances);
+ bool testnTips = ntipsFast == ntipsSafe;
+ if (! testnTips) {
+ err.append("Tips incorrectly labeled. ");
+ }
+
+ //check internal nodes
+ bool testNodes = Rcpp::all(allnodesSafe == allnodesFast).is_true() && // is both ways comparison needed?
+ Rcpp::all(allnodesFast == allnodesSafe).is_true();
+ if (! testNodes) {
+ err.append("Nodes incorrectly labeled. ");
+ }
+
+ // check edge lengths
+ if (hasEdgeLength) {
+ if (nEdLength != nEdges) {
+ err.append("Number of edge lengths do not match number of edges. ");
+ }
+ // if (nb_naC(edLength) > nroots) { // not enough! -- best done in R
+ // err.append("Only the root should have NA as an edge length. ");
+ // }
+ if (getRange(edLength, TRUE)[0] < 0) {
+ err.append("Edge lengths must be non-negative. ");
+ }
+ Rcpp::CharacterVector edgeLblSupp = edgeIdCpp(ed, "all");
+ Rcpp::CharacterVector edgeLblDiff = Rcpp::setdiff(edLengthNm, edgeLblSupp);
+ if ( edgeLblDiff.size() != 0 ) {
+ err.append("Edge lengths incorrectly labeled. ");
+ }
+ }
+
+ // check label names
+ Rcpp::CharacterVector chrLabelNm = Rcpp::as<Rcpp::CharacterVector>(allnodesFast);
+ int j = 0;
+ while (j < nroots) { //remove root(s)
+ chrLabelNm.erase(0);
+ j++;
+ }
+ bool testLabelNm = isLabelName(labelNm, chrLabelNm);
+ if (!testLabelNm) {
+ err.append("Tip and node labels must be a named vector, the names must match the node IDs. ");
+ err.append("Use tipLabels<- and/or nodeLabels<- to update them. ");
+ }
+
+ // check that tips have labels
+ Rcpp::CharacterVector tiplabel(ntipsFast);
+ std::copy (label.begin(), label.begin()+ntipsFast, tiplabel.begin());
+ bool emptyTipLabel = is_true(any(Rcpp::is_na(tiplabel)));
+ if ( emptyTipLabel ) {
+ err.append("All tips must have a label.");
+ }
+
+ // check edgeLabels
+ Rcpp::CharacterVector chrEdgeLblNm = edgeIdCpp(ed, "all");
+ bool testEdgeLblNm = isLabelName(edLabelNm, chrEdgeLblNm);
+ if (!testEdgeLblNm) {
+ err.append("Edge labels are not labelled correctly. Use the function edgeLabels<- to update them. ");
+ }
+
+ // make sure that tips and node labels are unique
+ if (hasDuplicatedLabelsCpp(label)) {
+ std::string labOpt = opts["allow.duplicated.labels"];
+ if (labOpt == "fail") {
+ err.append("Labels are not unique. ");
+ }
+ if (labOpt == "warn") {
+ wrn.append("Labels are not unique. ");
+ }
+ }
+
+ // check for polytomies
+ if (hasPolytomy(ances)) {
+ std::string msgPoly = "Tree includes polytomies. ";
+ std::string polyOpt = opts["poly"];
+ if (polyOpt == "fail") {
+ err.append(msgPoly);
+ }
+ if (polyOpt == "warn") {
+ wrn.append(msgPoly);
+ }
+ }
+
+ // check number of roots
+ if (nroots > 1) {
+ std::string msgRoot = "Tree has more than one root. ";
+ std::string rootOpt = opts["multiroot"];
+ if (rootOpt == "fail") {
+ err.append(msgRoot);
+ }
+ if (rootOpt == "warn") {
+ wrn.append(msgRoot);
+ }
+ }
+
+ // check for singletons
+ if (hasSingleton(ances)) {
+ std::string msgSing = "Tree contains singleton nodes. ";
+ std::string singOpt = opts["singleton"];
+ if (singOpt == "fail") {
+ err.append(msgSing);
+ }
+ if (singOpt == "warn") {
+ wrn.append(msgSing);
+ }
+ }
+
+ return Rcpp::List::create(err, wrn);
+}
diff --git a/src/descendants.c b/src/descendants.c
new file mode 100644
index 0000000..b3f12be
--- /dev/null
+++ b/src/descendants.c
@@ -0,0 +1,53 @@
+/*
+ descendants.c:
+ Identify all descendants of each node in the input vector. Function
+ inputs are derived from a phylo4 edge matrix, which *must* be in
+ preorder order. The isDescendant output is an indicator matrix of
+ which nodes (rows, corresponding to the decendant vector) are
+ descendants of each input node (columns, corresponding to the nodes
+ vector). It will contain 1 for each descendant of the node, *including
+ itself*, and 0 for all other nodes.
+
+ Jim Regetz (NCEAS)
+*/
+
+#include <R.h>
+#include <Rinternals.h>
+
+SEXP descendants_c(SEXP nod, SEXP anc, SEXP des) {
+
+ int numEdges = length(anc);
+ int numNodes = length(nod);
+
+ int* nodes = INTEGER(nod);
+ int* ancestor = INTEGER(anc);
+ int* descendant = INTEGER(des);
+
+ int child = 0;
+ SEXP isDescendant;
+
+ PROTECT(isDescendant = allocMatrix(INTSXP, numEdges, numNodes));
+ for (int n=0; n<numNodes; n++) {
+ for (int i=0; i<numEdges; i++) {
+ if (nodes[n]==descendant[i]) {
+ INTEGER(isDescendant)[i + n*numEdges] = 1;
+ } else {
+ INTEGER(isDescendant)[i + n*numEdges] = 0;
+ }
+ }
+ }
+ for (int n=0; n<numNodes; n++) {
+ for (int i=0; i<numEdges; i++) {
+ if (INTEGER(isDescendant)[i + n*numEdges]==1) {
+ child = descendant[i];
+ for (int j=i+1; j<numEdges; j++) {
+ if (ancestor[j]==child) {
+ INTEGER(isDescendant)[j + n*numEdges] = 1;
+ }
+ }
+ }
+ }
+ }
+ UNPROTECT(1);
+ return isDescendant;
+}
diff --git a/src/phyloXX.c b/src/phyloXX.c
new file mode 100644
index 0000000..047ad85
--- /dev/null
+++ b/src/phyloXX.c
@@ -0,0 +1,97 @@
+/*
+ descendants.c:
+ Identify all descendants of a given node. Function inputs are
+ derived from a phylo4 edge matrix, which *must* be in preorder order.
+ The isDescendant input vector should contain 1 for the immediate
+ children of the node, and 0 otherwise. The function returns this
+ vector updated to include all further descendants.
+*/
+
+// test1 <- function() {
+// for (i in edge[, 2]) {
+// dex <- edge[, 1] == i
+// cur <- edge[, 2] == i
+// xx[dex] <- phy at edge.length[dex] + xx[cur]
+// segs$v0x[dex] <- xx[cur]
+// }
+// return(list(segs=segs, xx=xx))
+// }
+// test1out <- test1()
+// segs <- test1out$segs
+// xx <- test1out$xx
+
+// test2 <- function() {
+// for(i in rev((Ntips + 1):nEdges(phy))) {
+// dex <- edge[, 1] == i
+// cur <- edge[, 2] == i
+// yy[cur] <- segs$v0y[dex] <- mean(yy[dex])
+// }
+// return(list(segs=segs, yy=yy))
+// }
+// test2out <- test2()
+// segs <- test2out$segs
+// yy <- test2out$yy
+// segs$h0y <- segs$h1y <- segs$v1y <- yy
+
+#include <R.h>
+
+//
+// void phyloyy(int *edge1, int *edge2, int *ntips,
+// int *numEdges, double *yy, double *v0y)
+// {
+// int i;
+// int k;
+// int j;
+// int cur;
+// int des;
+// int count;
+// double tmp;
+// double theMean;
+// Rprintf("test\n");
+// for (i=*numEdges; i > *ntips ; i--) {
+// for (k=0; k<*numEdges; k++) {
+// if(i == edge2[k]) {
+// cur = k;
+// }
+// }
+// tmp=0;
+// count=0;
+// for (j=0; j<*numEdges; j++) {
+// if(i == edge1[j]) {
+// des = j;
+// tmp += yy[j];
+// count += 1;
+// }
+// }
+// theMean = tmp / count;
+// yy[cur] = theMean;
+// for (j=0; j<*numEdges; j++) {
+// if(i == edge1[j]) {
+// v0y[j] = theMean;
+// }
+// }
+//
+// }
+// }
+
+void phyloxx(int *edge1, int *edge2, double *edgeLengths,
+ int *numEdges, double *xx, double *v0x)
+{
+ int j;
+ int i;
+ int k;
+ int cur=0;
+ for (i=0; i <*numEdges; i++) {
+ for (k=0; k<*numEdges; k++) {
+ if(edge2[i] == edge2[k]) {
+ cur = k;
+ }
+ }
+ for (j=0; j<*numEdges; j++) {
+ if(edge2[i] == edge1[j]) {
+ xx[j] = edgeLengths[j] + xx[cur];
+ v0x[j] = xx[cur];
+ }
+ }
+ }
+}
diff --git a/src/phylobase_init.c b/src/phylobase_init.c
new file mode 100644
index 0000000..29eddde
--- /dev/null
+++ b/src/phylobase_init.c
@@ -0,0 +1,74 @@
+#include <R.h>
+#include <Rinternals.h>
+#include <stdlib.h> // for NULL
+#include <R_ext/Rdynload.h>
+
+/* FIXME:
+ Check these declarations against the C/Fortran source code.
+*/
+
+/* .C calls */
+extern void phyloxx(void *, void *, void *, void *, void *, void *);
+extern void reorderBinary(void *, void *, void *, void *, void *, void *, void *);
+extern void reorderRobust(void *, void *, void *, void *, void *, void *);
+
+/* .Call calls */
+extern SEXP ancestors_c(SEXP, SEXP, SEXP);
+extern SEXP descendants_c(SEXP, SEXP, SEXP);
+extern SEXP phylobase_all_naC(SEXP);
+extern SEXP phylobase_any_naC(SEXP);
+extern SEXP phylobase_checkTreeCpp(SEXP, SEXP);
+extern SEXP phylobase_edgeIdCpp(SEXP, SEXP);
+extern SEXP phylobase_getAllNodesFast(SEXP);
+extern SEXP phylobase_getAllNodesSafe(SEXP);
+extern SEXP phylobase_getRange(SEXP, SEXP);
+extern SEXP phylobase_hasDuplicatedLabelsCpp(SEXP);
+extern SEXP phylobase_hasPolytomy(SEXP);
+extern SEXP phylobase_hasSingleton(SEXP);
+extern SEXP phylobase_isLabelName(SEXP, SEXP);
+extern SEXP phylobase_nb_naC(SEXP);
+extern SEXP phylobase_nRoots(SEXP);
+extern SEXP phylobase_nTipsFastCpp(SEXP);
+extern SEXP phylobase_nTipsSafe(SEXP);
+extern SEXP phylobase_tabulateTips(SEXP);
+extern SEXP phylobase_testEqInt(SEXP, SEXP);
+extern SEXP phylobase_tipsFast(SEXP);
+extern SEXP phylobase_tipsSafe(SEXP, SEXP);
+
+static const R_CMethodDef CEntries[] = {
+ {"phyloxx", (DL_FUNC) &phyloxx, 6},
+ {"reorderBinary", (DL_FUNC) &reorderBinary, 7},
+ {"reorderRobust", (DL_FUNC) &reorderRobust, 6},
+ {NULL, NULL, 0}
+};
+
+static const R_CallMethodDef CallEntries[] = {
+ {"ancestors_c", (DL_FUNC) &ancestors_c, 3},
+ {"descendants_c", (DL_FUNC) &descendants_c, 3},
+ {"phylobase_all_naC", (DL_FUNC) &phylobase_all_naC, 1},
+ {"phylobase_any_naC", (DL_FUNC) &phylobase_any_naC, 1},
+ {"phylobase_checkTreeCpp", (DL_FUNC) &phylobase_checkTreeCpp, 2},
+ {"phylobase_edgeIdCpp", (DL_FUNC) &phylobase_edgeIdCpp, 2},
+ {"phylobase_getAllNodesFast", (DL_FUNC) &phylobase_getAllNodesFast, 1},
+ {"phylobase_getAllNodesSafe", (DL_FUNC) &phylobase_getAllNodesSafe, 1},
+ {"phylobase_getRange", (DL_FUNC) &phylobase_getRange, 2},
+ {"phylobase_hasDuplicatedLabelsCpp", (DL_FUNC) &phylobase_hasDuplicatedLabelsCpp, 1},
+ {"phylobase_hasPolytomy", (DL_FUNC) &phylobase_hasPolytomy, 1},
+ {"phylobase_hasSingleton", (DL_FUNC) &phylobase_hasSingleton, 1},
+ {"phylobase_isLabelName", (DL_FUNC) &phylobase_isLabelName, 2},
+ {"phylobase_nb_naC", (DL_FUNC) &phylobase_nb_naC, 1},
+ {"phylobase_nRoots", (DL_FUNC) &phylobase_nRoots, 1},
+ {"phylobase_nTipsFastCpp", (DL_FUNC) &phylobase_nTipsFastCpp, 1},
+ {"phylobase_nTipsSafe", (DL_FUNC) &phylobase_nTipsSafe, 1},
+ {"phylobase_tabulateTips", (DL_FUNC) &phylobase_tabulateTips, 1},
+ {"phylobase_testEqInt", (DL_FUNC) &phylobase_testEqInt, 2},
+ {"phylobase_tipsFast", (DL_FUNC) &phylobase_tipsFast, 1},
+ {"phylobase_tipsSafe", (DL_FUNC) &phylobase_tipsSafe, 2},
+ {NULL, NULL, 0}
+};
+
+void R_init_phylobase(DllInfo *dll)
+{
+ R_registerRoutines(dll, CEntries, CallEntries, NULL, NULL);
+ R_useDynamicSymbols(dll, FALSE);
+}
diff --git a/src/reorderBinary.c b/src/reorderBinary.c
new file mode 100644
index 0000000..812089d
--- /dev/null
+++ b/src/reorderBinary.c
@@ -0,0 +1,66 @@
+/*
+ reorderBinary.c:
+ Given a root node, reorder a tree either as postorder or preorder.
+ Works only on binary trees, in which each internal node has exactly 2
+ descendants. Function inputs are derived from a phylo4 edge matrix.
+ The new descendant node ordering is stored in descendantNew.
+*/
+
+#include <R.h>
+
+typedef struct {
+ int *descendantNew;
+ int *ancestor;
+ int *left;
+ int *right;
+ int nEdges;
+ int index;
+ } tree;
+
+void postorderBinary(tree*, int node);
+void preorderBinary(tree*, int node);
+
+void reorderBinary(int *descendantNew, int *root, int *ancestor, int *left,
+ int *right, int *nEdges, int *order) {
+
+ tree tr;
+ tr.ancestor = ancestor;
+ tr.left = left;
+ tr.right = right;
+ tr.descendantNew = descendantNew;
+ tr.nEdges = *nEdges;
+ tr.index = 0;
+
+ if (*order==0) {
+ postorderBinary(&tr, *root);
+ } else if (*order==1) {
+ preorderBinary(&tr, *root);
+ } else {
+ error("invalid order type");
+ }
+
+}
+
+// postorder: continue traversing to the end, then record node
+void postorderBinary(tree *tr, int node) {
+ for (int i=0; i<tr->nEdges; i++) {
+ if (tr->ancestor[i]==node) {
+ postorderBinary(tr, tr->left[i]);
+ postorderBinary(tr, tr->right[i]);
+ }
+ }
+ tr->descendantNew[tr->index] = node;
+ tr->index += 1;
+}
+
+// preorder: record node first, then continue traversing
+void preorderBinary(tree *tr, int node) {
+ tr->descendantNew[tr->index] = node;
+ tr->index += 1;
+ for (int i=0; i<tr->nEdges; i++) {
+ if (tr->ancestor[i]==node) {
+ preorderBinary(tr, tr->left[i]);
+ preorderBinary(tr, tr->right[i]);
+ }
+ }
+}
diff --git a/src/reorderRobust.c b/src/reorderRobust.c
new file mode 100644
index 0000000..7506ccf
--- /dev/null
+++ b/src/reorderRobust.c
@@ -0,0 +1,62 @@
+/*
+ reorderRobust.c:
+ Given a root node, reorder a tree either as postorder or preorder.
+ Works on any valid tree, including those with singleton nodes and/or
+ polytomies. Function inputs are derived from a phylo4 edge matrix. The
+ new descendant node ordering is stored in descendantNew.
+*/
+
+#include <R.h>
+
+typedef struct {
+ int *descendantNew;
+ int *ancestor;
+ int *descendant;
+ int nEdges;
+ int index;
+ } tree;
+
+void postorderRobust(tree*, int node);
+void preorderRobust(tree*, int node);
+
+void reorderRobust(int *descendantNew, int *root, int *ancestor,
+ int *descendant, int *nEdges, int *order) {
+
+ tree tr;
+ tr.ancestor = ancestor;
+ tr.descendant = descendant;
+ tr.descendantNew = descendantNew;
+ tr.nEdges = *nEdges;
+ tr.index = 0;
+
+ if (*order==0) {
+ postorderRobust(&tr, *root);
+ } else if (*order==1) {
+ preorderRobust(&tr, *root);
+ } else {
+ error("invalid order type");
+ }
+
+}
+
+// postorder: continue traversing to the end, then record node
+void postorderRobust(tree *tr, int node) {
+ for (int i=0; i<tr->nEdges; i++) {
+ if (tr->ancestor[i]==node) {
+ postorderRobust(tr, tr->descendant[i]);
+ }
+ }
+ tr->descendantNew[tr->index] = node;
+ tr->index += 1;
+}
+
+// preorder: record node before continuing traversal
+void preorderRobust(tree *tr, int node) {
+ tr->descendantNew[tr->index] = node;
+ tr->index += 1;
+ for (int i=0; i<tr->nEdges; i++) {
+ if (tr->ancestor[i]==node) {
+ preorderRobust(tr, tr->descendant[i]);
+ }
+ }
+}
diff --git a/tests/misctests.R b/tests/misctests.R
new file mode 100644
index 0000000..ea08536
--- /dev/null
+++ b/tests/misctests.R
@@ -0,0 +1,112 @@
+library(phylobase)
+library(ape)
+
+set.seed(1)
+
+data(geospiza)
+
+## make sure geospiza is properly formatted
+if(is.character(checkval <- checkPhylo4(geospiza)))
+ stop(checkval)
+
+
+geospiza0 <-
+ list(geospiza.tree=as(geospiza,"phylo"),geospiza.data=tipData(geospiza))
+## push data back into list form as in geiger
+
+t1 <- try(p1 <- phylo4d(geospiza0$geospiza.tree,geospiza0$geospiza.data))
+## Error in checkData(res, ...) :
+## Tip data names are a subset of tree tip labels.
+
+p2 <- as(geospiza0$geospiza.tree,"phylo4")
+plot(p2)
+
+lab1 <- tipLabels(p2)
+lab2 <- rownames(geospiza0$geospiza.data)
+
+lab1[!lab1 %in% lab2] ## missing data
+lab2[!lab2 %in% lab1] ## extra data (none)
+p1 <- phylo4d(p2,geospiza0$geospiza.data, missing.data="warn")
+p1 <- phylo4d(p2,geospiza0$geospiza.data, missing.data="OK")
+
+plot(p1)
+plot(p1,show.node.label=TRUE)
+## one way to deal with it:
+
+p1B <- prune(p1,tip="olivacea")
+
+## or ...
+p1C <- stats::na.omit(p1)
+
+labels(p1C, "all") <- tolower(labels(p1C, "all"))
+
+## trace("prune",browser,signature="phylo4d")
+r1 <- read.tree(text="((t4:0.3210275554,(t2:0.2724586465,t3:0.2724586465):0.0485689089):0.1397952619,(t5:0.07551818331,t1:0.07551818331):0.385304634);")
+
+## trace("phylo4d", browser, signature = "phylo")
+## untrace("phylo4d", signature = "phylo")
+tipdat <- data.frame(a=1:5, row.names=r1$tip.label)
+q1 <- phylo4d(r1,tip.data=tipdat, node.data=data.frame(a=6:9), match.data=FALSE)
+q2 <- prune(q1,1)
+summary(q2)
+
+tipdat2 <- tipdat
+row.names(tipdat2)[1] <- "s1"
+t1 <- try(q1 <- phylo4d(r1,tip.data=tipdat2))
+
+plot(q2)
+plot(q2,type="cladogram")
+## plot(p2,type="dotchart",labels.nodes=nodeLabels(p2))
+## trace("plot", browser, signature = c("phylo4d","missing"))
+tipLabels(q1) <- paste("q",1:5,sep="")
+nodeLabels(q1) <- paste("n",1:4,sep="")
+p3 <- phylo4d(r1,tip.data=tipdat,node.data=data.frame(b=6:9), match.data=FALSE)
+summary(p3)
+
+plot(p1)
+
+plot(subset(p1,tips.include=c("fuliginosa","fortis","magnirostris",
+ "conirostris","scandens")))
+## better error?
+## Error in phy$edge[, 2] : incorrect number of dimensions
+
+if(dev.cur() == 1) get(getOption("device"))()
+plot(subset(p2,tips.include=c("fuliginosa","fortis","magnirostris",
+ "conirostris","scandens")))
+
+plot(p2,show.node.label=TRUE)
+
+tree.owls <- read.tree(text="(((Strix_aluco:4.2,Asio_otus:4.2):3.1,Athene_noctua:7.3):6.3,Tyto_alba:13.5);")
+
+z <- as(tree.owls,"phylo4")
+
+example("phylo4d")
+obj1 <- obj2 <- obj3 <- phylo4d(z, data.frame(wing=1:4,color=factor(c("b","w","b","b")), tail=runif(4)*10), match.data=FALSE)
+
+obj2 at data <- as.data.frame(obj2 at data[,1])
+obj3 at data <- cbind(obj1 at data,obj2 at data)
+obj4 <- obj1
+obj4 at data[2,3] <- NA
+obj4 at data[1,1] <- NA
+
+nodeLabels(obj4) <- character(0)
+
+obj5 <- obj1
+tipData(obj4) <- subset(tipData(obj4),select=sapply(tipData(obj4),class)=="numeric")
+
+treePlot(obj4)
+
+E <- matrix(c(
+ 8, 9,
+ 9, 10,
+ 10, 1,
+ 10, 2,
+ 9, 3,
+ 9, 4,
+ 8, 11,
+ 11, 5,
+ 11, 6,
+ 11, 7,
+ 0, 8), ncol=2,byrow=TRUE)
+
+P2 <- phylo4(E)
diff --git a/tests/phylo4dtests.R b/tests/phylo4dtests.R
new file mode 100644
index 0000000..8101c4b
--- /dev/null
+++ b/tests/phylo4dtests.R
@@ -0,0 +1,29 @@
+library(phylobase)
+library(ape)
+tree.phylo <- read.tree(text="(((A,B)C,D),E);") #only one node is labelled
+tree <- as(tree.phylo, "phylo4")
+
+tree.phylo2 <- read.tree(text="(((A,B)C,D)F,E)G;") # all nodes labelled
+tree2 <- as(tree.phylo2, "phylo4")
+
+tip.data <- data.frame(size=c(1, 2, 3, 4))
+rownames(tip.data) <- c("A", "B", "E", "D")
+
+treed <- phylo4d(tree, tip.data)
+dat2 <- data.frame(size=c(0,1,2), row.names=c("G", "F", "C"))
+
+try(phylo4d(tree, node.data=dat2), silent = TRUE) # error, cannot match data because no node labels on tree
+phylo4d(tree2, node.data=dat2) -> treed2 # OK tree labelled; has node data, no tip data
+
+plot(treed2) # works with a warning about no tip data to plot
+tipData(treed2, empty.columns=FALSE) #returns empty 4-row data.frame
+
+phylo4d(tree2, tip.data=tip.data, node.data=dat2) -> treed3 #node+tip data
+
+plot(treed3) # works
+tipData(treed3) #works, but returns tips only
+tdata(treed3, "all")
+
+print(tree)
+print(treed)
+
diff --git a/tests/phylosubtest.R b/tests/phylosubtest.R
new file mode 100644
index 0000000..99d9b4b
--- /dev/null
+++ b/tests/phylosubtest.R
@@ -0,0 +1,16 @@
+library(phylobase)
+library(ape)
+data(geospiza)
+
+gtree <- extractTree(geospiza)
+stopifnot(identical(gtree,prune(gtree,character(0))))
+
+stopifnot(identical(tdata(subset(geospiza)),
+ tdata(subset(geospiza, tipLabels(geospiza)))))
+
+
+tr <- read.tree(text="(((spA:0.2,(spB:0.1,spC:0.1):0.15):0.5,spD:0.7):0.2,spE:1):0.4;")
+phyd <- as(tr, "phylo4d")
+tipData(phyd) <- 1:5
+stopifnot(identical(phyd at data,subset(phyd,tipLabels(phyd))@data))
+
diff --git a/tests/phylotorture.R b/tests/phylotorture.R
new file mode 100644
index 0000000..1e911b8
--- /dev/null
+++ b/tests/phylotorture.R
@@ -0,0 +1,129 @@
+## torture-testing phylo4 objects.
+library(phylobase)
+library(ape)
+
+set.seed(10101)
+n <- 200
+p1 <- vector("list", n)
+## don't want to slow down R CMD check by doing this every time:
+## n <- 10000
+for (i in 1:n) {
+ if (i <= n/2) {
+ e <- matrix(sample(1:10, replace=TRUE, size=10), ncol=2)
+ }
+ else {
+ e <- cbind(sample(rep(11:19, 2)), sample(1:19))
+ e <- rbind(c(0, sample(11:19, 1)), e)
+ }
+ p1[[i]] <- try(phylo4(e), silent=TRUE)
+}
+OKvals <- sapply(p1, class) != "try-error"
+## table(sapply(p1[!OKvals], as.character)) # I think this is causing issues with
+## R check because of different width of terminal/output, trying something simpler:
+message(unique(sapply(p1[!OKvals], as.character)))
+sort(unname(table(sapply(p1[!OKvals], as.character))))
+if (sum(OKvals)) message("There are ", sum(OKvals), " valid trees...")
+
+if (any(OKvals)) {
+ p2 <- p1[OKvals]
+ length(p2)
+ has.poly <- sapply(p2, hasPoly)
+ has.sing <- sapply(p2, hasSingle)
+ has.retic <- sapply(p2, hasRetic)
+ message("number of trees with polytomies: ", sum(has.poly))
+ message("number of trees with singletons: ", sum(has.sing))
+ message("number of trees with reticulation: ", sum(has.retic))
+ if (any(has.sing)) {
+ p4 <- p2[has.sing]
+ plot(p4[[1]]) ## gives descriptive error
+ t2 <- try(plot(collapse.singles(as(p2[[1]],"phylo"))))
+ ## "incorrect number of dimensions"
+ }
+ if (any(!has.sing)) {
+ ## first tree without singles -- HANGS!
+ ## don't try the plot in an R session you care about ...
+ p3 <- p2[!has.sing]
+ ## plot(p2[[13]])
+ }
+}
+
+## elements 8 and 34 are
+## what SHOULD the rules for trees be?
+
+## (a) reduce node numbers to 1 ... N ?
+## (b) check: irreducible, non-cyclic, ... ?
+
+## convert to matrix format for checking?
+
+reduce_nodenums <- function(e) {
+ matrix(as.numeric(factor(e)),ncol=2)
+}
+
+# make an illegal phylo4 object, does it pass checks?
+# a disconnected node:
+
+t1 <- read.tree (text="((a,b), (c,(d, e)));")
+plot(t1)
+
+broke1 <- t1
+broke1$edge[broke1$edge[,2] ==9, 1] <- 9 # disconnect the node, two subtrees, ((a, b), c) and (d,e)
+
+try(as(broke1, "phylo4") -> tree, silent=TRUE) # makes a phylo4 object with no warning
+try(phylo4(broke1$edge), silent=TRUE) # constructor makes a phylo4 object with no warning
+## error message comes from ape, not phylo? -- AND
+## error is about singles, not disconnected nodes
+## print(try(plot(tree), silent=TRUE )) ## pdc couldn't get this to work, so temporarily commenting
+
+# root node value != ntips + 1:
+
+broke2 <- t1
+broke2$edge[broke2$edge==6] <- 10
+
+## warning, but no error
+## plot(broke2) ## seems to hang R CMD check??
+## generates error, but it's about wrong number of tips, not wrong value at root.
+message(try(as(broke2, "phylo4"), silent=TRUE))
+## error regarding number of tip labels vs edges and nodes
+message(try(phylo4(broke2$edge), silent=TRUE))
+
+# switch root node value (6) with next internal node (7):
+
+broke3 <- broke2
+broke3$edge[broke3$edge==7] <- 6
+broke3$edge[broke3$edge==10] <- 7
+
+## both of the following now fail with
+## "root node is not at position (nTips+1)
+try(as(broke3,"phylo4") -> tree3) # works with no error message
+try(phylo4(broke3$edge)) # works with no error message
+## plot(tree3) # would work if we could create it?
+
+
+# tips have larger numbers than root node:
+
+broke4 <- t1
+broke4$edge[broke4$edge==1] <- 11
+broke4$edge[broke4$edge==2] <- 12
+broke4$edge[broke4$edge==3] <- 13
+broke4$edge[broke4$edge==4] <- 14
+broke4$edge[broke4$edge==5] <- 15
+
+message(try(as(broke4, "phylo4"), silent=TRUE))
+message(try(phylo4(broke4$edge), silent=TRUE))
+# print(try(plot(broke4), TRUE)) ## CAUSES R TO HANG!
+
+###
+foo <- new('phylo4')
+
+foo at edge <- rcoal(10)$edge
+message(try(plot(foo)))
+
+foo at label <- c(rep('blah',10), rep("",9))
+
+#####
+## tree with only 2 tips: will fail under previous versions
+## with "Error in if (which(nAncest == 0) != nTips + 1) { :
+## argument is of length zero"
+
+edge <- matrix(c(3, 1, 3, 2), byrow=TRUE, ncol=2)
+try(p2 <- phylo4(edge), silent=TRUE)
diff --git a/tests/plottest.R b/tests/plottest.R
new file mode 100644
index 0000000..a5c01de
--- /dev/null
+++ b/tests/plottest.R
@@ -0,0 +1,54 @@
+library(phylobase)
+library(ape)
+
+data(geospiza)
+g1 <- as(geospiza,"phylo4")
+g2 <- geospiza
+
+par(mfrow=c(1,2))
+plot(g1, show.node.label=TRUE)
+## be careful with this: works if par("fin")=c(5.56,6.77)
+## fails if par("fin")=c(4.87,6.77)
+##try(plot(g2,show.node.label=TRUE),silent=TRUE)
+## Here, R was complaining about a lack of room to plot data
+## so nothing abnormal. -- TJ
+plot(g2, show.node.label=TRUE)
+
+
+## commented out since phylog objects are deprecated anyway
+## g2B <- as(extractTree(g2), "phylog")
+## Note the numbering differences!
+
+## round trip
+g2C <- as(read.tree(text=write.tree(as(g1, "phylo"))), "phylo4")
+## comes back in same order
+try(plot(g1, show.node.label=TRUE))
+try(plot(g2C, show.node.label=TRUE))
+
+g3 = subset(g2, tips.exclude=c("fuliginosa", "fortis", "magnirostris",
+ "conirostris", "scandens"))
+plot(extractTree(g3)) ## phylo4
+plot(g3)
+
+
+## Playing with new ways of plotting
+
+if (FALSE) {
+if(require(MASS)){
+ dist1 <- cophenetic.phylo(as(g2, "phylo"))
+ mdspos <- isoMDS(dist1)$points
+ par(mfrow=c(2, 2))
+ plot(g1)
+ ## plot(mdspos,type="n")
+ ## text(mdspos[,1],mdspos[,2],abbreviate(rownames(mdspos)))
+ ## cmdpos <- cmdscale(dist1)
+ ## plot(cmdpos,type="n")
+ ## text(cmdpos[,1],cmdpos[,2],abbreviate(rownames(mdspos)))
+}
+## never mind, I don't know how to construct a useful
+## 2D color space anyway ...
+}
+
+treePlot(g2,plot.at.tip=TRUE,tip.plot.fun=
+ function(x,...) {
+ grid::grid.points(seq(along=x),x)})
diff --git a/tests/roundtrip.R b/tests/roundtrip.R
new file mode 100644
index 0000000..36d19bc
--- /dev/null
+++ b/tests/roundtrip.R
@@ -0,0 +1,41 @@
+library(phylobase)
+library(ape)
+
+## set.seed(1)
+## t0A <- rcoal(5)
+t0 <- read.tree(text="((t4:0.3210275554,(t2:0.2724586465,t3:0.2724586465):0.0485689089):0.1397952619,(t5:0.07551818331,t1:0.07551818331):0.385304634);")
+## hack around variability in ape:
+## read.tree() and rcoal() produce sets of
+## elements in different orders
+t0 <- unclass(t0)[c("edge","edge.length","tip.label","Nnode")]
+class(t0) <- "phylo"
+
+## phylo -> phylo4 -> phylo
+t1 <- as(t0,"phylo4")
+t5 <- as(t1,"phylo")
+stopifnot(identical(t0,t5))
+
+## phylo4 -> phylo4vcov -> phylo4 -> phylo
+t2<-as(t1,"phylo4vcov")
+t3<-as(t2,"phylo4")
+t4<-as(t3,"phylo")
+stopifnot(identical(t4$edge,t0$edge) &&
+ identical(t4$tip.label,t0$tip.label) &&
+ identical(t4$Nnode,t0$Nnode) &&
+ max(abs(t4$edge.length-t0$edge.length))<1e-10)
+
+## UNROOTED
+t6 <- ape::unroot(t0)
+## hack around ape conversion issues:
+## unroot() converts integer to double
+storage.mode(t6$edge) <- "integer"
+storage.mode(t6$Nnode) <- "integer"
+t7 <- as(as(t6,"phylo4"),"phylo")
+stopifnot(identical(t6,t7))
+
+
+## EXPLICIT ROOT EDGE
+t8 <- t0
+t8$root.edge <- 0.5
+t9 <- as(as(t8,"phylo4"),"phylo")
+stopifnot(identical(t8,t9))
diff --git a/tests/test-all.R b/tests/test-all.R
new file mode 100644
index 0000000..690ba72
--- /dev/null
+++ b/tests/test-all.R
@@ -0,0 +1,3 @@
+
+library(testthat)
+test_check("phylobase")
diff --git a/tests/testprune.R b/tests/testprune.R
new file mode 100644
index 0000000..c7f4201
--- /dev/null
+++ b/tests/testprune.R
@@ -0,0 +1,20 @@
+library(phylobase)
+library(ape)
+
+set.seed(1)
+r1 <- rcoal(5)
+
+## trace("phylo4d", browser, signature = "phylo")
+## untrace("phylo4d", signature = "phylo")
+tipdat <- data.frame(a=1:5,row.names=r1$tip.label)
+p1 <- phylo4d(r1,tip.data=tipdat,node.data=data.frame(a=6:9), match.data=FALSE)
+p2 <- prune(p1,1)
+summary(p2)
+
+## from picante
+`phylo2phylog` <-
+function(phy, ...) {
+ newick2phylog(write.tree(phy, multi.line = FALSE),...)
+}
+
+plot.phylo(as(p2,"phylo"))
diff --git a/tests/testthat/test.badnex.R b/tests/testthat/test.badnex.R
new file mode 100644
index 0000000..15836de
--- /dev/null
+++ b/tests/testthat/test.badnex.R
@@ -0,0 +1,15 @@
+#
+# --- Test badnex.R ---
+#
+
+test_that("Malformed Nexus File should not work.", {
+ if (Sys.getenv("RCMDCHECK") == FALSE) {
+ pth <- file.path(getwd(), "..", "inst", "nexusfiles")
+ } else {
+ pth <- system.file(package="phylobase", "nexusfiles")
+ }
+ badFile <- file.path(pth, "badnex.nex")
+ expect_error(readNexus(file=badFile))
+})
+
+
diff --git a/tests/testthat/test.checkdata.R b/tests/testthat/test.checkdata.R
new file mode 100644
index 0000000..88b9ef0
--- /dev/null
+++ b/tests/testthat/test.checkdata.R
@@ -0,0 +1,70 @@
+#
+# --- Test checkdata.R ---
+#
+
+if (Sys.getenv("RCMDCHECK") == FALSE) {
+ pth <- file.path(getwd(), "..", "inst", "nexusfiles")
+} else {
+ pth <- system.file(package="phylobase", "nexusfiles")
+}
+## co1.nex -- typical output from MrBayes. Contains 2 identical trees, the first
+## one having posterior probabilities as node labels
+co1File <- file.path(pth, "co1.nex")
+
+# create phylo4 object with a full complement of valid slots
+ancestor <- as.integer(c(6,7,7,6,8,0,8,9,9))
+descendant <- as.integer(c(7,1,2,8,3,6,9,4,5))
+edge <- cbind(ancestor, descendant)
+nid.tip <- 1:5
+nid.int <- 6:9
+nid.all <- c(nid.tip, nid.int)
+lab.tip <- paste("t", nid.tip, sep="")
+lab.int <- paste("n", nid.int, sep="")
+lab.all <- c(lab.tip, lab.int)
+elen <- descendant/10
+elab <- paste("e", ancestor, descendant, sep="-")
+phy <- phylo4(x=edge, tip.label=lab.tip, node.label=lab.int,
+ edge.length=elen, edge.label=elab)
+
+op <- phylobase.options()
+
+context("test phylo4 validator/phylobase.options()")
+
+test_that("test polytomies", {
+ phylobase.options(poly="fail")
+ expect_error(readNexus(file=co1File, check.node.labels="drop"))
+ phylobase.options(op)
+})
+
+test_that("test retic", {
+ phylobase.options(retic="fail")
+ edgeRetic <- rbind(edge, c(6, 3))
+ expect_error(phy <- phylo4(x=edgeRetic))
+ phylobase.options(op)
+})
+
+test_that("test multiroot", {
+ phylobase.options(multiroot="fail")
+ edgeMultiRoot <- rbind(edge, c(0, 7))
+ expect_error(phy <- phylo4(x=edgeMultiRoot))
+ phylobase.options(op)
+})
+
+test_that("test singleton", {
+ phylobase.options(singleton="fail")
+ edgeSingleton <- cbind(c(9,7,7,6,6,8,8,10,10,0), 1:10)
+ expect_error(phylo4(x=edgeSingleton))
+ phylobase.options(op)
+})
+
+## checkPhylo4Data <- function() {
+## }
+
+## formatData <- function() {
+## # function(phy, dt, type=c("tip", "internal", "all"),
+## # match.data=TRUE, label.type=c("rownames", "column"),
+## # label.column=1, missing.data=c("fail", "warn", "OK"),
+## # extra.data=c("warn", "OK", "fail"), rownamesAsLabels=FALSE)
+## }
+
+
diff --git a/tests/testthat/test.class-phylo4.R b/tests/testthat/test.class-phylo4.R
new file mode 100644
index 0000000..9b34dd9
--- /dev/null
+++ b/tests/testthat/test.class-phylo4.R
@@ -0,0 +1,119 @@
+#
+# --- Test class-phylo4.R ---
+#
+
+### Get all the test files
+if (Sys.getenv("RCMDCHECK") == FALSE) {
+ pth <- file.path(getwd(), "..", "inst", "nexmlfiles")
+} else {
+ pth <- system.file(package="phylobase", "nexmlfiles")
+}
+
+## NeXML files
+compFile <- file.path(pth, "comp_analysis.xml")
+stopifnot(file.exists(compFile))
+
+op <- phylobase.options()
+
+context("test phylo4 class")
+
+test_that("building from matrix works", {
+ edge <- structure(c(6L, 7L, 8L, 8L, 9L, 9L, 7L, 6L, 7L, 8L, 1L, 9L,
+ 2L, 3L, 4L, 5L), .Dim = c(8, 2))
+ edge.length <- c(0.2, 0.5, 0.2, 0.15, 0.1, 0.1, 0.7, 1)
+ tip.label <- paste("t", 1:5, sep="")
+ node.label <- paste("n", 1:4, sep="")
+ edge.label <- paste("e", 1:8, sep="")
+ order <- "preorder"
+ annote <- list(x="annotation")
+ phy <- phylo4(edge, edge.length=edge.length, tip.label=tip.label,
+ node.label=node.label, edge.label=edge.label, order=order,
+ annote=annote)
+
+ ## test each slot
+ expect_equal(edge, unname(edges(phy)))
+ expect_equal(edge.length, unname(edgeLength(phy)))
+ expect_equal(4L, nNodes(phy))
+ expect_equal(tip.label, unname(tipLabels(phy)))
+ expect_equal(node.label, unname(nodeLabels(phy)))
+ expect_equal(edge.label, unname(edgeLabels(phy)))
+ expect_equal(order, edgeOrder(phy))
+ expect_equal(annote, phy at annote)
+
+ ## test improper cases
+ ## expect_error(phylo4(edge, edge.length=999)) # recycling is allowed? FM (20140506: yes)
+ expect_error(phylo4(edge, tip.label=999))
+ expect_error(phylo4(edge, node.label=999))
+ ## expect_error(phylo4(edge, edge.label=999)) # recycling is allowed? FM (20140506: yes)
+ expect_error(phylo4(edge, order="invalid order"))
+ expect_error(phylo4(edge, annote="invalid annotation"))
+})
+
+
+## note: this method mostly just wraps phylo->phylo4 coercion, which is
+## tested more thoroughly in runit.setAs-methods.R; focus here is on
+## annote and check.node.labels arguments
+
+test_that("phylo4 can be built from phylo (tests on what's not done in setAs tests)", {
+ tr <- ape::read.tree(text="(((t1:0.2,(t2:0.1,t3:0.1):0.15):0.5,t4:0.7):0.2,t5:1):0.4;")
+
+ ##
+ ## annote
+ ##
+
+ annote <- list(x="annotation")
+ phy <- phylo4(tr, annote=annote)
+ expect_equal(annote, phy at annote)
+
+ ##
+ ## check.node.labels
+ ##
+
+ # case 0: no node labels
+ phy <- phylo4(tr)
+ expect_true(!hasNodeLabels(phy))
+
+ # case 1: keep unique character labels
+ tr$node.label <- paste("n", 1:4, sep="")
+ phy <- phylo4(tr, check.node.labels="keep")
+ expect_equal(tr$node.label, unname(nodeLabels(phy)))
+ # keeping node labels should be the default
+ expect_equal(phy, phylo4(tr))
+
+ # case 2: keep unique number-like character labels
+ tr$node.label <- as.character(1:4)
+ phy <- phylo4(tr, check.node.labels="keep")
+ expect_equal(tr$node.label, unname(nodeLabels(phy)))
+
+ # case 3: keep unique numeric labels, but convert to character
+ tr$node.label <- as.numeric(1:4)
+ phy <- phylo4(tr, check.node.labels="keep")
+ expect_equal(as.character(tr$node.label), unname(nodeLabels(phy)))
+
+ # case 4: must drop non-unique labels
+ tr$node.label <- rep("x", 4)
+ ## with options allow.duplicated.labels="fail"
+ phylobase.options(allow.duplicated.labels="fail")
+ expect_error(phylo4(tr))
+ expect_error(phylo4(tr, check.node.labels="keep"))
+ phylobase.options(op)
+ ## test dropping node labels
+ phy <- phylo4(tr, check.node.labels="drop")
+ expect_true(!hasNodeLabels(phy))
+ ## with options allow.duplicated.labels="ok"
+ phylobase.options(allow.duplicated.labels="ok")
+ phy <- phylo4(tr)
+ expect_equal(unname(nodeLabels(phy)), tr$node.label)
+ phy <- phylo4(tr, check.node.labels="keep")
+ expect_equal(unname(nodeLabels(phy)), tr$node.label)
+ phy <- phylo4(tr, check.node.labels="drop")
+ expect_true(!hasNodeLabels(phy))
+ phylobase.options(op)
+})
+
+test_that("nexml to phylo4", {
+ nxml <- RNeXML::nexml_read(compFile)
+ phy4 <- phylo4(nxml)
+ expect_true(all(tipLabels(phy4) %in% paste("taxon", 1:10, sep="_")))
+ expect_equal(nEdges(phy4), 19)
+})
diff --git a/tests/testthat/test.class-phylo4d.R b/tests/testthat/test.class-phylo4d.R
new file mode 100644
index 0000000..4b44083
--- /dev/null
+++ b/tests/testthat/test.class-phylo4d.R
@@ -0,0 +1,317 @@
+#
+# --- Test class-phylo4d.R ---
+#
+
+### Get all the test files
+if (Sys.getenv("RCMDCHECK") == FALSE) {
+ pth <- file.path(getwd(), "..", "inst", "nexmlfiles")
+} else {
+ pth <- system.file(package="phylobase", "nexmlfiles")
+}
+
+## create ape::phylo version of a simple tree for testing
+nwk <- "((t1:0.1,t2:0.2)n7:0.7,(t3:0.3,(t4:0.4,t5:0.5)n9:0.9)n8:0.8)n6:0.6;"
+tr <- ape::read.tree(text=nwk)
+
+# create analogous phylo4 object with a full complement of valid slots
+ancestor <- as.integer(c(6,7,7,6,8,0,8,9,9))
+descendant <- as.integer(c(7,1,2,8,3,6,9,4,5))
+edge <- cbind(ancestor, descendant)
+nid.tip <- 1:5
+nid.int <- 6:9
+nid.all <- c(nid.tip, nid.int)
+lab.tip <- paste("t", nid.tip, sep="")
+lab.int <- paste("n", nid.int, sep="")
+lab.all <- c(lab.tip, lab.int)
+elen <- descendant/10
+elab <- paste("e", ancestor, descendant, sep="-")
+phy <- phylo4(x=edge, tip.label=lab.tip, node.label=lab.int,
+ edge.length=elen, edge.label=elab)
+
+# create altered version such that each slot is out of order with
+# respect to all others; methods should be able to handle this
+phy.alt <- phy
+phy.alt at label <- rev(phy at label)
+phy.alt at edge <- phy at edge[c(6:9, 1:5), ]
+phy.alt at edge.length <- phy at edge.length[c(7:9, 1:6)]
+phy.alt at edge.label <- phy at edge.label[c(8:9, 1:7)]
+
+# create data to add to phylo4 to create phylo4d, but with data rows out
+# of order
+set.seed(1)
+nid.tip.r <- sample(nid.tip)
+nid.int.r <- sample(nid.int)
+nid.all.r <- sample(c(nid.tip, nid.int))
+allDt <- data.frame(a=letters[nid.all.r], b=10*nid.all.r)
+tipDt <- data.frame(c=letters[nid.tip.r], d=10*nid.tip.r)
+nodDt <- data.frame(c=letters[nid.int.r], e=10*nid.int.r)
+## set row.names as numeric node IDs (may be changed in tests below)
+row.names(allDt) <- nid.all.r
+row.names(tipDt) <- nid.tip.r
+row.names(nodDt) <- nid.int.r
+
+## NeXML files
+compFile <- file.path(pth, "comp_analysis.xml")
+stopifnot(file.exists(compFile))
+
+
+#-----------------------------------------------------------------------
+
+context("test phylo4d class")
+
+test_that("phylo4d can be built from phylo4", {
+
+ ## case 1: add data matching only on row position
+ row.names(allDt) <- NULL
+ row.names(tipDt) <- NULL
+ row.names(nodDt) <- NULL
+
+ ## these should fail because row.names don't match nodes
+ expect_error(phylo4d(phy.alt, tip.data=tipDt, rownamesAsLabels=TRUE))
+ expect_error(phylo4d(phy.alt, node.data=nodDt))
+
+ ## brute force: no matching; with tip data
+ phyd <- phylo4d(phy.alt, tip.data=tipDt, match.data=FALSE)
+ expect_equal(phyd at data, data.frame(tipDt,
+ row.names=nid.tip))
+ expect_equal(tdata(phyd, "tip"), data.frame(tipDt,
+ row.names=lab.tip))
+
+ ## brute force: no matching; with node data
+ phyd <- phylo4d(phy.alt, node.data=nodDt, match.data=FALSE)
+ expect_equal(phyd at data, data.frame(nodDt,
+ row.names=nid.int))
+ expect_equal(tdata(phyd, "internal"), data.frame(nodDt,
+ row.names=lab.int))
+
+ ## brute force: no matching; with all.data
+ phyd <- phylo4d(phy.alt, all.data=allDt, match.data=FALSE)
+ expect_equal(phyd at data, data.frame(allDt,
+ row.names=nid.all))
+ expect_equal(tdata(phyd, "all"), data.frame(allDt,
+ row.names=lab.all))
+
+ ## brute force: no matching; with tip & node data
+ ## no merging (data names don't match)
+ phyd <- phylo4d(phy.alt, tip.data=tipDt["d"], node.data=nodDt["e"],
+ match.data=FALSE)
+ expect_equal(phyd at data, data.frame(rbind(data.frame(tipDt["d"],
+ e=NA_real_), data.frame(d=NA_real_, nodDt["e"])),
+ row.names=nid.all))
+ expect_equal(tdata(phyd, "tip"), data.frame(tipDt["d"], e=NA_real_,
+ row.names=lab.tip))
+ expect_equal(tdata(phyd, "internal"), data.frame(d=NA_real_, nodDt["e"],
+ row.names=lab.int))
+
+ ## brute force: no matching; with tip & node data
+ ## merging (common data names)
+ phyd <- phylo4d(phy.alt, tip.data=tipDt["c"], node.data=nodDt["c"],
+ match.data=FALSE)
+ expect_equal(phyd at data, data.frame(rbind(tipDt["c"], nodDt["c"]),
+ row.names=nid.all))
+ expect_equal(tdata(phyd, "tip"), data.frame(c=factor(tipDt$c,
+ levels=letters[nid.all]), row.names=lab.tip))
+ expect_equal(tdata(phyd, "internal"), data.frame(c=factor(nodDt$c,
+ levels=letters[nid.all]), row.names=lab.int))
+
+ ## case 2: add data matching on numeric (node ID) row.names
+ row.names(allDt) <- nid.all.r
+ row.names(tipDt) <- nid.tip.r
+ row.names(nodDt) <- nid.int.r
+
+ ## match with node numbers, tip data
+ phyd <- phylo4d(phy.alt, tip.data=tipDt)
+ expect_equal(phyd at data, data.frame(tipDt[order(nid.tip.r),],
+ row.names=nid.tip))
+ expect_equal(tdata(phyd, "tip"), data.frame(tipDt[order(nid.tip.r),],
+ row.names=lab.tip))
+
+ ## match with node numbers, node data
+ phyd <- phylo4d(phy.alt, node.data=nodDt)
+ expect_equal(phyd at data, data.frame(nodDt[order(nid.int.r),],
+ row.names=nid.int))
+ expect_equal(tdata(phyd, "internal"), data.frame(nodDt[order(nid.int.r),],
+ row.names=lab.int))
+
+ ## match with node numbers, tip & node data, no merge
+ phyd <- phylo4d(phy.alt, tip.data=tipDt["d"], node.data=nodDt["e"])
+ expect_equal(phyd at data, data.frame(rbind(data.frame(
+ d=tipDt[order(nid.tip.r), "d"], e=NA_real_),
+ data.frame(d=NA_real_, e=nodDt[order(nid.int.r), "e"])),
+ row.names=nid.all))
+ expect_equal(tdata(phyd, "tip"), data.frame(d=tipDt[order(nid.tip.r), "d"],
+ e=NA_real_, row.names=lab.tip))
+ expect_equal(tdata(phyd, "internal"), data.frame(d=NA_real_,
+ e=nodDt[order(nid.int.r), "e"], row.names=lab.int))
+
+ ## match with node numbers, tip & all data
+ phyd <- phylo4d(phy.alt, tip.data=tipDt, all.data=allDt)
+ merged <- data.frame(merge(allDt[order(nid.all.r),],
+ tipDt[order(nid.tip.r),], all=TRUE, by=0)[-1])
+ expect_equal(phyd at data, data.frame(merged, row.names=nid.all))
+ expect_equal(tdata(phyd, "all"), data.frame(merged, row.names=lab.all))
+
+ ## match with node numbers, node & all data
+ phyd <- phylo4d(phy.alt, node.data=nodDt, all.data=allDt)
+ merged <- data.frame(merge(allDt[order(nid.all.r),],
+ nodDt[order(nid.int.r),], all=TRUE, by=0)[-1])
+ expect_equal(phyd at data, data.frame(merged, row.names=nid.all))
+ expect_equal(tdata(phyd, "all"), data.frame(merged, row.names=lab.all))
+
+ ## match with node numbers, tip, node & all data
+ phyd <- phylo4d(phy.alt, tip.data=tipDt, node.data=nodDt, all.data=allDt)
+ # merge alldata with common tip and node data
+ m1 <- data.frame(merge(allDt, rbind(tipDt["c"], nodDt["c"]),
+ all=TRUE, by=0)[-1])
+ # merge distinct columns of tipdata and nodedata
+ m2 <- data.frame(merge(tipDt["d"], nodDt["e"], all=TRUE, by=0)[-1])
+ # ...now merge these together
+ merged <- data.frame(merge(m1, m2, by=0)[-1])
+ expect_equal(phyd at data, data.frame(merged,
+ row.names=nid.all))
+ expect_equal(tdata(phyd, "tip"), data.frame(merged[nid.tip,],
+ row.names=lab.tip, check.names=FALSE))
+ expect_equal(tdata(phyd, "internal"), data.frame(merged[nid.int,],
+ row.names=lab.int, check.names=FALSE))
+ expect_equal(tdata(phyd, "all"), data.frame(merged, row.names=lab.all))
+
+ ## as above, but without merging common tip and node column
+ phyd <- phylo4d(phy.alt, tip.data=tipDt, node.data=nodDt,
+ all.data=allDt, merge.data=FALSE)
+ m3 <- data.frame(merge(tipDt, nodDt, all=TRUE, by=0,
+ suffix=c(".tip", ".node"))[-1])
+ merged <- data.frame(merge(allDt, m3, by=0)[-1])
+ expect_equal(phyd at data, data.frame(merged,
+ row.names=nid.all))
+ expect_equal(tdata(phyd, "tip"), data.frame(merged[nid.tip,],
+ row.names=lab.tip, check.names=FALSE))
+ expect_equal(tdata(phyd, "internal"), data.frame(merged[nid.int,],
+ row.names=lab.int, check.names=FALSE))
+ expect_equal(tdata(phyd, "all"), data.frame(merged, row.names=lab.all))
+
+ ## case 3: add data matching on character (label) row.names for tips
+ row.names(tipDt) <- c(lab.tip, lab.int)[nid.tip.r]
+ row.names(nodDt) <- c(lab.tip, lab.int)[nid.int.r]
+
+ ## match with names, tip data
+ phyd <- phylo4d(phy.alt, tip.data=tipDt)
+ expect_equal(phyd at data, data.frame(tipDt[order(nid.tip.r),],
+ row.names=nid.tip))
+ expect_equal(tdata(phyd, "tip"), data.frame(tipDt[order(nid.tip.r),],
+ row.names=lab.tip))
+
+ ## case 4: add data matching on mixed rowname types (for tips and
+ ## for internal nodes)
+ row.names(allDt)[match(nid.tip.r, nid.all.r)] <- lab.tip[nid.tip.r]
+ row.names(allDt)[match(nid.int.r, nid.all.r)] <- nid.int.r
+
+ ## match with names for tips and numbers for nodes with all data
+ phyd <- phylo4d(phy.alt, all.data=allDt)
+ expect_equal(tdata(phyd, "all"), data.frame(allDt[match(nid.all,
+ nid.all.r),], row.names=lab.all))
+ expect_equal(tdata(phyd, "tip"), data.frame(allDt[match(nid.tip,
+ nid.all.r),], row.names=lab.tip))
+ expect_equal(tdata(phyd, "internal"), data.frame(allDt[match(nid.int,
+ nid.all.r),], row.names=lab.int))
+ expect_equal(phyd at data, data.frame(allDt[match(nid.all, nid.all.r),],
+ row.names=nid.all))
+
+})
+
+## test.phylo4d.matrix <- function() {
+## }
+
+# note: this method mostly does phylo4(phylo), then phylo4d(phylo4),
+# then addData methods, which are tested more thoroughly elsewhere;
+# focus here is on metadata and check.node.labels="asdata" arguments
+
+test_that("phylo4d can be built from phylo object", {
+ # function(x, tip.data=NULL, node.data=NULL, all.data=NULL,
+ # check.node.labels=c("keep", "drop", "asdata"), annote=list(),
+ # metadata=list(), ...)
+
+ ## show that method basically just wraps phylo4d("phylo4")
+ phyd.tr <- phylo4d(tr, tip.data=tipDt, node.data=nodDt,
+ all.data=allDt, match.data=TRUE, merge.data=TRUE)
+ expect_true(class(phyd.tr)=="phylo4d")
+ phyd.phy <- phylo4d(phy.alt, tip.data=tipDt, node.data=nodDt,
+ all.data=allDt, match.data=TRUE, merge.data=TRUE)
+ # reorder for edge order consistency, then test each slot (except
+ # edge labels, b/c phylo object has none)
+ phyd.tr <- reorder(phyd.tr)
+ phyd.phy <- reorder(phyd.phy)
+ expect_equal(edges(phyd.tr), edges(phyd.phy))
+ expect_equal(edgeLength(phyd.tr), edgeLength(phyd.phy))
+ expect_equal(nNodes(phyd.tr), nNodes(phyd.phy))
+ expect_equal(tipLabels(phyd.tr), tipLabels(phyd.phy))
+ expect_equal(nodeLabels(phyd.tr), nodeLabels(phyd.phy))
+ expect_equal(edgeOrder(phyd.tr), edgeOrder(phyd.phy))
+ expect_equal(phyd.tr at annote, phyd.phy at annote)
+ # other misc checks
+ expect_equal(phylo4d(phylo4(tr)), phylo4d(tr))
+ expect_equal(phylo4d(phylo4(tr, check.node.labels="drop")),
+ phylo4d(tr, check.node.labels="drop"))
+
+ ##
+ ## metadata
+ ##
+
+ metadata <- list(x="metadata")
+ phyd <- phylo4d(tr, metadata=metadata)
+ expect_equal(metadata, phyd at metadata)
+
+ ##
+ ## check.node.labels
+ ##
+
+ # case 0: no node labels
+ tr$node.label <- NULL
+ phyd <- phylo4d(tr)
+ expect_true(!hasNodeLabels(phyd))
+
+ # case 1: convert character labels as data
+ tr$node.label <- paste("n", 1:4, sep="")
+ phyd <- phylo4d(tr, check.node.labels="asdata")
+ expect_true(!hasNodeLabels(phyd))
+ expect_equal(tdata(phyd, "internal")$labelValues, as.factor(tr$node.label))
+
+ # case 2: convert number-like characters labels to numeric data
+ tr$node.label <- as.character(1:4)
+ phyd <- phylo4d(tr, check.node.labels="asdata")
+ expect_true(!hasNodeLabels(phyd))
+ expect_equal(tdata(phyd, "internal")$labelValues,
+ as.numeric(tr$node.label))
+
+ # case 3: convert numeric labels to numeric data
+ tr$node.label <- as.numeric(1:4)
+ phyd <- phylo4d(tr, check.node.labels="asdata")
+ expect_true(!hasNodeLabels(phyd))
+ expect_equal(tdata(phyd, "internal")$labelValues, tr$node.label)
+
+ # case 4: non-unique labels can be converted to data
+ tr$node.label <- rep(99, 4)
+ phyd <- phylo4d(tr)
+ expect_equal(unname(nodeLabels(phyd)), as.character(tr$node.label))
+ phyd <- phylo4d(tr, check.node.labels="asdata")
+ expect_true(!hasNodeLabels(phyd))
+ expect_equal(tdata(phyd, "internal", label.type="column")$labelValues, tr$node.label)
+})
+
+## phylo4d->phylo4d is currently unallowed
+
+test_that("phylo4d to phylo4d throws error", {
+ phyd <- phylo4d(phy)
+ expect_error(phylo4d(phyd))
+})
+
+test_that("nexml to phylo4d", {
+ nxml <- RNeXML::nexml_read(compFile)
+ phy4d <- phylo4d(nxml)
+ nxmldt <- RNeXML::get_characters(nxml)
+ phy4d2 <- phylo4d(get_trees(nxml), nxmldt[sample(1:nrow(nxmldt)), ])
+ expect_true(all(tipLabels(phy4d) %in% paste("taxon", 1:10, sep="_")))
+ expect_equal(nEdges(phy4d), 19)
+ expect_equal(phy4d, phy4d2)
+ expect_equal(ncol(tdata(phy4d, "tip")), 2)
+ expect_true(all(names(tdata(phy4d, "tip")) %in% c("log.snout.vent.length", "reef.dwelling")))
+})
diff --git a/tests/testthat/test.formatData.R b/tests/testthat/test.formatData.R
new file mode 100644
index 0000000..792ed72
--- /dev/null
+++ b/tests/testthat/test.formatData.R
@@ -0,0 +1,480 @@
+#
+# --- Test formatData.R ---
+#
+
+# create phylo4 object with a full complement of valid slots
+ancestor <- as.integer(c(6,7,7,6,8,0,8,9,9))
+descendant <- as.integer(c(7,1,2,8,3,6,9,4,5))
+edge <- cbind(ancestor, descendant)
+nid.tip <- 1:5
+nid.int <- 6:9
+nid.all <- c(nid.tip, nid.int)
+lab.tip <- paste("t", nid.tip, sep="")
+lab.int <- paste("n", nid.int, sep="")
+lab.all <- c(lab.tip, lab.int)
+elen <- descendant/10
+elab <- paste("e", ancestor, descendant, sep="-")
+phy <- phylo4(x=edge, tip.label=lab.tip, node.label=lab.int,
+ edge.length=elen, edge.label=elab)
+
+# create altered version such that each slot is out of order with
+# respect to all others; methods should be able to handle this
+phy.alt <- phy
+phy.alt at label <- rev(phy at label)
+phy.alt at edge <- phy at edge[c(6:9, 1:5), ]
+phy.alt at edge.length <- phy at edge.length[c(7:9, 1:6)]
+phy.alt at edge.label <- phy at edge.label[c(8:9, 1:7)]
+
+# create data to add to phylo4 to create phylo4d, but with data rows out
+# of order
+set.seed(1)
+nid.tip.r <- sample(nid.tip)
+nid.int.r <- sample(nid.int)
+nid.all.r <- sample(c(nid.tip, nid.int))
+allDt <- data.frame(a=letters[nid.all.r], b=10*nid.all.r)
+tipDt <- data.frame(c=letters[nid.tip.r], d=10*nid.tip.r)
+nodDt <- data.frame(c=letters[nid.int.r], e=10*nid.int.r)
+## set row.names as numeric node IDs (may be changed in tests below)
+row.names(allDt) <- nid.all.r
+row.names(tipDt) <- nid.tip.r
+row.names(nodDt) <- nid.int.r
+
+#-----------------------------------------------------------------------
+
+context("test formatData")
+
+## function(phy, dt, type=c("tip", "internal", "all"),
+## match.data=TRUE, rownamesAsLabels=FALSE,
+## label.type=c("rownames", "column"), label.column=1,
+## missing.data=c("fail", "warn", "OK"),
+## extra.data=c("warn", "OK", "fail"), keep.all=TRUE
+
+test_that("works with data.frame", {
+ ## vector data coerced to data.frame (colname dt)
+ expect_equal(phylobase:::formatData(phy.alt, 1:5),
+ phylobase:::formatData(phy.alt, data.frame(dt=1:5)))
+})
+
+test_that("works with lists of vector", {
+ ## list of vector data coerced to data.frame (colnames as given)
+ expect_equal(phylobase:::formatData(phy.alt, list(a=1:5, b=6:10)),
+ phylobase:::formatData(phy.alt, data.frame(a=1:5, b=6:10)))
+})
+
+test_that("works factors", {
+ ## factor data coerced to data.frame (colname dt)
+ expect_equal(phylobase:::formatData(phy.alt, factor(letters[1:5])),
+ phylobase:::formatData(phy.alt, data.frame(dt=letters[1:5])))
+})
+
+test_that("works with data.frame and 2 columns", {
+ ## matrix data coerced to data.frame (colnames V1, V2)
+ expect_equal(phylobase:::formatData(phy.alt, matrix(1:10, ncol=2)),
+ phylobase:::formatData(phy.alt, data.frame(V1=1:5, V2=6:10)))
+})
+
+test_that("works with data.frame colname as given", {
+ ## matrix data coerced to data.frame (colname as given)
+ expect_equal(phylobase:::formatData(phy.alt, matrix(1:10, ncol=2,
+ dimnames=list(NULL, c("a", "b")))),
+ phylobase:::formatData(phy.alt, data.frame(a=1:5, b=6:10)))
+})
+
+test_that("fails with non-supported objects (i.e. a phylo4)", {
+ ## error if dt is, say, a phylo4 object
+ expect_error(phylobase:::formatData(phy.alt, phy.alt))
+})
+
+test_that("fails with column number is out of range", {
+ ## error if column number is out of range
+ expect_error(phylobase:::formatData(phy.alt, data.frame(a=1:5,
+ lab=rev(nid.tip)), type="tip", match.data=FALSE,
+ label.type="column", label.column=3))
+})
+
+test_that("fails with column name is wrong", {
+ ## error if column name is wrong
+ expect_error(phylobase:::formatData(phy.alt, data.frame(a=1:5,
+ lab=rev(nid.tip)), type="tip", match.data=FALSE,
+ label.type="column", label.column="foo"))
+})
+
+
+##
+## matching options
+##
+
+test_that("matching options work as expected", {
+ ## don't match (purely positional)
+ expect_equal(phylobase:::formatData(phy.alt, data.frame(a=1:5,
+ row.names=rev(nid.tip)), type="tip", match.data=FALSE),
+ data.frame(a=c(1:5, rep(NA, 4)), row.names=nid.all))
+ ## match on rownames (node numbers)
+ expect_equal(phylobase:::formatData(phy.alt, data.frame(a=1:5,
+ row.names=rev(nid.tip)), type="tip", match.data=TRUE),
+ data.frame(a=c(5:1, rep(NA, 4)), row.names=nid.all))
+ expect_equal(phylobase:::formatData(phy.alt, data.frame(a=1:5,
+ row.names=rev(nid.tip)), type="tip"), data.frame(a=c(5:1,
+ rep(NA, 4)), row.names=nid.all))
+ ## match on rownames (labels)
+ expect_equal(phylobase:::formatData(phy.alt, data.frame(a=1:5,
+ row.names=rev(lab.tip)), type="tip", match.data=TRUE),
+ data.frame(a=c(5:1, rep(NA, 4)), row.names=nid.all))
+ ## match on rownames (mixed node numbers and labels)
+ expect_equal(phylobase:::formatData(phy.alt, data.frame(a=1:5,
+ row.names=c(rev(lab.tip)[1:3], rev(nid.tip)[4:5])),
+ type="tip", match.data=TRUE),
+ data.frame(a=c(5:1, rep(NA, 4)), row.names=nid.all))
+ ## but fails if rownamesAsLabels is TRUE
+ expect_error(phylobase:::formatData(phy.alt, data.frame(a=1:5,
+ row.names=c(rev(lab.tip)[1:3], rev(nid.tip)[4:5])),
+ type="tip", match.data=TRUE, rownamesAsLabels=TRUE))
+})
+
+##
+## label.type="column" and label.column=2
+##
+
+test_that("label.type=column works", {
+ ## should ignore label (purely positional) and retain a label col
+ expect_equal(phylobase:::formatData(phy.alt, data.frame(a=1:5,
+ lab=rev(nid.tip)), type="tip", match.data=FALSE,
+ label.type="column", label.column=2),
+ data.frame(a=c(1:5, rep(NA, 4)), lab=c(rev(nid.tip), rep(NA,
+ 4)), row.names=nid.all))
+ ## match on label column (node numbers)
+ expect_equal(phylobase:::formatData(phy.alt, data.frame(a=1:5,
+ lab=rev(nid.tip)), type="tip", match.data=TRUE,
+ label.type="column", label.column=2),
+ data.frame(a=c(5:1, rep(NA, 4)), row.names=nid.all))
+ expect_equal(phylobase:::formatData(phy.alt, data.frame(a=1:5,
+ lab=rev(nid.tip)), type="tip",
+ label.type="column", label.column=2),
+ data.frame(a=c(5:1, rep(NA, 4)), row.names=nid.all))
+ ## match on label column (labels)
+ expect_equal(phylobase:::formatData(phy.alt, data.frame(a=1:5,
+ lab=rev(lab.tip)), type="tip", match.data=TRUE,
+ label.type="column", label.column=2),
+ data.frame(a=c(5:1, rep(NA, 4)), row.names=nid.all))
+ expect_equal(phylobase:::formatData(phy.alt, data.frame(a=1:5,
+ lab=rev(lab.tip)), type="tip", match.data=TRUE,
+ label.type="column", label.column="lab"),
+ data.frame(a=c(5:1, rep(NA, 4)), row.names=nid.all))
+ ## match on label column (mixed node numbers and labels)
+ expect_equal(phylobase:::formatData(phy.alt, data.frame(a=1:5,
+ lab=c(rev(lab.tip)[1:3], rev(nid.tip)[4:5])), type="tip",
+ match.data=TRUE, label.type="column", label.column=2),
+ data.frame(a=c(5:1, rep(NA, 4)), row.names=nid.all))
+ ## but fails if rownamesAsLabels is TRUE
+ expect_error(phylobase:::formatData(phy.alt, data.frame(a=1:5,
+ lab=c(rev(lab.tip)[1:3], rev(nid.tip)[4:5])),
+ type="tip", match.data=TRUE, rownamesAsLabels=TRUE,
+ label.type="column", label.column=2))
+ ## try to match internal nodes when type='tips'
+ expect_error(phylobase:::formatData(phy.alt, data.frame(a=1:5, row.names=4:8),
+ type="tip"))
+ ## and vice versa
+ expect_error(phylobase:::formatData(phy.alt, data.frame(a=6:9, row.names=1:4),
+ type="internal"))
+})
+
+##
+## missing.data
+##
+
+test_that("behaves as expected with missing data", {
+ ## force error conditions
+ expect_error(phylobase:::formatData(phy.alt, data.frame(a=1:3), type="tip"))
+ expect_error(phylobase:::formatData(phy.alt, data.frame(a=1:3), type="tip",
+ missing.data="fail"))
+ expect_warning(phylobase:::formatData(phy.alt, data.frame(a=1:3), type="tip",
+ missing.data="warn"))
+ ## missing data with matching
+ expect_equal(phylobase:::formatData(phy.alt, data.frame(a=rev(nid.tip)[-1],
+ row.names=rev(nid.tip)[-1]), type="tip", missing.data="OK"),
+ data.frame(a=c(nid.tip[-5], rep(NA, 5))))
+ expect_equal(phylobase:::formatData(phy.alt, data.frame(a=rev(nid.int)[-1],
+ row.names=rev(nid.int)[-1]), type="internal", missing.data="OK"),
+ data.frame(a=c(rep(NA, 5), nid.int[-4], NA)))
+ expect_equal(phylobase:::formatData(phy.alt, data.frame(a=rev(nid.all)[-1],
+ row.names=rev(nid.all)[-1]), type="all", missing.data="OK"),
+ data.frame(a=c(nid.all[-9], NA)))
+ ## missing data without matching
+ expect_equal(phylobase:::formatData(phy.alt, data.frame(a=rev(nid.tip)[-1]),
+ type="tip", match.data=FALSE, missing.data="OK"),
+ data.frame(a=c(rev(nid.tip)[-1], rep(NA, 5))))
+ expect_equal(phylobase:::formatData(phy.alt, data.frame(a=rev(nid.int)[-1]),
+ type="internal", match.data=FALSE, missing.data="OK"),
+ data.frame(a=c(rep(NA, 5), rev(nid.int)[-1], NA)))
+ expect_equal(phylobase:::formatData(phy.alt, data.frame(a=rev(nid.all)[-1]),
+ type="all", match.data=FALSE, missing.data="OK"),
+ data.frame(a=c(rev(nid.all)[-1], NA)))
+})
+
+##
+## extra.data
+##
+
+test_that("works as expected with extra data", {
+ ## force error conditions
+ expect_error(phylobase:::formatData(phy.alt, data.frame(a=1:3), type="tip",
+ missing.data="fail"))
+ expect_warning(phylobase:::formatData(phy.alt, data.frame(a=0:5, row.names=0:5),
+ type="tip", missing="warn"), "not found in the tree")
+ expect_warning(phylobase:::formatData(phy.alt, data.frame(a=0:5, row.names=0:5),
+ type="tip"), "not found in the tree")
+ ## extra data with matching
+ expect_equal(phylobase:::formatData(phy.alt, data.frame(a=c(0L, rev(nid.tip)),
+ row.names=c(0, rev(nid.tip))), type="tip", extra.data="OK"),
+ data.frame(a=c(nid.tip, rep(NA, 4))))
+ expect_equal(phylobase:::formatData(phy.alt, data.frame(a=c(0L, rev(nid.int)),
+ row.names=c(0, rev(nid.int))), type="internal", extra.data="OK"),
+ data.frame(a=c(rep(NA, 5), nid.int)))
+ expect_equal(phylobase:::formatData(phy.alt, data.frame(a=c(0L, rev(nid.all)),
+ row.names=c(0, rev(nid.all))), type="all", extra.data="OK"),
+ data.frame(a=nid.all))
+ ## extra data without matching
+ expect_equal(phylobase:::formatData(phy.alt, data.frame(a=1:15),
+ type="tip", match.data=FALSE, extra.data="OK"),
+ data.frame(a=c(1:5, rep(NA, 4))))
+ expect_equal(phylobase:::formatData(phy.alt, data.frame(a=1:15),
+ type="internal", match.data=FALSE, extra.data="OK"),
+ data.frame(a=c(rep(NA, 5), 1:4)))
+ expect_equal(phylobase:::formatData(phy.alt, data.frame(a=1:15),
+ type="all", match.data=FALSE, extra.data="OK"),
+ data.frame(a=c(1:9)))
+})
+
+test_that("works as expected with both missing & extra data", {
+ ## allow both extra.data and missing.data
+ expect_equal(phylobase:::formatData(phy.alt, data.frame(a=0:3, row.names=0:3),
+ type="tip", extra.data="OK", missing.data="OK"),
+ data.frame(a=c(1:3, rep(NA, 6))))
+})
+
+##
+## keep.all
+##
+
+test_that("keep.all works", {
+ ## keep all rows
+ expect_equal(phylobase:::formatData(phy.alt, data.frame(a=1:5,
+ row.names=nid.tip), type="tip", keep.all=TRUE),
+ data.frame(a=c(1:5, rep(NA, 4)), row.names=nid.all))
+ expect_equal(phylobase:::formatData(phy.alt, data.frame(a=1:5,
+ row.names=nid.tip), type="tip"),
+ data.frame(a=c(1:5, rep(NA, 4)), row.names=nid.all))
+ expect_equal(phylobase:::formatData(phy.alt, data.frame(a=6:9,
+ row.names=nid.int), type="internal", keep.all=TRUE),
+ data.frame(a=c(rep(NA, 5), 6:9), row.names=nid.all))
+ expect_equal(phylobase:::formatData(phy.alt, data.frame(a=6:9,
+ row.names=nid.int), type="internal"),
+ data.frame(a=c(rep(NA, 5), 6:9), row.names=nid.all))
+ ## only keep 'type' rows
+ expect_equal(phylobase:::formatData(phy.alt, data.frame(a=1:5,
+ row.names=nid.tip), type="tip", keep.all=FALSE),
+ data.frame(a=c(1:5), row.names=nid.tip))
+ expect_equal(phylobase:::formatData(phy.alt, data.frame(a=6:9,
+ row.names=nid.int), type="internal", keep.all=FALSE),
+ data.frame(a=c(6:9), row.names=nid.int))
+})
+
+context("formatData with duplicated labels in object")
+
+test_that("formatData works with duplicated labels", {
+ ## Saving default options
+ op <- phylobase.options()
+
+ ## Changing default options
+ phylobase.options(allow.duplicated.labels="ok")
+
+ ## Creating phylo4 object with duplicated labels
+ phy.dup <- phy.alt
+ tipLabels(phy.dup)[2] <- tipLabels(phy.dup)[1]
+
+ ## vector data coerced to data.frame (colname dt)
+ expect_equal(phylobase:::formatData(phy.dup, 1:5),
+ phylobase:::formatData(phy.dup, data.frame(dt=1:5)))
+ ## list of vector data coerced to data.frame (colnames as given)
+ expect_equal(phylobase:::formatData(phy.dup, list(a=1:5, b=6:10)),
+ phylobase:::formatData(phy.dup, data.frame(a=1:5, b=6:10)))
+ ## factor data coerced to data.frame (colname dt)
+ expect_equal(phylobase:::formatData(phy.dup, factor(letters[1:5])),
+ phylobase:::formatData(phy.dup, data.frame(dt=letters[1:5])))
+ ## matrix data coerced to data.frame (colnames V1, V2)
+ expect_equal(phylobase:::formatData(phy.dup, matrix(1:10, ncol=2)),
+ phylobase:::formatData(phy.dup, data.frame(V1=1:5, V2=6:10)))
+ ## matrix data coerced to data.frame (colname as given)
+ expect_equal(phylobase:::formatData(phy.dup, matrix(1:10, ncol=2,
+ dimnames=list(NULL, c("a", "b")))),
+ phylobase:::formatData(phy.dup, data.frame(a=1:5, b=6:10)))
+ ## error if dt is, say, a phylo4 object
+ expect_error(phylobase:::formatData(phy.dup, phy.dup))
+
+ #
+ # matching options
+ #
+
+ ## don't match (purely positional)
+ expect_equal(phylobase:::formatData(phy.dup, data.frame(a=1:5,
+ row.names=rev(nid.tip)), type="tip", match.data=FALSE),
+ data.frame(a=c(1:5, rep(NA, 4)), row.names=nid.all))
+ ## match on rownames (node numbers)
+ expect_equal(phylobase:::formatData(phy.dup, data.frame(a=1:5,
+ row.names=rev(nid.tip)), type="tip", match.data=TRUE),
+ data.frame(a=c(5:1, rep(NA, 4)), row.names=nid.all))
+ expect_equal(phylobase:::formatData(phy.dup, data.frame(a=1:5,
+ row.names=rev(nid.tip)), type="tip"), data.frame(a=c(5:1,
+ rep(NA, 4)), row.names=nid.all))
+ ## match on rownames (labels)
+ expect_equal(phylobase:::formatData(phy.dup, data.frame(a=c(1,3,4,5),
+ row.names=rev(lab.tip[-2])), type="tip", match.data=TRUE),
+ data.frame(a=c(5,5,4,3,1, rep(NA, 4)), row.names=nid.all))
+ ## match on rownames (mixed node numbers and labels)
+ expect_equal(phylobase:::formatData(phy.dup, data.frame(a=c(1,2,3,4,5),
+ row.names=c(rev(lab.tip)[1:3], rev(nid.tip)[4:5])),
+ type="tip", match.data=TRUE),
+ data.frame(a=c(5,4,3,2,1, rep(NA, 4)), row.names=nid.all))
+ ## but fails if rownamesAsLabels is TRUE
+ expect_error(phylobase:::formatData(phy.dup, data.frame(a=1:5,
+ row.names=c(rev(lab.tip)[1:3], rev(nid.tip)[4:5])),
+ type="tip", match.data=TRUE, rownamesAsLabels=TRUE))
+
+ ##
+ ## label.type="column" and label.column=2
+ ##
+
+ ## should ignore label (purely positional) and retain a label col
+ expect_equal(phylobase:::formatData(phy.dup, data.frame(a=1:5,
+ lab=rev(nid.tip)), type="tip", match.data=FALSE,
+ label.type="column", label.column=2),
+ data.frame(a=c(1:5, rep(NA, 4)), lab=c(rev(nid.tip), rep(NA,
+ 4)), row.names=nid.all))
+ ## match on label column (node numbers)
+ expect_equal(phylobase:::formatData(phy.dup, data.frame(a=1:5,
+ lab=rev(nid.tip)), type="tip", match.data=TRUE,
+ label.type="column", label.column=2),
+ data.frame(a=c(5:1, rep(NA, 4)), row.names=nid.all))
+ expect_equal(phylobase:::formatData(phy.dup, data.frame(a=1:5,
+ lab=rev(nid.tip)), type="tip",
+ label.type="column", label.column=2),
+ data.frame(a=c(5:1, rep(NA, 4)), row.names=nid.all))
+ ## match on label column (labels)
+ expect_equal(phylobase:::formatData(phy.dup, data.frame(a=1:4,
+ lab=rev(lab.tip[-2])), type="tip", match.data=TRUE,
+ label.type="column", label.column=2),
+ data.frame(a=as.integer(c(4, 4:1, rep(NA, 4))), row.names=nid.all))
+ ## match on label column (mixed node numbers and labels)
+ expect_equal(phylobase:::formatData(phy.dup, data.frame(a=1:5,
+ lab=c(rev(lab.tip)[1:3], rev(nid.tip)[4:5])), type="tip",
+ match.data=TRUE, label.type="column", label.column=2),
+ data.frame(a=c(5:1, rep(NA, 4)), row.names=nid.all))
+ ## but fails if rownamesAsLabels is TRUE
+ expect_error(phylobase:::formatData(phy.dup, data.frame(a=1:5,
+ lab=c(rev(lab.tip)[1:3], rev(nid.tip)[4:5])),
+ type="tip", match.data=TRUE, rownamesAsLabels=TRUE,
+ label.type="column", label.column=2))
+
+ ## try to match internal nodes when type='tips'
+ expect_error(phylobase:::formatData(phy.dup, data.frame(a=1:5, row.names=4:8),
+ type="tip"))
+ ## and vice versa
+ expect_error(phylobase:::formatData(phy.dup, data.frame(a=6:9, row.names=1:4),
+ type="internal"))
+
+ ##
+ ## missing.data
+ ##
+
+ ## force error conditions
+ expect_error(phylobase:::formatData(phy.dup, data.frame(a=1:3), type="tip"))
+ expect_error(phylobase:::formatData(phy.dup, data.frame(a=1:3), type="tip",
+ missing.data="fail"))
+ expect_warning(phylobase:::formatData(phy.dup, data.frame(a=1:3), type="tip",
+ missing.data="warn"))
+ ## missing data with matching
+ expect_equal(phylobase:::formatData(phy.dup, data.frame(a=rev(nid.tip)[-1],
+ row.names=rev(nid.tip)[-1]), type="tip", missing.data="OK"),
+ data.frame(a=c(nid.tip[-5], rep(NA, 5))))
+ expect_equal(phylobase:::formatData(phy.dup, data.frame(a=rev(nid.int)[-1],
+ row.names=rev(nid.int)[-1]), type="internal", missing.data="OK"),
+ data.frame(a=c(rep(NA, 5), nid.int[-4], NA)))
+ expect_equal(phylobase:::formatData(phy.dup, data.frame(a=rev(nid.all)[-1],
+ row.names=rev(nid.all)[-1]), type="all", missing.data="OK"),
+ data.frame(a=c(nid.all[-9], NA)))
+ ## missing data without matching
+ expect_equal(phylobase:::formatData(phy.dup, data.frame(a=rev(nid.tip)[-1]),
+ type="tip", match.data=FALSE, missing.data="OK"),
+ data.frame(a=c(rev(nid.tip)[-1], rep(NA, 5))))
+ expect_equal(phylobase:::formatData(phy.dup, data.frame(a=rev(nid.int)[-1]),
+ type="internal", match.data=FALSE, missing.data="OK"),
+ data.frame(a=c(rep(NA, 5), rev(nid.int)[-1], NA)))
+ expect_equal(phylobase:::formatData(phy.dup, data.frame(a=rev(nid.all)[-1]),
+ type="all", match.data=FALSE, missing.data="OK"),
+ data.frame(a=c(rev(nid.all)[-1], NA)))
+
+ ##
+ ## extra.data
+ ##
+
+ ## force error conditions
+ expect_error(phylobase:::formatData(phy.dup, data.frame(a=1:3), type="tip",
+ missing.data="fail"))
+ expect_warning(phylobase:::formatData(phy.dup, data.frame(a=0:5, row.names=0:5),
+ type="tip", missing="warn"))
+ expect_warning(phylobase:::formatData(phy.dup, data.frame(a=0:5, row.names=0:5),
+ type="tip"))
+ ## extra data with matching
+ expect_equal(phylobase:::formatData(phy.dup, data.frame(a=c(0L, rev(nid.tip)),
+ row.names=c(0, rev(nid.tip))), type="tip", extra.data="OK"),
+ data.frame(a=c(nid.tip, rep(NA, 4))))
+ expect_equal(phylobase:::formatData(phy.dup, data.frame(a=c(0L, rev(nid.int)),
+ row.names=c(0, rev(nid.int))), type="internal", extra.data="OK"),
+ data.frame(a=c(rep(NA, 5), nid.int)))
+ expect_equal(phylobase:::formatData(phy.dup, data.frame(a=c(0L, rev(nid.all)),
+ row.names=c(0, rev(nid.all))), type="all", extra.data="OK"),
+ data.frame(a=nid.all))
+ ## extra data without matching
+ expect_equal(phylobase:::formatData(phy.dup, data.frame(a=1:15),
+ type="tip", match.data=FALSE, extra.data="OK"),
+ data.frame(a=c(1:5, rep(NA, 4))))
+ expect_equal(phylobase:::formatData(phy.dup, data.frame(a=1:15),
+ type="internal", match.data=FALSE, extra.data="OK"),
+ data.frame(a=c(rep(NA, 5), 1:4)))
+ expect_equal(phylobase:::formatData(phy.dup, data.frame(a=1:15),
+ type="all", match.data=FALSE, extra.data="OK"),
+ data.frame(a=c(1:9)))
+
+ ## allow both extra.data and missing.data
+ expect_equal(phylobase:::formatData(phy.dup, data.frame(a=0:3, row.names=0:3),
+ type="tip", extra.data="OK", missing.data="OK"),
+ data.frame(a=c(1:3, rep(NA, 6))))
+
+ ##
+ ## keep.all
+ ##
+
+ ## keep all rows
+ expect_equal(phylobase:::formatData(phy.dup, data.frame(a=1:5,
+ row.names=nid.tip), type="tip", keep.all=TRUE),
+ data.frame(a=c(1:5, rep(NA, 4)), row.names=nid.all))
+ expect_equal(phylobase:::formatData(phy.dup, data.frame(a=1:5,
+ row.names=nid.tip), type="tip"),
+ data.frame(a=c(1:5, rep(NA, 4)), row.names=nid.all))
+ expect_equal(phylobase:::formatData(phy.dup, data.frame(a=6:9,
+ row.names=nid.int), type="internal", keep.all=TRUE),
+ data.frame(a=c(rep(NA, 5), 6:9), row.names=nid.all))
+ expect_equal(phylobase:::formatData(phy.dup, data.frame(a=6:9,
+ row.names=nid.int), type="internal"),
+ data.frame(a=c(rep(NA, 5), 6:9), row.names=nid.all))
+ ## only keep 'type' rows
+ expect_equal(phylobase:::formatData(phy.dup, data.frame(a=1:5,
+ row.names=nid.tip), type="tip", keep.all=FALSE),
+ data.frame(a=c(1:5), row.names=nid.tip))
+ expect_equal(phylobase:::formatData(phy.dup, data.frame(a=6:9,
+ row.names=nid.int), type="internal", keep.all=FALSE),
+ data.frame(a=c(6:9), row.names=nid.int))
+
+ ## restoring default options
+ phylobase.options(op)
+})
diff --git a/tests/testthat/test.methods-oldclasses.R b/tests/testthat/test.methods-oldclasses.R
new file mode 100644
index 0000000..73df893
--- /dev/null
+++ b/tests/testthat/test.methods-oldclasses.R
@@ -0,0 +1,8 @@
+#
+# --- Test methods-oldclasses.R ---
+#
+
+#test.reorder.phylo <- function() {
+# # function(x, order = 'cladewise')
+#}
+
diff --git a/tests/testthat/test.methods-phylo4.R b/tests/testthat/test.methods-phylo4.R
new file mode 100644
index 0000000..4935794
--- /dev/null
+++ b/tests/testthat/test.methods-phylo4.R
@@ -0,0 +1,641 @@
+##
+## --- Test methods-phylo4.R ---
+##
+
+# create ape::phylo version of a simple tree for testing
+nwk <- "((t1:0.1,t2:0.2)n7:0.7,(t3:0.3,(t4:0.4,t5:0.5)n9:0.9)n8:0.8)n6:0.6;"
+tr <- read.tree(text=nwk)
+
+# create analogous phylo4 object with a full complement of valid slots
+ancestor <- as.integer(c(6,7,7,6,8,0,8,9,9))
+descendant <- as.integer(c(7,1,2,8,3,6,9,4,5))
+edge <- cbind(ancestor, descendant)
+nid.tip <- 1:5
+nid.int <- 6:9
+nid.all <- c(nid.tip, nid.int)
+lab.tip <- paste("t", nid.tip, sep="")
+lab.int <- paste("n", nid.int, sep="")
+lab.all <- c(lab.tip, lab.int)
+eid <- paste(ancestor, descendant, sep="-")
+elen <- descendant/10
+elab <- paste("e", eid, sep="")
+phy <- phylo4(x=edge, tip.label=lab.tip, node.label=lab.int,
+ edge.length=elen, edge.label=elab)
+
+# create altered version such that each slot is out of order with
+# respect to all others; methods should be able to handle this
+phy.alt <- phy
+phy.alt at label <- rev(phy at label)
+phy.alt at edge <- phy at edge[c(6:9, 1:5), ]
+phy.alt at edge.length <- phy at edge.length[c(7:9, 1:6)]
+phy.alt at edge.label <- phy at edge.label[c(8:9, 1:7)]
+
+# update test targets for edge-related slots
+ancestor <- ancestor[c(6:9, 1:5)]
+descendant <- descendant[c(6:9, 1:5)]
+edge <- cbind(ancestor, descendant)
+eid <- eid[c(6:9, 1:5)]
+elen <- elen[c(6:9, 1:5)]
+elab <- elab[c(6:9, 1:5)]
+
+op <- phylobase.options()
+#-----------------------------------------------------------------------
+
+context("nTips, depthTips, nNodes, nodeType")
+
+test_that("nTips works correctly",
+ expect_that(nTips(phy.alt), equals(length(nid.tip)))
+)
+
+test_that("depthTips works when there are edge lengths", {
+ edgeLengthVec <- c(1.2, 1.8, 1.8, 2.1, 2.3)
+ names(edgeLengthVec) <- tipLabels(phy.alt)
+ expect_that(depthTips(phy.alt), equals(edgeLengthVec))
+})
+
+test_that("depthTips works when there are no edge lengths", {
+ tmpPhy <- phy.alt
+ edgeLength(tmpPhy) <- NA
+ expect_true(is.null(depthTips(tmpPhy)))
+})
+
+test_that("nTips works on ape objects",
+ ## nTips phylo
+ expect_equal(nTips(tr), 5))
+
+test.nEdges.phylo4 <- function() {
+ expect_identical(nEdges(phy.alt), nrow(edge))
+}
+
+test_that("nNodes works as expected",
+ expect_equal(nNodes(phy.alt), length(nid.int)))
+
+test_that("nodeType works as expected",
+ expect_identical(nodeType(phy.alt),
+ setNames(c(rep("tip", length(nid.tip)),
+ "root",
+ rep("internal", length(nid.int)-1)),
+ c(nid.tip, nid.int))))
+
+context("nodeId")
+test_that("nodeId works without arguments",
+ expect_identical(nodeId(phy.alt), c(nid.tip, nid.int)))
+test_that("nodeId works with argument all",
+ expect_identical(nodeId(phy.alt, "all"), c(nid.tip, nid.int)))
+test_that("nodeId works with argument tip",
+ expect_identical(nodeId(phy.alt, "tip"), nid.tip))
+test_that("nodeId works with argument internal",
+ expect_identical(nodeId(phy.alt, "internal"), nid.int))
+test_that("nodeId works woth argument root",
+ expect_identical(nodeId(phy.alt, "root"), nid.int[1]))
+
+
+context("nodeDepth")
+allDepths <- c(1.2, 1.8, 1.8, 2.1, 2.3, 0.9, 1.0, 1.2, 1.6)
+names(allDepths) <- names(getNode(phy.alt))
+test_that("nodeDepth works without arguments", {
+ expect_equal(nodeDepth(phy.alt), allDepths)
+})
+
+test_that("nodeDepth works with numeric argument", {
+ expect_equal(nodeDepth(phy.alt, 1), allDepths[1])
+})
+
+test_that("nodeDepth works with character argument", {
+ expect_equal(nodeDepth(phy.alt, "t1"), allDepths[1])
+})
+
+test_that("nodeDepth works with no branch length", {
+ tmpPhy <- phy.alt
+ edgeLength(tmpPhy) <- NA
+ expect_true(is.null(nodeDepth(tmpPhy)))
+})
+
+############################################################################
+## nodeHeight ##
+############################################################################
+
+context("nodeHeight")
+
+tmp_nd_hgt_tree <- tempfile()
+cat("(((A:1,B:1):2,(C:1,D:1):2):4,((E:10,F:1):2,(G:3,H:7):2):4);",
+ file = tmp_nd_hgt_tree)
+nd_hgt_tree <- readNewick(file = tmp_nd_hgt_tree)
+unlink(tmp_nd_hgt_tree)
+
+test_that("nodeHeight with 1 node", {
+ expect_equal(nodeHeight(nd_hgt_tree, MRCA(nd_hgt_tree, c("A", "D")), "all_tip"),
+ setNames(c(3, 3, 3, 3), c("A", "B", "C", "D")))
+ expect_equal(nodeHeight(nd_hgt_tree, MRCA(nd_hgt_tree, c("E", "H")), "min_tip"),
+ c("F" = 3))
+ expect_equal(nodeHeight(nd_hgt_tree, MRCA(nd_hgt_tree, c("E", "H")), "max_tip"),
+ c("E" = 12))
+ expect_equal(nodeHeight(nd_hgt_tree, MRCA(nd_hgt_tree, c("A", "D")), "root"),
+ 4)
+ })
+
+test_that("nodeHeight with several nodes", {
+ expect_equal(nodeHeight(nd_hgt_tree, c(
+ MRCA(nd_hgt_tree, c("A", "D")),
+ MRCA(nd_hgt_tree, c("A", "B"))),
+ "all_tip"),
+ list("10" = setNames(c(3, 3, 3, 3), c("A", "B", "C", "D")),
+ "11" = c("A" = 1, "B" = 1)))
+
+ expect_equal(nodeHeight(nd_hgt_tree, c(
+ MRCA(nd_hgt_tree, c("E", "H")),
+ MRCA(nd_hgt_tree, c("E", "F"))),
+ "min_tip"),
+ list("13" = c("F" = 3),
+ "14" = c("F" = 1)))
+
+ expect_equal(nodeHeight(nd_hgt_tree, c(
+ MRCA(nd_hgt_tree, c("E", "H")),
+ MRCA(nd_hgt_tree, c("E", "F"))), "max_tip"),
+ list("13" = c("E" = 12),
+ "14" = c("E" = 10)))
+
+ expect_equal(nodeHeight(nd_hgt_tree, c(
+ MRCA(nd_hgt_tree, c("A", "D")),
+ MRCA(nd_hgt_tree, c("E", "F"))),
+ "root"),
+ c("10" = 4, "14" = 6))
+ })
+
+
+test_that("nodeHeight for tips", {
+ res <- as.list(rep(0, nTips(nd_hgt_tree)))
+ for (i in seq_len(nTips(nd_hgt_tree))) names(res[[i]]) <- LETTERS[i]
+ names(res) <- seq_len(nTips(nd_hgt_tree))
+
+ expect_equal(nodeHeight(nd_hgt_tree, nodeId(nd_hgt_tree, "tip"), "all_tip"),
+ res)
+ expect_equal(nodeHeight(nd_hgt_tree, nodeId(nd_hgt_tree, "tip"), "min_tip"),
+ res)
+ expect_equal(nodeHeight(nd_hgt_tree, nodeId(nd_hgt_tree, "tip"), "max_tip"),
+ res)
+ })
+
+test_that("nodeHeight for mix of tips and internal nodes", {
+ expect_equal(nodeHeight(nd_hgt_tree, c(1, 10), "all_tip"),
+ list("1" = c("A" = 0),
+ "10" = c("A" = 3, "B" = 3, "C" = 3, "D" = 3)))
+ expect_equal(nodeHeight(nd_hgt_tree, c(1, 14), "min_tip"),
+ list("1" = c("A" = 0),
+ "14" = c("F" = 1)))
+ expect_equal(nodeHeight(nd_hgt_tree, c(1, 14), "max_tip"),
+ list("1" = c("A" = 0),
+ "14" = c("E" = 10)))
+ expect_equal(nodeHeight(nd_hgt_tree, c(5, 14), "root"),
+ c("5" = 16, "14" = 6))
+ })
+
+
+############################################################################
+## edges ##
+############################################################################
+
+context("edges")
+test_that("edges works", expect_identical(edges(phy.alt), edge))
+test_that("edges work with drop.root=TRUE option",
+ expect_identical(edges(phy.alt, drop.root=TRUE),
+ edge[edge[,1] != 0,]))
+
+context("edge order")
+test_that("edgeOrder works as expected", {
+ expect_identical(edgeOrder(phy.alt), "unknown")
+ expect_identical(edgeOrder(reorder(phy.alt, "preorder")), "preorder")
+ expect_identical(edgeOrder(reorder(phy.alt, "postorder")), "postorder")
+})
+
+context("edgeId")
+test_that("edgeId works with no argument",
+ expect_identical(edgeId(phy.alt), eid))
+test_that("edgeId works with argument all",
+ expect_identical(edgeId(phy.alt, "all"), eid))
+test_that("edgeId works with argument tip",
+ expect_identical(edgeId(phy.alt, "tip"), eid[descendant %in% nid.tip]))
+test_that("edgeId works with argument internal",
+ expect_identical(edgeId(phy.alt, "internal"), eid[!descendant %in% nid.tip]))
+test_that("edgeId works with argument root",
+ expect_identical(edgeId(phy.alt, "root"), eid[ancestor == 0]))
+
+context("hasEdgeLength")
+test_that("hasEdgeLength works when edge lengths are present",
+ expect_true(hasEdgeLength(phy.alt)))
+test_that("hasEdgeLength works when no edge lengths are present", {
+ phy.alt at edge.length <- NA_real_
+ expect_true(!hasEdgeLength(phy.alt))
+})
+
+
+context("edgeLength")
+test_that("default works (all edge lengths)",
+ expect_identical(edgeLength(phy.alt), setNames(elen, eid)))
+test_that("one edge length, by label",
+ expect_equal(edgeLength(phy.alt, "t1"), c(`7-1`=0.1)))
+test_that("one edge length, by node ID",
+ expect_equal(edgeLength(phy.alt, 1), c(`7-1`=0.1)))
+test_that("non-existent edge, by label", {
+ ans <- structure(NA_real_, .Names = NA_character_)
+ expect_equal(suppressWarnings(edgeLength(phy.alt, "xxx")), ans)
+})
+test_that("non-existent edge, by number", {
+ ans <- structure(NA_real_, .Names = NA_character_)
+ expect_equal(suppressWarnings(edgeLength(phy.alt, 999)), ans)
+})
+test_that("wrong number of edge lengths", {
+ phy.tmp1 <- phy.alt
+ phy.tmp1 at edge.length <- phy.alt at edge.length[-1]
+ expect_true(nzchar(checkPhylo4(phy.tmp1)))
+ phy.tmp1 <- phy.alt
+ phy.tmp1 at edge.length <- c(phy.alt at edge.length, 1)
+ expect_true(nzchar(checkPhylo4(phy.tmp1)))
+})
+test_that("negative edge lengths", {
+ phy.tmp1 <- phy.alt
+ phy.tmp1 at edge.length[3] <- -1
+ expect_true(nzchar(checkPhylo4(phy.tmp1)))
+})
+test_that("edge incorrectly labeled", {
+ phy.tmp1 <- phy.alt
+ names(phy.tmp1 at edge.length)[1] <- "9-10"
+ expect_true(nzchar(checkPhylo4(phy.tmp1)))
+})
+
+context("edgeLength <-")
+emptyVec <- numeric()
+attributes(emptyVec) <- list(names=character(0))
+test_that("dropping all should produce empty slot", {
+ edgeLength(phy.alt) <- numeric()
+ expect_identical(edgeLength(phy.alt), setNames(rep(NA_real_, 9), edgeId(phy.alt, "all")))
+ expect_identical(phy.alt at edge.length, emptyVec)
+ edgeLength(phy.alt) <- NA_real_
+ expect_identical(edgeLength(phy.alt), setNames(rep(NA_real_, 9), edgeId(phy.alt, "all")))
+ expect_identical(phy.alt at edge.length, emptyVec)
+})
+test_that("vector with reversed names, get matched by default (complete replacement)", {
+ edgeLength(phy.alt) <- numeric()
+ revElen <- setNames(elen, rev(eid))
+ edgeLength(phy.alt) <- revElen
+ expect_identical(edgeLength(phy.alt), revElen[edgeId(phy.alt, "all")])
+})
+test_that("vector with reversed names, but specify no matching (complete replacement)", {
+ edgeLength(phy.alt) <- numeric()
+ revElen <- setNames(elen, rev(eid))
+ edgeLength(phy.alt, use.names=FALSE) <- revElen
+ elen1 <- elen
+ expect_identical(edgeLength(phy.alt), setNames(elen1, edgeId(phy.alt, "all")))
+})
+test_that("vector with no names, should match to edgeId order (complete replacement)", {
+ edgeLength(phy.alt) <- numeric()
+ edgeLength(phy.alt) <- elen
+ elen2 <- elen
+ expect_identical(edgeLength(phy.alt), setNames(elen2, edgeId(phy.alt, "all")))
+})
+test_that("recycling applies if fewer the nEdges elements are supplied, \
+ (duplicate edge length are okay), (complete replacement)", {
+ edgeLength(phy.alt) <- 1
+ expect_identical(edgeLength(phy.alt), setNames(rep(1, 9), edgeId(phy.alt, "all")))
+})
+edgeLength(phy.alt) <- elen
+test_that("replace an edge length using numeric index (partial replacement)", {
+ edgeLength(phy.alt)[9] <- 83
+ expect_identical(edgeLength(phy.alt), setNames(c(elen[1:8], 83), edgeId(phy.alt, "all")))
+})
+test_that("back again, now using character index (partial replacement)", {
+ edgeLength(phy.alt)["8-3"] <- 0.3
+ elen3 <- elen
+ expect_identical(edgeLength(phy.alt), setNames(elen3, edgeId(phy.alt, "all")))
+})
+test_that("error to add length for edges that don't exist (partial replacement)", {
+ expect_error(edgeLength(phy.alt)["fake"] <- 999)
+ expect_error(edgeLength(phy.alt)[999] <- 999)
+})
+test_that("NAs permitted only for root edge (or for *all* edges)", {
+ edgeLength(phy.alt)[edgeId(phy.alt, "root")] <- NA
+ expect_identical(edgeLength(phy.alt), setNames(c(NA, elen[2:9]), edgeId(phy.alt, "all")))
+ edgeLength(phy.alt) <- elen
+ expect_error(edgeLength(phy.alt)["8-3"] <- NA)
+})
+
+
+## TODO sumEdgeLength.phylo4 ## function(phy, node)
+
+context("isRooted")
+test_that("isRooted works as expected",
+ expect_true(isRooted(phy.alt)))
+
+context("rootNode")
+test_that("rootNode works as expected",
+ expect_identical(rootNode(phy.alt), getNode(phy, nid.int[1])))
+
+context("rootNode <-")
+test_that("rootNode <- is not yet implemented",
+ expect_error(rootNode(phy.alt) <- 7))
+
+context("labels")
+test_that("labels works as expected with no argument",
+ expect_identical(labels(phy.alt),
+ setNames(c(lab.tip, lab.int), c(nid.tip, nid.int))))
+test_that("labels works as expected with argument all",
+ expect_identical(labels(phy.alt, "all"),
+ setNames(c(lab.tip, lab.int), c(nid.tip, nid.int))))
+test_that("labels works as expected with argument tip",
+ expect_identical(labels(phy.alt, "tip"), setNames(lab.tip, nid.tip)))
+test_that("labels works as expected with argument internal",
+ expect_identical(labels(phy.alt, "internal"), setNames(lab.int, nid.int)))
+
+
+context("labels <-")
+test_that("dropping all should produce default tip labels, no internal labels", {
+ labels(phy.alt) <- character()
+ expect_identical(labels(phy.alt),
+ setNames(c(paste("T", 1:5, sep=""), rep(NA, 4)), nid.all))
+})
+
+## #
+## # complete replacement
+## #
+
+## with names, not used
+test_that("vector with reversed names, but names not used (all) - complete replacement", {
+ labels(phy.alt) <- character()
+ labels(phy.alt) <- setNames(lab.all, rev(nid.all))
+ expect_identical(labels(phy.alt), setNames(lab.all, nid.all))
+})
+test_that("vector with reversed names, but names not used (tips) - complete replacement", {
+ labels(phy.alt) <- character()
+ labels(phy.alt, "tip") <- setNames(lab.tip, rev(nid.tip))
+ expect_identical(tipLabels(phy.alt), setNames(lab.tip, nid.tip))
+})
+test_that("vector with reversed names, but names not used (internal) - complete replacement", {
+ labels(phy.alt) <- character()
+ labels(phy.alt, "internal") <- setNames(lab.int, rev(nid.int))
+ expect_identical(nodeLabels(phy.alt), setNames(lab.int, nid.int))
+})
+
+## with names, used
+test_that("vector with reversed names, but names used (all) - complete replacement", {
+ labels(phy.alt) <- character()
+ labels(phy.alt, use.names=TRUE) <- setNames(lab.all, rev(nid.all))
+ expect_identical(labels(phy.alt), setNames(rev(lab.all), nid.all))
+})
+test_that("vector with reversed names, but names used (tips) - complete replacement", {
+ labels(phy.alt) <- character()
+ labels(phy.alt, "tip", use.names=TRUE) <- setNames(lab.tip, rev(nid.tip))
+ expect_identical(tipLabels(phy.alt), setNames(rev(lab.tip), nid.tip))
+})
+test_that("vector with reversed names, but names used (internal) - complete replacement", {
+ labels(phy.alt) <- character()
+ labels(phy.alt, "internal", use.names=TRUE) <- setNames(lab.int, rev(nid.int))
+ expect_identical(nodeLabels(phy.alt), setNames(rev(lab.int), nid.int))
+})
+## no names
+test_that("vector with no names, should match to nodeId order (all) - complete replacement", {
+ labels(phy.alt) <- character()
+ labels(phy.alt) <- lab.all
+ expect_identical(labels(phy.alt), setNames(lab.all, nid.all))
+})
+test_that("vector with no names, should match to nodeId order (all) - complete replacement", {
+ labels(phy.alt) <- character()
+ labels(phy.alt, type="tip") <- lab.tip
+ expect_identical(tipLabels(phy.alt), setNames(lab.tip, nid.tip))
+})
+test_that("vector with no names, should match to nodeId order (all) - complete replacement", {
+ labels(phy.alt) <- character()
+ labels(phy.alt, type="internal") <- lab.int
+ expect_identical(nodeLabels(phy.alt), setNames(lab.int, nid.int))
+})
+
+## partial replacement
+labels(phy.alt) <- lab.all
+test_that("replace a tip using numeric index", {
+ labels(phy.alt)[5] <- "t5a"
+ expect_identical(tipLabels(phy.alt), setNames(c(lab.tip[1:4], "t5a"), nid.tip))
+})
+test_that("and back again, now using character index", {
+ labels(phy.alt)["5"] <- "t5"
+ expect_identical(labels(phy.alt), setNames(lab.all, nid.all))
+})
+test_that("replace an internal node using numeric index", {
+ labels(phy.alt)[9] <- "n9a"
+ expect_identical(nodeLabels(phy.alt), setNames(c(lab.int[1:3], "n9a"), nid.int))
+})
+test_that("and back again, now using character index", {
+ labels(phy.alt)["9"] <- "n9"
+ expect_identical(labels(phy.alt), setNames(lab.all, nid.all))
+})
+test_that("error to produce duplicate tip or internal label", {
+ phylobase.options(allow.duplicated.labels="fail")
+ expect_error(labels(phy.alt)[1] <- "t2")
+ expect_error(labels(phy.alt)[6] <- "n7")
+})
+test_that("no error in allow.duplicated.labels is ok", {
+ phylobase.options(allow.duplicated.labels="ok")
+ labels(phy.alt)[1] <- "t2"
+ labels(phy.alt)[6] <- "n7"
+ expect_identical(tipLabels(phy.alt), setNames(c("t2", "t2", "t3", "t4", "t5"), nid.tip))
+ expect_identical(nodeLabels(phy.alt), setNames(c("n7", "n7", "n8", "n9"), nid.int))
+})
+test_that("error to add labels for nodes that don't exist", {
+ expect_error(labels(phy.alt)["fake"] <- "xxx")
+ expect_error(labels(phy.alt)[999] <- "xxx")
+})
+
+context("nodeLabels")
+test_that("nodeLabels works as expected",
+ expect_identical(nodeLabels(phy.alt), setNames(lab.int, nid.int)))
+
+context("hasNodeLabels")
+test_that("hasNodeLabels works as expected", {
+ expect_true(hasNodeLabels(phy.alt))
+ nodeLabels(phy.alt) <- NA_character_
+ expect_true(!hasNodeLabels(phy.alt))
+})
+
+context("nodeLabels <-")
+test_that("dropping all should produce no internal labels", {
+ nodeLabels(phy.alt) <- character()
+ expect_true(!any(nid.int %in% names(phy.alt at label)))
+ expect_identical(nodeLabels(phy.alt), setNames(rep(NA_character_, 4), nid.int))
+})
+labels(phy.alt) <- lab.all
+test_that("replace an internal node using numeric index", {
+ nodeLabels(phy.alt)[4] <- "n9a"
+ expect_identical(nodeLabels(phy.alt), setNames(c(lab.int[1:3], "n9a"), nid.int))
+})
+test_that("and back again, now using character index", {
+ nodeLabels(phy.alt)["9"] <- "n9"
+ expect_identical(labels(phy.alt), setNames(lab.all, nid.all))
+})
+test_that("error to produce duplicate internal label", {
+ phylobase.options(allow.duplicated.labels="fail")
+ expect_error(nodeLabels(phy.alt)["6"] <- "n7")
+})
+test_that("duplicated labels work as expected", {
+ phylobase.options(op)
+ phylobase.options(allow.duplicated.labels="ok")
+ nodeLabels(phy.alt)["6"] <- "n7"
+ expect_identical(nodeLabels(phy.alt), setNames(c("n7", "n7", "n8", "n9"), nid.int))
+ expect_true(hasDuplicatedLabels(phy.alt))
+ ## NAs are not considered duplicated
+ nodeLabels(phy.alt)[1:2] <- NA
+ expect_true(!hasDuplicatedLabels(phy.alt))
+ phylobase.options(op)
+ ## error to add labels for nodes that don't exist
+ expect_error(nodeLabels(phy.alt)["fake"] <- "xxx")
+ expect_error(nodeLabels(phy.alt)[999] <- "xxx")
+})
+
+context("tipLabels")
+test_that("tipLabels works as expected",
+ expect_identical(tipLabels(phy.alt), setNames(lab.tip, nid.tip)))
+
+context("tipLabels <-")
+test_that("dropping all tip labels should produce default labels", {
+ tipLabels(phy.alt) <- character()
+ expect_identical(tipLabels(phy.alt), setNames(paste("T", 1:5, sep=""), nid.tip))
+})
+labels(phy.alt) <- lab.all
+test_that("replace a tip using numeric index", {
+ tipLabels(phy.alt)[5] <- "t5a"
+ expect_identical(tipLabels(phy.alt), setNames(c(lab.tip[1:4], "t5a"), nid.tip))
+})
+test_that("and back again, now using character index", {
+ tipLabels(phy.alt)["5"] <- "t5"
+ expect_identical(labels(phy.alt), setNames(lab.all, nid.all))
+})
+test_that("error to produce duplicate tip or internal label", {
+ phylobase.options(allow.duplicated.labels="fail")
+ expect_error(tipLabels(phy.alt)[1] <- "t2")
+})
+test_that("duplicated labels works as expected on tips", {
+ phylobase.options(op)
+ phylobase.options(allow.duplicated.labels="ok")
+ tipLabels(phy.alt)[1] <- "t2"
+ expect_identical(tipLabels(phy.alt), setNames(c("t2", "t2", "t3", "t4", "t5"), nid.tip))
+ expect_true(hasDuplicatedLabels(phy.alt))
+ tipLabels(phy.alt)[1:2] <- NA
+ expect_true(!hasDuplicatedLabels(phy.alt))
+ phylobase.options(op)
+})
+test_that("error to add labels for nodes that don't exist", {
+ expect_error(tipLabels(phy.alt)["fake"] <- "xxx")
+ expect_error(tipLabels(phy.alt)[999] <- "xxx")
+})
+test_that("hasEdgeLabels works as expected", {
+ expect_true(hasEdgeLabels(phy.alt))
+ phy.alt at edge.label <- NA_character_
+ expect_true(!hasEdgeLabels(phy.alt))
+})
+
+context("edgeLabels")
+test_that("edgeLabels works as expected", {
+ expect_identical(edgeLabels(phy.alt), setNames(elab, eid))
+})
+test_that("edgeLabels returns named vector of NAs if edge labels are missing or NA", {
+ phy.alt at edge.label <- NA_character_
+ expect_identical(edgeLabels(phy.alt), setNames(rep(NA_character_, 9), eid))
+ phy.alt at edge.label <- character()
+ expect_identical(edgeLabels(phy.alt), setNames(rep(NA_character_, 9), eid))
+})
+test_that("if only some labels exists, should fill in NA for the others", {
+ phy.alt at edge.label <- setNames(elab[-1], eid[-1])
+ expect_identical(edgeLabels(phy.alt), setNames(c(NA, elab[-1]), eid))
+})
+
+
+context("edgeLabels <-")
+test_that(" dropping all should produce empty slot", {
+ edgeLabels(phy.alt) <- character()
+ expect_identical(edgeLabels(phy.alt), setNames(rep(NA_character_, 9), eid))
+})
+test_that("vector with reversed names, which always get matched - complete replacement", {
+ edgeLabels(phy.alt) <- character()
+ edgeLabels(phy.alt) <- setNames(elab, rev(eid))
+ expect_identical(edgeLabels(phy.alt), setNames(rev(elab), eid))
+})
+test_that("vector with no names, should match to edgeId order - complete replacement", {
+ edgeLabels(phy.alt) <- character()
+ edgeLabels(phy.alt) <- elab
+ expect_identical(edgeLabels(phy.alt), setNames(elab, eid))
+})
+test_that("recycling applies if fewer the nEdges elements are supplied\\
+ (duplicate edge labels are okay) - complete replacement.", {
+ edgeLabels(phy.alt) <- "x"
+ expect_identical(edgeLabels(phy.alt), setNames(rep("x", 9), eid))
+ })
+edgeLabels(phy.alt) <- elab
+test_that("replace an edge label using numeric index - partial replacement", {
+ edgeLabels(phy.alt)[9] <- "e8-3a"
+ expect_identical(edgeLabels(phy.alt), setNames(c(elab[1:8], "e8-3a"), eid))
+})
+test_that("and back again, now using character index", {
+ edgeLabels(phy.alt)["8-3"] <- "e8-3"
+ expect_identical(edgeLabels(phy.alt), setNames(elab, eid))
+})
+test_that("error to add labels for edges that don't exist", {
+ expect_error(edgeLabels(phy.alt)["fake"] <- "xxx")
+ expect_error(edgeLabels(phy.alt)[999] <- "xxx")
+})
+
+## this is also the print method
+## this mostly just wraps .phylo4ToDataFrame, which is tested elsewhere
+## test.show.phylo4 <- function() {
+## }
+## test.names.phylo4 <- function() {
+## #TODO?
+## }
+## test.head.phylo4 <- function() {
+## #TODO?
+## }
+## test.tail.phylo4 <- function() {
+## #TODO?
+## }
+
+context("summary")
+test_that("summary works as expected", {
+ phy.sum <- summary(phy.alt, quiet=TRUE)
+ expect_identical(phy.sum$name, "phy.alt")
+ expect_identical(phy.sum$nb.tips, length(nid.tip))
+ expect_identical(phy.sum$nb.nodes, length(nid.int))
+ expect_identical(phy.sum$mean.el, mean(elen))
+ expect_identical(phy.sum$var.el, var(elen))
+ expect_identical(phy.sum$sumry.el, summary(elen))
+})
+test_that("summary works as expected when root edge as no length", {
+ ## now make root edge length NA
+ edgeLength(phy.alt)[edgeId(phy.alt, "root")] <- NA
+ phy.sum2 <- summary(phy.alt, quiet=TRUE)
+ expect_identical(phy.sum2$mean.el, mean(edgeLength(phy.alt), na.rm=TRUE))
+ expect_identical(phy.sum2$var.el, var(edgeLength(phy.alt), na.rm=TRUE))
+ expect_identical(phy.sum2$sumry.el, summary(stats::na.omit(edgeLength(phy.alt))))
+})
+test_that("now remove edge lengths altogether", {
+ phy.alt at edge.length[] <- NA
+ phy.sum3 <- summary(phy.alt, quiet=TRUE)
+ expect_true(is.null(phy.sum3$mean.el))
+ expect_true(is.null(phy.sum3$var.el))
+ expect_true(is.null(phy.sum3$sumry.el))
+})
+
+## not an exported function -- called internally by reorder("phylo4")
+## test.orderIndex <- function() {
+## }
+
+## test.reorder.phylo4 <- function() {
+## ## TODO
+## }
+
+context("isUltrametric")
+test_that("isUltrametric works as expected", {
+ expect_true(!isUltrametric(phy.alt))
+ tmpPhy <- as(rcoal(10), "phylo4")
+ expect_true(isUltrametric(tmpPhy))
+ tmpPhy <- phy.alt
+ edgeLength(tmpPhy) <- NA
+ expect_error(isUltrametric(tmpPhy))
+})
+
+phylobase.options(op)
diff --git a/tests/testthat/test.pdata.R b/tests/testthat/test.pdata.R
new file mode 100644
index 0000000..4b7e629
--- /dev/null
+++ b/tests/testthat/test.pdata.R
@@ -0,0 +1,21 @@
+#
+# --- Test pdata.R ---
+#
+
+## test.pdata <- function() {
+## # function(data,type,comment,metadata)
+## }
+
+## test.check_pdata <- function() {
+## }
+
+## test.extract.pdata <- function() {
+## # test "[" and "[["
+## }
+
+## test.assign.pdata <- function() {
+## # test "[<-" and "[[<-"
+## }
+
+## test.plot.pdata <- function() {
+## }
diff --git a/tests/testthat/test.phylo4.R b/tests/testthat/test.phylo4.R
new file mode 100644
index 0000000..40099cd
--- /dev/null
+++ b/tests/testthat/test.phylo4.R
@@ -0,0 +1,11 @@
+#
+# --- Test phylo4.R ---
+#
+
+# phylo4.R is mostly used to set generics, so no testing needed
+
+# one non-exported method:
+## test..genlab <- function() {
+## # use phylobase:::.genlab
+## }
+
diff --git a/tests/testthat/test.phylobase.options.R b/tests/testthat/test.phylobase.options.R
new file mode 100644
index 0000000..af09d86
--- /dev/null
+++ b/tests/testthat/test.phylobase.options.R
@@ -0,0 +1,32 @@
+
+###
+### phylobase.options
+###
+
+context("phylobase.options()")
+
+test_that("test of match.arg", {
+ op <- phylobase.options()
+ ## test match.arg
+ expect_error(phylobase.options(retic="test"))
+ no <- phylobase.options(retic="f")
+ expect_equal(no$retic, "fail")
+ phylobase.options(op)
+})
+
+test_that("test of multiple arguments", {
+ op <- phylobase.options()
+ ## test multiple args
+ no <- phylobase.options(retic="f", poly="f")
+ expect_equal(no$retic, "fail")
+ expect_equal(no$poly, "fail")
+ phylobase.options(op)
+})
+
+test_that("test some failures", {
+ op <- phylobase.options()
+ ## check some failures
+ expect_error(phylobase.options(1))
+ expect_error(phylobase.options("foobar"="foo"))
+ phylobase.options(op)
+})
diff --git a/tests/testthat/test.prune.R b/tests/testthat/test.prune.R
new file mode 100644
index 0000000..1190c8a
--- /dev/null
+++ b/tests/testthat/test.prune.R
@@ -0,0 +1,18 @@
+#
+# --- Test prune.R ---
+#
+
+data(geospiza)
+gtree <- extractTree(geospiza)
+
+context("prune")
+
+test_that("prune works on phylo4 objects", {
+ # function(phy, tip, trim.internal = TRUE, subtree = FALSE, ...)
+ expect_equal(gtree, prune(gtree, character(0)))
+})
+
+test_that("prune works on phylo4d objects", {
+ # function(phy, tip, trim.internal = TRUE, subtree = FALSE, ...)
+ expect_equal(geospiza, prune(geospiza, character(0)))
+})
diff --git a/tests/testthat/test.readNCL.R b/tests/testthat/test.readNCL.R
new file mode 100644
index 0000000..543ef7d
--- /dev/null
+++ b/tests/testthat/test.readNCL.R
@@ -0,0 +1,585 @@
+#
+# --- Test readNCL.R ---
+#
+
+### Get all the test files
+if (Sys.getenv("RCMDCHECK") == FALSE) {
+ pth <- file.path(getwd(), "..", "inst", "nexusfiles")
+} else {
+ pth <- system.file(package="phylobase", "nexusfiles")
+}
+
+## co1.nex -- typical output from MrBayes. Contains 2 identical trees, the first
+## one having posterior probabilities as node labels
+co1File <- file.path(pth, "co1.nex")
+
+## MultiLineTrees.nex -- 2 identical trees stored on several lines
+multiLinesFile <- file.path(pth, "MultiLineTrees.nex")
+
+## treeWithDiscreteData.nex -- Mesquite file with discrete data
+treeDiscDt <- file.path(pth, "treeWithDiscreteData.nex")
+
+## treeWithPolyExcludedData.nex -- Mesquite file with polymorphic and excluded
+## characters
+treePolyDt <- file.path(pth, "treeWithPolyExcludedData.nex")
+
+## treeWithContinuousData.nex -- Mesquite file with continuous characters
+treeContDt <- file.path(pth, "treeWithContinuousData.nex")
+
+## treeWithDiscAndContData.nex -- Mesquite file with both discrete and
+## continuous data
+treeDiscCont <- file.path(pth, "treeWithDiscAndContData.nex")
+
+## noStateLabels.nex -- Discrete characters with missing state labels
+noStateLabels <- file.path(pth, "noStateLabels.nex")
+
+## Newick trees
+newick <- file.path(pth, "newick.tre")
+
+## Test with trees that don't include all the taxa listed in TAXA block
+treeSubset <- file.path(pth, "testSubsetTaxa.nex")
+
+## Contains representation of data associated with continuous data
+ExContDataFile <- file.path(pth, "ExContData.Rdata")
+
+
+stopifnot(file.exists(co1File))
+stopifnot(file.exists(treeDiscDt))
+stopifnot(file.exists(multiLinesFile))
+stopifnot(file.exists(treePolyDt))
+stopifnot(file.exists(treeContDt))
+stopifnot(file.exists(treeDiscCont))
+stopifnot(file.exists(ExContDataFile))
+stopifnot(file.exists(noStateLabels))
+stopifnot(file.exists(treeSubset))
+
+op <- phylobase.options()
+
+
+## function (file, simplify=TRUE, type=c("all", "tree", "data"),
+## char.all=FALSE, polymorphic.convert=TRUE, levels.uniform=TRUE,
+## check.node.labels=c("keep", "drop", "asdata"))
+
+
+
+## ########### CO1 -- MrBayes file -- tree only
+
+## Tree properties
+## Labels
+labCo1 <- c("Cow", "Seal", "Carp", "Loach", "Frog", "Chicken", "Human",
+ "Mouse", "Rat", "Whale", NA, NA, NA, NA, NA, NA, NA, NA)
+names(labCo1) <- 1:18
+## Edge lengths
+eLco1 <- c(0.143336, 0.225087, 0.047441, 0.055934, 0.124549, 0.204809, 0.073060, 0.194575,
+ 0.171296, 0.222039, 0.237101, 0.546258, 0.533183, 0.154442, 0.134574, 0.113163,
+ 0.145592)
+names(eLco1) <- c("11-1", "11-2", "11-12", "12-13", "13-14", "14-15", "15-16", "16-17", "17-3",
+ "17-4", "16-5", "15-6", "14-7", "13-18", "18-8", "18-9", "12-10")
+## Node types
+nTco1 <- c("tip", "tip", "tip", "tip", "tip", "tip", "tip", "tip", "tip",
+ "tip", "internal", "internal", "internal", "internal", "internal",
+ "internal", "internal", "internal")
+names(nTco1) <- 1:18
+## Label values
+lVco1 <- c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 0.93, 0.88, 0.99, 1.00,
+ 0.76, 1.00, 1.00)
+context("readNCL can deal with simple NEXUS files (tree only)")
+test_that("file with 2 trees (warning normal)", {
+ ## Read trees
+ co1 <- suppressWarnings(readNCL(file=co1File, check.node.labels="asdata"))
+ ## Tree 1
+ co1Tree1 <- co1[[1]]
+ edgeNm <- paste(edges(co1Tree1)[, "ancestor"], edges(co1Tree1)[, "descendant"], sep = "-")
+ expect_equal(labels(co1Tree1), labCo1) # check labels
+ expect_equal(edgeLength(co1Tree1), eLco1[edgeNm]) # check edge lengths
+ expect_equal(nodeType(co1Tree1), nTco1) # check node types
+ expect_equal(as(co1Tree1, "data.frame")$labelValues, lVco1) # check label value
+ ## Tree 2
+ co1Tree2 <- co1[[2]]
+ expect_equal(labels(co1Tree2), labCo1) # check labels
+ expect_equal(edgeLength(co1Tree2), eLco1[edgeNm]) # check edge lengths
+ expect_equal(nodeType(co1Tree2), nTco1) # check node types
+})
+
+test_that("test option simplify", {
+ ## Check option simplify
+ co1 <- readNCL(file=co1File, check.node.labels="asdata", simplify=TRUE)
+ edgeNm <- paste(edges(co1)[, "ancestor"], edges(co1)[, "descendant"], sep = "-")
+ expect_equal(length(co1), as.integer(1)) # make sure there is only one tree
+ expect_equal(labels(co1), labCo1) # check labels
+ expect_equal(edgeLength(co1), eLco1[edgeNm]) # check edge lengths
+ expect_equal(nodeType(co1), nTco1) # check node type
+ expect_equal(as(co1, "data.frame")$labelValues, lVco1) # check label values
+})
+
+test_that("test option check.node.labels", {
+ ## Check option check.node.labels
+ phylobase.options(allow.duplicated.labels="fail")
+ expect_error(readNCL(file=co1File, check.node.labels="keep")) # fail because labels aren't unique
+ phylobase.options(op)
+ phylobase.options(allow.duplicated.labels="ok")
+ co1 <- readNCL(file=co1File, check.node.labels="keep", simplify=TRUE)
+ expect_equal(nodeLabels(co1),
+ setNames(c(NA, "0.93", "0.88", "0.99", "1.00", "0.76", "1.00", "1.00"),
+ 11:18))
+ phylobase.options(op)
+ co1 <- readNCL(file=co1File, check.node.labels="drop", simplify=TRUE)
+ edgeNm <- paste(edges(co1)[, "ancestor"], edges(co1)[, "descendant"], sep = "-")
+ expect_equal(labels(co1), labCo1) # check labels
+ expect_equal(edgeLength(co1), eLco1[edgeNm]) # check edge lengths
+ expect_equal(nodeType(co1), nTco1) # check node type
+ expect_equal(as(co1, "data.frame")$labelValues, NULL) # check label values don't exist
+})
+
+test_that("labelled root", {
+ tmp_file <- tempfile()
+ cat("(A:0.1,B:0.2,(C:0.3,D:0.4)E:0.5)F;", file = tmp_file)
+ ape_tree <- as(ape::read.tree(file = tmp_file), "phylo4")
+ ph4_tree <- readNewick(file = tmp_file)
+ expect_equal(tipLabels(ape_tree), tipLabels(ph4_tree))
+ expect_equal(nodeLabels(ape_tree), nodeLabels(ph4_tree))
+ expect_equal(sort(edgeLength(ape_tree)), sort(edgeLength(ape_tree)))
+})
+
+test_that("readNCL can handle multi line files", {
+ ## ########### Mutli Lines -- tree only
+ multiLines <- readNCL(file=multiLinesFile)
+ ## load correct representation and make sure that the trees read
+ ## match it
+ ml <- rncl::read_nexus_phylo(file = multiLinesFile)
+ ml1 <- as(ml[[1]], "phylo4")
+ ml2 <- as(ml[[2]], "phylo4")
+ expect_equal(tipLabels(multiLines[[1]]), tipLabels(ml1))
+ expect_equal(tipLabels(multiLines[[2]]), tipLabels(ml2))
+ expect_equivalent(sort(edgeLength(multiLines[[1]])), sort(edgeLength(ml1)))
+ expect_equivalent(sort(edgeLength(multiLines[[2]])), sort(edgeLength(ml2)))
+ expect_equal(nodeType(multiLines[[1]]), nodeType(ml1))
+ expect_equal(nodeType(multiLines[[2]]), nodeType(ml2))
+})
+
+## ########### Tree + data -- file from Mesquite
+context("readNCL can handle files with tree & data")
+## tree properties
+labTr <- c("Myrmecocystussemirufus", "Myrmecocystusplacodops",
+ "Myrmecocystusmendax", "Myrmecocystuskathjuli",
+ "Myrmecocystuswheeleri", "Myrmecocystusmimicus",
+ "Myrmecocystusdepilis", "Myrmecocystusromainei",
+ "Myrmecocystusnequazcatl", "Myrmecocystusyuma",
+ "Myrmecocystuskennedyi", "Myrmecocystuscreightoni",
+ "Myrmecocystussnellingi", "Myrmecocystustenuinodis",
+ "Myrmecocystustestaceus", "Myrmecocystusmexicanus",
+ "Myrmecocystuscfnavajo", "Myrmecocystusnavajo",
+ NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA)
+names(labTr) <- 1:35
+eTr <- c(NA, 1.699299, 12.300701, 0.894820, 0.836689, 10.569191, 4.524387, 6.044804,
+ 0.506099, 0.198842, 0.689044, 4.650818, 2.926053, 1.724765, 1.724765, 4.255993,
+ 1.083870, 1.083870, 0.802512, 2.027251, 2.708942, 2.708942, 0.284767, 4.451425,
+ 2.257581, 2.193845, 2.193845, 8.635503, 2.770378, 2.770378, 8.275077, 5.724923,
+ 2.855375, 2.869547, 2.869547)
+names(eTr) <- c("0-19", "19-20", "20-15", "20-21", "21-22", "22-12", "22-23", "23-11", "23-24",
+ "24-25", "25-26", "26-3", "26-27", "27-1", "27-2", "25-28", "28-4", "28-5",
+ "24-29", "29-30", "30-6", "30-7", "29-31", "31-10", "31-32", "32-8", "32-9",
+ "21-33", "33-13", "33-14", "19-34", "34-16", "34-35", "35-17", "35-18")
+nTtr <- c("tip", "tip", "tip", "tip", "tip", "tip", "tip", "tip", "tip",
+ "tip", "tip", "tip", "tip", "tip", "tip", "tip", "tip", "tip",
+ "root", "internal", "internal", "internal", "internal", "internal",
+ "internal", "internal", "internal", "internal", "internal",
+ "internal", "internal", "internal", "internal", "internal",
+ "internal")
+names(nTtr) <- 1:35
+## data to test against
+dtTest1 <- data.frame(time = factor(c(2,1,0,0,0,0,2,0,2,0,0,0,0,1,1,1,0,1)),
+ subgenus = factor(c(2,1,0,0,0,0,2,0,2,0,0,0,0,1,1,2,0,1)))
+row.names(dtTest1) <- c("Myrmecocystuscfnavajo","Myrmecocystuscreightoni",
+ "Myrmecocystusdepilis","Myrmecocystuskathjuli",
+ "Myrmecocystuskennedyi","Myrmecocystusmendax",
+ "Myrmecocystusmexicanus","Myrmecocystusmimicus",
+ "Myrmecocystusnavajo","Myrmecocystusnequazcatl",
+ "Myrmecocystusplacodops","Myrmecocystusromainei",
+ "Myrmecocystussemirufus","Myrmecocystussnellingi",
+ "Myrmecocystustenuinodis","Myrmecocystustestaceus",
+ "Myrmecocystuswheeleri","Myrmecocystusyuma")
+dtTest2 <- dtTest1
+levels(dtTest2$time) <- c("diurnal", "crepuscular", "nocturnal")
+levels(dtTest2$subgenus) <- c("Endiodioctes", "Eremnocystus", "Myrmecocystus")
+p4 <- "phylo4"
+p4d <- "phylo4d"
+attributes(p4) <- attributes(p4d) <- list(package="phylobase")
+
+test_that("readNCL can deal with the tree only", {
+ ## Tree only
+ tr <- readNCL(file=treeDiscDt, type="tree")
+ tr2 <- rncl::read_nexus_phylo(file = treeDiscDt)
+ tr2 <- as(tr2, "phylo4")
+ expect_equal(labels(tr), labTr) # check labels
+ expect_equal(nodeType(tr), nTtr) # check node types
+ expect_equal(class(tr), p4) # check class
+ expect_equal(edgeLength(tr), edgeLength(tr2)[names(edgeLength(tr))])
+})
+
+test_that("readNCL can deal with data only", {
+ ## Data only
+ dt1 <- readNCL(file=treeDiscDt, type="data", return.labels=FALSE,
+ levels.uniform=FALSE)
+ expect_equal(dt1, dtTest1)
+ dt2 <- readNCL(file=treeDiscDt, type="data", return.labels=TRUE,
+ levels.uniform=FALSE)
+ expect_equal(dt2, dtTest2)
+})
+
+test_that("readNCL can deal with tree + data", {
+ ## Tree + Data
+ trDt1 <- readNCL(file=treeDiscDt, type="all", return.labels=FALSE,
+ levels.uniform=FALSE)
+ expect_equal(labels(trDt1), labTr) # check labels
+ expect_equivalent(sort(edgeLength(trDt1)), sort(eTr)) # check edge lengths
+ expect_equal(nodeType(trDt1), nTtr) # check node types
+ expect_equal(class(trDt1), p4d) # check class
+ expect_equal(tdata(trDt1, type="tip")[rownames(dtTest1), ], dtTest1)
+ trDt2 <- readNCL(file=treeDiscDt, type="all", return.labels=TRUE,
+ levels.uniform=FALSE)
+ expect_equal(labels(trDt2), labTr) # check labels
+ expect_equivalent(sort(edgeLength(trDt2)), sort(eTr)) # check edge lengths
+ expect_equal(nodeType(trDt2), nTtr) # check node types
+ expect_equal(class(trDt2), p4d) # check class
+ expect_equal(tdata(trDt2, type="tip")[rownames(dtTest2), ], dtTest2)
+})
+
+
+## ########## Tree + Data -- Test for polymorphic.convert, levels.uniform and char.all
+## data to test against
+## dtTest 3 -- levels.uniform=FALSE, return.labels=FALSE, polymorphic.convert=FALSE
+dtPoly1 <- data.frame(Test1=factor(c(0,0,1,1,0,NA,1,1,1,0,0,NA,1,1,NA,0,1, NA)),
+ Test2=factor(c(0,0,0,0,0,NA,0,1,0,1,1,"{0,1}",NA,0,NA,0,"{0,1}",1)),
+ Test3=factor(c(1,1,1,0,0,0,2,"{0,1,2}",0,NA,0,"{0,1}",0,1,0,0,"{0,1,2}",1)),
+ row.names=c("Myrmecocystussemirufus","Myrmecocystusplacodops",
+ "Myrmecocystusmendax","Myrmecocystuskathjuli",
+ "Myrmecocystuswheeleri","Myrmecocystusmimicus",
+ "Myrmecocystusdepilis","Myrmecocystusromainei",
+ "Myrmecocystusnequazcatl","Myrmecocystusyuma",
+ "Myrmecocystuskennedyi","Myrmecocystuscreightoni",
+ "Myrmecocystussnellingi","Myrmecocystustenuinodis",
+ "Myrmecocystustestaceus","Myrmecocystusmexicanus",
+ "Myrmecocystuscfnavajo","Myrmecocystusnavajo"))
+## dtPoly2 -- levels.uniform=FALSE, return.labels=FALSE, polymorphic.convert=TRUE
+dtPoly2 <- dtPoly1
+dtPoly2[c(12,17),2] <- NA
+dtPoly2[c(8,12,17),3] <- NA
+dtPoly2$Test1 <- factor(dtPoly2$Test1)
+dtPoly2$Test2 <- factor(dtPoly2$Test2)
+dtPoly2$Test3 <- factor(dtPoly2$Test3)
+## dtPoly3 -- levels.uniform=FALSE, return.labels=TRUE, polymorphic.convert=TRUE
+dtPoly3 <- dtPoly2
+levels(dtPoly3$Test1) <- c("test1A", "test1B")
+levels(dtPoly3$Test2) <- c("test2A", "test2B")
+levels(dtPoly3$Test3) <- c("test3A", "test3B", "test3C")
+## dtPoly4 -- levels.uniform=FALSE, return.labels=TRUE, polymorphic.convert=FALSE
+## not yet implemented
+
+## dtPoly5 -- levels.uniform=TRUE, return.labels=FALSE, polymorphic.convert=FALSE
+dtPoly5 <- dtPoly1
+levels(dtPoly5$Test1) <- levels(dtPoly5$Test2) <- levels(dtPoly5$Test3) <-
+ union(levels(dtPoly1$Test1), c(levels(dtPoly1$Test2), levels(dtPoly1$Test3)))
+## dtPoly6 -- levels.uniform=TRUE, return.labels=FALSE, polymorphic.convert=TRUE
+dtPoly6 <- dtPoly2
+levels(dtPoly6$Test1) <- levels(dtPoly6$Test2) <- levels(dtPoly6$Test3) <-
+ union(levels(dtPoly2$Test1), c(levels(dtPoly2$Test2), levels(dtPoly2$Test3)))
+## dtPoly7 -- levels.uniform=TRUE, return.labels=TRUE, polymorphic.convert=FALSE
+## not yet implemented
+
+## dtPoly8 -- levels.uniform=TRUE, return.labels=TRUE, polymorphic.convert=TRUE
+dtPoly8 <- dtPoly3
+levels(dtPoly8$Test1) <- levels(dtPoly8$Test2) <- levels(dtPoly8$Test3) <-
+ union(levels(dtPoly3$Test1), c(levels(dtPoly3$Test2), levels(dtPoly3$Test3)))
+## dtPoly5F -- char.all=FALSE, levels.uniform=TRUE, return.labels=FALSE, polymorphic.convert=FALSE
+dtPoly5F <- dtPoly1[, 1:2]
+levels(dtPoly5F$Test1) <- levels(dtPoly5F$Test2) <-
+ union(levels(dtPoly1$Test1), levels(dtPoly1$Test2))
+## dtPoly6F -- char.all=FALSE, levels.uniform=TRUE, return.labels=FALSE, polymorphic.convert=TRUE
+dtPoly6F <- dtPoly2[, 1:2]
+levels(dtPoly6F$Test1) <- levels(dtPoly6F$Test2) <-
+ union(levels(dtPoly2$Test1), levels(dtPoly2$Test2))
+## dtPoly8F -- char.all=FALSE, levels.uniform=TRUE, return.labels=TRUE, polymorphic.convert=TRUE
+dtPoly8F <- dtPoly3[, 1:2]
+levels(dtPoly8F$Test1) <- levels(dtPoly8F$Test2) <-
+ union(levels(dtPoly3$Test1), levels(dtPoly3$Test2))
+
+test_that("char.all=TRUE, levels.uniform=FALSE, return.labels=FALSE, polymorphic.convert=FALSE", {
+ trChr1 <- readNCL(file=treePolyDt, type="all", polymorphic.convert=FALSE,
+ levels.uniform=FALSE, char.all=TRUE, return.labels=FALSE)
+ expect_equal(labels(trChr1), labTr) # check labels
+ expect_equivalent(sort(edgeLength(trChr1)), sort(eTr)) # check edge lengths
+ expect_equal(nodeType(trChr1), nTtr) # check node types
+ expect_equal(class(trChr1), p4d) # check class
+ expect_equal(tdata(trChr1, "tip"), dtPoly1[tipLabels(trChr1), ])
+})
+
+test_that("char.all=TRUE, levels.uniform=FALSE, return.labels=FALSE, polymorphic.convert=TRUE", {
+ trChr2 <- readNCL(file=treePolyDt, type="all", polymorphic.convert=TRUE,
+ levels.uniform=FALSE, return.labels=FALSE, char.all=TRUE)
+ expect_equal(labels(trChr2), labTr) # check labels
+ expect_equivalent(sort(edgeLength(trChr2)), sort(eTr)) # check edge lengths
+ expect_equal(nodeType(trChr2), nTtr) # check node types
+ expect_equal(class(trChr2), p4d) # check class
+ expect_equal(tdata(trChr2, "tip"), dtPoly2[tipLabels(trChr2), ])
+})
+
+test_that("char.all=TRUE, levels.uniform=FALSE, return.labels=TRUE, polymorphic.convert=TRUE", {
+ trChr3 <- readNCL(file=treePolyDt, type="all", polymorphic.convert=TRUE,
+ levels.uniform=FALSE, char.all=TRUE, return.labels=TRUE)
+ expect_equal(labels(trChr3), labTr) # check labels
+ expect_equivalent(sort(edgeLength(trChr3)), sort(eTr)) # check edge lengths
+ expect_equal(nodeType(trChr3), nTtr) # check node types
+ expect_equal(class(trChr3), p4d) # check class
+ expect_equal(tdata(trChr3, "tip"), dtPoly3[tipLabels(trChr3), ])
+})
+
+test_that("char.all=TRUE, levels.uniform=FALSE, return.labels=TRUE, polymorphic.convert=FALSE is not yet implemented", {
+## trChr4 <-
+ expect_error(readNCL(file=treePolyDt, type="all",
+ levels.uniform=FALSE,
+ return.labels=TRUE,
+ polymorphic.convert=FALSE))
+})
+
+test_that("char.all=TRUE, levels.uniform=TRUE, return.labels=FALSE, polymorphic.convert=FALSE", {
+ trChr5 <- readNCL(file=treePolyDt, type="all", polymorphic.convert=FALSE,
+ levels.uniform=TRUE, char.all=TRUE, return.labels=FALSE)
+ expect_equal(labels(trChr5), labTr) # check labels
+ expect_equivalent(sort(edgeLength(trChr5)), sort(eTr)) # check edge lengths
+ expect_equal(nodeType(trChr5), nTtr) # check node types
+ expect_equal(class(trChr5), p4d) # check class
+ expect_equal(tdata(trChr5, "tip"), dtPoly5[tipLabels(trChr5), ])
+})
+
+test_that("char.all=TRUE, levels.uniform=TRUE, return.labels=FALSE, polymorphic.convert=TRUE", {
+ trChr6 <- readNCL(file=treePolyDt, type="all", polymorphic.convert=TRUE,
+ levels.uniform=TRUE, char.all=TRUE, return.labels=FALSE)
+ expect_equal(labels(trChr6), labTr) # check labels
+ expect_equivalent(sort(edgeLength(trChr6)), sort(eTr)) # check edge lengths
+ expect_equal(nodeType(trChr6), nTtr) # check node types
+ expect_equal(class(trChr6), p4d) # check class
+ expect_equal(tdata(trChr6, "tip"), dtPoly6[tipLabels(trChr6), ])
+})
+
+test_that("char.all=TRUE, levels.uniform=TRUE, return.labels=TRUE, polymorphic.convert=FALSE is not yet implemented", {
+ ## trChr7 <-
+ expect_error(readNCL(file=treePolyDt, type="all", char.all=TRUE,
+ levels.uniform=TRUE,
+ return.labels=TRUE,
+ polymorphic.convert=FALSE))
+})
+
+test_that("char.all=TRUE, levels.uniform=TRUE, return.labels=TRUE, polymorphic.convert=TRUE", {
+ trChr8 <- readNCL(file=treePolyDt, type="all", char.all=TRUE,
+ levels.uniform=TRUE,
+ return.labels=TRUE,
+ polymorphic.convert=TRUE)
+ expect_equal(labels(trChr8), labTr) # check labels
+ expect_equivalent(sort(edgeLength(trChr8)), sort(eTr)) # check edge lengths
+ expect_equal(nodeType(trChr8), nTtr) # check node types
+ expect_equal(class(trChr8), p4d) # check class
+ expect_equal(tdata(trChr8, "tip"), dtPoly8[tipLabels(trChr8), ])
+})
+
+## -- with char.all=FALSE
+test_that("char.all=FALSE, levels.uniform=FALSE, return.labels=FALSE, polymorphic.convert=FALSE", {
+ trChr1F <- readNCL(file=treePolyDt, type="all", polymorphic.convert=FALSE,
+ levels.uniform=FALSE, char.all=FALSE, return.labels=FALSE)
+ expect_equal(labels(trChr1F), labTr) # check labels
+ expect_equivalent(sort(edgeLength(trChr1F)), sort(eTr)) # check edge lengths
+ expect_equal(nodeType(trChr1F), nTtr) # check node types
+ expect_equal(class(trChr1F), p4d) # check class
+ expect_equal(tdata(trChr1F, "tip"), dtPoly1[tipLabels(trChr1F), 1:2])
+})
+
+test_that("char.all=FALSE, levels.uniform=FALSE, return.labels=FALSE, polymorphic.convert=TRUE", {
+ trChr2F <- readNCL(file=treePolyDt, type="all", polymorphic.convert=TRUE,
+ levels.uniform=FALSE, return.labels=FALSE, char.all=FALSE)
+ expect_equal(labels(trChr2F), labTr) # check labels
+ expect_equivalent(sort(edgeLength(trChr2F)), sort(eTr)) # check edge lengths
+ expect_equal(nodeType(trChr2F), nTtr) # check node types
+ expect_equal(class(trChr2F), p4d) # check class
+ expect_equal(tdata(trChr2F, "tip"), dtPoly2[tipLabels(trChr2F), 1:2])
+})
+
+test_that("char.all=FALSE, levels.uniform=FALSE, return.labels=TRUE, polymorphic.convert=TRUE", {
+ trChr3F <- readNCL(file=treePolyDt, type="all", polymorphic.convert=TRUE,
+ levels.uniform=FALSE, char.all=FALSE, return.labels=TRUE)
+ expect_equal(labels(trChr3F), labTr) # check labels
+ expect_equivalent(sort(edgeLength(trChr3F)), sort(eTr)) # check edge lengths
+ expect_equal(nodeType(trChr3F), nTtr) # check node types
+ expect_equal(class(trChr3F), p4d) # check class
+ expect_equal(tdata(trChr3F, "tip"), dtPoly3[tipLabels(trChr3F), 1:2])
+})
+
+test_that("char.all=FALSE, levels.uniform=FALSE, return.labels=TRUE, polymorphic.convert=FALSE is not yet implemented", {
+ ## trChr4F <-
+ expect_error(readNCL(file=treePolyDt, type="all",
+ levels.uniform=FALSE,
+ return.labels=TRUE,
+ polymorphic.convert=FALSE))
+})
+
+test_that("char.all=FALSE, levels.uniform=TRUE, return.labels=FALSE, polymorphic.convert=FALSE", {
+ trChr5F <- readNCL(file=treePolyDt, type="all", polymorphic.convert=FALSE,
+ levels.uniform=TRUE, char.all=FALSE, return.labels=FALSE)
+ expect_equal(labels(trChr5F), labTr) # check labels
+ expect_equivalent(sort(edgeLength(trChr5F)), sort(eTr)) # check edge lengths
+ expect_equal(nodeType(trChr5F), nTtr) # check node types
+ expect_equal(class(trChr5F), p4d) # check class
+ expect_equal(tdata(trChr5F, "tip"), dtPoly5F[tipLabels(trChr5F), ])
+})
+
+test_that("char.all=FALSE, levels.uniform=TRUE, return.labels=FALSE, polymorphic.convert=TRUE", {
+ trChr6F <- readNCL(file=treePolyDt, type="all", polymorphic.convert=TRUE,
+ levels.uniform=TRUE, char.all=FALSE, return.labels=FALSE)
+ expect_equal(labels(trChr6F), labTr) # check labels
+ expect_equivalent(sort(edgeLength(trChr6F)), sort(eTr)) # check edge lengths
+ expect_equal(nodeType(trChr6F), nTtr) # check node types
+ expect_equal(class(trChr6F), p4d) # check class
+ expect_equal(tdata(trChr6F, "tip"), dtPoly6F[tipLabels(trChr6F), ])
+})
+
+test_that("char.all=FALSE, levels.uniform=TRUE, return.labels=TRUE, polymorphic.convert=FALSE is not yet implemented", {
+ ## trChr7F <-
+ expect_error(readNCL(file=treePolyDt, type="all", char.all=FALSE,
+ levels.uniform=TRUE,
+ return.labels=TRUE,
+ polymorphic.convert=FALSE))
+})
+
+test_that("char.all=FALSE, levels.uniform=TRUE, return.labels=TRUE, polymorphic.convert=TRUE", {
+ trChr8F <- readNCL(file=treePolyDt, type="all", char.all=FALSE,
+ levels.uniform=TRUE,
+ return.labels=TRUE,
+ polymorphic.convert=TRUE)
+ expect_equal(labels(trChr8F), labTr) # check labels
+ expect_equivalent(sort(edgeLength(trChr8F)), sort(eTr)) # check edge lengths
+ expect_equal(nodeType(trChr8F), nTtr) # check node types
+ expect_equal(class(trChr8F), p4d) # check class
+ expect_equal(tdata(trChr8F, "tip"), dtPoly8F[tipLabels(trChr8F), ])
+})
+
+## ########## Tree + Data -- test with continuous Characters
+test_that("test of readNCL with tree data, with continuous characters", {
+ DtCont <- readNCL(file=treeContDt, type="data")
+ trDtCont <- readNCL(file=treeContDt, type="all")
+ load(ExContDataFile)
+ expect_equal(DtCont, ExContData[rownames(DtCont), ])
+ expect_equal(tdata(trDtCont, "tip"), ExContData[tipLabels(trDtCont), ])
+ expect_equal(labels(trDtCont), labTr) # check labels
+ expect_equivalent(sort(edgeLength(trDtCont)), sort(eTr)) # check edge lengths
+ expect_equal(nodeType(trDtCont), nTtr) # check node types
+ expect_equal(class(trDtCont), p4d) # check class
+})
+
+
+## ########## Tree + Data -- both types (Discrete & Continuous)
+test_that("tree + data for both types (discrete & continuous)", {
+ dtDiscCont <- readNCL(file=treeDiscCont, type="data", levels.uniform=FALSE)
+ trDtDiscCont <- readNCL(file=treeDiscCont, type="all", levels.uniform=FALSE)
+ load(ExContDataFile)
+ dtDiscContTest <- cbind(ExContData, dtTest2[rownames(ExContData), ])
+ expect_equal(dtDiscCont, dtDiscContTest[rownames(dtDiscCont), ])
+ expect_equal(tdata(trDtDiscCont, "tip"), dtDiscContTest[tipLabels(trDtDiscCont), ])
+ expect_equal(labels(trDtDiscCont), labTr) # check labels
+ expect_equivalent(sort(edgeLength(trDtDiscCont)), sort(eTr)) # check edge lengths
+ expect_equal(nodeType(trDtDiscCont), nTtr) # check node types
+ expect_equal(class(trDtDiscCont), p4d) # check class
+})
+
+## ########### Check for proper handling of missing files
+test_that("readNCL can handle missing files", {
+ expect_error(readNCL(file="foo.bar"), regexp="doesn't exist")
+})
+
+## ########### Check behavior in case of missing state labels
+test_that("readNCL warns in case of missing state labels", {
+ expect_warning(readNCL(file=noStateLabels, return.labels=TRUE),
+ regexp="state labels are missing")
+})
+
+test_that("readNCL warns in case of missing state labels", {
+ expect_warning(dtNoSt <- readNCL(file=noStateLabels, type="data",
+ return.labels=TRUE),
+ regexp="state labels are missing")
+ expect_equal(dtNoSt$char1, factor(c(1,2,0,1)))
+})
+
+## ########### Newick files
+context("test with Newick files")
+## Tree representation
+labNew <- c("a", "b", "c", NA, NA)
+names(labNew) <- 1:5
+eLnew <- c(NA, 1, 4, 2, 3)
+names(eLnew) <- c("0-4", "4-1", "4-5", "5-2", "5-3")
+nTnew <- c("tip", "tip", "tip", "root", "internal")
+names(nTnew) <- 1:5
+
+test_that("check.node.labels='drop' with readNCL", {
+ newTr <- readNCL(file=newick, file.format="newick", check.node.labels="drop")
+ expect_equal(labels(newTr), labNew)
+ expect_equivalent(sort(edgeLength(newTr)), sort(eLnew))
+ expect_equal(nodeType(newTr), nTnew)
+})
+
+test_that("check.node.labels='drop' with readNewick", {
+ newTr <- readNewick(file=newick, check.node.labels="drop")
+ expect_equal(labels(newTr), labNew)
+ expect_equivalent(sort(edgeLength(newTr)), sort(eLnew))
+ expect_equal(nodeType(newTr), nTnew)
+})
+
+test_that("check.node.labels='asdata' with readNCL", {
+ newTr <- readNCL(file=newick, file.format="newick", check.node.labels="asdata")
+ expect_equal(labels(newTr), labNew)
+ expect_equal(tdata(newTr)$labelValues, factor(c(NA, NA, NA, "yy", "xx")))
+})
+
+test_that("check.node.labels='asdata' with readNewick", {
+ newTr <- readNewick(file=newick, check.node.labels="asdata")
+ expect_equal(labels(newTr), labNew)
+ expect_equal(tdata(newTr)$labelValues, factor(c(NA, NA, NA, "yy", "xx")))
+})
+
+test_that("check.node.labels='keep' with readNCL", {
+ labNew[4:5] <- c("yy", "xx")
+ newTr <- readNCL(file=newick, file.format="newick", check.node.labels="keep")
+ expect_equal(labels(newTr), labNew)
+})
+
+test_that("check.node.labels='keep' with readNewick", {
+ labNew[4:5] <- c("yy", "xx")
+ newTr <- readNewick(file=newick, check.node.labels="keep")
+ expect_equal(labels(newTr), labNew)
+})
+
+### Test with files where trees don't include all taxa -------------------------
+context("Trees that don't contain all the taxa listed in the TAXA block")
+
+test_that("first tree is correct", {
+ tr <- readNexus(file = treeSubset)
+ expect_equivalent(rootNode(tr[[1]]), 6)
+ expect_equivalent(rootNode(tr[[2]]), 6)
+ expect_equivalent(rootNode(tr[[3]]), 7)
+ expect_equivalent(tipLabels(tr[[1]]), c("porifera", "ctenophora", "cnidaria", "deuterostomia", "protostomia"))
+ expect_equivalent(tipLabels(tr[[2]]), c("porifera", "ctenophora", "xeno", "deuterostomia", "protostomia"))
+ expect_equivalent(tipLabels(tr[[3]]), c("deuterostomia", "protostomia", "porifera", "ctenophora", "cnidaria", "xeno"))
+ }
+)
+
+### Test roundtrip with Myrmecus file ------------------------------------------
+
+context("Compare output from rncl read file and phylobase")
+
+test_that("output from rncl::read_nexus_phylo and readNexus match", {
+ tr_ape <- rncl::read_nexus_phylo(file = treeDiscDt)
+ tr_ph4 <- readNexus(file = treeDiscDt, type = "tree")
+ tr_ape <- as(tr_ape, "phylo4")
+ expect_equal(edges(tr_ape)[order(edges(tr_ape)[, 1]), ],
+ edges(tr_ph4)[order(edges(tr_ph4)[, 1]), ])
+ expect_equal(edgeLength(tr_ape),
+ edgeLength(tr_ph4)[names(edgeLength(tr_ape))])
+ expect_equal(labels(tr_ape), labels(tr_ph4))
+})
diff --git a/tests/testthat/test.setAs-Methods.R b/tests/testthat/test.setAs-Methods.R
new file mode 100644
index 0000000..6c45984
--- /dev/null
+++ b/tests/testthat/test.setAs-Methods.R
@@ -0,0 +1,183 @@
+#
+# --- Test setAs-Methods.R ---
+#
+
+### Get all the test files
+if (Sys.getenv("RCMDCHECK") == FALSE) {
+ pth <- file.path(getwd(), "..", "inst", "nexmlfiles")
+} else {
+ pth <- system.file(package="phylobase", "nexmlfiles")
+}
+
+# create ape::phylo version of a simple tree for testing
+nwk <- "((t1:0.1,t2:0.2)n7:0.7,(t3:0.3,(t4:0.4,t5:0.5)n9:0.9)n8:0.8)n6:0.6;"
+tr <- ape::read.tree(text=nwk)
+
+# create analogous phylo4 object with a full complement of valid slots
+ancestor <- as.integer(c(6,7,7,6,8,0,8,9,9))
+descendant <- as.integer(c(7,1,2,8,3,6,9,4,5))
+edge <- cbind(ancestor, descendant)
+nid.tip <- 1:5
+nid.int <- 6:9
+lab.tip <- paste("t", nid.tip, sep="")
+lab.int <- paste("n", nid.int, sep="")
+elen <- descendant/10
+elab <- paste("e", ancestor, descendant, sep="-")
+phy <- phylo4(x=edge, tip.label=lab.tip, node.label=lab.int,
+ edge.length=elen, edge.label=elab)
+
+# create altered version such that each slot is out of order with
+# respect to all others; methods should be able to handle this
+phy.alt <- phy
+phy.alt at label <- rev(phy at label)
+phy.alt at edge <- phy at edge[c(6:9, 1:5), ]
+phy.alt at edge.length <- phy at edge.length[c(7:9, 1:6)]
+phy.alt at edge.label <- phy at edge.label[c(8:9, 1:7)]
+
+## NeXML files
+compFile <- file.path(pth, "comp_analysis.xml")
+stopifnot(file.exists(compFile))
+
+#-----------------------------------------------------------------------
+
+context("setAs methods")
+
+test_that("phylo to phylo4", {
+ # simple case
+ as.phy <- as(tr, "phylo4")
+ expect_true(class(as.phy)=="phylo4")
+ expect_equal(tr$edge, unname(edges(as.phy, drop.root=TRUE)))
+ expect_equal(tr$tip.label, unname(tipLabels(as.phy)))
+ expect_equal(tr$node.label, unname(nodeLabels(as.phy)))
+ # TODO: ape keeps the root edge length in $root.edge
+ #expect_equal(tr$edge.length, unname(edgeLength(as.phy)))
+ expect_equal("preorder", edgeOrder(as.phy))
+
+ ## test preservation of order attribute
+ as.phy <- as(reorder(tr, "cladewise"), "phylo4")
+ expect_equal("preorder", edgeOrder(as.phy))
+ as.phy <- as(reorder(tr, "pruningwise"), "phylo4")
+ expect_equal("postorder", edgeOrder(as.phy))
+
+ ## test phylo import when only 2 tips
+ tr2 <- ape::drop.tip(tr, 3:ape::Ntip(tr))
+ expect_equal(nTips(as(tr2, "phylo4")), 2)
+ expect_equal(nNodes(as(tr2, "phylo4")), 1)
+
+ ## simple roundtrip test
+ phy <- as(tr, "phylo4")
+ expect_equal(tr, as(phy, "phylo"))
+})
+
+# note: this method mostly just wraps phylo->phylo4 coercion (tested
+# above) and phylo4d("phylo4") method (tested in runit.class-phylo4d.R)
+test_that("phylo to phylo4d", {
+ expect_equal(as(tr, "phylo4d"), phylo4d(tr))
+ phyd <- as(tr, "phylo4d")
+ expect_true(class(phyd)=="phylo4d")
+ # simple roundtrip test
+ phyd <- as(tr, "phylo4d")
+ expect_warning(phyo <- as(phyd, "phylo"))
+ expect_equal(tr, phyo)
+})
+
+## test.multiPhylo.As.multiPhylo4 <- function() {
+## }
+
+## test.multiPhylo4.As.multiPhylo <- function() {
+## }
+
+test_that("nexml to phylo4", {
+ nxml <- RNeXML::nexml_read(compFile)
+ phy4 <- as(nxml, "phylo4")
+ expect_true(all(tipLabels(phy4) %in% paste("taxon", 1:10, sep="_")))
+ expect_equal(nEdges(phy4), 19)
+})
+
+test_that("nexml to phylo4d", {
+ nxml <- RNeXML::nexml_read(compFile)
+ phy4d <- as(nxml, "phylo4d")
+ nxmldt <- RNeXML::get_characters(nxml)
+ phy4d2 <- phylo4d(get_trees(nxml), nxmldt[sample(1:nrow(nxmldt)), ])
+ expect_true(all(tipLabels(phy4d) %in% paste("taxon", 1:10, sep="_")))
+ expect_equal(nEdges(phy4d), 19)
+ expect_equal(phy4d, phy4d2)
+ expect_equal(ncol(tdata(phy4d, "tip")), 2)
+ expect_true(all(names(tdata(phy4d, "tip")) %in% c("log.snout.vent.length", "reef.dwelling")))
+})
+
+test_that("phylo4 to phylo", {
+ ## phylo tree in unknown order
+ expect_equal(suppressWarnings(as(phy, "phylo")), tr)
+ # ...now check for warning for unknown order
+ expect_warning(as(phy, "phylo"))
+
+ # phylo tree in cladewise order
+ tr.cladewise <- reorder(tr, "cladewise")
+ phy.c <- as(tr.cladewise, "phylo4")
+ expect_equal(as(phy.c, "phylo"), tr.cladewise)
+
+ # phylo tree in pruningwise order
+ tr.pruningwise <- reorder(tr, "pruningwise")
+ phy.p <- as(tr.pruningwise, "phylo4")
+ expect_equal(suppressWarnings(as(phy.p, "phylo")), tr.pruningwise)
+
+ # after transforming the jumbled tree to phylo and back, edge matrix
+ # and edge slots should still be in the original order, but node slots
+ # should be back in nodeId order
+ phy.r <- reorder(phy.alt)
+ phy.roundtrip.r <- reorder(as(suppressWarnings(as(phy.alt, "phylo")), "phylo4"))
+ expect_equal(edges(phy.roundtrip.r), edges(phy.r))
+ expect_equal(edgeLength(phy.roundtrip.r), edgeLength(phy.r))
+ expect_equal(labels(phy.roundtrip.r), labels(phy.r))
+})
+
+## this coerce method is defined implicitly
+test_that("phylo to phylo4d", {
+ ## phylo tree in unknown order
+ phyd <- as(tr, "phylo4d")
+ tipData(phyd) <- data.frame(x=1:5, row.names=tipLabels(phyd))
+ expect_equal(suppressWarnings(as(phyd, "phylo")), tr)
+ ## ...now check for warning for unknown order
+ expect_warning(as(phyd, "phylo"))
+
+ ## phylo tree in cladewise order
+ tr.cladewise <- reorder(tr, "cladewise")
+ phyd <- as(tr.cladewise, "phylo4d")
+ tipData(phyd) <- data.frame(x=1:5, row.names=tipLabels(phyd))
+ expect_equal(suppressWarnings(as(phyd, "phylo")), tr.cladewise)
+ ## ...now check for warning for dropping data
+ expect_warning(as(phyd, "phylo"))
+
+ ## phylo tree in pruningwise order
+ tr.pruningwise <- reorder(tr, "pruningwise")
+ phyd <- as(tr.pruningwise, "phylo4d")
+ tipData(phyd) <- data.frame(x=1:5, row.names=tipLabels(phyd))
+ expect_equal(suppressWarnings(as(phyd, "phylo")), tr.pruningwise)
+})
+
+##test.phylo4.As.phylog <- function() {
+##}
+
+test_that("phylo4 to data.frame", {
+ phy.show <- phylobase:::.phylo4ToDataFrame(phy.alt, "pretty")
+ expect_equal(phy.show$label, c(lab.tip, lab.int))
+ expect_equal(phy.show$node, c(nid.tip, nid.int))
+ expect_equal(phy.show$ancestor, ancestor[match(c(nid.tip, nid.int),
+ descendant)])
+ expect_equal(phy.show$edge.length, sort(elen))
+ expect_equal(phy.show$node.type, factor(unname(nodeType(phy))))
+})
+
+## core functionality is already tested in test..phylo4ToDataFrame()
+test_that("phylo4 to data.frame", {
+ ## rooted tree
+ expect_true(is.data.frame(as(phy, "data.frame")))
+
+ ## unrooted tree
+ tru <- ape::unroot(tr)
+ phyu <- as(tru, "phylo4")
+ # should probably check that this coercion results in something
+ # *correct*, not just that it produces a data.frame
+ expect_true(is.data.frame(as(phyu, "data.frame")))
+})
diff --git a/tests/testthat/test.subset.R b/tests/testthat/test.subset.R
new file mode 100644
index 0000000..d983fe6
--- /dev/null
+++ b/tests/testthat/test.subset.R
@@ -0,0 +1,133 @@
+##
+## --- Test subset.R ---
+##
+
+## create phylo4 object with a full complement of valid slots
+ancestor <- as.integer(c(6,7,7,6,8,0,8,9,9))
+descendant <- as.integer(c(7,1,2,8,3,6,9,4,5))
+edge <- cbind(ancestor, descendant)
+nid.tip <- 1:5
+nid.int <- 6:9
+nid.all <- c(nid.tip, nid.int)
+lab.tip <- paste("t", nid.tip, sep="")
+lab.int <- paste("n", nid.int, sep="")
+elen <- descendant/10
+elab <- paste("e", ancestor, descendant, sep="-")
+phy <- phylo4(x=edge, tip.label=lab.tip, node.label=lab.int,
+ edge.length=elen, edge.label=elab)
+
+## create altered version such that each slot is out of order with
+## respect to all others; methods should be able to handle this
+phy.alt <- phy
+phy.alt at label <- rev(phy at label)
+phy.alt at edge <- phy at edge[c(6:9, 1:5), ]
+phy.alt at edge.length <- phy at edge.length[c(7:9, 1:6)]
+phy.alt at edge.label <- phy at edge.label[c(8:9, 1:7)]
+
+## now create phylo4d by adding data (with node IDs as row.names)
+phyd.alt <- as(phy.alt, "phylo4d")
+allDt <- data.frame(a=letters[nid.all], b=10*nid.all, row.names=nid.all)
+tdata(phyd.alt, "all") <- allDt
+
+## create altered version such that data slots are out of order with
+## respect to all others; methods should be able to handle this
+nid.tip.r <- c(2,5,4,3,1)
+nid.int.r <- c(8,7,9,6)
+nid.all.r <- c(nid.tip.r, nid.int.r)
+phyd.alt at data <- phyd.alt at data[rank(nid.all.r), ]
+
+#-----------------------------------------------------------------------
+
+context("subset and friends")
+
+## Also be testing "[" phylo4 methods here
+test_that("subset on phylo4", {
+ # subset 2 tips
+ phy.sub2 <- subset(phy.alt, tips.include=c(2, 5))
+ expect_equal(tipLabels(phy.sub2), setNames(c("t2", "t5"), c("1", "2")))
+ expect_equal(nodeLabels(phy.sub2), setNames(c("n6"), c("3")))
+ expect_equal(edgeLength(phy.sub2),
+ setNames(c(0.6, 0.9, 2.2), c("0-3", "3-1", "3-2")))
+ expect_equal(subset(phy.alt, tips.exclude=c(1, 3, 4)), phy.sub2)
+ expect_equal(subset(phy.alt, tips.include=c("t2", "t5")), phy.sub2)
+ expect_equal(subset(phy.alt, tips.exclude=c("t1", "t3", "t4")), phy.sub2)
+ # subset 4 tips
+ phy.sub4 <- subset(phy.alt, tips.include=c(1, 2, 4, 5))
+ expect_equal(tipLabels(phy.sub4),
+ setNames(c("t1", "t2", "t4", "t5"), c("1", "2", "3", "4")))
+ expect_equal(nodeLabels(phy.sub4),
+ setNames(c("n6", "n7", "n9"), c("5", "6", "7")))
+ expect_equal(edgeLength(phy.sub4),
+ setNames(c(0.6, 0.4, 0.5, 0.7, 0.1, 0.2, 1.7),
+ c("0-5", "7-3", "7-4", "5-6", "6-1", "6-2", "5-7")))
+ expect_equal(subset(phy.alt, tips.exclude=3), phy.sub4)
+ expect_equal(subset(phy.alt, tips.include=c("t1", "t2", "t4", "t5")),
+ phy.sub4)
+ expect_equal(subset(phy.alt, tips.exclude="t3"), phy.sub4)
+ # check variants that should all return the original object
+ expect_equal(phy.alt, subset(phy.alt))
+ expect_equal(phy.alt, subset(phy.alt, tipLabels(phy.alt)))
+ expect_equal(phy.alt, subset(phy.alt, seq_len(nTips(phy.alt))))
+ expect_equal(phy.alt, phy.alt[tipLabels(phy.alt)])
+ expect_equal(phy.alt, phy.alt[seq_len(nTips(phy.alt))])
+ expect_equal(phy.alt, phy.alt[TRUE])
+ # error if only one valid tip requested
+ expect_error(subset(phy, tips.include="t1"))
+ expect_error(suppressWarnings(subset(phy, tips.include=c("t1", "t999"))))
+ # error if zero valid tips requested
+ expect_error(suppressWarnings(subset(phy, tips.include="t999")))
+ # error if more than one subset criteria are supplied
+ expect_error(subset(phyd, tips.include="t1", tips.exclude="t3"))
+})
+
+## Also testing "[" phylo4d methods here
+##TODO get rid of some tests that are pretty much redundant with the
+##above, and add tests focused more on tree data
+test_that("subset on phylo4d", {
+ ## subset 2 tips
+ phyd.sub2 <- subset(phyd.alt, tips.include=c(2, 5))
+ expect_equal(tipLabels(phyd.sub2), setNames(c("t2", "t5"), c("1", "2")))
+ expect_equal(nodeLabels(phyd.sub2), setNames(c("n6"), c("3")))
+ expect_equal(edgeLength(phyd.sub2),
+ setNames(c(0.6, 0.9, 2.2), c("0-3", "3-1", "3-2")))
+ expect_equal(subset(phyd.alt, tips.exclude=c(1, 3, 4)), phyd.sub2)
+ expect_equal(subset(phyd.alt, tips.include=c("t2", "t5")), phyd.sub2)
+ expect_equal(subset(phyd.alt, tips.exclude=c("t1", "t3", "t4")), phyd.sub2)
+ ## subset 4 tips
+ phyd.sub4 <- subset(phyd.alt, tips.include=c(1, 2, 4, 5))
+ expect_equal(tipLabels(phyd.sub4),
+ setNames(c("t1", "t2", "t4", "t5"), c("1", "2", "3", "4")))
+ expect_equal(nodeLabels(phyd.sub4),
+ setNames(c("n6", "n7", "n9"), c("5", "6", "7")))
+ expect_equal(edgeLength(phyd.sub4),
+ setNames(c(0.6, 0.4, 0.5, 0.7, 0.1, 0.2, 1.7),
+ c("0-5", "7-3", "7-4", "5-6", "6-1", "6-2", "5-7")))
+ expect_equal(subset(phyd.alt, tips.exclude=3), phyd.sub4)
+ expect_equal(subset(phyd.alt, tips.include=c("t1", "t2", "t4", "t5")),
+ phyd.sub4)
+ expect_equal(subset(phyd.alt, tips.exclude="t3"), phyd.sub4)
+ ## check variants that should all return the original object
+ expect_equal(phyd.alt, subset(phyd.alt))
+ expect_equal(phyd.alt, subset(phyd.alt, tipLabels(phyd.alt)))
+ expect_equal(phyd.alt, subset(phyd.alt, seq_len(nTips(phyd.alt))))
+ expect_equal(phyd.alt, phyd.alt[tipLabels(phyd.alt)])
+ expect_equal(phyd.alt, phyd.alt[seq_len(nTips(phyd.alt))])
+ expect_equal(phyd.alt, phyd.alt[TRUE])
+ ## error if only one valid tip requested
+ expect_error(subset(phyd.alt, tips.include="t1"))
+ expect_error(suppressWarnings(subset(phyd.alt, tips.include=c("t1", "t999"))))
+ ## error if zero valid tips requested
+ expect_error(suppressWarnings(subset(phyd.alt, tips.include="t999")))
+ # subset tips that include an NA value
+ ##TODO uncomment this after tdata is working right with scrambled order
+ ## tdata(phyd.alt)["t5", "a"] <- NA
+ ## tdata(phyd.sub2)["t5", "a"] <- NA
+ ## expect_equal(phyd.sub2, subset(phyd.alt, tips.include=c(2, 5)))
+})
+
+test_that("subset on extractTree", {
+ # extract phylo4 from itself
+ expect_equal(phy.alt, extractTree(phy.alt))
+ # extract phylo4 from phylo4d
+ expect_equal(phy.alt, extractTree(phyd.alt))
+})
diff --git a/tests/testthat/test.tbind.R b/tests/testthat/test.tbind.R
new file mode 100644
index 0000000..e756082
--- /dev/null
+++ b/tests/testthat/test.tbind.R
@@ -0,0 +1,8 @@
+## #
+## # --- Test tbind.R ---
+## #
+
+## test.tbind <- function() {
+## # function(...,checkData=TRUE)
+## }
+
diff --git a/tests/testthat/test.treePlot.R b/tests/testthat/test.treePlot.R
new file mode 100644
index 0000000..5f1fb56
--- /dev/null
+++ b/tests/testthat/test.treePlot.R
@@ -0,0 +1,42 @@
+##
+## --- Test treePlot.R ---
+##
+
+context("check that treePlot returns warnings when providing incorrectly formatted phylo4d objects.")
+
+test_that("phylo4d gives warning when there is no data", {
+ phyd <- phylo4d(ape::rcoal(5), tip.data=data.frame())
+ expect_warning(plot(phyd), "tree has no tip data to plot")
+})
+
+test_that("phylo4d gives warning when there is data but they can't be plotted", {
+ phyd <- phylo4d(ape::rcoal(5), tip.data=data.frame(letters[1:5], letters[6:10]))
+ expect_warning(plot(phyd), "only numeric data can be plotted at this time")
+})
+
+## test.treePlot <- function() {
+## }
+
+## test.plotOneTree <- function() {
+## }
+
+## test.phyloXXYY <- function() {
+## # function(phy, tip.order = NULL)
+## }
+
+## test..bubLegendGrob <- function() {
+## }
+
+## test.drawDetails.bubLegend <- function() {
+## }
+
+## test.phylobubbles <- function() {
+## }
+
+## test.tip.data.plot <- function() {
+## }
+
+## test.plot.phylo4 <- function() {
+## # signature(x='phylo4', y='missing')
+## }
+
diff --git a/tests/testthat/test.treestruc.R b/tests/testthat/test.treestruc.R
new file mode 100644
index 0000000..ddb9305
--- /dev/null
+++ b/tests/testthat/test.treestruc.R
@@ -0,0 +1,30 @@
+#
+# --- Test treestruc.R functions ---
+#
+
+context("tree structures")
+
+test_that("hasPoly", {
+ # construct simple polytomy
+ owls <- ape::read.tree(text =
+ "((Strix_aluco:4.2,Asio_otus:4.2):3.1,Athene_noctua:7.3);")
+ owls$edge <- matrix(c(4,4,4,1,2,3), ncol=2)
+ owls$Nnode <- 1
+ owls$edge.length <- owls$edge.length[-4]
+ tr <- as(owls, "phylo4")
+ expect_true(hasPoly(tr))
+ # test against empty tree
+ expect_true(!hasPoly(new("phylo4")))
+})
+
+
+test_that("hasSingle", {
+ # test against empty tree
+ expect_true(!hasSingle(new("phylo4")))
+})
+
+test_that("hasRetic", {
+ # test against empty tree
+ expect_true(!hasRetic(new("phylo4")))
+})
+
diff --git a/tests/testthat/test.treewalk.R b/tests/testthat/test.treewalk.R
new file mode 100644
index 0000000..06e0012
--- /dev/null
+++ b/tests/testthat/test.treewalk.R
@@ -0,0 +1,275 @@
+#
+# --- Test treewalk.R ---
+#
+
+# Create sample phylo4 tree for testing
+tr <- read.tree(text="(((spA:0.2,(spB:0.1,spC:0.1):0.15):0.5,spD:0.7):0.2,spE:1):0.4;")
+phytr <- as(tr, "phylo4")
+
+# create phylo4 object with a full complement of valid slots
+ancestor <- as.integer(c(6,7,7,6,8,0,8,9,9))
+descendant <- as.integer(c(7,1,2,8,3,6,9,4,5))
+edge <- cbind(ancestor, descendant)
+nid.tip <- 1:5
+nid.int <- 6:9
+nid.all <- c(nid.tip, nid.int)
+lab.tip <- paste("t", nid.tip, sep="")
+lab.int <- paste("n", nid.int, sep="")
+lab.all <- c(lab.tip, lab.int)
+eid <- paste(ancestor, descendant, sep="-")
+elen <- descendant/10
+elab <- paste("e", eid, sep="")
+phy <- phylo4(x=edge, tip.label=lab.tip, node.label=lab.int,
+ edge.length=elen, edge.label=elab)
+
+# create altered version such that each slot is out of order with
+# respect to all others; methods should be able to handle this
+phy.alt <- phy
+phy.alt at label <- rev(phy at label)
+phy.alt at edge <- phy at edge[c(6:9, 1:5), ]
+phy.alt at edge.length <- phy at edge.length[c(7:9, 1:6)]
+phy.alt at edge.label <- phy at edge.label[c(8:9, 1:7)]
+
+# update test targets for edge-related slots
+ancestor <- ancestor[c(6:9, 1:5)]
+descendant <- descendant[c(6:9, 1:5)]
+edge <- cbind(ancestor, descendant)
+eid <- eid[c(6:9, 1:5)]
+elen <- elen[c(6:9, 1:5)]
+elab <- elab[c(6:9, 1:5)]
+
+#-----------------------------------------------------------------------
+
+
+
+## Note: we're not explicitly testing missing="warn" condition below;
+## however, if "OK" and "fail" both work as expected, then so must "warn"
+
+#test.getNode <- function() {
+
+context("getNode")
+test_that("getNode works when nodes provided only has valid characters", {
+ expect_that(getNode(phytr, "spA"), equals(c(spA=1)))
+ expect_that(getNode(phytr, c("spA", "spC")), equals(c(spA=1, spC=3)))
+})
+
+test_that("getNode works when nodes provided only has valid integers", {
+ ans <- 4
+ names(ans) <- "spD"
+ expect_that(getNode(phytr, 4), equals(ans))
+ ans <- c(4,6)
+ names(ans) <- c("spD", NA)
+ expect_that(getNode(phytr, c(4,6)), equals(ans))
+})
+
+test_that("getNode works when node includes only missing characters (names), but missing=OK", {
+ ans <- rep(NA_integer_, 2) # return values should be NA
+ names(ans) <- rep(NA, 2) # return values should have NA names
+ expect_that(getNode(phytr, c("xxx", "yyy"), missing="OK"), equals(ans))
+ # now missing = "fail"
+ expect_error(getNode(phytr, c("xxx", "yyy"), missing="fail"))
+})
+
+test_that("getNode works wehn node includes only missing numbers (IDs), but missing=OK", {
+ ans <- rep(NA_integer_, 3) # return values should be NA
+ names(ans) <- rep(NA, 3) # return values should have NA names
+ expect_that(getNode(phytr, c(-9, 0, 50), missing="OK"), equals(ans))
+ # now missing = "fail"
+ expect_error(getNode(phytr, c(-9, 0, 50), missing="fail"))
+})
+
+test_that("getNode works when node includes NAs, but missing = \"OK\"", {
+ expect_true(is.na(getNode(phytr, NA_integer_, missing="OK")))
+ expect_true(is.na(getNode(phytr, NA_character_, missing="OK")))
+})
+
+test_that("getNode works when node includes mixture of valid values and NAs", {
+ ans <- c(2, NA)
+ names(ans) <- c("spB", NA)
+ expect_that(getNode(phytr, c("spB", NA), missing="OK"), equals(ans))
+ expect_that(getNode(phytr, c(2, NA), missing="OK"), equals(ans))
+})
+
+test_that("getNode throws exception when node is neither integer-like nor character",
+ expect_error(getNode(phytr, 1.5)))
+
+test_that("getNode works even when a tip is labeled as \"0\"", {
+ phyTmp <- phytr
+ tipLabels(phyTmp)[1] <- "0"
+ ans <- 1
+ names(ans) <- "0"
+ expect_that(getNode(phyTmp, "0"), equals(ans))
+})
+
+## TODO context("ancestor function")
+
+## TODO context("children function")
+
+
+context("descendants function")
+phytr <- phylo4(read.tree(text="((t3,t4),(t1,(t2,t5)));"))
+
+test_that("descendants() works with tips", {
+ expect_identical(descendants(phytr, 5), setNames(5L, "t5"))
+ expect_identical(descendants(phytr, 5, "tips"), setNames(5L, "t5"))
+ expect_identical(descendants(phytr, 5, "children"),
+ setNames(integer(0), character(0)))
+ expect_identical(descendants(phytr, 5, "all"), setNames(5L, "t5"))
+ expect_identical(descendants(phytr, 5, "ALL"), setNames(5L, "t5"))
+})
+
+test_that("descendants() works when provided with a vector of nodes", {
+ expect_identical(descendants(phytr, 5:7),
+ list("5" = c(t5 = 5L),
+ "6" = c(t3 = 1L, t4 = 2L, t1 = 3L, t2 = 4L, t5 = 5L),
+ "7" = c(t3 = 1L, t4 = 2L)))
+ expect_identical(descendants(phytr, 5:7, "tips"),
+ list("5" = c(t5 = 5L),
+ "6" = c(t3 = 1L, t4 = 2L, t1 = 3L, t2 = 4L, t5 = 5L),
+ "7" = c(t3 = 1L, t4 = 2L)))
+ expect_identical(descendants(phytr, 5:7, "children"),
+ list("5" = setNames(integer(0), character(0)),
+ "6" = setNames(c(7L, 8L), c(NA, NA)),
+ "7" = c(t3 = 1L, t4 = 2L))
+ )
+ expect_identical(descendants(phytr, 5:7, "ALL"),
+ list("5" = c(t5 = 5L),
+ "6" = setNames(c(6L, 7L, 1L, 2L, 8L, 3L, 9L, 4L, 5L),
+ c(NA, NA, "t3", "t4", NA, "t1", NA, "t2", "t5")),
+ "7" = setNames(c(7L, 1L, 2L), c(NA, "t3", "t4")))
+ )
+ })
+
+test_that("descendants() works with internal nodes", {
+ expect_identical(descendants(phytr, 8),
+ setNames(c(3L, 4L, 5L), c("t1", "t2", "t5")))
+ expect_identical(descendants(phytr, 8, "tips"),
+ setNames(c(3L, 4L, 5L), c("t1", "t2", "t5")))
+ expect_identical(descendants(phytr, 8, "children"),
+ setNames(c(3L, 9L), c("t1", NA)))
+ expect_identical(descendants(phytr, 8, "all"),
+ setNames(c(3L, 9L, 4L, 5L), c("t1", NA, "t2", "t5")))
+ expect_identical(descendants(phytr, 8, "ALL"),
+ setNames(c(8L, 3L, 9L, 4L, 5L),
+ c(NA, "t1", NA, "t2", "t5")))
+})
+
+## TODO siblings # function(phy, node, include.self=FALSE)
+## TODO ancestors # function (phy, node, type=c("all","parent","ALL"))
+## TODO MRCA # function(phy, ...)
+## TODO shortestPath # function(phy, node1, node2)
+
+context("test on getEdge with nodes as descendants")
+## function(phy, node, type=c("descendant", "ancestor"),
+## missing=c("warn", "OK", "fail"))
+
+test_that("getEdge works when node only has valid descendants, as characters", {
+ expect_identical(getEdge(phy.alt, "t1"), setNames("7-1", 1))
+ expect_identical(getEdge(phy.alt, c("t1", "t3")),
+ setNames(c("7-1", "8-3"), c(1,3)))
+})
+
+test_that("getEdge works when node only has valid descendants, as integers", {
+ expect_identical(getEdge(phy.alt, 1), setNames("7-1", 1))
+ expect_identical(getEdge(phy.alt, c(1,3)),
+ setNames(c("7-1", "8-3"), c(1,3)))
+})
+
+test_that("node includes only missing characters (labels), missing=OK", {
+ expect_identical(getEdge(phy.alt, c("x", "y", "z"), missing="OK"),
+ setNames(rep(NA, 3), rep(NA, 3)))
+})
+
+test_that("node includes only missing characters (labels), missing=fail", {
+ expect_error(getEdge(phy.alt, c("x", "y", "z"), missing="fail"))
+})
+
+test_that("node includes only missing numbers (IDs), but missing=OK",
+ expect_identical(getEdge(phy.alt, c(-9, 0, 50), missing="OK"),
+ setNames(rep(NA, 3), rep(NA, 3))))
+
+test_that("node includes only missing numbers (IDs), but missing=fail",
+ expect_error(getEdge(phy, c(-9, 0, 50), missing="fail")))
+
+test_that("node includes NAs, but missing = OK", {
+ expect_true(is.na(getEdge(phy, NA_integer_, missing="OK")))
+ expect_true(is.na(getEdge(phy, NA_character_, missing="OK")))
+})
+
+test_that("node includes mixture of valid values and NAs", {
+ expect_identical(getEdge(phy, c("t3", NA), missing="OK"),
+ setNames(c("8-3", NA), c(3, NA)))
+ expect_identical(getEdge(phy, c(3, NA), missing="OK"),
+ setNames(c("8-3", NA), c(3, NA)))
+})
+
+test_that("node is neither integer-like nor character", {
+ expect_error(getEdge(phy, 1.5))
+})
+
+context("test on getEdge with nodes as ancestors")
+
+test_that("node only has valid ancestors, as characters", {
+ expect_identical(getEdge(phy.alt, "n6", type="ancestor"),
+ setNames(c("6-7", "6-8"), c(6, 6)))
+ expect_identical(getEdge(phy.alt, c("n6", "n8"), type="ancestor"),
+ setNames(c("6-7", "6-8", "8-9", "8-3"), c(6, 6, 8, 8)))
+})
+
+test_that("node only has valid ancestors, as integers", {
+ expect_identical(getEdge(phy.alt, 6, type="ancestor"),
+ setNames(c("6-7", "6-8"), c(6, 6)))
+ expect_identical(getEdge(phy.alt, c(6, 8), type="ancestor"),
+ setNames(c("6-7", "6-8", "8-9", "8-3"), c(6, 6, 8, 8)))
+ })
+
+test_that("node includes only missing characters (labels), but missing=OK", {
+ expect_identical(getEdge(phy.alt, c("x", "y", "z"), type="ancestor",
+ missing="OK"), setNames(rep(NA, 3), rep(NA, 3)))
+})
+
+test_that("node includes only tips (labels), but missing=OK", {
+ expect_identical(
+ getEdge(phy.alt, c("t1", "t3"), type="ancestor", missing="OK"),
+ setNames(rep(NA, 2), c(1, 3)))
+})
+
+test_that("node includes only tips (labels), now missing = fail", {
+ expect_error(getEdge(phy.alt, c("x", "y", "z"), missing="fail"))
+ expect_error(getEdge(phy.alt, c("t1", "t3"), type="ancestor",
+ missing="fail"))
+})
+
+test_that("node includes only missing numbers (IDs), but missing=OK", {
+ expect_identical(
+ getEdge(phy.alt, c(-9, 0, 50), type="ancestor", missing="OK"),
+ setNames(rep(NA, 3), rep(NA, 3)))
+})
+
+test_that("node includes only tips (labels), but missing=OK", {
+ expect_identical(
+ getEdge(phy.alt, c(1, 3), type="ancestor", missing="OK"),
+ setNames(rep(NA, 2), c(1, 3)))
+})
+
+test_that("node includes only tips (labels), but missing=fail", {
+ expect_error(getEdge(phy.alt, c(-9, 0, 50), missing="fail"))
+ expect_error(getEdge(phy.alt, c(1, 3), type="ancestor",
+ missing="fail"))
+})
+
+test_that("node includes NAs, but missing = OK", {
+ expect_true(is.na(getEdge(phy.alt, NA_integer_, type="ancestor",
+ missing="OK")))
+ expect_true(is.na(getEdge(phy.alt, NA_character_, type="ancestor",
+ missing="OK")))
+})
+
+test_that("node includes mixture of valid values and NAs", {
+ expect_identical(
+ getEdge(phy.alt, c("t3", "n8", NA), type="ancestor", missing="OK"),
+ setNames(c(NA, "8-9", "8-3", NA), c(3, 8, 8, NA)))
+ expect_identical(
+ getEdge(phy.alt, c(3, 8, NA), type="ancestor", missing="OK"),
+ setNames(c(NA, "8-9", "8-3", NA), c(3, 8, 8, NA)))
+})
diff --git a/vignettes/auto/developer.el b/vignettes/auto/developer.el
new file mode 100644
index 0000000..2ab9f75
--- /dev/null
+++ b/vignettes/auto/developer.el
@@ -0,0 +1,19 @@
+(TeX-add-style-hook
+ "developer"
+ (lambda ()
+ (TeX-add-to-alist 'LaTeX-provided-package-options
+ '(("inputenc" "utf8") ("hyperref" "colorlinks=true" "bookmarks=true")))
+ (TeX-run-style-hooks
+ "latex2e"
+ "article"
+ "art10"
+ "inputenc"
+ "graphicx"
+ "hyperref"
+ "url")
+ (TeX-add-symbols
+ '("code" 1)
+ "pb")
+ (LaTeX-add-labels
+ "subversion")))
+
diff --git a/vignettes/auto/phylobase.el b/vignettes/auto/phylobase.el
new file mode 100644
index 0000000..b11ee36
--- /dev/null
+++ b/vignettes/auto/phylobase.el
@@ -0,0 +1,21 @@
+(TeX-add-style-hook
+ "phylobase"
+ (lambda ()
+ (TeX-add-to-alist 'LaTeX-provided-package-options
+ '(("inputenc" "utf8")))
+ (add-to-list 'LaTeX-verbatim-macros-with-braces-local "url")
+ (add-to-list 'LaTeX-verbatim-macros-with-braces-local "path")
+ (add-to-list 'LaTeX-verbatim-macros-with-delims-local "url")
+ (add-to-list 'LaTeX-verbatim-macros-with-delims-local "path")
+ (TeX-run-style-hooks
+ "latex2e"
+ "article"
+ "art10"
+ "inputenc"
+ "graphicx"
+ "array"
+ "url")
+ (TeX-add-symbols
+ '("code" 1)))
+ :latex)
+
diff --git a/vignettes/phylobase.Rnw b/vignettes/phylobase.Rnw
new file mode 100644
index 0000000..4f81ba6
--- /dev/null
+++ b/vignettes/phylobase.Rnw
@@ -0,0 +1,674 @@
+\documentclass{article}
+%\VignetteEngine{knitr::knitr}
+%\VignetteIndexEntry{phylo4: classes and methods for phylogenetic trees and data}
+
+\usepackage[utf8]{inputenc} % for UTF-8/single quotes from sQuote()
+\usepackage{graphicx}
+\usepackage{array}
+\usepackage{url}
+
+
+%% Use a little bit more of the page
+%% borrowed from Rd.sty, of r-project.org
+\addtolength{\textheight}{12mm}
+\addtolength{\topmargin}{-9mm} % still fits on US paper
+\addtolength{\textwidth}{24mm} % still fits on US paper
+\setlength{\oddsidemargin}{10mm}
+\setlength{\evensidemargin}{\oddsidemargin}
+
+\newcommand{\code}[1]{{{\tt #1}}}
+
+\title{The \code{phylo4} S4 classes and methods}
+\author{Ben Bolker, Peter Cowan \& Fran\c{c}ois Michonneau}
+\date{\today}
+
+\begin{document}
+
+
+<<setup, include=FALSE>>=
+library(knitr)
+opts_chunk$set(
+ fig.keep='none', dev='pdf', fig.width=6, fig.height=6,
+ latex.options.color="usenames,dvipsnames"
+)
+@
+
+
+\maketitle
+\tableofcontents
+
+\section{Introduction}
+
+This document describes the new \code{phylo4} S4 classes and methods, which are
+intended to provide a unifying standard for the representation of phylogenetic
+trees and comparative data in R. The \code{phylobase} package was developed to
+help both end users and package developers by providing a common suite of tools
+likely to be shared by all packages designed for phylogenetic analysis,
+facilities for data and tree manipulation, and standardization of formats.
+
+This standardization will benefit \emph{end-users} by making it easier to move
+data and compare analyses across packages, and to keep comparative data
+synchronized with phylogenetic trees. Users will also benefit from a repository
+of functions for tree manipulation, for example tools for including or excluding
+subtrees (and associated phenotypic data) or improved tree and data plotting
+facilities. \code{phylobase} will benefit \emph{developers} by freeing them to
+put their programming effort into developing new methods rather than into
+re-coding base tools. We (the \code{phylobase} developers) hope \code{phylobase}
+will also facilitate code validation by providing a repository for benchmark
+tests, and more generally that it will help catalyze community development of
+comparative methods in R.
+
+A more abstract motivation for developing \code{phylobase} was to improve data
+checking and abstraction of the tree data formats. \code{phylobase} can check
+that data and trees are associated in the proper fashion, and protects users and
+developers from accidently reordering one, but not the other. It also seeks to
+abstract the data format so that commonly used information (for example, branch
+length information or the ancestor of a particular node) can be accessed without
+knowledge of the underlying data structure (i.e., whether the tree is stored as
+a matrix, or a list, or a parenthesis-based format). This is achieved through
+generic \code{phylobase} functions which which retrieve the relevant information
+from the data structures. The benefits of such abstraction are multiple: (1)
+\emph{easier access to the relevant information} via a simple function call
+(this frees both users and developers from learning details of complex data
+structures), (2) \emph{freedom to optimize data structures in the future without
+ breaking code.} Having the generic functions in place to ``translate'' between
+the data structures and the rest of the program code allows program and data
+structure development to proceed somewhat independently. The alternative is code
+written for specific data structures, in which modifications to the data
+structure requires rewriting the entire package code (often exacting too high a
+price, which results in the persistence of less-optimal data structures). (3)
+\emph{providing broader access to the range of tools in
+ \code{phylobase}}. Developers of specific packages can use these new tools
+based on S4 objects without knowing the details of S4 programming.
+
+The base \code{phylo4} class is modeled on the the \code{phylo} class in
+\code{ape}. \code{phylo4d} and \code{multiphylo4} extend the \code{phylo4}
+class to include data or multiple trees respectively. In addition to describing
+the classes and methods, this vignette gives examples of how they might be used.
+
+\section{Package overview}
+
+The phylobase package currently implements the following functions and data structures:
+
+\begin{itemize}
+\item Data structures for storing a single tree and multiple trees:
+ \code{phylo4} and \code{multiPhylo4}?
+\item A data structure for storing a tree with associated tip and node data:
+ \code{phylo4d}
+\item A data structure for storing multiple trees with one set of tip data:
+ \code{multiPhylo4d}
+\item Functions for reading nexus files into the above data structures
+\item Functions for converting between the above data structures and \code{ape
+ phylo} objects as well as \code{ade4} \code{phylog} objects (although the
+ latter are now deprecated \ldots)
+\item Functions for editing trees and data (i.e., subsetting and replacing)
+\item Functions for plotting trees and trees with data
+\end{itemize}
+
+\section{Using the S4 help system}
+
+The \code{S4} help system works similarly to the \code{S3} help system with some
+small differences relating to how \code{S4} methods are written. The
+\code{plot()} function is a good example. When we type \code{?plot} we are
+provided the help for the default plotting function which expects \code{x} and
+\code{y}. \code{R} also provides a way to smartly dispatch the right type of
+plotting function. In the case of an \code{ape phylo} object (a \code{S3} class
+object) \code{R} evaluates the class of the object and finds the correct
+functions, so the following works correctly.
+
+<<randtree1,fig.keep='none',tidy=FALSE>>=
+library(ape)
+set.seed(1) ## set random-number seed
+rand_tree <- rcoal(10) ## Make a random tree with 10 tips
+plot(rand_tree)
+@
+
+However, typing \code{?plot} still takes us to the default \code{plot} help. We
+have to type \code{?plot.phylo} to find what we are looking for. This is
+because \code{S3} generics are simply functions with a dot and the class name
+added.
+
+The \code{S4} generic system is too complicated to describe here, but doesn't
+include the same dot notation. As a result \code{?plot.phylo4} doesn't work,
+\code{R} still finds the right plotting function.
+
+<<convtree,fig.keep='none'>>=
+library(phylobase)
+# convert rand_tree to a phylo4 object
+rand_p4_tree <- as(rand_tree, "phylo4")
+plot(rand_p4_tree)
+@
+
+All fine and good, but how to we find out about all the great features of the
+\code{phylobase} plotting function? \code{R} has two nifty ways to find it, the
+first is to simply put a question mark in front of the whole call:
+
+<<doc0, eval=FALSE, purl=FALSE>>=
+`?`(plot(rand_p4_tree))
+@
+
+\code{R} looks at the class of the \code{rand\_p4\_tree} object and takes us to
+the correct help file (note: this only works with \code{S4} objects). The
+second ways is handy if you already know the class of your object, or want to
+compare to generics for different classes:
+
+<<doc1, eval=FALSE, purl=FALSE>>=
+`?`(method, plot("phylo4"))
+@
+
+More information about how \code{S4} documentation works can be found in the
+methods package, by running the following command.
+
+<<doc2,eval=FALSE, purl=FALSE>>=
+help('Documentation', package="methods")
+@
+
+\section{Trees without data}
+
+You can start with a tree --- an object of class \code{phylo} from the
+\code{ape} package (e.g., read in using the \code{read.tree()} or
+\code{read.nexus()} functions), and convert it to a \code{phylo4} object.
+
+For example, load the raw \emph{Geospiza} data:
+<<geodata,tidy=FALSE>>=
+library(phylobase)
+data(geospiza_raw)
+## what does it contain?
+names(geospiza_raw)
+@
+
+Convert the \code{S3} tree to a \code{S4 phylo4} object using the \code{as()}
+function:
+
+<<convgeodata>>=
+(g1 <- as(geospiza_raw$tree, "phylo4"))
+@
+
+The (internal) nodes appear with labels \verb+<NA>+ because
+they are not defined:
+
+<<nodelabelgeodata>>=
+nodeLabels(g1)
+@
+
+You can also retrieve the node labels with \code{labels(g1,"internal")}).
+
+A simple way to assign the node numbers as labels (useful for various checks) is
+
+<<>>=
+nodeLabels(g1) <- paste("N", nodeId(g1, "internal"), sep="")
+head(g1, 5)
+@
+
+The \code{summary} method gives a little extra information, including
+information on the distribution of branch lengths:
+
+<<sumgeodata>>=
+summary(g1)
+@
+
+Print tip labels:
+<<tiplabelgeodata>>=
+tipLabels(g1)
+@
+
+(\code{labels(g1,"tip")} would also work.)
+
+You can modify labels and other aspects of the tree --- for example, to convert
+all the labels to lower case:
+
+<<modlabelsgeodata>>=
+tipLabels(g1) <- tolower(tipLabels(g1))
+@
+
+You could also modify selected labels, e.g. to modify the labels in positions 11
+and 13 (which happen to be the only labels with uppercase letters):
+
+<<eval=FALSE, purl=FALSE>>=
+tipLabels(g1)[c(11, 13)] <- c("platyspiza", "pinaroloxias")
+@
+
+Note that for a given tree, \code{phylobase} always return the \code{tipLabels}
+in the same order.
+
+Print node numbers (in edge matrix order):
+<<nodenumbergeodata>>=
+nodeId(g1, type='all')
+@
+
+Does it have information on branch lengths?
+<<hasbrlengeodata>>=
+hasEdgeLength(g1)
+@
+
+It does! What do they look like?
+<<edgeLength-geodata>>=
+edgeLength(g1)
+@
+
+Note that the root has \verb+<NA>+ as its length.
+
+Print edge labels (also empty in this case --- therefore all \code{NA}):
+
+<<edgelabelgeodata>>=
+edgeLabels(g1)
+@
+
+You can also use this function to label specific edges:
+<<edgelabel-assign-geodata>>=
+edgeLabels(g1)["23-24"] <- "an edge"
+edgeLabels(g1)
+@
+
+The edge labels are named according to the nodes they connect
+(ancestor-descendant). You can get the edge(s) associated with a particular
+node:
+
+<<getEdge-geodata>>=
+getEdge(g1, 24) # default uses descendant node
+getEdge(g1, 24, type="ancestor") # edges using ancestor node
+@
+
+These results can in turn be passed to the function \code{edgeLength} to
+retrieve the length of a given set of edges:
+
+<<getEdge-edgeLength>>=
+edgeLength(g1)[getEdge(g1, 24)]
+edgeLength(g1)[getEdge(g1, 24, "ancestor")]
+@
+
+Is it rooted?
+
+<<rootedgeodata>>=
+isRooted(g1)
+@
+
+Which node is the root?
+<<rootnodegeodata>>=
+rootNode(g1)
+@
+
+Does it contain any polytomies?
+<<polygeodata>>=
+hasPoly(g1)
+@
+
+Is the tree ultrametric?
+<<ultrametric-geodata>>=
+isUltrametric(g1)
+@
+
+You can also get the depth (distance from the root) of any given node or the
+tips:
+<<nodeDepth-geodata>>=
+nodeDepth(g1, 23)
+depthTips(g1)
+@
+
+\section{Trees with data}
+
+The \code{phylo4d} class matches trees with data, or combines them with a data
+frame to make a \code{phylo4d} (tree-with-data) object.
+
+Now we'll take the \emph{Geospiza} data from \verb+geospiza_raw$data+ and merge
+it with the tree. First, let's prepare the data:
+
+<<dataprep>>=
+g1 <- as(geospiza_raw$tree, "phylo4")
+geodata <- geospiza_raw$data
+@
+
+
+However, since \emph{G. olivacea} is included in the tree but
+not in the data set, we will initially run into some trouble:
+
+<<geomergedata, error=TRUE, purl=FALSE>>=
+g2 <- phylo4d(g1, geodata)
+@
+
+<<echo=FALSE, results='hide'>>=
+geodata <- geospiza_raw$data
+@
+
+To deal with \emph{G. olivacea} missing from the data, we have a few
+choices. The easiest is to use \code{missing.data="warn"} to allow \code{R} to
+create the new object with a warning (you can also use \code{missing.data="OK"}
+to proceed without warnings):
+
+<<geomerge2, tidy=FALSE, warning=TRUE, purl=FALSE>>=
+g2 <- phylo4d(g1, geodata, missing.data="warn")
+@
+
+<<echo=FALSE, results='hide'>>=
+g2 <- phylo4d(g1, geodata, missing.data="OK", extra.data="OK")
+@
+
+Another way to deal with this would be to use \code{prune()} to drop the
+offending tip from the tree first:
+
+<<geomerge3, results='hide'>>=
+g1sub <- prune(g1, "olivacea")
+g1B <- phylo4d(g1sub, geodata)
+@
+
+The difference between the two objects is that the species \emph{G. olivacea} is
+still present in the tree but has no data (i.e., \verb+NA+) associated with
+it. In the other case, \textit{G. olivacea} is not included in the tree
+anymore. The approach you choose depends on the goal of your analysis.
+
+You can summarize the new object with the function \code{summary}. It breaks
+down the statistics about the traits based on whether it is associated with the
+tips for the internal nodes:
+<<geomergesum>>=
+summary(g2)
+@
+
+Or use \code{tdata()} to extract the data (i.e., \code{tdata(g2)}). By default,
+\code{tdata()} will retrieve tip data, but you can also get internal node data
+only (\code{tdata(tree, "internal")}) or --- if the tip and node data have the
+same format --- all the data combined (\code{tdata(tree, "allnode")}).
+
+If you want to plot the data (e.g. for checking the input),
+\code{plot(tdata(g2))} will create the default plot for the data --- in this
+case, since it is a data frame [\textbf{this may change in future versions but
+ should remain transparent}] this will be a \code{pairs} plot of the data.
+
+\section{Subsetting}
+
+The \code{subset} command offers a variety of ways of extracting portions of a
+\code{phylo4} or \code{phylo4d} tree, keeping any tip/node data consistent.
+
+\begin{description}
+\item[tips.include]{give a vector of tips (names or numbers) to retain}
+\item[tips.exclude]{give a vector of tips (names or numbers) to drop}
+\item[mrca]{give a vector of node or tip names or numbers; extract the clade
+ containing these taxa}
+\item[node.subtree]{give a node (name or number); extract the subtree starting
+ from this node}
+\end{description}
+
+Different ways to extract the \emph{fuliginosa}-\emph{scandens} clade:
+
+<<geoextract,results='hide'>>=
+subset(g2, tips.include=c("fuliginosa", "fortis", "magnirostris",
+ "conirostris", "scandens"))
+subset(g2, node.subtree=21)
+subset(g2, mrca=c("scandens", "fortis"))
+@
+
+One could drop the clade by doing
+
+<<geodrop, results='hide'>>=
+subset(g2, tips.exclude=c("fuliginosa", "fortis", "magnirostris",
+ "conirostris", "scandens"))
+subset(g2, tips.exclude=names(descendants(g2, MRCA(g2, c("difficilis",
+ "fortis")))))
+
+@
+
+% This isn't implemented yet
+
+% Another approach is to pick the subtree graphically, by plotting the tree and
+% using \code{identify}, which returns the identify of the node you click on
+% with the mouse.
+%
+% <<geoident,eval=FALSE>>=
+% plot(g1)
+% n1 <- identify(g1)
+% subset(g2,node.subtree=n1)
+% @
+
+\section{Tree-walking}
+
+\code{phylobase} provides many functions that allows users to explore
+relationships between nodes on a tree (tree-walking and tree traversal). Most
+functions work by specifying the \code{phylo4} (or \code{phylo4d}) object as the
+first argument, the node numbers/labels as the second argument (followed by some
+additional arguments).
+
+\code{getNode} allows you to find a node based on its node number or its
+label. It returns a vector with node numbers as values and labels as names:
+
+<<getnode>>=
+data(geospiza)
+getNode(geospiza, 10)
+getNode(geospiza, "pauper")
+@
+
+If no node is specified, they are all returned, and if a node can't be found
+it's returned as a \verb+NA+. It is possible to control what happens when a node
+can't be found:
+
+<<getnode2>>=
+getNode(geospiza)
+getNode(geospiza, 10:14)
+getNode(geospiza, "melanogaster", missing="OK") # no warning
+getNode(geospiza, "melanogaster", missing="warn") # warning!
+@
+
+\code{children} and \code{ancestor} give the immediate neighboring nodes:
+
+<<children>>=
+children(geospiza, 16)
+ancestor(geospiza, 16)
+@
+
+while \code{descendants} and \code{ancestors} can traverse the tree up to the
+tips or root respectively:
+
+<<descendants>>=
+descendants(geospiza, 16) # by default returns only the tips
+descendants(geospiza, "all") # also include the internal nodes
+ancestors(geospiza, 20)
+ancestors(geospiza, 20, "ALL") # uppercase ALL includes self
+@
+
+\code{siblings} returns the other node(s) associated with the same ancestor:
+
+<<siblings>>=
+siblings(geospiza, 20)
+siblings(geospiza, 20, include.self=TRUE)
+@
+
+\code{MRCA} returns the most common recent ancestor for a set of tips, and
+shortest path returns the nodes connecting 2 nodes:
+
+<<mrca>>=
+MRCA(geospiza, 1:6)
+shortestPath(geospiza, 4, "pauper")
+@
+
+\section{multiPhylo4 classes}
+
+\code{multiPhylo4} classes are not yet implemented but will be coming soon.
+
+\section{Examples}
+
+\subsection{Constructing a Brownian motion trait simulator}
+
+This section will describe a way of constructing a simulator that generates
+trait values for extant species (tips) given a tree with branch lengths,
+assuming a model of Brownian motion.
+
+We can use \code{as(tree,"phylo4vcov")} to coerce the tree into a
+variance-covariance matrix form, and then use \code{mvrnorm} from the
+\code{MASS} package to generate a set of multivariate normally distributed
+values for the tips. (A benefit of this approach is that we can very quickly
+generate a very large number of replicates.) This example illustrates a common
+feature of working with \code{phylobase} --- combining tools from several
+different packages to operate on phylogenetic trees with data.
+
+We start with a randomly generated tree using \code{rcoal()} from \code{ape} to
+generate the tree topology and branch lengths:
+
+<<rtree2>>=
+set.seed(1001)
+tree <- as(rcoal(12), "phylo4")
+@
+
+Next we generate the phylogenetic variance-covariance matrix (by coercing the
+tree to a \code{phylo4vcov} object) and pick a single set of normally
+distributed traits (using \code{MASS:mvrnorm} to pick a multivariate normal
+deviate with a variance-covariance matrix that matches the structure of the
+tree).
+
+<<vcvphylo>>=
+vmat <- as(tree, "phylo4vcov")
+vmat <- cov2cor(vmat)
+library(MASS)
+trvec <- mvrnorm(1, mu=rep(0, 12), Sigma=vmat)
+@
+
+The last step (easy) is to convert the \code{phylo4vcov} object back to a
+\code{phylo4d} object:
+
+<<plotvcvphylo>>=
+treed <- phylo4d(tree, tip.data=as.data.frame(trvec))
+plot(treed)
+@
+
+% \subsubsection{The hard way}
+
+% <<tidy=FALSE>>=
+% ## add node labels so we can match to data
+% nodeLabels(tree) <- as.character(nodeId(tree, "internal"))
+% ## ordering will make sure that we have ancestor value
+% ## defined before descendant
+% tree <- reorder(tree, "preorder")
+% edgemat <- edges(tree)
+% ## set aside space for values
+% nodevals <- numeric(nrow(edgemat))
+% ## label data in edge matrix order
+% names(nodevals) <- labels(tree, "all")[nodeId(tree, "all")]
+% ## variance is proportional to edge length; drop first
+% ## element of edge length, which is NA
+% dvals <- rnorm(nrow(edgemat) - 1, sd=edgeLength(tree)[-1]^2)
+% ## indexing: ind[node number] gives position in edge matrix
+% ind <- order(nodeId(tree, "all"))
+% for (i in 2:nrow(edgemat)) {
+% ## value of ancestor node plus change
+% nodevals[i] <- nodevals[ind[edgemat[i, 1]]] + dvals[i - 1]
+% }
+% nodevals <- data.frame(nodevals)
+% treed2 <- phylo4d(tree, all.data=nodevals)
+% @
+
+
+% ========================================
+% = Table of commands, worth the effort? =
+% ========================================
+% \begin{tabular}{>{\tt}ll}
+% \hline
+% \rm Method & Description\\
+% \hline
+% tdata & Retrieve tip data\\
+% plot & plot tree with data if present\\
+% \hline
+% \end{tabular}
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% Appendices %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+\appendix
+\section{Definitions/slots}
+
+This section details the internal structure of the \code{phylo4},
+\code{multiphylo4} (coming soon!), \code{phylo4d}, and \code{multiphylo4d}
+(coming soon!) classes. The basic building blocks of these classes are the
+\code{phylo4} object and a dataframe. The \code{phylo4} tree format is largely
+similar to the one used by \code{phylo} class in the package
+\code{ape}\footnote{\url{http://ape.mpl.ird.fr/}}.
+
+We use ``edge'' for ancestor-descendant relationships in the phylogeny
+(sometimes called ``branches'') and ``edge lengths'' for their lengths (``branch
+lengths''). Most generally, ``nodes'' are all species in the tree; species with
+descendants are ``internal nodes'' (we often refer to these just as ``nodes'',
+meaning clear from context); ``tips'' are species with no descendants. The
+``root node'' is the node with no ancestor (if one exists).
+
+\subsection{phylo4}
+Like \code{phylo}, the main components of
+the \code{phylo4} class are:
+\begin{description}
+\item[edge]{a 2-column matrix of integers,
+ with $N$ rows for a rooted tree or
+ $N-1$ rows for an unrooted tree and
+ column names \code{ancestor} and \code{descendant}.
+ Each row contains information on one edge in the tree.
+ See below for further constraints on the edge matrix.}
+\item[edge.length]{numeric list of edge lengths
+ (length $N$ (rooted) or $N-1$ (unrooted) or empty (length 0))}
+\item[tip.label]{character vector of tip labels (required), with length=\# of
+ tips. Tip labels need not be unique, but data-tree matching with non-unique
+ labels will cause an error}
+\item[node.label]{character vector of node labels, length=\# of internal nodes
+ or 0 (if empty). Node labels need not be unique, but data-tree matching
+ with non-unique labels will cause an error}
+\item[order]{character: ``preorder'', ``postorder'', or ``unknown'' (default),
+ describing the order of rows in the edge matrix. , ``pruningwise'' and
+ ``cladewise'' are accepted for compatibility with \code{ape}}
+\end{description}
+
+The edge matrix must not contain \code{NA}s, with the exception of the root
+node, which has an \code{NA} for \code{ancestor}. \code{phylobase} does not
+enforce an order on the rows of the edge matrix, but it stores information on
+the current ordering in the \code{@order} slot --- current allowable values are
+``unknown'' (the default), ``preorder'' (equivalent to ``cladewise'' in
+\code{ape}) or ``postorder'' \footnote{see
+ \url{http://en.wikipedia.org/wiki/Tree_traversal} for more information on
+ orderings. (\code{ape}'s ``pruningwise'' is ``bottom-up'' ordering).}.
+
+The basic criteria for the edge matrix are similar to those of \code{ape}, as
+documented it's tree
+specification\footnote{\url{ape.mpl.ird.fr/misc/FormatTreeR_28July2008.pdf}}. This
+is a modified version of those rules, for a tree with $n$ tips and $m$ internal
+nodes:
+
+\begin{itemize}
+\item Tips (no descendants) are coded $1,\ldots, n$,
+ and internal nodes ($\ge 1$ descendant)
+ are coded $n + 1, \ldots , n + m$
+ ($n + 1$ is the root).
+ Both series are numbered with no gaps.
+\item The first (ancestor)
+ column has only values $> n$ (internal nodes): thus, values $\le n$
+ (tips) appear only in the second (descendant) column)
+\item all internal nodes [not including the root] must appear in the first
+ (ancestor) column at least once [unlike \code{ape}, which nominally requires
+ each internal node to have at least two descendants (although it doesn't
+ absolutely prohibit them and has a \code{collapse.singles} function to get rid
+ of them), \code{phylobase} does allow these ``singleton nodes'' and has a
+ method \code{hasSingle} for detecting them]. Singleton nodes can be useful as
+ a way of representing changes along a lineage; they are used this way in the
+ \code{ouch} package.
+
+\item the number of occurrences of a node in the first column is related to the
+ nature of the node: once if it is a singleton, twice if it is dichotomous
+ (i.e., of degree 3 [counting ancestor as well as descendants]), three times if
+ it is trichotomous (degree 4), and so on.
+\end{itemize}
+
+\code{phylobase} does not technically prohibit reticulations (nodes or tips that
+appear more than once in the descendant column), but they will probably break
+most of the methods. Disconnected trees, cycles, and other exotica are not
+tested for, but will certainly break the methods.
+
+We have defined basic methods for \code{phylo4}:\code{show}, \code{print}, and a
+variety of accessor functions (see help files). \code{summary} does not seem to
+be terribly useful in the context of a ``raw'' tree, because there is not much
+to compute.
+
+\subsection{phylo4d}
+
+The \code{phylo4d} class extends \code{phylo4} with data. Tip data, and
+(internal) node data are stored separately, but can be retrieved together or
+separately with \code{tdata(x,"tip")}, \code{tdata(x,"internal")} or
+\code{tdata(x,"all")}. There is no separate slot for edge data, but these can be
+stored as node data associated with the descendant node.
+
+
+% \subsection{multiphylo4}
+
+\end{document}
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-med/r-cran-phylobase.git
More information about the debian-med-commit
mailing list