[med-svn] [r-cran-ape] 05/06: New upstream version 5.0
Dylan Aïssi
bob.dybian-guest at moszumanska.debian.org
Thu Nov 2 22:18:54 UTC 2017
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 8db8fcec4340260e2fe4b0666b171d3acbd5ad41
Author: Dylan Aïssi <bob.dybian at gmail.com>
Date: Thu Nov 2 23:16:50 2017 +0100
New upstream version 5.0
---
DESCRIPTION | 15 +-
MD5 | 156 ++++++++++---------
NAMESPACE | 11 +-
R/CADM.global.R | 1 +
R/CADM.post.R | 3 +-
R/CDF.birth.death.R | 7 +-
R/DNA.R | 104 +++++++++++--
R/PGLS.R | 12 +-
R/RcppExports.R | 15 ++
R/ace.R | 10 +-
R/alex.R | 5 +-
R/apetools.R | 103 ++++++++++++-
R/as.phylo.R | 14 +-
R/biplot.pcoa.R | 44 ++++--
R/chronoMPL.R | 8 +-
R/collapse.singles.R | 42 +++--
R/dist.topo.R | 87 +++++++----
R/drop.tip.R | 20 +--
R/evonet.R | 122 ++++++++++++++-
R/is.compatible.R | 4 +-
R/ladderize.R | 8 +-
R/makeLabel.R | 4 +-
R/mrca.R | 47 +++---
R/nodelabels.R | 27 +++-
R/pcoa.R | 4 +
R/phydataplot.R | 24 +--
R/pic.R | 12 +-
R/plot.phylo.R | 132 ++++++++--------
R/plotPhyloCoor.R | 97 +++---------
R/read.nexus.R | 237 +++++++++++++++++-----------
R/read.tree.R | 333 ++++++++++++++++++++++++----------------
R/reorder.phylo.R | 24 ++-
R/subtreeplot.R | 9 +-
R/which.edge.R | 65 ++++++--
R/write.nexus.R | 4 +-
R/write.tree.R | 13 +-
build/vignette.rds | Bin 194 -> 194 bytes
data/hivtree.newick.rda | Bin 2190 -> 2189 bytes
inst/doc/MoranI.Rnw | 28 ++--
inst/doc/MoranI.pdf | Bin 238354 -> 238497 bytes
man/AAbin.Rd | 28 +++-
man/LTT.Rd | 3 +-
man/add.scale.bar.Rd | 2 +-
man/ape-internal.Rd | 15 +-
man/ape-package.Rd | 11 +-
man/apetools.Rd | 6 +
man/boot.phylo.Rd | 4 +-
man/carnivora.Rd | 19 +--
man/checkAlignment.Rd | 1 +
man/chiroptera.Rd | 2 +-
man/chronoMPL.Rd | 1 +
man/collapse.singles.Rd | 17 +-
man/dist.topo.Rd | 3 +-
man/drop.tip.Rd | 10 +-
man/evonet.Rd | 49 +++++-
man/image.DNAbin.Rd | 16 +-
man/mrca.Rd | 5 +-
man/multi2di.Rd | 2 +-
man/nodelabels.Rd | 5 +-
man/pcoa.Rd | 7 +-
man/phydataplot.Rd | 11 +-
man/plot.phylo.Rd | 2 +-
man/rTraitCont.Rd | 4 +-
man/read.tree.Rd | 21 ++-
man/reorder.phylo.Rd | 26 +++-
man/richness.yule.test.Rd | 2 +-
man/rtree.Rd | 3 +-
man/speciesTree.Rd | 17 +-
man/trans.Rd | 2 +-
man/write.nexus.Rd | 3 +
man/write.tree.Rd | 6 +
src/RcppExports.cpp | 45 ++++++
src/ape.c | 32 ++--
src/bipartition.c | 276 ++++++++++++++++-----------------
src/dist_dna.c | 5 +-
src/pic.c | 6 +-
src/plot_phylo.c | 17 +-
src/prop_part.cpp | 82 ++++++++++
src/reorder_Rcpp.cpp | 93 +++++++++++
src/tree_build.c | 384 +++++++++++++++++++++++++++++++++++++++++-----
vignettes/MoranI.Rnw | 28 ++--
81 files changed, 2176 insertions(+), 946 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index c8f74d5..196b059 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,10 +1,11 @@
Package: ape
-Version: 4.1
-Date: 2017-02-14
+Version: 5.0
+Date: 2017-10-04
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")),
person("Ben", "Bolker", role = c("aut", "cph")),
+ person("Joseph", "Brown", role = c("aut", "cph")),
person("Julien", "Claude", role = c("aut", "cph")),
person("Hoa Sien", "Cuong", role = c("aut", "cph")),
person("Richard", "Desper", role = c("aut", "cph")),
@@ -16,6 +17,7 @@ Authors at R: c(person("Emmanuel", "Paradis", role = c("aut", "cre", "cph"), email
person("Christoph", "Heibl", role = c("aut", "cph")),
person("Anthony", "Ives", role = c("aut", "cph")),
person("Bradley", "Jones", role = c("aut", "cph")),
+ person("Franz", "Krah", role = c("aut", "cph")),
person("Daniel", "Lawson", role = c("aut", "cph")),
person("Vincent", "Lefort", role = c("aut", "cph")),
person("Pierre", "Legendre", role = c("aut", "cph")),
@@ -31,16 +33,18 @@ Authors at R: c(person("Emmanuel", "Paradis", role = c("aut", "cre", "cph"), email
Depends: R (>= 3.2.0)
Suggests: gee, expm
Imports: nlme, lattice, graphics, methods, stats, tools, utils,
- parallel
+ parallel, Rcpp (>= 0.12.0)
+LinkingTo: Rcpp
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 DNA sequences, 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, kronoviz), estimati [...]
License: GPL (>= 2)
URL: http://ape-package.ird.fr/
NeedsCompilation: yes
-Packaged: 2017-02-14 16:20:43 UTC; paradis
+Packaged: 2017-10-04 16:39:18 UTC; paradis
Author: Emmanuel Paradis [aut, cre, cph],
Simon Blomberg [aut, cph],
Ben Bolker [aut, cph],
+ Joseph Brown [aut, cph],
Julien Claude [aut, cph],
Hoa Sien Cuong [aut, cph],
Richard Desper [aut, cph],
@@ -52,6 +56,7 @@ Author: Emmanuel Paradis [aut, cre, cph],
Christoph Heibl [aut, cph],
Anthony Ives [aut, cph],
Bradley Jones [aut, cph],
+ Franz Krah [aut, cph],
Daniel Lawson [aut, cph],
Vincent Lefort [aut, cph],
Pierre Legendre [aut, cph],
@@ -66,4 +71,4 @@ Author: Emmanuel Paradis [aut, cre, cph],
Damien de Vienne [aut, cph]
Maintainer: Emmanuel Paradis <Emmanuel.Paradis at ird.fr>
Repository: CRAN
-Date/Publication: 2017-02-14 19:15:21
+Date/Publication: 2017-10-30 15:36:18 UTC
diff --git a/MD5 b/MD5
index e958f98..3792af9 100644
--- a/MD5
+++ b/MD5
@@ -1,40 +1,41 @@
eb723b61539feef013de476e68b5c50a *COPYING
-04fa612328ddf8b15a99cc4f6eb2cf5a *DESCRIPTION
-c08ae7d7f93544183572e7c378f67c74 *NAMESPACE
+7688a13ae8ac47f77a234b37592b890e *DESCRIPTION
+2e58df81a51bcdbee42627eee3e18275 *NAMESPACE
854a025cb7e5da3e4fe230c0be950d08 *NEWS
-0c7bc9101516fd26fb3ddbedbe25b6a3 *R/CADM.global.R
-e042efca1d8a00d4178204f5f481b64d *R/CADM.post.R
-a10ebb0e9ecf861eea483eb41da1bd23 *R/CDF.birth.death.R
+f9e439d31c9c5dc938283b537d996112 *R/CADM.global.R
+e5939e709187595a1651c5f704bf217f *R/CADM.post.R
+c41ea70b2fc8b0c85d047281676778dc *R/CDF.birth.death.R
fdb9cfa0cbda82bda982b290693e44e3 *R/Cheverud.R
-ba0115131695f6fb2b7fb58f4d63300e *R/DNA.R
+b960ec7a65e9322906509e8f548affba *R/DNA.R
2187a1289b767066d1efe1ebbe7c3b0c *R/MPR.R
bb95af56d882b6162aa517a77140175e *R/MoranI.R
-218b8cf3c13a700c757b7b2303dc897e *R/PGLS.R
+2e19bda0a55293e8642aff49072f525e *R/PGLS.R
+30b1f0782318dc8ec3212edb4f03c89a *R/RcppExports.R
6be0924b9f043abaee0968de5cf62aa6 *R/SDM.R
315ae41ee77b323b07e63ff861359ae2 *R/SlowinskiGuyer.R
-8240ac5d3ec4c439e9a33a33f66e8428 *R/ace.R
+badc3bec27cf781280cbb62697b7a53e *R/ace.R
4ce79cf3f3ff49bef989454d86d0c891 *R/additive.R
-9fca35b1005cce7b2a260b553dd971a3 *R/alex.R
+1d76af894213570636d36c5a671192b3 *R/alex.R
9fe874382f024a98f62a0ccfcd6d09ac *R/all.equal.phylo.R
-aa844e5d40f27d3dbbe45cd932b39ad6 *R/apetools.R
+981cdd532ae4d6e528fc28c22373a592 *R/apetools.R
06b049b681ab2e594124a2b010c5cddd *R/as.bitsplits.R
c94018d5e792c72e20ce84085b2df9e7 *R/as.matching.R
-86d55d04b20c1ecad73ea817866d632d *R/as.phylo.R
+95e2ed1cd76f47c29101229b8a31f934 *R/as.phylo.R
1bb4dcfb44a7485710ec7f599d4b2ee8 *R/as.phylo.formula.R
844a38494dd34adbe916bb9116cd0bc2 *R/balance.R
607d7d6bc0ec5559ce1de5b1d1aab0c1 *R/binaryPGLMM.R
76b5ca45b7210c85fdc20cd1579b33a2 *R/bind.tree.R
-a28930cdae07a271403e988e86a0c324 *R/biplot.pcoa.R
+a1bcc11d7e142753b3f6c285d9ac2d07 *R/biplot.pcoa.R
92d9db6d7c1150d1a7c9443fd3d5cb04 *R/birthdeath.R
4ee816e0dc69630d104fb5da4cc542c4 *R/branching.times.R
b4557270916972166e13e76391bb0a69 *R/checkValidPhylo.R
e43b5dec7eae6d4bf9371e50117bf6ed *R/cherry.R
-5fd65efbdae6e0934e8bb42191142d4b *R/chronoMPL.R
+56491406d404355aefeb79db3d6f52cd *R/chronoMPL.R
74e1019810b06458e808a447bb099a91 *R/chronopl.R
f68d5d19e6a080ff70e03f41b7e43400 *R/chronos.R
2a9983307f686facf6d9ec843d214f38 *R/clustal.R
dedf66f0595977a11a7dbc2b0d2f56bb *R/coalescent.intervals.R
-c3d44d960238a711764aaeebe9570559 *R/collapse.singles.R
+5ca572331b7e701c933c1ad9cc56650d *R/collapse.singles.R
338accc0accb8e67f31db5a90c033d2f *R/collapsed.intervals.R
01e979242ba4667e48a80fd32c03f254 *R/compar.gee.R
89ce53eb1bb8c0fb36e95810cf7cd769 *R/compar.lynch.R
@@ -47,47 +48,47 @@ fd39268020a494980293c92d0971caca *R/corphylo.R
3822f0bb0a9ed4c8c19654e86ef34359 *R/def.R
93480a5b64e0d37f5450891629557615 *R/delta.plot.R
dfd5bb35f1cb1fd9154d023e0e4cfc2b *R/dist.gene.R
-c59b82a465d826b821896e0da82f1017 *R/dist.topo.R
+eda23e76483d03125f3318e0d25e70ff *R/dist.topo.R
b28ced504fedeb7f991f7eba10ad06df *R/diversi.gof.R
8b2ec4004022afdc7e2cb42f2657b628 *R/diversi.time.R
-d83a976aa9a582ab31ea12f65d7c6374 *R/drop.tip.R
-1c4bdd6cf163aa4d605ed67249883ad4 *R/evonet.R
+96b5883342dff1df58b9ba76759277ad *R/drop.tip.R
+4cb8b5d758f5746427b7a87cd931e5a0 *R/evonet.R
fceafc86fae624fd9037403ad301d35a *R/ewLasso.R
aa09abeb90ef891384128f978ffce843 *R/extract.popsize.R
5c29d3ee785da587f4ad5288ec36b76a *R/gammaStat.R
499b5f8596f40c32592fc85ee0e226ce *R/howmanytrees.R
68d848281455c4c91e9b91f16170e2f7 *R/identify.phylo.R
7d6ba4bcc70903878b1bba0565ac4722 *R/is.binary.tree.R
-be075b35bb032eaca5946abd14ded1e3 *R/is.compatible.R
+36ca87fc7b670608c51146b1d9cc5050 *R/is.compatible.R
35921387c705612d8f7c5baa06f9ab79 *R/is.monophyletic.R
a7bd37de10eb3f5c02096dfb9a492307 *R/is.ultrametric.R
-944879f7a9a134866f31d8476a07f9c1 *R/ladderize.R
+0e1155005d48770be5ee2507fd7c5d59 *R/ladderize.R
65b2494ebd918c6f9a31c80e25370035 *R/lmorigin.R
1553fd068a844a4274c62b936e242131 *R/ltt.plot.R
-0e3a341c99497686db7583eb0894ba77 *R/makeLabel.R
+ed8a75753d59e9488677837a5eb5c784 *R/makeLabel.R
34069210fd7b12dda0979c45822e4d3a *R/makeNodeLabel.R
a84000c0d7d2f53aec6a7105477f886a *R/mantel.test.R
d2c16632492bfafd2ee18f2fe3d3d64a *R/matexpo.R
566ed17c837a32977cb1546880d253b0 *R/mcmc.popsize.R
61021f7af1175c46a743c7fee4cdc87e *R/me.R
-e1327a592199bac7ac8f670c3a068d46 *R/mrca.R
+9f58cc8e04d340f201ed3ab729a1e647 *R/mrca.R
a078728fb5907565f85b54b30e5bf83f *R/mst.R
dea8394974d847a254f810883e1f246e *R/multi2di.R
0850fdd19c01d37ac632fc308632a463 *R/mvr.R
2f302fa091736fd5b1cb067c6ecd1215 *R/nj.R
e3f22d0f260c43be87a17b0ab091e2bb *R/njs.R
3efe5029d25c09e238b3d45aa9b3a140 *R/node.dating.R
-e4a0712fa45754cd02f5d3da6ef23204 *R/nodelabels.R
+ebcf7382f9eab104d17e77c87c4c38ba *R/nodelabels.R
ae2aeb0e8aef7f8d4b19939ca61b3482 *R/nodepath.R
d9fd8e402e6fce6939a05332823a9390 *R/parafit.R
-fc0260f9e8e17fc1446117580bbc93cc *R/pcoa.R
-431d25db557d480985ac16bfc3d6425c *R/phydataplot.R
+591094422ab6eb5bf7025cef68cff4dd *R/pcoa.R
+c2357dbf0ca7198c58d97e08ad3d16c4 *R/phydataplot.R
e71db002c66c277bfb57f6914ca143d4 *R/phymltest.R
-d04e04530104c16108684db049d715da *R/pic.R
-198dfc699186f842a0cce2bedf4eabc9 *R/plot.phylo.R
+615818acb88bc5c6d232b8b052506176 *R/pic.R
+0c5d463e949e83e768e48ea56e05ce6e *R/plot.phylo.R
b31f836442e0a6dd739d446faffda284 *R/plot.phyloExtra.R
e579ec65c808c29e1ecaae1501784b37 *R/plot.popsize.R
-736506e2f67e90cf9326abead437d298 *R/plotPhyloCoor.R
+dd009da9120a99c30ca4169b61e5d195 *R/plotPhyloCoor.R
1e2485437566ca9af99d93b4580cbbc2 *R/print.lmorigin.R
d0e8bd41d5acc217fdee3578adcf635b *R/print.parafit.R
8c401518738b9cda403fa9f0eb382757 *R/rTrait.R
@@ -95,11 +96,11 @@ d05e33bba295c6208e302275668b3a27 *R/read.GenBank.R
b13dfb8f455b1c9e74a364085f72dbce *R/read.caic.R
ec0d133f24b736de2d3a66edad978f83 *R/read.dna.R
b25674d229dfa4d2bf76a50e1874c690 *R/read.gff.R
-d8045fd7da3d9aabaeb11216098995d0 *R/read.nexus.R
+9314a1bab94e42c230bfec112360fc3b *R/read.nexus.R
13ce7f5c7d1bcb7101469d12651e99c8 *R/read.nexus.data.R
-88e633c80886f5a6c9f2b34918452d15 *R/read.tree.R
+729bf904ad495fc492ac1428ba821989 *R/read.tree.R
df2ac5d3de7185c7e26fc95b35192a40 *R/reconstruct.R
-1770cbeb0312916ebe52647fc29a83fc *R/reorder.phylo.R
+d7486ab8ac6d584f04bf1f75ca7f6be3 *R/reorder.phylo.R
4400af9cbac48963c7cb287c51aad62c *R/root.R
f584366b32e7414c669714ba5b84951b *R/rotate.R
b7158b84c7ee7d9dcb2e0abeb6005cb0 *R/rtree.R
@@ -108,7 +109,7 @@ d099c8987470c4506511be54e29a5ddd *R/scales.R
d2e06f8288af941a00c46248b586225a *R/skyline.R
1f82059f740388b7430b2359e54a147f *R/skylineplot.R
9c7b02a4625099f715700fb868226b0f *R/speciesTree.R
-28fce999b31a0c7d53816cec6916981f *R/subtreeplot.R
+97c4c3d7cb1606fe6d5519d817156bde *R/subtreeplot.R
bcc8f1fc8363728caba82129412d9e31 *R/subtrees.R
e9daa8dbb2eef717c51a73e92669ae31 *R/summary.phylo.R
8fbd1589f5d98d76b1154cffb8d4d1f5 *R/treePop.R
@@ -117,16 +118,16 @@ b5081fca8758fe4458183c3e25e3e661 *R/triangMtd.R
2937379ad9e91e263b7956c264926466 *R/varcomp.R
a40ae9ad30c221d4ed14b90e8b406f93 *R/vcv.phylo.R
31b3bb1feed474692f07fcebe3a61ac7 *R/vcv2phylo.R
-16d5511c871e41b9b2673052e03c8b33 *R/which.edge.R
+c9adce0f3d0120434ca22f2bb2a0b0c8 *R/which.edge.R
43b881eea3763d0079e88012e0b84d37 *R/write.dna.R
-4e5d7a7904fe6496a44c4b69f674290b *R/write.nexus.R
+2a9393fed275f1b214c0f4fb264f574a *R/write.nexus.R
89496c0df70205654456d3b7bb7ba41f *R/write.nexus.data.R
-17d72a136a8131ea46ef9a20fcfd4d36 *R/write.tree.R
+9cf6124d166e103846316b2b52e276d9 *R/write.tree.R
774ce72875903259aade5344f9a70aa4 *R/yule.R
c8d3aa3fe64e75e61af07a1b11c74f3f *R/yule.time.R
1eb44ff9e5a036eb845faa1598ce5009 *R/zoom.R
3387c0d0c1f913f8471e1bb34bd2e516 *R/zzz.R
-b77a7eef47f2f8d2874a638562f49ea4 *build/vignette.rds
+7d368ccc5a36581c137df6a29e026834 *build/vignette.rds
db9083e8750aff839d5ebf3ed982f1f1 *data/HP.links.rda
9d9f9232839665422709ded1e541d038 *data/bird.families.rda
a14a6df0f3a735ebc056065077788c90 *data/bird.orders.rda
@@ -134,7 +135,7 @@ f74f9ed80c04756021cc093d40ca9ff9 *data/carnivora.csv.gz
4eaf8cbaefa2e8f8d395a9b482ee9967 *data/chiroptera.rda
1c74c3b99d08b0e17eea3ec1065c12d2 *data/cynipids.rda
7fe760c2f3b4deba0554aae6138cb602 *data/gopher.D.rda
-1c8e6ca4c99ce95b2f2692c15b6d768d *data/hivtree.newick.rda
+a50de1a68c246297839c26d592191504 *data/hivtree.newick.rda
8d14f95319d0a5cdc8faa60a1d0085ce *data/hivtree.table.txt.gz
31be81fe3faca11f98d3e74c090bc59e *data/lice.D.rda
38edbd84a0a067322c40db8d71fb1289 *data/lmorigin.ex1.rda
@@ -145,27 +146,27 @@ e2d1339025ed901009bfed58dc6505ff *data/mat5M3ID.RData
39e4fece2bdc527d7a9d4d83d023a947 *data/woodmouse.rda
828290996b613493f96e0fab024beebb *inst/CITATION
3f54f3775bcf382e25df2a12228894f6 *inst/doc/MoranI.R
-2277b0efdb2f70dfdc5df8278702c6b6 *inst/doc/MoranI.Rnw
-49be1aafbc668a68960f23c66d6cf61a *inst/doc/MoranI.pdf
-db2ed5302bddcfac232dcd6fabe4a651 *man/AAbin.Rd
+2d9f63bd652273f8d6fd830fb6f908e7 *inst/doc/MoranI.Rnw
+a90e67c794ebb6f7fb4964e3980ab89c *inst/doc/MoranI.pdf
+226e52dad3a55604a8fec934e969b579 *man/AAbin.Rd
e6876b193a0df06697c788a8e48cf4bc *man/CADM.global.Rd
dfa15a3e3bb57c9b21a30b8d5d790c62 *man/DNAbin.Rd
d94f358593695b1713840df5a8c000ba *man/DNAbin2indel.Rd
8b9bc214e32cde4c6e5970e48ff30c5f *man/Initialize.corPhyl.Rd
-4ed78ca9d87b32808b064e0ecd6756cb *man/LTT.Rd
+ab4685ee7e884b03d622fcf841f5da08 *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
+1e45e292cea5a4f0154ffeafd67fd832 *man/add.scale.bar.Rd
0d68dd79c42bad2f3a68635ba75a59b0 *man/additive.Rd
25a2859708b9a281a0d682e4376f3f53 *man/alex.Rd
2ff5d30c6fb1c5458643f1b3c09e76da *man/all.equal.DNAbin.Rd
f0b85d459edb5ead2e6d39a86cbb350c *man/all.equal.phylo.Rd
c3bd9e7b02831d6086fabd5de6db917c *man/alview.Rd
-42489c977f59031dc17a0ba7e55663b6 *man/ape-internal.Rd
-f84e59c805efa00000d775b81bf9f8d0 *man/ape-package.Rd
-d051129f1de68268f43d1360601b9c25 *man/apetools.Rd
+021645deac89b85579af1e7dc86b8298 *man/ape-internal.Rd
+13e18c5056e06963319e05bab833ddf3 *man/ape-package.Rd
+c8b3bcf7f3c3010a9fd2e3676fd7f2fd *man/apetools.Rd
5bba4ae4bfc66b613855cfc182d9b1bc *man/as.alignment.Rd
4eed5aecc55738e6bdda6839b91cc635 *man/as.bitsplits.Rd
4f014cf2923e2eab6188acd48e8096fa *man/as.matching.Rd
@@ -182,20 +183,20 @@ f929bc1b6391c57a6b0099c4561fd7be *man/binaryPGLMM.Rd
71a008cfe65c4f524a5b66e68bbf81ab *man/bird.families.Rd
0e41770e1e6d0b8d90c4cf51049213cb *man/bird.orders.Rd
ef1c15d5d93410c21179997431112209 *man/birthdeath.Rd
-87fafa0226908ea87c6d11aecc9bf72c *man/boot.phylo.Rd
+18552bbfe4527c1a72a9050e90368d8d *man/boot.phylo.Rd
5a64b90d3a6c7a8204946b00f45f4cfc *man/branching.times.Rd
99ffa532ab4397c374eaddd0f2ff8469 *man/c.phylo.Rd
-9d3f9614732671a610cc8a37454885e2 *man/carnivora.Rd
-953b3c21c60a38e8e53ec6894170dd36 *man/checkAlignment.Rd
+6ddcfd41f33b85334a04f2c252a2f561 *man/carnivora.Rd
+a35edcfb2299e68b6378961c0755c4ea *man/checkAlignment.Rd
5ff8c7e8fad519d978f166948c03059c *man/checkValidPhylo.Rd
64c3996ca6bcc97d0d2e2cf3361f8f71 *man/cherry.Rd
-f82a24dc4bb17b5675ec7b422d575587 *man/chiroptera.Rd
-b40dd77fd2529626e983ee0300be6781 *man/chronoMPL.Rd
+f97bae24ccc83cce6728fd1072bffc07 *man/chiroptera.Rd
+c68be7ff5a08664691df3e2813468490 *man/chronoMPL.Rd
c1f01c6200b2f1e2901d45d40daae404 *man/chronopl.Rd
506d0332fb092ab87ca7674faef63ab7 *man/chronos.Rd
1edeca1697a517d946b2062d20b90cbb *man/clustal.Rd
866af6e8d769b3d6972ef8e1ac849a12 *man/coalescent.intervals.Rd
-18c77b4104aa22d3e6cb88339f2eff90 *man/collapse.singles.Rd
+b114a09e0cb474323d5398ec4ee83d3c *man/collapse.singles.Rd
bff5a7826f5a39767601e32ceb776247 *man/collapsed.intervals.Rd
301f271dc131de2efc3294d31f03afed *man/compar.cheverud.Rd
4d8ee141d7b6b323ef5ee9446000ae32 *man/compar.gee.Rd
@@ -221,20 +222,20 @@ c0763a70c4965a6b03df3e5be68e450d *man/def.Rd
fbcd1d4bcf74e21fc93c195c7af3db98 *man/delta.plot.Rd
d4c1853e139f84101de2b9309823f366 *man/dist.dna.Rd
38011e81d28a120d88eead09e62c154a *man/dist.gene.Rd
-4042a6c6113e8a0eb3a1ffaf51138f0f *man/dist.topo.Rd
+4fc2f773c6ee4fe134befa4cde202fe3 *man/dist.topo.Rd
c7cc398115be066740ca4fb037394727 *man/diversi.gof.Rd
d646ea0343999bd0e38e86dcf6c12018 *man/diversi.time.Rd
da8898476bb15b627b34ee1093b9aeb4 *man/diversity.contrast.test.Rd
-55ed69cf42cb2fb768467870ef5e4c99 *man/drop.tip.Rd
+3855217efc96ffd3bae9d3fc987bf73c *man/drop.tip.Rd
6ae02a689abea279f7e6650678aa7ae2 *man/edges.Rd
-7ad398603675bd4e0e1c5f5eeb1105bc *man/evonet.Rd
+3eb82a23c0ece8a095c8f472736f33a1 *man/evonet.Rd
28675cca1ce5738ba2cb3148d8e935cb *man/ewLasso.Rd
fd760ac491d39a6c9bb32c95995e87b3 *man/fastme.Rd
eea313e8ee32597b4cec120d23113642 *man/gammaStat.Rd
3991fa7864e326579f1ab8b671095e4b *man/hivtree.Rd
18012643a904f657fc5f5896f3d14054 *man/howmanytrees.Rd
86c49d080fdffd614d8056021e91cc55 *man/identify.phylo.Rd
-dc00b2b43a44f4ba7ea76ea23a12c615 *man/image.DNAbin.Rd
+b8ba66426802e3dfe44def33f8ebef03 *man/image.DNAbin.Rd
0ede757d7bed82216980d3c4fd592cb6 *man/is.binary.tree.Rd
ab3d6e53acd7fe19bdf48a12912f005f *man/is.compatible.Rd
d2de8fd9549ef01a1dddeb726dd77fcf *man/is.monophyletic.Rd
@@ -254,30 +255,30 @@ f56f6f49c89c6bc850a7aee1bce5e0bd *man/mat5M3ID.Rd
a8b9d6b04d35d75f43d1b283361a1642 *man/mcconwaysims.test.Rd
8c3dfdb6c70caee1051b1e576e3eaa74 *man/mcmc.popsize.Rd
d974e980cb56568e337ef4e926f43617 *man/mixedFontLabel.Rd
-dbcdc231c2f1f221818307bb33486159 *man/mrca.Rd
+ab32c16c1290a7a5057d743951f041b0 *man/mrca.Rd
5c88230ad597ea9fe41536a8321c326b *man/mst.Rd
-b74a379a0a9b80941118922ca7843b02 *man/multi2di.Rd
+c01b6d4d2e79cc78cc1f3d1e029f58da *man/multi2di.Rd
029b04adeafe89ea5edf9a1ab00cd154 *man/multiphylo.Rd
00fb7ade93c2dd887be27e3dad8e2115 *man/mvr.Rd
3df9e16b8a09df3f1dba5c4327a635fc *man/nj.Rd
9ea7d5899a190171de4165e3240de62e *man/njs.Rd
1f2bbc4477c7fcfad397a6bdfa11faee *man/node.dating.Rd
a589b4cc04505185dc9ef1817c7ae304 *man/node.depth.Rd
-ba754eba67181a1c39d417ffd9d23b76 *man/nodelabels.Rd
+18cd39e5238e92da33b3afefa8cee3fb *man/nodelabels.Rd
447ae03684ff56a4a24932aec182acf3 *man/nodepath.Rd
c2e2f35f4e233265c86b7967ec2d0630 *man/parafit.Rd
-89db814a5fc2e9fa5f0b9f4ad2f0d070 *man/pcoa.Rd
-583200254fe87b2a36fc18a88825298d *man/phydataplot.Rd
+2912b4bd180c08a4aecb95536d5786ad *man/pcoa.Rd
+0089077e3be11d37650331437e4a8a48 *man/phydataplot.Rd
6dfa52711bab351bbcfe2624690eb730 *man/phymltest.Rd
447941526b92322c52b5cfe367cb7088 *man/pic.Rd
0363aa3fa3e86160934e2359c8ac5323 *man/pic.ortho.Rd
265527313d479d3625df7680c7479cd1 *man/plot.correlogram.Rd
-d23d21863b2dffa5388f3fc128368af4 *man/plot.phylo.Rd
+28822c7953a0c54b78fb771f9b728d0e *man/plot.phylo.Rd
896198fa3a0ce916346c8b507bf707bf *man/plot.phyloExtra.Rd
6bb1cf751772b9b6acf560b5f3c6f3c1 *man/plot.varcomp.Rd
e0e2f60baddaaaa8f1d9796bd50a8ba2 *man/plotTreeTime.Rd
b24438c42cea969302ec6ba61002426e *man/print.phylo.Rd
-80bf68fd21b5e665329cf30b10a1655f *man/rTraitCont.Rd
+cd98ef01fc72ff6a66cf6d24a5197259 *man/rTraitCont.Rd
59e81eaae91dc77b4275c9a5b2910dda *man/rTraitDisc.Rd
81f756fdf2ec4c968095595dece8338f *man/rTraitMult.Rd
028b11582b3493cdefea60ccb78ad429 *man/read.GenBank.Rd
@@ -286,25 +287,25 @@ b24438c42cea969302ec6ba61002426e *man/print.phylo.Rd
51670875393d70cb7ef84b4b0388e8e4 *man/read.gff.Rd
fdc2393e70328ae27034c54bf8a847c7 *man/read.nexus.Rd
bc02e36c51d67074e661468993ed359b *man/read.nexus.data.Rd
-3c8b53f5af4fdd36e7c0b449412d5a77 *man/read.tree.Rd
+80aaced77530e1d5faf459f8695baea2 *man/read.tree.Rd
9224f164351fea4be9f7ce9d827f8e58 *man/reconstruct.Rd
-5c2f0e05ef560aa4ec066c898c430aec *man/reorder.phylo.Rd
-af19f262b468dfd7c12448d9d8085331 *man/richness.yule.test.Rd
+29fd18c1d0729228307b82dc3ef70ede *man/reorder.phylo.Rd
+23cb928f62f9c7103244fbd752ff9a81 *man/richness.yule.test.Rd
3afe25cebe4628e4844e41aad512d6e4 *man/rlineage.Rd
c2503e4a9511cafefa7bc1e058fdde2a *man/root.Rd
6b97ea2fd96bf948fca764deab3a6e76 *man/rotate.Rd
-1a7314ee0aa76712737e76162df6cc74 *man/rtree.Rd
+dd34e2217c70e488059091775ffdd8e6 *man/rtree.Rd
e53b4b3f7e009289c628e16143b3e8b4 *man/rtt.Rd
5010f7e12af0865bd3e4112349d601db *man/seg.sites.Rd
f125fe172ee83b8bb4adaede4b4d3b43 *man/skyline.Rd
bf851aa61b6310afa2ae1358c189dad7 *man/skylineplot.Rd
0cede7cdef45fc9a8b993f938a32ce67 *man/slowinskiguyer.test.Rd
-a0db170675b1c265f1f4e7d56e88d7cb *man/speciesTree.Rd
+201f06e5f36495dda446d523dbabf354 *man/speciesTree.Rd
8fc51ff26614e7c713be2570d9af47b6 *man/stree.Rd
1f1309e2ec6327974952d546241a6024 *man/subtreeplot.Rd
ef8aa9721275f20ddd38612cddf8300c *man/subtrees.Rd
d684cc640acf041c6f1124e08426c8c8 *man/summary.phylo.Rd
-18eb8ab87509076b49c50cd86b231cf7 *man/trans.Rd
+dd26f77674f0b451eaca4641a6091b9c *man/trans.Rd
3340a4f09c55010c15c0149a20b41c99 *man/treePop.Rd
7749863f505076f2288c106eb465805e *man/trex.Rd
dbb269e680caf8c722cf53c9b5ce7ace *man/triangMtd.Rd
@@ -318,9 +319,9 @@ a5d3cbf19df84d0f1e4e3a4650945cbf *man/weight.taxo.Rd
ef9658f5343bdcbfc3673c7f936934f5 *man/which.edge.Rd
9b83a148295dcfcb3994fdb6eaab0174 *man/woodmouse.Rd
f613518d0ecd88b4a80c779b0453ad7f *man/write.dna.Rd
-b9fe1836be61c56a521386b00021fa67 *man/write.nexus.Rd
+df8657f468307a02b8cde93ff4758f1c *man/write.nexus.Rd
bf9417a54722e3185ece06cf01b5e899 *man/write.nexus.data.Rd
-b2302d65196726ab4cc573a22ee2d8e3 *man/write.tree.Rd
+06fcd0c13156f7ccc187595adc414d78 *man/write.tree.Rd
2568c6529e40fae7effe88b6c73998a1 *man/yule.Rd
7df89ac6996c82b52c4c9b3734807de1 *man/yule.cov.Rd
8612123f3617699a8e29ddf0541dc9ee *man/yule.time.Rd
@@ -328,17 +329,18 @@ a00006ae345bb9379312e81694de3885 *man/zoom.Rd
225b45505001f9311e1d76f3a880cd70 *src/BIONJ.c
2a6f9e9e044a78154d3cfda5936d6f48 *src/Makevars
3174e9b61c83de87e8f14f428775d415 *src/NNI.c
+b00a5ad1a396f723491edbbce69fca62 *src/RcppExports.cpp
122ba51b574f7f7acd5ea4b6256cea5f *src/SPR.c
d11fb19958f2953583a9c5876da82df9 *src/TBR.c
9733c82cd67c4bd41aea44981f4ac8b8 *src/additive.c
-f795f77892d496e05e247b114eacf83a *src/ape.c
+6975b04b36dcbea72dab09d2410f7c57 *src/ape.c
7eaffd3d85df9a1e4460905e9ca5eced *src/ape.h
19b564aab62c464c092cdf2f0d5cf447 *src/bNNI.c
79ca5c473decf13964192524caebf9f1 *src/bionjs.c
-f782a97466ed8008d31afd7a3e9d4ea9 *src/bipartition.c
+0c543e9135305b89a6775bea33a74995 *src/bipartition.c
a5d4f692aca36f6b50e123b443792fa1 *src/bitsplits.c
81e4ad60b418966cdd09e608e074bb28 *src/delta_plot.c
-bcbc45836832bf51f35e920283cc37d6 *src/dist_dna.c
+19276345d288d4dbf29bd011f762b69d *src/dist_dna.c
2a6a59a3a220eb855a3c48bc73dc54ba *src/dist_nodes.c
005ab69356525fbbc1b69950341308c2 *src/ewLasso.c
afa27403972145d083d7f7f8b2536b98 *src/heap.c
@@ -351,16 +353,18 @@ cf2bdcf9eda24eb6b572584c0ab79fb4 *src/me_ols.c
b3da0884f49bb4564fa1109c3255aa38 *src/mvrs.c
d3364013ad597425d01ac50ae4ee0b34 *src/nj.c
1a4fa91d36ba25cf8d53d25683a2235e *src/njs.c
-7de13de6d828d870915c2efb6eb47ab6 *src/pic.c
-28ef72b2ccede817c0431afcb04e9c8c *src/plot_phylo.c
+72e310102d7db22ae9b6794d153889ac *src/pic.c
+9643db2c211ee54a978ac50f3909cd43 *src/plot_phylo.c
+fbf5f1788c721c8d259b0e36fc6fc7ab *src/prop_part.cpp
aa8d9966da3b7e970879a49a40c05a07 *src/rTrait.c
3789c732cdd750e3c5e813884968cf03 *src/read_dna.c
+f30c6b59e86ad6e7c357d6f054e12f92 *src/reorder_Rcpp.cpp
b5505d4f7c732c82bc54687d6fc37c0d *src/reorder_phylo.c
d7d48424f600f5dad372a8c3ccfbbcad *src/treePop.c
-40d4ed144aba4b1acbc64d2807f33466 *src/tree_build.c
+2f369753617b1447a6f7c9db53ba4d6a *src/tree_build.c
42c108c79f26d1940f94b98fcbe271e1 *src/tree_phylo.c
5937b5ba96d2ff5615badf55dff9ed5a *src/triangMtd.c
ace51cbbe1e728d1e94e78ca99a6d019 *src/triangMtds.c
72e04107c752568641219bf57b5731a8 *src/ultrametric.c
-2277b0efdb2f70dfdc5df8278702c6b6 *vignettes/MoranI.Rnw
+2d9f63bd652273f8d6fd830fb6f908e7 *vignettes/MoranI.Rnw
70d5ed89ae0c78af85e1309702679087 *vignettes/ape.bib
diff --git a/NAMESPACE b/NAMESPACE
index 03219a6..d43497f 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -23,8 +23,9 @@ importFrom(stats, AIC, as.dist, as.hclust, biplot, coef, complete.cases,
qbinom, qnorm, qt, quantile, quasibinomial, rbinom, reorder, resid,
rexp, rgamma, rnorm, runif, sd, setNames, terms, uniroot, var,
wilcox.test)
-importFrom(utils, download.file, edit, read.table, str)
+importFrom(utils, browseURL, download.file, edit, read.table, str)
importFrom(parallel, mclapply)
+importFrom(Rcpp,sourceCpp)
## Methods for the classes defined in ape, including for the generics
## defined in ape (see also below). Some methods are exported above.
@@ -33,6 +34,9 @@ S3method(is.binary, tree) # to delete when removing the function
S3method("[", AAbin)
S3method(as.character, AAbin)
+S3method(as.list, AAbin)
+S3method(as.matrix, AAbin)
+S3method(c, AAbin)
S3method(image, AAbin)
S3method(labels, AAbin)
S3method(print, AAbin)
@@ -70,8 +74,10 @@ S3method(print, DNAbin)
S3method(rbind, DNAbin)
S3method(as.phylo, evonet)
+S3method(Nedge, evonet)
S3method(plot, evonet)
S3method(print, evonet)
+S3method(reorder, evonet)
S3method("[", multiPhylo)
S3method("[<-", multiPhylo)
@@ -173,6 +179,7 @@ S3method(print, parafit)
## Other methods of the generics defined in ape:
S3method(as.AAbin, character)
+S3method(as.AAbin, list)
S3method(as.DNAbin, alignment)
S3method(as.DNAbin, character)
@@ -182,6 +189,8 @@ S3method(as.DNAbin, DNAStringSet)
S3method(as.DNAbin, list)
S3method(as.DNAbin, PairwiseAlignmentsSingleSubject)
+S3method(as.evonet, phylo)
+
S3method(as.phylo, formula)
S3method(as.phylo, hclust)
S3method(as.phylo, matching)
diff --git a/R/CADM.global.R b/R/CADM.global.R
index 5644ca5..18f5f18 100644
--- a/R/CADM.global.R
+++ b/R/CADM.global.R
@@ -110,6 +110,7 @@
vec <- c(vec, as.vector(as.dist(t(D.temp))))
diag(D.temp) <- NA
D.temp2 <- rank(D.temp)
+ dim(D.temp2) <- dim(D.temp) # Correction E. Paradis, 08may17
diag(D.temp2) <- 0
# cat("nrow =",nrow(D.temp2)," ncol =",ncol(D.temp2),'\n')
# cat("Matrix ",k," min =",min(D.temp2)," max =",max(D.temp2),'\n')
diff --git a/R/CADM.post.R b/R/CADM.post.R
index d159c4b..387ea7b 100644
--- a/R/CADM.post.R
+++ b/R/CADM.post.R
@@ -119,7 +119,8 @@
## The two halves are stored as symmetric matrices in D1[[k]] and D2[[k]]
vec <- c(vec, as.vector(as.dist(t(D.temp))))
diag(D.temp) <- NA
- D.temp2 <- rank(D.temp)
+ D.temp2 <- rank(D.temp)
+ dim(D.temp2) <- dim(D.temp) # Correction E. Paradis, 08may17
diag(D.temp2) <- 0
# cat("nrow =",nrow(D.temp2)," ncol =",ncol(D.temp2),'\n')
# cat("Matrix ",k," min =",min(D.temp2)," max =",max(D.temp2),'\n')
diff --git a/R/CDF.birth.death.R b/R/CDF.birth.death.R
index dd0cabf..a7e73a9 100644
--- a/R/CDF.birth.death.R
+++ b/R/CDF.birth.death.R
@@ -40,7 +40,8 @@ integrateTrapeze <- function(FUN, from, to, nint = 10)
}
}
-if(getRversion() >= "2.15.1") utils::globalVariables("Tmax")
+## if (getRversion() >= "2.15.1") -- R 3.2.0 is required for ape
+utils::globalVariables("Tmax")
.getRHOetINT <- function(birth, death, BIRTH = NULL, DEATH = NULL, case, fast)
{
@@ -489,7 +490,7 @@ bd.time <- function(phy, birth, death, BIRTH = NULL, DEATH = NULL,
LTT <- function(birth = 0.1, death = 0, N = 100, Tmax = 50, PI = 95,
scaled = TRUE, eps = 0.1, add = FALSE, backward = TRUE,
ltt.style = list("black", 1, 1),
- pi.style = list("blue", 1, 2))
+ pi.style = list("blue", 1, 2), ...)
{
case <- .getCase(birth, death, NULL, NULL)
Time <- seq(0, Tmax, eps)
@@ -511,7 +512,7 @@ LTT <- function(birth = 0.1, death = 0, N = 100, Tmax = 50, PI = 95,
lty = ltt.style[[3]])
else
plot(Time, F, "l", col = ltt.style[[1]], lwd = ltt.style[[2]],
- lty = ltt.style[[3]], ylab = "Number of lineages")
+ lty = ltt.style[[3]], ylab = "Number of lineages", ...)
if (PI)
lines(c(Time, NA, Time), c(Flow, NA, Fup),
col = pi.style[[1]], lwd = pi.style[[2]], lty = pi.style[[3]])
diff --git a/R/DNA.R b/R/DNA.R
index 010f61d..3e16346 100644
--- a/R/DNA.R
+++ b/R/DNA.R
@@ -1,8 +1,8 @@
-## DNA.R (2017-01-12)
+## DNA.R (2017-08-28)
## Manipulations and Comparisons of DNA and AA Sequences
-## Copyright 2002-2017 Emmanuel Paradis, 2015 Klaus Schliep
+## Copyright 2002-2017 Emmanuel Paradis, 2015 Klaus Schliep, 2017 Franz Krah
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
@@ -104,7 +104,7 @@ as.alignment <- function(x)
as.matrix.DNAbin <- function(x, ...)
{
if (is.matrix(x)) return(x)
- if (is.vector(x)) {
+ if (!is.list(x)) { # vector
dim(x) <- c(1, length(x))
return(x)
}
@@ -376,8 +376,11 @@ GC.content <- function(x) sum(base.freq(x)[2:3])
seg.sites <- function(x)
{
if (is.list(x)) x <- as.matrix(x)
- if (is.vector(x)) return(integer(0))
- if (nrow(x) == 1) return(integer(0))
+ ## is.vector() returns FALSE because of the class,
+ ## so we use a different test
+ dx <- dim(x)
+ if (is.null(dx)) return(integer(0))
+ if (dx[1] == 1) return(integer(0))
ans <- .Call(SegSites, x)
which(as.logical(ans))
}
@@ -450,8 +453,11 @@ dist.dna <- function(x, model = "K80", variance = FALSE, gamma = FALSE,
d
}
-image.DNAbin <- function(x, what, col, bg = "white", xlab = "", ylab = "",
- show.labels = TRUE, cex.lab = 1, legend = TRUE, ...)
+image.DNAbin <-
+ function(x, what, col, bg = "white", xlab = "", ylab = "",
+ show.labels = TRUE, cex.lab = 1, legend = TRUE,
+ grid = FALSE, show.bases = FALSE, base.cex = 1,
+ base.font = 1, base.col = "black", ...)
{
what <-
if (missing(what)) c("a", "g", "c", "t", "n", "-") else tolower(what)
@@ -502,6 +508,17 @@ image.DNAbin <- function(x, what, col, bg = "white", xlab = "", ylab = "",
pt.cex = 2, bty = "n", xjust = 0.5, yjust = 0.5,
horiz = TRUE, xpd = TRUE)
}
+ if (grid) {
+ if (is.logical(grid)) grid <- 3L
+ if (grid %in% 2:3) abline(v = seq(1.5, s - 0.5, 1), lwd = 0.33, xpd = FALSE)
+ if (grid %in% c(1, 3)) abline(h = seq(1.5, n - 0.5, 1), lwd = 0.33, xpd = FALSE)
+ }
+ if (show.bases) {
+ x <- toupper(as.character(x))
+ xx <- rep(1:s, each = n)
+ yy <- rep(n:1, s)
+ text(xx, yy, x, cex = base.cex, font = base.font, col = base.col)
+ }
}
alview <- function(x, file = "", uppercase = TRUE)
@@ -742,8 +759,11 @@ AAsubst <- function(x)
Small = .AA_raw[c("P", "G", "A", "C")],
Hydrophilic = .AA_raw[c("S", "T", "H", "N", "Q", "D", "E", "K", "R")])
-image.AAbin <- function(x, what, col, bg = "white", xlab = "", ylab = "",
- show.labels = TRUE, cex.lab = 1, legend = TRUE, ...)
+image.AAbin <-
+ function(x, what, col, bg = "white", xlab = "", ylab = "",
+ show.labels = TRUE, cex.lab = 1, legend = TRUE,
+ grid = FALSE, show.aa = FALSE, aa.cex = 1,
+ aa.font = 1, aa.col = "black", ...)
{
if (missing(what))
what <- c("Hydrophobic", "Small", "Hydrophilic")
@@ -781,6 +801,11 @@ image.AAbin <- function(x, what, col, bg = "white", xlab = "", ylab = "",
yaxt <- if (show.labels) "n" else "s"
image.default(1:s, 1:n, t(y[n:1, ]), col = co, xlab = xlab, ylab = ylab,
yaxt = yaxt, breaks = brks, ...)
+ if (length(poly <- AAsubst(x))) {
+ rect(poly - 0.5, n + 0.5, poly + 0.5, n + 0.5 + yinch(0.2),
+ col = "slategrey", border = NA, xpd = TRUE)
+ ##rect(0.5, n + 0.5, s + 0.5, n + 0.5 + yinch(0.2), lwd = 0.5)
+ }
if (show.labels)
mtext(rownames(x), side = 2, line = 0.1, at = n:1, cex = cex.lab,
adj = 1, las = 1)
@@ -792,6 +817,17 @@ image.AAbin <- function(x, what, col, bg = "white", xlab = "", ylab = "",
pt.cex = 2, bty = "n", xjust = 0.5, yjust = 0.5,
horiz = TRUE, xpd = TRUE)
}
+ if (grid) {
+ if (is.logical(grid)) grid <- 3L
+ if (grid %in% 2:3) abline(v = seq(1.5, s - 0.5, 1), lwd = 0.33, xpd = FALSE)
+ if (grid %in% c(1, 3)) abline(h = seq(1.5, n - 0.5, 1), lwd = 0.33, xpd = FALSE)
+ }
+ if (show.aa) {
+ x <- toupper(as.character(x))
+ xx <- rep(1:s, each = n)
+ yy <- rep(n:1, s)
+ text(xx, yy, x, cex = aa.cex, font = aa.font, col = aa.col)
+ }
}
checkAlignment <- function(x, check.gaps = TRUE, plot = TRUE, what = 1:4)
@@ -993,3 +1029,53 @@ all.equal.DNAbin <- function(target, current, plot = FALSE, ...)
}
res
}
+
+## From Franz Krah <f.krah at mailbox.org>:
+
+## estensions of the AAbin class to complement the DNAbin class funcitons
+
+c.AAbin <- function(..., recursive = FALSE)
+{
+ if (!all(unlist(lapply(list(...), is.list))))
+ stop("the 'c' method for \"AAbin\" accepts only lists")
+ structure(NextMethod("c"), class = "AAbin")
+}
+
+as.AAbin.list <- function(x, ...)
+{
+ obj <- lapply(x, as.AAbin)
+ class(obj) <- "AAbin"
+ obj
+}
+
+as.list.AAbin <- function(x, ...)
+{
+ if (is.list(x)) return(x)
+ if (is.null(dim(x))) obj <- list(x) # cause is.vector() doesn't work
+ else { # matrix
+ n <- nrow(x)
+ obj <- vector("list", n)
+ for (i in seq_len(n)) obj[[i]] <- x[i, , drop = TRUE]
+ names(obj) <- rownames(x)
+ }
+ class(obj) <- "AAbin"
+ obj
+}
+
+as.matrix.AAbin <- function(x, ...)
+{
+ if (is.matrix(x)) return(x)
+ if (!is.list(x)) { # vector
+ dim(x) <- c(1, length(x))
+ return(x)
+ }
+ s <- unique(lengths(x, use.names = FALSE))
+ if (length(s) != 1)
+ stop("AA sequences in list not of the same length.")
+ n <- length(x)
+ y <- matrix(raw(), n, s)
+ for (i in seq_len(n)) y[i, ] <- x[[i]]
+ rownames(y) <- names(x)
+ class(y) <- "AAbin"
+ y
+}
diff --git a/R/PGLS.R b/R/PGLS.R
index c7dba5c..2d87327 100644
--- a/R/PGLS.R
+++ b/R/PGLS.R
@@ -1,8 +1,8 @@
-## PGLS.R (2014-12-11)
+## PGLS.R (2017-04-25)
## Phylogenetic Generalized Least Squares
-## Copyright 2004 Julien Dutheil, and 2006-2014 Emmanuel Paradis
+## Copyright 2004 Julien Dutheil, and 2006-2017 Emmanuel Paradis
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
@@ -167,9 +167,7 @@ coef.corGrafen <- function(object, unconstrained = TRUE, ...)
aux
}
-### removed node.sons() and node.leafnumber() (2006-10-12)
-
-### changed by EP (2006-10-12):
+## changed by EP (2006-10-12):
compute.brlen <- function(phy, method = "Grafen", power = 1, ...)
{
@@ -188,9 +186,9 @@ compute.brlen <- function(phy, method = "Grafen", power = 1, ...)
}
if (is.character(method)) { # == "Grafen"
tr <- reorder(phy, "postorder")
- xx <- .C(node_depth, as.integer(Ntip), as.integer(Nnode),
+ xx <- .C(node_depth, as.integer(Ntip),
as.integer(tr$edge[, 1]), as.integer(tr$edge[, 2]),
- as.integer(Nedge), double(Ntip + Nnode), 1L)[[6]] - 1
+ as.integer(Nedge), double(Ntip + Nnode), 1L)[[5]] - 1
m <- Ntip - 1
phy$edge.length <-
(xx[phy$edge[, 1]]/m)^power - (xx[phy$edge[, 2]]/m)^power
diff --git a/R/RcppExports.R b/R/RcppExports.R
new file mode 100644
index 0000000..1c629c5
--- /dev/null
+++ b/R/RcppExports.R
@@ -0,0 +1,15 @@
+# Generated by using Rcpp::compileAttributes() -> do not edit by hand
+# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
+
+bipartition2 <- function(orig, nTips) {
+ .Call(`_ape_bipartition2`, orig, nTips)
+}
+
+prop_part2 <- function(trees, nTips) {
+ .Call(`_ape_prop_part2`, trees, nTips)
+}
+
+reorderRcpp <- function(orig, nTips, root, order) {
+ .Call(`_ape_reorderRcpp`, orig, nTips, root, order)
+}
+
diff --git a/R/ace.R b/R/ace.R
index 6da4b39..37c6ef4 100644
--- a/R/ace.R
+++ b/R/ace.R
@@ -1,8 +1,8 @@
-## ace.R (2016-06-08)
+## ace.R (2017-04-25)
## Ancestral Character Estimation
-## Copyright 2005-2016 Emmanuel Paradis and Ben Bolker
+## Copyright 2005-2017 Emmanuel Paradis and Ben Bolker
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
@@ -86,15 +86,15 @@ ace <-
phenotype <- numeric(nb.tip + nb.node)
phenotype[1:nb.tip] <- if (is.null(names(x))) x else x[phy$tip.label]
contr <- var.con <- numeric(nb.node)
- ans <- .C(C_pic, as.integer(nb.tip), as.integer(nb.node),
+ ans <- .C(C_pic, as.integer(nb.tip),
as.integer(phy$edge[, 1]), as.integer(phy$edge[, 2]),
as.double(phy$edge.length), as.double(phenotype),
as.double(contr), as.double(var.con),
as.integer(CI), as.integer(scaled))
- obj$ace <- ans[[6]][-(1:nb.tip)]
+ obj$ace <- ans[[5]][-(1:nb.tip)]
names(obj$ace) <- nb.tip + 1:nb.node
if (CI) {
- se <- sqrt(ans[[8]])
+ se <- sqrt(ans[[7]])
tmp <- se * qnorm(0.025)
obj$CI95 <- cbind(obj$ace + tmp, obj$ace - tmp)
}
diff --git a/R/alex.R b/R/alex.R
index ab846a7..c0163ca 100644
--- a/R/alex.R
+++ b/R/alex.R
@@ -1,8 +1,8 @@
-## alex.R (2012-03-27)
+## alex.R (2017-04-18)
## Alignment Explorer With Multiple Devices
-## Copyright 2012 Emmanuel Paradis
+## Copyright 2012-2017 Emmanuel Paradis
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
@@ -19,6 +19,7 @@ Right-click to exit.\n")
repeat {
xy <- locator(2)
if (is.null(xy)) break
+ xy$y <- n - xy$y + 1
xy <- lapply(xy, function(x) sort(round(x)))
i1 <- xy$y[1L]; i2 <- xy$y[2L]
j1 <- xy$x[1L]; j2 <- xy$x[2L]
diff --git a/R/apetools.R b/R/apetools.R
index 090498f..7fb9e78 100644
--- a/R/apetools.R
+++ b/R/apetools.R
@@ -1,14 +1,14 @@
-## apetools.R (2017-02-03)
+## apetools.R (2017-08-31)
## APE Tools
-## Copyright 2005-2017 Emmanuel Paradis
+## Copyright 2017 Emmanuel Paradis
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
.file.extensions <-
- list(clustal = "aln", fasta = c("fas", "fasta"),
+ list(clustal = "aln", fasta = c("fas", "fasta", "fa"),
fastq = c("fq", "fastq"), newick = c("nwk", "newick", "tre", "tree"),
nexus = c("nex", "nexus"), phylip = "phy")
@@ -81,3 +81,100 @@ bydir <- function(x)
top <- unlist(lapply(SPLIT, "[", 1L))
for (z in unique(top)) foo(1L, z)
}
+
+Xplor <- function()
+{
+ ext <- if (exists(".file.extensions", envir = .PlotPhyloEnv))
+ get(".file.extensions", envir = .PlotPhyloEnv)
+ else .file.extensions
+
+ OUT <- paste0(tempfile(), ".html")
+ mycat <- function(...) cat(..., sep = "", file = OUT, append = TRUE)
+
+ FILES <- Xplorefiles()
+ filetypes <- names(FILES)
+ ## nb of files of each type:
+ NR <- sapply(FILES, nrow)
+
+ ## HTML header
+ mycat('<html><title>Files Sorted by Type</title></head>')
+
+ ## build the TOC
+ mycat('<h2>File types searched:</h2>')
+ mycat('<TABLE border=0>')
+ mycat('<tr><th align="center"> Type </th><th align="center"> Number of files </th><th align="center"> Extensions* </th></tr>')
+ for (type in filetypes) {
+ mycat('<tr><td><a href=#', type, '>', type, '</a></td><td align="center">', NR[type],
+ '</td><td align="center">', paste(paste0(".", ext[[type]]), collapse = " "), '</td></tr>')
+ }
+ mycat('</TABLE>')
+
+ mycat('<br>*Case-independent<br>To change the files extensions, type in R: <font face = "courier">editFileExtensions()</font><br>')
+
+ if (all(NR == 0)) {
+ browseURL(OUT)
+ return(invisible(NULL))
+ }
+
+ OUTBYDIR <- paste0(tempfile(), ".html")
+ sink(OUTBYDIR)
+ cat('<html><title>Files Sorted by Directory</title></head>')
+ .bydir.html(FILES)
+ cat('</html>')
+ sink(NULL)
+ mycat('<br><a target="blank" href=', OUTBYDIR, '><h2>Files sorted by directory (in new tab)</h2></a><br>')
+
+ for (type in filetypes) {
+ nr <- NR[type]
+ mycat('<a name=', type, '></a><h1>', toupper(type), '</h1>')
+ if (nr == 0) {
+ mycat('no file of this type')
+ next
+ }
+ DF <- FILES[[type]]
+ mycat('<TABLE border=1>')
+ mycat('<tr><th> File name </th><th align="center"> Size (KB) </th></tr>')
+ for (i in 1:nr)
+ mycat('<tr><td><a href="file://', DF[i, 1], '">', DF[i, 1],
+ '</a></td><td align="right">', round(DF[i, 2]/1000, 1), '</td></tr>')
+ mycat('</TABLE>')
+ }
+ mycat('</html>')
+ browseURL(OUT)
+}
+
+.bydir.html <- function(x)
+{
+ nofile <- which(sapply(x, nrow) == 0)
+ if (length(nofile)) x <- x[-nofile]
+ if (!length(x)) return(NULL)
+ for (i in seq_along(x)) x[[i]]$Type <- names(x)[i]
+ x <- do.call(rbind, x)
+ x <- x[order(x$File), ]
+ SPLIT <- strsplit(x$File, "/")
+ LL <- lengths(SPLIT)
+ foo <- function(i, PATH) {
+ K <- grep(paste0("^", PATH, "/"), x$File)
+ sel <- intersect(K, which(LL == i + 1L))
+ if (length(sel)) {
+ y <- x[sel, ]
+ y$File <- gsub(".*/", "", y$File)
+ cat('<h2><a href="file://', PATH, '">', PATH, '/</a></h2>', sep = "")
+ cat('<TABLE border=1>')
+ cat('<tr><th> File </th><th align="center"> Size (KB) </th><th align="center"> Type </th></tr>')
+ for (i in 1:nrow(y))
+ cat('<tr><td><a href="file://', PATH, '/', y[i, 1], '">', y[i, 1],
+ '</a></td><td align="right">', round(y[i, 2]/1000, 1),
+ '</td><td align="right">', y[i, 3], '</td></tr>', sep = "")
+ cat('</TABLE><br>')
+ }
+ if (length(sel) < length(K)) {
+ d <- setdiff(K, sel)
+ subdir <- unlist(lapply(SPLIT[d], "[", i + 1L))
+ for (z in unique(subdir))
+ foo(i + 1L, paste(PATH, z, sep = "/"))
+ }
+ }
+ top <- unlist(lapply(SPLIT, "[", 1L))
+ for (z in unique(top)) foo(1L, z)
+}
diff --git a/R/as.phylo.R b/R/as.phylo.R
index 63b6fee..16583bf 100644
--- a/R/as.phylo.R
+++ b/R/as.phylo.R
@@ -1,8 +1,8 @@
-## as.phylo.R (2015-10-16)
+## as.phylo.R (2017-06-05)
## Conversion Among Tree Objects
-## Copyright 2005-2015 Emmanuel Paradis
+## Copyright 2005-2017 Emmanuel Paradis
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
@@ -97,7 +97,10 @@ as.hclust.phylo <- function(x, ...)
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)])
+ bt <- bt[as.character(anc)] # 1st, reorder
+ ## 2nd, sort keeping the root branching time in last (in case of
+ ## rounding error if there zero-lengthed branches nead the root)
+ bt <- c(sort(bt[-N]), bt[N])
o <- match(names(bt), anc)
m <- m[o, ]
@@ -132,7 +135,10 @@ as.igraph.phylo <- function(x, directed = is.rooted(x), use.labels = TRUE, ...)
directed <- directed
if (use.labels) {
if (is.null(x$node.label)) x <- makeNodeLabel(x)
+ ## check added by Klaus:
+ if(any(duplicated(c(x$tip.label, x$node.label))))
+ stop("Duplicated labels!")
x$edge <- matrix(c(x$tip.label, x$node.label)[x$edge], ncol = 2)
- } else x$edge <- x$edge - 1L
+ }# else x$edge <- x$edge - 1L # changed in graph 1.0+, not needed anymore
graph.edgelist(x$edge, directed = directed, ...)
}
diff --git a/R/biplot.pcoa.R b/R/biplot.pcoa.R
index 9ba8809..f4047b1 100644
--- a/R/biplot.pcoa.R
+++ b/R/biplot.pcoa.R
@@ -1,49 +1,63 @@
'biplot.pcoa' <-
- function(x, Y=NULL, plot.axes = c(1,2), dir.axis1=1, dir.axis2=1, rn=NULL, ...)
+ function(x, Y=NULL, plot.axes=c(1,2), dir.axis1=1, dir.axis2=1,rn=NULL,main=NULL, ...)
# x = output object from function pcoa.R
# Y = optional sites-by-variables data table
# plot.axes = the two axes to be plotted
-# rn = an optional vector, length n, of object labels
# dir.axis.1 = -1 to revert axis 1 for the projection of points and variables
# dir.axis.2 = -1 to revert axis 2 for the projection of points and variables
+# rn = an optional vector, length n, of object name labels
+# Customize the title of the biplot with argument 'main'. Ex.: main="My own PCoA title".
#
-# Author: Pierre Legendre, January 2009
+# Corrected version, March 2017 - This version draws biplots from the principal coordinates (x$vectors.cor) with Lingoes or Cailliez correction, when applicable.
+#
+# Author: Pierre Legendre, January 2009, March 2017
{
- k <- ncol(x$vectors)
+ if (!inherits(x, "pcoa")) stop("Object of class 'pcoa' expected")
+ pr.coo <- x$vectors
+ if(x$correction[2] > 1) pr.coo <- x$vectors.cor
+ k <- ncol(pr.coo)
if(k < 2) stop("There is a single eigenvalue. No plot can be produced.")
if(k < plot.axes[1]) stop("Axis",plot.axes[1],"does not exist.")
if(k < plot.axes[2]) stop("Axis",plot.axes[2],"does not exist.")
- if(!is.null(rn)) rownames(x$vectors) <- rn
- labels = colnames(x$vectors[,plot.axes])
+ if(!is.null(rn)) rownames(pr.coo) <- rn
+ labels = colnames(pr.coo[,plot.axes])
diag.dir <- diag(c(dir.axis1,dir.axis2))
- x$vectors[,plot.axes] <- x$vectors[,plot.axes] %*% diag.dir
+ pr.coo[,plot.axes] <- pr.coo[,plot.axes] %*% diag.dir
if(is.null(Y)) {
- limits <- apply(x$vectors[,plot.axes], 2, range)
+ limits <- apply(pr.coo[,plot.axes], 2, range)
ran.x <- limits[2,1] - limits[1,1]
ran.y <- limits[2,2] - limits[1,2]
xlim <- c((limits[1,1]-ran.x/10), (limits[2,1]+ran.x/5))
ylim <- c((limits[1,2]-ran.y/10), (limits[2,2]+ran.y/10))
par(mai = c(1.0, 1.0, 1.0, 0.5))
- plot(x$vectors[,plot.axes], xlab=labels[1], ylab=labels[2], xlim=xlim, ylim=ylim, asp=1)
- text(x$vectors[,plot.axes], labels=rownames(x$vectors), pos=4, cex=1, offset=0.5)
- title(main = "PCoA ordination", line=2.5)
+ plot(pr.coo[,plot.axes],xlab=labels[1],ylab=labels[2],xlim=xlim,ylim=ylim,asp=1)
+ text(pr.coo[,plot.axes], labels=rownames(pr.coo), pos=4, cex=1, offset=0.5)
+ if(is.null(main)) {
+ title(main = "PCoA ordination", line=2)
+ } else {
+ title(main = main, family="serif", line=2)
+ }
} else {
# Find positions of variables in biplot:
# construct U from covariance matrix between Y and standardized point vectors
# (equivalent to PCA scaling 1, since PCoA preserves distances among objects)
n <- nrow(Y)
- points.stand <- scale(x$vectors[,plot.axes])
+ points.stand <- scale(pr.coo[,plot.axes])
S <- cov(Y, points.stand)
U <- S %*% diag((x$values$Eigenvalues[plot.axes]/(n-1))^(-0.5))
- colnames(U) <- colnames(x$vectors[,plot.axes])
+ colnames(U) <- colnames(pr.coo[,plot.axes])
par(mai = c(1, 0.5, 1.4, 0))
- biplot(x$vectors[,plot.axes], U, xlab=labels[1], ylab=labels[2])
- title(main = c("PCoA biplot","Response variables projected","as in PCA with scaling 1"), line=4)
+ biplot(pr.coo[,plot.axes], U, xlab=labels[1], ylab=labels[2])
+ if(is.null(main)) {
+ title(main = c("PCoA biplot","Response variables projected","as in PCA with scaling 1"), line=4)
+ } else {
+ title(main = main, family="serif")
+ }
}
invisible()
}
diff --git a/R/chronoMPL.R b/R/chronoMPL.R
index c859ee8..e01d91c 100644
--- a/R/chronoMPL.R
+++ b/R/chronoMPL.R
@@ -1,8 +1,8 @@
-## chronoMPL.R (2007-08-29)
+## chronoMPL.R (2017-04-25)
## Molecular Dating with Mean Path Lengths
-## Copyright 2007 Emmanuel Paradis
+## Copyright 2007-2017 Emmanuel Paradis
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
@@ -14,9 +14,9 @@ chronoMPL <- function(phy, se = TRUE, test = TRUE)
m <- phy$Nnode
N <- dim(phy$edge)[1]
obj <- reorder(phy, "postorder")
- ndesc <- .C(node_depth, as.integer(n), as.integer(m),
+ ndesc <- .C(node_depth, as.integer(n),
as.integer(obj$edge[, 1]), as.integer(obj$edge[, 2]),
- as.integer(N), double(n + m), 1L)[[6]]
+ as.integer(N), double(n + m), 1L)[[5]]
s <- numeric(n + m) # sum of path lengths
if (se) ss <- s
if (test) Pval <- numeric(m)
diff --git a/R/collapse.singles.R b/R/collapse.singles.R
index ae99159..2c163a3 100644
--- a/R/collapse.singles.R
+++ b/R/collapse.singles.R
@@ -1,20 +1,32 @@
-## collapse.singles.R (2015-06-22)
+## collapse.singles.R (2017-07-27)
-## Collapse "Single" Nodes
+## Collapse "Single" Nodes
-## Copyright 2015 Emmanuel Paradis
+## Copyright 2015 Emmanuel Paradis, 2017 Klaus Schliep
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
+has.singles <- function(tree)
+{
+ fun <- function(x) {
+ tab <- tabulate(x$edge[, 1])
+ if (any(tab == 1L)) return(TRUE)
+ FALSE
+ }
+ if (inherits(tree, "phylo")) return(fun(tree))
+ if (inherits(tree, "multiPhylo")) return(sapply(tree, fun))
+}
+
collapse.singles <- function(tree, root.edge = FALSE)
{
n <- length(tree$tip.label)
+ tree <- reorder(tree) # this works now
e1 <- tree$edge[, 1]
e2 <- tree$edge[, 2]
tab <- tabulate(e1)
- if (all(tab > 1)) return(tree)
+ if (all(tab[-c(1:n)] > 1)) return(tree) # tips are zero
if (is.null(tree$edge.length)) {
root.edge <- FALSE
@@ -40,19 +52,17 @@ collapse.singles <- function(tree, root.edge = FALSE)
}
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]
+ if (length(singles) > 0) {
+ ii <- sort(match(singles, e1), decreasing = TRUE)
+ jj <- match(e1[ii], e2)
+ for (i in 1:length(singles)) {
+ e2[jj[i]] <- e2[ii[i]]
+ if (wbl) el[jj[i]] <- el[jj[i]] + el[ii[i]]
}
- e1 <- e1[-i]
- e2 <- e2[-i]
- singles <- which(tabulate(e1) == 1)
+ e1 <- e1[-ii]
+ e2 <- e2[-ii]
+ if (wbl) el <- el[-ii]
}
-
Nnode <- length(e1) - n + 1L
oldnodes <- unique(e1)
@@ -71,3 +81,5 @@ collapse.singles <- function(tree, root.edge = FALSE)
}
tree
}
+
+
diff --git a/R/dist.topo.R b/R/dist.topo.R
index 4e7f0af..3cd9c4a 100644
--- a/R/dist.topo.R
+++ b/R/dist.topo.R
@@ -1,9 +1,9 @@
-## dist.topo.R (2016-11-24)
+## dist.topo.R (2017-07-28)
## Topological Distances, Tree Bipartitions,
## Consensus Trees, and Bootstrapping Phylogenies
-## Copyright 2005-2016 Emmanuel Paradis, 2016 Klaus Schliep
+## Copyright 2005-2017 Emmanuel Paradis, 2016-2017 Klaus Schliep
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
@@ -17,47 +17,73 @@
dist.topo <- function(x, y = NULL, method = "PH85")
{
- if (!is.null(y)) {
- res <- .dist.topo(x, y, method = method)
- } else {
- n <- length(x) # number of trees
- res <- numeric(n * (n - 1) /2)
- nms <- names(x)
- if (is.null(nms)) nms <- paste0("tree", 1:n)
+ method <- match.arg(method, c("PH85", "score"))
+ if (!is.null(y)) x <- c(x, y)
+ testroot <- any(is.rooted(x))
+ n <- length(x) # number of trees
+ res <- numeric(n * (n - 1) /2)
+ nms <- names(x)
+ if (is.null(nms)) nms <- paste0("tree", 1:n)
+
+ if (method == "PH85") {
+ if (testroot)
+ warning("Some trees were rooted: topological distances may be spurious.")
+
+ x <- .compressTipLabel(x)
+ ntip <- length(attr(x, "TipLabel"))
+ nnode <- sapply(x, Nnode)
+
+ foo <- function(phy, ntip) {
+ phy <- reorder(phy, "postorder")
+ ans <- ONEwise(bipartition2(phy$edge, ntip))
+ sapply(ans, paste, collapse = "\r")
+ }
+
+ x <- lapply(x, foo, ntip = ntip)
+
+ k <- 0L
+ for (i in 1:(n - 1)) {
+ y <- x[[i]]
+ m1 <- nnode[i]
+ for (j in (i + 1):n) {
+ z <- x[[j]]
+ k <- k + 1L
+ res[k] <- m1 + nnode[j] - 2 * sum(z %in% y)
+ }
+ }
+ } else { # method == "score"
k <- 0L
for (i in 1:(n - 1)) {
for (j in (i + 1):n) {
k <- k + 1L
- res[k] <- .dist.topo(x[[i]], x[[j]], method = method)
+ ## still very slow......
+ res[k] <- .dist.topo.score(x[[i]], x[[j]])
}
}
- attr(res, "Size") <- n
- attr(res, "Labels") <- nms
- attr(res, "Diag") <- attr(res, "Upper") <- FALSE
- attr(res, "method") <- method
- class(res) <- "dist"
}
+
+ attr(res, "Size") <- n
+ attr(res, "Labels") <- nms
+ attr(res, "Diag") <- attr(res, "Upper") <- FALSE
+ attr(res, "method") <- method
+ class(res) <- "dist"
res
}
-.dist.topo <- function(x, y, method = "PH85")
+.dist.topo.score <- function(x, y)
{
- if (method == "PH85") {
- bs <- bitsplits(unroot.multiPhylo(c(x, y)))
- return(sum(bs$freq == 1))
- }
-
- ## method == "score":
if (is.null(x$edge.length) || is.null(y$edge.length))
stop("trees must have branch lengths for branch score distance.")
nx <- length(x$tip.label)
- x <- unroot(x)
- y <- unroot(y)
- bp1 <- .Call(bipartition, x$edge, nx, x$Nnode)
+ x <- reorder.phylo(unroot(x), "postorder")
+ y <- reorder.phylo(unroot(y), "postorder")
+ ##bp1 <- .Call(bipartition, x$edge, nx, x$Nnode)
+ bp1 <- bipartition2(x$edge, nx)
bp1 <- lapply(bp1, function(xx) sort(x$tip.label[xx]))
ny <- length(y$tip.label) # fix by Otto Cordero
## fix by Tim Wallstrom:
- bp2.tmp <- .Call(bipartition, y$edge, ny, y$Nnode)
+ bp2.tmp <- bipartition2(y$edge, ny)
+ ##bp2.tmp <- .Call(bipartition, y$edge, ny, y$Nnode)
bp2 <- lapply(bp2.tmp, function(xx) sort(y$tip.label[xx]))
bp2.comp <- lapply(bp2.tmp, function(xx) setdiff(1:ny, xx))
bp2.comp <- lapply(bp2.comp, function(xx) sort(y$tip.label[xx]))
@@ -126,11 +152,12 @@ prop.part <- function(..., check.labels = TRUE)
class(obj) <- NULL # fix by Klaus Schliep (2014-03-06)
for (i in 1:ntree) storage.mode(obj[[i]]$Nnode) <- "integer"
class(obj) <- "multiPhylo"
- obj <- .uncompressTipLabel(obj) # fix a bug (2010-11-18)
- clades <- .Call(prop_part, obj, ntree, TRUE)
- attr(clades, "number") <- attr(clades, "number")[1:length(clades)]
+ obj <- reorder(obj, "postorder")
+# the following line should not be necessary any more
+# obj <- .uncompressTipLabel(obj) # fix a bug (2010-11-18)
+ nTips <- length(obj[[1]]$tip.label)
+ clades <- prop_part2(obj, nTips)
attr(clades, "labels") <- obj[[1]]$tip.label
- class(clades) <- "prop.part"
clades
}
diff --git a/R/drop.tip.R b/R/drop.tip.R
index 5187919..9261138 100644
--- a/R/drop.tip.R
+++ b/R/drop.tip.R
@@ -1,13 +1,13 @@
-## drop.tip.R (2017-02-14)
+## drop.tip.R (2017-07-27)
## Remove Tips in a Phylogenetic Tree
-## Copyright 2003-2017 Emmanuel Paradis
+## Copyright 2003-2017 Emmanuel Paradis, 2017 Klaus Schliep
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
-extract.clade <- function(phy, node, root.edge = 0, interactive = FALSE)
+extract.clade <- function(phy, node, root.edge = 0, collapse.singles = TRUE, interactive = FALSE)
{
n <- length(phy$tip.label)
if (interactive) {
@@ -29,12 +29,14 @@ extract.clade <- function(phy, node, root.edge = 0, interactive = FALSE)
}
if (node == n + 1L) return(phy)
keep <- prop.part(phy)[[node - n]]
- drop.tip(phy, (1:n)[-keep], root.edge = root.edge, rooted = TRUE)
+ drop.tip(phy, (1:n)[-keep], root.edge = root.edge, rooted = TRUE,
+ collapse.singles = collapse.singles)
}
drop.tip <-
function(phy, tip, trim.internal = TRUE, subtree = FALSE,
- root.edge = 0, rooted = is.rooted(phy), interactive = FALSE)
+ root.edge = 0, rooted = is.rooted(phy), collapse.singles = TRUE,
+ interactive = FALSE)
{
if (!inherits(phy, "phylo"))
stop('object "phy" is not of class "phylo"')
@@ -95,9 +97,9 @@ drop.tip <-
if (subtree) {
trim.internal <- TRUE
tr <- reorder(phy, "postorder")
- N <- .C(node_depth, as.integer(Ntip), as.integer(Nnode),
+ N <- .C(node_depth, as.integer(Ntip),
as.integer(tr$edge[, 1]), as.integer(tr$edge[, 2]),
- as.integer(Nedge), double(Ntip + Nnode), 1L)[[6]]
+ as.integer(Nedge), double(Ntip + Nnode), 1L)[[5]]
}
edge1 <- phy$edge[, 1] # local copies
@@ -199,6 +201,6 @@ drop.tip <-
storage.mode(phy$edge) <- "integer"
if (!is.null(phy$node.label)) # update node.label if needed
phy$node.label <- phy$node.label[which(newNb > 0) - Ntip]
- collapse.singles(phy)
+ if (collapse.singles) phy <- collapse.singles(phy)
+ phy
}
-
diff --git a/R/evonet.R b/R/evonet.R
index e52571f..cce599c 100644
--- a/R/evonet.R
+++ b/R/evonet.R
@@ -1,8 +1,8 @@
-## evonet.R (2012-09-14)
+## evonet.R (2017-07-28)
## Evolutionary Networks
-## Copyright 2011-2012 Emmanuel Paradis
+## Copyright 2011-2012 Emmanuel Paradis, 2017 Klaus Schliep
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
@@ -56,11 +56,12 @@ as.phylo.evonet <- function(x, ...)
plot.evonet <- function(x, col = "blue", lty = 1, lwd = 1, alpha = 0.5,
arrows = 0, arrow.type = "classical", ...)
{
- plot.phylo(as.phylo(x), ...)
+ ## changed 5/24/17 by Klaus
+ plot.phylo(x, ...)
edges(x$reticulation[, 1], x$reticulation[, 2],
col = rgb(t(col2rgb(col)), alpha = 255 * alpha,
- maxColorValue = 255), lty = lty, lwd = lwd,
- arrows = arrows, type = arrow.type)
+ maxColorValue = 255),
+ lty = lty, lwd = lwd, arrows = arrows, type = arrow.type)
}
as.networx.evonet <- function(x, weight = NA, ...)
@@ -90,6 +91,18 @@ as.igraph.evonet <- function(x, directed = TRUE, use.labels = TRUE, ...)
{
class(x) <- NULL
x$edge <- rbind(x$edge, x$reticulation)
+ ## added check by Klaus (2017-05-26)
+ if (use.labels) {
+ if (!is.null(x$node.label)){
+ tmp <- nchar(x$node.label)
+ if (any(tmp == 0)){
+ newLabel <- paste0("number", 1:x$Nnode)
+ x$node.label[tmp == 0] <- newLabel[tmp == 0]
+ }
+ }
+ if (any(duplicated(c(x$tip.label, x$node.label))))
+ stop("Duplicated labels!")
+ }
as.igraph.phylo(x, directed = directed, use.labels = use.labels, ...)
}
@@ -101,3 +114,102 @@ print.evonet <- function(x, ...)
cat("\n\n --- Base tree ---")
print.phylo(as.phylo(x))
}
+
+## new stuff by Klaus (2017-05-26)
+
+reorder.evonet <- function(x, order = "cladewise", index.only = FALSE, ...)
+{
+ reticulation <- x$reticulation
+ y <- reorder(as.phylo(x), order = order, index.only = index.only, ...)
+ if (index.only) return(y)
+ y$reticulation <- reticulation
+ class(y) <- c("evonet", "phylo")
+ y
+}
+
+## requires topo_sort from igraph, behaviour different from phylo
+## (postorder seems to work fine)
+## if no singletons are in edge reorder.phylo could be used
+## if (getRversion() >= "2.15.1") utils::globalVariables(c("topo_sort", "graph"))
+## reorder.evonet <- function(x, order = "cladewise", index.only = FALSE, ...)
+## {
+## order <- match.arg(order, c("cladewise", "postorder"))
+## if (!is.null(attr(x, "order")))
+## if (attr(x, "order") == order) return(x)
+## g <- graph(t(x$edge))
+## neword <- if (order == "cladewise") topo_sort(g, "out") else topo_sort(g, "in")
+## neworder <- order(match(x$edge[, 1], neword))
+## if (index.only) return(neworder)
+## x$edge <- x$edge[neworder, ]
+## if (!is.null(x$edge.length)) x$edge.length <- x$edge.length[neworder]
+## attr(x, "order") <- order
+## x
+## }
+
+as.evonet <- function(x, ...)
+{
+ if (inherits(x, "evonet")) return(x)
+ UseMethod("as.evonet")
+}
+
+as.evonet.phylo <- function(x, ...)
+{
+ pos <- grep("#", x$tip.label)
+ ind <- match(pos, x$edge[, 2])
+ reticulation <- x$edge[ind, , drop = FALSE]
+ edge <- x$edge[-ind, , drop = FALSE]
+ nTips <- as.integer(length(x$tip.label))
+ reticulation[, 2] <- as.integer(match(x$tip.label[pos], x$node.label) + nTips)
+ for (i in sort(pos, TRUE)) {
+ edge[edge > i ] <- edge[edge > i] - 1L
+ reticulation[reticulation > i] <- reticulation[reticulation > i] - 1L
+ }
+ x$edge <- edge
+ x$reticulation <- reticulation
+ if (!is.null(x$edge.length)) x$edge.length <- x$edge.length[-ind]
+ x$tip.label <- x$tip.label[-pos]
+ class(x) <- c("evonet", "phylo")
+ x
+}
+
+## requires new version of clado.build and tree.build
+read.evonet <- function(file = "", text = NULL, comment.char = "", ...)
+{
+ x <- read.tree(file = file, text = text, comment.char = comment.char, ...)
+ as.evonet.phylo(x)
+}
+
+.evonet2phylo <- function(x)
+{
+ nTips <- as.integer(length(x$tip.label))
+ if (!is.null(x$edge.length)) {
+ nd <- node.depth.edgelength(x)
+ x$edge.length <- c(x$edge.length, nd[x$reticulation[, 2]] - nd[x$reticulation[, 1]])
+ }
+ if (!is.null(x$node.label))
+ x$tip.label <- c(x$tip.label, x$node.label[x$reticulation[, 2] - nTips])
+ else {
+ newLabels <- paste0("#H", x$reticulation[, 2])
+ x$tip.label <- c(x$tip.label, newLabels)
+ x$node.label <- rep("", x$Nnode)
+ ind <- which((x$reticulation[, 2] > nTips) & !duplicated(x$reticulation[, 2]))
+ x$node.label[x$reticulation[ind, 2] - nTips] <- newLabels[ind]
+ }
+ nrets <- as.integer(nrow(x$reticulation))
+ x$edge[x$edge > nTips] <- x$edge[x$edge > nTips] + nrets
+ x$reticulation[, 1] <- x$reticulation[, 1] + nrets
+ x$reticulation[, 2] <- nTips + (1L:nrets)
+ x$edge <- rbind(x$edge, x$reticulation)
+ x$reticulation <- NULL
+ attr(x, "order") <- NULL
+ class(x) <- "phylo"
+ x
+}
+
+write.evonet <- function(x, file = "", ...)
+{
+ x <- .evonet2phylo(x)
+ write.tree(x, file = file, ...)
+}
+
+Nedge.evonet <- function(phy) dim(phy$edge)[1] + dim(phy$reticulation)[1]
diff --git a/R/is.compatible.R b/R/is.compatible.R
index 522e4f7..3712d66 100644
--- a/R/is.compatible.R
+++ b/R/is.compatible.R
@@ -1,4 +1,4 @@
-## is.compatible.R (2011-10-11)
+## is.compatible.R (2017-06-03)
## Check Compatibility of Splits
@@ -32,5 +32,5 @@ arecompatible <-function(x, y, n)
}
nE <- foo(x & y) + foo(x & !y) + foo(!x & y) + foo(!x & !y)
- if (nE == 1) TRUE else FALSE
+ if (nE >= 1) TRUE else FALSE
}
diff --git a/R/ladderize.R b/R/ladderize.R
index 664d777..8305a3e 100644
--- a/R/ladderize.R
+++ b/R/ladderize.R
@@ -1,8 +1,8 @@
-## ladderize.R (2015-10-04)
+## ladderize.R (2017-04-25)
## Ladderize a Tree
-## Copyright 2007-2015 Emmanuel Paradis
+## Copyright 2007-2017 Emmanuel Paradis
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
@@ -30,9 +30,9 @@ ladderize <- function(phy, right = TRUE)
nb.node <- phy$Nnode
nb.edge <- dim(phy$edge)[1]
tmp <- reorder(phy, "postorder")
- N <- .C(node_depth, as.integer(nb.tip), as.integer(nb.node),
+ N <- .C(node_depth, as.integer(nb.tip),
as.integer(tmp$edge[, 1]), as.integer(tmp$edge[, 2]),
- as.integer(nb.edge), double(nb.tip + nb.node), 1L)[[6]]
+ as.integer(nb.edge), double(nb.tip + nb.node), 1L)[[5]]
neworder <- integer(nb.edge)
foo(nb.tip + 1, nb.edge, 1)
phy$edge <- phy$edge[neworder, ]
diff --git a/R/makeLabel.R b/R/makeLabel.R
index f34dd64..2f94ab7 100644
--- a/R/makeLabel.R
+++ b/R/makeLabel.R
@@ -1,4 +1,4 @@
-## makeLabel.R (2016-06-08)
+## makeLabel.R (2017-05-06)
## Label Management
@@ -64,7 +64,7 @@ makeLabel.multiPhylo <- function(x, tips = TRUE, nodes = TRUE, ...)
makeLabel.DNAbin <- function(x, ...)
{
- if (is.vector(x) || is.list(x))
+ if (is.list(x))
names(x) <- makeLabel.character(names(x), ...)
else rownames(x) <- makeLabel.character(rownames(x), ...)
x
diff --git a/R/mrca.R b/R/mrca.R
index 0c4b429..76a4629 100644
--- a/R/mrca.R
+++ b/R/mrca.R
@@ -1,8 +1,8 @@
-## mrca.R (2009-05-10)
+## mrca.R (2017-07-28)
## Find Most Recent Common Ancestors Between Pairs
-## Copyright 2005-2009 Emmanuel Paradis
+## Copyright 2005-2017 Emmanuel Paradis
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
@@ -10,43 +10,46 @@
mrca <- function(phy, full = FALSE)
{
if (!inherits(phy, "phylo")) stop('object "phy" is not of class "phylo"')
- ## if (!is.rooted(phy)) stop("the tree must be rooted.")
## Get all clades:
- nb.tip <- length(phy$tip.label)
- nb.node <- phy$Nnode
- BP <- .Call(bipartition, phy$edge, nb.tip, nb.node)
- N <- nb.tip + nb.node
- ROOT <- nb.tip + 1
+ n <- length(phy$tip.label)
+ m <- phy$Nnode
+ phy <- reorder.phylo(phy, "postorder")
+ BP <- bipartition2(phy$edge, n)
+ N <- n + m
+ ROOT <- n + 1L
## In the following matrix, numeric indexing will be used:
M <- numeric(N * N)
dim(M) <- c(N, N)
+ e1 <- phy$edge[, 1]
+ e2 <- phy$edge[, 2]
+
## We start at the root:
next.node <- ROOT
while (length(next.node)) {
tmp <- numeric(0)
for (anc in next.node) {
## Find the branches which `anc' is the ancestor...:
- id <- which(phy$edge[, 1] == anc)
+ id <- which(e1 == anc)
## ... and get their descendants:
- desc <- phy$edge[id, 2]
+ desc <- e2[id]
## `anc' is itself the MRCA of its direct descendants:
M[anc, desc] <- M[desc, anc] <- anc
## Find all 2-by-2 combinations of `desc': `anc'
## is their MRCA:
for (i in 1:length(desc))
- M[cbind(desc[i], desc[-i])] <- anc
+ M[cbind(desc[i], desc[-i])] <- anc
## If one element of `desc' is a node, then the tips it
## leads to and the other elements of `desc' have also
## `anc' as MRCA!
for (i in 1:length(desc)) {
if (desc[i] < ROOT) next
## (get the tips:)
- tips <- BP[[desc[i] - nb.tip]]
+ tips <- BP[[desc[i] - n]]
## Same thing for the nodes...
node.desc <- numeric(0)
- for (k in 1:nb.node) {
- if (k == desc[i] - nb.tip) next
+ for (k in 1:m) {
+ if (k == desc[i] - n) next
## If the clade of the current node is a
## subset of desc[i], then it is one of its
## descendants:
@@ -55,18 +58,18 @@ mrca <- function(phy, full = FALSE)
}
## all nodes and tips which are descendants of
## `desc[i]':
- ALLDESC <- c(tips, node.desc + nb.tip)
+ ALLDESC <- c(tips, node.desc + n)
M[ALLDESC, desc[-i]] <- M[desc[-i], ALLDESC] <- anc
for (j in 1:length(desc)) {
if (j == i || desc[j] < ROOT) next
- tips2 <- BP[[desc[j] - nb.tip]]
+ tips2 <- BP[[desc[j] - n]]
node.desc <- numeric(0)
- for (k in 1:nb.node) {
- if (k == desc[j] - nb.tip) next
+ for (k in 1:m) {
+ if (k == desc[j] - n) next
if (all(BP[[k]] %in% tips2))
node.desc <- c(node.desc, k)
}
- ALLDESC2 <- c(tips2, node.desc + nb.tip)
+ ALLDESC2 <- c(tips2, node.desc + n)
M[ALLDESC, ALLDESC2] <- M[ALLDESC2, ALLDESC] <- anc
}
## `anc' is also the MRCA of itself and its descendants:
@@ -74,15 +77,15 @@ mrca <- function(phy, full = FALSE)
}
## When it is done, `desc' i stored to become
## the new `next.node', if they are nodes:
- tmp <- c(tmp, desc[desc > nb.tip])
+ tmp <- c(tmp, desc[desc > n])
}
next.node <- tmp
}
M[cbind(1:N, 1:N)] <- 1:N
if (full)
- dimnames(M)[1:2] <- list(as.character(1:N))
+ dimnames(M)[1:2] <- list(as.character(1:N))
else {
- M <- M[1:nb.tip, 1:nb.tip]
+ M <- M[1:n, 1:n]
dimnames(M)[1:2] <- list(phy$tip.label)
}
M
diff --git a/R/nodelabels.R b/R/nodelabels.R
index 1f166b0..2d9d3a3 100644
--- a/R/nodelabels.R
+++ b/R/nodelabels.R
@@ -1,8 +1,8 @@
-## nodelabels.R (2014-07-31)
+## nodelabels.R (2017-03-13)
## Labelling Trees
-## Copyright 2004-2014 Emmanuel Paradis, 2006 Ben Bolker, and 2006 Jim Lemon
+## Copyright 2004-2017 Emmanuel Paradis, 2006 Ben Bolker, and 2006 Jim Lemon
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
@@ -50,7 +50,7 @@ BOTHlabels <- function(text, sel, XX, YY, adj, frame, pch, thermo,
if (missing(text)) text <- NULL
if (length(adj) == 1) adj <- c(adj, 0.5)
if (is.null(text) && is.null(pch) && is.null(thermo) && is.null(pie))
- text <- as.character(sel)
+ text <- as.character(sel)
frame <- match.arg(frame, c("rect", "circle", "none"))
args <- list(...)
CEX <- if ("cex" %in% names(args)) args$cex else par("cex")
@@ -163,12 +163,31 @@ tiplabels <-
function(text, tip, adj = c(0.5, 0.5), frame = "rect",
pch = NULL, thermo = NULL, pie = NULL, piecol = NULL,
col = "black", bg = "yellow", horiz = FALSE,
- width = NULL, height = NULL, ...)
+ width = NULL, height = NULL, offset = 0, ...)
{
lastPP <- get("last_plot.phylo", envir = .PlotPhyloEnv)
if (missing(tip)) tip <- 1:lastPP$Ntip
XX <- lastPP$xx[tip]
YY <- lastPP$yy[tip]
+ if (offset != 0) {
+ if (lastPP$type %in% c("phylogram", "cladogram")) {
+ switch(lastPP$direction,
+ "rightwards" = {XX <- XX + offset},
+ "leftwards" = {XX <- XX - offset},
+ "upwards" = {YY <- YY + offset},
+ "downwards" = {YY <- YY - offset})
+ } else {
+ if (lastPP$type %in% c("fan", "radial")) {
+ tmp <- rect2polar(XX, YY)
+ tmp <- polar2rect(tmp$r + offset, tmp$angle)
+ XX <- tmp$x
+ YY <- tmp$y
+ } else {
+ if (lastPP$type == "unrooted")
+ warning("argument 'offset' ignored with unrooted trees")
+ }
+ }
+ }
BOTHlabels(text, tip, XX, YY, adj, frame, pch, thermo,
pie, piecol, col, bg, horiz, width, height, ...)
}
diff --git a/R/pcoa.R b/R/pcoa.R
index 335fd15..07cf35f 100644
--- a/R/pcoa.R
+++ b/R/pcoa.R
@@ -127,6 +127,8 @@ bstick.def <- function (n, tot.var = 1, ...) # 'bstick.default' from vegan
cum.eig.cor <- cumsum(rel.eig.cor)
k2 <- length(which(eig.cor > epsilon))
vectors.cor <- sweep(toto.cor$vectors[,1:k2], 2, sqrt(eig.cor[1:k2]), FUN="*")
+ rownames(vectors.cor) <- names
+ colnames(vectors.cor) <- colnames(vectors.cor, do.NULL = FALSE, prefix = "Axis.")
# bs <- broken.stick(k2)[,2]
bs <- bstick.def(k2)
bs <- c(bs, rep(0,(k-k2)))
@@ -138,6 +140,8 @@ bstick.def <- function (n, tot.var = 1, ...) # 'bstick.default' from vegan
if(correct == 3) cat("Problem! Negative eigenvalues are still present after Cailliez",'\n')
rel.eig.cor <- cum.eig.cor <- bs <- cum.bs <- rep(NA,n)
vectors.cor <- matrix(NA,n,2)
+ rownames(vectors.cor) <- names
+ colnames(vectors.cor) <- colnames(vectors.cor, do.NULL = FALSE, prefix = "Axis.")
} # End curly 4
res <- data.frame(eig[1:k], eig.cor[1:k], rel.eig.cor, bs, cum.eig.cor, cum.bs)
diff --git a/R/phydataplot.R b/R/phydataplot.R
index dc28b0f..a681f23 100644
--- a/R/phydataplot.R
+++ b/R/phydataplot.R
@@ -1,8 +1,8 @@
-## phydataplot.R (2015-07-16)
+## phydataplot.R (2017-10-04)
## Annotate Phylogenies
-## Copyright 2014-2015 Emmanuel Paradis
+## Copyright 2014-2017 Emmanuel Paradis
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
@@ -157,6 +157,7 @@ phydataplot <- function(x, phy, style = "bars", offset = 1, scaling = 1,
axis(1, px + x0, labels = px / scaling, line = 1)
}, mosaic = {
p <- ncol(x)
+ if (is.null(p)) p <- 1L
if (is.null(width)) {
x1 <- lastPP$x.lim[2]
width <- (x1 - x0)/p
@@ -177,17 +178,22 @@ phydataplot <- function(x, phy, style = "bars", offset = 1, scaling = 1,
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))
+ nux <- length(ux <- sort(unique.default(x)))
x <- match(x, ux)
lgd <- as.character(ux)
}
co <- funcol(nux)
+ conames <- names(co)
+ if (!is.null(conames)) co <- co[lgd]
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)
+ legend <- match.arg(legend, c("below", "side", "none"))
+ if (legend != "none") {
+ 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/pic.R b/R/pic.R
index 21e1c20..635966b 100644
--- a/R/pic.R
+++ b/R/pic.R
@@ -1,8 +1,8 @@
-## pic.R (2013-02-18)
+## pic.R (2017-08-22)
## Phylogenetically Independent Contrasts
-## Copyright 2002-2013 Emmanuel Paradis
+## Copyright 2002-2017 Emmanuel Paradis
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
@@ -37,22 +37,22 @@ pic <- function(x, phy, scaled = TRUE, var.contrasts = FALSE, rescaled.tree = FA
## No need to copy the branch lengths: they are rescaled
## in the C code, so it's important to leave the default
## `DUP = TRUE' of .C.
- ans <- .C(C_pic, as.integer(nb.tip), as.integer(nb.node),
+ ans <- .C(C_pic, as.integer(nb.tip),
as.integer(phy$edge[, 1]), as.integer(phy$edge[, 2]),
as.double(phy$edge.length), as.double(phenotype),
double(nb.node), double(nb.node),
as.integer(var.contrasts), as.integer(scaled))
- contr <- ans[[7]]
+ contr <- ans[[6]]
lbls <-
if (is.null(phy$node.label)) as.character(1:nb.node + nb.tip)
else phy$node.label
if (var.contrasts) {
- contr <- cbind(contr, ans[[8]])
+ contr <- cbind(contr, ans[[7]])
dimnames(contr) <- list(lbls, c("contrasts", "variance"))
} else names(contr) <- lbls
if (rescaled.tree) {
- phy$edge.length <- ans[[5]]
+ phy$edge.length <- ans[[4]]
contr <- list(contr = contr, rescaled.tree = phy)
}
contr
diff --git a/R/plot.phylo.R b/R/plot.phylo.R
index 3c351e0..77375fd 100644
--- a/R/plot.phylo.R
+++ b/R/plot.phylo.R
@@ -1,8 +1,8 @@
-## plot.phylo.R (2016-07-01)
+## plot.phylo.R (2017-07-27)
## Plot Phylogenies
-## Copyright 2002-2016 Emmanuel Paradis
+## Copyright 2002-2017 Emmanuel Paradis
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
@@ -23,24 +23,22 @@ plot.phylo <-
warning("found less than 2 tips in the tree")
return(NULL)
}
- if (any(tabulate(x$edge[, 1]) == 1))
- stop("there are single (non-splitting) nodes in your tree; you may need to use collapse.singles()")
+# if (any(tabulate(x$edge[, 1]) == 1))
+# stop("there are single (non-splitting) nodes in your tree; you may need to use collapse.singles()")
- .nodeHeight <- function(Ntip, Nnode, edge, Nedge, yy)
- .C(node_height, as.integer(Ntip), as.integer(Nnode),
- as.integer(edge[, 1]), as.integer(edge[, 2]),
- as.integer(Nedge), as.double(yy))[[6]]
+ .nodeHeight <- function(edge, Nedge, yy)
+ .C(node_height, as.integer(edge[, 1]), as.integer(edge[, 2]),
+ as.integer(Nedge), as.double(yy))[[4]]
.nodeDepth <- function(Ntip, Nnode, edge, Nedge, node.depth)
- .C(node_depth, as.integer(Ntip), as.integer(Nnode),
+ .C(node_depth, as.integer(Ntip),
as.integer(edge[, 1]), as.integer(edge[, 2]),
- as.integer(Nedge), double(Ntip + Nnode), as.integer(node.depth))[[6]]
+ as.integer(Nedge), double(Ntip + Nnode), as.integer(node.depth))[[5]]
.nodeDepthEdgelength <- function(Ntip, Nnode, edge, Nedge, edge.length)
- .C(node_depth_edgelength, as.integer(Ntip),
- as.integer(Nnode), as.integer(edge[, 1]),
+ .C(node_depth_edgelength, as.integer(edge[, 1]),
as.integer(edge[, 2]), as.integer(Nedge),
- as.double(edge.length), double(Ntip + Nnode))[[7]]
+ as.double(edge.length), double(Ntip + Nnode))[[5]]
Nedge <- dim(x$edge)[1]
Nnode <- x$Nnode
@@ -121,16 +119,15 @@ if (phyloORclado) {
if (type == "cladogram" && !use.edge.length) 2 else 1
if (node.pos == 1)
- yy <- .nodeHeight(Ntip, Nnode, z$edge, Nedge, yy)
+ yy <- .nodeHeight(z$edge, Nedge, yy)
else {
## node_height_clado requires the number of descendants
## for each node, so we compute `xx' at the same time
ans <- .C(node_height_clado, as.integer(Ntip),
- as.integer(Nnode), as.integer(z$edge[, 1]),
- as.integer(z$edge[, 2]), as.integer(Nedge),
- double(Ntip + Nnode), as.double(yy))
- xx <- ans[[6]] - 1
- yy <- ans[[7]]
+ as.integer(z$edge[, 1]), as.integer(z$edge[, 2]),
+ as.integer(Nedge), double(Ntip + Nnode), as.double(yy))
+ xx <- ans[[5]] - 1
+ yy <- ans[[6]]
}
if (!use.edge.length) {
if (node.pos != 2) xx <- .nodeDepth(Ntip, Nnode, z$edge, Nedge, node.depth) - 1
@@ -155,7 +152,7 @@ if (phyloORclado) {
}
switch(type, "fan" = {
- theta <- .nodeHeight(Ntip, Nnode, z$edge, Nedge, theta)
+ theta <- .nodeHeight(z$edge, Nedge, theta)
if (use.edge.length) {
r <- .nodeDepthEdgelength(Ntip, Nnode, z$edge, Nedge, z$edge.length)
} else {
@@ -179,7 +176,7 @@ if (phyloORclado) {
r <- .nodeDepth(Ntip, Nnode, z$edge, Nedge, node.depth)
r[r == 1] <- 0
r <- 1 - r/Ntip
- theta <- .nodeHeight(Ntip, Nnode, z$edge, Nedge, theta) + rotate.tree
+ theta <- .nodeHeight(z$edge, Nedge, theta) + rotate.tree
xx <- r * cos(theta)
yy <- r * sin(theta)
})
@@ -202,28 +199,39 @@ if (phyloORclado) {
if (show.tip.label) nchar.tip.label <- nchar(x$tip.label)
max.yy <- max(yy)
+ ## Function to compute the axis limit
+ ## x: vector of coordinates, must be positive (or at least the largest value)
+ ## lab: vector of labels, length(x) == length(lab)
+ ## sin: size of the device in inches
+ getLimit <- function(x, lab, sin, cex) {
+ s <- strwidth(lab, "inches", cex = cex) # width of the tip labels
+ ## if at least one string is larger than the device,
+ ## give 1/3 of the plot for the tip labels:
+ if (any(s > sin)) return(1.5 * max(x))
+ Limit <- 0
+ while (any(x > Limit)) {
+ i <- which.max(x)
+ ## 'alp' is the conversion coeff from inches to user coordinates:
+ alp <- x[i]/(sin - s[i])
+ Limit <- x[i] + alp*s[i]
+ x <- x + alp*s
+ }
+ Limit
+ }
+
if (is.null(x.lim)) {
if (phyloORclado) {
if (horizontal) {
- x.lim <- c(0, NA)
- pin1 <- par("pin")[1] # width of the device in inches
- strWi <- strwidth(x$tip.label, "inches", cex = cex) # id. for the tip labels
## 1.04 comes from that we are using a regular axis system
## with 4% on both sides of the range of x:
- xx.tips <- xx[1:Ntip] * 1.04
- ## 'alp' is the conversion coefficient from
- ## user coordinates to inches:
- 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)
- 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
- x.lim[2] <- tmp
+ ## REMOVED (2017-06-14)
+ xx.tips <- xx[1:Ntip]# * 1.04
+ if (show.tip.label) {
+ pin1 <- par("pin")[1] # width of the device in inches
+ tmp <- getLimit(xx.tips, x$tip.label, pin1, cex)
+ tmp <- tmp + label.offset
+ } else tmp <- max(xx.tips)
+ x.lim <- c(0, tmp)
} else x.lim <- c(1, Ntip)
} else switch(type, "fan" = {
if (show.tip.label) {
@@ -256,25 +264,16 @@ if (phyloORclado) {
if (is.null(y.lim)) {
if (phyloORclado) {
if (horizontal) y.lim <- c(1, Ntip) else {
- y.lim <- c(0, NA)
pin2 <- par("pin")[2] # height of the device in inches
- strWi <- strwidth(x$tip.label, "inches", cex = cex)
## 1.04 comes from that we are using a regular axis system
## with 4% on both sides of the range of x:
- yy.tips <- yy[1:Ntip] * 1.04
- ## 'alp' is the conversion coefficient from
- ## user coordinates to inches:
- 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)
- 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
- y.lim[2] <- tmp
+ ## REMOVED (2017-06-14)
+ yy.tips <- yy[1:Ntip]# * 1.04
+ if (show.tip.label) {
+ tmp <- getLimit(yy.tips, x$tip.label, pin2, cex)
+ tmp <- tmp + label.offset
+ } else tmp <- max(yy.tips)
+ y.lim <- c(0, tmp)
}
} else switch(type, "fan" = {
if (show.tip.label) {
@@ -658,7 +657,7 @@ unrooted.xy <- function(Ntip, Nnode, edge, edge.length, nb.sp, rotate.tree)
M <- cbind(xx, yy)
axe <- axis[1:Ntip] # the axis of the terminal branches (for export)
axeGTpi <- axe > pi
- ## insures that returned angles are in [-PI, +PI]:
+ ## make sure that the returned angles are in [-PI, +PI]:
axe[axeGTpi] <- axe[axeGTpi] - 2*pi
list(M = M, axe = axe)
}
@@ -669,9 +668,9 @@ node.depth <- function(phy, method = 1)
m <- phy$Nnode
N <- dim(phy$edge)[1]
phy <- reorder(phy, order = "postorder")
- .C(node_depth, as.integer(n), as.integer(m),
+ .C(node_depth, as.integer(n),
as.integer(phy$edge[, 1]), as.integer(phy$edge[, 2]),
- as.integer(N), double(n + m), as.integer(method))[[6]]
+ as.integer(N), double(n + m), as.integer(method))[[5]]
}
node.depth.edgelength <- function(phy)
@@ -680,13 +679,14 @@ node.depth.edgelength <- function(phy)
m <- phy$Nnode
N <- dim(phy$edge)[1]
phy <- reorder(phy, order = "postorder")
- .C(node_depth_edgelength, as.integer(n), as.integer(n),
- as.integer(phy$edge[, 1]), as.integer(phy$edge[, 2]),
- as.integer(N), as.double(phy$edge.length), double(n + m))[[7]]
+ .C(node_depth_edgelength, as.integer(phy$edge[, 1]),
+ as.integer(phy$edge[, 2]), as.integer(N),
+ as.double(phy$edge.length), double(n + m))[[5]]
}
node.height <- function(phy, clado.style = FALSE)
-{ n <- length(phy$tip.label)
+{
+ n <- length(phy$tip.label)
m <- phy$Nnode
N <- dim(phy$edge)[1]
@@ -700,13 +700,11 @@ node.height <- function(phy, clado.style = FALSE)
e2 <- phy$edge[, 2]
if (clado.style)
- .C(node_height_clado, as.integer(n), as.integer(m),
- as.integer(e1), as.integer(e2), as.integer(N),
- double(n + m), as.double(yy))[[7]]
+ .C(node_height_clado, as.integer(n), as.integer(e1),
+ as.integer(e2), as.integer(N), double(n + m), as.double(yy))[[5]]
else
- .C(node_height, as.integer(n), as.integer(m),
- as.integer(e1), as.integer(e2), as.integer(N),
- as.double(yy))[[6]]
+ .C(node_height, as.integer(e1), as.integer(e2), as.integer(N),
+ as.double(yy))[[4]]
}
plot.multiPhylo <- function(x, layout = 1, ...)
diff --git a/R/plotPhyloCoor.R b/R/plotPhyloCoor.R
index db59f32..964b056 100644
--- a/R/plotPhyloCoor.R
+++ b/R/plotPhyloCoor.R
@@ -1,15 +1,15 @@
-## plotPhyloCoor.R (2013-03-30)
+## plotPhyloCoor.R (2017-05-26)
## Coordinates of a Tree Plot
-## Copyright 2008 Damien de Vienne, 2013 Klaus Schliep
+## Copyright 2008 Damien de Vienne, 2013-2017 Klaus Schliep
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
plotPhyloCoor <-
function (x, type = "phylogram", use.edge.length = TRUE, node.pos = NULL,
- direction = "rightwards", tip.order = NULL, ...)
+ direction = "rightwards", tip.height = NULL, ...)
{
Ntip <- length(x$tip.label)
if (Ntip == 1)
@@ -24,13 +24,13 @@ plotPhyloCoor <-
if (phyloORclado) {
## changed by KS:
yy <- numeric(Ntip + Nnode)
- if (!is.null(tip.order)) {
- yy[tip.order] <- 1:length(tip.order)
- } else {
- x <- reorder(x)
- TIPS <- x$edge[x$edge[, 2] <= Ntip, 2]
- yy[TIPS] <- 1:Ntip
- }
+ x <- reorder(x)
+ TIPS <- x$edge[x$edge[, 2] <= Ntip, 2]
+ if (!is.null(tip.height)) {
+ if(!is.null(names(tip.height))) tip.height = tip.height[x$tip.label]
+ yy[TIPS] <- tip.height
+ }
+ else yy[TIPS] <- 1:Ntip
}
xe <- x$edge
@@ -46,78 +46,29 @@ plotPhyloCoor <-
node.pos <- 2
}
if (node.pos == 1)
- yy <- .C("node_height", as.integer(Ntip), as.integer(Nnode),
- as.integer(x$edge[, 1]), as.integer(x$edge[,
- 2]), as.integer(Nedge), as.double(yy),
- PACKAGE = "ape")[[6]]
+ yy <- .C(node_height, as.integer(x$edge[, 1]),
+ as.integer(x$edge[, 2]), as.integer(Nedge),
+ as.double(yy))[[4]]
else {
- ans <- .C("node_height_clado", as.integer(Ntip),
- as.integer(Nnode), as.integer(x$edge[, 1]), as.integer(x$edge[,
- 2]), as.integer(Nedge), double(Ntip + Nnode),
- as.double(yy), PACKAGE = "ape")
- xx <- ans[[6]] - 1
- yy <- ans[[7]]
+ ans <- .C(node_height_clado, as.integer(Ntip),
+ as.integer(x$edge[, 1]), as.integer(x$edge[, 2]),
+ as.integer(Nedge), double(Ntip + Nnode), as.double(yy))
+ xx <- ans[[5]] - 1
+ yy <- ans[[6]]
}
if (!use.edge.length) {
if (node.pos != 2)
- xx <- .C("node_depth", as.integer(Ntip), as.integer(Nnode),
+ xx <- .C(node_depth, as.integer(Ntip),
as.integer(x$edge[, 1]), as.integer(x$edge[, 2]),
- as.integer(Nedge), double(Ntip + Nnode), 1L,
- PACKAGE = "ape")[[6]] - 1
+ as.integer(Nedge), double(Ntip + Nnode), 1L)[[5]] - 1
xx <- max(xx) - xx
} else {
- xx <- .C("node_depth_edgelength", as.integer(Ntip),
- as.integer(Nnode), as.integer(x$edge[, 1]), as.integer(x$edge[,
- 2]), as.integer(Nedge), as.double(x$edge.length),
- double(Ntip + Nnode), PACKAGE = "ape")[[7]]
+ xx <- .C(node_depth_edgelength, as.integer(x$edge[, 1]),
+ as.integer(x$edge[, 2]), as.integer(Nedge),
+ as.double(x$edge.length), double(Ntip + Nnode))[[5]]
}
}
- ##if (type == "fan") {
- ## TIPS <- xe[which(xe[, 2] <= Ntip), 2]
- ## xx <- seq(0, 2 * pi * (1 - 1/Ntip), 2 * pi/Ntip)
- ## theta <- double(Ntip)
- ## theta[TIPS] <- xx
- ## theta <- c(theta, numeric(Nnode))
- ## theta <- .C("node_height", as.integer(Ntip), as.integer(Nnode),
- ## as.integer(x$edge[, 1]), as.integer(x$edge[, 2]),
- ## as.integer(Nedge), theta, DUP = FALSE, PACKAGE = "ape")[[6]]
- ## if (use.edge.length) {
- ## r <- .C("node_depth_edgelength", as.integer(Ntip),
- ## as.integer(Nnode), as.integer(x$edge[, 1]), as.integer(x$edge[,
- ## 2]), as.integer(Nedge), as.double(x$edge.length),
- ## double(Ntip + Nnode), DUP = FALSE, PACKAGE = "ape")[[7]]
- ## }
- ## else {
- ## r <- .C("node_depth", as.integer(Ntip), as.integer(Nnode),
- ## as.integer(x$edge[, 1]), as.integer(x$edge[,
- ## 2]), as.integer(Nedge), double(Ntip + Nnode),
- ## DUP = FALSE, PACKAGE = "ape")[[6]]
- ## r <- 1/r
- ## }
- ## xx <- r * cos(theta)
- ## yy <- r * sin(theta)
- ##}
- ##if (type == "unrooted") {
- ## XY <- if (use.edge.length)
- ## unrooted.xy(Ntip, Nnode, x$edge, x$edge.length)
- ## else unrooted.xy(Ntip, Nnode, x$edge, rep(1, Nedge))
- ## xx <- XY$M[, 1] - min(XY$M[, 1])
- ## yy <- XY$M[, 2] - min(XY$M[, 2])
- ##}
- ##if (type == "radial") {
- ## X <- .C("node_depth", as.integer(Ntip), as.integer(Nnode),
- ## as.integer(x$edge[, 1]), as.integer(x$edge[, 2]),
- ## as.integer(Nedge), double(Ntip + Nnode), DUP = FALSE,
- ## PACKAGE = "ape")[[6]]
- ## X[X == 1] <- 0
- ## X <- 1 - X/Ntip
- ## yy <- c((1:Ntip) * 2 * pi/Ntip, rep(0, Nnode))
- ## Y <- .C("node_height", as.integer(Ntip), as.integer(Nnode),
- ## as.integer(x$edge[, 1]), as.integer(x$edge[, 2]),
- ## as.integer(Nedge), as.double(yy), DUP = FALSE, PACKAGE = "ape")[[6]]
- ## xx <- X * cos(Y)
- ## yy <- X * sin(Y)
- ##}
+
if (phyloORclado && direction != "rightwards") {
if (direction == "leftwards") {
xx <- -xx
diff --git a/R/read.nexus.R b/R/read.nexus.R
index b34caa2..85f1827 100644
--- a/R/read.nexus.R
+++ b/R/read.nexus.R
@@ -1,8 +1,8 @@
-## read.nexus.R (2017-01-10)
+## read.nexus.R (2017-07-28)
## Read Tree File in Nexus Format
-## Copyright 2003-2017 Emmanuel Paradis and 2010 Klaus Schliep
+## Copyright 2003-2017 Emmanuel Paradis and 2010-2017 Klaus Schliep
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
@@ -20,88 +20,149 @@
phy
}
-clado.build <- function(tp)
+## for read.nexus clado with TRANSLATION
+.cladoBuildWithTokens <- function(x)
{
- add.internal <- function() {
- edge[j, 1L] <<- current.node
- node <<- node + 1L
- edge[j, 2L] <<- current.node <<- node
- index[node] <<- j # set index
- j <<- j + 1L
- }
- add.terminal <- function() {
- edge[j, 1L] <<- current.node
- edge[j, 2L] <<- tip
- index[tip] <<- j # set index
- tip.label[tip] <<- tpc[k]
- k <<- k + 1L
- tip <<- tip + 1L
- j <<- j + 1L
- }
- go.down <- function() {
- l <- index[current.node]
- node.label[current.node - nb.tip] <<- tpc[k]
- k <<- k + 1L
- current.node <<- edge[l, 1L]
- }
- if (!length(grep(",", tp))) {
- obj <- list(edge = matrix(c(2L, 1L), 1L, 2L), Nnode = 1L)
- tp <- unlist(strsplit(tp, "[\\(\\);]"))
- obj$tip.label <- tp[2]
- if (tp[3] != "") obj$node.label <- tp[3]
- class(obj) <- "phylo"
- return(obj)
- }
- tsp <- unlist(strsplit(tp, NULL))
- tp <- gsub(")", ")NA", tp)
- tp <- gsub(" ", "", tp)
- tpc <- unlist(strsplit(tp, "[\\(\\),;]"))
- tpc <- tpc[tpc != ""]
- skeleton <- tsp[tsp == "(" | tsp == ")" | tsp == "," | tsp == ";"]
- nsk <- length(skeleton)
- nb.node <- length(skeleton[skeleton == ")"])
- nb.tip <- length(skeleton[skeleton == ","]) + 1L
- ## We will assume there is an edge at the root;
- ## if so, it will be removed and put in a vector
- nb.edge <- nb.node + nb.tip
- node.label <- character(nb.node)
- tip.label <- character(nb.tip)
+ phy <- .Call(cladoBuildWithTokens, x)
+ dim(phy[[1]]) <- c(length(phy[[1]])/2, 2)
+ nms <- c("edge", "Nnode", "node.label", "root.edge")
+ if (length(phy) == 3) nms <- nms[-4]
+ names(phy) <- nms
+ if (all(phy$node.label == "")) phy$node.label <- NULL
+ class(phy) <- "phylo"
+ attr(phy, "order") <- "cladewise"
+ phy
+}
- edge <- matrix(NA_integer_, nb.edge, 2L)
- current.node <- node <- nb.tip + 1L # node number
- edge[nb.edge, 1L] <- 0L # see comment above
- edge[nb.edge, 2L] <- node #
+.treeBuild <- function(x)
+{
+ if (!length(grep(",", x))) {
+ phy <- list(edge = matrix(c(2L, 1L), 1, 2), Nnode = 1L)
+ x <- unlist(strsplit(x, "[\\(\\):;]"))
+ phy$tip.label <- x[2]
+ phy$edge.length <- as.numeric(x[3])
+ phy$node.label <- x[4]
+ } else {
+ phy <- .Call(treeBuild, x)
+ dim(phy[[1]]) <- c(length(phy[[1]])/2, 2)
+ nms <- c("edge", "edge.length", "Nnode", "node.label", "tip.label", "root.edge")
+ if (length(phy) == 5) nms <- nms[-6]
+ names(phy) <- nms
+ }
+ if (all(phy$node.label == "")) phy$node.label <- NULL
+ class(phy) <- "phylo"
+ attr(phy, "order") <- "cladewise"
+ phy
+}
- index <- numeric(nb.edge + 1L)
- index[node] <- nb.edge
- ## j: index of the line number of edge
- ## k: index of the line number of tpc
- ## tip: tip number
- j <- k <- tip <- 1L
- for (i in 2:nsk) {
- if (skeleton[i] == "(") add.internal() # add an internal branch (on top)
- if (skeleton[i] == ",") {
- if (skeleton[i - 1] != ")") add.terminal() # add a terminal branch
- }
- if (skeleton[i] == ")") {
- if (skeleton[i - 1] == ",") { # add a terminal branch and go down one level
- add.terminal()
- go.down()
- }
- if (skeleton[i - 1] == ")") go.down() # go down one level
- }
+.cladoBuild <- function(x)
+{
+ if (!length(grep(",", x))) {
+ phy <- list(edge = matrix(c(2L, 1L), 1, 2), Nnode = 1L)
+ x <- unlist(strsplit(x, "[\\(\\);]"))
+ phy$tip.label <- x[2]
+ phy$node.label <- x[3]
+ } else {
+ phy <- .Call(cladoBuild, x)
+ dim(phy[[1]]) <- c(length(phy[[1]])/2, 2)
+ nms <- c("edge", "Nnode", "node.label", "tip.label", "root.edge")
+ if (length(phy) == 4) nms <- nms[-5]
+ names(phy) <- nms
}
- edge <- edge[-nb.edge, ]
- obj <- list(edge = edge, tip.label = tip.label,
- Nnode = nb.node, node.label = node.label)
- obj$node.label <-
- if (all(obj$node.label == "NA", na.rm = TRUE)) NULL
- else gsub("^NA", "", obj$node.label)
- class(obj) <- "phylo"
- attr(obj, "order") <- "cladewise"
- obj
+ if (all(phy$node.label == "")) phy$node.label <- NULL
+ class(phy) <- "phylo"
+ attr(phy, "order") <- "cladewise"
+ phy
}
+##clado.build <- function(tp)
+##{
+## add.internal <- function() {
+## edge[j, 1L] <<- current.node
+## node <<- node + 1L
+## edge[j, 2L] <<- current.node <<- node
+## index[node] <<- j # set index
+## j <<- j + 1L
+## }
+## add.terminal <- function() {
+## edge[j, 1L] <<- current.node
+## edge[j, 2L] <<- tip
+## index[tip] <<- j # set index
+## tip.label[tip] <<- tpc[k]
+## k <<- k + 1L
+## tip <<- tip + 1L
+## j <<- j + 1L
+## }
+## go.down <- function() {
+## l <- index[current.node]
+## node.label[current.node - nb.tip] <<- tpc[k]
+## k <<- k + 1L
+## current.node <<- edge[l, 1L]
+## }
+## if (!length(grep(",", tp))) {
+## obj <- list(edge = matrix(c(2L, 1L), 1L, 2L), Nnode = 1L)
+## tp <- unlist(strsplit(tp, "[\\(\\);]"))
+## obj$tip.label <- tp[2]
+## if (tp[3] != "") obj$node.label <- tp[3]
+## class(obj) <- "phylo"
+## return(obj)
+## }
+## tsp <- unlist(strsplit(tp, NULL))
+## tp <- gsub(")", ")NA", tp)
+## tp <- gsub(" ", "", tp)
+## tpc <- unlist(strsplit(tp, "[\\(\\),;]"))
+## tpc <- tpc[tpc != ""]
+## skeleton <- tsp[tsp == "(" | tsp == ")" | tsp == "," | tsp == ";"]
+## nsk <- length(skeleton)
+## nb.node <- length(skeleton[skeleton == ")"])
+## nb.tip <- length(skeleton[skeleton == ","]) + 1L
+## ## We will assume there is an edge at the root;
+## ## if so, it will be removed and put in a vector
+## nb.edge <- nb.node + nb.tip
+## node.label <- character(nb.node)
+## tip.label <- character(nb.tip)
+##
+## edge <- matrix(NA_integer_, nb.edge, 2L)
+## current.node <- node <- nb.tip + 1L # node number
+## edge[nb.edge, 1L] <- 0L # see comment above
+## edge[nb.edge, 2L] <- node #
+##
+## index <- numeric(nb.edge + 1L)
+## index[node] <- nb.edge
+## ## j: index of the line number of edge
+## ## k: index of the line number of tpc
+## ## tip: tip number
+## j <- k <- tip <- 1L
+## for (i in 2:nsk) {
+## if (skeleton[i] == "(") add.internal() # add an internal branch (on top)
+## if (skeleton[i] == ",") {
+## if (skeleton[i - 1] != ")") add.terminal() # add a terminal branch
+## }
+## if (skeleton[i] == ")") {
+## if (skeleton[i - 1] == ",") { # add a terminal branch and go down one level
+## add.terminal()
+## go.down()
+## }
+## ## added by Klaus to allow singleton nodes (2017-05-26):
+## if (skeleton[i - 1] == "(") {
+## add.terminal()
+## go.down()
+## }
+## ## end
+## if (skeleton[i - 1] == ")") go.down() # go down one level
+## }
+## }
+## edge <- edge[-nb.edge, ]
+## obj <- list(edge = edge, tip.label = tip.label,
+## Nnode = nb.node, node.label = node.label)
+## obj$node.label <-
+## if (all(obj$node.label == "NA", na.rm = TRUE)) NULL
+## else gsub("^NA", "", obj$node.label)
+## class(obj) <- "phylo"
+## attr(obj, "order") <- "cladewise"
+## obj
+##}
+
read.nexus <- function(file, tree.names = NULL, force.multi = FALSE)
{
X <- scan(file = file, what = "", sep = "\n", quiet = TRUE)
@@ -188,16 +249,16 @@ read.nexus <- function(file, tree.names = NULL, force.multi = FALSE)
STRING <- gsub(" ", "", STRING) # delete all white spaces
colon <- grep(":", STRING)
if (!length(colon)) {
- trees <- lapply(STRING, clado.build)
+ trees <- lapply(STRING, .cladoBuild)
} else if (length(colon) == Ntree) {
trees <-
if (translation) lapply(STRING, .treeBuildWithTokens)
- else lapply(STRING, tree.build)
+ else lapply(STRING, .treeBuild)
} else {
trees <- vector("list", Ntree)
- trees[colon] <- lapply(STRING[colon], tree.build)
+ trees[colon] <- lapply(STRING[colon], .treeBuild)
nocolon <- (1:Ntree)[!1:Ntree %in% colon]
- trees[nocolon] <- lapply(STRING[nocolon], clado.build)
+ trees[nocolon] <- lapply(STRING[nocolon], .cladoBuild)
if (translation) {
for (i in 1:Ntree) {
tr <- trees[[i]]
@@ -218,14 +279,12 @@ read.nexus <- function(file, tree.names = NULL, force.multi = FALSE)
}
for (i in 1:Ntree) {
tr <- trees[[i]]
- ## Check here that the root edge is not incorrectly represented
- ## in the object of class "phylo" by simply checking that there
- ## is a bifurcation at the root
if (!translation) n <- length(tr$tip.label)
- ROOT <- n + 1
- if (sum(tr$edge[, 1] == ROOT) == 1 && dim(tr$edge)[1] > 1) {
- stop(paste("The tree has apparently singleton node(s): cannot read tree file.\n Reading NEXUS file aborted at tree no.", i, sep = ""))
- }
+ ## I suppose the following is no more needed (EP 2017-07-28)
+ ##ROOT <- n + 1L
+ ##if (sum(tr$edge[, 1] == ROOT) == 1 && dim(tr$edge)[1] > 1) {
+ ## stop(paste("The tree has apparently singleton node(s): cannot read tree file.\n Reading NEXUS file aborted at tree no.", i, sep = ""))
+ ##}
}
if (Ntree == 1 && !force.multi) {
trees <- trees[[1]]
diff --git a/R/read.tree.R b/R/read.tree.R
index 4ec8454..67f835c 100644
--- a/R/read.tree.R
+++ b/R/read.tree.R
@@ -1,167 +1,240 @@
-## read.tree.R (2015-01-12)
+## read.tree.R (2017-09-21)
## Read Tree Files in Parenthetic Format
-## Copyright 2002-2012 Emmanuel Paradis, Daniel Lawson and Klaus Schliep
+## Copyright 2002-2017 Emmanuel Paradis, Daniel Lawson and Klaus Schliep
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
-tree.build <- function(tp)
-{
- add.internal <- function() {
- edge[j, 1] <<- current.node
- edge[j, 2] <<- current.node <<- node <<- node + 1L
- index[node] <<- j # set index
- j <<- j + 1L
- }
- add.terminal <- function() {
- edge[j, 1] <<- current.node
- edge[j, 2] <<- tip
- index[tip] <<- j # set index
- X <- unlist(strsplit(tpc[k], ":"))
- tip.label[tip] <<- X[1]
- edge.length[j] <<- as.numeric(X[2])
- k <<- k + 1L
- tip <<- tip + 1L
- j <<- j + 1L
- }
- go.down <- function() {
- l <- index[current.node]
- X <- unlist(strsplit(tpc[k], ":"))
- node.label[current.node - nb.tip] <<- X[1]
- edge.length[l] <<- as.numeric(X[2])
- k <<- k + 1L
- current.node <<- edge[l, 1]
- }
- if (!length(grep(",", tp))) {
- obj <- list(edge = matrix(c(2L, 1L), 1, 2))
- tp <- unlist(strsplit(tp, "[\\(\\):;]"))
- obj$edge.length <- as.numeric(tp[3])
- obj$Nnode <- 1L
- obj$tip.label <- tp[2]
- if (tp[4] != "") obj$node.label <- tp[4]
- class(obj) <- "phylo"
- return(obj)
- }
-
- tpc <- unlist(strsplit(tp, "[\\(\\),;]"))
- tpc <- tpc[nzchar(tpc)]
- ## the following 2 lines are (slightly) faster than using gsub()
- tsp <- unlist(strsplit(tp, NULL))
- skeleton <- tsp[tsp %in% c("(", ")", ",", ";")]
- nsk <- length(skeleton)
- nb.node <- sum(skeleton == ")")
- nb.tip <- sum(skeleton == ",") + 1
- ## We will assume there is an edge at the root;
- ## if so, it will be removed and put into a vector
- nb.edge <- nb.node + nb.tip
- node.label <- character(nb.node)
- tip.label <- character(nb.tip)
-
- edge.length <- numeric(nb.edge)
- edge <- matrix(0L, nb.edge, 2)
- current.node <- node <- as.integer(nb.tip + 1) # node number
- edge[nb.edge, 2] <- node
- index <- numeric(nb.edge + 1) # hash index to avoid which
- index[node] <- nb.edge
-
- ## j: index of the line number of edge
- ## k: index of the line number of tpc
- ## tip: tip number
- j <- k <- tip <- 1L
-
- for (i in 2:nsk) {
- if (skeleton[i] == "(") add.internal() # add an internal branch (on top)
- if (skeleton[i] == ",") {
- if (skeleton[i - 1] != ")") add.terminal() # add a terminal branch
- }
- if (skeleton[i] == ")") {
- if (skeleton[i - 1] == ",") { # add a terminal branch and go down one level
- add.terminal()
- go.down()
- }
- if (skeleton[i - 1] == ")") go.down() # go down one level
- }
- }
-
- edge <- edge[-nb.edge, ]
- obj <- list(edge = edge, Nnode = nb.node, tip.label = tip.label)
- root.edge <- edge.length[nb.edge]
- edge.length <- edge.length[-nb.edge]
- if (!all(is.na(edge.length))) # added 2005-08-18
- obj$edge.length <- edge.length
- if (is.na(node.label[1])) node.label[1] <- ""
- if (any(nzchar(node.label))) obj$node.label <- node.label
- if (!is.na(root.edge)) obj$root.edge <- root.edge
- class(obj) <- "phylo"
- attr(obj, "order") <- "cladewise"
- obj
-}
+##tree.build <- function(tp)
+##{
+## add.internal <- function() {
+## edge[j, 1] <<- current.node
+## edge[j, 2] <<- current.node <<- node <<- node + 1L
+## index[node] <<- j # set index
+## j <<- j + 1L
+## }
+## add.terminal <- function() {
+## edge[j, 1] <<- current.node
+## edge[j, 2] <<- tip
+## index[tip] <<- j # set index
+## X <- unlist(strsplit(tpc[k], ":"))
+## tip.label[tip] <<- X[1]
+## edge.length[j] <<- as.numeric(X[2])
+## k <<- k + 1L
+## tip <<- tip + 1L
+## j <<- j + 1L
+## }
+## go.down <- function() {
+## l <- index[current.node]
+## X <- unlist(strsplit(tpc[k], ":"))
+## node.label[current.node - nb.tip] <<- X[1]
+## edge.length[l] <<- as.numeric(X[2])
+## k <<- k + 1L
+## current.node <<- edge[l, 1]
+## }
+## if (!length(grep(",", tp))) {
+## obj <- list(edge = matrix(c(2L, 1L), 1, 2))
+## tp <- unlist(strsplit(tp, "[\\(\\):;]"))
+## obj$edge.length <- as.numeric(tp[3])
+## obj$Nnode <- 1L
+## obj$tip.label <- tp[2]
+## if (tp[4] != "") obj$node.label <- tp[4]
+## class(obj) <- "phylo"
+## return(obj)
+## }
+##
+## tpc <- unlist(strsplit(tp, "[\\(\\),;]"))
+## tpc <- tpc[nzchar(tpc)]
+## ## the following 2 lines are (slightly) faster than using gsub()
+## tsp <- unlist(strsplit(tp, NULL))
+## skeleton <- tsp[tsp %in% c("(", ")", ",", ";")]
+## nsk <- length(skeleton)
+## nb.node <- sum(skeleton == ")")
+## nb.tip <- sum(skeleton == ",") + 1
+## ## We will assume there is an edge at the root;
+## ## if so, it will be removed and put into a vector
+## nb.edge <- nb.node + nb.tip
+## node.label <- character(nb.node)
+## tip.label <- character(nb.tip)
+##
+## edge.length <- numeric(nb.edge)
+## edge <- matrix(0L, nb.edge, 2)
+## current.node <- node <- as.integer(nb.tip + 1) # node number
+## edge[nb.edge, 2] <- node
+## index <- numeric(nb.edge + 1) # hash index to avoid which
+## index[node] <- nb.edge
+##
+## ## j: index of the line number of edge
+## ## k: index of the line number of tpc
+## ## tip: tip number
+## j <- k <- tip <- 1L
+##
+## for (i in 2:nsk) {
+## if (skeleton[i] == "(") add.internal() # add an internal branch (on top)
+## if (skeleton[i] == ",") {
+## if (skeleton[i - 1] != ")") add.terminal() # add a terminal branch
+## }
+## if (skeleton[i] == ")") {
+## if (skeleton[i - 1] == ",") { # add a terminal branch and go down one level
+## add.terminal()
+## go.down()
+## }
+## ## added by Klaus to allow singleton nodes (2017-05-26):
+## if (skeleton[i - 1] == "(") {
+## add.terminal()
+## go.down()
+## }
+## ## end
+## if (skeleton[i - 1] == ")") go.down() # go down one level
+## }
+## }
+##
+## edge <- edge[-nb.edge, ]
+## obj <- list(edge = edge, Nnode = nb.node, tip.label = tip.label)
+## root.edge <- edge.length[nb.edge]
+## edge.length <- edge.length[-nb.edge]
+## if (!all(is.na(edge.length))) # added 2005-08-18
+## obj$edge.length <- edge.length
+## if (is.na(node.label[1])) node.label[1] <- ""
+## if (any(nzchar(node.label))) obj$node.label <- node.label
+## if (!is.na(root.edge)) obj$root.edge <- root.edge
+## class(obj) <- "phylo"
+## attr(obj, "order") <- "cladewise"
+## obj
+##}
read.tree <- function(file = "", text = NULL, tree.names = NULL, skip = 0,
- comment.char = "#", keep.multi = FALSE, ...)
+ comment.char = "", keep.multi = FALSE, ...)
{
- unname <- function(treetext) {
- nc <- nchar(treetext)
- tstart <- 1
- while (substr(treetext, tstart, tstart) != "(" && tstart <= nc)
- tstart <- tstart + 1
- if (tstart > 1)
- return(c(substr(treetext, 1, tstart - 1),
- substr(treetext, tstart, nc)))
- return(c("", treetext))
- }
if (!is.null(text)) {
if (!is.character(text))
- stop("argument `text' must be of mode character")
+ stop("argument `text' must be of mode character")
tree <- text
} else {
tree <- scan(file = file, what = "", sep = "\n", quiet = TRUE,
skip = skip, comment.char = comment.char, ...)
}
+
## Suggestion from Eric Durand and Nicolas Bortolussi (added 2005-08-17):
if (identical(tree, character(0))) {
warning("empty character string.")
return(NULL)
}
+
tree <- gsub("[ \t]", "", tree)
- tree <- unlist(strsplit(tree, NULL))
- y <- which(tree == ";")
- Ntree <- length(y)
- x <- c(1, y[-Ntree] + 1)
- ## Suggestion from Olivier Francois (added 2006-07-15):
- if (is.na(y[1])) return(NULL)
- STRING <- character(Ntree)
- for (i in 1:Ntree) {
- tmp <- paste(tree[x[i]:y[i]], sep = "", collapse = "")
- STRING[i] <- gsub("\\[[^]]*\\]", "", tmp) # delete comments (fix 2015-01-12)
+ tree <- gsub("''", "", tree)
+
+ single_quotes <- function(x, start = 1L) {
+ z <- unlist(gregexpr("'", x))
+ if (length(z) %% 2)
+ stop("wrong number of single quotes around labels")
+ l <- length(z) / 2
+ tmp <- strsplit(x, "'")[[1]]
+ ind_orig <- 2L * (1L:l)
+ tmp_label <- paste0("@_", start:(start + l - 1), "_@")
+ orig_label <- tmp[ind_orig] #paste0("'", tmp[ind_orig], "'")
+ names(orig_label) <- tmp_label
+ for (i in 1:l) tmp[2 * i] <- tmp_label[i]
+ tmp <- paste0(tmp, collapse = "")
+ list(tmp, orig_label)
}
- tmp <- unlist(lapply(STRING, unname))
- tmpnames <- tmp[c(TRUE, FALSE)]
- STRING <- tmp[c(FALSE, TRUE)]
- if (is.null(tree.names) && any(nzchar(tmpnames)))
- tree.names <- tmpnames
+ ## replace labels with single quotes
+ z <- grepl("'", tree)
+ if (any(z)) {
+ Ntree <- length(tree)
+ tmp_label <- vector("list", Ntree)
+ for (i in 1:Ntree) {
+ if (z[i]) {
+ TMP <- single_quotes(tree[i])
+ tree[i] <- TMP[[1]]
+ tmp_label[[i]] <- TMP[[2]]
+ }
+ }
+ }
+
+ y <- unlist(gregexpr(";", tree))
+
+### replace comments may handle them different later on
+
+ ## if one tree per line much faster
+ if (identical(y, nchar(tree))) { # check if always one tree per line
+ Ntree <- length(y)
+ STRING <- character(Ntree)
+ for (i in 1:Ntree) {
+ STRING[i] <- gsub("\\[[^]]*\\]", "", tree[i]) # delete comments (fix 2015-01-12)
+ }
+ } else {
+ ## tree <- paste0(tree)
+ ## tree <- unlist(strsplit(tree, ";"))
+ ## tree <- paste0(tree, ";")
+ tree <- unlist(strsplit(tree, NULL))
+ y <- which(tree == ";")
+ Ntree <- length(y)
+ x <- c(1, y[-Ntree] + 1)
+ ## Suggestion from Olivier Francois (added 2006-07-15):
+ if (is.na(y[1])) return(NULL)
+ STRING <- character(Ntree)
+ for (i in 1:Ntree) {
+ tmp <- paste0(tree[x[i]:y[i]], collapse = "")
+ STRING[i] <- gsub("\\[[^]]*\\]", "", tmp) # delete comments (fix 2015-01-12)
+ }
+ }
+
+ ## remove possible leading and trailing underscores
+ STRING <- gsub("^_+", "", STRING)
+ STRING <- gsub("_+$", "", STRING)
+
+ getTreeName <- function(x) {
+ res <- rep("", length(x))
+ i <- regexpr("\\(", x)
+ s <- i > 1
+ if (any(s)) res[s] <- substr(x[s], 1, i[s] - 1)
+ res
+ }
+
+ tmpnames <- getTreeName(STRING)
+ if (is.null(tree.names) && any(nzchar(tmpnames))) tree.names <- tmpnames
colon <- grep(":", STRING)
if (!length(colon)) {
- obj <- lapply(STRING, clado.build)
+ obj <- lapply(STRING, .cladoBuild)
} else if (length(colon) == Ntree) {
- obj <- lapply(STRING, tree.build)
+ obj <- lapply(STRING, .treeBuild)
} else {
obj <- vector("list", Ntree)
- obj[colon] <- lapply(STRING[colon], tree.build)
+ obj[colon] <- lapply(STRING[colon], .treeBuild)
nocolon <- (1:Ntree)[!1:Ntree %in% colon]
- obj[nocolon] <- lapply(STRING[nocolon], clado.build)
+ obj[nocolon] <- lapply(STRING[nocolon], .cladoBuild)
}
+
for (i in 1:Ntree) {
- ## Check here that the root edge is not incorrectly represented
- ## in the object of class "phylo" by simply checking that there
- ## is a bifurcation at the root
- ROOT <- length(obj[[i]]$tip.label) + 1
- if(sum(obj[[i]]$edge[, 1] == ROOT) == 1 && dim(obj[[i]]$edge)[1] > 1)
- stop(paste("The tree has apparently singleton node(s): cannot read tree file.\n Reading Newick file aborted at tree no.", i))
+ if (z[i]) {
+ tmp_lab <- tmp_label[[i]]
+ tip.label <- obj[[i]]$tip.label
+ node.label <- obj[[i]]$node.label
+ ind <- match(tip.label, names(tmp_lab))
+ ind2 <- which(!is.na(ind))
+ tip.label[ind2] <- tmp_lab[ind[ind2]]
+ tmp_lab <- tmp_lab[-ind[ind2]]
+
+ ind <- match(node.label, names(tmp_lab))
+ ind2 <- which(!is.na(ind))
+ if (length(ind2)) {
+ node.label[ind2] <- tmp_lab[ind[ind2]]
+ tmp_lab <- tmp_lab[-ind[ind2]]
+ }
+ if (length(tmp_lab)) {
+ for (j in 1:length(tmp_lab)) {
+ node.label <- gsub(names(tmp_lab)[j], tmp_lab[j], node.label)
+ tip.label <- gsub(names(tmp_lab)[j], tmp_lab[j], tip.label)
+ }
+ }
+ obj[[i]]$tip.label <- tip.label
+ obj[[i]]$node.label <- node.label
+ }
}
if (Ntree == 1 && !keep.multi) obj <- obj[[1]] else {
if (!is.null(tree.names)) names(obj) <- tree.names
diff --git a/R/reorder.phylo.R b/R/reorder.phylo.R
index 718aadb..007e3a2 100644
--- a/R/reorder.phylo.R
+++ b/R/reorder.phylo.R
@@ -1,8 +1,8 @@
-## reorder.phylo.R (2016-10-04)
+## reorder.phylo.R (2017-07-28)
## Internal Reordering of Trees
-## Copyright 2006-2016 Emmanuel Paradis
+## Copyright 2006-2017 Emmanuel Paradis, 2017 Klaus Schliep
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
@@ -17,11 +17,6 @@
if (nb.node == 1)
if (index.only) return(1:nb.edge) else return(x)
- ## I'm adding the next check for badly conformed trees to avoid R
- ## crashing (2013-05-17):
- if (nb.node >= nb.tip)
- stop("tree apparently badly conformed")
-
if (io == 3) {
x <- reorder(x)
neworder <-
@@ -30,11 +25,8 @@
as.integer(x$edge[, 2]), as.integer(nb.edge),
integer(nb.edge))[[6]]
} else {
- neworder <-
- .C(neworder_phylo, as.integer(nb.tip),
- as.integer(x$edge[, 1]), as.integer(x$edge[, 2]),
- as.integer(nb.edge), integer(nb.edge), io,
- NAOK = TRUE)[[5]]
+ neworder <- reorderRcpp(x$edge, as.integer(nb.tip),
+ as.integer(nb.tip + 1L), io)
}
if (index.only) return(neworder)
x$edge <- x$edge[neworder, ]
@@ -64,11 +56,17 @@ reorder.multiPhylo <- function(x, order = "cladewise", ...)
labs <- attr(x, "TipLabel")
x <-
if (is.null(labs)) lapply(x, reorder.phylo, order = order)
- else lapply(x, .reorder_ape, order = order, nb.tip = length(labs), io = io)
+ else lapply(x, .reorder_ape, order = order, index.only = FALSE,
+ nb.tip = length(labs), io = io)
+ if (!is.null(labs)) attr(x, "TipLabel") <- labs
class(x) <- oc
x
}
+cladewise <- function(x) reorder(x, "cladewise", index.only = TRUE)
+
+postorder <- function(x) reorder(x, "postorder", index.only = TRUE)
+
rotateConstr <- function(phy, constraint)
{
D <- match(phy$tip.label, constraint)
diff --git a/R/subtreeplot.R b/R/subtreeplot.R
index b733e90..cf71085 100644
--- a/R/subtreeplot.R
+++ b/R/subtreeplot.R
@@ -1,4 +1,4 @@
-## subtreeplot.R (2008-04-30)
+## subtreeplot.R (2017-05-26)
## Zoom on a Portion of a Phylogeny by Successive Clicks
@@ -23,13 +23,16 @@ subtreeplot<-function(x, wait=FALSE, ...) {
N.tip<-Ntip(x)
N.node<-Nnode(x)
- coor<-plotPhyloCoor(x)
+ # 5/24/17 changed by Klaus
+ # coor<-plotPhyloCoor(x)
+ lastPP <- get("last_plot.phylo", envir = .PlotPhyloEnv)
tips<-x$tip.label
nodes<-x$node.label
if (is.null(x$node.label)) nodes<-(N.tip+1):(N.tip+N.node)
labs<-c(rep("",N.tip), nodes)
- click<-identify(coor[,1], coor[,2], labels=labs, n=1)
+ #click<-identify(coor[,1], coor[,2], labels=labs, n=1)
+ click<-identify(lastPP$xx, lastPP$yy, labels=labs, n=1)
if (length(click) == 0) {return(y)}
if (click > N.tip) {
close.screen(c(1,2),all.screens = TRUE)
diff --git a/R/which.edge.R b/R/which.edge.R
index c1a7572..623ae42 100644
--- a/R/which.edge.R
+++ b/R/which.edge.R
@@ -1,32 +1,63 @@
-## which.edge.R (2014-07-15)
+## which.edge.R (2017-10-04)
## Identifies Edges of a Tree
-## Copyright 2004-2014 Emmanuel Paradis
+## Copyright 2004-2017 Emmanuel Paradis, 2017 Joseph W. Brown, 2017 Klaus Schliep
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
-getMRCA <- function(phy, tip)
-### Find the MRCA of the tips given as `tip'
-### (see `root.R' for comments on the code)
-{
+getMRCA <- function(phy, tip) {
if (!inherits(phy, "phylo"))
stop('object "phy" is not of class "phylo"')
- if (is.character(tip)) tip <- which(phy$tip.label %in% tip)
if (length(tip) < 2) return(NULL)
Ntip <- length(phy$tip.label)
- seq.nod <- .Call(seq_root2tip, phy$edge, Ntip, phy$Nnode)
- sn <- seq.nod[tip]
- MRCA <- Ntip + 1
- i <- 2
- repeat {
- x <- unique(unlist(lapply(sn, "[", i)))
- if (length(x) != 1) break
- MRCA <- x
- i <- i + 1
+ ## <FIXME> do we need to check the value(s) in 'tip'?
+ ##if (any(tip > Ntip + phy$Nnode) || any(tip < 1))
+ ## stop("value(s) out of range in 'tip'")
+ ## </FIXME>
+ rootnd <- Ntip + 1L
+
+ pars <- integer(phy$Nnode) # worst case assignment, usually far too long
+ tnd <- if (is.character(tip)) match(tip, phy$tip.label) else tip
+
+ done_v <- logical(Ntip + phy$Nnode)
+
+ ## build a lookup table to get parents faster
+ pvec <- integer(Ntip + phy$Nnode)
+ pvec[phy$edge[, 2]] <- phy$edge[, 1]
+
+ ## get entire lineage for first tip
+ nd <- tnd[1]
+ for (k in 1:phy$Nnode) {
+ nd <- pvec[nd]
+ pars[k] <- nd
+ if (nd == rootnd) break
+ }
+ pars <- pars[1:k] # delete the rest
+ mrcind <- integer(max(pars))
+ mrcind[pars] <- 1:k
+
+ mrcand <- pars[1]
+
+ ## traverse lineages for remaining tips, stop if hit common ancestor
+ for (i in 2:length(tnd)) {
+ cnd <- tnd[i]
+ done <- done_v[cnd]
+ while(!done){
+ done_v[cnd] <- TRUE
+ cpar <- pvec[cnd] # get immediate parent
+ done <- done_v[cpar] # early exit if TRUE
+ if (cpar %in% pars) {
+ if (cpar == rootnd) return(rootnd) # early exit
+ if(mrcind[cpar] > mrcind[mrcand]) mrcand <- cpar
+ done_v[cpar] <- TRUE
+ done <- TRUE
+ }
+ cnd <- cpar # keep going!
+ }
}
- MRCA
+ mrcand
}
which.edge <- function(phy, group)
diff --git a/R/write.nexus.R b/R/write.nexus.R
index 0d6b61c..c5b647d 100644
--- a/R/write.nexus.R
+++ b/R/write.nexus.R
@@ -1,8 +1,8 @@
-## write.nexus.R (2014-12-10)
+## write.nexus.R (2017-09-08)
## Write Tree File in Nexus Format
-## Copyright 2003-2014 Emmanuel Paradis
+## Copyright 2003-2017 Emmanuel Paradis
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
diff --git a/R/write.tree.R b/R/write.tree.R
index 08de505..80568bb 100644
--- a/R/write.tree.R
+++ b/R/write.tree.R
@@ -1,13 +1,13 @@
-## write.tree.R (2010-12-07)
+## write.tree.R (2017-09-08)
## Write Tree File in Parenthetic Format
-## Copyright 2002-2010 Emmanuel Paradis, Daniel Lawson, and Klaus Schliep
+## Copyright 2002-2017 Emmanuel Paradis, Daniel Lawson, and Klaus Schliep
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
-checkLabel <- function(x, ...)
+checkLabel <- function(x)
{
## delete all leading and trailing spaces and tabs, and
## the leading left and trailing right parentheses:
@@ -17,13 +17,10 @@ checkLabel <- function(x, ...)
x <- gsub("[[:space:]\\)]+$", "", x)
## replace all spaces and tabs by underscores:
x <- gsub("[[:space:]]", "_", x)
- ## remove all commas, colons, and semicolons
- x <- gsub("[,:;]", "", x)
+ ## replace commas, colons, and semicolons with dashes:
+ x <- gsub("[,:;]", "-", x)
## replace left and right parentheses with dashes:
x <- gsub("[\\(\\)]", "-", x)
- ## delete extra underscores and extra dashes:
- x <- gsub("_{2,}", "_", x)
- x <- gsub("-{2,}", "-", x)
x
}
diff --git a/build/vignette.rds b/build/vignette.rds
index bd50957..67b426f 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 60c5da9..d35681c 100644
Binary files a/data/hivtree.newick.rda and b/data/hivtree.newick.rda differ
diff --git a/inst/doc/MoranI.Rnw b/inst/doc/MoranI.Rnw
index ae1720e..a1f4179 100644
--- a/inst/doc/MoranI.Rnw
+++ b/inst/doc/MoranI.Rnw
@@ -20,7 +20,7 @@
<<echo=false,quiet=true>>=
options(width=60)
-@
+@
This document clarifies the use of Moran's autocorrelation coefficient
to quantify whether the distribution of a trait among a set of species
@@ -120,7 +120,7 @@ body mass and longevity of five species of primates:
body <- c(4.09434, 3.61092, 2.37024, 2.02815, -1.46968)
longevity <- c(4.74493, 3.3322, 3.3673, 2.89037, 2.30259)
names(body) <- names(longevity) <- c("Homo", "Pongo", "Macaca", "Ateles", "Galago")
-@
+@
The tree has branch lengths scaled so that the root age is one. We
read the tree with \ape, and plot it:
@@ -132,7 +132,7 @@ trnwk[2] <- ":0.38,Galago:1.00);"
tr <- read.tree(text = trnwk)
plot(tr)
axisPhylo()
-@
+@
We choose the weights as $w_{ij}=1/d_{ij}$, where the $d$'s is the
distances measured on the tree:
@@ -150,7 +150,7 @@ We can now perform the analysis with Moran's $I$:
<<>>=
Moran.I(body, w)
-@
+@
Not surprisingly, the results are opposite to those in
\cite{Paradis2006} since, there, the distances (given by
@@ -171,13 +171,13 @@ be two if we define H$_1$ as $I > I_0$:
<<>>=
Moran.I(body, w, alt = "greater")
-@
+@
The same analysis with \code{longevity} gives:
<<>>=
Moran.I(longevity, w)
-@
+@
As for \code{body}, the results are nearly mirrored compared to
\cite{Paradis2006} where a non-significant negative phylogenetic
@@ -248,7 +248,7 @@ We first consider a single variable analysis (as in \cite{Paradis2006}):
fm1.carn <- log10SW ~ Order/SuperFamily/Family/Genus
co1 <- correlogram.formula(fm1.carn, data = carnivora)
plot(co1)
-@
+@
A legend now appears by default, but can be removed with \code{legend
= FALSE}. Most of the appearance of the graph can be customized via
@@ -266,7 +266,7 @@ correlograms can be plotted together with the appropriate plot method:
fm2.carn <- log10SW + log10FW ~ Order/SuperFamily/Family/Genus
co2 <- correlogram.formula(fm2.carn, data = carnivora)
print(plot(co2))
-@
+@
By default, lattice is used to plot the correlograms on separate
panels; using \code{lattice = FALSE} (actually the second argument,
@@ -275,7 +275,7 @@ the different correlograms:
<<fig=true>>=
plot(co2, FALSE)
-@
+@
The options are roughly the same than above, but do not have always
the same effect since lattice and base graphics do not have the same
@@ -294,14 +294,14 @@ done with a distance matrix. So I correct this below:
> gearymoran(w, data.frame(body, longevity))
\end{Sinput}
\begin{Soutput}
-class: krandtest
+class: krandtest
Monte-Carlo tests
-Call: as.krandtest(sim = matrix(res$result, ncol = nvar, byr = TRUE),
+Call: as.krandtest(sim = matrix(res$result, ncol = nvar, byr = TRUE),
obs = res$obs, alter = alter, names = test.names)
-Test number: 2
-Permutation number: 999
-Alternative hypothesis: greater
+Test number: 2
+Permutation number: 999
+Alternative hypothesis: greater
Test Obs Std.Obs Pvalue
1 body -0.06256789 2.1523342 0.001
diff --git a/inst/doc/MoranI.pdf b/inst/doc/MoranI.pdf
index 4ebc3fa..5a4d35e 100644
Binary files a/inst/doc/MoranI.pdf and b/inst/doc/MoranI.pdf differ
diff --git a/man/AAbin.Rd b/man/AAbin.Rd
index a03d95b..70ffcb9 100644
--- a/man/AAbin.Rd
+++ b/man/AAbin.Rd
@@ -10,6 +10,10 @@
\alias{as.phyDat.AAbin}
\alias{dist.aa}
\alias{AAsubst}
+\alias{c.AAbin}
+\alias{as.AAbin.list}
+\alias{as.list.AAbin}
+\alias{as.matrix.AAbin}
\title{Amino Acid Sequences}
\description{
These functions help to create and manipulate AA sequences.
@@ -19,28 +23,40 @@
\method{[}{AAbin}(x, i, j, drop = FALSE)
+\method{c}{AAbin}(..., recursive = FALSE)
+
\method{as.character}{AAbin}(x, \dots)
\method{labels}{AAbin}(object, \dots)
\method{image}{AAbin}(x, what, col, bg = "white", xlab = "", ylab = "",
- show.labels = TRUE, cex.lab = 1, legend = TRUE, \dots)
+ show.labels = TRUE, cex.lab = 1, legend = TRUE, grid = FALSE,
+ show.aa = FALSE, aa.cex = 1, aa.font = 1, aa.col = "black",\dots)
as.AAbin(x, \dots)
\method{as.AAbin}{character}(x, \dots)
+\method{as.AAbin}{list}(x, ...)
+
+\method{as.list}{AAbin}(x, ...)
+
+\method{as.matrix}{AAbin}(x, ...)
+
\method{as.phyDat}{AAbin}(x, \dots)
dist.aa(x, pairwise.deletion = FALSE, scaled = FALSE)
AAsubst(x)
}
\arguments{
-\item{x, object}{an object of class \code{"AAbin"}.}
+\item{x, object}{an object of class \code{"AAbin"} (or else depending on
+the function).}
\item{i, j}{indices of the rows and/or columns to select or to
drop. They may be numeric, logical, or character (in the same way than
for standard \R objects).}
\item{drop}{logical; if \code{TRUE}, the returned object is of the
lowest possible dimension.}
+\item{recursive}{logical; whether to go down lists and concatenate its
+elements.}
\item{what}{a vector of characters specifying the amino acids to
visualize. Currently, the only possible choice is to show the three
categories hydrophobic, small, and hydrophilic.}
@@ -58,6 +74,12 @@ labels. Use \code{cex.axis} to control the size of the annotations on
the \emph{x}-axis.}
\item{legend}{a logical controlling whether the legend is plotted
(\code{TRUE} by default).}
+\item{grid}{a logical controlling whether to draw a grid (\code{FALSE} by
+default).}
+\item{show.aa}{a logical controlling whether to show the AA symbols (\code{FALSE} by
+default).}
+\item{aa.cex, aa.font, aa.col}{control the aspect of the AA symbols
+(ignored if the previous is \code{FALSE}).}
\item{pairwise.deletion}{a logical indicating whether to delete the
sites with missing data in a pairwise way. The default is to delete the
sites with at least one missing data for all sequences.}
@@ -89,7 +111,7 @@ acid sequence files in FASTA format.
an object of class \code{"AAbin"}, \code{"character"}, \code{"phyDat"},
\code{"dist"}, or \code{"numeric"}, depending on the function.
}
-\author{Emmanuel Paradis}
+\author{Emmanuel Paradis, Franz Krah}
\seealso{
\code{\link{trans}}, \code{\link{alview}}
}
diff --git a/man/LTT.Rd b/man/LTT.Rd
index afa642e..e9abbd8 100644
--- a/man/LTT.Rd
+++ b/man/LTT.Rd
@@ -13,7 +13,7 @@
\usage{
LTT(birth = 0.1, death = 0, N = 100, Tmax = 50, PI = 95,
scaled = TRUE, eps = 0.1, add = FALSE, backward = TRUE,
- ltt.style = list("black", 1, 1), pi.style = list("blue", 1, 2))
+ ltt.style = list("black", 1, 1), pi.style = list("blue", 1, 2), ...)
}
\arguments{
\item{birth}{the speciation rate, this may be either a numeric value
@@ -34,6 +34,7 @@ LTT(birth = 0.1, death = 0, N = 100, Tmax = 50, PI = 95,
LTT curve with, respectively, the colour (\code{"col"}), the line
thickness (\code{"lwd"}), and the line type (\code{"lty"}).}
\item{pi.style}{id. for the prediction interval.}
+ \item{\dots}{arguments passed to \code{plot} (e.g., \code{log="y"}).}
}
\details{
For the moment, this works well when \code{birth} and \code{death} are
diff --git a/man/add.scale.bar.Rd b/man/add.scale.bar.Rd
index 3f1ee59..1843416 100644
--- a/man/add.scale.bar.Rd
+++ b/man/add.scale.bar.Rd
@@ -46,6 +46,6 @@ plot(tr)
add.scale.bar()
plot(tr)
add.scale.bar(cex = 0.7, font = 2, col = "red")
-layout(matrix(1))
+layout(1)
}
\keyword{aplot}
diff --git a/man/ape-internal.Rd b/man/ape-internal.Rd
index 29ce7bc..9793bd2 100644
--- a/man/ape-internal.Rd
+++ b/man/ape-internal.Rd
@@ -1,5 +1,4 @@
\name{ape-internal}
-\alias{tree.build}
\alias{f.cherry.yule}
\alias{f.cherry.uniform}
\alias{sortIndex}
@@ -7,7 +6,6 @@
\alias{perm.rowscols}
\alias{mant.zstat}
\alias{lower.triang}
-\alias{clado.build}
\alias{phylogram.plot}
\alias{cladogram.plot}
\alias{circular.plot}
@@ -60,10 +58,19 @@
\alias{node_depth_edgelength}
\alias{node_height}
\alias{node_height_clado}
-\alias{prop_part}
+%\alias{prop_part}
+\alias{_ape_bipartition2}
+\alias{_ape_prop_part2}
+\alias{_ape_reorderRcpp}
+\alias{bipartition2}
+\alias{prop_part2}
+\alias{reorderRcpp}
\alias{rawStreamToDNAbin}
\alias{seq_root2tip}
+\alias{treeBuild}
\alias{treeBuildWithTokens}
+\alias{cladoBuild}
+\alias{cladoBuildWithTokens}
\alias{polar2rect}
\alias{rect2polar}
\alias{CountBipartitionsFromTrees}
@@ -84,6 +91,6 @@
\alias{trans_DNA2AA}
\title{Internal Ape Functions}
\description{
- Internal \pkg{ape} functions.
+ Internal \pkg{ape} functions. Do not call these from other packages.
}
\keyword{internal}
diff --git a/man/ape-package.Rd b/man/ape-package.Rd
index 996b3f8..33a6457 100644
--- a/man/ape-package.Rd
+++ b/man/ape-package.Rd
@@ -6,11 +6,12 @@
Analyses of Phylogenetics and Evolution
}
\description{
- \pkg{ape} provides functions for reading and manipulating phylogenetic
- trees and DNA sequences, computing DNA distances, estimating trees
- with distance-based methods, and a range of methods for comparative
- analyses and analysis of diversification. Functionalities are also
- provided for programming new phylogenetic methods.
+ \pkg{ape} provides functions for reading, writing, manipulating,
+ analysing, and simulating phylogenetic trees and DNA sequences,
+ computing DNA distances, translating into AA sequences, estimating
+ trees with distance-based methods, and a range of methods for
+ comparative analyses and analysis of diversification. Functionalities
+ are also provided for programming new phylogenetic methods.
The complete list of functions can be displayed with
\code{library(help = ape)}.
diff --git a/man/apetools.Rd b/man/apetools.Rd
index c231adf..3a0330e 100644
--- a/man/apetools.Rd
+++ b/man/apetools.Rd
@@ -1,6 +1,7 @@
\name{apetools}
\alias{apetools}
\alias{Xplorefiles}
+\alias{Xplor}
\alias{editFileExtensions}
\alias{bydir}
\title{Tools to Explore Files}
@@ -11,6 +12,7 @@
Xplorefiles(from = "HOME", recursive = TRUE, ignore.case = TRUE)
editFileExtensions()
bydir(x)
+Xplor()
}
\arguments{
\item{from}{the directory where to start the file search; by default,
@@ -30,6 +32,9 @@ bydir(x)
(.phy). This list can be modified with \code{editFileExtensions}.
\code{bydir} sorts the list of files by directories.
+
+ \code{Xplor} combines the other operations and opens the results in
+ a Web browser with clickable links to the directories and files.
}
\value{
\code{Xplorefiles} returns a list. \code{bydir} prints the file
@@ -43,5 +48,6 @@ x # all data files on your disk
bydir(x) # sorted by directories
bydir(x["fasta"]) # only the FASTA files
Xplorefiles(getwd(), recursive = FALSE) # look only in current dir
+Xplor()
}}
\keyword{manip}
diff --git a/man/boot.phylo.Rd b/man/boot.phylo.Rd
index 602ae8a..10a71b9 100644
--- a/man/boot.phylo.Rd
+++ b/man/boot.phylo.Rd
@@ -171,7 +171,9 @@ bstrees <- boot.phylo(tree, woodmouse, fun, trees = TRUE)$trees
clad <- prop.clades(tree, bstrees, rooted = TRUE)
## get proportions of each bipartition:
boot <- prop.clades(tree, bstrees)
-plot(tree, main = "Bipartitions vs. Clades Support Values")
+layout(1)
+par(mar = rep(2, 4))
+plot(tree, main = "Bipartition vs. Clade Support Values")
drawSupportOnEdges(boot)
nodelabels(clad)
legend("bottomleft", legend = c("Bipartitions", "Clades"), pch = 22,
diff --git a/man/carnivora.Rd b/man/carnivora.Rd
index fb1dfca..4a07595 100644
--- a/man/carnivora.Rd
+++ b/man/carnivora.Rd
@@ -35,15 +35,16 @@
\bold{127}: 744--771.
}
\examples{
- data(carnivora);
- # This is figure 1 of Gittleman 1986:
- library(lattice)
- trellis.device(color=FALSE)
- xyplot(BW ~ FW, groups=Family, data=carnivora, auto.key=TRUE, xlog=TRUE,
- scale=list(log=TRUE), ylim=c(1, 2000))
- trellis.device(color=FALSE)
- xyplot(BW ~ FB, groups=Family, data=carnivora, auto.key=TRUE, xlog=TRUE,
- scale=list(log=TRUE), ylim=c(1, 2000))
+data(carnivora)
+## Fig. 1 in Gittleman (1986):
+plot(carnivora$BW ~ carnivora$FW, pch = (1:8)[carnivora$Family], log = "xy",
+ xlab = "Female body weight (kg)", ylab = "Birth weigth (g)",
+ ylim = c(1, 2000))
+legend("bottomright", legend = levels(carnivora$Family), pch = 1:8)
+plot(carnivora$BW ~ carnivora$FB, pch = (1:8)[carnivora$Family], log = "xy",
+ xlab = "Female brain weight (g)", ylab = "Birth weigth (g)",
+ ylim = c(1, 2000))
+legend("bottomright", legend = levels(carnivora$Family), pch = 1:8)
}
\keyword{datasets}
diff --git a/man/checkAlignment.Rd b/man/checkAlignment.Rd
index bfc6a17..ecf4eca 100644
--- a/man/checkAlignment.Rd
+++ b/man/checkAlignment.Rd
@@ -39,4 +39,5 @@ checkAlignment(x, check.gaps = TRUE, plot = TRUE, what = 1:4)
\examples{
data(woodmouse)
checkAlignment(woodmouse)
+layout(1)
}
\ No newline at end of file
diff --git a/man/chiroptera.Rd b/man/chiroptera.Rd
index e8081f3..07e9716 100644
--- a/man/chiroptera.Rd
+++ b/man/chiroptera.Rd
@@ -27,6 +27,6 @@ str(chiroptera)
op <- par()
par(cex = 0.3)
plot(chiroptera, type = "c")
-par(op)
+par(cex = op$cex)
}
\keyword{datasets}
diff --git a/man/chronoMPL.Rd b/man/chronoMPL.Rd
index fb1a6f4..40438a4 100644
--- a/man/chronoMPL.Rd
+++ b/man/chronoMPL.Rd
@@ -71,5 +71,6 @@ title("The standard-errors")
plot(tr)
nodelabels(round(attr(chr, "Pval"), 3))
title("The tests")
+layout(1)
}
\keyword{models}
diff --git a/man/collapse.singles.Rd b/man/collapse.singles.Rd
index c7d22de..cef0860 100644
--- a/man/collapse.singles.Rd
+++ b/man/collapse.singles.Rd
@@ -1,12 +1,16 @@
\name{collapse.singles}
\alias{collapse.singles}
+\alias{has.singles}
\title{Collapse Single Nodes}
\description{
- This function deletes the single nodes (i.e., with a single
+ \code{collapse.singles} deletes the single nodes (i.e., with a single
descendant) in a tree.
+
+ \code{has.singles} tests for the presence of single node(s) in a tree.
}
\usage{
collapse.singles(tree, root.edge = FALSE)
+has.singles(tree)
}
\arguments{
\item{tree}{an object of class \code{"phylo"}.}
@@ -18,7 +22,7 @@ collapse.singles(tree, root.edge = FALSE)
\value{
an object of class \code{"phylo"}.
}
-\author{Emmanuel Paradis}
+\author{Emmanuel Paradis, Klaus Schliep}
\seealso{
\code{\link{plot.phylo}}, \code{\link{read.tree}}
}
@@ -29,14 +33,13 @@ dim(e) <- c(5, 2)
tr <- structure(list(edge = e, tip.label = LETTERS[1:3], Nnode = 3L),
class = "phylo")
tr
+has.singles(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()
+## A bifurcating tree has less nodes than it has tips:
+## the following used to fail with ape 4.1 or lower:
+plot(tr)
collapse.singles(tr) # only 2 nodes
## give branch lengths to use the 'root.edge' option:
tr$edge.length <- runif(5)
diff --git a/man/dist.topo.Rd b/man/dist.topo.Rd
index 8c91553..62a1295 100644
--- a/man/dist.topo.Rd
+++ b/man/dist.topo.Rd
@@ -17,7 +17,8 @@ dist.topo(x, y = NULL, method = "PH85")
\code{"PH85"}, or \code{"score"}.}
}
\value{
- a single numeric value.
+ a single numeric value if both \code{x} and \code{y} are used, an
+ object of class \code{"dist"} otherwise.
}
\details{
Two methods are available: the one by Penny and Hendy (1985,
diff --git a/man/drop.tip.Rd b/man/drop.tip.Rd
index 4b4b60e..54bd52b 100644
--- a/man/drop.tip.Rd
+++ b/man/drop.tip.Rd
@@ -11,8 +11,10 @@
}
\usage{
drop.tip(phy, tip, trim.internal = TRUE, subtree = FALSE,
- root.edge = 0, rooted = is.rooted(phy), interactive = FALSE)
-extract.clade(phy, node, root.edge = 0, interactive = FALSE)
+ root.edge = 0, rooted = is.rooted(phy), collapse.singles = TRUE,
+ interactive = FALSE)
+extract.clade(phy, node, root.edge = 0, collapse.singles = TRUE,
+ interactive = FALSE)
}
\arguments{
\item{phy}{an object of class \code{"phylo"}.}
@@ -28,6 +30,8 @@ extract.clade(phy, node, root.edge = 0, interactive = FALSE)
\item{rooted}{a logical indicating whether the tree must be treated as
rooted or not. This allows to force the tree to be considered as
unrooted (see examples).}
+ \item{collapse.singles}{a logical specifying whether to delete the
+ internal nodes of degree 2.}
\item{node}{a node number or label.}
\item{interactive}{if \code{TRUE} the user is asked to select the tips
or the node by clicking on the tree which must be plotted.}
@@ -60,7 +64,7 @@ extract.clade(phy, node, root.edge = 0, interactive = FALSE)
\value{
an object of class \code{"phylo"}.
}
-\author{Emmanuel Paradis}
+\author{Emmanuel Paradis, Klaus Schliep}
\seealso{
\code{\link{bind.tree}}, \code{\link{root}}
}
diff --git a/man/evonet.Rd b/man/evonet.Rd
index b41acf0..dbe8cff 100644
--- a/man/evonet.Rd
+++ b/man/evonet.Rd
@@ -1,29 +1,44 @@
\name{evonet}
\alias{evonet}
+\alias{as.evonet}
+\alias{as.evonet.phylo}
+\alias{read.evonet}
+\alias{write.evonet}
\alias{print.evonet}
\alias{plot.evonet}
+\alias{reorder.evonet}
\alias{as.phylo.evonet}
\alias{as.networx.evonet}
\alias{as.network.evonet}
\alias{as.igraph.evonet}
+\alias{Nedge.evonet}
\title{Evolutionary Networks}
\description{
\code{evonet} builds a network from a tree of class
- \code{"phylo"}. There are \code{print} and \code{plot} methods as well
- as a few conversion functions.
+ \code{"phylo"}. There are \code{print}, \code{plot}, and
+ \code{reorder} methods as well as a few conversion functions.
}
\usage{
evonet(phy, from, to = NULL)
\method{print}{evonet}(x, ...)
\method{plot}{evonet}(x, col = "blue", lty = 1, lwd = 1, alpha = 0.5,
arrows = 0, arrow.type = "classical", ...)
+\method{Nedge}{evonet}(phy)
+\method{reorder}{evonet}(x, order = "cladewise", index.only = FALSE, ...)
\method{as.phylo}{evonet}(x, ...)
\method{as.networx}{evonet}(x, weight = NA, ...)
\method{as.network}{evonet}(x, directed = TRUE, ...)
\method{as.igraph}{evonet}(x, directed = TRUE, use.labels = TRUE, ...)
+
+as.evonet(x, ...)
+\method{as.evonet}{phylo}(x, ...)
+
+read.evonet(file = "", text = NULL, comment.char = "", ...)
+write.evonet(x, file = "", ...)
}
\arguments{
- \item{phy, x}{an object of class \code{"phylo"} or \code{"evonet"}.}
+ \item{phy}{an object of class \code{"phylo"}.}
+ \item{x}{an object of class \code{"evonet"}.}
\item{from}{a vector (or a matrix if \code{to = NULL}) giving the node
or tip numbers involved in the reticulations.}
\item{to}{a vector of the same length than \code{from}.}
@@ -31,8 +46,8 @@ evonet(phy, from, to = NULL)
(recycled if necessary).}
\item{alpha}{a value between 0 and 1 specifying the transparency of
the reticulations.}
- \item{arrows}{see \code{\link{fancyarrows}}.}
- \item{arrow.type}{idem.}
+ \item{arrows, arrow.type}{see \code{\link{fancyarrows}}.}
+ \item{order, index.only}{see \code{\link{reorder.phylo}}.}
\item{weight}{a numeric vector giving the weights for the
reticulations when converting to the class \code{"networx"}
(recycled or shortened if needed).}
@@ -40,6 +55,7 @@ evonet(phy, from, to = NULL)
directed? \code{TRUE} by default.}
\item{use.labels}{a logical specifying whether to use the tip and node
labels when building the network of class \code{"igraph"}.}
+ \item{file, text, comment.char}{see \code{\link{read.tree}}.}
\item{\dots}{arguments passed to other methods.}
}
\details{
@@ -48,6 +64,9 @@ evonet(phy, from, to = NULL)
The classes \code{"networx"}, \code{"network"}, and \code{"igraph"}
are defined in the packages \pkg{phangorn}, \pkg{network}, and
\pkg{igraph}, respectively.
+
+ \code{read.evonet} reads networks from files in extended newick format
+ (Cardona et al. 2008).
}
\value{
an object of class \code{c("evonet", "phylo")} which is made of an
@@ -57,14 +76,30 @@ evonet(phy, from, to = NULL)
The conversion functions return an object of the appropriate class.
}
-\author{Emmanuel Paradis}
+\author{Emmanuel Paradis, Klaus Schliep}
\seealso{
\code{\link[phangorn]{as.networx}} in package \pkg{phangorn}
}
+\references{
+ Cardona, G., Rossell, F., and Valiente, G. (2008) Extended Newick: it
+ is time for a standard representation of phylogenetic
+ networks. \emph{BMC Bioinformatics}, \bold{9}, 532.
+}
\examples{
tr <- rcoal(5)
(x <- evonet(tr, 6:7, 8:9))
plot(x)
-}
+## simple example of extended Newick format:
+(enet <- read.evonet(text = "((a:2,(b:1)#H1:1):1,(#H1,c:1):2);"))
+plot(enet, arrows=1)
+## from Fig. 2 in Cardona et al. 2008:
+z <- read.evonet(text =
+"((1,((2,(3,(4)Y#H1)g)e,(((Y#H1, 5)h,6)f)X#H2)c)a,((X#H2,7)d,8)b)r;")
+z
+plot(z)
+\dontrun{
+if (require(igraph)) {
+ plot(as.igraph(z))
+}}}
\keyword{manip}
\keyword{hplot}
diff --git a/man/image.DNAbin.Rd b/man/image.DNAbin.Rd
index f5fdfec..2dc89a6 100644
--- a/man/image.DNAbin.Rd
+++ b/man/image.DNAbin.Rd
@@ -6,7 +6,9 @@
}
\usage{
\method{image}{DNAbin}(x, what, col, bg = "white", xlab = "", ylab = "",
- show.labels = TRUE, cex.lab = 1, legend = TRUE, ...)
+ show.labels = TRUE, cex.lab = 1, legend = TRUE,
+ grid = FALSE, show.bases = FALSE, base.cex = 1,
+ base.font = 1, base.col = "black", ...)
}
\arguments{
\item{x}{a matrix of DNA sequences (class \code{"DNAbin"}).}
@@ -24,11 +26,19 @@
\item{show.labels}{a logical controlling whether the sequence labels
are printed (\code{TRUE} by default).}
\item{cex.lab}{a single numeric controlling the size of the sequence labels.
- Use \code{cex.axis} to control the size of the annotations on the \emph{x}-axis.}
+ Use \code{cex.axis} to control the size of the annotations on the
+ \emph{x}-axis.}
\item{legend}{a logical controlling whether the legend is plotted
(\code{TRUE} by default).}
+ \item{grid}{a logical controlling whether to draw a grid (\code{FALSE}
+ by default).}
+ \item{show.bases}{a logical controlling whether to show the base symbols
+ (\code{FALSE} by default).}
+ \item{base.cex, base.font, base.col}{control the aspect of the base
+ symbols (ignored if the previous is \code{FALSE}).}
\item{\dots}{further arguments passed to
- \code{\link[graphics]{image.default}} (e.g., \code{cex.axis}).}
+ \code{\link[graphics]{image.default}} (e.g., \code{xlab},
+ \code{cex.axis}).}
}
\details{
The idea of this function is to allow flexible plotting and colouring
diff --git a/man/mrca.Rd b/man/mrca.Rd
index 696f055..cb127d9 100644
--- a/man/mrca.Rd
+++ b/man/mrca.Rd
@@ -17,7 +17,8 @@ getMRCA(phy, tip)
\item{full}{a logical indicating whether to return the MRCAs among
all tips and nodes (if \code{TRUE}); the default is to return only
the MRCAs among tips.}
- \item{tip}{a vector of mode numeric or character specifying the tips.}
+ \item{tip}{a vector of mode numeric or character specifying the tips;
+ can also be node numbers.}
}
\details{
For \code{mrca}, the diagonal is set to the number of the tips (and
@@ -32,5 +33,5 @@ getMRCA(phy, tip)
a matrix of mode numeric (\code{mrca}) or a single numeric value
(\code{getMRCA}).
}
-\author{Emmanuel Paradis}
+\author{Emmanuel Paradis, Klaus Schliep, Joseph W. Brown}
\keyword{manip}
diff --git a/man/multi2di.Rd b/man/multi2di.Rd
index 0fd0b97..829b4a8 100644
--- a/man/multi2di.Rd
+++ b/man/multi2di.Rd
@@ -49,6 +49,6 @@ tr <- read.tree(text = "(a:1,b:1,c:1);")
layout(matrix(1:4, 2, 2))
for (i in 1:4)
plot(multi2di(tr), use.edge.length = FALSE, cex = 1.5)
-layout(matrix(1))
+layout(1)
}
\keyword{manip}
diff --git a/man/nodelabels.Rd b/man/nodelabels.Rd
index 229b517..8edf54f 100644
--- a/man/nodelabels.Rd
+++ b/man/nodelabels.Rd
@@ -16,7 +16,7 @@ nodelabels(text, node, adj = c(0.5, 0.5), frame = "rect",
tiplabels(text, tip, adj = c(0.5, 0.5), frame = "rect",
pch = NULL, thermo = NULL, pie = NULL, piecol = NULL,
col = "black", bg = "yellow", horiz = FALSE,
- width = NULL, height = NULL, ...)
+ width = NULL, height = NULL, offset = 0, ...)
edgelabels(text, edge, adj = c(0.5, 0.5), frame = "rect",
pch = NULL, thermo = NULL, pie = NULL, piecol = NULL,
col = "black", bg = "lightgreen", horiz = FALSE,
@@ -63,6 +63,7 @@ edgelabels(text, edge, adj = c(0.5, 0.5), frame = "rect",
\item{horiz, width, height}{parameters controlling the aspect of
thermometers; by default, their width and height are determined
automatically.}
+ \item{offset}{offset of the tip labels (can be negative).}
\item{date}{specifies the positions of labels on edges of chronograms
with respect to the time scale.}
}
@@ -159,7 +160,7 @@ plot(tr, "c", FALSE, no.margin = TRUE)
nodelabels(thermo = x, col = rainbow(4), cex = 1.3)
plot(tr, "c", FALSE, no.margin = TRUE)
nodelabels(thermo = x, col = rainbow(4), width = 3, horiz = TRUE)
-layout(matrix(1))
+layout(1)
plot(tr, main = "Showing Edge Lengths")
edgelabels(round(tr$edge.length, 3), srt = 90)
plot(tr, "p", FALSE)
diff --git a/man/pcoa.Rd b/man/pcoa.Rd
index c5e43ea..3f4307d 100644
--- a/man/pcoa.Rd
+++ b/man/pcoa.Rd
@@ -8,7 +8,8 @@ Function \code{\link{pcoa}} computes principal coordinate decomposition (also ca
\usage{
pcoa(D, correction="none", rn=NULL)
-\method{biplot}{pcoa}(x, Y=NULL, plot.axes = c(1,2), dir.axis1=1, dir.axis2=1, rn=NULL, ...)
+\method{biplot}{pcoa}(x, Y=NULL, plot.axes = c(1,2), dir.axis1=1,
+ dir.axis2=1, rn=NULL, main=NULL, ...)
}
\arguments{
@@ -19,7 +20,9 @@ pcoa(D, correction="none", rn=NULL)
\item{Y}{ Any rectangular data table containing explanatory variables to be projected onto the ordination plot. That table may contain, for example, the community composition data used to compute D, or any transformation of these data; see examples. }
\item{plot.axes}{ The two PCoA axes to plot. }
\item{dir.axis1}{ = -1 to revert axis 1 for the projection of points and variables. Default value: +1. }
- \item{dir.axis2}{ = -1 to revert axis 2 for the projection of points and variables. Default value: +1. }
+ \item{dir.axis2}{ = -1 to revert axis 2 for the projection of points
+ and variables. Default value: +1. }
+ \item{main}{An optional title.}
\item{...}{ Other graphical arguments passed to function. }
}
diff --git a/man/phydataplot.Rd b/man/phydataplot.Rd
index e4fe61d..8271bc1 100644
--- a/man/phydataplot.Rd
+++ b/man/phydataplot.Rd
@@ -27,7 +27,8 @@ ring(x, phy, style = "ring", offset = 1, ...)
\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.}
+ legend; one of \code{"below"} (the default), \code{"side"}, or
+ \code{"none"}, or an unambiguous abbreviation of these.}
\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.}
@@ -46,7 +47,8 @@ ring(x, phy, style = "ring", offset = 1, ...)
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).
+ vector of colours must be used, possibly with names if you want to
+ assign a specific colour to each value (see examples).
}
\note{
For the moment, only rightwards trees are supported (does not apply to
@@ -163,6 +165,11 @@ f <- function(n) c("yellow", "blue", "red")
phydataplot(x, tr, "m", 18, width = 2, border = "white", lwd = 3,
legend = "side", funcol = f)
+## alternative colour function...:
+## fb <- function(n) c("3" = "red", "2" = "blue", "1" = "yellow")
+## ... but since the values are sorted alphabetically,
+## both f and fb will produce the same plot.
+
## use continuous = TRUE with two different scales:
x[] <- 1:(n*p)
plot(tr, x.lim = 35, align.tip = TRUE, adj = 1)
diff --git a/man/plot.phylo.Rd b/man/plot.phylo.Rd
index 4c5cef3..7f3dd97 100644
--- a/man/plot.phylo.Rd
+++ b/man/plot.phylo.Rd
@@ -210,7 +210,7 @@ plot(tree.owls, type = "u")
plot(tree.owls, use.edge.length = FALSE, main = "Without branch lengths")
plot(tree.owls, type = "c", use.edge.length = FALSE)
plot(tree.owls, type = "u", use.edge.length = FALSE)
-layout(matrix(1))
+layout(1)
data(bird.orders)
### using random colours and thickness
diff --git a/man/rTraitCont.Rd b/man/rTraitCont.Rd
index 2251c85..40d3099 100644
--- a/man/rTraitCont.Rd
+++ b/man/rTraitCont.Rd
@@ -36,8 +36,8 @@ rTraitCont(phy, model = "BM", sigma = 0.1, alpha = 1, theta = 0,
\code{sigma} has more than one value, its length must be equal to the
the branches of the tree. This allows to specify a model with variable
rates of evolution. You must be careful that branch numbering is done
- with the tree in ``pruningwise'' order: to see the order of the branches
- you can use: \code{tr <- reorder(tr, "p"); plor(tr); edgelabels()}.
+ with the tree in ``postorder'' order: to see the order of the branches
+ you can use: \code{tr <- reorder(tr, "po"); plor(tr); edgelabels()}.
The arguments \code{alpha} and \code{theta} are ignored.}
\item{\code{"OU"}:}{an Ornstein-Uhlenbeck model is used. The above
diff --git a/man/read.tree.Rd b/man/read.tree.Rd
index 0ce1646..5c687e1 100644
--- a/man/read.tree.Rd
+++ b/man/read.tree.Rd
@@ -4,7 +4,7 @@
\title{Read Tree File in Parenthetic Format}
\usage{
read.tree(file = "", text = NULL, tree.names = NULL, skip = 0,
- comment.char = "#", keep.multi = FALSE, ...)
+ comment.char = "", keep.multi = FALSE, ...)
}
\arguments{
\item{file}{a file name specified by either a variable of mode character,
@@ -50,6 +50,10 @@ read.tree(file = "", text = NULL, tree.names = NULL, skip = 0,
If there are any characters preceding the first "(" in a line then
this is assigned to the name. This is returned when a "multiPhylo"
object is returned and \code{tree.names = NULL}.
+
+ Until \pkg{ape} 4.1, the default of \code{comment.char} was \code{"#"}
+ (as in \code{scan}). This has been changed so that extended Newick
+ files can be read.
}
\value{
an object of class \code{"phylo"} with the following components:
@@ -111,6 +115,21 @@ TREE
tree.owls.bis <- read.tree(text = TREE)
str(tree.owls.bis)
tree.owls.bis
+
+## tree with singleton nodes:
+ts <- read.tree(text="((((a))),d);")
+plot(ts, node.depth = 2) # the default will overlap the singleton node with the tip
+nodelabels()
+
+## skeleton tree with a singleton node:
+tx <- read.tree(text = "(((,)),);")
+plot(tx, node.depth = 2)
+nodelabels()
+
+## a tree with single quoted labels (the 2nd label is not quoted):
+z <- "(('a: France, Spain (Europe)',b),'c: Australia [Outgroup]');"
+tz <- read.tree(text = z)
+plot(tz, font = 1)
}
\keyword{manip}
\keyword{IO}
diff --git a/man/reorder.phylo.Rd b/man/reorder.phylo.Rd
index d34654f..3a9ecd9 100644
--- a/man/reorder.phylo.Rd
+++ b/man/reorder.phylo.Rd
@@ -1,15 +1,22 @@
\name{reorder.phylo}
\alias{reorder.phylo}
\alias{reorder.multiPhylo}
+\alias{cladewise}
+\alias{postorder}
\title{Internal Reordering of Trees}
\description{
- This function changes the internal structure of a phylogeny stored as
+ \code{reorder} changes the internal structure of a phylogeny stored as
an object of class \code{"phylo"}. The tree returned is the same than
the one input, but the ordering of the edges could be different.
+
+ \code{cladewise} and \code{postorder} are convenience functions to
+ return only the indices of the reordered edge matrices (see examples).
}
\usage{
\method{reorder}{phylo}(x, order = "cladewise", index.only = FALSE, ...)
\method{reorder}{multiPhylo}(x, order = "cladewise", ...)
+cladewise(x)
+postorder(x)
}
\arguments{
\item{x}{an object of class \code{"phylo"} or \code{"multiPhylo"}.}
@@ -59,5 +66,22 @@ data(bird.families)
tr <- reorder(bird.families, "postorder")
all.equal(bird.families, tr) # uses all.equal.phylo actually
all.equal.list(bird.families, tr) # bypasses the generic
+
+## get the number of descendants for each tip or node:
+nr_desc <- function(x) {
+ res <- numeric(max(x$edge))
+ res[1:Ntip(x)] <- 1L
+ for (i in postorder(x)) {
+ tmp <- x$edge[i,1]
+ res[tmp] <- res[tmp] + res[x$edge[i, 2]]
+ }
+ res
+}
+## apply it to a random tree:
+tree <- rtree(10)
+plot(tree, show.tip.label = FALSE)
+tiplabels()
+nodelabels()
+nr_desc(tree)
}
\keyword{manip}
diff --git a/man/richness.yule.test.Rd b/man/richness.yule.test.Rd
index 91177f6..b80c856 100644
--- a/man/richness.yule.test.Rd
+++ b/man/richness.yule.test.Rd
@@ -32,6 +32,6 @@ richness.yule.test(x, t)
\code{\link{diversity.contrast.test}}
}
\examples{
-### see examples(mcconwaysims.test)
+### see example(mcconwaysims.test)
}
\keyword{htest}
diff --git a/man/rtree.Rd b/man/rtree.Rd
index 514f39b..8ad609f 100644
--- a/man/rtree.Rd
+++ b/man/rtree.Rd
@@ -63,6 +63,7 @@ data(bird.orders)
layout(matrix(1:4, 2, 2))
for (i in 1:4)
plot(rcoal(23, tip.label = bird.orders$tip.label), no.margin = TRUE)
-layout(matrix(1))
+layout(1)
+par(mar = c(5, 4, 4, 2))
}
\keyword{datagen}
diff --git a/man/speciesTree.Rd b/man/speciesTree.Rd
index f977f3b..5cb3b72 100644
--- a/man/speciesTree.Rd
+++ b/man/speciesTree.Rd
@@ -42,16 +42,11 @@ TR <- c(tr1, tr2)
TSmax <- speciesTree(TR) # MAXTREE
TSsha <- speciesTree(TR, mean) # shallowest divergence
-layout(matrix(1:4, 1))
-## playing with 'x.lim' is not so complicated
-## but this will be improved someday
-plot(tr1, "c", d = "u", y.lim = c(-0.07, 0.1), font = 1)
-axisPhylo(4); title("Gene tree 1")
-plot(tr2, "c", d = "u", y.lim = c(-0.05, 0.12), font = 1)
-axisPhylo(4); title("Gene tree 2")
-plot(TSmax, "c", d = "u", y.lim = c(-0.1, 0.07), font = 1)
-axisPhylo(4); title("Species tree inferred\nby MAXTREE")
-plot(TSsha, "c", d = "u", y.lim = c(0, 0.17), font = 1)
-axisPhylo(4); title("Species tree inferred\nby Shallowest Divergence")
+kronoviz(c(tr1, tr2, TSmax, TSsha), horiz = FALSE,
+ type = "c", cex = 1.5, font = 1)
+mtext(c("Gene tree 1", "Gene tree 2", "Species tree - MAXTREE"),
+ at = -c(7.5, 4, 1))
+mtext("Species tree - Shallowest Divergence")
+layout(1)
}
\keyword{models}
diff --git a/man/trans.Rd b/man/trans.Rd
index 67431a2..47b1946 100644
--- a/man/trans.Rd
+++ b/man/trans.Rd
@@ -46,7 +46,7 @@ data(woodmouse)
X <- trans(woodmouse) # not correct
X2 <- trans(woodmouse, 2) # using the correct code
identical(X, X2)
-alview(X[1:2, 1:60]) # some codon Stop (*)
+alview(X[1:2, 1:60]) # some 'Stop' codons (*)
alview(X2[, 1:60])
X2
}
\ No newline at end of file
diff --git a/man/write.nexus.Rd b/man/write.nexus.Rd
index b9713ad..5912d57 100644
--- a/man/write.nexus.Rd
+++ b/man/write.nexus.Rd
@@ -23,6 +23,9 @@ write.nexus(..., file = "", translate = TRUE)
If among the objects given some are not trees of class \code{"phylo"},
they are simply skipped and not written in the file.
+
+ See \code{\link{write.tree}} for details on how tip (and node) labels
+ are checked before being printed.
}
\value{
None (invisible `NULL').
diff --git a/man/write.tree.Rd b/man/write.tree.Rd
index 7a51244..09e2ab7 100644
--- a/man/write.tree.Rd
+++ b/man/write.tree.Rd
@@ -37,6 +37,12 @@ write.tree(phy, file = "", append = FALSE,
(parentheses are eventually deleted beforehand). The tree names are
taken from the \code{names} attribute if present (they are ignored if
\code{tree.names} is a character vector).
+
+ The tip labels (and the node labels if present) are checked before
+ being printed: the leading and trailing spaces, and the leading left
+ and trailing right parentheses are deleted; the other spaces are
+ replaced by underscores; the commas, colons, semicolons, and the other
+ parentheses are replaced with dashes.
}
\references{
Felsenstein, J. The Newick tree format.
diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp
new file mode 100644
index 0000000..1b0a1cd
--- /dev/null
+++ b/src/RcppExports.cpp
@@ -0,0 +1,45 @@
+// Generated by using Rcpp::compileAttributes() -> do not edit by hand
+// Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
+
+#include <Rcpp.h>
+
+using namespace Rcpp;
+
+// bipartition2
+std::vector< std::vector<int> > bipartition2(IntegerMatrix orig, int nTips);
+RcppExport SEXP _ape_bipartition2(SEXP origSEXP, SEXP nTipsSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< IntegerMatrix >::type orig(origSEXP);
+ Rcpp::traits::input_parameter< int >::type nTips(nTipsSEXP);
+ rcpp_result_gen = Rcpp::wrap(bipartition2(orig, nTips));
+ return rcpp_result_gen;
+END_RCPP
+}
+// prop_part2
+List prop_part2(SEXP trees, int nTips);
+RcppExport SEXP _ape_prop_part2(SEXP treesSEXP, SEXP nTipsSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< SEXP >::type trees(treesSEXP);
+ Rcpp::traits::input_parameter< int >::type nTips(nTipsSEXP);
+ rcpp_result_gen = Rcpp::wrap(prop_part2(trees, nTips));
+ return rcpp_result_gen;
+END_RCPP
+}
+// reorderRcpp
+IntegerVector reorderRcpp(IntegerMatrix orig, int nTips, int root, int order);
+RcppExport SEXP _ape_reorderRcpp(SEXP origSEXP, SEXP nTipsSEXP, SEXP rootSEXP, SEXP orderSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< IntegerMatrix >::type orig(origSEXP);
+ Rcpp::traits::input_parameter< int >::type nTips(nTipsSEXP);
+ Rcpp::traits::input_parameter< int >::type root(rootSEXP);
+ Rcpp::traits::input_parameter< int >::type order(orderSEXP);
+ rcpp_result_gen = Rcpp::wrap(reorderRcpp(orig, nTips, root, order));
+ return rcpp_result_gen;
+END_RCPP
+}
diff --git a/src/ape.c b/src/ape.c
index dc0a726..2d938d1 100644
--- a/src/ape.c
+++ b/src/ape.c
@@ -1,4 +1,4 @@
-/* ape.c 2016-06-21 */
+/* ape.c 2017-07-27 */
/* Copyright 2011-2016 Emmanuel Paradis, and 2007 R Development Core Team */
@@ -81,12 +81,18 @@ void CountBipartitionsFromTrees(int *n, int *m, int *e, int *N, int *nr, int *nc
void DNAbin2indelblock(unsigned char *x, int *n, int *s, int *y);
void trans_DNA2AA(unsigned char *x, int *s, unsigned char *res, int *code);
-SEXP bipartition(SEXP edge, SEXP nbtip, SEXP nbnode);
-SEXP prop_part(SEXP TREES, SEXP nbtree, SEXP keep_partitions);
+//SEXP bipartition(SEXP edge, SEXP nbtip, SEXP nbnode);
+//SEXP prop_part(SEXP TREES, SEXP nbtree, SEXP keep_partitions);
SEXP rawStreamToDNAbin(SEXP x);
SEXP seq_root2tip(SEXP edge, SEXP nbtip, SEXP nbnode);
SEXP treeBuildWithTokens(SEXP nwk);
+SEXP treeBuild(SEXP nwk);
+SEXP cladoBuildWithTokens(SEXP nwk);
+SEXP cladoBuild(SEXP nwk);
SEXP bitsplits_multiPhylo(SEXP x, SEXP n, SEXP nr);
+SEXP _ape_prop_part2(SEXP trees, SEXP nTips);
+SEXP _ape_bipartition2(SEXP orig, SEXP nTips);
+SEXP _ape_reorderRcpp(SEXP orig, SEXP nTips, SEXP root, SEXP order);
static R_CMethodDef C_entries[] = {
{"C_additive", (DL_FUNC) &C_additive, 4},
@@ -106,11 +112,11 @@ static R_CMethodDef C_entries[] = {
{"neworder_pruningwise", (DL_FUNC) &neworder_pruningwise, 6},
{"C_nj", (DL_FUNC) &C_nj, 5},
{"C_njs", (DL_FUNC) &C_njs, 6},
- {"node_depth", (DL_FUNC) &node_depth, 7},
- {"node_depth_edgelength", (DL_FUNC) &node_depth_edgelength, 7},
- {"node_height", (DL_FUNC) &node_height, 6},
- {"node_height_clado", (DL_FUNC) &node_height_clado, 7},
- {"C_pic", (DL_FUNC) &C_pic, 10},
+ {"node_depth", (DL_FUNC) &node_depth, 6},
+ {"node_depth_edgelength", (DL_FUNC) &node_depth_edgelength, 5},
+ {"node_height", (DL_FUNC) &node_height, 4},
+ {"node_height_clado", (DL_FUNC) &node_height_clado, 6},
+ {"C_pic", (DL_FUNC) &C_pic, 9},
{"C_rTraitCont", (DL_FUNC) &C_rTraitCont, 9},
{"C_treePop", (DL_FUNC) &C_treePop, 7},
{"C_triangMtd", (DL_FUNC) &C_triangMtd, 5},
@@ -124,15 +130,21 @@ static R_CMethodDef C_entries[] = {
};
static R_CallMethodDef Call_entries[] = {
- {"bipartition", (DL_FUNC) &bipartition, 3},
- {"prop_part", (DL_FUNC) &prop_part, 3},
+// {"bipartition", (DL_FUNC) &bipartition, 3},
+// {"prop_part", (DL_FUNC) &prop_part, 3},
{"rawStreamToDNAbin", (DL_FUNC) &rawStreamToDNAbin, 1},
{"seq_root2tip", (DL_FUNC) &seq_root2tip, 3},
{"treeBuildWithTokens", (DL_FUNC) &treeBuildWithTokens, 1},
+ {"treeBuild", (DL_FUNC) &treeBuild, 1},
+ {"cladoBuildWithTokens", (DL_FUNC) &cladoBuildWithTokens, 1},
+ {"cladoBuild", (DL_FUNC) &cladoBuild, 1},
{"bitsplits_multiPhylo", (DL_FUNC) &bitsplits_multiPhylo, 3},
{"BaseProportion", (DL_FUNC) &BaseProportion, 1},
{"SegSites", (DL_FUNC) &SegSites, 1},
{"C_where", (DL_FUNC) &C_where, 2},
+ {"_ape_bipartition2", (DL_FUNC) &_ape_bipartition2, 2},
+ {"_ape_prop_part2", (DL_FUNC) &_ape_prop_part2, 2},
+ {"_ape_reorderRcpp", (DL_FUNC) &_ape_reorderRcpp, 4},
{NULL, NULL, 0}
};
diff --git a/src/bipartition.c b/src/bipartition.c
index d2a682d..856b51d 100644
--- a/src/bipartition.c
+++ b/src/bipartition.c
@@ -1,6 +1,6 @@
-/* bipartition.c 2014-01-02 */
+/* bipartition.c 2017-07-28 */
-/* Copyright 2005-2014 Emmanuel Paradis */
+/* Copyright 2005-2017 Emmanuel Paradis */
/* This file is part of the R-package `ape'. */
/* See the file ../COPYING for licensing issues. */
@@ -75,139 +75,139 @@ SEXP seq_root2tip(SEXP edge, SEXP nbtip, SEXP nbnode)
return ans;
} /* EOF seq_root2tip */
-SEXP bipartition(SEXP edge, SEXP nbtip, SEXP nbnode)
-{
- int i, j, k, lt, lt2, inod, Ntip, Nnode;
- SEXP ans, seqnod, tmp_vec;
-
- PROTECT(edge = coerceVector(edge, INTSXP));
- PROTECT(nbtip = coerceVector(nbtip, INTSXP));
- PROTECT(nbnode = coerceVector(nbnode, INTSXP));
- Ntip = *INTEGER(nbtip);
- Nnode = *INTEGER(nbnode);
-
- PROTECT(ans = allocVector(VECSXP, Nnode));
- PROTECT(seqnod = seq_root2tip(edge, nbtip, nbnode));
-
- for (i = 0; i < LENGTH(seqnod); i++) { /* for each tip */
- lt = LENGTH(VECTOR_ELT(seqnod, i));
- for (j = 0; j < lt - 1; j++) {
- inod = INTEGER(VECTOR_ELT(seqnod, i))[j] - Ntip - 1;
- if (VECTOR_ELT(ans, inod) == R_NilValue) {
- tmp_vec = allocVector(INTSXP, 1);
- INTEGER(tmp_vec)[0] = i + 1;
- } else {
- lt2 = LENGTH(VECTOR_ELT(ans, inod));
- tmp_vec = allocVector(INTSXP, lt2 + 1);
- for (k = 0; k < lt2; k++)
- INTEGER(tmp_vec)[k] = INTEGER(VECTOR_ELT(ans, inod))[k];
- INTEGER(tmp_vec)[lt2] = i + 1;
- }
- SET_VECTOR_ELT(ans, inod, tmp_vec);
- }
- }
-
- UNPROTECT(5);
- return ans;
-} /* bipartition */
-
-int SameClade(SEXP clade1, SEXP clade2)
-{
- int i, n = LENGTH(clade1), *c1, *c2;
-
- if (n != LENGTH(clade2)) return 0;
-
- c1 = INTEGER(clade1);
- c2 = INTEGER(clade2);
- for (i = 0; i < n; i++)
- if (c1[i] != c2[i]) return 0;
-
- return 1;
-}
-
-SEXP prop_part(SEXP TREES, SEXP nbtree, SEXP keep_partitions)
-{
- int i, j, k, KeepPartition, Ntree, Ntip, Nnode, Npart, NpartCurrent, *no;
- SEXP bp, ans, nbtip, nbnode, number;
-
- PROTECT(nbtree = coerceVector(nbtree, INTSXP));
- PROTECT(keep_partitions = coerceVector(keep_partitions, INTSXP));
- Ntree = *INTEGER(nbtree);
- KeepPartition = *INTEGER(keep_partitions);
-
-
- Ntip = LENGTH(getListElement(VECTOR_ELT(TREES, 0), "tip.label"));
- Nnode = *INTEGER(getListElement(VECTOR_ELT(TREES, 0), "Nnode"));
-
- PROTECT(nbtip = allocVector(INTSXP, 1));
- PROTECT(nbnode = allocVector(INTSXP, 1));
- INTEGER(nbtip)[0] = Ntip;
- INTEGER(nbnode)[0] = Nnode;
-
- if (KeepPartition) Npart = Ntree * (Ntip - 2) + 1;
- else Npart = Ntip - 1;
-
- PROTECT(number = allocVector(INTSXP, Npart));
- no = INTEGER(number); /* copy the pointer */
- /* The first partition in the returned list has all tips,
- so it is observed in all trees: */
- no[0] = Ntree;
- /* The partitions in the first tree are obviously observed once: */
- for (i = 1; i < Nnode; i++) no[i] = 1;
-
- if (KeepPartition) {
- for (i = Nnode; i < Npart; i++) no[i] = 0;
-
- PROTECT(ans = allocVector(VECSXP, Npart));
- PROTECT(bp = bipartition(getListElement(VECTOR_ELT(TREES, 0), "edge"),
- nbtip, nbnode));
- for (i = 0; i < Nnode; i++)
- SET_VECTOR_ELT(ans, i, VECTOR_ELT(bp, i));
- UNPROTECT(1);
- } else {
- PROTECT(ans = bipartition(getListElement(VECTOR_ELT(TREES, 0), "edge"),
- nbtip, nbnode));
- }
-
- NpartCurrent = Nnode;
-
- /* We start on the 2nd tree: */
- for (k = 1; k < Ntree; k++) {
-
-/* in case there are trees with multichotomies: */
- nbnode = getListElement(VECTOR_ELT(TREES, k), "Nnode");
- Nnode = INTEGER(nbnode)[0];
-
- PROTECT(bp = bipartition(getListElement(VECTOR_ELT(TREES, k), "edge"),
- nbtip, nbnode));
- for (i = 1; i < Nnode; i++) {
- j = 1;
-next_j:
- if (SameClade(VECTOR_ELT(bp, i), VECTOR_ELT(ans, j))) {
- no[j]++;
- continue;
- }
- j++;
- if (j < NpartCurrent) goto next_j;
- if (KeepPartition) {
- no[NpartCurrent]++;
- SET_VECTOR_ELT(ans, NpartCurrent, VECTOR_ELT(bp, i));
- NpartCurrent++;
- }
- }
- UNPROTECT(1);
- }
-
- if (KeepPartition && NpartCurrent < Npart) {
- PROTECT(bp = allocVector(VECSXP, NpartCurrent));
- for (i = 0; i < NpartCurrent; i++)
- SET_VECTOR_ELT(bp, i, VECTOR_ELT(ans, i));
- setAttrib(bp, install("number"), number);
- UNPROTECT(7);
- return bp;
- } else {
- setAttrib(ans, install("number"), number);
- UNPROTECT(6);
- return ans;
- }
-} /* prop_part */
+//SEXP bipartition(SEXP edge, SEXP nbtip, SEXP nbnode)
+//{
+// int i, j, k, lt, lt2, inod, Ntip, Nnode;
+// SEXP ans, seqnod, tmp_vec;
+//
+// PROTECT(edge = coerceVector(edge, INTSXP));
+// PROTECT(nbtip = coerceVector(nbtip, INTSXP));
+// PROTECT(nbnode = coerceVector(nbnode, INTSXP));
+// Ntip = *INTEGER(nbtip);
+// Nnode = *INTEGER(nbnode);
+//
+// PROTECT(ans = allocVector(VECSXP, Nnode));
+// PROTECT(seqnod = seq_root2tip(edge, nbtip, nbnode));
+//
+// for (i = 0; i < LENGTH(seqnod); i++) { /* for each tip */
+// lt = LENGTH(VECTOR_ELT(seqnod, i));
+// for (j = 0; j < lt - 1; j++) {
+// inod = INTEGER(VECTOR_ELT(seqnod, i))[j] - Ntip - 1;
+// if (VECTOR_ELT(ans, inod) == R_NilValue) {
+// tmp_vec = allocVector(INTSXP, 1);
+// INTEGER(tmp_vec)[0] = i + 1;
+// } else {
+// lt2 = LENGTH(VECTOR_ELT(ans, inod));
+// tmp_vec = allocVector(INTSXP, lt2 + 1);
+// for (k = 0; k < lt2; k++)
+// INTEGER(tmp_vec)[k] = INTEGER(VECTOR_ELT(ans, inod))[k];
+// INTEGER(tmp_vec)[lt2] = i + 1;
+// }
+// SET_VECTOR_ELT(ans, inod, tmp_vec);
+// }
+// }
+//
+// UNPROTECT(5);
+// return ans;
+//} /* bipartition */
+
+//int SameClade(SEXP clade1, SEXP clade2)
+//{
+// int i, n = LENGTH(clade1), *c1, *c2;
+//
+// if (n != LENGTH(clade2)) return 0;
+//
+// c1 = INTEGER(clade1);
+// c2 = INTEGER(clade2);
+// for (i = 0; i < n; i++)
+// if (c1[i] != c2[i]) return 0;
+//
+// return 1;
+//}
+
+//SEXP prop_part(SEXP TREES, SEXP nbtree, SEXP keep_partitions)
+//{
+// int i, j, k, KeepPartition, Ntree, Ntip, Nnode, Npart, NpartCurrent, *no;
+// SEXP bp, ans, nbtip, nbnode, number;
+//
+// PROTECT(nbtree = coerceVector(nbtree, INTSXP));
+// PROTECT(keep_partitions = coerceVector(keep_partitions, INTSXP));
+// Ntree = *INTEGER(nbtree);
+// KeepPartition = *INTEGER(keep_partitions);
+//
+//
+// Ntip = LENGTH(getListElement(VECTOR_ELT(TREES, 0), "tip.label"));
+// Nnode = *INTEGER(getListElement(VECTOR_ELT(TREES, 0), "Nnode"));
+//
+// PROTECT(nbtip = allocVector(INTSXP, 1));
+// PROTECT(nbnode = allocVector(INTSXP, 1));
+// INTEGER(nbtip)[0] = Ntip;
+// INTEGER(nbnode)[0] = Nnode;
+//
+// if (KeepPartition) Npart = Ntree * (Ntip - 2) + 1;
+// else Npart = Ntip - 1;
+//
+// PROTECT(number = allocVector(INTSXP, Npart));
+// no = INTEGER(number); /* copy the pointer */
+// /* The first partition in the returned list has all tips,
+// so it is observed in all trees: */
+// no[0] = Ntree;
+// /* The partitions in the first tree are obviously observed once: */
+// for (i = 1; i < Nnode; i++) no[i] = 1;
+//
+// if (KeepPartition) {
+// for (i = Nnode; i < Npart; i++) no[i] = 0;
+//
+// PROTECT(ans = allocVector(VECSXP, Npart));
+// PROTECT(bp = bipartition(getListElement(VECTOR_ELT(TREES, 0), "edge"),
+// nbtip, nbnode));
+// for (i = 0; i < Nnode; i++)
+// SET_VECTOR_ELT(ans, i, VECTOR_ELT(bp, i));
+// UNPROTECT(1);
+// } else {
+// PROTECT(ans = bipartition(getListElement(VECTOR_ELT(TREES, 0), "edge"),
+// nbtip, nbnode));
+// }
+//
+// NpartCurrent = Nnode;
+//
+// /* We start on the 2nd tree: */
+// for (k = 1; k < Ntree; k++) {
+//
+///* in case there are trees with multichotomies: */
+// nbnode = getListElement(VECTOR_ELT(TREES, k), "Nnode");
+// Nnode = INTEGER(nbnode)[0];
+//
+// PROTECT(bp = bipartition(getListElement(VECTOR_ELT(TREES, k), "edge"),
+// nbtip, nbnode));
+// for (i = 1; i < Nnode; i++) {
+// j = 1;
+//next_j:
+// if (SameClade(VECTOR_ELT(bp, i), VECTOR_ELT(ans, j))) {
+// no[j]++;
+// continue;
+// }
+// j++;
+// if (j < NpartCurrent) goto next_j;
+// if (KeepPartition) {
+// no[NpartCurrent]++;
+// SET_VECTOR_ELT(ans, NpartCurrent, VECTOR_ELT(bp, i));
+// NpartCurrent++;
+// }
+// }
+// UNPROTECT(1);
+// }
+//
+// if (KeepPartition && NpartCurrent < Npart) {
+// PROTECT(bp = allocVector(VECSXP, NpartCurrent));
+// for (i = 0; i < NpartCurrent; i++)
+// SET_VECTOR_ELT(bp, i, VECTOR_ELT(ans, i));
+// setAttrib(bp, install("number"), number);
+// UNPROTECT(7);
+// return bp;
+// } else {
+// setAttrib(ans, install("number"), number);
+// UNPROTECT(6);
+// return ans;
+// }
+//} /* prop_part */
diff --git a/src/dist_dna.c b/src/dist_dna.c
index a90ff2c..8719881 100644
--- a/src/dist_dna.c
+++ b/src/dist_dna.c
@@ -870,8 +870,7 @@ void distDNA_LogDet_pairdel(unsigned char *x, int *n, int *s, double *d,
}
}
-void distDNA_BH87(unsigned char *x, int *n, int *s, double *d,
- int *variance, double *var)
+void distDNA_BH87(unsigned char *x, int *n, int *s, double *d)
/* <FIXME>
For the moment there is no need to check for pairwise deletions
since DO_CONTINGENCY_NUCLEOTIDES considers only the known nucleotides.
@@ -1190,7 +1189,7 @@ void dist_dna(unsigned char *x, int *n, int *s, int *model, double *d,
else distDNA_GG95(x, n, s, d, variance, var); break;
case 10 : if (pairdel) distDNA_LogDet_pairdel(x, n, s, d, variance, var);
else distDNA_LogDet(x, n, s, d, variance, var); break;
- case 11 : distDNA_BH87(x, n, s, d, variance, var); break;
+ case 11 : distDNA_BH87(x, n, s, d); break;
case 12 : if (pairdel) distDNA_ParaLin_pairdel(x, n, s, d, variance, var);
else distDNA_ParaLin(x, n, s, d, variance, var); break;
case 13 : if (pairdel) distDNA_raw_pairdel(x, n, s, d, 0);
diff --git a/src/pic.c b/src/pic.c
index c06310c..b119c38 100644
--- a/src/pic.c
+++ b/src/pic.c
@@ -1,13 +1,13 @@
-/* pic.c 2006-11-13 */
+/* pic.c 2017-04-25 */
-/* Copyright 2006 Emmanuel Paradis */
+/* Copyright 2006-2017 Emmanuel Paradis */
/* This file is part of the R-package `ape'. */
/* See the file ../COPYING for licensing issues. */
#include <R.h>
-void C_pic(int *ntip, int *nnode, int *edge1, int *edge2,
+void C_pic(int *ntip, int *edge1, int *edge2,
double *edge_len, double *phe, double *contr,
double *var_contr, int *var, int *scaled)
{
diff --git a/src/plot_phylo.c b/src/plot_phylo.c
index b63d995..ad4b1be 100644
--- a/src/plot_phylo.c
+++ b/src/plot_phylo.c
@@ -1,14 +1,14 @@
-/* plot_phylo.c (2014-03-05) */
+/* plot_phylo.c (2017-04-25) */
-/* Copyright 2004-2014 Emmanuel Paradis */
+/* Copyright 2004-2017 Emmanuel Paradis */
/* This file is part of the R-package `ape'. */
/* See the file ../COPYING for licensing issues. */
#include <R.h>
-void node_depth_edgelength(int *ntip, int *nnode, int *edge1, int *edge2,
- int *nedge, double *edge_length, double *xx)
+void node_depth_edgelength(int *edge1, int *edge2, int *nedge,
+ double *edge_length, double *xx)
{
int i;
@@ -19,7 +19,7 @@ void node_depth_edgelength(int *ntip, int *nnode, int *edge1, int *edge2,
xx[edge2[i] - 1] = xx[edge1[i] - 1] + edge_length[i];
}
-void node_depth(int *ntip, int *nnode, int *e1, int *e2,
+void node_depth(int *ntip, int *e1, int *e2,
int *nedge, double *xx, int *method)
/* method == 1: the node depths are proportional to the number of tips
method == 2: the node depths are evenly spaced */
@@ -47,8 +47,7 @@ void node_depth(int *ntip, int *nnode, int *e1, int *e2,
}
}
-void node_height(int *ntip, int *nnode, int *edge1, int *edge2,
- int *nedge, double *yy)
+void node_height(int *edge1, int *edge2, int *nedge, double *yy)
{
int i, n;
double S;
@@ -73,14 +72,14 @@ void node_height(int *ntip, int *nnode, int *edge1, int *edge2,
yy[edge1[i] - 1] = S/n;
}
-void node_height_clado(int *ntip, int *nnode, int *edge1, int *edge2,
+void node_height_clado(int *ntip, int *edge1, int *edge2,
int *nedge, double *xx, double *yy)
{
int i, j, n;
double S;
i = 1;
- node_depth(ntip, nnode, edge1, edge2, nedge, xx, &i);
+ node_depth(ntip, edge1, edge2, nedge, xx, &i);
/* The coordinates of the tips have been already computed */
diff --git a/src/prop_part.cpp b/src/prop_part.cpp
new file mode 100644
index 0000000..960ee5f
--- /dev/null
+++ b/src/prop_part.cpp
@@ -0,0 +1,82 @@
+/* additive.c 2017-07-26 */
+
+/* Copyright 2017 Klaus Schliep */
+
+/* This file is part of the R-package `ape'. */
+/* See the file ../COPYING for licensing issues. */
+
+#include <Rcpp.h>
+using namespace Rcpp;
+
+// [[Rcpp::export]]
+std::vector< std::vector<int> > bipartition2(IntegerMatrix orig, int nTips) {
+ IntegerVector parent = orig( _, 0);
+ IntegerVector children = orig( _, 1);
+ int m = max(parent), j=0;
+ int nnode = m - nTips;
+ // create list for results
+ std::vector< std::vector<int> > out(nnode);
+ std::vector<int> y;
+ for(int i = 0; i<parent.size(); i++){
+ j = parent[i] - nTips - 1L;
+ if(children[i] > nTips){
+ y = out[children[i] - nTips -1L];
+ out[j].insert( out[j].end(), y.begin(), y.end() );
+ }
+ else out[j].push_back(children[i]);
+ }
+ for(int i=0; i<nnode; ++i){
+ sort(out[i].begin(), out[i].end());
+ }
+ return out;
+}
+
+// call-by-reference is important here
+int SameClade(const std::vector<int>& clade1, const std::vector<int>& clade2)
+{
+ unsigned int n = clade1.size();
+ if (n != clade2.size()) return 0;
+// c1 = INTEGER(clade1);
+// c2 = INTEGER(clade2);
+ for (unsigned int i = 0; i < n; i++)
+ if (clade1[i] != clade2[i]) return 0;
+ return 1;
+}
+
+// [[Rcpp::export]]
+List prop_part2(SEXP trees, int nTips){
+ List tr(trees);
+ int nbtree = tr.size(), KeepPartition=1;
+ List M = tr(0);
+ IntegerMatrix E = M["edge"];
+ std::vector< std::vector<int> > ans = bipartition2(E, nTips);
+ std::vector<int> no;
+ for(unsigned int i=0; i<ans.size();++i) no.push_back(1);
+ no[0] = nbtree;
+ for(int k=1; k<nbtree; ++k){
+ List tmpTree = tr(k);
+ IntegerMatrix tmpE = tmpTree["edge"];
+ std::vector< std::vector<int> > bp = bipartition2(tmpE, nTips);
+
+ for (unsigned int i = 1; i < bp.size(); i++) {
+ unsigned int j = 1;
+ next_j:
+ if (SameClade(bp[i], ans[j])) {
+ no[j]++;
+ continue;
+ }
+ j++;
+ if (j < ans.size()) goto next_j;
+ else { //if(KeepPartition)
+ ans.push_back(bp[i]);
+ no.push_back(1);
+ }
+ }
+ }
+ List output = wrap(ans);
+ output.attr("number") = no;
+ output.attr("class") = "prop.part";
+// return Rcpp::List::create(Rcpp::Named("splits") = ans,
+// Rcpp::Named("number") = no);
+ return output;
+}
diff --git a/src/reorder_Rcpp.cpp b/src/reorder_Rcpp.cpp
new file mode 100644
index 0000000..5898053
--- /dev/null
+++ b/src/reorder_Rcpp.cpp
@@ -0,0 +1,93 @@
+/* additive.c 2017-07-26 */
+
+/* Copyright 2017 Klaus Schliep */
+
+/* This file is part of the R-package `ape'. */
+/* See the file ../COPYING for licensing issues. */
+
+#include <Rcpp.h>
+using namespace Rcpp;
+
+// This is a simple example of exporting a C++ function to R. You can
+// source this function into an R session using the Rcpp::sourceCpp
+// function (or via the Source button on the editor toolbar). Learn
+// more about Rcpp at:
+//
+// http://www.rcpp.org/
+// http://adv-r.had.co.nz/Rcpp.html
+// http://gallery.rcpp.org/
+//
+
+
+static int iii;
+
+void foo_reorderRcpp(int node, int nTips, const IntegerVector & e1,
+ const IntegerVector & e2, IntegerVector neworder, const IntegerVector & L,
+ const IntegerVector & xi, const IntegerVector & xj)
+{
+ int i = node - nTips - 1, j, k;
+ /* 'i' is the C index corresponding to 'node' */
+ for (j = 0; j < xj[i]; j++) {
+ k = L[xi[i] + j];
+ neworder[iii++] = k + 1;
+ if (e2[k] > nTips) /* is it an internal edge? */
+ foo_reorderRcpp(e2[k], nTips, e1, e2, neworder, L, xi, xj);
+ }
+}
+
+void bar_reorderRcpp(int node, int nTips, const IntegerVector & e1,
+ const IntegerVector & e2, IntegerVector neworder, const IntegerVector & L,
+ const IntegerVector & xi, const IntegerVector & xj)
+{
+ int i = node - nTips - 1, j, k;
+
+ for (j = xj[i] -1; j >= 0; j--)
+ neworder[iii--] = L[xi[i] + j ] + 1;
+
+ for (j = 0; j < xj[i]; j++) {
+ k = e2[L[xi[i] + j ]];
+ if (k > nTips)
+ bar_reorderRcpp(k, nTips, e1, e2, neworder, L, xi, xj);
+ }
+}
+
+
+// L is a vector of length number of edges
+// not max degree * number of nodes
+
+// [[Rcpp::export]]
+IntegerVector reorderRcpp(IntegerMatrix orig, int nTips, int root, int order) {
+ IntegerVector e1 = orig( _, 0);
+ IntegerVector e2 = orig( _, 1);
+ int m = max(e1), k, j;
+ int nnode = m - nTips;
+// int root = nTips + 1;
+ int n = orig.nrow();
+ IntegerVector L(n);
+ IntegerVector neworder(n);
+ IntegerVector pos(nnode);
+ IntegerVector xi(nnode);
+ IntegerVector xj(nnode);
+ for (int i = 0; i < n; i++) {
+ xj[e1[i] - nTips - 1]++;
+ }
+ for (int i = 1; i < nnode; i++) {
+ xi[i] = xi[i-1] + xj[i - 1];
+ }
+ for (int i = 0; i < n; i++) {
+ k = e1[i] - nTips - 1;
+ j = pos[k]; /* the current 'column' position corresponding to k */
+ L[xi[k] + j] = i;
+ pos[k]++;
+ }
+
+ switch(order) {
+ case 1 : iii = 0;
+ foo_reorderRcpp(root, nTips, e1, e2, neworder, L, xi, xj);
+ break;
+ case 2 : iii = n - 1;
+ bar_reorderRcpp(root, nTips, e1, e2, neworder, L, xi, xj);
+ break;
+ }
+ return neworder;
+}
diff --git a/src/tree_build.c b/src/tree_build.c
index 5ac3f86..51e1ae4 100644
--- a/src/tree_build.c
+++ b/src/tree_build.c
@@ -1,6 +1,6 @@
-/* tree_build.c 2011-06-23 */
+/* tree_build.c 2017-07-28 */
-/* Copyright 2008-2011 Emmanuel Paradis */
+/* Copyright 2008-2017 Emmanuel Paradis, 2017 Klaus Schliep */
/* This file is part of the R-package `ape'. */
/* See the file ../COPYING for licensing issues. */
@@ -32,12 +32,14 @@ void decode_terminal_edge_token(const char *x, int a, int b, int *node, double *
int co = a;
char *endstr, str[100];
- while (x[co] != ':') co++;
+ while (x[co] != ':' && co <= b) co++;
extract_portion_Newick(x, a, co - 1, str);
*node = str2int(str, co - a);
- extract_portion_Newick(x, co + 1, b, str);
- *w = R_strtod(str, &endstr);
+ if (co < b) {
+ extract_portion_Newick(x, co + 1, b, str);
+ *w = R_strtod(str, &endstr);
+ } else *w = NAN;
}
void decode_internal_edge(const char *x, int a, int b, char *lab, double *w)
@@ -45,13 +47,48 @@ void decode_internal_edge(const char *x, int a, int b, char *lab, double *w)
int co = a;
char *endstr, str[100];
- while (x[co] != ':') co++;
+ while (x[co] != ':' && co <= b) co++;
if (a == co) lab[0] = '\0'; /* if no node label */
else extract_portion_Newick(x, a, co - 1, lab);
+ if (co < b) {
+ extract_portion_Newick(x, co + 1, b, str);
+ *w = R_strtod(str, &endstr);
+ } else *w = NAN;
+}
+
+void decode_terminal_edge_token_clado(const char *x, int a, int b, int *node)
+{
+ char str[100]; // *endstr,
+
+ extract_portion_Newick(x, a, b, str);
+ *node = str2int(str, b + 1 - a);
+}
+
+void decode_internal_edge_clado(const char *x, int a, int b, char *lab)
+{
+// char *endstr, str[100];
+ if (a > b) lab[0] = '\0'; /* if no node label */
+ else extract_portion_Newick(x, a, b, lab);
+}
+
+void decode_terminal_edge(const char *x, int a, int b, char *tip, double *w)
+{
+ int co = a;
+ char *endstr, str[100];
+
+ while (x[co] != ':' && co <= b) co++;
- extract_portion_Newick(x, co + 1, b, str);
- *w = R_strtod(str, &endstr);
+ extract_portion_Newick(x, a, co - 1, tip);
+ if (co < b) {
+ extract_portion_Newick(x, co + 1, b, str);
+ *w = R_strtod(str, &endstr);
+ } else *w = NAN;
+}
+
+void decode_terminal_edge_clado(const char *x, int a, int b, char *tip)
+{
+ extract_portion_Newick(x, a, b, tip);
}
#define ADD_INTERNAL_EDGE \
@@ -74,6 +111,68 @@ void decode_internal_edge(const char *x, int a, int b, char *lab, double *w)
el[l] = tmpd; \
curnode = e[l]
+#define ADD_TERMINAL_EDGE_CLADO \
+ e[j] = curnode; \
+ decode_terminal_edge_token_clado(x, pr + 1, ps - 1, &tmpi); \
+ e[j + nedge] = tmpi; \
+ j++
+
+#define GO_DOWN_CLADO \
+ decode_internal_edge_clado(x, ps + 1, pt - 1, lab); \
+ SET_STRING_ELT(node_label, curnode - 1 - ntip, mkChar(lab)); \
+ l = stack_internal[--k]; \
+ curnode = e[l]
+
+
+#define ADD_TERMINAL_EDGE_TIPLABEL \
+ e[j] = curnode; \
+ decode_terminal_edge(x, pr + 1, ps - 1, tip, &tmpd); \
+ SET_STRING_ELT(tip_label, curtip-1, mkChar(tip)); \
+ e[j + nedge] = curtip; \
+ el[j] = tmpd; \
+ curtip++; \
+ j++
+
+#define ADD_TERMINAL_EDGE_TIPLABEL_CLADO \
+ e[j] = curnode; \
+ decode_terminal_edge_clado(x, pr + 1, ps - 1, tip); \
+ SET_STRING_ELT(tip_label, curtip-1, mkChar(tip)); \
+ e[j + nedge] = curtip; \
+ curtip++; \
+ j++
+
+#define INITIALIZE_SKELETON \
+ PROTECT(nwk = coerceVector(nwk, STRSXP)); \
+ x = CHAR(STRING_ELT(nwk, 0)); \
+ n = strlen(x); \
+ skeleton = (int *)R_alloc(n, sizeof(int *)); \
+ for (i = 0; i < n; i++) { \
+ if (x[i] == '(') { \
+ skeleton[nsk] = i; \
+ nsk++; \
+ continue; \
+ } \
+ if (x[i] == ',') { \
+ skeleton[nsk] = i; \
+ nsk++; \
+ ntip++; \
+ continue; \
+ } \
+ if (x[i] == ')') { \
+ skeleton[nsk] = i; \
+ nsk++; \
+ nnode++; \
+ } \
+ } \
+ nedge = ntip + nnode - 1
+
+/*
+ NOTE: the four functions below use the same algorithm to build a
+ "phylo" object from a Newick string (with/without edge lengths
+ and/or with/without tokens). Only the first one is commented.
+
+*/
+
SEXP treeBuildWithTokens(SEXP nwk)
{
const char *x;
@@ -82,32 +181,8 @@ SEXP treeBuildWithTokens(SEXP nwk)
char lab[512];
SEXP edge, edge_length, Nnode, node_label, phy;
- PROTECT(nwk = coerceVector(nwk, STRSXP));
- x = CHAR(STRING_ELT(nwk, 0));
- n = strlen(x);
- skeleton = (int *)R_alloc(n, sizeof(int *));
-
-/* first pass on the Newick string to localize parentheses and commas */
- for (i = 0; i < n; i++) {
- if (x[i] == '(') {
- skeleton[nsk] = i;
- nsk++;
- continue;
- }
- if (x[i] == ',') {
- skeleton[nsk] = i;
- nsk++;
- ntip++;
- continue;
- }
- if (x[i] == ')') {
- skeleton[nsk] = i;
- nsk++;
- nnode++;
- }
- }
-
- nedge = ntip + nnode - 1;
+ /* first pass on the Newick string to localize parentheses and commas */
+ INITIALIZE_SKELETON;
PROTECT(Nnode = allocVector(INTSXP, 1));
PROTECT(edge = allocVector(INTSXP, nedge*2));
@@ -125,13 +200,12 @@ SEXP treeBuildWithTokens(SEXP nwk)
/* stack_internal is a simple array storing the indices of the
successive internal edges from the root; it's a stack so it is
incremented every time an internal edge is added, and decremented
- every GO_DOWN step. This makes easy to the index of the
+ every GO_DOWN step. This makes easy to find the index of the
subtending edge. */
/* second pass on the Newick string to build the "phylo" object elements */
for (i = 1; i < nsk - 1; i++) {
ps = skeleton[i];
-// Rprintf(""); /* <- again !!!! */
if (x[ps] == '(') {
ADD_INTERNAL_EDGE;
continue;
@@ -151,6 +225,12 @@ SEXP treeBuildWithTokens(SEXP nwk)
GO_DOWN;
continue;
}
+ /* added by Klaus to allow singleton nodes (2017-05-28): */
+ if (x[pr] == '(') {
+ ADD_TERMINAL_EDGE;
+ GO_DOWN;
+ continue;
+ } /* end */
if (x[pr] == ')') {
GO_DOWN;
}
@@ -193,6 +273,238 @@ SEXP treeBuildWithTokens(SEXP nwk)
return phy;
}
+SEXP cladoBuildWithTokens(SEXP nwk)
+{
+ const char *x;
+ int n, i, ntip = 1, nnode = 0, nedge, *e, curnode, node, j, *skeleton, nsk = 0, ps, pr, pt, tmpi, l, k, stack_internal[10000];
+ char lab[512];
+ SEXP edge, Nnode, node_label, phy;
+
+ INITIALIZE_SKELETON;
+
+ PROTECT(Nnode = allocVector(INTSXP, 1));
+ PROTECT(edge = allocVector(INTSXP, nedge*2));
+ PROTECT(node_label = allocVector(STRSXP, nnode));
+ INTEGER(Nnode)[0] = nnode;
+
+ e = INTEGER(edge);
+
+ curnode = node = ntip + 1;
+ k = j = 0;
+
+ for (i = 1; i < nsk - 1; i++) {
+ ps = skeleton[i];
+ if (x[ps] == '(') {
+ ADD_INTERNAL_EDGE;
+ continue;
+ }
+ pr = skeleton[i - 1];
+ if (x[ps] == ',') {
+ if (x[pr] != ')') {
+ ADD_TERMINAL_EDGE_CLADO;
+ }
+ continue;
+ }
+ if (x[ps] == ')') {
+ pt = skeleton[i + 1];
+ if (x[pr] == ',') {
+ ADD_TERMINAL_EDGE_CLADO;
+ GO_DOWN_CLADO;
+ continue;
+ }
+ if (x[pr] == '(') {
+ ADD_TERMINAL_EDGE_CLADO;
+ GO_DOWN_CLADO;
+ continue;
+ }
+ if (x[pr] == ')') {
+ GO_DOWN_CLADO;
+ }
+ }
+ }
+
+ pr = skeleton[nsk - 2];
+ ps = skeleton[nsk - 1];
+ if (x[pr] == ',' && x[ps] == ')') {
+ ADD_TERMINAL_EDGE_CLADO;
+ }
+ if (ps < n - 2) {
+ extract_portion_Newick(x, ps + 1, n - 2, lab);
+ SET_STRING_ELT(node_label, 0, mkChar(lab));
+ PROTECT(phy = allocVector(VECSXP, 3));
+ } else PROTECT(phy = allocVector(VECSXP, 3));
+
+ SET_VECTOR_ELT(phy, 0, edge);
+ SET_VECTOR_ELT(phy, 1, Nnode);
+ SET_VECTOR_ELT(phy, 2, node_label);
+
+ UNPROTECT(5);
+ return phy;
+}
+
+SEXP treeBuild(SEXP nwk)
+{
+ const char *x;
+ int n, i, ntip = 1, nnode = 0, nedge, *e, curnode, node, j, *skeleton, nsk = 0, ps, pr, pt, l, k, stack_internal[10000], curtip = 1;
+ double *el, tmpd;
+ char lab[512], tip[512];
+ SEXP edge, edge_length, Nnode, node_label, tip_label, phy;
+
+ INITIALIZE_SKELETON;
+
+ PROTECT(Nnode = allocVector(INTSXP, 1));
+ PROTECT(edge = allocVector(INTSXP, nedge*2));
+ PROTECT(edge_length = allocVector(REALSXP, nedge));
+ PROTECT(node_label = allocVector(STRSXP, nnode));
+ PROTECT(tip_label = allocVector(STRSXP, ntip));
+ INTEGER(Nnode)[0] = nnode;
+
+ e = INTEGER(edge);
+ el = REAL(edge_length);
+
+ curnode = node = ntip + 1;
+ k = j = 0;
+
+ for (i = 1; i < nsk - 1; i++) {
+ ps = skeleton[i];
+ if (x[ps] == '(') {
+ ADD_INTERNAL_EDGE;
+ continue;
+ }
+ pr = skeleton[i - 1];
+ if (x[ps] == ',') {
+ if (x[pr] != ')') {
+ ADD_TERMINAL_EDGE_TIPLABEL;
+ }
+ continue;
+ }
+ if (x[ps] == ')') {
+ pt = skeleton[i + 1];
+ if (x[pr] == ',') {
+ ADD_TERMINAL_EDGE_TIPLABEL;
+ GO_DOWN;
+ continue;
+ }
+ if (x[pr] == '(') {
+ ADD_TERMINAL_EDGE_TIPLABEL;
+ GO_DOWN;
+ continue;
+ }
+ if (x[pr] == ')') {
+ GO_DOWN;
+ }
+ }
+ }
+
+ pr = skeleton[nsk - 2];
+ ps = skeleton[nsk - 1];
+ if (x[pr] == ',' && x[ps] == ')') {
+ ADD_TERMINAL_EDGE_TIPLABEL;
+ }
+
+ if (ps < n - 2) {
+ i = ps + 1;
+ while (i < n - 2 && x[i] != ':') i++;
+ if (i < n - 2) {
+ PROTECT(phy = allocVector(VECSXP, 6));
+ SEXP root_edge;
+ decode_internal_edge(x, ps + 1, n - 2, lab, &tmpd);
+ PROTECT(root_edge = allocVector(REALSXP, 1));
+ REAL(root_edge)[0] = tmpd;
+ SET_VECTOR_ELT(phy, 5, root_edge);
+ UNPROTECT(1);
+ SET_STRING_ELT(node_label, 0, mkChar(lab));
+ } else {
+ extract_portion_Newick(x, ps + 1, n - 2, lab);
+ SET_STRING_ELT(node_label, 0, mkChar(lab));
+ PROTECT(phy = allocVector(VECSXP, 5));
+ }
+ } else PROTECT(phy = allocVector(VECSXP, 5));
+
+ SET_VECTOR_ELT(phy, 0, edge);
+ SET_VECTOR_ELT(phy, 1, edge_length);
+ SET_VECTOR_ELT(phy, 2, Nnode);
+ SET_VECTOR_ELT(phy, 3, node_label);
+ SET_VECTOR_ELT(phy, 4, tip_label);
+ UNPROTECT(7);
+ return phy;
+}
+
+SEXP cladoBuild(SEXP nwk)
+{
+ const char *x;
+ int n, i, ntip = 1, nnode = 0, nedge, *e, curnode, node, j, *skeleton, nsk = 0, ps, pr, pt, l, k, stack_internal[10000], curtip = 1;
+ char lab[512], tip[512];
+ SEXP edge, Nnode, node_label, tip_label, phy;
+
+ INITIALIZE_SKELETON;
+
+ PROTECT(Nnode = allocVector(INTSXP, 1));
+ PROTECT(edge = allocVector(INTSXP, nedge*2));
+ PROTECT(node_label = allocVector(STRSXP, nnode));
+ PROTECT(tip_label = allocVector(STRSXP, ntip));
+ INTEGER(Nnode)[0] = nnode;
+
+ e = INTEGER(edge);
+
+ curnode = node = ntip + 1;
+ k = j = 0;
+
+ for (i = 1; i < nsk - 1; i++) {
+ ps = skeleton[i];
+ if (x[ps] == '(') {
+ ADD_INTERNAL_EDGE;
+ continue;
+ }
+ pr = skeleton[i - 1];
+ if (x[ps] == ',') {
+ if (x[pr] != ')') {
+ ADD_TERMINAL_EDGE_TIPLABEL_CLADO;
+ }
+ continue;
+ }
+ if (x[ps] == ')') {
+ pt = skeleton[i + 1];
+ if (x[pr] == ',') {
+ ADD_TERMINAL_EDGE_TIPLABEL_CLADO;
+ GO_DOWN_CLADO;
+ continue;
+ }
+ if (x[pr] == '(') {
+ ADD_TERMINAL_EDGE_TIPLABEL_CLADO;
+ GO_DOWN_CLADO;
+ continue;
+ }
+ if (x[pr] == ')') {
+ GO_DOWN_CLADO;
+ }
+ }
+ }
+
+ pr = skeleton[nsk - 2];
+ ps = skeleton[nsk - 1];
+ if (x[pr] == ',' && x[ps] == ')') {
+ ADD_TERMINAL_EDGE_TIPLABEL_CLADO;
+ }
+
+ if (ps < n - 2) {
+ extract_portion_Newick(x, ps + 1, n - 2, lab);
+ SET_STRING_ELT(node_label, 0, mkChar(lab));
+ PROTECT(phy = allocVector(VECSXP, 4));
+ } else PROTECT(phy = allocVector(VECSXP, 4));
+
+ SET_VECTOR_ELT(phy, 0, edge);
+ SET_VECTOR_ELT(phy, 1, Nnode);
+ SET_VECTOR_ELT(phy, 2, node_label);
+ SET_VECTOR_ELT(phy, 3, tip_label);
+ UNPROTECT(6);
+ return phy;
+}
+
#undef ADD_INTERNAL_EDGE
#undef ADD_TERMINAL_EDGE
+#undef ADD_TERMINAL_EDGE_CLADO
+#undef ADD_TERMINAL_EDGE_TIPLABEL
+#undef ADD_TERMINAL_EDGE_TIPLABEL_CLADO
#undef GO_DOWN
+#undef GO_DOWN_CLADO
diff --git a/vignettes/MoranI.Rnw b/vignettes/MoranI.Rnw
index ae1720e..a1f4179 100644
--- a/vignettes/MoranI.Rnw
+++ b/vignettes/MoranI.Rnw
@@ -20,7 +20,7 @@
<<echo=false,quiet=true>>=
options(width=60)
-@
+@
This document clarifies the use of Moran's autocorrelation coefficient
to quantify whether the distribution of a trait among a set of species
@@ -120,7 +120,7 @@ body mass and longevity of five species of primates:
body <- c(4.09434, 3.61092, 2.37024, 2.02815, -1.46968)
longevity <- c(4.74493, 3.3322, 3.3673, 2.89037, 2.30259)
names(body) <- names(longevity) <- c("Homo", "Pongo", "Macaca", "Ateles", "Galago")
-@
+@
The tree has branch lengths scaled so that the root age is one. We
read the tree with \ape, and plot it:
@@ -132,7 +132,7 @@ trnwk[2] <- ":0.38,Galago:1.00);"
tr <- read.tree(text = trnwk)
plot(tr)
axisPhylo()
-@
+@
We choose the weights as $w_{ij}=1/d_{ij}$, where the $d$'s is the
distances measured on the tree:
@@ -150,7 +150,7 @@ We can now perform the analysis with Moran's $I$:
<<>>=
Moran.I(body, w)
-@
+@
Not surprisingly, the results are opposite to those in
\cite{Paradis2006} since, there, the distances (given by
@@ -171,13 +171,13 @@ be two if we define H$_1$ as $I > I_0$:
<<>>=
Moran.I(body, w, alt = "greater")
-@
+@
The same analysis with \code{longevity} gives:
<<>>=
Moran.I(longevity, w)
-@
+@
As for \code{body}, the results are nearly mirrored compared to
\cite{Paradis2006} where a non-significant negative phylogenetic
@@ -248,7 +248,7 @@ We first consider a single variable analysis (as in \cite{Paradis2006}):
fm1.carn <- log10SW ~ Order/SuperFamily/Family/Genus
co1 <- correlogram.formula(fm1.carn, data = carnivora)
plot(co1)
-@
+@
A legend now appears by default, but can be removed with \code{legend
= FALSE}. Most of the appearance of the graph can be customized via
@@ -266,7 +266,7 @@ correlograms can be plotted together with the appropriate plot method:
fm2.carn <- log10SW + log10FW ~ Order/SuperFamily/Family/Genus
co2 <- correlogram.formula(fm2.carn, data = carnivora)
print(plot(co2))
-@
+@
By default, lattice is used to plot the correlograms on separate
panels; using \code{lattice = FALSE} (actually the second argument,
@@ -275,7 +275,7 @@ the different correlograms:
<<fig=true>>=
plot(co2, FALSE)
-@
+@
The options are roughly the same than above, but do not have always
the same effect since lattice and base graphics do not have the same
@@ -294,14 +294,14 @@ done with a distance matrix. So I correct this below:
> gearymoran(w, data.frame(body, longevity))
\end{Sinput}
\begin{Soutput}
-class: krandtest
+class: krandtest
Monte-Carlo tests
-Call: as.krandtest(sim = matrix(res$result, ncol = nvar, byr = TRUE),
+Call: as.krandtest(sim = matrix(res$result, ncol = nvar, byr = TRUE),
obs = res$obs, alter = alter, names = test.names)
-Test number: 2
-Permutation number: 999
-Alternative hypothesis: greater
+Test number: 2
+Permutation number: 999
+Alternative hypothesis: greater
Test Obs Std.Obs Pvalue
1 body -0.06256789 2.1523342 0.001
--
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