[med-svn] [r-cran-ape] 01/02: Imported Upstream version 3.4
Dylan Aïssi
bob.dybian-guest at moszumanska.debian.org
Sat Dec 5 21:58:45 UTC 2015
This is an automated email from the git hooks/post-receive script.
bob.dybian-guest pushed a commit to branch master
in repository r-cran-ape.
commit f30a5673307f15c19ac51b933f3ec0bbbde40012
Author: Dylan Aïssi <bob.dybian at gmail.com>
Date: Sat Dec 5 22:57:36 2015 +0100
Imported Upstream version 3.4
---
DESCRIPTION | 11 +-
MD5 | 81 +++++++------
NAMESPACE | 23 +++-
R/CDF.birth.death.R | 11 +-
R/DNA.R | 34 +++++-
R/as.phylo.R | 33 +++---
R/balance.R | 6 +-
R/checkValidPhylo.R | 93 +++++++++++++++
R/clustal.R | 33 +++++-
R/collapse.singles.R | 101 +++++++++-------
R/drop.tip.R | 11 +-
R/ladderize.R | 5 +-
R/makeLabel.R | 44 ++++++-
R/nodelabels.R | 28 +++--
R/parafit.R | 1 +
R/phydataplot.R | 89 ++++++++++++--
R/plot.phylo.R | 106 ++++++++++-------
R/reorder.phylo.R | 8 +-
R/root.R | 287 ++++++++++++++++-----------------------------
R/rtt.R | 82 ++++++-------
build/vignette.rds | Bin 192 -> 194 bytes
data/hivtree.newick.rda | Bin 2189 -> 2190 bytes
data/landplants.newick.rda | Bin 574 -> 576 bytes
data/opsin.newick.rda | Bin 444 -> 446 bytes
inst/doc/MoranI.pdf | Bin 238306 -> 238529 bytes
man/DNAbin2indel.Rd | 28 +++++
man/LTT.Rd | 3 +
man/alex.Rd | 2 +-
man/alview.Rd | 32 +++++
man/ape-internal.Rd | 1 +
man/as.phylo.Rd | 10 +-
man/checkValidPhylo.Rd | 29 +++++
man/clustal.Rd | 20 +++-
man/collapse.singles.Rd | 36 +++++-
man/image.DNAbin.Rd | 2 +-
man/label2table.Rd | 47 ++++++++
man/makeLabel.Rd | 2 +-
man/makeNodeLabel.Rd | 2 +-
man/mixedFontLabel.Rd | 2 +-
man/phydataplot.Rd | 70 ++++++++++-
man/plot.phylo.Rd | 11 +-
man/rlineage.Rd | 1 +
src/ape.c | 6 +-
src/dist_dna.c | 149 ++++++++++++++---------
44 files changed, 1035 insertions(+), 505 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index 1549b07..4a56a65 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,6 +1,6 @@
Package: ape
-Version: 3.3
-Date: 2015-05-28
+Version: 3.4
+Date: 2015-11-29
Title: Analyses of Phylogenetics and Evolution
Authors at R: c(person("Emmanuel", "Paradis", role = c("aut", "cre", "cph"), email = "Emmanuel.Paradis at ird.fr"),
person("Simon", "Blomberg", role = c("aut", "cph")),
@@ -28,13 +28,14 @@ Authors at R: c(person("Emmanuel", "Paradis", role = c("aut", "cre", "cph"), email
person("Damien", "de Vienne", role = c("aut", "cph")))
Depends: R (>= 3.0.0)
Suggests: gee, expm
-Imports: nlme, lattice, graphics, stats, tools, utils, parallel
+Imports: nlme, lattice, graphics, methods, stats, tools, utils,
+ parallel
ZipData: no
Description: Functions for reading, writing, plotting, and manipulating phylogenetic trees, analyses of comparative data in a phylogenetic framework, ancestral character analyses, analyses of diversification and macroevolution, computing distances from allelic and nucleotide data, reading and writing nucleotide sequences as well as importing from BioConductor, and several tools such as Mantel's test, generalized skyline plots, graphical exploration of phylogenetic data (alex, trex, krono [...]
License: GPL (>= 2)
URL: http://ape-package.ird.fr/
NeedsCompilation: yes
-Packaged: 2015-05-29 09:20:40 UTC; paradis
+Packaged: 2015-11-29 08:54:16 UTC; paradis
Author: Emmanuel Paradis [aut, cre, cph],
Simon Blomberg [aut, cph],
Ben Bolker [aut, cph],
@@ -61,4 +62,4 @@ Author: Emmanuel Paradis [aut, cre, cph],
Damien de Vienne [aut, cph]
Maintainer: Emmanuel Paradis <Emmanuel.Paradis at ird.fr>
Repository: CRAN
-Date/Publication: 2015-05-29 12:44:18
+Date/Publication: 2015-11-29 19:14:31
diff --git a/MD5 b/MD5
index d6d5cdd..6d06c47 100644
--- a/MD5
+++ b/MD5
@@ -1,12 +1,12 @@
eb723b61539feef013de476e68b5c50a *COPYING
-50b68c64f7094784d90ab4c5a2e7d44a *DESCRIPTION
-ce33ce7a078a76ba0b7d15c174e19078 *NAMESPACE
+57b1f36bda7714d59b4a842112555cde *DESCRIPTION
+3da79160e5c27538ff5cab02127c05a8 *NAMESPACE
854a025cb7e5da3e4fe230c0be950d08 *NEWS
0c7bc9101516fd26fb3ddbedbe25b6a3 *R/CADM.global.R
e042efca1d8a00d4178204f5f481b64d *R/CADM.post.R
-f6dfdae2ca8529a2f0ba1de6b90fed0f *R/CDF.birth.death.R
+df7599318fae6e660d57461413148967 *R/CDF.birth.death.R
fdb9cfa0cbda82bda982b290693e44e3 *R/Cheverud.R
-144ad46a2f5fcc069f97971f4d405b91 *R/DNA.R
+f5be79ac583e238aa7f86184f9e650de *R/DNA.R
0fbc7715dfdc8d54ded16d78ca3100f8 *R/MPR.R
bb95af56d882b6162aa517a77140175e *R/MoranI.R
218b8cf3c13a700c757b7b2303dc897e *R/PGLS.R
@@ -18,21 +18,22 @@ eaad016718d9ee8c79b15d252879072c *R/ace.R
9fe874382f024a98f62a0ccfcd6d09ac *R/all.equal.phylo.R
06b049b681ab2e594124a2b010c5cddd *R/as.bitsplits.R
c94018d5e792c72e20ce84085b2df9e7 *R/as.matching.R
-91674814efe984a1dcc90b3d7d8f425f *R/as.phylo.R
+ea82e116c735fbf545d888f3aeb36fd6 *R/as.phylo.R
1bb4dcfb44a7485710ec7f599d4b2ee8 *R/as.phylo.formula.R
-29efb767d4a207910c1da99c1eb6cb69 *R/balance.R
+844a38494dd34adbe916bb9116cd0bc2 *R/balance.R
607d7d6bc0ec5559ce1de5b1d1aab0c1 *R/binaryPGLMM.R
76b5ca45b7210c85fdc20cd1579b33a2 *R/bind.tree.R
a28930cdae07a271403e988e86a0c324 *R/biplot.pcoa.R
92d9db6d7c1150d1a7c9443fd3d5cb04 *R/birthdeath.R
4ee816e0dc69630d104fb5da4cc542c4 *R/branching.times.R
+cc55d092fc68c6433da930832ba03177 *R/checkValidPhylo.R
e43b5dec7eae6d4bf9371e50117bf6ed *R/cherry.R
02bdacc928572e8ab2d88380a075d7a8 *R/chronoMPL.R
74e1019810b06458e808a447bb099a91 *R/chronopl.R
8ae1af4a30c40d15676d70e180f3d593 *R/chronos.R
-f6f25bb8f94f424dd6bbbab64eedb00d *R/clustal.R
+452d7e2d19f9eccb3798d34e0a97e270 *R/clustal.R
4f52fb37d822be586f0c5971295167dc *R/coalescent.intervals.R
-054bec70587f0056636b2cc52754c7f9 *R/collapse.singles.R
+c3d44d960238a711764aaeebe9570559 *R/collapse.singles.R
338accc0accb8e67f31db5a90c033d2f *R/collapsed.intervals.R
01e979242ba4667e48a80fd32c03f254 *R/compar.gee.R
89ce53eb1bb8c0fb36e95810cf7cd769 *R/compar.lynch.R
@@ -48,7 +49,7 @@ dfd5bb35f1cb1fd9154d023e0e4cfc2b *R/dist.gene.R
eba6cb1e8dd0359568a46907c445351e *R/dist.topo.R
b28ced504fedeb7f991f7eba10ad06df *R/diversi.gof.R
8b2ec4004022afdc7e2cb42f2657b628 *R/diversi.time.R
-fd662cd4bbd6ce536ef379eca2e516ab *R/drop.tip.R
+ea5fcbd0f207ab1d874c0d032392967d *R/drop.tip.R
1c4bdd6cf163aa4d605ed67249883ad4 *R/evonet.R
fceafc86fae624fd9037403ad301d35a *R/ewLasso.R
aa09abeb90ef891384128f978ffce843 *R/extract.popsize.R
@@ -59,10 +60,10 @@ aa09abeb90ef891384128f978ffce843 *R/extract.popsize.R
be075b35bb032eaca5946abd14ded1e3 *R/is.compatible.R
35921387c705612d8f7c5baa06f9ab79 *R/is.monophyletic.R
135e6538fd2db96b8bd39ad42d161506 *R/is.ultrametric.R
-6133e277d2594d94345e6f10789a3a3a *R/ladderize.R
+944879f7a9a134866f31d8476a07f9c1 *R/ladderize.R
65b2494ebd918c6f9a31c80e25370035 *R/lmorigin.R
b4c7ccf40ec0c69a21da38965747d350 *R/ltt.plot.R
-5b4a31b11b83ea3371f75befcb42ea94 *R/makeLabel.R
+2adfbd3f101466e8b04c4f9aaf3d5377 *R/makeLabel.R
34069210fd7b12dda0979c45822e4d3a *R/makeNodeLabel.R
a84000c0d7d2f53aec6a7105477f886a *R/mantel.test.R
d2c16632492bfafd2ee18f2fe3d3d64a *R/matexpo.R
@@ -74,14 +75,14 @@ eb5dd3843951b8bde1b8d53ab2d1353a *R/multi2di.R
0850fdd19c01d37ac632fc308632a463 *R/mvr.R
282308c27ac1e78e330711d635d2e572 *R/nj.R
e3f22d0f260c43be87a17b0ab091e2bb *R/njs.R
-080c82acd4a90a88a1bbd098ebfe6b60 *R/nodelabels.R
+e4a0712fa45754cd02f5d3da6ef23204 *R/nodelabels.R
ae2aeb0e8aef7f8d4b19939ca61b3482 *R/nodepath.R
-d624cca14aa569e94e1f1e13e9091337 *R/parafit.R
+d9fd8e402e6fce6939a05332823a9390 *R/parafit.R
fc0260f9e8e17fc1446117580bbc93cc *R/pcoa.R
-4999c85e82105ded85a214204321c3d1 *R/phydataplot.R
+431d25db557d480985ac16bfc3d6425c *R/phydataplot.R
e71db002c66c277bfb57f6914ca143d4 *R/phymltest.R
61d1360195bf4d5e6e2d8c30de335dc8 *R/pic.R
-9ff3970a2edd690be453c7f06076341b *R/plot.phylo.R
+92c0db6a14b334c5777e9128c7a06f12 *R/plot.phylo.R
e579ec65c808c29e1ecaae1501784b37 *R/plot.popsize.R
736506e2f67e90cf9326abead437d298 *R/plotPhyloCoor.R
1e2485437566ca9af99d93b4580cbbc2 *R/print.lmorigin.R
@@ -94,11 +95,11 @@ c1fc8ab4715f1d58145f533fbaf776e4 *R/read.dna.R
13ce7f5c7d1bcb7101469d12651e99c8 *R/read.nexus.data.R
88e633c80886f5a6c9f2b34918452d15 *R/read.tree.R
86361682a3d477e8e63fff53dc67279e *R/reconstruct.R
-b1218f7862a66f566e4f3165f28fe47c *R/reorder.phylo.R
-d1b097835752cd0c7672a68789bdb610 *R/root.R
+4a39f9ba8cc833bdabe7bf32d9e40651 *R/reorder.phylo.R
+1d1f46c727948c8d07f5cb7da8b0327b *R/root.R
f584366b32e7414c669714ba5b84951b *R/rotate.R
b7158b84c7ee7d9dcb2e0abeb6005cb0 *R/rtree.R
-0730a0bed794d8297576e732868d23ec *R/rtt.R
+6d359208c90e5aff93426f3c6ce39f46 *R/rtt.R
d099c8987470c4506511be54e29a5ddd *R/scales.R
d2e06f8288af941a00c46248b586225a *R/skyline.R
1f82059f740388b7430b2359e54a147f *R/skylineplot.R
@@ -121,7 +122,7 @@ a918c086a449bcca5ccbb04f7e6d50a9 *R/yule.R
c8d3aa3fe64e75e61af07a1b11c74f3f *R/yule.time.R
1eb44ff9e5a036eb845faa1598ce5009 *R/zoom.R
3387c0d0c1f913f8471e1bb34bd2e516 *R/zzz.R
-85eb7d45a064be571370be6e598c3cf5 *build/vignette.rds
+2ea9c2e09861e4e7f78e4ca935ff5079 *build/vignette.rds
db9083e8750aff839d5ebf3ed982f1f1 *data/HP.links.rda
9d9f9232839665422709ded1e541d038 *data/bird.families.rda
a14a6df0f3a735ebc056065077788c90 *data/bird.orders.rda
@@ -129,39 +130,41 @@ f74f9ed80c04756021cc093d40ca9ff9 *data/carnivora.csv.gz
4eaf8cbaefa2e8f8d395a9b482ee9967 *data/chiroptera.rda
1c74c3b99d08b0e17eea3ec1065c12d2 *data/cynipids.rda
7fe760c2f3b4deba0554aae6138cb602 *data/gopher.D.rda
-41a3ee7725bfad5558773b3ef4ad7eb0 *data/hivtree.newick.rda
+b188e7bd92e1630728de2d7df20892e2 *data/hivtree.newick.rda
8d14f95319d0a5cdc8faa60a1d0085ce *data/hivtree.table.txt.gz
-20d7287583c3ba5ab039a770d3172fc1 *data/landplants.newick.rda
+4e20263989bfa454171269174966162e *data/landplants.newick.rda
31be81fe3faca11f98d3e74c090bc59e *data/lice.D.rda
38edbd84a0a067322c40db8d71fb1289 *data/lmorigin.ex1.rda
e3ce9e3444182fea2e65df2e150ea0db *data/lmorigin.ex2.rda
ce7a56faebdf286fdf5ba6c8c3699a79 *data/mat3.RData
e2d1339025ed901009bfed58dc6505ff *data/mat5M3ID.RData
101d0ab2e981b0987cde704a2dee1d8d *data/mat5Mrand.RData
-34b42702379db0d59db817f7c6c33709 *data/opsin.newick.rda
+95cef0772cc4b7eb2203317468659102 *data/opsin.newick.rda
39e4fece2bdc527d7a9d4d83d023a947 *data/woodmouse.rda
828290996b613493f96e0fab024beebb *inst/CITATION
3f54f3775bcf382e25df2a12228894f6 *inst/doc/MoranI.R
abf2e3e84707634e32f3e7cc6a5ee7ae *inst/doc/MoranI.Rnw
-d00d528ac1f7e054d372178a314558de *inst/doc/MoranI.pdf
+946e0a4afd6cc366bfa269f2b9116464 *inst/doc/MoranI.pdf
e6876b193a0df06697c788a8e48cf4bc *man/CADM.global.Rd
b79f29b6efb97d7d4cb5408810a23893 *man/DNAbin.Rd
+4bf4cce57153ff6b1728d9bb2b49fd2e *man/DNAbin2indel.Rd
8b9bc214e32cde4c6e5970e48ff30c5f *man/Initialize.corPhyl.Rd
-4f9582ee3a35e609a01779e1b1bf32e7 *man/LTT.Rd
+c81533f37d8e6d9b8b1ca8a9118608e9 *man/LTT.Rd
ff05fd6fa0a2750b53abf025cdc021d3 *man/MPR.Rd
303135aa8664be5cb518e0cbf2018b2c *man/MoranI.Rd
17486c0fd29fb6f4a752c53fe37142c4 *man/SDM.Rd
b4b2d3c708bf1ebca6f1f3b4cb752243 *man/ace.Rd
60adac0f324c7b08a756d8f45c02b024 *man/add.scale.bar.Rd
32d8ad6eeea971901aee33f1f654ae7c *man/additive.Rd
-0f37535a86413945bf3205b7a7b7c20b *man/alex.Rd
+25a2859708b9a281a0d682e4376f3f53 *man/alex.Rd
179ad4f32184a21ebd65564c41d0d02e *man/all.equal.phylo.Rd
-416c995c868f02d17fe9dc14a106b71c *man/ape-internal.Rd
+f8fc170ab95008fc9bbcba0a85889e64 *man/alview.Rd
+e02eb0f3c7ff30ae3e085e7a27f5397a *man/ape-internal.Rd
587cbd9d9a326b3990ed20bfe5016165 *man/ape-package.Rd
5bba4ae4bfc66b613855cfc182d9b1bc *man/as.alignment.Rd
2771f272ad46b279022892d9f5d21eb2 *man/as.bitsplits.Rd
4f014cf2923e2eab6188acd48e8096fa *man/as.matching.Rd
-3a9546ce6447f5b6585b4bd58dc4c7f4 *man/as.phylo.Rd
+78ff1c24cc3b91de1bf33ca5f45c7af5 *man/as.phylo.Rd
219cff7b94e167e18f4f9cd99cc8efc3 *man/as.phylo.formula.Rd
c1bb2b36369966cc61f802daa27921a2 *man/axisPhylo.Rd
ad514b163e70bfbc11dfd34a450799f8 *man/balance.Rd
@@ -178,14 +181,15 @@ ef1c15d5d93410c21179997431112209 *man/birthdeath.Rd
5a64b90d3a6c7a8204946b00f45f4cfc *man/branching.times.Rd
7dad9d632d914de8122f2455f0762546 *man/c.phylo.Rd
9d3f9614732671a610cc8a37454885e2 *man/carnivora.Rd
+5ff8c7e8fad519d978f166948c03059c *man/checkValidPhylo.Rd
64c3996ca6bcc97d0d2e2cf3361f8f71 *man/cherry.Rd
f82a24dc4bb17b5675ec7b422d575587 *man/chiroptera.Rd
b40dd77fd2529626e983ee0300be6781 *man/chronoMPL.Rd
c1f01c6200b2f1e2901d45d40daae404 *man/chronopl.Rd
506d0332fb092ab87ca7674faef63ab7 *man/chronos.Rd
-cb0cdda41058b55d02b87df14c86f85e *man/clustal.Rd
+63d84f7fa6540b7a17e980f346861d6f *man/clustal.Rd
866af6e8d769b3d6972ef8e1ac849a12 *man/coalescent.intervals.Rd
-0841b19345d6f61e97852f6c810cccfd *man/collapse.singles.Rd
+18c77b4104aa22d3e6cb88339f2eff90 *man/collapse.singles.Rd
bff5a7826f5a39767601e32ceb776247 *man/collapsed.intervals.Rd
301f271dc131de2efc3294d31f03afed *man/compar.cheverud.Rd
4d8ee141d7b6b323ef5ee9446000ae32 *man/compar.gee.Rd
@@ -224,18 +228,19 @@ eea313e8ee32597b4cec120d23113642 *man/gammaStat.Rd
3991fa7864e326579f1ab8b671095e4b *man/hivtree.Rd
18012643a904f657fc5f5896f3d14054 *man/howmanytrees.Rd
86c49d080fdffd614d8056021e91cc55 *man/identify.phylo.Rd
-46c7c675e02d355a25d8c1c02deffcd7 *man/image.DNAbin.Rd
+0d49b03a4a0fb96add881f4d0f8d6ae8 *man/image.DNAbin.Rd
9957425ef61231ba72538e771c6565b5 *man/is.binary.tree.Rd
80a5a228a43679edf75903590253a875 *man/is.compatible.Rd
d2de8fd9549ef01a1dddeb726dd77fcf *man/is.monophyletic.Rd
9d09e72a00da6b7b3f967f76166077cd *man/is.ultrametric.Rd
3f6ff8340b6c9770a1f4d2fed72a295d *man/kronoviz.Rd
+8edde42ffc43737ba82e18594801421f *man/label2table.Rd
2afa6305e48e4c47a7d94d46401f85a3 *man/ladderize.Rd
23db31affc0dc60f6c772e850bb640c3 *man/landplants.Rd
4b86460e4e5d993abf13c99b9744dbd6 *man/lmorigin.Rd
21bb31db5bcc8d8650467ef73fe0c0d3 *man/ltt.plot.Rd
-3d81c146cea3555ac60a7dede5fbb882 *man/makeLabel.Rd
-21a1880755f3dce16856f0987c3a25fd *man/makeNodeLabel.Rd
+7ca1aeffd0cd8106e00d0ee1952b5ccb *man/makeLabel.Rd
+376a9b2d1653806bbef6c4e53db16fab *man/makeNodeLabel.Rd
817b23b342fe170de6500d13d9f54c82 *man/mantel.test.Rd
97cf5ddb9352b0545ed225d16d750ffb *man/mat3.Rd
f56f6f49c89c6bc850a7aee1bce5e0bd *man/mat5M3ID.Rd
@@ -243,7 +248,7 @@ f56f6f49c89c6bc850a7aee1bce5e0bd *man/mat5M3ID.Rd
69ae0cb181240bb8ec168e69f1ba44bb *man/matexpo.Rd
a8b9d6b04d35d75f43d1b283361a1642 *man/mcconwaysims.test.Rd
d47c22d9e889ae5c878940c41c59d31f *man/mcmc.popsize.Rd
-a3180429a5f137f1749180084d984257 *man/mixedFontLabel.Rd
+c1d52335ab9d9ccac265c06c9fae019c *man/mixedFontLabel.Rd
dbcdc231c2f1f221818307bb33486159 *man/mrca.Rd
5c88230ad597ea9fe41536a8321c326b *man/mst.Rd
114f7834d51151cb6f92f8ed77becbcd *man/multi2di.Rd
@@ -257,12 +262,12 @@ ba754eba67181a1c39d417ffd9d23b76 *man/nodelabels.Rd
4f8b4cf2a725a8001e49390056181bef *man/opsin.Rd
c2e2f35f4e233265c86b7967ec2d0630 *man/parafit.Rd
89db814a5fc2e9fa5f0b9f4ad2f0d070 *man/pcoa.Rd
-1721a03534aaab0d59209197726d474b *man/phydataplot.Rd
+583200254fe87b2a36fc18a88825298d *man/phydataplot.Rd
6dfa52711bab351bbcfe2624690eb730 *man/phymltest.Rd
447941526b92322c52b5cfe367cb7088 *man/pic.Rd
0363aa3fa3e86160934e2359c8ac5323 *man/pic.ortho.Rd
265527313d479d3625df7680c7479cd1 *man/plot.correlogram.Rd
-ae7dba067878a6546519c8cc84889dae *man/plot.phylo.Rd
+d23d21863b2dffa5388f3fc128368af4 *man/plot.phylo.Rd
6bb1cf751772b9b6acf560b5f3c6f3c1 *man/plot.varcomp.Rd
b24438c42cea969302ec6ba61002426e *man/print.phylo.Rd
80bf68fd21b5e665329cf30b10a1655f *man/rTraitCont.Rd
@@ -277,7 +282,7 @@ bc02e36c51d67074e661468993ed359b *man/read.nexus.data.Rd
48d08588177df45a1e53dede1dc56bae *man/reconstruct.Rd
61e0bc86ae5a1f04ee6e88cdc92a2089 *man/reorder.phylo.Rd
af19f262b468dfd7c12448d9d8085331 *man/richness.yule.test.Rd
-d919cbc29acafcefaa9a5b2594da6a8c *man/rlineage.Rd
+3afe25cebe4628e4844e41aad512d6e4 *man/rlineage.Rd
bb3a58966e6d9d72a4b885bbe9fb935f *man/root.Rd
6b97ea2fd96bf948fca764deab3a6e76 *man/rotate.Rd
1a7314ee0aa76712737e76162df6cc74 *man/rtree.Rd
@@ -317,14 +322,14 @@ a00006ae345bb9379312e81694de3885 *man/zoom.Rd
122ba51b574f7f7acd5ea4b6256cea5f *src/SPR.c
d11fb19958f2953583a9c5876da82df9 *src/TBR.c
9733c82cd67c4bd41aea44981f4ac8b8 *src/additive.c
-d343190ba59ef1feac9c96752f210687 *src/ape.c
+fff638ac2fab946388330ec67cba990d *src/ape.c
7eaffd3d85df9a1e4460905e9ca5eced *src/ape.h
19b564aab62c464c092cdf2f0d5cf447 *src/bNNI.c
79ca5c473decf13964192524caebf9f1 *src/bionjs.c
f782a97466ed8008d31afd7a3e9d4ea9 *src/bipartition.c
a5d4f692aca36f6b50e123b443792fa1 *src/bitsplits.c
81e4ad60b418966cdd09e608e074bb28 *src/delta_plot.c
-00d3d2104b1b606b17d4cc636129d2e7 *src/dist_dna.c
+97d837be6e2d862a26a8028d4a56af4b *src/dist_dna.c
2a6a59a3a220eb855a3c48bc73dc54ba *src/dist_nodes.c
005ab69356525fbbc1b69950341308c2 *src/ewLasso.c
afa27403972145d083d7f7f8b2536b98 *src/heap.c
diff --git a/NAMESPACE b/NAMESPACE
index ded7b7f..a752a53 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -3,14 +3,27 @@ useDynLib(ape, .registration = TRUE)
exportPattern("^[^\\.]")
export(.compressTipLabel, .uncompressTipLabel, .PlotPhyloEnv)
-importFrom(graphics, arrows, identify, image.default, lines, plot,
- plot.default, segments)
+importFrom(graphics, abline, arrows, axTicks, axis, barplot, boxplot, bxp,
+ close.screen, identify, image, image.default, layout, lines,
+ locator, mtext, par, plot, plot.default, points, polygon, rect,
+ screen, segments, split.screen, strheight, strwidth, symbols,
+ text, title, xinch, yinch)
+importFrom(grDevices, col2rgb, dev.cur, dev.new, dev.off, dev.set,
+ devAskNewPage, grey, rainbow, rgb, topo.colors)
importFrom(lattice, xyplot, panel.lines, panel.points)
+importFrom(methods, as, show)
importFrom(nlme, corMatrix, Dim, getCovariate, getGroups,
getGroupsFormula, gls, Initialize)
-importFrom(stats, as.hclust, biplot, coef, cophenetic, drop1, hclust,
- mahalanobis, reorder)
-importFrom(utils, setTxtProgressBar, txtProgressBar)
+importFrom(stats, as.dist, as.hclust, biplot, coef, complete.cases,
+ cophenetic, cor, cor.test, cov, cov2cor, density, dgamma,
+ dpois, drop1, formula, gaussian, glm, hclust, integrate,
+ lm, mahalanobis, median, model.frame, model.matrix,
+ model.response, na.fail, nlm, nlminb, optim, optimize, p.adjust,
+ pchisq, pf, pgamma, pnorm, ppois, printCoefmat, pt, qbinom, qnorm,
+ qt, quantile, quasibinomial, rbinom, reorder, resid, rexp, rgamma,
+ rnorm, runif, sd, terms, uniroot, var, wilcox.test)
+importFrom(utils, download.file, read.table, setTxtProgressBar, str,
+ txtProgressBar)
## Methods for the classes defined in ape, including for the generics
## defined in ape (see also below). Some methods are exported above.
diff --git a/R/CDF.birth.death.R b/R/CDF.birth.death.R
index c632528..2cced20 100644
--- a/R/CDF.birth.death.R
+++ b/R/CDF.birth.death.R
@@ -1,4 +1,4 @@
-## CDF.birth.death.R (2015-04-10)
+## CDF.birth.death.R (2015-07-28)
## Functions to Simulate and Fit Time-Dependent Birth-Death Models
@@ -676,8 +676,9 @@ if (!fossils) {
## concatenate the vectors of times after dropping the extra 0's:
TIME <- c(time.tips[seq_len(n)], rev(time.nodes[seq_len(Nnode)]))
}
- structure(list(edge = cbind(e1, e2, deparse.level = 0),
- edge.length = TIME[e2] - TIME[e1],
- tip.label = paste0("t", seq_len(n)),
- Nnode = Nnode), class = "phylo")
+ obj <- list(edge = cbind(e1, e2, deparse.level = 0),
+ edge.length = TIME[e2] - TIME[e1],
+ tip.label = paste0("t", seq_len(n)), Nnode = Nnode)
+ class(obj) <- "phylo"
+ reorder(obj)
}
diff --git a/R/DNA.R b/R/DNA.R
index 8306eb4..0217c28 100644
--- a/R/DNA.R
+++ b/R/DNA.R
@@ -1,4 +1,4 @@
-## DNA.R (2015-05-28)
+## DNA.R (2015-11-18)
## Manipulations and Comparisons of DNA Sequences
@@ -7,6 +7,18 @@
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
+DNAbin2indel <- function(x)
+{
+ if (is.list(x)) x <- as.matrix(x)
+ d <- dim(x)
+ s <- as.integer(d[2])
+ n <- as.integer(d[1])
+ res <- .C(DNAbin2indelblock, x, n, s, integer(n*s), NAOK = TRUE)[[4]]
+ dim(res) <- d
+ rownames(res) <- rownames(x)
+ res
+}
+
labels.DNAbin <- function(object, ...)
{
if (is.list(object)) return(names(object))
@@ -479,6 +491,26 @@ image.DNAbin <- function(x, what, col, bg = "white", xlab = "", ylab = "",
}
}
+alview <- function(x, file = "", uppercase = TRUE)
+{
+ if (is.list(x)) x <- as.matrix(x)
+ taxa <- formatC(labels(x), width = -1)
+ x <- as.character(x)
+ s <- ncol(x)
+ if (nrow(x) > 1) {
+ for (j in seq_len(s)) {
+ q <- which(x[-1L, j] == x[1L, j]) + 1L
+ x[q, j] <- "."
+ }
+ }
+ x <- apply(x, 1L, paste, collapse = "")
+ if (uppercase) x <- toupper(x)
+ res <- paste(taxa, x)
+ hdr <- formatC(s, width = nchar(res[1]))
+ cat(hdr, file = file, sep = "\n")
+ cat(res, file = file, sep = "\n", append = TRUE)
+}
+
where <- function(x, pattern)
{
pat <- as.DNAbin(strsplit(pattern, NULL)[[1]])
diff --git a/R/as.phylo.R b/R/as.phylo.R
index fa2f373..f02bb5d 100644
--- a/R/as.phylo.R
+++ b/R/as.phylo.R
@@ -1,4 +1,4 @@
-## as.phylo.R (2015-02-06)
+## as.phylo.R (2015-10-16)
## Conversion Among Tree Objects
@@ -91,21 +91,26 @@ as.hclust.phylo <- function(x, ...)
if (!is.rooted(x)) stop("the tree is not rooted")
n <- length(x$tip.label)
x$node.label <- NULL # by Jinlong Zhang (2010-12-15)
- bt <- sort(branching.times(x))
- inode <- as.numeric(names(bt))
+ bt <- branching.times(x)
N <- n - 1L
- nm <- numeric(N + n) # hash table
- nm[inode] <- 1:N
- merge <- matrix(NA, N, 2)
- for (i in 1:N) {
- ind <- which(x$edge[, 1] == inode[i])
- for (k in 1:2) {
- tmp <- x$edge[ind[k], 2]
- merge[i, k] <- if (tmp <= n) -tmp else nm[tmp]
- }
- }
+
+ x <- reorder(x, "postorder")
+ m <- matrix(x$edge[, 2], N, 2, byrow = TRUE)
+ anc <- x$edge[c(TRUE, FALSE), 1]
+ bt <- sort(bt[as.character(anc)])
+ o <- match(names(bt), anc)
+ m <- m[o, ]
+
+ ## first renumber the tips:
+ TIPS <- m <= n
+ m[TIPS] <- -m[TIPS]
+
+ ## then renumber the nodes:
+ oldnodes <- as.numeric(names(bt))[-N]
+ m[match(oldnodes, m)] <- 1:(N - 1)
+
names(bt) <- NULL
- obj <- list(merge = merge, height = bt, order = 1:n, labels = x$tip.label,
+ obj <- list(merge = m, height = 2*bt, order = 1:n, labels = x$tip.label,
call = match.call(), method = "unknown")
class(obj) <- "hclust"
obj
diff --git a/R/balance.R b/R/balance.R
index 37b2671..00f18d1 100644
--- a/R/balance.R
+++ b/R/balance.R
@@ -1,17 +1,17 @@
-## balance.R (2009-05-10)
+## balance.R (2015-07-08)
## Balance of a Dichotomous Phylogenetic Tree
-## Copyright 2002-2009 Emmanuel Paradis
+## Copyright 2002-2015 Emmanuel Paradis
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
balance <- function(phy)
{
-### the tree must be in cladewise order
if (!inherits(phy, "phylo"))
stop('object "phy" is not of class "phylo"')
+ phy <- reorder(phy) # fix a bug reported by G. Valiente in January 2009 (2015-07-08)
N <- length(phy$tip.label)
nb.node <- phy$Nnode
if (nb.node != N - 1)
diff --git a/R/checkValidPhylo.R b/R/checkValidPhylo.R
new file mode 100644
index 0000000..d86d3a9
--- /dev/null
+++ b/R/checkValidPhylo.R
@@ -0,0 +1,93 @@
+## checkValidPhylo.R (2015-11-17)
+
+## Check the Structure of a "phylo" Object
+
+## Copyright 2015 Emmanuel Paradis
+
+## This file is part of the R-package `ape'.
+## See the file ../COPYING for licensing issues.
+
+checkValidPhylo <- function(phy)
+{
+ cat("Starting checking the validity of ", deparse(substitute(phy)), "...\n", sep = "")
+ n <- m <- NULL
+ if (is.null(phy$tip.label)) {
+ cat(" FATAL: no element named 'tip.label' in the tree -- did you extract this tree from a \"multiPhylo\" object?\n")
+ } else {
+ if (!is.vector(phy$tip.label)) {
+ cat(" FATAL: 'tip.label' is not a vector\n")
+ } else {
+ if (!is.character(phy$tip.label))
+ cat(" MODERATE: 'tip.label' is not of mode \"character\"\n")
+ n <- length(phy$tip.label)
+ cat("Found number of tips: n =", n, "\n")
+ }
+ }
+
+ if (is.null(n))
+ cat(" FATAL: cannot determine the number of tips\n")
+
+ if (is.null(phy$Nnode)) {
+ cat(" FATAL: no element named 'Nnode' in the tree\n")
+ } else {
+ if (!is.vector(phy$Nnode)) cat(" MODERATE: 'Nnode' is not a vector\n")
+ if (length(phy$Nnode) != 1) cat(" FATAL: 'Nnode' is not of length 1\n")
+ if (!is.numeric(phy$Nnode)) {
+ cat(" FATAL: 'Nnode' is not numeric\n")
+ } else {
+ if (storage.mode(phy$Nnode) != "integer")
+ cat(" MODERATE: 'Nnode' is not stored as an integer\n")
+ }
+ if (length(phy$Nnode) == 1 && is.numeric(phy$Nnode)) {
+ m <- phy$Nnode
+ cat("Found number of nodes: m =", m, "\n")
+ }
+ }
+
+ if (is.null(m))
+ cat(" FATAL: cannot determine the number of nodes\n")
+
+ if (is.null(phy$edge)) {
+ cat(" FATAL: no element named 'edge' in the tree\n")
+ } else {
+ if (!is.matrix(phy$edge)) {
+ cat(" FATAL: 'edge' is not a matrix\n")
+ } else {
+ nc <- ncol(phy$edge)
+ if (nc != 2)
+ cat(" FATAL: 'edge' has", nc, "columns: it MUST have 2\n")
+ if (!is.numeric(phy$edge)) {
+ cat(" FATAL: 'edge' is not a numeric matrix\n")
+ } else {
+ if (storage.mode(phy$edge) != "integer")
+ cat(" MODERATE: the matrix 'edge' is not stored as integers\n")
+ if (nc == 2) {
+ if (any(phy$edge <= 0))
+ cat(" FATAL: some elements in 'edge' are negative or zero\n")
+ if (is.null(n) || is.null(m)) {
+ cat("The number of tips and/or nodes was not found: cannot check completely the 'edge' matrix\n")
+ } else {
+ tab <- tabulate(phy$edge)
+ if (length(tab) > n + m)
+ cat(" FATAL: some numbers in 'edge' are larger than 'n + m'\n")
+ if (length(tab) < n + m)
+ cat(" MODERATE: some nodes are missing in 'edge'\n")
+ if (any(tab[1:n] != 1))
+ cat(" FATAL: each tip must appear once in 'edge'\n")
+ if (any(tab[n + 1:m] < 2))
+ cat(" FATAL: all nodes should appear at least twice in 'edge'\n")
+ if (any(tab[n + 2:m] < 3))
+ cat(" MODERATE: only the root can be of degree 2, all other nodes should be of degree 3 or higher\n")
+ if (any(phy$edge[, 1] <= n & phy$edge[, 1] > 0))
+ cat(" FATAL: tips should not appear in the 1st column of 'edge'\n")
+ if (any(table(phy$edge[, 2]) > 1))
+ cat(" FATAL: nodes and tips should appear only once in the 2nd column of 'edge'\n")
+ if (any(phy$edge[, 2] == n + 1L))
+ cat(" FATAL: the root node should not appear in the 2nd column of 'edge'\n")
+ }
+ }
+ }
+ }
+ }
+ cat("Done.\n")
+}
diff --git a/R/clustal.R b/R/clustal.R
index c777945..8125e52 100644
--- a/R/clustal.R
+++ b/R/clustal.R
@@ -1,21 +1,44 @@
-## clustal.R (2012-11-28)
+## clustal.R (2015-07-06)
## Multiple Sequence Alignment with External Applications
-## Copyright 2011-2012 Emmanuel Paradis
+## Copyright 2011-2015 Emmanuel Paradis
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
+clustalomega <- function(x, exec = NULL, MoreArgs = "", quiet = TRUE)
+{
+ os <- Sys.info()[1]
+ if (is.null(exec)) {
+ exec <- switch(os, "Linux" = "clustalo", "Darwin" = "clustalo",
+ "Windows" = "clustalo.exe")
+ }
+
+ if (missing(x)) {
+ system(paste(exec, "-h"))
+ return(invisible(NULL))
+ }
+
+ d <- tempdir()
+ inf <- paste(d, "input_clustalo.fas", sep = "/")
+ outf <- paste(d, "output_clustalo.fas", sep = "/")
+ write.dna(x, inf, "fasta")
+ opts <- paste("-i", inf, "-o", outf, "--force")
+ if (!quiet) opts <- paste(opts, "-v")
+ opts <- paste(opts, MoreArgs)
+ system(paste(exec, opts), ignore.stdout = quiet)
+ read.dna(outf, "fasta")
+}
+
clustal <- function(x, pw.gapopen = 10, pw.gapext = 0.1,
gapopen = 10, gapext = 0.2, exec = NULL,
MoreArgs = "", quiet = TRUE, original.ordering = TRUE)
{
os <- Sys.info()[1]
if (is.null(exec)) {
- if (os == "Linux") exec <- "clustalw"
- if (os == "Darwin") exec <- "clustalw2"
- if (os == "Windows") shortPathName("C:/Program Files/ClustalW2/clustalw2.exe")
+ exec <- switch(os, "Linux" = "clustalw", "Darwin" = "clustalw2",
+ "Windows" = "clustalw2.exe")
}
if (missing(x)) {
diff --git a/R/collapse.singles.R b/R/collapse.singles.R
index bbde0a1..ae99159 100644
--- a/R/collapse.singles.R
+++ b/R/collapse.singles.R
@@ -1,52 +1,73 @@
-## collapse.singles.R (2010-07-23)
+## collapse.singles.R (2015-06-22)
## Collapse "Single" Nodes
-## Copyright 2006 Ben Bolker
+## Copyright 2015 Emmanuel Paradis
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
-collapse.singles <- function(tree)
+collapse.singles <- function(tree, root.edge = FALSE)
{
- elen <- tree$edge.length
- xmat <- tree$edge
- ## added by Elizabeth Purdom (2008-06-19):
- node.lab <- tree$node.label
- nnode <- tree$Nnode
- ntip <- length(tree$tip.label)
- ## end
- singles <- NA
- while (length(singles) > 0) {
- ## changed by EP to make it slightly more efficient:
- ## tx <- table(xmat[xmat < 0])
- ## singles <- as.numeric(names(tx)[tx < 3])
- tx <- tabulate(xmat[, 1])
- singles <- which(tx == 1)
- ## END
- if (length(singles) > 0) {
- i <- singles[1]
- prev.node <- which(xmat[, 2] == i)
- next.node <- which(xmat[, 1] == i)
- xmat[prev.node, 2] <- xmat[next.node, 2]
- xmat <- xmat[xmat[, 1] != i, ] # drop
- ## changed by EP for the new coding of "phylo" (2006-10-05):
- ## xmat[xmat < i] <- xmat[xmat < i] + 1 ## adjust indices
- xmat[xmat > i] <- xmat[xmat > i] - 1L ## adjust indices # changed '1' by '1L' (2010-07-23)
- ## END
- elen[prev.node] <- elen[prev.node] + elen[next.node]
- ## added by Elizabeth Purdom (2008-06-19):
- if (!is.null(node.lab)) node.lab <- node.lab[-c(i - ntip)]
- nnode <- nnode - 1L
- ## end
- elen <- elen[-next.node]
+ n <- length(tree$tip.label)
+ e1 <- tree$edge[, 1]
+ e2 <- tree$edge[, 2]
+
+ tab <- tabulate(e1)
+ if (all(tab > 1)) return(tree)
+
+ if (is.null(tree$edge.length)) {
+ root.edge <- FALSE
+ wbl <- FALSE
+ } else {
+ wbl <- TRUE
+ el <- tree$edge.length
+ }
+
+ if (root.edge) ROOTEDGE <- 0
+
+ ## start with the root node:
+ ROOT <- n + 1L
+ while (tab[ROOT] == 1) {
+ i <- which(e1 == ROOT)
+ ROOT <- e2[i]
+ if (wbl) {
+ if (root.edge) ROOTEDGE <- ROOTEDGE + el[i]
+ el <- el[-i]
}
+ e1 <- e1[-i]
+ e2 <- e2[-i]
+ }
+
+ singles <- which(tabulate(e1) == 1)
+ while (length(singles)) {
+ i <- which(e1 == singles[1])
+ j <- which(e2 == e1[i])
+ e2[j] <- e2[i]
+ if (wbl) {
+ el[j] <- el[j] + el[i]
+ el <- el[-i]
+ }
+ e1 <- e1[-i]
+ e2 <- e2[-i]
+ singles <- which(tabulate(e1) == 1)
+ }
+
+ Nnode <- length(e1) - n + 1L
+
+ oldnodes <- unique(e1)
+ if (!is.null(tree$node.label))
+ tree$node.label <- tree$node.label[oldnodes - n]
+ newNb <- integer(max(oldnodes))
+ newNb[ROOT] <- n + 1L
+ sndcol <- e2 > n
+ e2[sndcol] <- newNb[e2[sndcol]] <- n + 2:Nnode
+ e1 <- newNb[e1]
+ tree$edge <- cbind(e1, e2, deparse.level = 0)
+ tree$Nnode <- Nnode
+ if (wbl) {
+ if (root.edge) tree$root.edge <- ROOTEDGE
+ tree$edge.length <- el
}
- tree$edge <- xmat
- tree$edge.length <- elen
- ## added by Elizabeth Purdom (2008-06-19):
- tree$node.label <- node.lab
- tree$Nnode <- nnode
- ## end
tree
}
diff --git a/R/drop.tip.R b/R/drop.tip.R
index 8c0c1de..62bd65c 100644
--- a/R/drop.tip.R
+++ b/R/drop.tip.R
@@ -1,8 +1,8 @@
-## drop.tip.R (2013-05-17)
+## drop.tip.R (2015-07-28)
## Remove Tips in a Phylogenetic Tree
-## Copyright 2003-2013 Emmanuel Paradis
+## Copyright 2003-2015 Emmanuel Paradis
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
@@ -222,13 +222,12 @@ drop.tip <-
phy$Nnode <- dim(phy$edge)[1] - n + 1L # update phy$Nnode
## The block below renumbers the nodes so that they conform
- ## to the "phylo" format, same as in root()
+ ## to the "phylo" format
newNb <- integer(Ntip + Nnode)
newNb[NEWROOT] <- n + 1L
sndcol <- phy$edge[, 2] > n
- ## executed from right to left, so newNb is modified before phy$edge:
- phy$edge[sndcol, 2] <- newNb[phy$edge[sndcol, 2]] <-
- (n + 2):(n + phy$Nnode)
+ newNb[sort(phy$edge[sndcol, 2])] <- (n + 2):(n + phy$Nnode)
+ phy$edge[sndcol, 2] <- newNb[phy$edge[sndcol, 2]]
phy$edge[, 1] <- newNb[phy$edge[, 1]]
storage.mode(phy$edge) <- "integer"
if (!is.null(phy$node.label)) # update node.label if needed
diff --git a/R/ladderize.R b/R/ladderize.R
index 30e71f0..664d777 100644
--- a/R/ladderize.R
+++ b/R/ladderize.R
@@ -1,8 +1,8 @@
-## ladderize.R (2007-01-04)
+## ladderize.R (2015-10-04)
## Ladderize a Tree
-## Copyright 2007 Emmanuel Paradis
+## Copyright 2007-2015 Emmanuel Paradis
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
@@ -25,6 +25,7 @@ ladderize <- function(phy, right = TRUE)
for (i in 1:Nclade)
if (desc[i] > nb.tip) foo(desc[i], end[i], newpos[i] + 1)
}
+ phy <- reorder(phy) # fix by Klaus (2015-10-04)
nb.tip <- length(phy$tip.label)
nb.node <- phy$Nnode
nb.edge <- dim(phy$edge)[1]
diff --git a/R/makeLabel.R b/R/makeLabel.R
index 3f5b1ed..fb688e9 100644
--- a/R/makeLabel.R
+++ b/R/makeLabel.R
@@ -1,8 +1,8 @@
-## makeLabel.R (2013-06-04)
+## makeLabel.R (2015-11-18)
## Label Management
-## Copyright 2010-2013 Emmanuel Paradis
+## Copyright 2010-2015 Emmanuel Paradis
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
@@ -115,3 +115,43 @@ mixedFontLabel <-
}
parse(text = res)
}
+
+.getSeparatorTaxaLabels <- function(x)
+{
+ if (length(grep("_", x))) "_" else " "
+}
+
+label2table <- function(x, sep = NULL, as.is = FALSE)
+{
+ n <- length(x)
+ if (is.null(sep)) sep <- .getSeparatorTaxaLabels(x)
+ x <- strsplit(x, sep)
+ x <- unlist(lapply(x, "[", 1:3))
+ x <- matrix(x, n, 3, byrow = TRUE)
+ x <- as.data.frame(x, as.is = as.is)
+ names(x) <- c("genus", "species", "subspecies")
+ x
+}
+
+stripLabel <- function(x, species = FALSE, subsp = TRUE, sep = NULL)
+{
+ if (is.null(sep)) sep <- .getSeparatorTaxaLabels(x)
+ n <- 0
+ if (species) n <- 1 else if (subsp) n <- 2
+ if (!n) return(x)
+ x <- strsplit(x, sep)
+ x <- lapply(x, "[", 1:n)
+ sapply(x, paste, collapse = sep)
+}
+
+abbreviateGenus <- function(x, genus = TRUE, species = FALSE, sep = NULL)
+{
+ if (is.null(sep)) sep <- .getSeparatorTaxaLabels(x)
+ if (genus) x <- sub(paste0("[[:lower:]]{1,}", sep), paste0(".", sep), x)
+ if (!species) return(x)
+ x <- strsplit(x, sep)
+ k <- which(sapply(x, length) > 1)
+ for (i in k)
+ x[[i]][2] <- paste0(substr(x[[i]][2], 1, 1), ".")
+ sapply(x, paste, collapse = sep)
+}
diff --git a/R/nodelabels.R b/R/nodelabels.R
index fbb5edd..1f166b0 100644
--- a/R/nodelabels.R
+++ b/R/nodelabels.R
@@ -1,4 +1,4 @@
-## nodelabels.R (2014-06-05)
+## nodelabels.R (2014-07-31)
## Labelling Trees
@@ -187,22 +187,32 @@ edgelabels <-
sel <- edge
subedge <- lastPP$edge[sel, , drop = FALSE]
}
+
+ xx <- lastPP$xx
+ yy <- lastPP$yy
+
if (lastPP$type == "phylogram") {
if (lastPP$direction %in% c("rightwards", "leftwards")) {
- XX <- (lastPP$xx[subedge[, 1]] + lastPP$xx[subedge[, 2]]) / 2
- YY <- lastPP$yy[subedge[, 2]]
+ XX <- (xx[subedge[, 1]] + xx[subedge[, 2]]) / 2
+ YY <- yy[subedge[, 2]]
} else {
- XX <- lastPP$xx[subedge[, 2]]
- YY <- (lastPP$yy[subedge[, 1]] + lastPP$yy[subedge[, 2]]) / 2
+ XX <- xx[subedge[, 2]]
+ YY <- (yy[subedge[, 1]] + yy[subedge[, 2]]) / 2
}
} else {
- XX <- (lastPP$xx[subedge[, 1]] + lastPP$xx[subedge[, 2]]) / 2
- YY <- (lastPP$yy[subedge[, 1]] + lastPP$yy[subedge[, 2]]) / 2
+ if (lastPP$type == "fan") { # fix by Klaus Schliep (2015-07-31)
+ r <- sqrt(xx^2 + yy^2)
+ tmp <- (r[subedge[, 2]] + r[subedge[, 1]]) / (r[subedge[, 2]] * 2)
+ XX <- xx[subedge[, 2]] * tmp
+ YY <- yy[subedge[, 2]] * tmp
+ } else {
+ XX <- (xx[subedge[, 1]] + xx[subedge[, 2]]) / 2
+ YY <- (yy[subedge[, 1]] + yy[subedge[, 2]]) / 2
+ }
}
## suggestion by Rob Lanfear:
- if (!is.null(date))
- XX[] <- max(lastPP$xx) - date
+ if (!is.null(date)) XX[] <- max(lastPP$xx) - date
BOTHlabels(text, sel, XX, YY, adj, frame, pch, thermo,
pie, piecol, col, bg, horiz, width, height, ...)
diff --git a/R/parafit.R b/R/parafit.R
index a59e450..a7a5d9e 100644
--- a/R/parafit.R
+++ b/R/parafit.R
@@ -13,6 +13,7 @@ if(is.null(seed)) {
runif(1)
seed <- .Random.seed[trunc(runif(1,1,626))]
}
+HP <- as.matrix(HP)
host.D <- as.matrix(host.D)
host.pc <- pcoa(host.D, correction=correction)
diff --git a/R/phydataplot.R b/R/phydataplot.R
index 1b91e8c..dc28b0f 100644
--- a/R/phydataplot.R
+++ b/R/phydataplot.R
@@ -1,8 +1,8 @@
-## phydataplot.R (2014-01-20)
+## phydataplot.R (2015-07-16)
## Annotate Phylogenies
-## Copyright 2014 Emmanuel Paradis
+## Copyright 2014-2015 Emmanuel Paradis
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
@@ -79,9 +79,11 @@ ring <- function(x, phy, style = "ring", offset = 1, ...)
})
}
-phydataplot <- function(x, phy, style = "bars", offset = 1, ...)
+phydataplot <- function(x, phy, style = "bars", offset = 1, scaling = 1,
+ continuous = FALSE, width = NULL, legend = "below",
+ funcol = rainbow, ...)
{
- style <- match.arg(style, c("bars", "segments", "image", "arrows"))
+ style <- match.arg(style, c("bars", "segments", "image", "arrows", "boxplot", "dotchart", "mosaic"))
lastPP <- get("last_plot.phylo", envir = .PlotPhyloEnv)
circular <- if (lastPP$type %in% c("radial", "fan")) TRUE else FALSE
@@ -89,42 +91,103 @@ phydataplot <- function(x, phy, style = "bars", offset = 1, ...)
one2n <- seq_len(n)
x <- .matchDataPhylo(x, phy)
+ if (scaling != 1)
+ x <- if (is.list(x)) lapply(x, "*", scaling) else scaling * x
+
if (!circular) {
if (lastPP$direction != "rightwards")
stop("for the moment, only rightwards trees are supported")
x0 <- max(lastPP$xx[one2n]) + offset
- if (style != "image") x1 <- x0 + x
+ if (style %in% c("bars", "segments", "arrows")) x1 <- x0 + x
y1 <- lastPP$yy[one2n]
- if (style %in% c("bars", "image")) {
+ if (style %in% c("bars", "image", "boxplot", "dotchart", "mosaic")) {
o <- order(y1)
x <- if (style == "image") x[o, o] else
if (is.vector(x)) x[o] else x[o, ]
}
+ } else {
+ if (style %in% c("image", "boxplot", "dotchart", "mosaic"))
+ stop(paste(dQuote(style), "not implemented with circular trees"))
}
switch(style, bars = {
if (circular)
- stop("style = \"bars\" not implemented with circular trees; see the function 'ring'")
+ stop("style = \"bars\" not implemented with circular trees; see function 'ring'")
if (!is.null(dim(x))) x <- t(x)
barplot(x, width = 1, add = TRUE, horiz = TRUE, offset = x0,
axes = FALSE, axisnames = FALSE, space = c(0.5, rep(0, n - 1)), ...)
px <- pretty(c(0, x))
- axis(1, px + x0, labels = px, line = 1)
+ axis(1, px + x0, labels = px / scaling, line = 1)
}, segments = {
if (circular) ring(x, phy, style, offset, ...)
else segments(x0, y1, x1, y1, ...)
}, image = {
- if (circular)
- stop("style = \"image\" not implemented with circular trees")
if (inherits(x, "DNAbin"))
- stop("object of class \"DNAbin\" not yet supported")
- ##image(x, show.labels = FALSE, add = TRUE, ...)
+ stop('object of class "DNAbin" not supported: use type="mosaic"')
x1 <- seq(x0, lastPP$x.lim[2], length.out = n)
image(x1, y1[o], x, add = TRUE, ...)
mtext(phy$tip.label[o], 1, 1, at = x1, font = lastPP$font,
cex = lastPP$cex, col = lastPP$tip.color)
}, arrows = {
if (circular) ring(x, phy, style, offset, ...)
- else fancyarrows(x0, y1, x1, y1, ...)
+ else fancyarrows(rep(x0, length(y1)), y1, x1, y1, ...)
+ }, boxplot = {
+ if (is.matrix(x)) x <- t(x)
+ o <- boxplot(x, plot = FALSE)
+ mini <- min(o$stats)
+ maxi <- max(o$stats)
+ if (length(o$out)) { # in case there is no outlier
+ mini <- min(o$out, mini)
+ maxi <- max(o$out, maxi)
+ }
+ px <- pretty(c(mini, maxi))
+ x0 <- x0 - mini
+ o$stats <- o$stats + x0
+ o$out <- o$out + x0
+ bxp(o, horizontal = TRUE, add = TRUE, axes = FALSE, ...)
+ axis(1, px + x0, labels = px / scaling, line = 1)
+
+ }, dotchart = {
+ mini <- min(x)
+ maxi <- max(x)
+ x0 <- x0 - mini
+ segments(mini + x0, one2n, maxi + x0, one2n, lty = 3, col = "gray")
+ points(x + x0, 1:n, ...)
+ px <- pretty(x)
+ axis(1, px + x0, labels = px / scaling, line = 1)
+ }, mosaic = {
+ p <- ncol(x)
+ if (is.null(width)) {
+ x1 <- lastPP$x.lim[2]
+ width <- (x1 - x0)/p
+ } else x1 <- x0 + width * p
+ xx <- seq(x0, x1, width)
+ xl <- rep(xx[-length(xx)], each = n)
+ yb <- rep(one2n - 0.5, p)
+ xr <- xl + width
+ yt <- yb + 1
+
+ if (!is.null(labx <- colnames(x)))
+ text(xx[-length(xx)] + width/2, max(yt), labx, adj = c(0.5, -0.5), xpd = TRUE)
+
+ if (continuous) {
+ nux <- if (is.logical(continuous)) 10 else continuous
+ sq <- seq(min(x), max(x), length.out = nux + 1)
+ x <- .bincode(x, sq, FALSE, TRUE)
+ lgd <- paste0("[", sq[-length(sq)], "-", sq[-1], ")")
+ } else {
+ if (is.raw(x)) x <- toupper(as.character(x)) # for DNAbin objects
+ nux <- length(ux <- unique.default(x))
+ x <- match(x, ux)
+ lgd <- as.character(ux)
+ }
+ co <- funcol(nux)
+ rect(xl, yb, xr, yt, col = co[x], xpd = TRUE, ...)
+ if (legend == "below")
+ legend((x0 + x1)/2, -yinch(0.1), lgd, pch = 22, pt.bg = co,
+ pt.cex = 2, bty = "n", xjust = 0.5, yjust = 0.5,
+ horiz = TRUE, xpd = TRUE)
+ else legend(x1, n, lgd, pch = 22, pt.bg = co,
+ pt.cex = 2, bty = "n", yjust = 1, xpd = TRUE)
})
}
diff --git a/R/plot.phylo.R b/R/plot.phylo.R
index fd6f75e..d38ca3a 100644
--- a/R/plot.phylo.R
+++ b/R/plot.phylo.R
@@ -1,4 +1,4 @@
-## plot.phylo.R (2015-02-25)
+## plot.phylo.R (2015-09-20)
## Plot Phylogenies
@@ -16,7 +16,7 @@ plot.phylo <-
label.offset = 0, underscore = FALSE, x.lim = NULL,
y.lim = NULL, direction = "rightwards", lab4ut = NULL,
tip.color = "black", plot = TRUE, rotate.tree = 0,
- open.angle = 0, node.depth = 1, ...)
+ open.angle = 0, node.depth = 1, align.tip.label = FALSE, ...)
{
Ntip <- length(x$tip.label)
if (Ntip < 2) {
@@ -53,6 +53,18 @@ plot.phylo <-
"upwards", "downwards"))
if (is.null(x$edge.length)) use.edge.length <- FALSE
+ if (is.numeric(align.tip.label)) {
+ align.tip.label.lty <- align.tip.label
+ align.tip.label <- TRUE
+ } else { # assumes is.logical(align.tip.labels) == TRUE
+ if (align.tip.label) align.tip.label.lty <- 3
+ }
+
+ if (align.tip.label) {
+ if (type %in% c("unrooted", "radial") || !use.edge.length || is.ultrametric(x))
+ align.tip.label <- FALSE
+ }
+
## the order of the last two conditions is important:
if (type %in% c("unrooted", "radial") || !use.edge.length ||
is.null(x$root.edge) || !x$root.edge) root.edge <- FALSE
@@ -194,7 +206,10 @@ if (phyloORclado) {
alp <- try(uniroot(function(a) max(a*xx.tips + strWi) - pin1,
c(0, 1e6))$root, silent = TRUE)
## if the above fails, give 1/3 of the plot for the tip labels:
- if (is.character(alp)) tmp <- max(xx.tips)*1.5 else {
+ if (is.character(alp)) {
+ tmp <- max(xx.tips)
+ if (show.tip.label) tmp <- tmp * 1.5 # fix by Liam Revell (2015-06-22)
+ } else {
tmp <- if (show.tip.label) max(xx.tips + strWi/alp) else max(xx.tips)
}
if (show.tip.label) tmp <- tmp + label.offset
@@ -220,11 +235,11 @@ if (phyloORclado) {
x.lim <- c(0, x.lim)
if (phyloORclado && !horizontal) x.lim[1] <- 1
if (type %in% c("fan", "unrooted") && show.tip.label)
- x.lim[1] <- -max(nchar.tip.label * 0.018 * max.yy * cex)
+ x.lim[1] <- -max(nchar.tip.label * 0.018 * max.yy * cex)
if (type == "radial")
- x.lim[1] <-
- if (show.tip.label) -1 - max(nchar.tip.label * 0.03 * cex)
- else -1
+ x.lim[1] <-
+ if (show.tip.label) -1 - max(nchar.tip.label * 0.03 * cex)
+ else -1
}
## mirror the xx:
if (phyloORclado && direction == "leftwards") xx <- x.lim[2] - xx
@@ -242,7 +257,10 @@ if (phyloORclado) {
alp <- try(uniroot(function(a) max(a*yy.tips + strWi) - pin2,
c(0, 1e6))$root, silent = TRUE)
## if the above fails, give 1/3 of the device for the tip labels:
- if (is.character(alp)) tmp <- max(yy.tips)*1.5 else {
+ if (is.character(alp)) {
+ tmp <- max(yy.tips)
+ if (show.tip.label) tmp <- tmp * 1.5
+ } else {
tmp <- if (show.tip.label) max(yy.tips + strWi/alp) else max(yy.tips)
}
if (show.tip.label) tmp <- tmp + label.offset
@@ -348,10 +366,26 @@ if (plot) {
if (is.expression(x$tip.label)) underscore <- TRUE
if (!underscore) x$tip.label <- gsub("_", " ", x$tip.label)
- if (phyloORclado)
- text(xx[1:Ntip] + lox, yy[1:Ntip] + loy, x$tip.label, adj = adj,
+ if (phyloORclado) {
+ if (align.tip.label) {
+ xx.tmp <- switch(direction,
+ "rightwards" = max(xx[1:Ntip]),
+ "leftwards" = min(xx[1:Ntip]),
+ "upwards" = xx[1:Ntip],
+ "downwards" = xx[1:Ntip])
+ yy.tmp <- switch(direction,
+ "rightwards" = yy[1:Ntip],
+ "leftwards" = yy[1:Ntip],
+ "upwards" = max(yy[1:Ntip]),
+ "downwards" = min(yy[1:Ntip]))
+ segments(xx[1:Ntip], yy[1:Ntip], xx.tmp, yy.tmp, lty = align.tip.label.lty)
+ } else {
+ xx.tmp <- xx[1:Ntip]
+ yy.tmp <- yy[1:Ntip]
+ }
+ text(xx.tmp + lox, yy.tmp + loy, x$tip.label, adj = adj,
font = font, srt = srt, cex = cex, col = tip.color)
- else {
+ } else {
angle <- if (type == "unrooted") XY$axe else atan2(yy[1:Ntip], xx[1:Ntip]) # in radians
lab4ut <-
@@ -373,40 +407,21 @@ if (plot) {
x$tip.label, adj = c(adj, 0), font = font,
srt = srt, cex = cex, col = tip.color)
} else { # if lab4ut == "axial"
-### adj <- abs(XY$axe) > pi/2
-### srt <- 180 * XY$axe / pi
-### srt[adj] <- srt[adj] - 180
-### adj <- as.numeric(adj)
-### xx.tips <- xx[1:Ntip]
-### yy.tips <- yy[1:Ntip]
-### if (label.offset) {
-### xx.tips <- xx.tips + label.offset * cos(XY$axe)
-### yy.tips <- yy.tips + label.offset * sin(XY$axe)
-### }
-### ## `srt' takes only a single value, so can't vectorize this:
-### ## (and need to 'elongate' these vectors:)
-### font <- rep(font, length.out = Ntip)
-### tip.color <- rep(tip.color, length.out = Ntip)
-### cex <- rep(cex, length.out = Ntip)
-### for (i in 1:Ntip)
-### text(xx.tips[i], yy.tips[i], cex = cex[i],
-### x$tip.label[i], adj = adj[i], font = font[i],
-### srt = srt[i], col = tip.color[i])
-### }
-### }
-### if (type %in% c("fan", "radial")) {
xx.tips <- xx[1:Ntip]
yy.tips <- yy[1:Ntip]
-### angle <- atan2(yy.tips, xx.tips) # in radians
+ if (align.tip.label) {
+ POL <- rect2polar(xx.tips, yy.tips)
+ POL$r[] <- max(POL$r)
+ REC <- polar2rect(POL$r, POL$angle)
+ xx.tips <- REC$x
+ yy.tips <- REC$y
+ segments(xx[1:Ntip], yy[1:Ntip], xx.tips, yy.tips, lty = align.tip.label.lty)
+ }
if (label.offset) {
xx.tips <- xx.tips + label.offset * cos(angle)
yy.tips <- yy.tips + label.offset * sin(angle)
}
-### s <- xx.tips < 0
-### angle <- angle * 180/pi # switch to degrees
-### angle[s] <- angle[s] + 180
-### adj <- as.numeric(s)
- if (type == "unrooted"){
+ if (type == "unrooted") {
adj <- abs(angle) > pi/2
angle <- angle * 180/pi # switch to degrees
angle[adj] <- angle[adj] - 180
@@ -440,7 +455,8 @@ if (plot) {
cex = cex, adj = adj, srt = srt, no.margin = no.margin,
label.offset = label.offset, x.lim = x.lim, y.lim = y.lim,
direction = direction, tip.color = tip.color,
- Ntip = Ntip, Nnode = Nnode, root.time = x$root.time)
+ Ntip = Ntip, Nnode = Nnode, root.time = x$root.time,
+ align.tip.label = align.tip.label)
assign("last_plot.phylo", c(L, list(edge = xe, xx = xx, yy = yy)),
envir = .PlotPhyloEnv)
invisible(L)
@@ -572,10 +588,12 @@ circular.plot <- function(edge, Ntip, Nnode, xx, yy, theta,
feat.arc <- as.list(rep(default, Nnode))
for (k in 1:Nnode) {
tmp <- edge.feat[start[k]]
- feat.arc[[k]] <-
- if (tmp == edge.feat[end[k]]) tmp
- else if (nodedegree[k] == 2)
- rep(c(tmp, edge.feat[end[k]]), each = 50)
+ if (tmp == edge.feat[end[k]]) { # fix by Francois Michonneau (2015-07-24)
+ feat.arc[[k]] <- tmp
+ } else {
+ if (nodedegree[k] == 2)
+ feat.arc[[k]] <- rep(c(tmp, edge.feat[end[k]]), each = 50)
+ }
}
feat.arc
}
diff --git a/R/reorder.phylo.R b/R/reorder.phylo.R
index c820c18..9cf74ed 100644
--- a/R/reorder.phylo.R
+++ b/R/reorder.phylo.R
@@ -1,8 +1,8 @@
-## reorder.phylo.R (2013-09-03)
+## reorder.phylo.R (2015-08-24)
## Internal Reordering of Trees
-## Copyright 2006-2013 Emmanuel Paradis
+## Copyright 2006-2015 Emmanuel Paradis
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
@@ -18,7 +18,9 @@ reorder.phylo <- function(x, order = "cladewise", index.only = FALSE, ...)
if (attr(x, "order") == order)
if (index.only) return(1:nb.edge) else return(x)
nb.node <- x$Nnode
- if (nb.node == 1) return(x)
+ if (nb.node == 1)
+ if (index.only) return(1:nb.edge) else return(x)
+
nb.tip <- length(x$tip.label)
## I'm adding the next check for badly conformed trees to avoid R
diff --git a/R/root.R b/R/root.R
index d0eef6f..5b37875 100644
--- a/R/root.R
+++ b/R/root.R
@@ -1,4 +1,4 @@
-## root.R (2015-04-08)
+## root.R (2015-11-29)
## Root of Phylogenetic Trees
@@ -95,14 +95,20 @@ root <- function(phy, outgroup, node = NULL,
resolve.root = FALSE, interactive = FALSE)
{
if (!inherits(phy, "phylo"))
- stop('object "phy" is not of class "phylo"')
+ stop('object not of class "phylo"')
phy <- reorder(phy)
n <- length(phy$tip.label)
ROOT <- n + 1L
+
if (interactive) {
node <- identify(phy)$nodes
cat("You have set resolve.root =", resolve.root, "\n")
}
+
+ e1 <- phy$edge[, 1L]
+ e2 <- phy$edge[, 2L]
+ wbl <- !is.null(phy$edge.length)
+
if (!is.null(node)) {
if (node <= n)
stop("incorrect node#: should be greater than the number of taxa")
@@ -112,14 +118,16 @@ root <- function(phy, outgroup, node = NULL,
if (is.numeric(outgroup)) {
if (any(outgroup > n))
stop("incorrect taxa#: should not be greater than the number of taxa")
- outgroup <- sort(outgroup) # used below
}
- if (is.character(outgroup))
- outgroup <- which(phy$tip.label %in% outgroup)
+ if (is.character(outgroup)) {
+ outgroup <- match(outgroup, phy$tip.label)
+ if (anyNA(outgroup))
+ stop("specified outgroup not in labels of the tree")
+ }
if (length(outgroup) == n) return(phy)
+ outgroup <- sort(outgroup) # used below
- ## First check that the outgroup is monophyletic--
- ## unless there's only one tip specified of course
+ ## First check that the outgroup is monophyletic, unless it has only one tip
if (length(outgroup) > 1) {
pp <- prop.part(phy)
ingroup <- (1:n)[-outgroup]
@@ -127,7 +135,7 @@ root <- function(phy, outgroup, node = NULL,
for (i in 2:phy$Nnode) {
if (identical(pp[[i]], ingroup)) {
## inverted with the next if (... (2013-06-16)
- newroot <- phy$edge[which(phy$edge[, 2] == i + n), 1]
+ newroot <- e1[which(e2 == i + n)]
break
}
if (identical(pp[[i]], outgroup)) {
@@ -137,201 +145,113 @@ root <- function(phy, outgroup, node = NULL,
}
if (!newroot)
stop("the specified outgroup is not monophyletic")
- } else newroot <- phy$edge[which(phy$edge[, 2] == outgroup), 1]
+ MRCA.outgroup <- i + n
+ } else newroot <- e1[which(e2 == outgroup)]
}
+
N <- Nedge(phy)
oldNnode <- phy$Nnode
+
if (newroot == ROOT) {
- ## assumes length(outgroup) == 1
- if (resolve.root) {
- ## add this check 2015-04-08:
- if (!is.null(node))
- stop("ambiguous resolution of the root node: please specify an explicit outgroup")
- ##
- snw <- which(phy$edge[, 1L] == newroot)
- if (length(snw) > 2) {
- i <- which(phy$edge[, 2L] == outgroup) # see comment above
- j <- snw[snw != i]
- newnod <- oldNnode + n + 1L
- phy$edge[j, 1] <- newnod
-
- ## put the row with the outgroup as the last one in 'edge':
- if (i != N) {
- no <- 1:N
- no <- c(no[-i], i)
- phy$edge <- phy$edge[no, ]
- if (!is.null(phy$edge.length))
- phy$edge.length <- phy$edge.length[no]
+ if (!resolve.root) return(phy) # else (resolve.root == TRUE)
+ if (length(outgroup) > 1) outgroup <- MRCA.outgroup
+ if (!is.null(node))
+ stop("ambiguous resolution of the root node: please specify an explicit outgroup")
+
+ k <- which(e1 == ROOT) # find the basal edges
+ if (length(k) > 2) {
+ i <- which(e2 == outgroup) # outgroup is always of length 1 here
+ j <- k[k != i]
+ newnod <- oldNnode + n + 1L
+ phy$edge[j, 1] <- newnod
+
+ phy$edge <- rbind(c(ROOT, newnod), phy$edge)
+ if (wbl) phy$edge.length <- c(0, phy$edge.length)
+
+ phy$Nnode <- phy$Nnode + 1L
+ }
+ } else {
+ phy$root.edge <- NULL # just in case
+ Nclade <- tabulate(e1)[ROOT] # degree of the root node
+
+ ## if only 2 edges connect to the root, we have to fuse them:
+ fuseRoot <- Nclade == 2
+
+ INV <- logical(N)
+ w <- which(e2 == newroot)
+ anc <- e1[w]
+ i <- w
+
+ nod <- anc
+
+ if (nod != ROOT) {
+ INV[w] <- TRUE
+ i <- w - 1L
+ repeat {
+ if (e2[i] == nod) {
+ if (e1[i] == ROOT) break
+ INV[i] <- TRUE
+ nod <- e1[i]
}
-
- phy$edge <- rbind(c(ROOT, newnod), phy$edge)
- if (!is.null(phy$edge.length))
- phy$edge.length <- c(0, phy$edge.length)
-
- phy$Nnode <- phy$Nnode + 1L
- ## node renumbering (see comments below)
- newNb <- integer(n + oldNnode)
- newNb[newroot] <- n + 1L
- sndcol <- phy$edge[, 2] > n
- phy$edge[sndcol, 2] <- newNb[phy$edge[sndcol, 2]] <- n + 2:phy$Nnode
- phy$edge[, 1] <- newNb[phy$edge[, 1]]
- }
- if (!is.null(phy$node.label)) {
- newNb <- newNb[-(1:n)]
- phy$node.label <- phy$node.label[order(newNb)]
- phy$node.label[is.na(phy$node.label)] <- phy$node.label[1]
- phy$node.label[1] <- "Root"
+ i <- i - 1L
}
}
- return(phy)
- }
- phy$root.edge <- NULL # just in case
- Nclade <- tabulate(phy$edge[, 1])[ROOT] # degree of the root node
- ## if only 2 edges connect to the root, we have to fuse them:
- fuseRoot <- Nclade == 2
-
- start <- which(phy$edge[, 1] == ROOT)
- end <- c(start[-1] - 1, N)
- o <- integer(N)
- INV <- logical(N)
-
- w <- which(phy$edge[, 2] == newroot)
- nod <- phy$edge[w, 1]
- i <- w
- NEXT <- 1L
-
- ## The loop below starts from the new root and goes up in the edge
- ## matrix reversing the edges that need to be as well as well
- ## inverting their order. The other edges must not be changed, so
- ## their indices are stored in `stack'.
- ## We then bind the other edges in a straightforward way.
-
- if (nod != ROOT) {
- ## it is important that the 3 next lines
- ## are inside this "if" statement
- o[NEXT] <- w
- NEXT <- NEXT + 1L
- INV[w] <- TRUE
- i <- w - 1L
- stack <- 0L
- repeat {
- if (phy$edge[i, 2] == nod) {
- if (stack) {
- o[NEXT:(NEXT + stack - 1L)] <- i + 1:stack
- NEXT <- NEXT + stack
- stack <- 0L
- }
- if (phy$edge[i, 1] == ROOT) break
- o[NEXT] <- i
- NEXT <- NEXT + 1L
- INV[i] <- TRUE
- nod <- phy$edge[i, 1]
- } else stack <- stack + 1L
- i <- i - 1L
+ ## we keep the edge leading to the old root if needed:
+ if (!fuseRoot) INV[i] <- TRUE
+
+ ## bind the other clades...
+ for (j in 1:Nclade) {
+ ## do we have to fuse the two basal edges?
+ if (fuseRoot) {
+ k <- which(e1 == ROOT)
+ k <- if (k[2] > w) k[2] else k[1]
+ phy$edge[k, 1] <- phy$edge[i, 2]
+ if (wbl)
+ phy$edge.length[k] <- phy$edge.length[k] + phy$edge.length[i]
+ }
}
- }
-
- ## we keep the edge leading to the old root if needed:
- if (!fuseRoot) {
- o[NEXT] <- i
- INV[i] <- TRUE
- NEXT <- NEXT + 1L
- }
- endOfOutgroup <- which(phy$edge[(w+1):N, 1] < newroot)[1] + w - 1
- if (is.na(endOfOutgroup)) endOfOutgroup <- N
- endOfClade <- end[end >= endOfOutgroup][1]
+ if (fuseRoot) phy$Nnode <- oldNnode - 1L
- ## bind the other clades...
- for (j in 1:Nclade) {
- if (end[j] == endOfClade) next
- ## do we have to fuse the two basal edges?
+ phy$edge[INV, ] <- phy$edge[INV, 2:1]
if (fuseRoot) {
- phy$edge[start[j], 1] <- phy$edge[i, 2]
- if (!is.null(phy$edge.length))
- phy$edge.length[start[j]] <- phy$edge.length[start[j]] + phy$edge.length[i]
- } #else {
- # o[NEXT] <- i#start[j]
- # NEXT <- NEXT + 1L
- #}
- s <- start[j]:end[j]
- ne <- length(s)
- o[NEXT:(NEXT + ne - 1L)] <- s
- NEXT <- NEXT + ne
- }
-
- ## possibly bind the edges below the outgroup till the end of the clade
- if (all(endOfOutgroup != end)) {
- j <- (endOfOutgroup + 1L):endOfClade
- ## we must take care that the branch inversions done above
- ## may have changed the hierarchy of clades here, so we
- ## travel from the bottom of this series of edges
- stack <- 0L
- inverted <- phy$edge[INV, 1] # <- fails if ', 2]' is used
- for (k in rev(j)) {
- if (any(phy$edge[k, 1] == inverted)) {
- o[NEXT] <- k
- NEXT <- NEXT + 1L
- if (stack){
- o[NEXT:(NEXT + stack - 1L)] <- (k + 1L):(k + stack)
- NEXT <- NEXT + stack
- stack <- 0L
- }
- } else stack <- stack + 1L
+ phy$edge <- phy$edge[-i, ]
+ if (wbl) phy$edge.length <- phy$edge.length[-i]
+ N <- N - 1L
}
- }
-
- ## ... and the outgroup
- s <- (w + 1L):endOfOutgroup
- ne <- length(s)
- o[NEXT:(NEXT + ne - 1L)] <- s
- if (fuseRoot) {
- phy$Nnode <- oldNnode - 1L
- N <- N - 1L
- }
- phy$edge[INV, ] <- phy$edge[INV, 2:1]
- phy$edge <- phy$edge[o, ]
- if (!is.null(phy$edge.length))
- phy$edge.length <- phy$edge.length[o]
-
- if (resolve.root) {
- newnod <- oldNnode + n + 1
- if (length(outgroup) == 1L) {
- wh <- which(phy$edge[, 2] == outgroup)
- phy$edge[1] <- newnod
- phy$edge <-
- rbind(c(newroot, newnod), phy$edge[-wh, ], phy$edge[wh, ])
- snw <- which(phy$edge[, 1] == newroot)
- phy$edge[snw[length(snw) - 1], 1] <- newnod
- if (!is.null(phy$edge.length)) {
- phy$edge.length <-
- c(0, phy$edge.length[-wh], phy$edge.length[wh])
- }
- } else {
- wh <- which(phy$edge[, 1] == newroot)
- phy$edge[wh[-1], 1] <- newnod
- s1 <- 1:(wh[2] - 1)
- s2 <- wh[2]:N
- phy$edge <-
- rbind(phy$edge[s1, ], c(newroot, newnod), phy$edge[s2, ])
- if (!is.null(phy$edge.length)) {
- phy$edge.length <-
- c(phy$edge.length[s1], 0, phy$edge.length[s2])
+ if (resolve.root) {
+ newnod <- oldNnode + n + 1L
+ if (length(outgroup) == 1L) {
+ wh <- which(phy$edge[, 2] == outgroup)
+ #phy$edge[1] <- newnod
+ k <- which(phy$edge[, 1] == newroot) # wh should be among k
+ phy$edge[k[k != wh], 1] <- newnod
+ o <- c((1:N)[-wh], wh)
+ phy$edge <- rbind(c(newroot, newnod), phy$edge[o, ])
+ if (wbl) phy$edge.length <- c(0, phy$edge.length[o])
+ } else {
+ wh <- which(phy$edge[, 1] == newroot)
+ phy$edge[wh[-1], 1] <- newnod
+ s1 <- 1:(wh[2] - 1)
+ s2 <- wh[2]:N
+ phy$edge <-
+ rbind(phy$edge[s1, ], c(newroot, newnod), phy$edge[s2, ])
+ if (wbl)
+ phy$edge.length <- c(phy$edge.length[s1], 0, phy$edge.length[s2])
}
+ phy$Nnode <- phy$Nnode + 1L
}
- ## N <- N + 1L ... not needed
- phy$Nnode <- phy$Nnode + 1L
}
## The block below renumbers the nodes so that they conform
## to the "phylo" format
- newNb <- integer(n + oldNnode)
+ newNb <- integer(n + phy$Nnode)
newNb[newroot] <- n + 1L
sndcol <- phy$edge[, 2] > n
- ## executed from right to left, so newNb is modified before phy$edge:
- phy$edge[sndcol, 2] <- newNb[phy$edge[sndcol, 2]] <- n + 2:phy$Nnode
+ newNb[sort(phy$edge[sndcol, 2])] <- n + 2:phy$Nnode
+ phy$edge[sndcol, 2] <- newNb[phy$edge[sndcol, 2]]
phy$edge[, 1] <- newNb[phy$edge[, 1]]
if (!is.null(phy$node.label)) {
@@ -344,9 +264,8 @@ root <- function(phy, outgroup, node = NULL,
if (resolve.root) {
phy$node.label[is.na(phy$node.label)] <- phy$node.label[1]
phy$node.label[1] <- "Root"
- ##phy$node.label <- c(phy$node.label[1], NA, phy$node.label[-1])
- ##phy$node.label <- c("NA", phy$node.label)
}
}
- phy
+ attr(phy, "order") <- NULL
+ reorder.phylo(phy)
}
diff --git a/R/rtt.R b/R/rtt.R
index 3be78db..14095ce 100644
--- a/R/rtt.R
+++ b/R/rtt.R
@@ -1,55 +1,55 @@
-## rtt.R (2014-06-16)
+## rtt.R (2015-07-16)
## Root a tree by root-to-tip regression
-## Copyright (c) 2014, Rosemary McCloskey, BC Centre for Excellence in HIV/AIDS
+## Copyright (c) 2014-2015, Rosemary McCloskey, BC Centre for Excellence in HIV/AIDS
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
-rtt <- function(t, tip.dates, ncpu = 1, objective = "correlation", opt.tol = .Machine$double.eps^0.25)
-{
- ## These are objective functions which can be used to evaluate the "goodness" of
- ## a regression fit.
- if (objective == "correlation")
+rtt <- function (t, tip.dates, ncpu = 1, objective = "correlation",
+ opt.tol = .Machine$double.eps^0.25) {
+ if (objective == "correlation")
objective <- function(x, y) cor.test(y, x)$estimate
- else if (objective == "rsquared")
+ else if (objective == "rsquared")
objective <- function(x, y) summary(lm(y ~ x))$r.squared
- else if (objective == "rms")
+ else if (objective == "rms")
objective <- function(x, y) -summary(lm(y ~ x))$sigma^2
- else
- stop('objective must be one of "correlation", "rsquared", or "rms"')
-
- t <- unroot(t)
- dist <- dist.nodes(t)[, 1:(t$Nnode + 2)]
-
- ## Do root-to-tip regressions for every possible choice of root.
- fits <- if (ncpu > 1)
- unlist(parallel::mclapply(1:nrow(dist), function(row) objective(tip.dates, dist[row, ]),
- mc.cores = ncpu))
- else unlist(lapply(1:nrow(dist), function(row) objective(tip.dates, dist[row, ])))
-
- ## Find the best one (highest value of objective function).
- fit.edge <- apply(t$edge, 2, function(e) fits[e])
- obj.edge <- apply(fit.edge, 1, mean)
- ## Compatibility with Path-O-Gen: find the last maximum, not the first.
- best.edge <- length(obj.edge) - which.max(rev(obj.edge)) + 1
- best.edge.parent <- t$edge[best.edge, 1]
- best.edge.child <- t$edge[best.edge, 2]
- best.edge.length <- t$edge.length[best.edge]
-
- ## Find the best location on that edge.
- f <- function(x) {
- dist <- x * dist[best.edge.parent, ] + (1 - x) * dist[best.edge.child, ]
- objective(tip.dates, dist)
+ else stop("objective must be one of \"correlation\", \"rsquared\", or \"rms\"")
+
+ ut <- unroot(t)
+ dist <- dist.nodes(ut)[, 1:(ut$Nnode + 2)]
+
+ f <- function (x, parent, child) {
+ edge.dist <- x * dist[parent, ] + (1 - x) * dist[child,]
+ objective(tip.dates, edge.dist)
}
- best.pos <- optimize(f, c(0, 1), maximum = TRUE, tol = opt.tol)$maximum
- ## Reroot the tree at the optimal location
- new.root <- list(edge = matrix(c(2L, 1L), 1, 2), tip.label = "new.root", edge.length = 1, Nnode = 1L, root.edge = 1)
+ obj.edge <- if (ncpu > 1)
+ unlist(parallel::mclapply(1:nrow(ut$edge), function (e) {
+ opt.fun <- function (x) f(x, ut$edge[e,1], ut$edge[e,2])
+ optimize(opt.fun, c(0, 1), maximum = TRUE, tol = opt.tol)$objective
+ }, mc.cores=ncpu))
+ else apply(ut$edge, 1, function (e) {
+ opt.fun <- function (x) f(x, e[1], e[2])
+ optimize(opt.fun, c(0, 1), maximum = TRUE, tol = opt.tol)$objective
+ })
+
+ best.edge <- which.max(obj.edge)
+
+ best.edge.parent <- ut$edge[best.edge, 1]
+ best.edge.child <- ut$edge[best.edge, 2]
+ best.edge.length <- ut$edge.length[best.edge]
+
+ opt.fun <- function (x) f(x, best.edge.parent, best.edge.child)
+ best.pos <- optimize(opt.fun, c(0, 1), maximum = TRUE, tol = opt.tol)$maximum
+
+ new.root <- list(edge = matrix(c(2L, 1L), 1, 2), tip.label = "new.root",
+ edge.length = 1, Nnode = 1L, root.edge = 1)
class(new.root) <- "phylo"
- t <- bind.tree(t, new.root, where = best.edge.child, position = best.pos * best.edge.length)
- t <- collapse.singles(t)
- t <- root(t, "new.root")
- drop.tip(t, "new.root")
+ ut <- bind.tree(ut, new.root, where = best.edge.child, position = best.pos *
+ best.edge.length)
+ ut <- collapse.singles(ut)
+ ut <- root(ut, "new.root")
+ drop.tip(ut, "new.root")
}
diff --git a/build/vignette.rds b/build/vignette.rds
index dd76fc1..9c3179d 100644
Binary files a/build/vignette.rds and b/build/vignette.rds differ
diff --git a/data/hivtree.newick.rda b/data/hivtree.newick.rda
index 1662abc..0c7420c 100644
Binary files a/data/hivtree.newick.rda and b/data/hivtree.newick.rda differ
diff --git a/data/landplants.newick.rda b/data/landplants.newick.rda
index 1f40b47..62e1bee 100644
Binary files a/data/landplants.newick.rda and b/data/landplants.newick.rda differ
diff --git a/data/opsin.newick.rda b/data/opsin.newick.rda
index e7089dc..8fa6439 100644
Binary files a/data/opsin.newick.rda and b/data/opsin.newick.rda differ
diff --git a/inst/doc/MoranI.pdf b/inst/doc/MoranI.pdf
index 4e5b25e..70ba2bb 100644
Binary files a/inst/doc/MoranI.pdf and b/inst/doc/MoranI.pdf differ
diff --git a/man/DNAbin2indel.Rd b/man/DNAbin2indel.Rd
new file mode 100644
index 0000000..3e237d7
--- /dev/null
+++ b/man/DNAbin2indel.Rd
@@ -0,0 +1,28 @@
+\name{DNAbin2indel}
+\alias{DNAbin2indel}
+\title{Recode Blocks of Indels}
+\description{
+ This function scans a set of aligned DNA sequences and returns a
+ matrix with information of the localisations and lengths on alignment
+ gaps.
+}
+\usage{
+DNAbin2indel(x)
+}
+\arguments{
+ \item{x}{an object of class \code{"DNAbin"}.}
+}
+\details{
+ The output matrix has the same dimensions than the input one with,
+ either a numeric value where an alignment gap starts giving the length
+ of the gap, or zero. The rownames are kept.
+}
+\value{
+ a numeric matrix.
+}
+\author{Emmanuel Paradis}
+\seealso{
+ \code{\link{DNAbin}}, \code{\link{as.DNAbin}}, \code{\link{del.gaps}},
+ \code{\link{seg.sites}}, \code{\link{image.DNAbin}}
+}
+\keyword{manip}
diff --git a/man/LTT.Rd b/man/LTT.Rd
index 7d76b17..db2ce35 100644
--- a/man/LTT.Rd
+++ b/man/LTT.Rd
@@ -48,6 +48,9 @@ LTT(birth = 0.1, death = 0, N = 100, Tmax = 50, PI = 95,
Paradis, E. (2011) Time-dependent speciation and extinction from
phylogenies: a least squares approach. \emph{Evolution}, \bold{65},
661--672.
+
+ Paradis, E. (2015) Random phylogenies and the distribution of
+ branching times. In revision.
}
\author{Emmanuel Paradis}
\seealso{
diff --git a/man/alex.Rd b/man/alex.Rd
index 92176e0..6a84b34 100644
--- a/man/alex.Rd
+++ b/man/alex.Rd
@@ -33,7 +33,7 @@ alex(x, ...)
\value{NULL}
\author{Emmanuel Paradis}
\seealso{
- \code{\link{image.DNAbin}}, \code{\link{trex}}
+ \code{\link{image.DNAbin}}, \code{\link{trex}}, \code{\link{alview}}
}
\examples{
\dontrun{
diff --git a/man/alview.Rd b/man/alview.Rd
new file mode 100644
index 0000000..e2558bc
--- /dev/null
+++ b/man/alview.Rd
@@ -0,0 +1,32 @@
+\name{alview}
+\alias{alview}
+\title{Print DNA Sequence Alignements}
+\description{
+ This function displays in the console or a file an alignment of DNA sequences. The first sequence is printed on the first row and the bases of the other sequences are replaced by dots if they are identical with the first sequence.
+}
+\usage{
+alview(x, file = "", uppercase = TRUE)
+}
+\arguments{
+ \item{x}{a matrix or a list of DNA sequences (class \code{"DNAbin"}).}
+ \item{file}{a character string giving the name of the file where to print the sequences; by default, they are printed in the console.}
+ \item{uppercase}{a logical specifying whether to print the bases as uppercase letters.}
+}
+\details{
+The first line of the output shows the position of the last column of the printed alignment.
+}
+\author{Emmanuel Paradis}
+\seealso{
+ \code{\link{DNAbin}}, \code{\link{image.DNAbin}}, \code{\link{alex}},
+ \code{\link{clustal}}
+}
+\examples{
+data(woodmouse)
+alview(woodmouse[, 1:50])
+alview(woodmouse[, 1:50], uppercase = FALSE)
+\dontrun{
+alview(woodmouse, file = "woodmouse.txt")
+}
+}
+\keyword{IO}
+
diff --git a/man/ape-internal.Rd b/man/ape-internal.Rd
index dbcb1c9..32de966 100644
--- a/man/ape-internal.Rd
+++ b/man/ape-internal.Rd
@@ -45,6 +45,7 @@
\alias{C_ultrametric}
\alias{C_where}
\alias{GlobalDeletionDNA}
+\alias{DNAbin2indelblock}
\alias{SegSites}
\alias{bipartition}
\alias{delta_plot}
diff --git a/man/as.phylo.Rd b/man/as.phylo.Rd
index 09af082..4912a30 100644
--- a/man/as.phylo.Rd
+++ b/man/as.phylo.Rd
@@ -70,9 +70,7 @@ new2old.phylo(phy)
data(bird.orders)
hc <- as.hclust(bird.orders)
tr <- as.phylo(hc)
-all.equal(bird.orders, tr) # FALSE, but...
-tr$edge.length <- 2 * tr$edge.length
-all.equal(bird.orders, tr) # ... TRUE
+all.equal(bird.orders, tr) # TRUE
### shows the three plots for tree objects:
dend <- as.dendrogram(hc)
@@ -82,13 +80,13 @@ plot(hc)
par(mar = c(8, 0, 0, 0)) # leave space for the labels
plot(dend)
-### how to get (nearly) identical plots with
+### how to get identical plots with
### plot.phylo and plot.dendrogram:
layout(matrix(1:2, 2, 1))
-plot(bird.orders, font = 1, no.margin = TRUE)
+plot(bird.orders, font = 1, no.margin = TRUE, label.offset = 0.4)
par(mar = c(0, 0, 0, 8))
plot(dend, horiz = TRUE)
-layout(matrix(1))
+layout(1)
\dontrun{
### convert into networks:
diff --git a/man/checkValidPhylo.Rd b/man/checkValidPhylo.Rd
new file mode 100644
index 0000000..bae4313
--- /dev/null
+++ b/man/checkValidPhylo.Rd
@@ -0,0 +1,29 @@
+\name{checkValidPhylo}
+\alias{checkValidPhylo}
+\title{Check the Structure of a "phylo" Object}
+\description{
+ This function takes as single argument an object (phy), checks its
+ elements, and prints a diagnostic. All problems are printed with a
+ label: FATAL (will likely cause an error or a crash) or MODERATE (may
+ cause some problems).
+
+ This function is mainly intended for developers creating
+ \code{"phylo"} objects from scratch.
+}
+\usage{
+checkValidPhylo(phy)
+}
+\arguments{
+ \item{phy}{an object of class \code{"phylo"}.}
+}
+\value{
+ NULL.
+}
+\author{Emmanuel Paradis}
+\examples{
+tr <- rtree(3)
+checkValidPhylo(tr)
+tr$edge[1] <- 0
+checkValidPhylo(tr)
+}
+\keyword{manip}
diff --git a/man/clustal.Rd b/man/clustal.Rd
index afb8d73..fc5b843 100644
--- a/man/clustal.Rd
+++ b/man/clustal.Rd
@@ -1,5 +1,6 @@
\name{clustal}
\alias{clustal}
+\alias{clustalomega}
\alias{muscle}
\alias{tcoffee}
\title{Multiple Sequence Alignment with External Applications}
@@ -11,6 +12,7 @@
clustal(x, pw.gapopen = 10, pw.gapext = 0.1,
gapopen = 10, gapext = 0.2, exec = NULL,
MoreArgs = "", quiet = TRUE, original.ordering = TRUE)
+clustalomega(x, exec = NULL, MoreArgs = "", quiet = TRUE)
muscle(x, exec = "muscle", MoreArgs = "", quiet = TRUE,
original.ordering = TRUE)
tcoffee(x, exec = "t_coffee", MoreArgs = "", quiet = TRUE,
@@ -34,7 +36,10 @@ tcoffee(x, exec = "t_coffee", MoreArgs = "", quiet = TRUE,
\code{clustal} tries to guess the name of the executable program
depending on the operating system. Specifically, the followings are
used: ``clustalw'' under Linux, ``clustalw2'' under MacOS, or
- ``C:/Program Files/ClustalW2/clustalw2'' under Windows.
+ ``clustalw2.exe'' under Windows.
+
+ For \code{clustalomega}, ``clustalo'' is the default on all systems
+ (with no specific path) since it seems there is no Windows installer.
The calculations are done in a temporary directory which is deleted
when \R is quit. So it is possible to find the files created by the
@@ -63,13 +68,20 @@ tcoffee(x, exec = "t_coffee", MoreArgs = "", quiet = TRUE,
method for multiple sequence alignments. \emph{Journal of Molecular
Biology}, \bold{302}, 205--217.
\url{http://www.tcoffee.org/Documentation/t_coffee/t_coffee_technical.htm}
+
+ Sievers, F., Wilm, A., Dineen, D., Gibson, T. J., Karplus, K., Li, W.,
+ Lopez, R., McWilliam, H., Remmert, M., S\"oding, J., Thompson,
+ J. D. and Higgins, D. G. (2011) Fast, scalable generation of
+ high-quality protein multiple sequence alignments using Clustal
+ Omega. \emph{Molecular Systems Biology}, \bold{7}, 539.
}
\author{Emmanuel Paradis}
\seealso{
- \code{\link{image.DNAbin}}, \code{\link{del.gaps}}, \code{\link{alex}}
+ \code{\link{image.DNAbin}}, \code{\link{del.gaps}},
+ \code{\link{alex}}, \code{\link{alview}}
- The package \pkg{phyloch} which has similar functions for the MAFFT
- and Prank.
+ The package \pkg{ips} which has similar functions for MAFFT and
+ Prank.
}
\examples{
\dontrun{
diff --git a/man/collapse.singles.Rd b/man/collapse.singles.Rd
index ecfa0ec..c7d22de 100644
--- a/man/collapse.singles.Rd
+++ b/man/collapse.singles.Rd
@@ -1,21 +1,45 @@
\name{collapse.singles}
\alias{collapse.singles}
\title{Collapse Single Nodes}
+\description{
+ This function deletes the single nodes (i.e., with a single
+ descendant) in a tree.
+}
\usage{
-collapse.singles(tree)
+collapse.singles(tree, root.edge = FALSE)
}
\arguments{
\item{tree}{an object of class \code{"phylo"}.}
-}
-\description{
- This function deletes the single nodes (i.e., with a single
- descendant) in a tree.
+ \item{root.edge}{whether to get the singleton edges from the root
+ until the first bifurcating node and put them as \code{root.edge} of
+ the returned tree. By default, this is ignored or if the tree has no
+ edge lengths (see examples).}
}
\value{
an object of class \code{"phylo"}.
}
-\author{Ben Bolker}
+\author{Emmanuel Paradis}
\seealso{
\code{\link{plot.phylo}}, \code{\link{read.tree}}
}
+\examples{
+## a tree with 3 tips and 3 nodes:
+e <- c(4L, 6L, 6L, 5L, 5L, 6L, 1L, 5L, 3L, 2L)
+dim(e) <- c(5, 2)
+tr <- structure(list(edge = e, tip.label = LETTERS[1:3], Nnode = 3L),
+ class = "phylo")
+tr
+## the following shows that node #4 (ie, the root) is a singleton
+## and node #6 is the first bifurcating node
+tr$edge
+## Normally, a tree has less nodes than it has tips:
+## > plot(tr)
+## Error in plot.phylo(tr) :
+## there are single (non-splitting) nodes in your tree;
+## you may need to use collapse.singles()
+collapse.singles(tr) # only 2 nodes
+## give branch lengths to use the 'root.edge' option:
+tr$edge.length <- runif(5)
+str(collapse.singles(tr, TRUE)) # has a 'root.edge'
+}
\keyword{manip}
diff --git a/man/image.DNAbin.Rd b/man/image.DNAbin.Rd
index 6ad2210..0b011fb 100644
--- a/man/image.DNAbin.Rd
+++ b/man/image.DNAbin.Rd
@@ -44,7 +44,7 @@
\author{Emmanuel Paradis}
\seealso{
\code{\link{DNAbin}}, \code{\link{del.gaps}}, \code{\link{alex}},
- \code{\link{clustal}}, \code{\link[graphics]{grid}}
+ \code{\link{alview}}, \code{\link{clustal}}, \code{\link[graphics]{grid}}
}
\examples{
data(woodmouse)
diff --git a/man/label2table.Rd b/man/label2table.Rd
new file mode 100644
index 0000000..55aaf4c
--- /dev/null
+++ b/man/label2table.Rd
@@ -0,0 +1,47 @@
+\name{label2table}
+\alias{label2table}
+\alias{stripLabel}
+\alias{abbreviateGenus}
+\title{Label Management}
+\description{
+ These functions work on a vector of character strings storing bi- or trinomial species names, typically ``Genus_species_subspecies''.
+}
+\usage{
+label2table(x, sep = NULL, as.is = FALSE)
+stripLabel(x, species = FALSE, subsp = TRUE, sep = NULL)
+abbreviateGenus(x, genus = TRUE, species = FALSE, sep = NULL)
+}
+\arguments{
+ \item{x}{a vector of mode character.}
+ \item{sep}{the separator (a single character) between the taxonomic levels (see details).}
+ \item{as.is}{a logical specifying whether to convert characters into factors (like in \code{\link[utils]{read.table}}).}
+ \item{species, subsp, genus}{a logical specifying whether the taxonomic level is concerned by the operation.}
+}
+\details{
+\code{label2table} returns a data frame with three columns named ``genus'', ``species'', and ``subspecies'' (with \code{NA} if the level is missing).
+
+\code{stripLabel} deletes the subspecies names from the input. If \code{species = TRUE}, the species names are also removed, thus returning only the genus names.
+
+\code{abbreviateGenus} abbreviates the genus names keeping only the first letter. If \code{species = TRUE}, the species names are abbreviated.
+
+By default, these functions try to guess what is the separator between the genus, species and/or subspecies names. If an underscore is present in the input, then this character is assumed to be the separator; otherwise, a space. If this does not work, you can specify \code{sep} to its appropriate value.
+}
+\value{
+ A vector of mode character or a data frame.
+}
+\author{Emmanuel Paradis}
+\seealso{
+ \code{\link{makeLabel}}, \code{\link{makeNodeLabel}},
+ \code{\link{mixedFontLabel}}
+}
+\examples{
+x <- c("Panthera_leo", "Panthera_pardus", "Panthera_onca", "Panthera_uncia",
+ "Panthera_tigris_altaica", "Panthera_tigris_amoyensis")
+label2table(x)
+stripLabel(x)
+stripLabel(x, TRUE)
+abbreviateGenus(x)
+abbreviateGenus(x, species = TRUE)
+abbreviateGenus(x, genus = FALSE, species = TRUE)
+}
+\keyword{manip}
diff --git a/man/makeLabel.Rd b/man/makeLabel.Rd
index be99abd..11abf77 100644
--- a/man/makeLabel.Rd
+++ b/man/makeLabel.Rd
@@ -61,7 +61,7 @@ makeLabel(x, ...)
\seealso{
\code{\link{makeNodeLabel}}, \code{\link[base]{make.unique}},
\code{\link[base]{make.names}}, \code{\link[base]{abbreviate}},
- \code{\link{mixedFontLabel}}
+ \code{\link{mixedFontLabel}}, \code{\link{label2table}}
}
\examples{
x <- rep("a", 3)
diff --git a/man/makeNodeLabel.Rd b/man/makeNodeLabel.Rd
index b48ea13..9d22c64 100644
--- a/man/makeNodeLabel.Rd
+++ b/man/makeNodeLabel.Rd
@@ -51,7 +51,7 @@ makeNodeLabel(phy, method = "number", prefix = "Node", nodeList = list(), ...)
\author{Emmanuel Paradis \email{Emmanuel.Paradis at mpl.ird.fr}}
\seealso{
\code{\link{makeLabel}}, \code{\link[base]{grep}},
- \code{\link{mixedFontLabel}}
+ \code{\link{mixedFontLabel}}, \code{\link{label2table}}
}
\examples{
tr <-
diff --git a/man/mixedFontLabel.Rd b/man/mixedFontLabel.Rd
index d4b6267..1455ff2 100644
--- a/man/mixedFontLabel.Rd
+++ b/man/mixedFontLabel.Rd
@@ -45,7 +45,7 @@ mixedFontLabel(..., sep = " ", italic = NULL, bold = NULL,
\author{Emmanuel Paradis}
\seealso{
\code{\link{makeLabel}}, \code{\link{makeNodeLabel}},
- \code{taxo.fonts} in package \pkg{phyloch} for fancy alignments
+ \code{\link{label2table}}
}
\examples{
tr <- read.tree(text = "((a,(b,c)),d);")
diff --git a/man/phydataplot.Rd b/man/phydataplot.Rd
index 10de7d4..e4fe61d 100644
--- a/man/phydataplot.Rd
+++ b/man/phydataplot.Rd
@@ -9,7 +9,9 @@
Both functions match the data with the labels of the tree.
}
\usage{
-phydataplot(x, phy, style = "bars", offset = 1, ...)
+phydataplot(x, phy, style = "bars", offset = 1, scaling = 1,
+ continuous = FALSE, width = NULL, legend = "below",
+ funcol = rainbow, ...)
ring(x, phy, style = "ring", offset = 1, ...)
}
\arguments{
@@ -18,12 +20,33 @@ ring(x, phy, style = "ring", offset = 1, ...)
\item{style}{a character string specifying the type of graphics; can
be abbreviated (see details).}
\item{offset}{the space between the tips of the tree and the plot.}
+ \item{scaling}{the scaling factor to apply to the data.}
+ \item{continuous}{(used if style="mosaic") a logical specifying
+ whether to treat the values in \code{x} as continuous or not; can be
+ an integer value giving the number of categories.}
+ \item{width}{(used if style = "mosaic") the width of the cells; by
+ default, all the available space is used.}
+ \item{legend}{(used if style = "mosaic") the place where to draw the
+ legend; if not the default, the legend is drawn besides the mosaic.}
+ \item{funcol}{(used if style = "mosaic") the function used to generate
+ the colours (see details and examples).}
\item{\dots}{further arguments passed to the graphical functions.}
}
\details{
The possible values for \code{style} are ``bars'', ``segments'',
- ``image'', or ``arrows'' for \code{phydataplot}, and ``ring'',
- ``segments'', or ``arrows'' for \code{ring}.
+ ``image'', ``arrows'', ``boxplot'', ``dotchart'', or ``mosaic'' for
+ \code{phydataplot}, and ``ring'', ``segments'', or ``arrows'' for
+ \code{ring}.
+
+ \code{style = "image"} works only with square matrices (e.g.,
+ similarities). If you want to plot a DNA alignment in the same way
+ than \code{\link{image.DNAbin}}, try \code{style = "mosaic"}.
+
+ \code{style = "mosaic"} can plot any kind of matrices, possibly after
+ discretizing its values (using \code{continuous}). The default colour
+ palette is taken from the function \code{\link[grDevices]{rainbow}}.
+ If you want to use specified colours, a function simply returning the
+ vector of colours must be used (see examples).
}
\note{
For the moment, only rightwards trees are supported (does not apply to
@@ -48,10 +71,10 @@ phydataplot(sample(x), tr, "s", lwd = 3, lty = 3)
plot(tr, "f", x.l = c(-11, 11), y.l = c(-11, 11))
phydataplot(x, tr, "s")
-## leave more space with x.lim to show 2 barplots:
+## leave more space with x.lim to show a barplot and a dotchart:
plot(tr, x.lim = 22)
-phydataplot(x, tr, "b")
-phydataplot(x, tr, "b", offset = 12, col = "yellow")
+phydataplot(x, tr, col = "yellow")
+phydataplot(x, tr, "d", offset = 13)
ts <- rcoal(N <- 100)
X <- rTraitCont(ts) # names are set
@@ -112,5 +135,40 @@ phydataplot(X, tx, col = co, offset = 0.05, border = NA)
plot(tx, "f", show.tip.label = FALSE, open.angle = 180)
ring(X, tx, col = co, offset = 0.05)
+
+Z <- matrix(rnorm(m * 5), m)
+rownames(Z) <- rownames(X)
+plot(tx, x.lim = 5)
+phydataplot(Z, tx, "bo", scaling = .5, offset = 0.5,
+ boxfill = c("gold", "skyblue"))
+
+## plot an alignment with a NJ tree:
+data(woodmouse)
+trw <- nj(dist.dna(woodmouse))
+plot(trw, x.lim = 0.1, align.tip = TRUE, font = 1)
+phydataplot(woodmouse[, 1:50], trw, "m", 0.02, border = NA)
+
+## use type = "mosaic" on a 30x5 matrix:
+tr <- rtree(n <- 30)
+p <- 5
+x <- matrix(sample(3, size = n*p, replace = TRUE), n, p)
+dimnames(x) <- list(paste0("t", 1:n), LETTERS[1:p])
+plot(tr, x.lim = 35, align.tip = TRUE, adj = 1)
+phydataplot(x, tr, "m", 2)
+## change the aspect:
+plot(tr, x.lim = 35, align.tip = TRUE, adj = 1)
+phydataplot(x, tr, "m", 2, width = 2, border = "white", lwd = 3, legend = "side")
+## user-defined colour:
+f <- function(n) c("yellow", "blue", "red")
+phydataplot(x, tr, "m", 18, width = 2, border = "white", lwd = 3,
+ legend = "side", funcol = f)
+
+## use continuous = TRUE with two different scales:
+x[] <- 1:(n*p)
+plot(tr, x.lim = 35, align.tip = TRUE, adj = 1)
+phydataplot(x, tr, "m", 2, width = 1.5, continuous = TRUE, legend = "side",
+ funcol = colorRampPalette(c("white", "darkgreen")))
+phydataplot(x, tr, "m", 18, width = 1.5, continuous = 5, legend = "side",
+ funcol = topo.colors)
}
\keyword{aplot}
diff --git a/man/plot.phylo.Rd b/man/plot.phylo.Rd
index 2934cf6..4c5cef3 100644
--- a/man/plot.phylo.Rd
+++ b/man/plot.phylo.Rd
@@ -14,7 +14,8 @@
root.edge = FALSE, label.offset = 0, underscore = FALSE,
x.lim = NULL, y.lim = NULL, direction = "rightwards",
lab4ut = NULL, tip.color = "black", plot = TRUE,
- rotate.tree = 0, open.angle = 0, node.depth = 1, ...)
+ rotate.tree = 0, open.angle = 0, node.depth = 1,
+ align.tip.label = FALSE, ...)
\method{plot}{multiPhylo}(x, layout = 1, ...)
}
\arguments{
@@ -109,6 +110,10 @@
not used to plot the tree; 1: the node depths are proportional to
the number of tips descending from each node (the default and was the
only possibility previously), 2: they are evenly spaced.}
+ \item{align.tip.label}{a logical value or an integer. If \code{TRUE},
+ the tips are aligned and dotted lines are drawn between the tips of
+ the tree and the labels. If an integer, the tips are aligned and
+ this gives the type of the lines (\code{lty}).}
\item{layout}{the number of trees to be plotted simultaneously.}
\item{\dots}{further arguments to be passed to \code{plot} or to
\code{plot.phylo}.}
@@ -147,6 +152,9 @@
give a nice result: the user may check these values with the
(invisibly) returned list (see ``Value:'').
+ If you use \code{align.tip.label = TRUE} with \code{type = "fan"}, you
+ will have certainly to set \code{x.lim} and \code{y.lim} manually.
+
If you resize manually the graphical device (windows or X11) you may
need to replot the tree.
}
@@ -176,6 +184,7 @@
\item{Ntip}{}
\item{Nnode}{}
\item{root.time}{}
+ \item{align.tip.label}{}
}
\author{Emmanuel Paradis}
\seealso{
diff --git a/man/rlineage.Rd b/man/rlineage.Rd
index 1f7299f..6886930 100644
--- a/man/rlineage.Rd
+++ b/man/rlineage.Rd
@@ -85,6 +85,7 @@ drop.fossil(phy, tol = 1e-8)
\code{\link{rtree}}, \code{\link{stree}}
}
\examples{
+set.seed(10)
plot(rlineage(0.1, 0)) # Yule process with lambda = 0.1
plot(rlineage(0.1, 0.05)) # simple birth-death process
b <- function(t) 1/(1 + exp(0.2*t - 1)) # logistic
diff --git a/src/ape.c b/src/ape.c
index 81f10c9..c76caa8 100644
--- a/src/ape.c
+++ b/src/ape.c
@@ -1,6 +1,6 @@
-/* ape.c 2014-01-02 */
+/* ape.c 2015-10-15 */
-/* Copyright 2011-2014 Emmanuel Paradis, and 2007 R Development Core Team */
+/* Copyright 2011-2015 Emmanuel Paradis, and 2007 R Development Core Team */
/* This file is part of the R-package `ape'. */
/* See the file ../COPYING for licensing issues. */
@@ -78,6 +78,7 @@ void C_where(unsigned char *x, unsigned char *pat, int *s, int *p,
void bitsplits_phylo(int *n, int *m, int *e, int *N, int *nr, unsigned char *mat);
void CountBipartitionsFromTrees(int *n, int *m, int *e, int *N, int *nr, int *nc,
unsigned char *mat, double *freq);
+void DNAbin2indelblock(unsigned char *x, int *n, int *s, int *y);
SEXP bipartition(SEXP edge, SEXP nbtip, SEXP nbnode);
SEXP prop_part(SEXP TREES, SEXP nbtree, SEXP keep_partitions);
@@ -119,6 +120,7 @@ static R_CMethodDef C_entries[] = {
{"C_where", (DL_FUNC) &C_where, 6},
{"bitsplits_phylo", (DL_FUNC) &bitsplits_phylo, 6},
{"CountBipartitionsFromTrees", (DL_FUNC) &CountBipartitionsFromTrees, 8},
+ {"DNAbin2indelblock", (DL_FUNC) &DNAbin2indelblock, 4},
{NULL, NULL, 0}
};
diff --git a/src/dist_dna.c b/src/dist_dna.c
index 650e02f..b95554a 100644
--- a/src/dist_dna.c
+++ b/src/dist_dna.c
@@ -1,4 +1,4 @@
-/* dist_dna.c 2015-02-25 */
+/* dist_dna.c 2015-10-15 */
/* Copyright 2005-2015 Emmanuel Paradis */
@@ -91,57 +91,55 @@ void distDNA_indel(unsigned char *x, int *n, int *s, double *d)
}
}
-#define X(i, j) i - 1 + *n * (j - 1)
-
-void distDNA_indelblock(unsigned char *x, int *n, int *s, double *d)
+void DNAbin2indelblock(unsigned char *x, int *n, int *s, int *y)
{
- int i1, i2, s1, s2, target, start_block, end_block;
-
- for (i1 = 1; i1 <= *n; i1++) {
-
-/* find a block of one or more '-' */
-
- s1 = 1;
- while (s1 < *s) {
- if (x[X(i1, s1)] == 4) {
- start_block = s1;
- while (x[X(i1, s1)] == 4) s1++;
- end_block = s1 - 1;
-
-/* then look if the same block is present in all the other sequences */
-
- for (i2 = 1; i2 <= *n; i2++) {
- if (i2 == i1) continue;
-
- target = give_index(i1, i2, *n);
-
- if (start_block > 1) {
- if (x[X(i2, start_block - 1)] == 4) {
- d[target]++;
- continue;
- }
- }
- if (end_block < *s) {
- if (x[X(i2, end_block + 1)] == 4) {
- d[target]++;
- continue;
- }
- }
- for (s2 = start_block; s2 <= end_block; s2++) {
- if (x[X(i2, s2)] != 4) {
- d[target]++;
- continue;
- }
- }
- }
- s1 = end_block + 1;
- }
- s1++;
+ int i, j, k, pos, ngap, indel = 0;
+
+ for (i = 0; i < *n; i++) {
+ j = i;
+ k = 0;
+ while (k < *s) {
+ if (x[j] == 4) {
+ if (!indel) {
+ pos = j;
+ indel = 1;
+ ngap = 1;
+ } else ngap++;
+ } else {
+ if (indel) {
+ y[pos] = ngap;
+ indel = 0;
}
+ }
+ j += *n;
+ k++;
}
+ if (indel) {
+ y[pos] = ngap;
+ indel = 0;
+ }
+ }
}
-#undef X
+void distDNA_indelblock(unsigned char *x, int *n, int *s, double *d)
+{
+ int *y, i1, i2, s1, s2, target, Nd;
+
+ y = (int*)R_alloc(*n * *s, sizeof(int));
+ memset(y, 0, *n * *s * sizeof(int));
+ DNAbin2indelblock(x, n, s, y);
+
+ target = 0;
+ for (i1 = 1; i1 < *n; i1++) {
+ for (i2 = i1 + 1; i2 <= *n; i2++) {
+ Nd = 0;
+ for (s1 = i1 - 1, s2 = i2 - 1; s1 < i1 + *n*(*s - 1); s1 += *n, s2 += *n)
+ if (y[s1] != y[s2]) Nd++;
+ d[target] = ((double) Nd);
+ target++;
+ }
+ }
+}
void distDNA_TsTv(unsigned char *x, int *n, int *s, double *d, int Ts, int pairdel)
{
@@ -1069,20 +1067,61 @@ void BaseProportion(unsigned char *x, int *n, double *BF)
BF[16] = count[2];
}
+#define SEGCOL seg[j] = 1; done = 1; break
+
void SegSites(unsigned char *x, int *n, int *s, int *seg)
{
- int i, ib, j;
+ int i, j, done, end;
+ unsigned char base;
for (j = 0; j < *s; j++) {
- for (i = *n * j; i < *n * (j + 1) - 1; i++) {
- if (!KnownBase(x[i])) continue;
- for (ib = i + 1; ib < *n * (j + 1); ib++) {
- if (DifferentBase(x[i], x[ib])) {
- seg[j] = 1;
- break;
+
+ i = *n * j; /* start */
+ end = i + *n - 1;
+
+ base = x[i];
+ done = 0;
+
+ while (!KnownBase(base)) {
+ /* in this while-loop, we are not yet sure that 'base' is known,
+ so we must be careful with the comparisons */
+ i++;
+ if (i > end) {
+ done = 1;
+ break;
+ }
+ if (base != x[i]) {
+ if (base != 2 && x[i] != 2) { /* both should not be "?" */
+ if (base > 4) {
+ if (x[i] == 4) { /* 'base' is not a gap but x[i] is one => this is a segregating site */
+ SEGCOL;
+ } else { /* both are an ambiguous base */
+ if (DifferentBase(x[i], base)) {
+ SEGCOL;
+ }
+ }
+ } else { /* 'base' is a gap but x[i] is different => this is a segregating site */
+ SEGCOL;
+ }
+ }
+ base = x[i];
+ }
+ }
+
+ if (done) continue;
+
+ i++;
+ while (i <= end) {
+ if (x[i] != base) {
+ if (x[i] == 4) {
+ SEGCOL;
+ } else {
+ if (DifferentBase(x[i], base)) {
+ SEGCOL;
+ }
}
}
- if (seg[j]) break;
+ i++;
}
}
}
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-med/r-cran-ape.git
More information about the debian-med-commit
mailing list