[med-svn] [r-cran-adephylo] 09/11: New upstream version 1.1-10
Andreas Tille
tille at debian.org
Mon Oct 2 22:00:55 UTC 2017
This is an automated email from the git hooks/post-receive script.
tille pushed a commit to branch master
in repository r-cran-adephylo.
commit 8182c3142faa2dc7e7e19fefd3225fec322a1314
Author: Andreas Tille <tille at debian.org>
Date: Mon Oct 2 23:56:45 2017 +0200
New upstream version 1.1-10
---
ChangeLog | 122 ++++
DESCRIPTION | 20 +
MD5 | 83 +++
NAMESPACE | 60 ++
R/abouheif.R | 147 ++++
R/adephylo-package.R | 619 +++++++++++++++++
R/bullseye.R | 207 ++++++
R/dibas.R | 605 +++++++++++++++++
R/distances.R | 327 +++++++++
R/moran.R | 96 +++
R/orthobasis.R | 152 +++++
R/orthogram.R | 332 +++++++++
R/partition.R | 232 +++++++
R/ppca.R | 699 +++++++++++++++++++
R/proximities.R | 183 +++++
R/table.phylo4d.R | 413 ++++++++++++
R/utils.R | 288 ++++++++
R/zzz.R | 3 +
build/vignette.rds | Bin 0 -> 243 bytes
data/carni19.RData | Bin 0 -> 651 bytes
data/carni70.RData | Bin 0 -> 1868 bytes
data/lizards.RData | Bin 0 -> 883 bytes
data/maples.RData | Bin 0 -> 2030 bytes
data/mjrochet.RData | Bin 0 -> 2384 bytes
data/palm.RData | Bin 0 -> 3447 bytes
data/procella.RData | Bin 0 -> 1156 bytes
data/tithonia.RData | Bin 0 -> 913 bytes
data/ungulates.RData | Bin 0 -> 724 bytes
debian/README.test | 8 -
debian/changelog | 23 -
debian/compat | 1 -
debian/control | 27 -
debian/copyright | 32 -
debian/docs | 2 -
debian/examples | 1 -
debian/rules | 4 -
debian/source/format | 1 -
debian/tests/control | 3 -
debian/tests/run-unit-test | 19 -
debian/upstream/metadata | 12 -
debian/watch | 3 -
inst/CITATION | 13 +
inst/doc/adephylo.R | 283 ++++++++
inst/doc/adephylo.Rnw | 665 ++++++++++++++++++
inst/doc/adephylo.pdf | Bin 0 -> 231481 bytes
man/abouheif.Rd | 115 ++++
man/adephylo-package.Rd | 132 ++++
man/bullseye.Rd | 97 +++
man/carni19.Rd | 37 +
man/carni70.Rd | 55 ++
man/dibas.Rd | 149 +++++
man/distRoot.Rd | 74 ++
man/distTips.Rd | 100 +++
man/listDD.Rd | 46 ++
man/listTips.Rd | 42 ++
man/lizards.Rd | 75 +++
man/maples.Rd | 56 ++
man/miscUtils.Rd | 50 ++
man/mjrochet.Rd | 54 ++
man/moranIdx.Rd | 76 +++
man/orthobasis.Rd | 125 ++++
man/orthogram.Rd | 154 +++++
man/palm.Rd | 59 ++
man/ppca.Rd | 265 ++++++++
man/procella.Rd | 51 ++
man/proxTips.Rd | 148 ++++
man/sp.tips.Rd | 68 ++
man/table.phylo4d.Rd | 155 +++++
man/tithonia.Rd | 61 ++
man/treePart.Rd | 67 ++
man/ungulates.Rd | 58 ++
src/adesub.c | 1152 ++++++++++++++++++++++++++++++++
src/adesub.h | 45 ++
src/distPhylo.c | 368 ++++++++++
src/misc.c | 29 +
src/phylog.c | 478 +++++++++++++
src/sptips.c | 482 +++++++++++++
src/sptips.h | 17 +
vignettes/adephylo.Rnw | 665 ++++++++++++++++++
vignettes/figs/adephylo-012.pdf | Bin 0 -> 7980 bytes
vignettes/figs/adephylo-012.png | Bin 0 -> 4569 bytes
vignettes/figs/adephylo-016.pdf | Bin 0 -> 4262 bytes
vignettes/figs/adephylo-017.pdf | 293 ++++++++
vignettes/figs/adephylo-017.png | Bin 0 -> 2981 bytes
vignettes/figs/adephylo-018.pdf | Bin 0 -> 5319 bytes
vignettes/figs/adephylo-aboutest.pdf | Bin 0 -> 4697 bytes
vignettes/figs/adephylo-figFourBas.pdf | Bin 0 -> 11018 bytes
vignettes/figs/adephylo-lm1.pdf | Bin 0 -> 4918 bytes
vignettes/figs/adephylo-loadings.pdf | Bin 0 -> 5742 bytes
vignettes/figs/adephylo-orthobas1.pdf | Bin 0 -> 6514 bytes
vignettes/figs/adephylo-pca1.pdf | Bin 0 -> 4600 bytes
vignettes/figs/adephylo-pca2.pdf | Bin 0 -> 6513 bytes
vignettes/figs/adephylo-phylo4d.pdf | Bin 0 -> 6908 bytes
vignettes/figs/adephylo-phylo4d.png | Bin 0 -> 6533 bytes
vignettes/figs/adephylo-resid.pdf | Bin 0 -> 5900 bytes
vignettes/figs/adephylo-treePart.pdf | 139 ++++
vignettes/figs/adephylo-treePart.png | Bin 0 -> 1786 bytes
97 files changed, 11586 insertions(+), 136 deletions(-)
diff --git a/ChangeLog b/ChangeLog
new file mode 100644
index 0000000..18b6b48
--- /dev/null
+++ b/ChangeLog
@@ -0,0 +1,122 @@
+ CHANGES IN ADEPHYLO VERSION 1.1-7
+
+FIXES
+
+ o sp.tips now returns ordered paths between tips
+
+FRESH BLOOD
+
+ o Anders Ellern Bilgrau has joined the development team!
+
+
+
+
+ CHANGES IN ADEPHYLO VERSION 1.1-5
+
+FIXES
+
+ o the new NAMESPACE selectively imports procedures to avoid
+ conflicts between ape, phylobase, and ade4. Thes packages are no
+ longer attached when loading adephylo
+
+ o most dataset examples have been 'dontrun-ed' to save time during
+ checks of the package on CRAN
+
+
+
+
+ CHANGES IN ADEPHYLO VERSION 1.1-4
+
+
+NEW FEATURES
+
+ o added the function bullseye to plot fan-like phylogenies and
+ associated traits.
+
+ o added new methods for dibas.
+
+
+
+ CHANGES IN ADEPHYLO VERSION 1.1-3
+
+
+NEW FEATURES
+
+ o added dibas, a new (and still under development) method for
+ describing/testing phylogenetic clusters
+
+
+BUG FIXES
+
+ o replaced the use of .First.lib and library.dynam by more
+ up-to-date procedures
+
+ o replaced a call to a C procedure from ade4 to the same procedure
+ in adephylo
+
+ o replaced instances of 'printf' by 'Rprintf' in C procedures
+
+
+
+ CHANGES IN ADEPHYLO VERSION 1.1-1
+
+
+BUG FIXES
+
+ o fixed the citation to be used for adephylo.
+
+
+
+ CHANGES IN ADEPHYLO VERSION 1.1-0
+
+
+NEW FEATURES
+
+ o the phylogenetic Principal Component Analysis (pPCA, Jombart et
+ al. 2010) has been implemented in adephylo. See ?ppca for more
+ information.
+
+ o phylogenetic distances and proximities are now computed using
+ compiled C code, speeding up dramatically computations and making
+ the functions applicable to large trees (thousands of tips).
+
+ o table.phylo4d has now a color mode which allows using colors to
+ represent values of traits; this is usefull for large trees.
+
+
+
+ CHANGES IN ADEPHYLO VERSION 1.0-2
+
+
+BUG FIXES
+
+ o standardization of variables in abouheif.moran is now performed using
+ uniform weights (instead of marginal phylogenetic weights)
+
+
+
+ CHANGES IN ADEPHYLO VERSION 1.0-1
+
+
+NEW FEATURES
+
+ o first release on CRAN, first stable version
+
+ o compatible with the first stable release of the phylobase package
+
+
+
+ CHANGES IN ADEPHYLO VERSION 1.0-0
+
+
+NEW FEATURES
+
+ o first release of the package with unstable status. Compatible
+ with phylobase (in development) and ape packages; package
+ only released on R-Forge, not CRAN.
+
+ o re-implements all phylogenetic methods and datasets available in ade4
+
+ o add new features to compute phylogenetic distances/proximities,
+ pPCA, tree walks, ...
+
diff --git a/DESCRIPTION b/DESCRIPTION
new file mode 100644
index 0000000..c5204eb
--- /dev/null
+++ b/DESCRIPTION
@@ -0,0 +1,20 @@
+Package: adephylo
+Version: 1.1-10
+Date: 2016-12-12
+Title: Adephylo: Exploratory Analyses for the Phylogenetic Comparative
+ Method
+Author: Thibaut Jombart <t.jombart at imperial.ac.uk>, Stéphane Dray
+ <stephane.dray at univ-lyon1.fr>, Anders Ellern Bilgrau <abilgrau at math.aau.dk>
+Maintainer: Stéphane Dray <stephane.dray at univ-lyon1.fr>
+Depends: methods, ade4
+Imports: phylobase, ape, adegenet
+Description: Multivariate tools to analyze comparative data, i.e. a phylogeny
+ and some traits measured for each taxa.
+License: GPL (>= 2)
+LazyLoad: yes
+RoxygenNote: 5.0.1
+Encoding: UTF-8
+NeedsCompilation: yes
+Packaged: 2016-12-12 20:48:04 UTC; stephane
+Repository: CRAN
+Date/Publication: 2016-12-13 07:57:00
diff --git a/MD5 b/MD5
new file mode 100644
index 0000000..eb1079a
--- /dev/null
+++ b/MD5
@@ -0,0 +1,83 @@
+1ce151019e24615b020192f1b544b2d4 *ChangeLog
+e8e901a6ae824be03b445ae95c384ced *DESCRIPTION
+eed3f37ec2e10afa1676905f41021e81 *NAMESPACE
+82aba88b46c88682a9d85982abef6ec4 *R/abouheif.R
+3f7e8da1935350bb2a09ee9e0aa0051c *R/adephylo-package.R
+bb5257814c5d46340cc5246038355304 *R/bullseye.R
+3c1e19b14282d4c7df2de2dfe89dec39 *R/dibas.R
+04a2d77c2cd49f67b7e2458bf077a4e0 *R/distances.R
+05cbf3b73b8242f3d07f3b3d7f2443e1 *R/moran.R
+25173b10539408dafb74aa0dedcc79e8 *R/orthobasis.R
+0f23257cce05d800f740eb2fd2605f0f *R/orthogram.R
+1becda05bad78b0d191dd6c22543af43 *R/partition.R
+86d729cb5419bfcfe564b83db5e021be *R/ppca.R
+25ba8a83c333f1afb92fb4ead4632429 *R/proximities.R
+2327af739484d50738ffeb9625dda505 *R/table.phylo4d.R
+6fb95c7db9492ebd66bdb9a2a5d38071 *R/utils.R
+bd589a28ab5c5b6e56977d0a9eeec90b *R/zzz.R
+712cc87bbdfb31c38498c54e96017e92 *build/vignette.rds
+fb47d6532985c28847275ecc7fedfc0b *data/carni19.RData
+275000d0eed20069101d0d260cfcde55 *data/carni70.RData
+d31937e2535ffe6fe6c0d72d25347aa4 *data/lizards.RData
+54f190b119437306366726f1706a003d *data/maples.RData
+f9b33e218603ee0ab52f253996e22fe5 *data/mjrochet.RData
+dcf24d8a524b736c8e9bafe76ab56e06 *data/palm.RData
+09955da04f6c0d7ce2cdaa0be3fe694f *data/procella.RData
+b2504fb4f437fc17c5d95a03febe4c3e *data/tithonia.RData
+e30d7b713ffad63530009e2233314dea *data/ungulates.RData
+669fd22410226e1e9cb0d60dd1aca4e1 *inst/CITATION
+b45c5e695ca16f9e484c602522458165 *inst/doc/adephylo.R
+6976f1077318a80a7a667d84955ccabf *inst/doc/adephylo.Rnw
+42060761fe08cf73aff6957ee179e550 *inst/doc/adephylo.pdf
+38d7dd8bd1b202bf61e72db6693ce01a *man/abouheif.Rd
+2960d40b9f53bd42487e50fe5a0c8b63 *man/adephylo-package.Rd
+67e4ea08668e2be05b9d635b10eefead *man/bullseye.Rd
+0b804311c0ab399a1426164713f07085 *man/carni19.Rd
+a44a426275505e0692f58cb0017aeefe *man/carni70.Rd
+23d6bca6e77be5c3467ac547b23d83c8 *man/dibas.Rd
+d52a9eeaf5c3c78518fd5178706a3578 *man/distRoot.Rd
+7a1cc8deda2b56016ba4886ad13ae4e8 *man/distTips.Rd
+75fcbd803ea53cad63361128d5058986 *man/listDD.Rd
+16edc4529ed4601412eb3a6f36b383e7 *man/listTips.Rd
+5e1dd71839bf56b401659e33173a3ac6 *man/lizards.Rd
+6d12bb1a6bf18d170872137994b49368 *man/maples.Rd
+610935e24558b79e1b7a5a2ff7e51b24 *man/miscUtils.Rd
+1b72b49af2773fa933d997799aa63964 *man/mjrochet.Rd
+88f3908e9aacf7b6c54152217ecf9e8d *man/moranIdx.Rd
+cbd6de42c48ee05a0e955d22d90d4814 *man/orthobasis.Rd
+1c235ee1e19677cfff5762fd32295cf7 *man/orthogram.Rd
+913407ccd1c97d784490e4464a9add19 *man/palm.Rd
+f7e4d72e4491c6095c1617c592401a7f *man/ppca.Rd
+d6b93f6f129e3a575845e2c373a7f54a *man/procella.Rd
+242f6275e0b11cf8d4207fb95f784acf *man/proxTips.Rd
+f481fb2e82a8cb636f6c1a9728a1e362 *man/sp.tips.Rd
+d7e2d1821df0c24dbfddce510fcc8818 *man/table.phylo4d.Rd
+7e4082d0d76acae7bb2315854457ef77 *man/tithonia.Rd
+369ae42628e833566657ff47b76e380b *man/treePart.Rd
+2f43618e2cba0f00cf622ac30accd762 *man/ungulates.Rd
+1f6a617c93fba4457f732ac048df9aa9 *src/adesub.c
+193a84ba51685334c563db5ba4c5c322 *src/adesub.h
+d6a30425786e3569ff112f4315c63719 *src/distPhylo.c
+6c4bbbcb5992f13082f08ce84739abdd *src/misc.c
+3bcedd4e41987c777c74a500fd7f94f0 *src/phylog.c
+dd217810ba88e51b18367e6cde1c876d *src/sptips.c
+3adff053ac9e3f225e6be54236e109c3 *src/sptips.h
+6976f1077318a80a7a667d84955ccabf *vignettes/adephylo.Rnw
+762dc146a4aaafb1d8d171e8f584509f *vignettes/figs/adephylo-012.pdf
+feda0f7e2434eacdd920247eb11c259c *vignettes/figs/adephylo-012.png
+3a4a908eb6e2880b6bcfdb4c20c703d9 *vignettes/figs/adephylo-016.pdf
+50534ae017d28a88b7e48a49090e024d *vignettes/figs/adephylo-017.pdf
+730504bf836f10a58bd8912553eda10c *vignettes/figs/adephylo-017.png
+37c5e27216f70aff9d32e7e2ccedb743 *vignettes/figs/adephylo-018.pdf
+af6868f42ea27eb9b8660358781f9480 *vignettes/figs/adephylo-aboutest.pdf
+3e2d223b5611053d46b648785f74e8ae *vignettes/figs/adephylo-figFourBas.pdf
+6054855e8aee746fd337a78181fae1a6 *vignettes/figs/adephylo-lm1.pdf
+879d3ecf5d19fe7efdccd17ced463509 *vignettes/figs/adephylo-loadings.pdf
+0c1254b877265a2f87cba02efdd498c5 *vignettes/figs/adephylo-orthobas1.pdf
+1da95952c7894c61d03b2594ef47c587 *vignettes/figs/adephylo-pca1.pdf
+409a62646256bedc495a8955b0a05aec *vignettes/figs/adephylo-pca2.pdf
+f99788d92950a336e4fb6055f0213a54 *vignettes/figs/adephylo-phylo4d.pdf
+c982aaeafa2d518a939e15165846d270 *vignettes/figs/adephylo-phylo4d.png
+d46571d964e8d2851958386a72efc557 *vignettes/figs/adephylo-resid.pdf
+8da38c81c7d17b6ad1cec22d964c127f *vignettes/figs/adephylo-treePart.pdf
+f44ae56792427611f2e9d2a1f9acbdc5 *vignettes/figs/adephylo-treePart.png
diff --git a/NAMESPACE b/NAMESPACE
new file mode 100644
index 0000000..a359d77
--- /dev/null
+++ b/NAMESPACE
@@ -0,0 +1,60 @@
+# Generated by roxygen2: do not edit by hand
+
+S3method(dibas,dist)
+S3method(dibas,matrix)
+S3method(dibas,phylo)
+S3method(dibas,vector)
+S3method(plot,ppca)
+S3method(print,ppca)
+S3method(scatter,ppca)
+S3method(screeplot,ppca)
+S3method(summary,ppca)
+export(.tipToRoot)
+export(abouheif.moran)
+export(bullseye)
+export(dibas)
+export(distRoot)
+export(distTips)
+export(listDD)
+export(listTips)
+export(me.phylo)
+export(moran.idx)
+export(orthobasis.phylo)
+export(orthogram)
+export(ppca)
+export(proxTips)
+export(sp.tips)
+export(table.phylo4d)
+export(treePart)
+import(ade4)
+import(methods)
+import(phylobase)
+importFrom(adegenet,any2col)
+importFrom(adegenet,spectral)
+importFrom(adegenet,transp)
+importFrom(ape,.PlotPhyloEnv)
+importFrom(ape,plot.phylo)
+importFrom(grDevices,grey)
+importFrom(grDevices,heat.colors)
+importFrom(graphics,abline)
+importFrom(graphics,arrows)
+importFrom(graphics,axis)
+importFrom(graphics,barplot)
+importFrom(graphics,box)
+importFrom(graphics,dotchart)
+importFrom(graphics,layout)
+importFrom(graphics,par)
+importFrom(graphics,points)
+importFrom(graphics,rect)
+importFrom(graphics,segments)
+importFrom(graphics,strheight)
+importFrom(graphics,strwidth)
+importFrom(graphics,symbols)
+importFrom(graphics,text)
+importFrom(graphics,title)
+importFrom(stats,dnorm)
+importFrom(stats,median)
+importFrom(stats,rnorm)
+importFrom(stats,screeplot)
+importFrom(stats,sd)
+useDynLib(adephylo)
diff --git a/R/abouheif.R b/R/abouheif.R
new file mode 100644
index 0000000..da3830d
--- /dev/null
+++ b/R/abouheif.R
@@ -0,0 +1,147 @@
+#' Abouheif's test based on Moran's I
+#'
+#' The test of Abouheif (1999) is designed to detect phylogenetic
+#' autocorrelation in a quantitative trait. Pavoine \emph{et al.} (2008) have
+#' shown that this tests is in fact a Moran's I test using a particular
+#' phylogenetic proximity between tips (see details). The function
+#' \code{abouheif.moran} performs basically Abouheif's test for several traits
+#' at a time, but it can incorporate other phylogenetic proximities as well.\cr
+#'
+#' Note that the original Abouheif's proximity (Abouheif, 1999; Pavoine
+#' \emph{et al.} 2008) unifies Moran's I and Geary'c tests (Thioulouse \emph{et
+#' al.} 1995).\cr
+#'
+#' \code{abouheif.moran} can be used in two ways:\cr - providing a data.frame
+#' of traits (\code{x}) and a matrix of phylogenetic proximities (\code{W})\cr
+#' - providing a \linkS4class{phylo4d} object (\code{x}) and specifying the
+#' type of proximity to be used (\code{method}).
+#'
+#' \code{W} is a squared symmetric matrix whose terms are all positive or
+#' null.\cr
+#'
+#' \code{W} is firstly transformed in frequency matrix A by dividing it by the
+#' total sum of data matrix : \deqn{a_{ij} =
+#' \frac{W_{ij}}{\sum_{i=1}^{n}\sum_{j=1}^{n}W_{ij}}}{a_ij = W_ij / (sum_i
+#' sum_j W_ij)} The neighbouring weights is defined by the matrix \eqn{D =
+#' diag(d_1,d_2, \ldots)} where \eqn{d_i = \sum_{j=1}^{n}W_{ij}}{d_i = sum_j
+#' W_ij}. For each vector x of the data frame x, the test is based on the Moran
+#' statistic \eqn{x^{t}Ax}{t(x)Ax} where x is D-centred.
+#'
+#' @param x a data frame with continuous variables, or a \linkS4class{phylo4d}
+#' object (i.e. containing both a tree, and tip data). In the latter case,
+#' \code{method} argument is used to determine which proximity should be used.
+#' @param W a \emph{n} by \emph{n} matrix (\emph{n} being the number rows in x)
+#' of phylogenetic proximities, as produced by \code{\link{proxTips}}.
+#' @param method a character string (full or unambiguously abbreviated)
+#' specifying the type of proximity to be used. By default, the proximity used
+#' is that of the original Abouheif's test. See details in
+#' \code{\link{proxTips}} for information about other methods.
+#' @param f a function to turn a distance into a proximity (see
+#' \code{\link{proxTips}}).
+#' @param nrepet number of random permutations of data for the randomization
+#' test
+#' @param alter a character string specifying the alternative hypothesis, must
+#' be one of "greater" (default), "less" or "two-sided"
+#' @return Returns an object of class \code{krandtest} (randomization tests
+#' from ade4), containing one Monte Carlo test for each trait.
+#' @author Original code from ade4 (gearymoran function) by Sebastien Ollier\cr
+#' Adapted and maintained by Thibaut Jombart <tjombart@@imperial.ac.uk>.
+#' @seealso - \code{\link[ade4]{gearymoran}} from the ade4 package\cr -
+#' \code{\link[ape]{Moran.I}} from the ape package for the classical Moran's I
+#' test. \cr
+#' @references
+#'
+#' Thioulouse, J., Chessel, D. and Champely, S. (1995) Multivariate analysis of
+#' spatial patterns: a unified approach to local and global structures.
+#' \emph{Environmental and Ecological Statistics}, \bold{2}, 1--14.
+#' @examples
+#'
+#'
+#' if(require(ade4)&& require(ape) && require(phylobase)){
+#' ## load data
+#' data(ungulates)
+#' tre <- read.tree(text=ungulates$tre)
+#' x <- phylo4d(tre, ungulates$tab)
+#'
+#' ## Abouheif's tests for each trait
+#' myTests <- abouheif.moran(x)
+#' myTests
+#' plot(myTests)
+#'
+#' ## a variant using another proximity
+#' plot(abouheif.moran(x, method="nNodes") )
+#'
+#' ## Another example
+#'
+#' data(maples)
+#' tre <- read.tree(text=maples$tre)
+#' dom <- maples$tab$Dom
+#'
+#' ## Abouheif's tests for each trait (equivalent to Cmean)
+#' W1 <- proxTips(tre,method="oriAbouheif")
+#' abouheif.moran(dom,W1)
+#'
+#' ## Equivalence with moran.idx
+#'
+#' W2 <- proxTips(tre,method="Abouheif")
+#' abouheif.moran(dom,W2)
+#' moran.idx(dom,W2)
+#' }
+#'
+#' @rdname abouheif
+#' @import phylobase
+#' @import ade4
+#' @export abouheif.moran
+abouheif.moran <- function (x, W=NULL,
+ method=c("oriAbouheif","patristic","nNodes","Abouheif","sumDD"),
+ f=function(x){1/x}, nrepet=999,alter=c("greater", "less", "two-sided")) {
+
+ ## some checks
+ ## if(!require(ade4)) stop("The ade4 package is not installed.")
+ alter <- match.arg(alter)
+ method <- match.arg(method)
+
+ ## handle W
+ if(!is.null(W)){ # W is provided
+ if (any(W<0)) stop ("negative terms found in 'W'")
+ if (nrow(W) != ncol(W)) stop ("'W' is not squared")
+ W <- as.matrix(W)
+ } else { # otherwise computed W from x, a phylo4d object
+ if(!inherits(x, "phylo4d")) stop("if W is not provided, x has to be a phylo4d object")
+ if (is.character(chk <- checkPhylo4(x))) stop("bad phylo4d object: ",chk)
+ ##if (is.character(chk <- checkData(x))) stop("bad phylo4d object: ",chk) no longer needed
+ W <- proxTips(x, method=method, f=f, normalize="row", symmetric=TRUE)
+ }
+
+ nobs <- ncol(W)
+ ## W has to be symmetric
+ W <- (W + t(W))/2
+
+ ## take data from x if it is a phylo4d
+ if(inherits(x, "phylo4d")){
+ if (is.character(chk <- checkPhylo4(x))) stop("bad phylo4d object: ",chk)
+ ## if (is.character(chk <- checkData(x))) stop("bad phylo4d object: ",chk) : no longer needed
+ x <- tdata(x, type="tip")
+ }
+
+ ## main computations
+ x <- data.frame(x)
+ test.names <- names(x)
+ x <- data.matrix(x) # convert all variables to numeric type
+
+ if (nrow(x) != nobs) stop ("non convenient dimension")
+ nvar <- ncol(x)
+ res <- .C("gearymoran",
+ param = as.integer(c(nobs,nvar,nrepet)),
+ data = as.double(x),
+ W = as.double(W),
+ obs = double(nvar),
+ result = double (nrepet*nvar),
+ obstot = double(1),
+ restot = double (nrepet),
+ PACKAGE="adephylo"
+ )
+ res <- as.krandtest(obs=res$obs,sim=matrix(res$result,ncol=nvar, byrow=TRUE),
+ names=test.names,alter=alter)
+ return(res)
+} # end abouheif.moran
diff --git a/R/adephylo-package.R b/R/adephylo-package.R
new file mode 100644
index 0000000..14e3a09
--- /dev/null
+++ b/R/adephylo-package.R
@@ -0,0 +1,619 @@
+
+
+#' The adephylo package
+#'
+#' This package is devoted to exploratory analysis of phylogenetic comparative
+#' data. It re-implements and extends phylogenetic procedures from the
+#' \code{ade4} package (which are now deprecated).\cr
+#'
+#' Comparative data (phylogeny+traits) are handled as \linkS4class{phylo4d}
+#' objects, a canonical class implemented by the \code{phylobase} package.
+#' Trees are handled as \code{\link[ape:read.tree]{phylo}} objects (from the
+#' \code{ape} package) or as \linkS4class{phylo4} objects (\code{phylobase}'s
+#' extension of \code{phylo} objects).\cr
+#'
+#' Main functionalities of \code{adephylo} are summarized below.\cr
+#'
+#' === TOPOLOGICAL INFORMATION ===\cr Several functions allow one to retrieve
+#' topological information from a tree; such information can be used, for
+#' instance, as a basis to compute distances or proximities between tips.\cr
+#'
+#' - \code{\link{listDD}}: lists the direct descendants from each node of a
+#' tree.\cr
+#'
+#' - \code{\link{listTips}}: lists the tips descending from each node of a
+#' tree.\cr
+#'
+#' - \code{\link{.tipToRoot}}: finds the set of nodes between a tip and the
+#' root of a tree.\cr
+#'
+#' - \code{\link{sp.tips}}: finds the shortest path between tips of a tree.\cr
+#'
+#' - \code{\link{treePart}}: defines partitions of tips reflecting the topology
+#' of a tree. This function can output non-independent dummy vectors, or
+#' alternatively an orthonormal basis used by the orthogram procedure.\cr
+#'
+#' === PHYLOGENETIC PROXIMITIES/DISTANCES ===\cr Several phylogenetic
+#' proximities and distances are implemented. Auxiliary function easing the
+#' computation of other distances/proximities are also provided:\cr
+#'
+#' - \code{\link{distRoot}}: computes different distances of a set of tips to
+#' the root.\cr
+#'
+#' - \code{\link{distTips}}: computes different pairwise distances in a set of
+#' tips.\cr
+#'
+#' - \code{\link{proxTips}}: computes different proximities between a set of
+#' tips.\cr
+#'
+#' === MEASURES/TESTS OF PHYLOGENETIC AUTOCORRELATION ===\cr Several procedures
+#' allow one to measure, and/or test phylogenetic signal in biological
+#' traits:\cr
+#'
+#' - \code{\link{abouheif.moran}}: performs Abouheif's test, designed to detect
+#' phylogenetic autocorrelation in a quantitative trait. This implementation is
+#' not based on original heuristic procedure, but on the exact formulation
+#' proposed by Pavoine et al. (2008), showing that the test is in fact a
+#' Moran's index test. This implementation further extends the procedure by
+#' allowing any measure of phylogenetic proximity (5 are proposed).\cr
+#'
+#' - \code{\link{orthogram}}: performs the orthonormal decomposition of
+#' variance of a quantitative variable on an orthonormal basis as in Ollier et
+#' al. (2005). It also returns the results of five non parametric tests
+#' associated to the variance decomposition.\cr
+#'
+#' - \code{\link{moran.idx}}: computes Moran's index of autocorrelation given a
+#' variable and a matrix of proximities among observations (no test).\cr
+#'
+#' === MODELLING/INVESTIGATION OF PHYLOGENETIC SIGNAL ===\cr Rather than
+#' testing or measuring phylogenetic autocorrelation, these procedures can be
+#' used for further investigation of phylogenetic signal. Some, like
+#' \code{\link{me.phylo}}, can be used to remove phylogenetic autocorrelation.
+#' Others can be used to understand the nature of this autocorrelation (i.e.,
+#' to ascertain which traits and tips are concerned by phylogenetic
+#' non-independence).\cr
+#'
+#' - \code{\link{me.phylo}}/\code{\link{orthobasis.phylo}}: these synonymous
+#' functions compute Moran's eigenvectors (ME) associated to a tree. These
+#' vectors model different observable phylogenetic signals. They can be used as
+#' covariables to remove phylogenetic autocorrelation from data.\cr
+#'
+#' - \code{\link{orthogram}}: the orthogram mentioned above also provides a
+#' description of how biological variability is structured on a phylogeny.\cr
+#'
+#' - \code{\link{ppca}}: performs a phylogenetic Principal Component Analysis
+#' (pPCA, Jombart et al. 2010). This multivariate method investigates
+#' phylogenetic patterns in a set of quantitative traits.\cr
+#'
+#' === GRAPHICS ===\cr Some plotting functions are proposed, most of them being
+#' devoted to representing phylogeny and a quantitative information at the same
+#' time.\cr
+#'
+#' - \code{\link{table.phylo4d}}: fairly customisable way of representing
+#' traits onto the tips of a phylogeny. Several traits can be plotted in a
+#' single graphic.\cr
+#'
+#' - \code{\link{bullseye}}: an alternative to \code{\link{table.phylo4d}}
+#' based on fan-like representation, better for large trees.\cr
+#'
+#' - \code{\link{scatter.ppca}}, \code{\link{screeplot.ppca}},
+#' \code{\link{plot.ppca}}: several plots associated to a phylogenetic
+#' principal component analysis (see \code{\link{ppca}}).\cr
+#'
+#' === DATASETS ===\cr Several datasets are also proposed. Some of these
+#' datasets replace former version from \code{ade4}, which are now deprecated.
+#' Here is a list of available datasets: \code{\link{carni19}},
+#' \code{\link{carni70}}, \code{\link{lizards}}, \code{\link{maples}},
+#' \code{\link{mjrochet}}, \code{\link{palm}}, \code{\link{procella}},
+#' \code{\link{tithonia}}, and \code{\link{ungulates}}.\cr
+#'
+#' To cite adephylo, please use the reference given by
+#' \code{citation("adephylo")}.
+#'
+#' \tabular{ll}{ Package: \tab adephylo\cr Type: \tab Package\cr Version: \tab
+#' 1.1-7\cr Date: \tab 2014-11-10 \cr License: \tab GPL (>=2) }
+#'
+#' @name adephylo-package
+#' @aliases adephylo-package adephylo
+#' @docType package
+#' @author Thibaut Jombart <tjombart@@imperial.ac.uk>\cr with contributions
+#' Stephane Dray <stephane.dray@@univ-lyon1.fr> and Anders Ellern Bilgrau
+#' <abilgrau@@math.aau.dk>. \cr Parts of former code from \code{ade4} by Daniel
+#' Chessel and Sebastien Ollier.
+#' @seealso The \code{ade4} package for multivariate analysis.
+#' @keywords manip multivariate
+NULL
+
+
+
+
+
+#' Phylogeny and quantative trait of carnivora
+#'
+#' This data set describes the phylogeny of carnivora as reported by
+#' Diniz-Filho et al. (1998). It also gives the body mass of these 19 species.
+#'
+#'
+#' @name carni19
+#' @docType data
+#' @format \code{carni19} is a list containing the 2 following objects :
+#' \describe{ \item{tre}{is a character string giving the phylogenetic tree in
+#' Newick format.} \item{bm}{is a numeric vector which values correspond to the
+#' body mass of the 19 species (log scale).} }
+#' @note This dataset replaces the former version in ade4.
+#' @source Diniz-Filho, J. A. F., de Sant'Ana, C.E.R. and Bini, L.M. (1998) An
+#' eigenvector method for estimating phylogenetic inertia. \emph{Evolution},
+#' \bold{52}, 1247--1262.
+#' @keywords datasets
+#' @examples
+#'
+#' \dontrun{
+#' if(require(ape) && require(phylobase)){
+#'
+#' data(carni19)
+#' tre <- read.tree(text=carni19$tre)
+#' x <- phylo4d(tre, data.frame(carni19$bm))
+#' table.phylo4d(x, ratio=.5, center=FALSE)
+#' }
+#' }
+#'
+NULL
+
+
+
+
+
+#' Phylogeny and quantitative traits of carnivora
+#'
+#' This data set describes the phylogeny of 70 carnivora as reported by
+#' Diniz-Filho and Torres (2002). It also gives the geographic range size and
+#' body size corresponding to these 70 species.
+#'
+#'
+#' @name carni70
+#' @docType data
+#' @format \code{carni70} is a list containing the 2 following objects:
+#' \describe{ \item{tre}{is a character string giving the phylogenetic tree in
+#' Newick format. Branch lengths are expressed as divergence times (millions
+#' of years)} \item{tab}{is a data frame with 70 species and two traits: size
+#' (body size (kg)) ; range (geographic range size (km)).} }
+#' @note This dataset replaces the former version in ade4.
+#' @source Diniz-Filho, J. A. F., and N. M. Torres. (2002) Phylogenetic
+#' comparative methods and the geographic range size-body size relationship in
+#' new world terrestrial carnivora. \emph{Evolutionary Ecology}, \bold{16},
+#' 351--367.
+#' @keywords datasets
+#' @examples
+#'
+#' \dontrun{
+#' if(require(ape) && require(phylobase)){
+#'
+#' data(carni70)
+#' rownames(carni70$tab) <- gsub("_", ".", rownames(carni70$tab))
+#' tre <- read.tree(text=carni70$tre)
+#' x <- phylo4d(tre, carni70$tab)
+#' table.phylo4d(x)
+#'
+#' par(mar=rep(.1,4))
+#' table.phylo4d(x,cex.lab=.5, show.n=FALSE, ratio=.5)
+#'
+#'
+#' ## transform size in log and test for a phylogenetic signal
+#' size <- log(carni70$tab)[,1]
+#' names(size) <- row.names(carni70$tab)
+#' orthogram(size, tre)
+#'
+#' ## transform range and test for a phylogenetic signal
+#' yrange <- scale(carni70$tab)[,2]
+#' names(yrange) <- row.names(carni70$tab)
+#' orthogram(yrange, tre)
+#' }
+#' }
+#'
+NULL
+
+
+
+
+
+#' Phylogeny and quantitative traits of lizards
+#'
+#' This data set describes the phylogeny of 18 lizards as reported by Bauwens
+#' and D\'iaz-Uriarte (1997). It also gives life-history traits corresponding
+#' to these 18 species.
+#'
+#' Variables of \code{lizards$traits} are the following ones : mean.L (mean
+#' length (mm)), matur.L (length at maturity (mm)), max.L (maximum length
+#' (mm)), hatch.L (hatchling length (mm)), hatch.m (hatchling mass (g)),
+#' clutch.S (Clutch size), age.mat (age at maturity (number of months of
+#' activity)), clutch.F (clutch frequency).
+#'
+#' @name lizards
+#' @docType data
+#' @format \code{lizards} is a list containing the 3 following objects :
+#' \describe{ \item{traits}{is a data frame with 18 species and 8 traits.}
+#' \item{hprA}{is a character string giving the phylogenetic tree (hypothesized
+#' phylogenetic relationships based on immunological distances) in Newick
+#' format.} \item{hprB}{is a character string giving the phylogenetic tree
+#' (hypothesized phylogenetic relationships based on morphological
+#' characteristics) in Newick format.} }
+#' @note This dataset replaces the former version in ade4.
+#' @references Bauwens, D., and D\'iaz-Uriarte, R. (1997) Covariation of
+#' life-history traits in lacertid lizards: a comparative study.
+#' \emph{American Naturalist}, \bold{149}, 91--111.
+#'
+#' See a data description at \url{http://pbil.univ-lyon1.fr/R/pdf/pps063.pdf}
+#' (in French).
+#' @keywords datasets
+#' @examples
+#'
+#' \dontrun{
+#' if(require(ape) && require(phylobase)){
+#'
+#' ## see data
+#' data(lizards)
+#' liz.tr <- read.tree(tex=lizards$hprA) # make a tree
+#' liz <- phylo4d(liz.tr, lizards$traits) # make a phylo4d object
+#' table.phylo4d(liz)
+#'
+#' ## compute and plot principal components
+#' if(require(ade4)){
+#' liz.pca1 <- dudi.pca(lizards$traits, cent=TRUE,
+#' scale=TRUE, scannf=FALSE, nf=2) # PCA of traits
+#' myPC <- phylo4d(liz.tr, liz.pca1$li) # store PC in a phylo4d object
+#' varlab <- paste("Principal \ncomponent", 1:2) # make labels for PCs
+#' table.phylo4d(myPC, ratio=.8, var.lab=varlab) # plot the PCs
+#' add.scatter.eig(liz.pca1$eig,2,1,2,posi="topleft", inset=c(0,.15))
+#' title("Phylogeny and the principal components")
+#'
+#' ## compute a pPCA ##
+#' ## remove size effect
+#' temp <- lapply(liz.pca1$tab, function(e) residuals(lm(e~-1+liz.pca1$li[,1])) )
+#' temp <- data.frame(temp)
+#' row.names(temp) <- tipLabels(liz)
+#'
+#' ## build corresponding phylo4d object
+#' liz.noSize <- phylo4d(liz.tr, temp)
+#' ppca1 <- ppca(liz.noSize, method="Abouheif", scale=FALSE, scannf=FALSE)
+#' plot(ppca1)
+#'
+#' }
+#' }
+#' }
+#'
+NULL
+
+
+
+
+
+#' Phylogeny and quantitative traits of flowers
+#'
+#' This data set describes the phylogeny of 17 flowers as reported by Ackerly
+#' and Donoghue (1998). It also gives 31 traits corresponding to these 17
+#' species.
+#'
+#'
+#' @name maples
+#' @docType data
+#' @format \code{tithonia} is a list containing the 2 following objects : -
+#' tre: a character string giving the phylogenetic tree in Newick format.\cr -
+#' tab: a data frame with 17 species and 31 traits.\cr
+#' @note This dataset replaces the former version in ade4.
+#' @references Ackerly, D. D. and Donoghue, M.J. (1998) Leaf size, sappling
+#' allometry, and Corner's rules: phylogeny and correlated evolution in Maples
+#' (Acer). \emph{American Naturalist}, \bold{152}, 767--791.
+#' @keywords datasets
+#' @examples
+#'
+#' \dontrun{
+#' if(require(ape) && require(phylobase)){
+#'
+#' data(maples)
+#'
+#' ## see the tree
+#' tre <- read.tree(text=maples$tre)
+#' plot(tre)
+#' axisPhylo()
+#'
+#' ## look at two variables
+#' dom <- maples$tab$Dom
+#' bif <- maples$tab$Bif
+#' plot(bif,dom,pch = 20)
+#' abline(lm(dom~bif)) # a strong negative correlation ?
+#' summary(lm(dom~bif))
+#' cor.test(bif,dom)
+#'
+#' ## look at the two variables onto the phylogeny
+#' temp <- phylo4d(tre, data.frame(dom,bif, row.names=tre$tip.label))
+#' table.phylo4d(temp) # correlation is strongly linked to phylogeny
+#'
+#' ## use ape's PIC (phylogenetic independent contrasts)
+#' pic.bif <- pic(bif, tre)
+#' pic.dom <- pic(dom, tre)
+#' cor.test(pic.bif, pic.dom) # correlation is no longer significant
+#' }
+#' }
+#'
+NULL
+
+
+
+
+
+
+
+
+
+
+#' Phylogeny and quantitative traits of teleos fishes
+#'
+#' This data set describes the phylogeny of 49 teleos fishes as reported by
+#' Rochet et al. (2000). It also gives life-history traits corresponding to
+#' these 49 species.
+#'
+#' Variables of \code{mjrochet$tab} are the following ones : tm (age at
+#' maturity (years)), lm (length at maturity (cm)), l05 (length at 5 per cent
+#' survival (cm)), t05 (time to 5 per cent survival (years)), fb (slope of the
+#' log-log fecundity-length relationship), fm (fecundity the year of maturity),
+#' egg (volume of eggs (\eqn{mm^{3}}{mm^3})).
+#'
+#' @name mjrochet
+#' @docType data
+#' @format \code{mjrochet} is a list containing the 2 following objects :
+#' \describe{ \item{tre}{is a character string giving the phylogenetic tree in
+#' Newick format.} \item{tab}{is a data frame with 49 rows and 7 traits.} }
+#' @note This dataset replaces the former version in ade4.
+#' @references Rochet, M. J., Cornillon, P-A., Sabatier, R. and Pontier, D.
+#' (2000) Comparative analysis of phylogenic and fishing effects in life
+#' history patterns of teleos fishes. \emph{Oikos}, \bold{91}, 255--270.
+#' @keywords datasets
+#' @examples
+#'
+#' \dontrun{
+#' if(require(ape) && require(phylobase)){
+#'
+#' data(mjrochet)
+#' tre <- read.tree(text=mjrochet$tre) # make a tree
+#' traits <- log((mjrochet$tab))
+#'
+#' ## build a phylo4d
+#' mjr <- phylo4d(tre, traits)
+#'
+#' ## see data
+#' table.phylo4d(mjr,cex.lab=.5,show.node=FALSE,symb="square")
+#'
+#' ## perform Abouheif's test for each trait
+#' mjr.tests <- abouheif.moran(mjr, nrep=499)
+#' mjr.tests
+#'
+#' }
+#' }
+#'
+NULL
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+#' Phylogenetic and quantitative traits of amazonian palm trees
+#'
+#' This data set describes the phylogeny of 66 amazonian palm trees. It also
+#' gives 7 traits corresponding to these 66 species.
+#'
+#' Variables of \code{palm$traits} are the following ones: \cr - rord: specific
+#' richness with five ordered levels\cr - h: height in meter (squared
+#' transform)\cr - dqual: diameter at breast height in centimeter with five
+#' levels \code{sout : subterranean}, \code{ d1(0, 5 cm)}, \code{ d2(5, 15
+#' cm)}, \code{ d3(15, 30 cm)} and \code{ d4(30, 100 cm)}\cr - vfruit: fruit
+#' volume in \eqn{mm^{3}}{mm^3} (logged transform)\cr - vgrain: seed volume in
+#' \eqn{mm^{3}}{mm^3} (logged transform)\cr - aire: spatial distribution area
+#' (\eqn{km^{2}}{km^2})\cr - alti: maximum altitude in meter (logged
+#' transform)\cr
+#'
+#' @name palm
+#' @docType data
+#' @format \code{palm} is a list containing the 2 following objects: \describe{
+#' \item{tre}{is a character string giving the phylogenetic tree in Newick
+#' format.} \item{traits}{is a data frame with 66 species (rows) and 7 traits
+#' (columns).} }
+#' @note This dataset replaces the former version in ade4.
+#' @source This data set was obtained by Clementine Gimaret-Carpentier.
+#' @keywords datasets
+#' @examples
+#'
+#' \dontrun{
+#' if(require(ape) && require(phylobase)){
+#'
+#' ## load data, make a tree and a phylo4d object
+#' data(palm)
+#' tre <- read.tree(text=palm$tre)
+#' rord <- as.integer(palm$traits$rord) # just use this for plotting purpose
+#' traits <- data.frame(rord, palm$traits[,-1])
+#' x <- phylo4d(tre, traits)
+#'
+#' ## plot data
+#' par(mar=rep(.1,4))
+#' table.phylo4d(x, cex.lab=.6)
+#'
+#' ## test phylogenetic autocorrelation
+#' if(require(ade4)){
+#' prox <- proxTips(x, method="sumDD")
+#' phylAutoTests <- gearymoran(prox, traits[,-3], nrep=499)
+#' plot(phylAutoTests)
+#' }
+#' }
+#' }
+#'
+NULL
+
+
+
+
+
+#' Phylogeny and quantitative traits of birds
+#'
+#' This data set describes the phylogeny of 19 birds as reported by Bried et
+#' al. (2002). It also gives 6 traits corresponding to these 19 species.
+#'
+#' Variables of \code{procella$traits} are the following ones: \cr - site.fid:
+#' a numeric vector that describes the percentage of site fidelity\cr -
+#' mate.fid: a numeric vector that describes the percentage of mate fidelity\cr
+#' - mass: an integer vector that describes the adult body weight (g)\cr - ALE:
+#' a numeric vector that describes the adult life expectancy (years)\cr - BF: a
+#' numeric vector that describes the breeding frequencies\cr - col.size: an
+#' integer vector that describes the colony size (no nests monitored)
+#'
+#' @name procella
+#' @docType data
+#' @format \code{procella} is a list containing the 2 following objects:
+#' \describe{ \item{tre}{is a character string giving the phylogenetic tree in
+#' Newick format.} \item{traits}{is a data frame with 19 species and 6 traits}
+#' }
+#' @note This dataset replaces the former version in ade4.
+#' @references Bried, J., Pontier, D. and Jouventin, P. (2002) Mate fidelity in
+#' monogamus birds: a re-examination of the Procellariiformes. \emph{Animal
+#' Behaviour}, \bold{65}, 235--246.
+#'
+#' See a data description at \url{http://pbil.univ-lyon1.fr/R/pdf/pps037.pdf}
+#' (in French).
+#' @keywords datasets
+#' @examples
+#'
+#' \dontrun{
+#' if(require(ape) && require(phylobase)){
+#'
+#' ## load data, make tree and phylo4d object
+#' data(procella)
+#' tre <- read.tree(text=procella$tre)
+#' x <- phylo4d(tre, procella$traits)
+#' par(mar=rep(.1,4))
+#' table.phylo4d(x,cex.lab=.7)
+#' }
+#' }
+#'
+NULL
+
+
+
+
+
+#' Phylogeny and quantitative traits of flowers
+#'
+#' This data set describes the phylogeny of 11 flowers as reported by Morales
+#' (2000). It also gives morphologic and demographic traits corresponding to
+#' these 11 species.
+#'
+#' Variables of \code{tithonia$tab} are the following ones : \cr morho1: is a
+#' numeric vector that describes the seed size (mm)\cr morho2: is a numeric
+#' vector that describes the flower size (mm)\cr morho3: is a numeric vector
+#' that describes the female leaf size (cm)\cr morho4: is a numeric vector that
+#' describes the head size (mm)\cr morho5: is a integer vector that describes
+#' the number of flowers per head \cr morho6: is a integer vector that
+#' describes the number of seeds per head \cr demo7: is a numeric vector that
+#' describes the seedling height (cm)\cr demo8: is a numeric vector that
+#' describes the growth rate (cm/day)\cr demo9: is a numeric vector that
+#' describes the germination time\cr demo10: is a numeric vector that describes
+#' the establishment (per cent)\cr demo11: is a numeric vector that describes
+#' the viability (per cent)\cr demo12: is a numeric vector that describes the
+#' germination (per cent)\cr demo13: is a integer vector that describes the
+#' resource allocation\cr demo14: is a numeric vector that describes the adult
+#' height (m)\cr
+#'
+#' @name tithonia
+#' @docType data
+#' @format \code{tithonia} is a list containing the 2 following objects :
+#' \describe{ \item{tre}{is a character string giving the phylogenetic tree in
+#' Newick format.} \item{tab}{is a data frame with 11 species and 14 traits (6
+#' morphologic traits and 8 demographic).} }
+#' @note This dataset replaces the former version in ade4.
+#' @source Data were obtained from Morales, E. (2000) Estimating phylogenetic
+#' inertia in Tithonia (Asteraceae) : a comparative approach. \emph{Evolution},
+#' \bold{54}, 2, 475--484.
+#' @keywords datasets
+#' @examples
+#'
+#' \dontrun{
+#' if(require(ape) && require(phylobase)){
+#'
+#' data(tithonia)
+#' tre <- read.tree(text=tithonia$tre)
+#' traits <- log(tithonia$tab + 1)
+#' rownames(traits) <- gsub("_", ".", rownames(traits))
+#'
+#' ## build a phylo4d object
+#' x <- phylo4d(tre, traits)
+#' par(mar=rep(.1,4))
+#' table.phylo4d(x)
+#'
+#' }
+#' }
+#'
+NULL
+
+
+
+
+
+#' Phylogeny and quantitative traits of ungulates.
+#'
+#' This data set describes the phylogeny of 18 ungulates as reported by
+#' Pelabon et al. (1995). It also gives 4 traits corresponding to these 18
+#' species.
+#'
+#' Variables of \code{ungulates$tab} are the following ones : \cr
+#'
+#' - afbw: is a numeric vector that describes the adult female body weight (g)
+#' \cr - mnw: is a numeric vector that describes the male neonatal weight (g)
+#' \cr - fnw: is a numeric vector that describes the female neonatal weight (g)
+#' \cr - ls: is a numeric vector that describes the litter size \cr
+#'
+#' @name ungulates
+#' @docType data
+#' @format \code{fission} is a list containing the 2 following objects :
+#' \describe{ \item{tre}{is a character string giving the phylogenetic tree in
+#' Newick format.} \item{tab}{is a data frame with 18 species and 4 traits} }
+#' @note This dataset replaces the former version in ade4.
+#' @source Data were obtained from Pelabon, C., Gaillard, J.M., Loison, A. and
+#' Portier, A. (1995) Is sex-biased maternal care limited by total maternal
+#' expenditure in polygynous ungulates? \emph{Behavioral Ecology and
+#' Sociobiology}, \bold{37}, 311--319.
+#' @keywords datasets
+#' @examples
+#'
+#' \dontrun{
+#' if(require(ape) && require(phylobase)){
+#' ## load data
+#' data(ungulates)
+#' tre <- read.tree(text=ungulates$tre)
+#' plot(tre)
+#'
+#' ## look at two traits
+#' afbw <- log(ungulates$tab[,1])
+#' neonatw <- log((ungulates$tab[,2]+ungulates$tab[,3])/2)
+#' names(afbw) <- tre$tip.label
+#' names(neonatw) <- tre$tip.label
+#' plot(afbw, neonatw) # relationship between traits
+#' lm1 <- lm(neonatw~afbw)
+#' abline(lm1)
+#' x <- phylo4d(tre, cbind.data.frame(afbw, neonatw)) # traits on the phylogeny
+#'
+#' ## test phylogenetic inertia in residuals
+#' orthogram(residuals(lm1), x)
+#' }
+#' }
+#'
+NULL
+
+
+
diff --git a/R/bullseye.R b/R/bullseye.R
new file mode 100644
index 0000000..88f5107
--- /dev/null
+++ b/R/bullseye.R
@@ -0,0 +1,207 @@
+##
+## PLOT A FAN TREE, WITH BULLSEYE LEGEND AND AXIS, AND OPTIONAL COLORS
+## FOR TIPS
+##
+## Author: Thibaut Jombart, May 2013.
+## t.jombart at imperial.ac.uk
+##
+
+############
+## bullseye
+############
+
+
+#' Fan-like phylogeny with possible representation of traits on tips
+#'
+#' This function represents a phylogeny as a fan, using circles to provide a
+#' legend for distances and optionally colored symbols to represent traits
+#' associated to the tips of the tree. This function uses and is compatible
+#' with ape's \code{\link[ape]{plot.phylo}}.
+#'
+#'
+#' @param phy a tree in \code{phylo}, \linkS4class{phylo4} or
+#' \linkS4class{phylo4d} format.
+#' @param traits an optional data.frame of traits.
+#' @param col.tips.by an optional vector used to define colors for tip labels;
+#' if unamed, must be ordered in the same order as \code{phy$tip.label}.
+#' @param col.pal a function generating colors according to a given palette;
+#' several palettes can be provided as a list, in the case of several traits;
+#' the first palette is always reserved for the tip colors; this argument is
+#' recycled.
+#' @param circ.n the number of circles for the distance annotations.
+#' @param circ.bg the color of the circles.
+#' @param circ.unit the unit of the circles; if NULL, determined automatically
+#' from the data.
+#' @param legend a logical specifying whether a legend should be plotted; only
+#' one legend is displayed, with priority to tip colors first, and then to the
+#' first trait.
+#' @param leg.posi,leg.title,leg.bg position, title and background for the
+#' legend.
+#' @param traits.inset inset for positioning the traits; 1 corresponds to the
+#' circle crossing the furthest tip, 0 to the center of the plot.
+#' @param traits.space a coefficient indicating the spacing between traits.
+#' @param traits.pch,traits.cex type and size of the symbols used for the
+#' traits; recycled if needed.
+#' @param alpha alpha value to be used for the color transparency, between 0
+#' (invisible) and 1 (plain).
+#' @param axis a logical indicating whether an axis should be displayed.
+#' @param \dots further arguments to be passed to plot methods from \code{ape}.
+#' See \code{\link[ape]{plot.phylo}}.
+#' @author Thibaut Jombart \email{tjombart@@imperial.ac.uk}
+#' @seealso \code{\link{table.phylo4d}} for non-radial plots.\cr
+#'
+#' The \linkS4class{phylo4d} class for storing \code{phylogeny+data}.\cr
+#'
+#' \code{\link[ape]{plot.phylo}} from the \code{ape} package.\cr
+#'
+#' \code{\link[ade4]{dotchart.phylog}}.
+#' @keywords hplot multivariate
+#' @examples
+#'
+#' if(require(ape) && require(phylobase) && require(adegenet)){
+#'
+#' data(lizards)
+#' tre <- read.tree(text=lizards$hprA) # make a tree
+#'
+#' ## basic plots
+#' bullseye(tre)
+#' bullseye(tre, lizards$traits)
+#'
+#' ## customized
+#' par(mar=c(6,6,6,6))
+#' bullseye(tre, lizards$traits, traits.cex=sqrt(1:7), alpha=.7,
+#' legend=FALSE, circ.unit=10, circ.bg=transp("black",.1),
+#' edge.width=2)
+#'
+#' }
+#'
+#' @importFrom adegenet spectral transp any2col
+#' @importFrom ape .PlotPhyloEnv
+#' @import phylobase
+#' @export bullseye
+bullseye <- function(phy, traits=NULL, col.tips.by=NULL, col.pal=spectral,
+ circ.n=6, circ.bg=transp("royalblue",.1), circ.unit=NULL,
+ legend=TRUE, leg.posi="bottomleft", leg.title="", leg.bg="white",
+ traits.inset=1.1, traits.space=0.05, traits.pch=19, traits.cex=1,
+ alpha=1, axis=TRUE, ...){
+ ## CHECKS ##
+ if(inherits(phy, c("phylo4","phylo4d"))) phy <- as(phy, "phylo")
+ if(!is.list(col.pal)) col.pal <- c(col.pal)
+ leg.info <- NULL
+
+ ## REORDER DATA BY TIP LABEL ##
+ ## make sure traits is a data.frame
+ if(!is.null(traits)) traits <- as.data.frame(traits)
+ if(!is.null(traits) && !is.null(row.names(traits))){
+ if(!all(phy$tip.label %in% row.names(traits))){
+ warning("tip labels and names of the traits matrix do not match")
+ } else {
+ traits <- traits[phy$tip.label,,drop=FALSE]
+ }
+ }
+
+ ## col.tips.by
+ if(!is.null(col.tips.by) && is.data.frame(col.tips.by)){
+ old.names <- row.names(col.tips.by)
+ col.tips.by <- unlist(col.tips.by)
+ names(col.tips.by) <- old.names
+ }
+ if(!is.null(col.tips.by) && !is.null(names(col.tips.by))){
+ col.tips.by <- col.tips.by[phy$tip.label]
+ }
+
+ ## recycle col.pal
+ pal.length <- 0
+ if(!is.null(traits)) pal.length <- pal.length + ncol(traits)
+ if(!is.null(col.tips.by)) pal.length <- pal.length + 1
+ col.pal <- rep(col.pal, length=pal.length)
+
+
+ ## PLOT THE PHYLOGENY
+ ## window setting
+ oxpd <- par("xpd")
+ par(xpd=TRUE)
+ on.exit(par(oxpd))
+
+ ## handle color info
+ if(!is.null(col.tips.by)){
+ tip.col.info <- any2col(col.tips.by, col.pal=col.pal[[1]])
+ plot(phy, type="fan", tip.col=transp(tip.col.info$col,alpha), ...)
+ } else{
+ plot(phy, type="fan", ...)
+ }
+
+
+ ## HANDLE THE 'BULLSEYE' ##
+ ## annot info
+ if(is.null(circ.unit)){
+ annot.max <- 0.5*diff(par("usr")[1:2])
+ annot.dist <- seq(from=0, to=annot.max, length=circ.n)
+ } else {
+ annot.dist <- seq(from=0, by=circ.unit, length=circ.n)
+ annot.max <- max(annot.dist)
+ }
+
+ ## trace the disks
+ symbols(rep(0,circ.n), rep(0,circ.n), circles=annot.dist, inches=FALSE,
+ bg=circ.bg, fg=NA, add=TRUE)
+
+ ## axis annotation
+ if(axis){
+ segments(-annot.dist[2],0,-annot.dist[3],0)
+ text(-mean(annot.dist[2:3]),-annot.dist[2]/5,
+ label=format(annot.dist[2], scientific=TRUE, digits=3),cex=.7)
+ }
+
+
+ ## PLOT TRAITS ##
+ if(!is.null(traits)){
+ ## recycle pch and cex
+ traits.pch <- rep(traits.pch, length=ncol(traits))
+ traits.cex <- rep(traits.cex, length=ncol(traits))
+
+ ## get tips coordinates
+ tips.x <- get("last_plot.phylo", envir = .PlotPhyloEnv)$xx[1:length(phy$tip.label)]
+ tips.y <- get("last_plot.phylo", envir = .PlotPhyloEnv)$yy[1:length(phy$tip.label)]
+
+ ## use furthest tip from the root to define new base coords
+ vec.length <- sqrt(tips.x^2 + tips.y^2)
+
+ x.base <- (tips.x/vec.length) * max(vec.length) * traits.inset
+ y.base <- (tips.y/vec.length) * max(vec.length) * traits.inset
+
+ ## plot traits
+ for(i in 1:ncol(traits)){
+ col.info <- any2col(traits[,i], col.pal=col.pal[[i]])
+ temp.x <- x.base * (traits.inset + i*traits.space)
+ temp.y <- y.base * (traits.inset + i*traits.space)
+ points(temp.x, temp.y, pch=traits.pch[i], col=transp(col.info$col,alpha), cex=traits.cex[i])
+
+ ## save info for legend if needed
+ if(is.null(col.tips.by) && i==1){
+ leg.info <- list(col=transp(col.info$leg.col,alpha), txt=col.info$leg.txt)
+ }
+ }
+ }
+
+
+ ## ADD LEGEND ##
+ ## legend info
+ if(!is.null(legend)){
+ ## legend for tip colors
+ if(!is.null(col.tips.by)){
+ leg.col <- transp(tip.col.info$leg.col,alpha)
+ leg.txt <- tip.col.info$leg.txt
+ leg.info <- list(col=transp(tip.col.info$leg.col,alpha), txt=tip.col.info$leg.txt)
+ }
+
+ ## plot legend
+ if(!is.null(leg.info) && legend){
+ leg.info$posi <- leg.posi
+ legend(x=leg.info$posi, legend=leg.info$txt, fill=leg.info$col, title=leg.title, bg=leg.bg)
+ return(invisible(leg.info))
+ }
+ }
+
+ return(invisible())
+} # end bullseye
diff --git a/R/dibas.R b/R/dibas.R
new file mode 100644
index 0000000..5c85fc6
--- /dev/null
+++ b/R/dibas.R
@@ -0,0 +1,605 @@
+#########
+## dibas ('distance-based group assignment')
+#########
+
+
+
+#' DIstance-Based Assignment
+#'
+#' These functions are under development. Please do not use them unless asked by
+#' the author.
+#'
+#'
+#' @aliases dibas dibas.matrix dibas.dist dibas.phylo dibas.vector simDatGroups
+#' @param x a \code{phylo} object, or a symmetric matrix of pairwise distances
+#' of class \code{matrix} or \code{dist}.
+#' @param grp a \code{factor} indicating the groups of observations.
+#' @param method a character string indicating the method to be used for
+#' estimating the distribution of pairwise distances within groups. The
+#' default method ("default") uses all observations, while the "leaveOneOut"
+#' estimates separate group distributions for each individual, leaving this
+#' one out in the estimation process.
+#' @param metric a character string matching "nNodes", "patristic", "Abouheif",
+#' or "sumDD" indicating the distance measure to be used. See
+#' \code{\link{distTips}} for more information. Note that patristic distances
+#' should be avoided in presence of one or more highly diverse group because
+#' of the 'hand fan' syndrome (see example).
+#' @param fromRoot a logical indicating if distances from the root, rather than
+#' between groups, should be used.
+#' @param n.items a vector of integers of the same length as x, stating how many
+#' times each items in 'x' should be repeated; used to take into account
+#' differences in abundances of the different items (e.g. sequences in
+#' multiple copies).
+#' @param \dots further arguments passed to other methods. Can be used to
+#' provide arguments to \code{\link{table.phylo4d}} in \code{plot} method.
+#' @author Thibaut Jombart \email{tjombart@@imperial.ac.uk}
+#' @keywords multivariate
+#' @examples
+#'
+#' \dontrun{
+#' if(require(ape)){
+#' #### SIMPLE SIMULATED DATA ####
+#' ## 50 variables, 2 groups, 30 indiv
+#' dat <- simDatGroups(k=2, p=50, n=c(15,15), mu=c(0,1))
+#' names(dat)
+#'
+#' ## make a tree
+#' tre <- nj(dist(dat$dat))
+#' plot(tre,type="unr", tip.col=c("blue","red")[as.integer(dat$grp)],
+#' main="simulated data - tree")
+#'
+#' ## use dibas method
+#' res <- dibas(tre, dat$grp, metric="nNodes")
+#' res
+#'
+#' barplot(t(res$prob), main="group membership probabilities")
+#'
+#'
+#'
+#' #### NON-PARAMETRIC TEST BASED ON MEAN SUCCESSFUL ASSIGNMENT ####
+#' ## use dibas method
+#' distHo <- replicate(100,
+#' dibas(tre, sample(dat$grp), metric="patristic")$mean.ok)
+#' pval <- mean(res$mean.ok<=c(distHo,res$mean.ok))
+#' pval
+#'
+#' hist(c(distHo,res$mean.ok), col="grey",
+#' main="Mean successful assignement - permuted values")
+#' abline(v=res$mean.ok, col="red")
+#' mtext(side=3, text="Observed value in red")
+#'
+#'
+#'
+#' #### HAND FAN SYNDROME ####
+#' ## 50 variables, 2 groups, 30 indiv
+#' dat <- simDatGroups(k=2, p=50, n=c(15,15), mu=c(0,1), sigma=c(2,4))
+#' names(dat)
+#'
+#' ## make a tree
+#' tre <- nj(dist(dat$dat))
+#' plot(tre,type="unr", tip.col=c("blue","red")[as.integer(dat$grp)],
+#' main="simulated data - tree")
+#' mtext(side=3, text="hand-fan syndrome")
+#'
+#' ## use dibas method
+#' res.patri <- dibas(tre, dat$grp, metric="patristic")
+#' res.patri$grp.tab # poor results
+#' plot(table(res.patri$groups), main="Group assignment - dibas patristic")
+#'
+#' res <- dibas(tre, dat$grp, metric="nNodes")
+#' res$grp.tab # results OK
+#' plot(table(res$groups), main="Group assignment - dibas nNodes")
+#'
+#'
+#'
+#'
+#' #### MORE COMPLEX DATASET ####
+#' if(require(adegenet)){
+#'
+#' dat <- simDatGroups(k=5, p=50, n=c(5,10,10,30,60), mu=sample(1:5, 5,
+#' replace=TRUE), sigma=sample(1:5)/2)
+#' names(dat)
+#'
+#' ## make a tree
+#' tre <- nj(dist(dat$dat))
+#' plot(tre,type="unr", tip.col=fac2col(dat$grp),main="simulated data - tree")
+#'
+#' ## use dibas method
+#' res <- dibas(tre, dat$grp, metric="Abouheif")
+#' res
+#'
+#' plot(table(res$groups), main="Group assignment - dibas Abouheif")
+#'
+#' }
+#' }
+#' }
+#'
+#'
+#'
+#'
+#'
+#'
+#'
+#' @importFrom stats dnorm sd rnorm
+#'
+#' @export dibas
+dibas <- function (x, ...) UseMethod("dibas")
+
+
+
+
+
+################
+## dibas.matrix
+################
+#' @rdname dibas
+#' @export
+dibas.matrix <- function(x, grp, method=c("default","leaveOneOut"), ...){
+ method <- match.arg(method)
+ ## DECLARE SOME VARIABLES, HANDLE ARGUMENTS ##
+ grp <- factor(grp)
+ K <- length(LEV <- levels(grp))
+ N <- nrow(x)
+
+
+ ## AUXILIARY FUNCTIONS ##
+ ## COMPUTE LOG AND AVOIDS -INF
+ logprob <- function(prob){
+ res <- log(prob)
+ res[res< -1e20] <- -1e20
+ return(res)
+ }
+
+ ## FUNCTION TO GET A VECTOR OF PAIRWISE DISTANCE WITHIN ONE GROUP
+ ## M: matrix of distances
+ ## fac: factor
+ ## val: level of the chosen group
+ getdist.within.grp <- function(M, fac, val){ # val is one level of fac
+ temp <- M[fac==val,fac==val]
+ return(temp[lower.tri(temp)])
+ }
+
+
+ ## FUNCTION TO GET LIST OF VECTORS OF PAIRWISE DISTANCES WITHIN GROUP, FOR EVERY GROUP
+ getdist.within.allgrp <- function(M, fac){
+ res <- lapply(LEV, function(e) getdist.within.grp(M, fac, e))
+ names(res) <- LEV
+ return(res)
+ }
+
+
+ ## FUNCTION TO GET THE DISTANCES OF AN INDIVIDUAL TO THE GROUPS
+ getdist.indiv <- function(i){
+ return(split(x[i,-i],grp[-i]))
+ }
+
+ ## FUNCTION TO COMPUTE MEMBERSHIP PROBA FOR ONE INDIV
+ ## i: index of an individual
+ ## distrib.param[1,]: vector of the means of with-grp distance distributions
+ ## distrib.param[2,]: vector of the sds of with-grp distance distributions
+ getproba.ind <- function(i, distrib.param){
+ temp <- getdist.indiv(i)
+ out <- sapply(1:K, function(k) mean(logprob(dnorm(temp[[k]], distrib.param[1,k],distrib.param[1,k]))))
+ return(exp(out)/sum(exp(out)))
+ }
+
+
+
+ ## CORE COMPUTATIONS ##
+ ## DEFAULT: DENSITY BASED ON ENTIRE SAMPLE ##
+ if(method=="default"){
+ ## get distance data for each group
+ temp <- getdist.within.allgrp(x, grp)
+
+ ## parameter of the group distributions
+ ## matrix of within-group dist: col=grp, row1=mean,row2=sd
+ distrib.param <- sapply(temp, function(e) return(c(mean(e,na.rm=TRUE),sd(e,na.rm=TRUE))))
+
+ ## result: row=indiv, col=groups, values=membership proba
+ prob <- t(sapply(1:N, getproba.ind, distrib.param))
+ }
+
+
+ ## LEAVEONEOUT: DENSITY EXCLUDES THE INDIV FOR WHICH PROBA IS SEEKED ##
+ if(method=="leaveOneOut"){
+ ## get within-group distance data for each individual
+ temp <- lapply(1:N, function(i) getdist.within.allgrp(x[-i,-i], grp[-i])) # grp density data for each individual
+
+ ## parameter of the group distributions
+ ## list of matrices, one per individual
+ ## matrix of within-group dist: col=grp, row1=mean,row2=sd
+ distrib.param <- lapply(1:N, function(i) sapply(temp[[i]], function(e) return(c(mean(e,na.rm=TRUE),sd(e,na.rm=TRUE)))))
+
+ ## result: row=indiv, col=groups, values=membership proba
+ prob <- t(sapply(1:N, function(i) getproba.ind(i, distrib.param[[i]])))
+ }
+
+
+ ## SHAPE MEMBERSHIP PROBABILITIES MATRIX ##
+ colnames(prob) <- LEV
+ rownames(prob) <- rownames(x)
+
+
+ ## FIND GROUP ASSIGNMENTS ##
+ temp <- factor(colnames(prob)[apply(prob,1, which.max)])
+ annot <- rep(" ", N)
+ annot[as.character(grp)!=as.character(temp)] <- "!"
+ groups <- data.frame(observed=grp, inferred=temp, annot=annot)
+ ##rownames(groups) <- rownames(prob)
+
+
+ ## BUILD / RETURN RESULT ##
+ ## get proportion of correct assignment
+ propcorrect <- mean(annot==" ")
+ propcorrect.bygroup <- tapply(annot==" ", grp, mean)
+
+ ## get summary of assignments
+ grp.tab <- table(observed=groups[,1], assigned=groups[,2])
+
+ ## get assignability
+ ## i.e. how many times better than at random is assignment?
+ ## 0 = grp very unlikely
+ ## 1 = assignment no better than at random
+ ## >1 = better than random (e.g. 2 = twice as better as at random)
+ temp <- table(grp)/N
+ probActualGrp <- sapply(1:N, function(i) prob[i, as.character(grp[i])])
+ assign.idx <- probActualGrp / as.numeric(temp[as.character(grp)])
+ assignStat <- list(assign.idx=assign.idx, mean=mean(assign.idx), grp.mean=tapply(assign.idx,grp,mean))
+
+
+ ##res <- list(prob=prob,groups=groups, mean.correct=propcorrect, prop.correct=propcorrect.bygroup)
+ res <- list(prob=prob, groups=groups, mean.ok=propcorrect, grp.tab=grp.tab, assignStat=assignStat)
+
+ return(res)
+} # end dibas.matrix
+
+
+
+
+
+
+
+
+################
+## dibas.vector
+################
+##
+## in this one, one distance to a reference point
+## is used to defined group membership probabilities
+##
+
+#' @rdname dibas
+#' @export
+dibas.vector <- function(x, grp, method=c("default","leaveOneOut"), n.items=NULL, ...){
+ method <- match.arg(method)
+
+ ## DECLARE SOME VARIABLES, HANDLE ARGUMENTS ##
+ grp <- factor(grp)
+ K <- length(LEV <- levels(grp))
+ N <- length(x)
+ if(!is.null(n.items)){
+ n.items <- round(n.items)
+ if(length(n.items)!=N) stop("n.items has a wrong length")
+ if(any(n.items<1)) stop("values in n.items cannot be less than 1")
+ x <- rep(x, n.items)
+ grp <- rep(grp, n.items)
+ }
+
+
+ ## AUXILIARY FUNCTIONS ##
+ ## COMPUTE LOG AND AVOIDS -INF
+ logprob <- function(prob){
+ res <- log(prob)
+ res[res< -1e20] <- -1e20
+ return(res)
+ }
+
+
+ ## FUNCTION TO COMPUTE MEMBERSHIP PROBA FOR ONE INDIV
+ ## i: index of an individual
+ ## distrib.mu: vector of the means of with-grp distance distributions
+ ## distrib.sigma: vector of the sds of with-grp distance distributions
+ getproba.ind <- function(i, leaveOneOut){
+ if(leaveOneOut){
+ distrib.mu <- tapply(x[-i], grp[-i], mean, na.rm=TRUE)
+ distrib.sigma <- tapply(x[-i], grp[-i], sd, na.rm=TRUE)
+ } else {
+ distrib.mu <- tapply(x, grp, mean, na.rm=TRUE)
+ distrib.sigma <- tapply(x, grp, sd, na.rm=TRUE)
+ }
+ out <- sapply(1:K, function(k) logprob(dnorm(x[i], distrib.mu[k],distrib.sigma[k])))
+ return(exp(out)/sum(exp(out)))
+ }
+
+
+
+ ## CORE COMPUTATIONS ##
+ prob <- t(sapply(1:length(x), getproba.ind, leaveOneOut=method=="leaveOneOut"))
+
+ ## SHAPE MEMBERSHIP PROBABILITIES MATRIX ##
+ colnames(prob) <- LEV
+ rownames(prob) <- rownames(x)
+
+
+ ## FIND GROUP ASSIGNMENTS ##
+ temp <- factor(colnames(prob)[apply(prob,1, which.max)])
+ annot <- rep(" ", N)
+ annot[as.character(grp)!=as.character(temp)] <- "!"
+ groups <- data.frame(observed=grp, inferred=temp, annot=annot)
+ ##rownames(groups) <- rownames(prob)
+
+
+ ## BUILD / RETURN RESULT ##
+ ## get proportion of correct assignment
+ propcorrect <- mean(annot==" ")
+ propcorrect.bygroup <- tapply(annot==" ", grp, mean)
+
+ ## get summary of assignments
+ grp.tab <- table(observed=groups[,1], assigned=groups[,2])
+
+ ## get assignability
+ ## i.e. how many times better than at random is assignment?
+ ## 0 = grp very unlikely
+ ## 1 = assignment no better than at random
+ ## >1 = better than random (e.g. 2 = twice as better as at random)
+ temp <- table(grp)/N
+ probActualGrp <- sapply(1:N, function(i) prob[i, as.character(grp[i])])
+ assign.idx <- probActualGrp / as.numeric(temp[as.character(grp)])
+ assignStat <- list(assign.idx=assign.idx, mean=mean(assign.idx), grp.mean=tapply(assign.idx,grp,mean))
+
+
+ ##res <- list(prob=prob,groups=groups, mean.correct=propcorrect, prop.correct=propcorrect.bygroup)
+ res <- list(prob=prob, groups=groups, mean.ok=propcorrect, grp.tab=grp.tab, assignStat=assignStat)
+
+ return(res)
+} # end dibas.vector
+
+
+
+
+
+
+###############
+## dibas.phylo
+###############
+#' @rdname dibas
+#' @export
+dibas.phylo <- function(x, grp, method=c("default","leaveOneOut"), fromRoot=FALSE, metric=c("Abouheif", "nNodes", "patristic", "sumDD"),
+ n.items=NULL, ...){
+ ## if(!require(ape)) stop("ape package is required")
+ if(!inherits(x,"phylo")) stop("x is not a phylo object")
+
+ metric <- match.arg(metric)
+
+ if(fromRoot){
+ res <- dibas.vector(distRoot(x, method=metric), grp=grp, method=method, n.items=n.items)
+ } else {
+ res <- dibas(distTips(x, method=metric), grp=grp, method=method)
+ }
+
+ return(res)
+} # end dibas.phylo
+
+
+
+
+
+
+##############
+## dibas.dist
+##############
+#' @rdname dibas
+#' @export
+dibas.dist <- function(x, grp, method=c("default","leaveOneOut"), ...){
+
+ res <- dibas.matrix(as.matrix(x), grp, method)
+
+ return(res)
+} # end dibas.phylo
+
+
+
+
+
+
+
+##############################
+## simulate data with groups
+##############################
+
+simDatGroups <- function(k=2, p=1000, n=10, mu=0, sigma=1){
+ ## RECYCLE ARGUMENTS ##
+ n <- rep(n, length=k)
+ mu <- rep(mu, length=k)
+ sigma <- rep(sigma, length=k)
+
+
+ ## GENERATE DATA ##
+ dat <- list()
+ for(i in 1:k){
+ dat[[i]] <- replicate(p, rnorm(n[i], mu[i], sigma[i]))
+ }
+
+ dat <- Reduce(rbind,dat)
+ rownames(dat) <- paste("ind", 1:nrow(dat))
+
+ ## SHAPE OUTPUT ##
+ grp <- factor(paste("grp", rep(1:k, n)))
+ res <- list(dat=dat, grp=grp)
+ return(res)
+} # end simDatGroups
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+########## OLD CODE, USING A DIFFERENT APPROACH ###########
+## THIS WAS USING A KERNEL APPROX OF THE DISTRIBUTION OF
+## WITHIN GROUP DISTANCES. NOT WORKING BECAUSE THERE COULD BE
+## MORE THAN ONE MODE, SO GROUPS COULD BE PRETTY SPLIT ACROSS
+## THE PHYLOGENY
+##
+## ##############
+## ## dibas
+## ##############
+## dibas <- function(x, grp, method=c("default","leaveOneOut","bootstrap"), n.dens=4096, plot=TRUE,
+## warn.lab=FALSE, dat=NULL, FUN=NULL, n.boot=10, ...){
+## if(!require(ape)) stop("ape package is required")
+## if(!inherits(x,"phylo")) stop("x is not a phylo object")
+## method <- match.arg(method)
+
+## if(method=="bootstrap" && (is.null(dat) || is.null(FUN))) stop("dat and FUN must be provided for the bootstrap procedure")
+## if(warn.lab && !is.null(dat) && !identical(x$tip.label,rownames(dat))) warning("Tip labels in x and rownames of dat differ \nplease make sure the same order is used in x, grp, and dat")
+
+## ## DECLARE SOME VARIABLES, HANDLE ARGUMENTS ##
+## grp <- factor(grp)
+## K <- length(LEV <- levels(grp))
+## N <- length(x$tip.label)
+## D <- cophenetic.phylo(x)
+## THRES <- 1e-320 # densities < THRES will be set to THRES to avoid log(x)=-Inf
+
+
+## ## RE-ORDER GRP AND DATA MATRIX AFTER TIP LABELS ##
+## if(!is.null(dat)){
+## if(is.null(rownames(dat))) rownames(dat) <- x$tip.label
+## if(!all(x$tip.label %in% rownames(dat))) stop("some tips do not have data matching their label")
+## grp <- grp[match(x$tip.label, rownames(dat))] # grp is assumed to be in the same order as 'dat'
+## dat <- dat[x$tip.label,,drop=FALSE]
+## }
+
+## #### AUXILIARY FUNCTIONS ####
+## ## FUNCTION TO ESTIMATE A DENSITY AT A SERIES OF POINTS ##
+## compute.dens <- function(dens, values){
+## pred.y <- double(n <- length(values))
+## return(.C("predict_density", dens$x, dens$y, length(dens$x), as.double(values), pred.y, n, PACKAGE="adephylo")[[5]])
+## }
+
+
+## ## FUNCTION TO GET A VECTOR OF PAIRWISE DISTANCE WITHIN ONE GROUP ##
+## getdist.within.grp <- function(M, fac, val){ # val is one level of fac
+## temp <- M[fac==val,fac==val]
+## return(temp[lower.tri(temp)])
+## }
+
+
+## ## FUNCTION TO GET A VECTOR OF PAIRWISE DISTANCES WITHIN GROUP, FOR ALL GROUPS ##
+## getdist.within.allgrp <- function(M, fac){
+## res <- lapply(LEV, function(e) getdist.within.grp(M, fac, e))
+## names(res) <- LEV
+## return(res)
+## }
+
+
+## ## FUNCTION TO GET PROBA FOR ONE INDIV / ONE GROUP ##
+## getprob.ind <- function(i, g, dens.per.grp){ # i: idx of indiv; g: idx of a group
+## temp <- 1:ncol(D)
+## dens <- compute.dens(dens.per.grp[[g]], D[i,grp==LEV[g] & temp!=i])
+## dens[dens < THRES] <- THRES
+## res <- exp(mean(log(dens)))
+## return(res)
+## }
+
+
+## ## FUNCTION TO GET PROBA FOR ALL INDIV / ONE GROUP ##
+## if(method=="leaveOneOut"){
+## getprob.grp <- function(g, dens.per.ind.grp){ # g: idx of a group; dens.per.ind.grp is a list giving grp density for each indiv
+## return(sapply(1:N, function(i) getprob.ind(i,g,dens.per.ind.grp[[i]])))
+## }
+## } else {
+## getprob.grp <- function(g, dens.per.grp){ # g: idx of a group
+## return(sapply(1:N, function(i) getprob.ind(i,g,dens.per.grp)))
+## }
+## }
+
+
+## ## FUNCTION TO GET A BOOTSTRAPPED TREE AND MATCHING GRP ##
+## getboot.tree.grp <- function(){
+## samp <- sample(1:N,replace=TRUE)
+## tre <- FUN(dat[samp,,drop=FALSE])
+## newgrp <- factor(grp[samp])
+## return(list(tre=tre, grp=newgrp))
+## }
+
+
+## #### CORE COMPUTATIONS ####
+## ## DEFAULT: DENSITY BASED ON SAMPLE ##
+## if(method=="default"){
+## dens.dat <- getdist.within.allgrp(D, grp) # density data for each group
+## list.dens <- lapply(dens.dat, density, n=n.dens, ...) # densities for each group
+## }
+
+
+## ## LEAVEONEOUT: GRP DENSITY EXCLUDES THE INDIV FOR WHICH PROBA IS SEEKED ##
+## if(method=="leaveOneOut"){
+## dens.dat <- lapply(1:N, function(i) getdist.within.allgrp(D[-i,-i], grp[-i])) # grp density data for each individual
+## list.dens <- lapply(1:N, function(i) lapply(dens.dat[[i]], density, n=n.dens, ...)) # densities for each group
+## }
+
+
+## ## BOOTSTRAP: DENSITY BASED ON BOOTSTRAPPIN INDIVIDUALS ##
+## if(method=="bootstrap"){
+## ## GET BOOTSTRAPPED TREES ##
+## list.trees.grp <- lapply(1:n.boot, function(i) getboot.tree.grp())
+
+
+## ## GET WITHIN-GROUP DISTANCES FOR EACH BOOTSTRAP SAMPLE ##
+## list.D <- lapply(list.trees.grp, function(e) cophenetic.phylo(e$tre))
+## temp <- lapply(1:n.boot, function(i) getdist.within.allgrp(list.D[[i]], list.trees.grp[[i]]$grp)) # for each replicate, list of distances within for each grp
+
+
+## ## GET DENSITIES FOR EACH GROUP ##
+## dens.dat <- lapply(LEV, function(onegroup) unlist(lapply(temp, function(e) e[[onegroup]]))) # density data for each group
+## list.dens <- lapply(dens.dat, density, n=n.dens, ...) # densities for each group
+## }
+
+
+## ## PLOT DENSITIES ##
+## if(method != "leaveOneOut" && plot){
+## find.mfrow <- function(i) {
+## nrow <- ceiling(sqrt(i))
+## ncol <- ceiling(i/ceiling(sqrt(i)))
+## return(c(nrow,ncol))
+## }
+## par(mfrow = find.mfrow(K))
+## for(i in 1:K){
+## plot(list.dens[[i]], main=paste("Group:",LEV[i]),xlab="Within-group pairwise distance",ylab="Density", col="blue")
+## points(dens.dat[[i]], rep(0,length(dens.dat[[i]])), pch="|", col="blue")
+## }
+## }
+
+
+## ## COMPUTE MEMBERSHIP PROBABILITIES ##
+## prob <- matrix(unlist(lapply(1:K, getprob.grp, list.dens)), ncol=K)
+## prob <- prop.table(prob,1)
+## colnames(prob) <- LEV
+## rownames(prob) <- x$tip.label
+
+
+## ## FIND GROUP ASSIGNMENTS ##
+## temp <- factor(colnames(prob)[apply(prob,1, which.max)])
+## annot <- rep(" ", N)
+## annot[as.character(grp)!=as.character(temp)] <- "!"
+## groups <- data.frame(observed=grp, inferred=temp, annot=annot)
+## ##rownames(groups) <- rownames(prob)
+
+
+## ## BUILD / RETURN RESULT ##
+## propcorrect <- mean(annot==" ")
+## ## propcorrect.bygroup <- tapply(annot==" ", grp, mean)
+## assignability <- mean((apply(prob,1,max)-.5)/.5)
+## ##res <- list(prob=prob,groups=groups, mean.correct=propcorrect, prop.correct=propcorrect.bygroup)
+## res <- list(prob=prob, groups=groups, assigndex=assignability, mean.correct=propcorrect)
+
+## return(res)
+## } # end dibas
diff --git a/R/distances.R b/R/distances.R
new file mode 100644
index 0000000..63ae809
--- /dev/null
+++ b/R/distances.R
@@ -0,0 +1,327 @@
+###########
+# distTips
+###########
+
+
+#' Compute some phylogenetic distance between tips
+#'
+#' The function \code{distTips} computes a given distance between a set of tips
+#' of a phylogeny. A vector of tips is supplied: distances between all possible
+#' pairs of these tips are computed. The distances are computed from the
+#' shortest path between the tips. Several distances can be used, defaulting to
+#' the sum of branch lengths (see argument \code{method}).
+#'
+#' An option (enabled by default) allows computations to be run using compiled
+#' C code, which is much faster than pure R code. In this case, a matrix of all
+#' pairwise distances is returned (i.e., \code{tips} argument is ignored).
+#'
+#' \code{Abouheif} distance refers to the phylogenetic distance underlying the
+#' test of Abouheif (see references). Let P be the set of all the nodes in the
+#' path going from \code{node1} to \code{node2}. Let DDP be the number of
+#' direct descendants from each node in P. Then, the so-called 'Abouheif'
+#' distance is the product of all terms in DDP.\cr
+#'
+#' \code{sumDD} refers to a phylogenetic distance quite similar to that of
+#' Abouheif. We consider the same sets P and DDP. But instead of computing the
+#' product of all terms in DDP, this distance computes the sum of all terms in
+#' DDP.
+#'
+#' @param x a tree of class \code{\link[ape:read.tree]{phylo}},
+#' \linkS4class{phylo4} or \linkS4class{phylo4d}.
+#' @param tips A vector of integers identifying tips by their numbers, or a
+#' vector of characters identifying tips by their names. Distances will be
+#' computed between all possible pairs of tips.
+#' @param method a character string (full or abbreviated without ambiguity)
+#' specifying the method used to compute distances ; possible values are:\cr -
+#' \code{patristic}: patristic distance, i.e. sum of branch lengths \cr -
+#' \code{nNodes}: number of nodes on the path between the nodes \cr -
+#' \code{Abouheif}: Abouheif's distance (see details) \cr - \code{sumDD}: sum
+#' of direct descendants of all nodes on the path (see details) \cr
+#' @param useC a logical indicating whether computations should be performed
+#' using compiled C code (TRUE, default), or using a pure R version (FALSE). C
+#' version is several orders of magnitude faster, and R version is kept for
+#' backward compatibility.
+#' @return An object of class \code{dist}, containing phylogenetic distances.
+#' @author Thibaut Jombart \email{tjombart@@imperial.ac.uk}
+#' @seealso \code{\link{distTips}} which computes several phylogenetic
+#' distances between tips.
+#' @references Pavoine, S.; Ollier, S.; Pontier, D. & Chessel, D. (2008)
+#' Testing for phylogenetic signal in life history variable: Abouheif's test
+#' revisited. \emph{Theoretical Population Biology}: \bold{73}, 79-91.
+#' @keywords manip
+#' @examples
+#'
+#' if(require(ape) & require(phylobase)){
+#' ## make a tree
+#' x <- as(rtree(10),"phylo4")
+#' plot(x, show.node=TRUE)
+#' axisPhylo()
+#' ## compute different distances
+#' distTips(x, 1:3)
+#' distTips(x, 1:3, "nNodes")
+#' distTips(x, 1:3, "Abouheif")
+#' distTips(x, 1:3, "sumDD")
+#'
+#' ## compare C and pure R code outputs
+#' x <- rtree(10)
+#' all.equal(as.matrix(distTips(x)), as.matrix(distTips(x, useC=FALSE)))
+#' all.equal(as.matrix(distTips(x, meth="nNode")),
+#' as.matrix(distTips(x, meth="nNode", useC=FALSE)))
+#' all.equal(as.matrix(distTips(x, meth="Abou")),
+#' as.matrix(distTips(x, meth="Abou", useC=FALSE)))
+#' all.equal(as.matrix(distTips(x, meth="sumDD")),
+#' as.matrix(distTips(x, meth="sumDD", useC=FALSE)))
+#'
+#' ## compare speed
+#' x <- rtree(50)
+#' tim1 <- system.time(distTips(x, useC=FALSE)) # old pure R version
+#' tim2 <- system.time(distTips(x)) # new version using C
+#' tim1[c(1,3)]/tim2[c(1,3)] # C is about a thousand time faster in this case
+#' }
+#'
+#' @useDynLib adephylo
+#' @import phylobase
+#' @export distTips
+distTips <- function(x, tips="all",
+ method=c("patristic","nNodes","Abouheif","sumDD"), useC=TRUE){
+
+ ## if(!require(phylobase)) stop("phylobase package is not installed")
+
+ if(useC){
+ tre <- as(x, "phylo")
+ n <- as.integer(nTips(tre))
+ resSize <- as.integer(n*(n-1)/2)
+ res <- double(resSize)
+ method <- match.arg(method)
+ method <- match(method, c("patristic","nNodes","Abouheif","sumDD"))
+ if(is.null(tre$edge.length)){
+ tre$edge.length <- as.double(rep(1, nrow(tre$edge)))
+ }
+
+ temp <- .C("distalltips", as.integer(tre$edge[,1]), as.integer(tre$edge[,2]), as.double(tre$edge.length), nrow(tre$edge), n, res, resSize, as.integer(method), PACKAGE="adephylo")
+ res <- temp[[6]]
+
+ class(res) <- "dist"
+ attr(res, "Size") <- nTips(tre)
+ attr(res, "Diag") <- FALSE
+ attr(res, "Upper") <- FALSE
+ attr(res, "method") <- paste("Phylogenetic: ",method,sep="")
+ attr(res, "call") <- match.call()
+ attr(res, "Labels") <- tre$tip.label
+ } else {
+
+ ## handle arguments
+ x <- as(x, "phylo4")
+ method <- match.arg(method)
+ N <- nTips(x)
+ if(tips[1]=="all") { tips <- 1:N }
+ tips <- getNode(x, tips)
+ tips.names <- names(tips)
+
+ ## some checks
+ if (is.character(checkval <- checkPhylo4(x))) stop(checkval)
+ if(any(is.na(tips))) stop("wrong tips specified")
+
+ ## create all couples of observations
+ findAllPairs <- function(vec){
+ res <- list(i=NULL,j=NULL)
+ k <- 0
+ for(i in 1:(length(vec)-1)){
+ for(j in (i+1):length(vec)){
+ k <- k+1
+ res[[1]][k] <- i
+ res[[2]][k] <- j
+ }
+ }
+ res <- data.frame(res)
+ return(res)
+ }
+
+ allPairs <- findAllPairs(tips) # this contains all possible pairs of tips
+
+ ## get the shortest path between all pairs of tips
+ if(method != "patristic") {
+ allPath <- sp.tips(x, allPairs$i, allPairs$j, useTipNames=TRUE, quiet=TRUE)
+ } else {
+ allPath <- sp.tips(x, allPairs$i, allPairs$j, useTipNames=TRUE, quiet=TRUE,
+ include.mrca=FALSE)
+ }
+
+ ## compute distances
+ if(method=="patristic"){
+ if(!hasEdgeLength(x)) stop("x does not have branch length")
+ ## add tip1 and tip2 to the paths, so that these edges are counted
+ allPath.names <- names(allPath)
+ allPath <- lapply(1:length(allPath), function(i)
+ c(allPath[[i]], allPairs[i,1], allPairs[i,2]) )
+ names(allPath) <- allPath.names
+
+ edge.idx <- lapply(allPath, function(e) getEdge(x, e) ) # list of indices of edges
+ allEdgeLength <- edgeLength(x)
+ res <- lapply(edge.idx, function(idx) sum(allEdgeLength[idx], na.rm=TRUE) )
+ } # end patristic
+
+ if(method=="nNodes"){
+ res <- lapply(allPath, length)
+ } # end nNodes
+
+ if(method=="Abouheif"){
+ E <- x at edge
+ f1 <- function(onePath){ # computes product of dd for one path
+ temp <- table(E[,1])[as.character(onePath)] # number of dd per node
+ return(prod(temp))
+ }
+ res <- lapply(allPath, f1)
+ } # end Abouheif
+
+ if(method=="sumDD"){
+ E <- x at edge
+ f1 <- function(onePath){ # computes sum of dd for one path
+ temp <- table(E[,1])[as.character(onePath)] # number of dd per node
+ return(sum(temp))
+ }
+ res <- lapply(allPath, f1)
+ } # end sumDD
+
+ ## convert res to a dist object
+ res <- unlist(res)
+ class(res) <- "dist"
+ attr(res, "Size") <- length(tips)
+ attr(res, "Diag") <- FALSE
+ attr(res, "Upper") <- FALSE
+ attr(res, "method") <- paste("Phylogenetic: ",method,sep="")
+ attr(res, "call") <- match.call()
+ attr(res, "Labels") <- tips.names
+ }
+ return(res)
+
+} # end distTips
+
+
+
+
+
+
+
+###########
+# distRoot
+###########
+
+
+#' Compute the distance of tips to the root
+#'
+#' The function \code{distRoot} computes the distance of a set of tips to the
+#' root. Several distances can be used, defaulting to the sum of branch
+#' lengths.
+#'
+#' \code{Abouheif} distance refers to the phylogenetic distance underlying the
+#' test of Abouheif (see references). Let P be the set of all the nodes in the
+#' path going from \code{node1} to \code{node2}. Let DDP be the number of
+#' direct descendants from each node in P. Then, the so-called 'Abouheif'
+#' distance is the product of all terms in DDP.\cr
+#'
+#' \code{sumDD} refers to a phylogenetic distance quite similar to that of
+#' Abouheif. We consider the same sets P and DDP. But instead of computing the
+#' product of all terms in DDP, this distance computes the sum of all terms in
+#' DDP.
+#'
+#' @param x a tree of class \code{\link[ape:read.tree]{phylo}},
+#' \linkS4class{phylo4} or \linkS4class{phylo4d}.
+#' @param tips A vector of integers identifying tips by their numbers, or a
+#' vector of characters identifying tips by their names.
+#' @param method a character string (full or abbreviated without ambiguity)
+#' specifying the method used to compute distances ; possible values are:\cr -
+#' \code{patristic}: patristic distance, i.e. sum of branch lengths \cr -
+#' \code{nNodes}: number of nodes on the path between the nodes \cr -
+#' \code{Abouheif}: Abouheif's distance (see details) \cr - \code{sumDD}: sum
+#' of direct descendants of all nodes on the path (see details) \cr
+#' @return A numeric vector containing one distance value for each tip.
+#' @author Thibaut Jombart \email{tjombart@@imperial.ac.uk}
+#' @seealso \code{\link{distTips}} which computes the same phylogenetic
+#' distances, but between tips.
+#' @references Pavoine, S.; Ollier, S.; Pontier, D. & Chessel, D. (2008)
+#' Testing for phylogenetic signal in life history variable: Abouheif's test
+#' revisited. \emph{Theoretical Population Biology}: \bold{73}, 79-91.
+#' @keywords manip
+#' @examples
+#'
+#' if(require(ape) & require(phylobase)){
+#' ## make a tree
+#' x <- as(rtree(50),"phylo4")
+#' ## compute 4 different distances
+#' met <- c("patristic","nNodes","Abouheif","sumDD")
+#' D <- lapply(met, function(e) distRoot(x, method=e) )
+#' names(D) <- met
+#' D <- as.data.frame(D)
+#'
+#' ## plot these distances along with the tree
+#' temp <- phylo4d(x, D)
+#' table.phylo4d(temp, show.node=FALSE, cex.lab=.6)
+#' }
+#'
+#' @import phylobase
+#' @export distRoot
+distRoot <- function(x, tips="all", method=c("patristic","nNodes","Abouheif","sumDD") ){
+ ## if(!require(phylobase)) stop("phylobase package is not installed")
+
+ ## handle arguments
+ x <- as(x, "phylo4")
+ method <- match.arg(method)
+ N <- nTips(x)
+ if(tips[1]=="all") { tips <- 1:N }
+ tips <- getNode(x, tips)
+ tips.names <- names(tips)
+ x <- as(x, "phylo4")
+ root <- getNode(x, N+1) # so that we have a named node
+
+ ## some checks
+ if(is.character(checkval <- checkPhylo4(x))) stop(checkval)
+ if(any(is.na(tips))) stop("wrong tips specified")
+
+
+ ## main computations
+
+ ## get path from root to tops
+ allPath <- lapply(tips, function(tip) .tipToRoot(x, tip, root, include.root = TRUE))
+
+ ## compute distances
+ if(method=="patristic"){
+ if(!hasEdgeLength(x)) stop("x does not have branch length")
+ ## add the concerned tips to the paths, so that these edges are counted
+ allPath.names <- names(allPath)
+ allPath <- lapply(1:length(allPath), function(i) c(allPath[[i]], tips[i]) )
+ names(allPath) <- allPath.names
+
+ edge.idx <- lapply(allPath, function(e) getEdge(x, e) ) # list of indices of edges
+ allEdgeLength <- edgeLength(x)
+ res <- sapply(edge.idx, function(idx) sum(allEdgeLength[idx], na.rm=TRUE) )
+ } # end patristic
+
+ if(method=="nNodes"){
+ res <- sapply(allPath, length)
+ } # end nNodes
+
+ if(method=="Abouheif"){
+ E <- x at edge
+ f1 <- function(onePath){ # computes product of dd for one path
+ temp <- table(E[,1])[as.character(onePath)] # number of dd per node
+ return(prod(temp))
+ }
+
+ res <- sapply(allPath, f1)
+ } # end Abouheif
+
+ if(method=="sumDD"){
+ E <- x at edge
+ f1 <- function(onePath){ # computes sum of dd for one path
+ temp <- table(E[,1])[as.character(onePath)] # number of dd per node
+ return(sum(temp))
+ }
+
+ res <- sapply(allPath, f1)
+ } # end sumDD
+
+
+ ## the output is a named numeric vector
+ return(res)
+} # end distRoot
diff --git a/R/moran.R b/R/moran.R
new file mode 100644
index 0000000..b22a0d6
--- /dev/null
+++ b/R/moran.R
@@ -0,0 +1,96 @@
+#' Computes Moran's index for a variable
+#'
+#' This simple function computes Moran's index of autocorrelation given a
+#' variable and a matrix of proximities among observations.
+#'
+#'
+#' @aliases moran.idx
+#' @param x a numeric vector whose autocorrelation is computed.
+#' @param prox a matrix of proximities between observations, as computed by the
+#' \code{\link{proxTips}}. Off-diagonal terms must be positive or null, while
+#' diagonal terms must all equal zero.
+#' @param addInfo a logical indicating whether supplementary info (null value,
+#' minimum and maximum values) should be returned (TRUE) or not (FALSE,
+#' default); if computed, these quantities are returned as attributes.
+#' @return The numeric value of Moran's index.
+#' @author Thibaut Jombart \email{tjombart@@imperial.ac.uk}
+#' @seealso \code{\link{proxTips}} which computes phylogenetic proximities
+#' between tips of a phylogeny.
+#' @references Moran, P.A.P. (1948) The interpretation of statistical maps.
+#' \emph{Journal of the Royal Statistical Society, B} \bold{10}, 243--251.
+#'
+#' Moran, P.A.P. (1950) Notes on continuous stochastic phenomena.
+#' \emph{Biometrika}, \bold{37}, 17--23.
+#'
+#' de Jong, P. and Sprenger, C. and van Veen, F. (1984) On extreme values of
+#' Moran's I and Geary's c. \emph{Geographical Analysis}, \bold{16}, 17--24.
+#' @keywords manip
+#' @examples
+#'
+#' \dontrun{
+#' ## use maples dataset
+#' data(maples)
+#' tre <- read.tree(text=maples$tre)
+#' dom <- maples$tab$Dom
+#' bif <- maples$tab$Bif
+#'
+#'
+#' ## get a proximity matrix between tips
+#' W <- proxTips(tre, met="Abouheif")
+#'
+#' ## compute Moran's I for two traits (dom and bif)
+#' moran.idx(dom, W)
+#' moran.idx(bif, W)
+#' moran.idx(rnorm(nTips(tre)), W)
+#'
+#' ## build a simple permutation test for 'bif'
+#' sim <- replicate(499, moran.idx(sample(bif), W)) # permutations
+#' sim <- c(moran.idx(bif, W), sim)
+#'
+#' pval <- mean(sim>=sim[1]) # right-tail p-value
+#' pval
+#'
+#' hist(sim, col="grey", main="Moran's I Monte Carlo test for 'bif'") # plot
+#' mtext("Histogram of permutations and observation (in red)")
+#' abline(v=sim[1], col="red", lwd=3)
+#'
+#' }
+#' @rdname moranIdx
+#' @export
+moran.idx <- function(x, prox, addInfo=FALSE){
+
+ ## handle arguments
+ if(any(is.na(x))) stop("NA entries in x")
+ if(!is.numeric(x)) stop("x is not numeric")
+
+ W <- as.matrix(prox)
+ if(!is.matrix(W)) stop("prox is not a matrix")
+ if(ncol(W) != nrow(W)) stop("prox is not a square matrix")
+ if(any(is.na(W))) stop("NA entries in prox")
+ diag(W) <- 0
+
+ n <- nrow(W)
+
+
+ ## main computations
+ x <- x - mean(x)
+ sumW <- sum(W)
+ num <- n * sum(x * (W %*% x) )
+ denom <- sumW * sum(x*x)
+
+ if(denom < 1e-14) stop("denominator equals zero")
+
+ res <- num/denom
+
+ if(addInfo){
+ I0 <- -1/(n-1)
+ matToDiag <- .5 * (t(W) + W)
+ rangeI <- range(eigen(matToDiag)$values)
+ attr(res, "I0") <- I0
+ attr(res, "Imin") <- rangeI[1]
+ attr(res, "Imax") <- rangeI[2]
+ }
+
+ return(res)
+
+} # end moran.idx
diff --git a/R/orthobasis.R b/R/orthobasis.R
new file mode 100644
index 0000000..b7a2f3d
--- /dev/null
+++ b/R/orthobasis.R
@@ -0,0 +1,152 @@
+#' Computes Moran's eigenvectors from a tree or a phylogenetic proximity matrix
+#'
+#' The function \code{orthobasis.phylo} (also nicknamed \code{me.phylo})
+#' computes Moran's eigenvectors (ME) associated to a tree. If the tree has 'n'
+#' tips, (n-1) vectors will be produced. These vectors form an orthonormal
+#' basis: they are centred to mean zero, have unit variance, and are
+#' uncorrelated. Each vector models a different pattern of phylogenetic
+#' autocorrelation. The first vectors are those with maximum positive
+#' autocorrelation, while the last vectors are those with maximum negative
+#' autocorrelation. ME can be used, for instance, as regressors to remove
+#' phylogenetic autocorrelation from data (see references).\cr
+#'
+#' ME can be obtained from a tree, specifying the phylogenetic proximity to be
+#' used. Alternatively, they can be obtained directly from a matrix of
+#' phylogenetic proximities as constructed by \code{\link{proxTips}}.
+#'
+#'
+#' @aliases orthobasis.phylo me.phylo
+#' @param x A tree of class \code{\link[ape:read.tree]{phylo}},
+#' \linkS4class{phylo4} or \linkS4class{phylo4d}.
+#' @param prox a matrix of phylogenetic proximities as returned by
+#' \code{\link{proxTips}}.
+#' @param method a character string (full or abbreviated without ambiguity)
+#' specifying the method used to compute proximities; possible values are:\cr -
+#' \code{patristic}: (inversed sum of) branch lengths \cr - \code{nNodes}:
+#' (inversed) number of nodes on the path between the nodes \cr -
+#' \code{oriAbouheif}: original Abouheif's proximity, with diagonal (see
+#' details in \code{\link{proxTips}}) \cr - \code{Abouheif}: Abouheif's
+#' proximity (see details in \code{\link{proxTips}}) \cr - \code{sumDD}:
+#' (inversed) sum of direct descendants of all nodes on the path (see details
+#' in \code{\link{proxTips}}).
+#' @param f a function to change a distance into a proximity.
+#' @return An object of class \code{orthobasis}. This is a data.frame with
+#' Moran's eigenvectors in column, with special attributes:\cr -
+#' attr(...,"values"): Moran's index for each vector - attr(...,"weights"):
+#' weights of tips; current implementation uses only uniform weights
+#' @author Thibaut Jombart \email{tjombart@@imperial.ac.uk}
+#' @seealso - \code{\link{proxTips}} which computes phylogenetic proximities
+#' between tips.\cr
+#'
+#' - \code{\link{treePart}} which can compute an orthobasis based on the
+#' topology of a phylogeny.\cr
+#' @references Peres-Neto, P. (2006) A unified strategy for estimating and
+#' controlling spatial, temporal and phylogenetic autocorrelation in ecological
+#' models \emph{Oecologica Brasiliensis} \bold{10}: 105-119.\cr
+#'
+#' Dray, S.; Legendre, P. \& Peres-Neto, P. (2006) Spatial modelling: a
+#' comprehensive framework for principal coordinate analysis of neighbours
+#' matrices (PCNM) \emph{Ecological Modelling} \bold{196}: 483-493.\cr
+#'
+#' Griffith, D. \& Peres-Neto, P. (2006) Spatial modeling in ecology: the
+#' flexibility of eigenfunction spatial analyses \emph{Ecology} \bold{87}:
+#' 2603-2613.\cr
+#' @keywords manip
+#' @examples
+#'
+#' if(require(ape) && require(phylobase)){
+#'
+#' ## SIMPLE EXAMPLE ##
+#' ## make a tree
+#' x <- rtree(50)
+#'
+#' ## compute Moran's eigenvectors
+#' ME <- me.phylo(x, met="Abouheif")
+#' ME
+#'
+#' ## plot the 10 first vectors
+#' obj <- phylo4d(x, as.data.frame(ME[,1:10]))
+#' table.phylo4d(obj, cex.sym=.7, cex.lab=.7)
+#'
+#'
+#' \dontrun{
+#' ## REMOVING PHYLOGENETIC AUTOCORRELATION IN A MODEL ##
+#' ## use example in ungulates dataset
+#' data(ungulates)
+#' tre <- read.tree(text=ungulates$tre)
+#' plot(tre)
+#'
+#' ## look at two traits
+#' afbw <- log(ungulates$tab[,1])
+#' neonatw <- log((ungulates$tab[,2]+ungulates$tab[,3])/2)
+#' names(afbw) <- tre$tip.label
+#' names(neonatw) <- tre$tip.label
+#' plot(afbw, neonatw) # relationship between traits
+#' lm1 <- lm(neonatw~afbw)
+#' abline(lm1)
+#'
+#' lm1
+#' resid1 <- residuals(lm1)
+#' orthogram(resid1, tre) # residuals are autocorrelated
+#'
+#' ## compute Moran's eigenvectors (ME)
+#' myME <- me.phylo(tre, method="Abou")
+#' lm2 <- lm(neonatw ~ myME[,1] + afbw) # use for ME as covariable
+#' resid2 <- residuals(lm2)
+#' orthogram(resid2, tre) # there is no longer phylogenetic autocorrelation
+#'
+#' ## see the difference
+#' table.phylo4d(phylo4d(tre, cbind.data.frame(resid1, resid2)))
+#' }
+#' }
+#'
+#' @rdname orthobasis
+#' @import phylobase ade4
+#' @export
+orthobasis.phylo <- function(x=NULL, prox=NULL,
+ method=c("patristic","nNodes","oriAbouheif","Abouheif","sumDD"),
+ f=function(x) {1/x} ){
+ ## if(!require(phylobase)) stop("phylobase package is not installed")
+ ## if(!require(ade4)) stop("ade4 package is not installed")
+
+ ## handle arguments
+ method <- match.arg(method)
+
+ if(is.null(prox)){ # have to compute prox
+ x <- as(x, "phylo4")
+ if (is.character(checkval <- checkPhylo4(x))) stop(checkval)
+ W <- proxTips(x, tips="all", method=method, f=f, normalize="row", symmetric=TRUE)
+ } else { # prox is provided
+ W <- as.matrix(prox)
+ if(!is.matrix(W)) stop("W is not a matrix")
+ if(ncol(W) != nrow(W)) stop("W is not a square matrix")
+ diag(W) <- 0
+ W <- 0.5 * (t(W) + W) # re-symmetrization
+ }
+
+ n <- nrow(W)
+
+
+ ## main computation -> call to orthobasis.mat
+ res <- orthobasis.mat(W, cnw=FALSE)
+
+ ## build output
+ row.names(res) <- rownames(W)
+ names(res) <- paste("ME", 1:ncol(res))
+ names(attr(res,"values")) <- names(res)
+ attr(res,"call") <- match.call()
+ attr(res,"class") <- c("orthobasis","data.frame")
+
+ return(res)
+} # end orthobasis.phylo
+
+
+
+
+
+###########
+# me.phylo
+###########
+
+#' @export
+me.phylo <- orthobasis.phylo
diff --git a/R/orthogram.R b/R/orthogram.R
new file mode 100644
index 0000000..012f6ef
--- /dev/null
+++ b/R/orthogram.R
@@ -0,0 +1,332 @@
+#' Orthonormal decomposition of variance
+#'
+#' This function performs the orthonormal decomposition of variance of a
+#' quantitative variable on an orthonormal basis. It also returns the results of
+#' five non parametric tests associated to the variance decomposition. It thus
+#' provides tools (graphical displays and test) for analysing phylogenetic,
+#' pattern in one quantitative trait. This implementation replace the
+#' (deprecated) version from the \code{ade4} package.\cr
+#'
+#' Several orthonormal bases can be used. By default, basis is constructed from
+#' a partition of tips according to tree topology (as returned by
+#' \code{\link{treePart}}); for this, the argument \code{tre} must be provided.
+#' Alternatively, one can provide an orthonormal basis as returned by
+#' \code{\link{orthobasis.phylo}}/\code{\link{me.phylo}} (argument
+#' \code{orthobas}), or provide a proximity matrix from which an orthobasis
+#' based on Moran's eigenvectors will be constructed (argument \code{prox}).
+#'
+#' The function computes the variance decomposition of a quantitative vector x
+#' on an orthonormal basis B. The variable is normalized given the uniform
+#' weight to eliminate problem of scales. It plots the squared correlations
+#' \eqn{R^{2}}{R^2} between x and vectors of B (variance decomposition) and the
+#' cumulated squared correlations \eqn{SR^{2}}{SR^2} (cumulative decomposition).
+#' The function also provides five non parametric tests to test the existence of
+#' autocorrelation. The tests derive from the five following statistics :
+#'
+#' - R2Max=\eqn{\max(R^{2})}{max(R^2)}. It takes high value when a high part of
+#' the variability is explained by one score.\cr -
+#' SkR2k=\eqn{\sum_{i=1}^{n-1}(iR^{2}_i)}{sum_i^(n-1) i*(R^2)_i}. It compares
+#' the part of variance explained by internal nodes to the one explained by end
+#' nodes.\cr - Dmax=\eqn{\max_{m=1,...,n-1}(\sum_{j=1}^{m}R^{2}_j -
+#' }{max_(m=1,...,n-1)(sum_(j=1)^m(R^2_j) - (m/n-1))}\eqn{
+#' \frac{m}{n-1})}{max_(m=1,...,n-1)(sum_(j=1)^m(R^2_j) - (m/n-1))}. It examines
+#' the accumulation of variance for a sequence of scores.\cr -
+#' SCE=\eqn{\sum_{m=1}^{n-1} (\sum_{j=1}^{m}R^{2}_j -
+#' }{sum_(m=1)^(n-1)(sum_(j=1)^m(R^2_j) - (m/n-1))^2}\eqn{
+#' \frac{m}{n-1})^{2}}{sum_(m=1)^(n-1)(sum_(j=1)^m(R^2_j) - (m/n-1))^2}. It
+#' examines also the accumulation of variance for a sequence of scores.\cr -
+#' ratio: depends of the parameter posinega. If posinega > 0, the statistic
+#' ratio exists and equals \eqn{\sum_{i=1}^{posinega}R^{2}_i}{sum_i (R^2)_i with
+#' i < posinega + 1}. It compares the part of variance explained by internal
+#' nodes to the one explained by end nodes when we can define how many vectors
+#' correspond to internal nodes.
+#'
+#' @param x a numeric vector corresponding to the quantitative variable
+#' @param tre a tree of class \code{\link[ape:read.tree]{phylo}},
+#' \linkS4class{phylo4} or \linkS4class{phylo4d}.
+#' @param orthobas an object of class \code{'orthobasis'}
+#' @param prox a matrix of phylogenetic proximities as returned by
+#' \code{\link{proxTips}}.
+#' @param nrepet an integer giving the number of permutations
+#' @param posinega a parameter for the ratio test. If posinega > 0, the function
+#' computes the ratio test.
+#' @param tol a tolerance threshold for orthonormality condition
+#' @param cdot a character size for points on the cumulative decomposition
+#' display
+#' @param cfont.main a character size for titles
+#' @param lwd a character size for dash lines
+#' @param nclass a single number giving the number of cells for the histogram
+#' @param high.scores a single number giving the number of vectors to return. If
+#' > 0, the function returns labels of vectors that explains the larger part
+#' of variance.
+#' @param alter a character string specifying the alternative hypothesis, must
+#' be one of "greater" (default), "less" or "two-sided"
+#' @return If (high.scores = 0), returns an object of class \code{'krandtest'}
+#' (randomization tests) corresponding to the five non parametric tests. \cr
+#' \cr If (high.scores > 0), returns a list containg : \item{w}{: an object of
+#' class \code{'krandtest'} (randomization tests)} \item{scores.order}{: a
+#' vector which terms give labels of vectors that explain the larger part of
+#' variance}
+#' @note This function replaces the former version from the ade4 package, which
+#' is deprecated. Note that if ade4 is not loaded BEFORE adephylo, then the
+#' version from ade4 will erase that of adephylo, which will still be
+#' available from adephylo::orthogram. In practice, though, this should never
+#' happen, since ade4 is loaded as a dependence by adephylo.
+#' @author Original code: Sebastien Ollier and Daniel Chessel.\cr
+#'
+#' Current maintainer: Stephane Dray <stephane.dray@@univ-lyon1.fr>
+#' @seealso \code{\link{orthobasis.phylo}}
+#' @references Ollier, S., Chessel, D. and Couteron, P. (2005) Orthonormal
+#' Transform to Decompose the Variance of a Life-History Trait across a
+#' Phylogenetic Tree. \emph{Biometrics}, \bold{62}, 471--477.
+#' @examples
+#'
+#' \dontrun{
+#' if(require(ape) && require(phylobase)){
+#'
+#' ## a phylogenetic example
+#' data(ungulates)
+#' tre <- read.tree(text=ungulates$tre)
+#' plot(tre)
+#'
+#' ## look at two traits
+#' afbw <- log(ungulates$tab[,1])
+#' neonatw <- log((ungulates$tab[,2]+ungulates$tab[,3])/2)
+#' names(afbw) <- tre$tip.label
+#' names(neonatw) <- tre$tip.label
+#' plot(afbw, neonatw) # relationship between traits
+#' lm1 <- lm(neonatw~afbw)
+#' resid <- residuals(lm1)
+#' abline(lm1)
+#'
+#' ## plot the two traits and the residuals of lm1
+#' x <- phylo4d(tre, cbind.data.frame(afbw, neonatw, residuals=resid))
+#' table.phylo4d(x) # residuals are surely not independant
+#'
+#' ## default orthogram for residuals of lm1
+#' orthogram(resid, tre)
+#'
+#' ## using another orthonormal basis (derived from Abouheif's proximity)
+#' myOrthoBasis <- orthobasis.phylo(tre, method="oriAbouheif") # Abouheif's proximities
+#' orthogram(resid, ortho=myOrthoBasis) # significant phylog. signal
+#'
+#' ## Abouheif's test
+#' W <- proxTips(tre, method="oriAbouheif") # proximity matrix
+#' abouheif.moran(resid, W)
+#' }
+#' }
+#'
+#' @import phylobase
+#' @import ade4
+#' @importFrom graphics par layout segments barplot abline title box points
+#' arrows
+#' @importFrom grDevices grey
+#' @export orthogram
+orthogram <- function (x, tre=NULL, orthobas = NULL, prox = NULL,
+ nrepet = 999, posinega = 0, tol = 1e-07, cdot = 1.5,
+ cfont.main = 1.5, lwd = 2, nclass,
+ high.scores = 0,alter=c("greater", "less", "two-sided")){
+
+ ## some checks and preliminary assignements
+ ## if(!require(ade4)) stop("The ade4 package is not installed.")
+
+ nobs <- length(x)
+ alter <- match.arg(alter)
+
+ if(is.numeric(x)&is.vector(x)){
+ type <- "numeric"
+ ## } else if(is.factor(x)){
+ ## type <- "factor"
+ ## } else if (inherits(x, "dudi")){
+ ## type <- "dudi"
+ } else {
+ ## stop("x must be a numeric vector, a factor or a dudi object")
+ stop("x must be a numeric vector")
+ }
+ ## if(type == "dudi") {
+ ## nobs <- nrow(x$tab)
+ ## } else {
+ ## nobs <- length(x)
+ ## }
+ ## if (!is.null(neig)) {
+ ## orthobas <- scores.neig(neig)
+ ## } else if (!is.null(phylog)) {
+ ## if (!inherits(phylog, "phylog")) stop ("'phylog' expected with class 'phylog'")
+ ## orthobas <- phylog$Bscores
+ ## }
+
+ ## if (is.null(orthobas)){
+ ## stop ("'orthobas','neig','phylog' all NULL")
+ ## }
+
+ ## retrieve the orthobasis from a proximity matrix
+ if(is.null(orthobas)){
+ if(is.null(prox)) { # both orthobas and prox are not given -> default orthobasis
+ ## check that tre is provided and valid
+ if(is.null(tre)) stop("tre, orthobasis or prox must be provided")
+ tre <- as(tre, "phylo4")
+ if (is.character(checkval <- checkPhylo4(tre))) stop(checkval)
+ orthobas <- treePart(tre, result="orthobasis")
+ } else { # else orthobasis from the proxi matrix.
+ orthobas <- orthobasis.phylo(prox=prox)
+ }
+ }
+
+ if (!inherits(orthobas, "data.frame")) stop ("'orthobas' is not a data.frame")
+ if (nrow(orthobas) != nobs) stop ("non convenient dimensions")
+ if (ncol(orthobas) != (nobs-1)) stop (paste("'orthobas' has",ncol(orthobas),"columns, expected:",nobs-1))
+ vecpro <- as.matrix(orthobas)
+ npro <- ncol(vecpro)
+
+ w <- t(vecpro/nobs)%*%vecpro
+ if (any(abs(diag(w)-1)>tol)) {
+
+ stop("'orthobas' is not orthonormal for uniform weighting")
+ }
+ diag(w) <- 0
+ if ( any( abs(as.numeric(w))>tol) )
+ stop("'orthobas' is not orthogonal for uniform weighting")
+ if (nrepet < 99) nrepet <- 99
+ if (posinega !=0) {
+ if (posinega >= nobs-1) stop ("Non convenient value in 'posinega'")
+ if (posinega <0) stop ("Non convenient value in 'posinega'")
+ }
+ if(type!="dudi"){
+ if (any(is.na(x)))
+ stop("missing value in 'x'")
+ }
+ if(type == "factor"){
+ dudi1 <- dudi.acm(data.frame(x), scannf = FALSE, nf = min(nobs, nlevels(x)))
+ }
+ if(type == "dudi") {
+ if (!all.equal(x$lw, rep(1/nobs, nobs)))
+ stop("not implemented for non-uniform row weights")
+ dudi1 <- redo.dudi(x, newnf = x$rank)
+ if(any(colMeans(dudi1$li)>tol))
+ stop("not implemented for non-centered analysis")
+ }
+
+ if(type == "numeric") {
+ z <- x - mean(x)
+ et <- sqrt(mean(z * z))
+ if ( et <= tol*(max(z)-min(z))) stop ("No variance")
+ z <- z/et
+ w <- .C("VarianceDecompInOrthoBasis",
+ param = as.integer(c(nobs,npro,nrepet,posinega)),
+ observed = as.double(z),
+ vecpro = as.double(vecpro),
+ phylogram = double(npro),
+ phylo95 = double(npro),
+ sig025 = double(npro),
+ sig975 = double(npro),
+ R2Max = double(nrepet+1),
+ SkR2k = double(nrepet+1),
+ Dmax = double(nrepet+1),
+ SCE = double(nrepet+1),
+ ratio = double(nrepet+1),
+ PACKAGE="adephylo"
+ )
+ } else {
+ w <- .C("MVarianceDecompInOrthoBasis",
+ param = as.integer(c(nobs,npro,nrepet,posinega)),
+ observed = as.double(as.matrix(dudi1$li)),
+ nvar = as.integer(ncol(dudi1$li)),
+ inertot = as.double(sum(dudi1$eig)),
+ vecpro = as.double(vecpro),
+ phylogram = double(npro),
+ phylo95 = double(npro),
+ sig025 = double(npro),
+ sig975 = double(npro),
+ R2Max = double(nrepet+1),
+ SkR2k = double(nrepet+1),
+ Dmax = double(nrepet+1),
+ SCE = double(nrepet+1),
+ ratio = double(nrepet+1),
+ PACKAGE="adephylo"
+ )
+ }
+ ##return(w$phylogram)
+ ## multiple graphical window (6 graphs)
+ ## 1 pgram
+ ## 2 cumulated pgram
+ ## 3-6 Randomization tests
+
+ def.par <- par(no.readonly = TRUE)
+ on.exit(par(def.par))
+ layout (matrix(c(1,1,2,2,1,1,2,2,3,4,5,6),4,3))
+ par(mar = c(0.1, 0.1, 0.1, 0.1))
+ par(usr = c(0,1,-0.05,1))
+
+
+ ylim <- max(c(w$phylogram, w$phylo95))
+ names(w$phylogram) <- as.character(1:npro)
+ phylocum <- cumsum(w$phylogram)
+ lwd0=2
+ fun <- function (y, last=FALSE) {
+ delta <- (mp[2]-mp[1])/3
+ sel <- 1:(npro - 1)
+ segments(mp[sel]-delta,y[sel],mp[sel]+delta, y[sel],lwd=lwd0)
+ if(last) segments(mp[npro]-delta,y[npro],mp[npro]+delta, y[npro],lwd=lwd0)
+ }
+ sig50 <- (1:npro)/npro
+ y0 <- phylocum - sig50
+ h.obs <- max(y0)
+ x0 <- min(which(y0 == h.obs))
+ par(mar = c(3.1, 2.5, 2.1, 2.1))
+ if(type == "numeric"){
+ z0 <- apply(vecpro, 2, function(x) sum(z * x))
+ mp <- barplot(w$phylogram, col = grey(1 - 0.3 * (sign(z0) > 0)), ylim = c(0, ylim * 1.05))
+ } else {
+ mp <- barplot(w$phylogram, ylim = c(0, ylim * 1.05))
+ }
+ scores.order <- (1:length(w$phylogram))[order(w$phylogram, decreasing=TRUE)[1:high.scores]]
+ fun(w$phylo95,TRUE)
+ abline(h = 1/npro)
+ if (posinega!=0) {
+ verti = (mp[posinega]+mp[posinega+1])/2
+ abline (v=verti, col="red",lwd=1.5)
+ }
+ title(main = "Variance decomposition",font.main=1, cex.main=cfont.main)
+ box()
+ obs0 <- rep(0, npro)
+ names(obs0) <- as.character(1:npro)
+ barplot(obs0, ylim = c(-0.05, 1.05))
+ abline(h=0,col="white")
+ if (posinega!=0) {
+ verti = (mp[posinega]+mp[posinega+1])/2
+ abline (v=verti, col="red",lwd=1.5)
+ }
+
+ title(main = "Cumulative decomposition",font.main=1, cex.main=cfont.main)
+ points(mp, phylocum, pch = 21, cex = cdot, type = "b")
+ segments(mp[1], 1/npro, mp[npro], 1, lty = 1)
+ fun(w$sig975)
+ fun(w$sig025)
+ arrows(mp[x0], sig50[x0], mp[x0], phylocum[x0], angle = 15, length = 0.15,
+ lwd = 2)
+ box()
+ if (missing(nclass)) {
+ nclass <- as.integer (nrepet/25)
+ nclass <- min(c(nclass,40))
+ }
+ plot(as.randtest (w$R2Max[-1],w$R2Max[1],call=match.call()),main = "R2Max",nclass=nclass)
+ if (posinega !=0) {
+ plot(as.randtest (w$ratio[-1],w$ratio[1],call=match.call()),main = "Ratio",nclass=nclass)
+ } else {
+ plot(as.randtest (w$SkR2k[-1],w$SkR2k[1],call=match.call()),main = "SkR2k",nclass=nclass)
+ }
+ plot(as.randtest (w$Dmax[-1],w$Dmax[1],call=match.call()),main = "DMax",nclass=nclass)
+ plot(as.randtest (w$SCE[-1],w$SCE[1],call=match.call()),main = "SCE",nclass=nclass)
+
+ w$param <- w$observed <- w$vecpro <- NULL
+ w$phylo95 <- w$sig025 <- w$sig975 <- NULL
+ if (posinega==0) {
+ w <- as.krandtest(obs=c(w$R2Max[1],w$SkR2k[1],w$Dmax[1],w$SCE[1]),sim=cbind(w$R2Max[-1],w$SkR2k[-1],w$Dmax[-1],w$SCE[-1]),names=c("R2Max","SkR2k","Dmax","SCE"),alter=alter,call=match.call())
+ } else {
+ w <- as.krandtest(obs=c(w$R2Max[1],w$SkR2k[1],w$Dmax[1],w$SCE[1],w$ratio[1]),sim=cbind(w$R2Max[-1],w$SkR2k[-1],w$Dmax[-1],w$SCE[-1],w$ratio[-1]),names=c("R2Max","SkR2k","Dmax","SCE","ratio"),alter=alter,call=match.call())
+ }
+
+ if (high.scores != 0)
+ w$scores.order <- scores.order
+ return(w)
+} # end orthogram
diff --git a/R/partition.R b/R/partition.R
new file mode 100644
index 0000000..3780b6e
--- /dev/null
+++ b/R/partition.R
@@ -0,0 +1,232 @@
+##
+## Functions to obtain partitions of tips from a tree.
+## For instance to obtain dummy vectors used in the orthogram.
+##
+
+
+
+
+
+############
+# listTips
+############
+
+
+#' List tips descendings from all nodes of a tree
+#'
+#' The function \code{listTips} lists the tips descending from each node of a
+#' tree. The tree can be of class \code{\link[ape:read.tree]{phylo}},
+#' \linkS4class{phylo4} or \linkS4class{phylo4d}.
+#'
+#'
+#' @param x A tree of class \code{\link[ape:read.tree]{phylo}},
+#' \linkS4class{phylo4} or \linkS4class{phylo4d}.
+#' @return A list whose components are vectors of named tips for a given node.
+#' @author Thibaut Jombart \email{tjombart@@imperial.ac.uk}
+#' @seealso \code{\link{listDD}} which lists the direct descendants for each
+#' node. \cr
+#'
+#' \code{\link{treePart}} which defines partitions of tips according to the
+#' tree topology.
+#' @keywords manip
+#' @examples
+#'
+#' if(require(ape) & require(phylobase)){
+#' ## make a tree
+#' x <- as(rtree(20),"phylo4")
+#' plot(x,show.node=TRUE)
+#' listTips(x)
+#' }
+#'
+#' @import phylobase
+#' @export listTips
+listTips <- function(x){
+ ## if(!require(phylobase)) stop("phylobase package is not installed")
+
+ ## conversion from phylo, phylo4 and phylo4d
+ x <- as(x, "phylo4")
+
+ ## check phylo4 object
+ if (is.character(checkval <- checkPhylo4(x))) stop(checkval)
+
+ ## computations
+ nodIdx <- nTips(x)+1
+ nodIdx <- nodIdx:(nodIdx+nNodes(x)-1)
+ res <- lapply(nodIdx, function(i) descendants(x, i))
+
+ if(hasNodeLabels(x)) {names(res) <- nodeLabels(x)}
+
+ return(res)
+} # end listTips
+
+
+
+
+
+###########
+# treePart
+###########
+
+
+#' Define partitions of tips according from a tree
+#'
+#' The function \code{treePart} defines partitions of tips reflecting the
+#' topology of a tree. There are two possible outputs (handled by the argument
+#' \code{result}):\cr - \code{basis} mode: each node but the root is translated
+#' into a dummy vector having one value for each tip: this value is '1' if the
+#' tip descends from this node, and '0' otherwise.\cr - \code{orthobasis}: in
+#' this mode, an orthonormal basis is derived from the basis previously
+#' mentionned. This orthobasis was proposed in the orthogram (Ollier \emph{et
+#' al.} 2006).
+#'
+#' Orthobasis produced by this function are identical to those stored in the
+#' \$Bscores component of deprecated \link[ade4]{phylog} objects, from the ade4
+#' package.
+#'
+#' @param x a tree of class \code{\link[ape:read.tree]{phylo}},
+#' \linkS4class{phylo4} or \linkS4class{phylo4d}.
+#' @param result a character string specifying the type of result: either a
+#' basis of dummy vectors (\code{dummy}), or an orthobasis derived from these
+#' dummy vectors (\code{orthobasis}).
+#' @return A matrix of numeric vectors (in columns) having one value for each
+#' tip (rows).
+#' @author Thibaut Jombart \email{tjombart@@imperial.ac.uk}
+#' @seealso - \code{\link{listDD}} which is called by \code{treePart}.\cr -
+#' \code{\link{orthogram}}, which uses by default the orthobasis produced by
+#' \code{treePart}.\cr
+#' @references Ollier, S., Chessel, D. and Couteron, P. (2005) Orthonormal
+#' Transform to Decompose the Variance of a Life-History Trait across a
+#' Phylogenetic Tree. \emph{Biometrics}, \bold{62}, 471--477.
+#' @keywords manip
+#' @examples
+#'
+#' \dontrun{
+#'
+#' if(require(ape) & require(phylobase)){
+#' ## make a tree
+#' x <- as(rtree(10),"phylo4")
+#' partition <- treePart(x)
+#' partition
+#'
+#' ## plot the dummy vectors with the tree
+#' temp <- phylo4d(x, partition)
+#' table.phylo4d(temp, cent=FALSE, scale=FALSE)
+#' }
+#' }
+#'
+#' @import phylobase
+#' @export treePart
+treePart <- function(x, result=c("dummy", "orthobasis")){
+ ## if(!require(phylobase)) stop("phylobase package is not installed")
+
+ ## conversion from phylo, phylo4 and phylo4d
+ x <- as(x, "phylo4")
+ result <- match.arg(result)
+
+ ## check phylo4 object
+ if (is.character(checkval <- checkPhylo4(x))) stop(checkval)
+
+ n <- nTips(x) # number of tips
+ HTU.idx <- (n+1):(n+nNodes(x)) # index of internal nodes (HTU)
+
+ if(!hasNodeLabels(x)) { # node labels will be used after
+ nodeLabels(x) <- as.character(HTU.idx)
+ }
+
+ ## function coding one dummy vector
+ fDum <- function(vec){ # vec is a vector of tip numbers
+ dum <- integer(n)
+ dum[vec] <- 1
+ return(dum)
+ }
+
+ ## main computations
+ temp <- listTips(x)
+ res <- data.frame(lapply(temp,fDum))
+ row.names(res) <- tipLabels(x)
+ res <- res[,-1, drop=FALSE]
+
+ if(result=="dummy"){
+ return(res) # res is a data.frame of dummy vectors
+ }
+
+
+
+ ## If orthobasis is required ##
+
+ ## Find values 'w' for all nodes
+ ##
+ ## Notations:
+ ## - n: an internal node (HTU)
+ ## - Dn: the set of all internal nodes descending from 'n'
+ ## - En: the set 'n U Dn' (that is, Dn plus n itself)
+ ## - ndd(e): the number of direct descendants from a node 'e'
+ ##
+ ## Then the values 'w' are computed as:
+ ##
+ ## w(n) = sum_{e \in En} lgamma( ndd(e) + 1)
+ ##
+
+ listDDx <- listDD(x)
+
+ nbOfDD <- sapply(listDDx, length) # nb of DD for each node
+ names(nbOfDD) <- HTU.idx # used to match the results of Dn
+
+ findAlldHTU <- function(node){ # find all HTU descending from a node
+ res <- descendants(x, node, type="all") # tips and HTU
+ res <- res[res > n] # only HTU (here, just node numbers are kept
+ if(length(res)==0) return(NULL)
+ return(res)
+ }
+
+
+ listAlldHTU <- lapply(HTU.idx, function(node) c(node,findAlldHTU(node))) # ='Dn': for each HTU, list all HTU descending from it
+
+ w <- sapply(listAlldHTU, function(e) sum(lgamma(nbOfDD[as.character(e)]+1))) # w(n)
+ ## from now on, 'w' stores the w(n) values.
+
+ ## add dummy vectors for tips
+ res <- cbind(diag(1, n), root=rep(1,n), res) # sorted from first tip to last node
+ colnames(res) <- 1:(nTips(x) + nNodes(x))
+ valDum <- c(rep(-1, n), w) # dummy vectors of tips are given a negative value
+ ## note: valDum is the w values for all nodes, sorted from first tip to last node
+
+ ## Discard dummy vectors with lowest valDum (value of dummy vectors, w).
+ ## -> for each node, a dummy vector associated to its DD is removed
+ ## this one is that with the lowest valDum.
+
+ discardOneDum <- function(node, DDnode){ # node is a node label, not a node number
+ if(length(DDnode)==1) return(NULL)
+ val <- valDum[DDnode]
+ toRemove <- which.min(val)
+ keptDD <- DDnode[-toRemove]
+ return(keptDD)
+ } # end discardOneDum
+
+ dumToKeep <- lapply(1:length(listDDx), function(i) discardOneDum(i, listDDx[[i]]))
+ dumToKeep <- unlist(dumToKeep) # contains indices of kept dummy vectors
+
+ res <- res[dumToKeep] # retained dummy vectors
+ res <- res[,order(valDum[dumToKeep], decreasing=TRUE)] # reorder vectors by decreasing w
+
+ ## orthonormalization
+ res <- cbind(root=rep(1,n), res) # for centring: vectors will be orthogonal to 1_n
+ res <- qr.Q(qr(res)) # Gram-Schmidt orthogonalization
+ res <- res[,-1] # keep only centred vectors; orthogonal for identity
+ res <- res * sqrt(n) # render vectors orthogonal for 1/n
+
+ rownames(res) <- tipLabels(x)
+ colnames(res) <- paste("V",1:ncol(res))
+
+ return(as.data.frame(res))
+
+} # end treePart
+
+
+
+## EXAMPLE
+##
+## plot(x <- read.tree(te=newick.eg[[2]]))
+## plot(y <- newick2phylog(newick.eg[[2]]), clabel.node=1)
+##
+##
diff --git a/R/ppca.R b/R/ppca.R
new file mode 100644
index 0000000..fdd5aee
--- /dev/null
+++ b/R/ppca.R
@@ -0,0 +1,699 @@
+#' Phylogenetic principal component analysis
+#'
+#' These functions are designed to perform a phylogenetic principal component
+#' analysis (pPCA, Jombart et al. 2010) and to display the results.
+#'
+#' \code{ppca} performs the phylogenetic component analysis. Other functions
+#' are:\cr
+#'
+#' - \code{print.ppca}: prints the ppca content\cr
+#'
+#' - \code{summary.ppca}: provides useful information about a ppca object,
+#' including the decomposition of eigenvalues of all axes\cr
+#'
+#' - \code{scatter.ppca}: plot principal components using
+#' \code{\link{table.phylo4d}}\cr
+#'
+#' - \code{screeplot.ppca}: graphical display of the decomposition of pPCA
+#' eigenvalues\cr
+#'
+#' - \code{plot.ppca}: several graphics describing a ppca object\cr
+#'
+#' The phylogenetic Principal Component Analysis (pPCA, Jombart et al., 2010) is
+#' derived from the spatial Principal Component Analysis (spca, Jombart et al.
+#' 2008), implemented in the adegenet package (see
+#' \code{\link[adegenet]{spca}}).\cr
+#'
+#' pPCA is designed to investigate phylogenetic patterns a set of quantitative
+#' traits. The analysis returns principal components maximizing the product of
+#' variance of the scores and their phylogenetic autocorrelation (Moran's I),
+#' therefore reflecting life histories that are phylogenetically structured.
+#' Large positive and large negative eigenvalues correspond to global and local
+#' structures.\cr
+#'
+#' @aliases ppca print.ppca summary.ppca scatter.ppca screeplot.ppca plot.ppca
+#' @param x a \linkS4class{phylo4d} object (for \code{ppca}) or a ppca object
+#' (for other methods).
+#' @param prox a marix of phylogenetic proximities as returned by
+#' \code{\link{proxTips}}. If not provided, this matrix will be constructed
+#' using the arguments \code{method} and \code{a}.
+#' @param method a character string (full or abbreviated without ambiguity)
+#' specifying the method used to compute proximities; possible values are:\cr
+#' - \code{patristic}: (inversed sum of) branch lengths \cr - \code{nNodes}:
+#' (inversed) number of nodes on the path between the nodes \cr -
+#' \code{oriAbouheif}: original Abouheif's proximity, with diagonal (see
+#' details in \code{\link{proxTips}}) \cr - \code{Abouheif}: Abouheif's
+#' proximity (see details in \code{\link{proxTips}}) \cr - \code{sumDD}:
+#' (inversed) sum of direct descendants of all nodes on the path (see details
+#' in \code{\link{proxTips}}).
+#' @param f a function to change a distance into a proximity.
+#' @param center a logical indicating whether traits should be centred to mean
+#' zero (TRUE, default) or not (FALSE).
+#' @param scale a logical indicating whether traits should be scaled to unit
+#' variance (TRUE, default) or not (FALSE).
+#' @param scannf a logical stating whether eigenvalues should be chosen
+#' interactively (TRUE, default) or not (FALSE).
+#' @param nfposi an integer giving the number of positive eigenvalues retained
+#' ('global structures').
+#' @param nfnega an integer giving the number of negative eigenvalues retained
+#' ('local structures').
+#' @param \dots further arguments passed to other methods. Can be used to
+#' provide arguments to \code{\link{table.phylo4d}} in \code{plot} method.
+#' @param object a \code{ppca} object.
+#' @param printres a logical stating whether results should be printed on the
+#' screen (TRUE, default) or not (FALSE).
+#' @param axes the index of the principal components to be represented.
+#' @param useLag a logical stating whether the lagged components (\code{x\$ls})
+#' should be used instead of the components (\code{x\$li}).
+#' @param main a title for the screeplot; if NULL, a default one is used.
+#' @return The class \code{ppca} are given to lists with the following
+#' components:\cr \item{eig}{a numeric vector of eigenvalues.}
+#' \item{nfposi}{an integer giving the number of global structures retained.}
+#' \item{nfnega}{an integer giving the number of local structures retained.}
+#' \item{c1}{a data.frame of loadings of traits for each axis.} \item{li}{a
+#' data.frame of coordinates of taxa onto the ppca axes (i.e., principal
+#' components).} \item{ls}{a data.frame of lagged prinpal components; useful
+#' to represent of global scores.} \item{as}{a data.frame giving the
+#' coordinates of the axes of an 'ordinary' PCA onto the ppca axes.}
+#' \item{call}{the matched call.} \item{tre}{a phylogenetic tre with class
+#' \linkS4class{phylo4}.} \item{prox}{a matrix of phylogenetic proximities.}
+#'
+#' Other functions have different outputs:\cr
+#'
+#' - \code{scatter.ppca} returns the matched call.\cr
+#' @author Thibaut Jombart \email{tjombart@@imperial.ac.uk}
+#' @seealso The implementation of \code{\link[adegenet]{spca}} in the adegenet
+#' package (\code{\link[adegenet]{adegenet}}) \cr
+#' @references Jombart, T.; Pavoine, S.; Dufour, A. & Pontier, D. (2010, in
+#' press) Exploring phylogeny as a source of ecological variation: a
+#' methodological approach. doi:10.1016/j.jtbi.2010.03.038
+#'
+#' Jombart, T., Devillard, S., Dufour, A.-B. and Pontier, D. (2008) Revealing
+#' cryptic phylogenetic patterns in genetic variability by a new multivariate
+#' method. \emph{Heredity}, \bold{101}, 92--103.
+#' @keywords multivariate
+#' @examples
+#'
+#' data(lizards)
+#'
+#' if(require(ape) && require(phylobase)){
+#'
+#' #### ORIGINAL EXAMPLE FROM JOMBART ET AL 2010 ####
+#'
+#'
+#' ## BUILD A TREE AND A PHYLO4D OBJECT
+#' liz.tre <- read.tree(tex=lizards$hprA)
+#' liz.4d <- phylo4d(liz.tre, lizards$traits)
+#' par(mar=rep(.1,4))
+#' table.phylo4d(liz.4d,var.lab=c(names(lizards$traits),
+#' "ACP 1\n(\"size effect\")"),show.node=FALSE, cex.lab=1.2)
+#'
+#'
+#' ## REMOVE DUPLICATED POPULATIONS
+#' liz.4d <- prune(liz.4d, c(7,14))
+#' table.phylo4d(liz.4d)
+#'
+#'
+#' ## CORRECT LABELS
+#' lab <- c("Pa", "Ph", "Ll", "Lmca", "Lmcy", "Phha", "Pha",
+#' "Pb", "Pm", "Ae", "Tt", "Ts", "Lviv", "La", "Ls", "Lvir")
+#' tipLabels(liz.4d) <- lab
+#'
+#'
+#' ## REMOVE SIZE EFFECT
+#' dat <- tdata(liz.4d, type="tip")
+#' dat <- log(dat)
+#' newdat <- data.frame(lapply(dat, function(v) residuals(lm(v~dat$mean.L))))
+#' rownames(newdat) <- rownames(dat)
+#' tdata(liz.4d, type="tip") <- newdat[,-1] # replace data in the phylo4d object
+#'
+#'
+#' ## pPCA
+#' liz.ppca <- ppca(liz.4d,scale=FALSE,scannf=FALSE,nfposi=1,nfnega=1, method="Abouheif")
+#' liz.ppca
+#' tempcol <- rep("grey",7)
+#' tempcol[c(1,7)] <- "black"
+#' barplot(liz.ppca$eig,main='pPCA eigenvalues',cex.main=1.8,col=tempcol)
+#'
+#' par(mar=rep(.1,4))
+#' plot(liz.ppca,ratio.tree=.7)
+#'
+#'
+#' ## CONTRIBUTIONS TO PC (LOADINGS) (viewed as dotcharts)
+#' dotchart(liz.ppca$c1[,1],lab=rownames(liz.ppca$c1),main="Global principal
+#' component 1")
+#' abline(v=0,lty=2)
+#'
+#' dotchart(liz.ppca$c1[,2],lab=rownames(liz.ppca$c1),main="Local principal
+#' component 1")
+#' abline(v=0,lty=2)
+#'
+#'
+#' ## REPRODUCE FIGURES FROM THE PAPER
+#' obj.ppca <- liz.4d
+#' tdata(obj.ppca, type="tip") <- liz.ppca$li
+#' myLab <- paste(" ",rownames(liz.ppca$li), sep="")
+#'
+#' ## FIGURE 1
+#' par(mar=c(.1,2.4,2.1,1))
+#' table.phylo4d(obj.ppca, ratio=.7, var.lab=c("1st global PC", "1st local
+#' PC"), tip.label=myLab,box=FALSE,cex.lab=1.4, cex.sym=1.2, show.node.label=TRUE)
+#' add.scatter.eig(liz.ppca$eig,1,1,1,csub=1.2, posi="topleft", ratio=.23)
+#'
+#'
+#' ## FIGURE 2
+#' s.arrow(liz.ppca$c1,xlim=c(-1,1),clab=1.3,cgrid=1.3)
+#'
+#'
+#'
+#' #### ANOTHER EXAMPLE - INCLUDING NA REPLACEMENT ####
+#' ## LOAD THE DATA
+#' data(maples)
+#' tre <- read.tree(text=maples$tre)
+#' x <- phylo4d(tre, maples$tab)
+#' omar <- par("mar")
+#' par(mar=rep(.1,4))
+#' table.phylo4d(x, cex.lab=.5, cex.sym=.6, ratio=.1) # note NAs in last trait ('x')
+#'
+#' ## FUNCTION TO REPLACE NAS
+#' f1 <- function(vec){
+#' if(any(is.na(vec))){
+#' m <- mean(vec, na.rm=TRUE)
+#' vec[is.na(vec)] <- m
+#' }
+#' return(vec)
+#' }
+#'
+#'
+#' ## PERFORM THE PPCA
+#' dat <- apply(maples$tab,2,f1) # replace NAs
+#' x.noNA <- phylo4d(tre, as.data.frame(dat))
+#' map.ppca <- ppca(x.noNA, scannf=FALSE, method="Abouheif")
+#' map.ppca
+#'
+#'
+#' ## SOME GRAPHICS
+#' screeplot(map.ppca)
+#' scatter(map.ppca, useLag=TRUE)
+#' plot(map.ppca, useLag=TRUE)
+#'
+#'
+#' ## MOST STRUCTURED TRAITS
+#' a <- map.ppca$c1[,1] # loadings on PC 1
+#' names(a) <- row.names(map.ppca$c1)
+#' highContrib <- a[a< quantile(a,0.1) | a>quantile(a,0.9)]
+#' datSel <- cbind.data.frame(dat[, names(highContrib)], map.ppca$li)
+#' temp <- phylo4d(tre, datSel)
+#' table.phylo4d(temp) # plot of most structured traits
+#'
+#'
+#' ## PHYLOGENETIC AUTOCORRELATION TESTS FOR THESE TRAITS
+#' prox <- proxTips(tre, method="Abouheif")
+#' abouheif.moran(dat[, names(highContrib)], prox)
+#'
+#' }
+#'
+#' @import phylobase methods
+#' @importFrom stats screeplot
+#' @importFrom graphics par layout barplot title box dotchart abline rect text
+#' axis segments
+#' @importFrom stats median
+#' @export ppca
+ppca <- function(x, prox=NULL, method=c("patristic","nNodes","oriAbouheif","Abouheif","sumDD"),
+ f=function(x) {1/x},
+ center=TRUE, scale=TRUE, scannf=TRUE, nfposi=1, nfnega=0){
+
+ ## handle arguments
+ ## if(!require(ade4)) stop("The package ade4 is not installed.")
+ if (is.character(chk <- checkPhylo4(x))) stop("bad phylo4d object: ",chk)
+ ##if (is.character(chk <- checkData(x))) stop("bad phylo4d object: ",chk) : no longer needed
+
+ tre <- as(x, "phylo4")
+ method <- match.arg(method)
+ NEARZERO <- 1e-10
+
+ ## proximity matrix
+ if(is.null(prox)){ # have to compute prox
+ W <- proxTips(x, tips="all", method=method, f=f, normalize="row", symmetric=TRUE)
+ } else { # prox is provided
+ W <- as.matrix(prox)
+ if(!is.matrix(W)) stop("W is not a matrix")
+ if(ncol(W) != nrow(W)) stop("W is not a square matrix")
+ diag(W) <- 0
+ W <- 0.5 * (t(W) + W) # re-symmetrization
+ }
+
+ N <- nTips(x)
+
+ ## data matrix X
+ X <- tdata(x, type="tip")
+ X.colnames <- names(X)
+ X.rownames <- row.names(X)
+ temp <- sapply(X, is.numeric)
+ if(!all(temp)) {
+ warning(paste("non-numeric data are removed:", X.colnames[!temp]))
+ X <- X[,temp]
+ X.colnames <- X.colnames[!temp]
+ X.rownames <- X.rownames[!temp]
+ }
+
+ ## replace NAs
+ f1 <- function(vec){
+ m <- mean(vec,na.rm=TRUE)
+ vec[is.na(vec)] <- m
+ return(vec)
+ }
+
+ if(any(is.na(X))) {
+ warning("Replacing missing values (NA) by mean values")
+ X <- as.data.frame(apply(X, 2, f1))
+ }
+
+ X <- scalewt(X, center=center, scale=scale) # centring/scaling of traits
+
+
+ ## main computation ##
+
+ ## make a skeleton of dudi
+ res <- dudi.pca(X, center=center, scale=scale, scannf=FALSE,nf=2)
+ Upca <- as.matrix(res$c1)
+
+ ## computations of the ppca
+ X <- as.matrix(X)
+ decomp <- eigen( ((t(X) %*% W %*% X)/N), symmetric=TRUE)
+ U <- decomp$vectors # U: principal axes
+ lambda <- decomp$values
+
+ ## remove null eigenvalues and corresponding vectors
+ toKeep <- (abs(lambda) > NEARZERO)
+ lambda <- lambda[toKeep]
+ U <- U[, toKeep]
+ p <- ncol(U)
+
+ if(scannf){ # interactive part
+ barplot(lambda)
+ cat("Select the number of global axes: ")
+ nfposi <- as.integer(readLines(n = 1))
+ cat("Select the number of local axes: ")
+ nfnega <- as.integer(readLines(n = 1))
+ }
+
+ nfposi <- max(nfposi, 1)
+ nfnega <- max(nfnega, 0)
+ posi.idx <- 1:nfposi
+ if(nfnega<1) {
+ nega.idx <- NULL
+ } else {
+ nega.idx <- (p-nfnega+1):p
+ }
+
+ axes.idx <- unique(c(posi.idx, nega.idx)) # index of kept axes
+ U <- U[, axes.idx, drop=FALSE]
+
+ S <- X %*% U # S: scores (=princ. components)
+ LS <- W %*% S # LS: lagged scores
+ A <- t(Upca) %*% U # A: pca princ. axes onto ppca princ. axes.
+
+ ## build the output
+ axes.lab <- paste("PA",axes.idx, sep="")
+ scores.lab <- paste("PC",axes.idx, sep="")
+
+ res$cent <- res$norm <- res$co <- NULL # cleaning
+
+ res$eig <- lambda # eigenvalues
+ res$nf <- NULL
+ res$nfposi <- nfposi
+ res$nfnega <- nfnega
+ res$kept.axes <- axes.idx
+
+ res$c1 <- as.data.frame(U) # principal axes
+ names(res$c1) <- axes.lab
+ row.names(res$c1) <- X.colnames
+
+ res$li <- as.data.frame(S) # scores (princ. components)
+ names(res$li) <- scores.lab
+ row.names(res$li) <- X.rownames
+
+ res$ls <- as.data.frame(LS) # lagged scores
+ names(res$ls) <- scores.lab
+ row.names(res$ls) <- X.rownames
+
+ res$as <- as.data.frame(A) # PCA axes onto pPCA axes
+ names(res$as) <- axes.lab
+ row.names(res$as) <- paste("PCA axis", 1:nrow(A))
+
+ res$tre <- as(tre,"phylo4") # tree
+
+ res$prox <- W # proximity matrix
+
+ res$call <- match.call() # call
+
+ class(res) <- "ppca"
+
+ return(res)
+} # end ppca
+
+
+
+
+
+#####################
+# Function scatter.ppca
+#####################
+#' @rdname ppca
+#' @export
+scatter.ppca <- function(x, axes=1:ncol(x$li), useLag=FALSE, ...){
+ if(useLag){
+ df <- as.data.frame(x$ls)
+ } else{
+ df <- as.data.frame(x$li)
+ }
+
+ if(any(axes < 1 | axes > ncol(x$li)) ) stop("Wrong axes specified.")
+ df <- df[, axes, drop=FALSE]
+
+ obj <- phylo4d(x$tre,df)
+ args <- list(...)
+ if(is.null(args$ratio.tree)){
+ args$ratio.tree <- 0.5
+ }
+ args <- c(obj,args)
+ do.call(table.phylo4d, args)
+
+ return(invisible(match.call()))
+} # end scatter.ppca
+
+
+
+
+
+######################
+# Function print.ppca
+######################
+#' @rdname ppca
+#' @method print ppca
+#' @export
+print.ppca <- function(x, ...){
+ cat("\t#############################################\n")
+ cat("\t# phylogenetic Principal Component Analysis #\n")
+ cat("\t#############################################\n")
+ cat("class: ")
+ cat(class(x))
+ cat("\n$call: ")
+ print(x$call)
+ cat("\n$nfposi:", x$nfposi, "axes-components saved")
+ cat("\n$nfnega:", x$nfnega, "axes-components saved")
+ cat("\n$kept.axes: index of kept axes")
+
+ cat("\nPositive eigenvalues: ")
+ l0 <- sum(x$eig >= 0)
+ cat(signif(x$eig, 4)[1:(min(5, l0))])
+ if (l0 > 5)
+ cat(" ...\n")
+ else cat("\n")
+ cat("Negative eigenvalues: ")
+ l0 <- sum(x$eig <= 0)
+ cat(sort(signif(x$eig, 4))[1:(min(5, l0))])
+ if (l0 > 5)
+ cat(" ...\n")
+ else cat("\n")
+ cat('\n')
+ sumry <- array("", c(1, 4), list(1, c("vector", "length",
+ "mode", "content")))
+ sumry[1, ] <- c('$eig', length(x$eig), mode(x$eig), 'eigenvalues')
+ class(sumry) <- "table"
+ print(sumry)
+ cat("\n")
+ sumry <- array("", c(4, 4), list(1:4, c("data.frame", "nrow", "ncol", "content")))
+ sumry[1, ] <- c("$c1", nrow(x$c1), ncol(x$c1), "principal axes: scaled vectors of traits loadings")
+ sumry[2, ] <- c("$li", nrow(x$li), ncol(x$li), "principal components: coordinates of taxa ('scores')")
+ sumry[3, ] <- c("$ls", nrow(x$ls), ncol(x$ls), 'lag vector of principal components')
+ sumry[4, ] <- c("$as", nrow(x$as), ncol(x$as), 'pca axes onto ppca axes')
+
+ class(sumry) <- "table"
+ print(sumry)
+
+ cat("\n$tre: a phylogeny (class phylo4)")
+ cat("\n$prox: a matrix of phylogenetic proximities")
+
+ cat("\n\nother elements: ")
+ if (length(names(x)) > 16)
+ cat(names(x)[17:(length(names(x)))], "\n")
+ else cat("NULL\n")
+} #end print.ppca
+
+
+
+
+
+###############
+# summary.ppca
+###############
+#' @rdname ppca
+#' @method summary ppca
+#' @export
+summary.ppca <- function (object, ..., printres=TRUE) {
+
+ ## some checks
+ if (!inherits(object, "ppca"))stop("to be used with 'ppca' object")
+ ## if(!require(ade4)) stop("The package ade4 is not installed.")
+
+
+ norm.w <- function(X, w) {
+ f2 <- function(v) sum(v * v * w)/sum(w)
+ norm <- apply(X, 2, f2)
+ return(norm)
+ }
+
+ resfin <- list()
+
+ if(printres) {
+ cat("\n### Phylogenetic Principal Component Analysis ###\n")
+ cat("\nCall: ")
+ print(object$call)
+ }
+
+ appel <- as.list(object$call)
+ ## compute original pca
+ X <- object$tab # transformed data
+ W <- object$prox
+
+ nfposi <- object$nfposi
+ nfnega <- object$nfnega
+
+ dudi <- dudi.pca(X, center=FALSE, scale=FALSE, scannf=FALSE, nf=nfposi+nfnega)
+ ## end of pca
+
+ Istat <- data.frame(attributes(moran.idx(X[,1], W,TRUE)))
+ row.names(Istat) <- ""
+ resfin$Istat <- Istat
+
+ if(printres) {
+ cat("\n== Moran's I statistics ==\n")
+ print(Istat)
+ }
+
+ ## pca scores
+ nf <- dudi$nf
+ eig <- dudi$eig[1:nf]
+ cum <- cumsum(dudi$eig)[1:nf]
+ ratio <- cum/sum(dudi$eig)
+ moran <- apply(as.matrix(dudi$l1),2,moran.idx, W)
+ res <- data.frame(var=eig,cum=cum,ratio=ratio, moran=moran)
+ row.names(res) <- paste("Axis",1:nf)
+ if(printres) {
+ cat("\n== PCA scores ==\n")
+ print(res)
+ }
+
+ resfin$pca <- res
+
+
+ ## ppca scores
+ ## ppca is recomputed, keeping all axes
+ eig <- object$eig
+ nfposimax <- sum(eig > 0)
+ nfnegamax <- sum(eig < 0)
+
+ listArgs <- appel[-1]
+ listArgs$nfposi <- nfposimax
+ listArgs$nfnega <- nfnegamax
+ listArgs$scannf <- FALSE
+
+ ppcaFull <- do.call(ppca, listArgs) # ppca with all axes
+
+ ndim <- dudi$rank
+ nf <- nfposi + nfnega
+ toKeep <- c(1:nfposi,if (nfnega>0) (ndim-nfnega+1):ndim)
+ varspa <- norm.w(ppcaFull$li,dudi$lw)
+ moran <- apply(as.matrix(ppcaFull$li), 2, moran.idx, W)
+ res <- data.frame(eig=eig,var=varspa,moran=moran)
+ row.names(res) <- paste("Axis",1:length(eig))
+
+ if(printres) {
+ cat("\n== pPCA eigenvalues decomposition ==\n")
+ print(res[toKeep,])
+ }
+
+ resfin$ppca <- res
+
+ return(invisible(resfin))
+} # end summary.ppca
+
+
+
+
+
+#################
+# screeplot.ppca
+#################
+#' @rdname ppca
+#' @export
+screeplot.ppca <- function(x,...,main=NULL){
+
+ opar <- par("las")
+ on.exit(par(las=opar))
+
+ sumry <- summary(x,printres=FALSE)
+
+ labels <- lapply(1:length(x$eig),function(i) bquote(lambda[.(i)]))
+
+ par(las=1)
+
+ xmax <- sumry$pca[1,1]*1.1
+ I0 <- unlist(sumry$Istat[1])
+ Imin <- unlist(sumry$Istat[2])
+ Imax <- unlist(sumry$Istat[3])
+
+ plot(x=sumry$ppca[,2],y=sumry$ppca[,3],type='n',xlab='Variance',ylab="Phylogenetic autocorrelation (I)",xlim=c(0,xmax),ylim=c(Imin*1.1,Imax*1.1),yaxt='n',...)
+ text(x=sumry$ppca[,2],y=sumry$ppca[,3],do.call(expression,labels))
+
+ ytick <- c(I0,round(seq(Imin,Imax,le=5),1))
+ ytlab <- as.character(round(seq(Imin,Imax,le=5),1))
+ ytlab <- c(as.character(round(I0,1)),as.character(round(Imin,1)),ytlab[2:4],as.character(round(Imax,1)))
+ axis(side=2,at=ytick,labels=ytlab)
+
+ rect(0,Imin,xmax,Imax,lty=2)
+ segments(0,I0,xmax,I0,lty=2)
+ abline(v=0)
+
+ if(is.null(main)) main <- ("Decomposition of pPCA eigenvalues")
+ title(main)
+
+ return(invisible(match.call()))
+} # end screeplot.ppca
+
+
+
+
+
+############
+# plot.ppca
+############
+#' @rdname ppca
+#' @method plot ppca
+#' @export
+plot.ppca <- function(x, axes = 1:ncol(x$li), useLag=FALSE, ...){
+
+ ## some checks
+ if (!inherits(x, "ppca")) stop("Use only with 'ppca' objects.")
+ if(any(axes>ncol(x$li) | axes<0)) stop("wrong axes required.")
+
+ ## par / layout
+ opar <- par(no.readonly = TRUE)
+ on.exit(par(opar))
+ par(mar = rep(.1,4))
+ layout(matrix(c(1,2,3,4,4,4,4,4,4), ncol=3))
+
+ ## some variables
+ tre <- x$tre
+ n <- nrow(x$li)
+
+ ## 1) barplot of eigenvalues
+ omar <- par("mar")
+ par(mar = c(0.8, 2.8, 0.8, 0.8))
+ r <- length(x$eig)
+ col <- rep("white", r)
+
+ keptAxes <- c( (1:r)[1:x$nfposi], (r:1)[1:x$nfnega]) # kept axes
+ if(x$nfposi==0) keptAxes <- keptAxes[-1]
+ if(x$nfnega==0) keptAxes <- keptAxes[-length(keptAxes)]
+ col[keptAxes] <- "grey"
+
+ repAxes <- gsub("PC","",colnames(x$li)[axes]) # represented axes
+ repAxes <- as.numeric(repAxes)
+ col[repAxes] <- "black"
+
+ barplot(x$eig, col=col)
+ title("Eigenvalues", line=-1)
+ par(mar=rep(.1,4))
+ box()
+
+
+ ## 2) decomposition of eigenvalues
+ par(mar=c(4,4,2,1))
+ screeplot(x,main="Eigenvalues decomposition")
+ par(mar=rep(.1,4))
+ box()
+
+
+ ## 3) loadings
+ if(length(axes)==1){ # one axis retained
+ par(mar=c(2.5,4,2,1))
+ dotchart(x$c1[,1], labels=row.names(x$c1), main="Loadings",
+ cex=par("cex")*.66)
+ abline(v=median(x$c1[,1]), lty=2)
+ par(mar=rep(.1,4))
+ box()
+
+ } else{ # at least two axes retained
+ s.arrow(x$c1[,axes], sub="Loadings")
+ }
+
+
+ ## 4) scatter plot
+ ratioTree <- .6
+ cexLabel <- 1
+ cexSymbol <- 1
+
+ temp <- try(scatter(x, axes=axes, ratio.tree=ratioTree,
+ cex.lab=cexLabel, cex.sym=cexSymbol,
+ show.node=FALSE, useLag=useLag), silent=TRUE) # try default plot
+ scatterOk <- !inherits(temp,"try-error")
+
+ while(!scatterOk){
+ ## clear 4th screen
+ par(new=TRUE)
+ plot(1, type="n",axes=FALSE)
+ rect(-10,-10, 10,10,col="white")
+ par(new=TRUE)
+ if(ratioTree > .25 & cexSymbol <= .7) {
+ ratioTree <- ratioTree - .05
+ }
+ if(cexLabel > .65 & cexSymbol <= .5) {
+ cexLabel <- cexLabel - .05
+ }
+ cexSymbol <- cexSymbol - .05
+
+ temp <- try(scatter(x, axes=axes, ratio.tree=ratioTree,
+ cex.lab=cexLabel, cex.sym=cexSymbol,
+ show.node=FALSE, useLag=useLag), silent=TRUE) # try default plot
+ scatterOk <- !inherits(temp,"try-error")
+ }
+
+ return(invisible(match.call()))
+
+} # end plot.phylo
+
+
+### testing
+## obj <- phylo4d(read.tree(text=mjrochet$tre),mjrochet$tab)
+## x at edge.length= rep(1,length(x at edge.label))
+## M = cophenetic.phylo(as(x,"phylo"))
+## M = 1/M
+## diag(M) <- 0
+
+
+## ppca1 <- ppca(obj,scannf=FALSE,nfp=1,nfn=0)
+
+## plot(ppca1)
diff --git a/R/proximities.R b/R/proximities.R
new file mode 100644
index 0000000..f2053a4
--- /dev/null
+++ b/R/proximities.R
@@ -0,0 +1,183 @@
+###########
+# proxTips
+###########
+
+
+#' Compute some phylogenetic proximities between tips
+#'
+#' The function \code{proxTips} computes a given proximity between a set of
+#' tips of a phylogeny. A vector of tips is supplied: proximities between all
+#' possible pairs of these tips are computed. The proximities are computed
+#' from the shortest path between the tips. \cr
+#'
+#' Proximities are computed as the inverse (to the power \code{a}) of a
+#' phylogenetic distance (computed by \code{\link{distTips}}. Denoting
+#' \eqn{D=[d_{ij}]} a matrix of phylogenetic distances, the proximity matrix
+#' \eqn{M=[m_{ij}]} is computed as: \deqn{m_{ij} = \frac{1}{d_{ij}^a} \forall i
+#' \neq j}{ m_{ij} = (1/d_{ij})^a for all i different from j} and \deqn{m_{ii}
+#' = 0}
+#'
+#' Several distances can be used, defaulting to the sum of branch lengths (see
+#' argument \code{method}). Proximities are not true similarity measures,
+#' since the proximity of a tip with itself is always set to zero.\cr
+#'
+#' The obtained matrix of phylogenetic proximities (M) defines a bilinear
+#' symmetric form when M is symmetric (default):\cr \deqn{f(x,y) = x^{T}My}
+#'
+#' In general, M is not a metric because it is not positive-definite. Such a
+#' matrice can be used to measure phylogenetic autocorrelation (using Moran's
+#' index): \deqn{I(x) = \frac{x^TMx}{var(x)}}{I(x) = (x^{T}Mx)/(var(x)) }
+#'
+#' or to compute lag vectors (Mx) used in autoregressive models, like: \deqn{x
+#' = Mx + ... + e} where '...' is the non-autoregressive part of the model, and
+#' 'e' are residuals.
+#'
+#' \code{Abouheif} proximity refers to the phylogenetic proximity underlying
+#' the test of Abouheif (see references). Let P be the set of all the nodes in
+#' the path going from \code{node1} to \code{node2}. Let DDP be the number of
+#' direct descendants from each node in P. Then, the so-called 'Abouheif'
+#' distance is the inverse of the product of all terms in DDP.
+#' \code{oriAbouheif} returns a matrix with non-null diagonal elements, as
+#' formulated in Pavoine \emph{et al.} (2008). This matrix is bistochastic (all
+#' marginal sums equal 1), but this bilinear symmetric form does not give rise
+#' to a Moran's index, since it requires a null diagonal. \code{Abouheif}
+#' contains Abouheif's proximities but has a null diagonal, giving rise to a
+#' Moran's index.\cr
+#'
+#' \code{sumDD} refers to a phylogenetic proximity quite similar to that of
+#' Abouheif. We consider the same sets P and DDP. But instead of taking the
+#' inverse of the product of all terms in DDP, this proximity computes the
+#' inverse of the sum of all terms in DDP. This matrix was denoted 'M' in
+#' Pavoine \emph{et al.} (2008), who reported that it is related to May's index
+#' (May, 1990).
+#'
+#' @param x a tree of class \code{\link[ape:read.tree]{phylo}},
+#' \linkS4class{phylo4} or \linkS4class{phylo4d}.
+#' @param tips A vector of integers identifying tips by their numbers, or a
+#' vector of characters identifying tips by their names. Distances will be
+#' computed between all possible pairs of tips.
+#' @param method a character string (full or abbreviated without ambiguity)
+#' specifying the method used to compute proximities; possible values are:\cr -
+#' \code{patristic}: (inversed sum of) branch length \cr - \code{nNodes}:
+#' (inversed) number of nodes on the path between the nodes \cr -
+#' \code{oriAbouheif}: original Abouheif's proximity, with diagonal (see
+#' details) \cr - \code{Abouheif}: Abouheif's proximity without diagonal (see
+#' details) \cr - \code{sumDD}: (inversed) sum of direct descendants of all
+#' nodes on the path (see details) \cr
+#' @param f a function to change a distance into a proximity.
+#' @param normalize a character string specifying whether the matrix must be
+#' normalized by row (\code{row}), column (\code{col}), or not (\code{none}).
+#' Normalization amounts to dividing each row (or column) so that the marginal
+#' sum is 1. Hence, default is matrix with each row summing to 1.
+#' @param symmetric a logical stating whether M must be coerced to be symmetric
+#' (TRUE, default) or not. This is achieved by taking (denoting N the matrix of
+#' proximities before re-symmetrization): \deqn{M = 0.5 * (N + N^{T})} Note
+#' that \eqn{x^{T}Ny = x^{T}My}, but the latter has the advantage of using a
+#' bilinear symmetric form (more appropriate for optimization purposes).
+#' @param useC a logical indicating whether computations of distances (before
+#' transformation into proximities) should be performed using compiled C code
+#' (TRUE, default), or using a pure R version (FALSE). C version is several
+#' orders of magnitude faster, and R version is kept for backward
+#' compatibility.
+#' @return A matrix of phylogenetic proximities.
+#' @author Thibaut Jombart \email{tjombart@@imperial.ac.uk}
+#' @seealso \code{\link{distTips}} which computes several phylogenetic
+#' distances between tips.
+#' @references == About Moran's index with various proximities == \cr Pavoine,
+#' S.; Ollier, S.; Pontier, D.; Chessel, D. (2008) Testing for phylogenetic
+#' signal in life history variable: Abouheif's test revisited.
+#' \emph{Theoretical Population Biology}: \bold{73}, 79-91.\cr
+#'
+#' == About regression on phylogenetic lag vector == \cr Cheverud, J. M.; Dow,
+#' M. M.; Leutenegger, W. (1985) The quantitative assessment of phylogentic
+#' constaints in comparative analyses: sexual dimorphism in body weights among
+#' primates. \emph{Evolution} \bold{39}, 1335-1351.\cr
+#'
+#' Cheverud, J. M.; Dow, M. M. (1985) An autocorrelation analysis of genetic
+#' variation due to lineal fission in social groups of Rhesus macaques.
+#' \emph{American Journal of Phyisical Anthropology} \bold{67}, 113-121.\cr
+#'
+#' == Abouheif's original paper ==\cr Abouheif, E. (1999) A method for testing
+#' the assumption of phylogenetic independence in comparative data.
+#' \emph{Evolutionary Ecology Research}, \bold{1}, 895-909.\cr
+#'
+#' == May's index ==\cr May, R.M. (1990) Taxonomy as destiny. \emph{Nature}
+#' \bold{347}, 129-130.
+#' @keywords manip
+#' @examples
+#'
+#' if(require(ape) & require(phylobase)){
+#' ## make a tree
+#' x <- as(rtree(10),"phylo4")
+#' plot(x, show.node=TRUE)
+#' axisPhylo()
+#' ## compute different distances
+#' proxTips(x, 1:5)
+#' proxTips(x, 1:5, "nNodes")
+#' proxTips(x, 1:5, "Abouheif")
+#' proxTips(x, , "sumDD")
+#'
+#' ## see what one proximity looks like
+#' M <- proxTips(x)
+#' obj <- phylo4d(x,as.data.frame(M))
+#' table.phylo4d(obj,symbol="sq")
+#' }
+#'
+#' @import phylobase
+#' @export proxTips
+proxTips <- function(x, tips="all",
+ method=c("patristic","nNodes","oriAbouheif","Abouheif","sumDD"),
+ f=function(x){1/x}, normalize=c("row","col","none"), symmetric=TRUE, useC=TRUE){
+
+ ## if(!require(phylobase)) stop("phylobase package is not installed")
+
+ ## handle arguments
+ x <- as(x, "phylo4")
+ method <- match.arg(method)
+ normalize <- match.arg(normalize)
+ N <- nTips(x)
+ if(tips[1]=="all") { tips <- 1:N }
+ tips <- getNode(x, tips)
+
+ ## some checks
+ if (is.character(checkval <- checkPhylo4(x))) stop(checkval)
+ if(any(is.na(tips))) stop("wrong tips specified")
+
+ ## compute distances
+ distMethod <- method
+ if(length(grep("Abouheif", distMethod)>1)){
+ distMethod <- "Abouheif"
+ }
+ D <- distTips(x, tips=tips, method=distMethod, useC=useC)
+ D <- as.matrix(D)
+
+ ## compute proximities
+ res <- f(D)
+ diag(res) <- 0
+
+ ## handle Abouheif with diagonal (Abouheif1)
+ if(method=="oriAbouheif"){
+ sumMarg <- apply(res,1,sum)
+ diag(res) <- (1-sumMarg)
+ normalize <- "none" # not needed (already bistochastic)
+ symmetric <- FALSE # not needed (aleady symmetric)
+ }
+
+ ## standardization
+ if(normalize=="row") {
+ res <- prop.table(res, 1)
+ }
+
+ if(normalize=="col") {
+ res <- prop.table(res, 2)
+ }
+
+ ## re-symmetrize
+ if(symmetric){
+ res <- 0.5 * (res + t(res))
+ }
+
+ ## set the output
+ return(res)
+
+} # end proxTips
diff --git a/R/table.phylo4d.R b/R/table.phylo4d.R
new file mode 100644
index 0000000..1b06a99
--- /dev/null
+++ b/R/table.phylo4d.R
@@ -0,0 +1,413 @@
+#############
+## table.phylo4d
+#############
+
+
+#' Graphical display of phylogeny and traits
+#'
+#' This function represents traits onto the tips of a phylogeny. Plotted objects
+#' must be valid \linkS4class{phylo4d} objects (implemented by the
+#' \code{phylobase} package). Current version allows plotting of a tree and one
+#' or more quantitative traits (possibly containing missing data, represented by
+#' an 'x').\cr
+#'
+#' The plot of phylogenies is performed by a call to
+#' \code{\link[ape]{plot.phylo}} from the \code{ape} package. Hence, many of the
+#' arguments of \code{\link[ape]{plot.phylo}} can be passed to
+#' \code{table.phylo4d}, through the \dots{} argument, but their names must be
+#' complete.
+#'
+#' For large trees, consider using \code{\link{bullseye}}.
+#'
+#' The function \code{table.phylo4d} is based on former plot method for
+#' \linkS4class{phylo4d} objects from the \code{phylobase} package. It replaces
+#' the deprecated \code{ade4} functions \code{\link[ade4]{symbols.phylog}} and
+#' \code{\link[ade4]{table.phylog}}.
+#'
+#' @param x a \linkS4class{phylo4d} object
+#' @param treetype the type of tree to be plotted ("phylogram" or "cladogram")
+#' @param symbol the type of symbol used to represent data ("circles",
+#' "squares", or "colors")
+#' @param repVar the numerical index of variables to be plotted
+#' @param center a logical stating whether variables should be centred (TRUE,
+#' default) or not (FALSE)
+#' @param scale a logical stating whether variables should be scaled (TRUE,
+#' default) or not (FALSE)
+#' @param legend a logical stating whether a legend should be added to the plot
+#' (TRUE) or not (FALSE, default)
+#' @param grid a logical stating whether a grid should be added to the plot
+#' (TRUE, default) or not (FALSE)
+#' @param box a logical stating whether a box should be added around the plot
+#' (TRUE, default) or not (FALSE)
+#' @param show.tip.label a logical stating whether tip labels should be printed
+#' (TRUE, default) or not (FALSE)
+#' @param show.node.label a logical stating whether node labels should be
+#' printed (TRUE, default) or not (FALSE)
+#' @param show.var.label a logical stating whether labels of variables should be
+#' printed (TRUE, default) or not (FALSE)
+#' @param ratio.tree the proportion of width of the figure occupied by the tree
+#' @param font an integer specifying the type of font for the labels: 1 (plain
+#' text), 2 (bold), 3 (italic, default), or 4 (bold italic).
+#' @param tip.label a character vector giving the tip labels
+#' @param var.label a character vector giving the labels of variables
+#' @param cex.symbol a numeric giving the factor scaling the symbols
+#' @param cex.label a numeric giving the factor scaling all labels
+#' @param cex.legend a numeric giving the factor scaling the legend
+#' @param pch is \code{symbol} is set to 'colors', a number indicating the type
+#' of point to be plotted (see ?points)
+#' @param col is \code{symbol} is set to 'colors', a vector of colors to be used
+#' to represent the data
+#' @param coord.legend an optional list with two components 'x' and 'y'
+#' indicating the lower-left position of the legend. Can be set to
+#' \code{locator(1) to position the legend interactively.}
+#' @param \dots further arguments to be passed to plot methods from \code{ape}.
+#' See \code{\link[ape]{plot.phylo}}.
+#' @author Thibaut Jombart \email{tjombart@@imperial.ac.uk}
+#' @seealso The \linkS4class{phylo4d} class for storing
+#' \code{phylogeny+data}.\cr
+#'
+#' For large trees, consider using \code{\link{bullseye}}.
+#'
+#' \code{\link[ape]{plot.phylo}} from the \code{ape} package.\cr
+#'
+#' An alternative (deprecated) representation is available from
+#' \code{\link[ade4]{dotchart.phylog}}.
+#' @keywords hplot multivariate
+#' @examples
+#'
+#' if(require(ape) & require(phylobase) & require(ade4)){
+#'
+#' ## simulated data
+#' tr <- rtree(20)
+#' dat <- data.frame(a = rnorm(20), b = scale(1:20), c=runif(20,-2,2) )
+#' dat[3:6, 2] <- NA # introduce some NAs
+#' obj <- phylo4d(tr, dat) # build a phylo4d object
+#' table.phylo4d(obj) # default scatterplot
+#' table.phylo4d(obj,cex.leg=.6, use.edge.length=FALSE) # customized
+#' table.phylo4d(obj,treetype="clad", show.node=FALSE, cex.leg=.6,
+#' use.edge.length=FALSE, edge.color="blue", edge.width=3) # more customized
+#'
+#'
+#' ## teleost fishes data
+#' data(mjrochet)
+#' temp <- read.tree(text=mjrochet$tre) # make a tree
+#' mjr <- phylo4d(x=temp,tip.data=mjrochet$tab) # male a phylo4d object
+#' table.phylo4d(mjr,cex.lab=.5,show.node=FALSE,symb="square")
+#'
+#'
+#' ## lizards data
+#' data(lizards)
+#' liz.tr <- read.tree(tex=lizards$hprA) # make a tree
+#' liz <- phylo4d(liz.tr, lizards$traits) # make a phylo4d object
+#' table.phylo4d(liz)
+#'
+#'
+#' ## plotting principal components
+#' liz.pca1 <- dudi.pca(lizards$traits, scannf=FALSE, nf=2) # PCA of traits
+#' myPC <- phylo4d(liz.tr, liz.pca1$li) # store PC in a phylo4d object
+#' varlab <- paste("Principal \ncomponent", 1:2) # make labels for PCs
+#' table.phylo4d(myPC, ratio=.8, var.lab=varlab) # plot the PCs
+#' add.scatter.eig(liz.pca1$eig,2,1,2,posi="topleft", inset=c(0,.15))
+#' title("Phylogeny and the principal components")
+#'
+#' }
+#'
+#' @import phylobase
+#' @importFrom ape plot.phylo
+#' @importFrom graphics par strwidth segments symbols points text strheight
+#' @importFrom grDevices heat.colors
+#' @export table.phylo4d
+table.phylo4d <- function(x, treetype=c("phylogram","cladogram"), symbol=c("circles", "squares", "colors"),
+ repVar=1:ncol(tdata(x, type="tip")), center=TRUE, scale=TRUE, legend=TRUE, grid=TRUE, box=TRUE,
+ show.tip.label=TRUE, show.node.label=TRUE, show.var.label=TRUE,
+ ratio.tree=1/3, font=3,
+ tip.label=tipLabels(x), var.label=colnames(tdata(x,type="tip")),
+ cex.symbol=1, cex.label=1, cex.legend=1,
+ pch=20, col=heat.colors(100), coord.legend=NULL, ...)
+{
+
+ ## preliminary stuff and checks
+ if (is.character(chk <- checkPhylo4(x))) stop("bad phylo4d object: ",chk)
+ # if (is.character(chk <- checkData(x))) stop("bad phylo4d object: ",chk) <- needed?
+
+ ## if(!require(ape)) stop("the ape package is required")
+ if(cex.label<0.1) {
+ show.tip.label <- FALSE
+ show.node.label <- FALSE
+ show.var.label <- FALSE
+ }
+
+ cex <- par("cex")
+ symbol <- match.arg(symbol)
+ treetype <- match.arg(treetype)
+
+ SYMBSCALE <- 0.2 # i.e. max size of a plotted symbol is 0.2*cex.symbol inches
+ if(symbol=="colors") {
+ SYMBSCALE <- 0.05
+ }
+
+ ## convert the tree into phylo
+ tre <- suppressWarnings(as(x,"phylo"))
+ ##tre$node.label <- x at node.label # this should be done by the as(x,"phylo")
+ ## plot only tree if no tip data
+ if(ncol(tdata(x,type="tip")) == 0) {
+ plot(tre, type=treetype, direction="rightwards", show.tip.label=show.tip.label,
+ show.node.label=show.node.label, cex=cex.label,
+ no.margin=FALSE, x.lim=NULL, y.lim=NULL, ...)
+ return(invisible())
+ }
+
+#### data handling
+ ## retrieve data
+ dat <- tdata(x, type="tip")
+ dat <- dat[, repVar, drop=FALSE]
+ clas <- lapply(dat,class)
+ isNum <- sapply(clas, function(e) e %in% c("integer","numeric"))
+ ## keep only numeric data
+ dat <- dat[, isNum, drop=FALSE]
+ var.label <- var.label[repVar]
+ var.label <- var.label[isNum]
+ ## order data like tips
+ E <- phylobase::edges(x)
+ tips.ord <- E[,2][!E[,2] %in% E[,1]]
+ dat <- dat[tips.ord,,FALSE]
+ tip.label <- tip.label[tips.ord] # reorder tip labels
+ ## centring / scaling
+ dat <- as.data.frame(scale(dat,center=center,scale=scale))
+
+ ## compute bottom margin
+ ## ! use inches as units still these won't be changed by plot.phylo
+ temp <- var.label[which.max(nchar(var.label))] # longest tip label
+ lab.height <- strwidth(temp, units="inches", cex=cex.label) # height required by the longest var label
+ lab.height <- lab.height / par("pin")[1] # returned as a fraction of the plot region
+
+#### define plot region
+ plotreg <- plotreg0 <- par("plt")
+ plotreg.width <- plotreg0[2] - plotreg0[1]
+ plotreg.height <- plotreg0[4] - plotreg0[3]
+ plotreg[2] <- plotreg[1] + (ratio.tree)*plotreg.width # restrain the width for phylo
+ plotreg[3] <- plotreg[3] + plotreg.height*ifelse(show.var.label,lab.height+0.05,0.05) ## add internal vertical margins
+ plotreg[4] <- plotreg[4] - plotreg.height*0.05 # add internal vertical margins
+
+#### plot the tree
+ par(plt = plotreg)
+ plotres <- plot(tre, type=treetype, direction="rightwards", show.tip.label=FALSE,
+ show.node.label=show.node.label, cex=cex.label,
+ no.margin=FALSE, x.lim=NULL, y.lim=NULL, ...)
+
+#### plot the data
+ par(plt=plotreg0)
+ cur.usr.width <- par("usr")[2] - par("usr")[1] # beware: par("usr") does not adapt to the new plot region
+ usr.width <- cur.usr.width / ratio.tree
+ usr.height <- par("usr")[4] - par("usr")[3]
+
+ ## x.inset is the space between tree/data and data/tip.labels (in usr units)
+ x.inset <- SYMBSCALE * cex.symbol * usr.width / par("pin")[1]
+ y.inset <- SYMBSCALE * cex.symbol * usr.height / par("pin")[2]
+ x.base <- plotres$x.lim[2] + x.inset # start plotting from x.base rightwards
+ if(show.tip.label){
+ temp <- tipLabels(x)[which.max(nchar(tipLabels(x)))] # longest tip label
+ lab.width <- strwidth(temp, units="user", cex=cex.label) # compute the width to keep for tip labels
+ } else{
+ lab.width <- 0
+ }
+ xrange.data <- c(x.base , (par("usr")[1]+usr.width) - lab.width - 2*x.inset) # plot data within this range
+
+ ## if(diff(xrange.data) < (x.inset*ncol(dat))) ("No room left to plot data; please try reducing ratio.tree or cex.label.")
+ if(diff(xrange.data) < (x.inset*ncol(dat))) warning("There may not be enough room left to plot data; you may consider reducing ratio.tree or cex.label.")
+
+ ## define x and y coordinates
+ x.grid <- seq(xrange.data[1],xrange.data[2], length=ncol(dat))
+ if(ncol(dat)==1) {x.grid <- mean(c(xrange.data[1],xrange.data[2]))}
+ y.grid <- seq(plotres$y.lim[1],plotres$y.lim[2],length=plotres$Ntip)
+ temp <- expand.grid(y.grid, x.grid) # here are coordinates for data
+ xy.data <- data.frame(x=temp[,2],y=temp[,1])
+
+ ## merge data and their coordinates
+ alldat <- cbind.data.frame(xy.data, unlist(dat))
+ ## fac <- factor(rep(1:ncol(dat), rep(nrow(dat),ncol(dat))))
+ ## alldat <- split(alldat, fac)
+
+ ## need to "reboot" the plot region without changing coordinates
+ ## seems that box does the job.
+ if(box) {box()} else {box(col="transparent")}
+ if(grid){
+ ## vertical segments
+ segments(x0=x.grid, y0=rep(min(y.grid),plotres$Ntip),
+ x1=x.grid, y1=rep(max(y.grid),plotres$Ntip), col="grey")
+ ## horizontal segments
+ segments(x0=rep(min(x.grid),plotres$Ntip), y0=y.grid,
+ x1=rep(max(x.grid),plotres$Ntip), y1=y.grid, col="grey")
+ }
+
+
+ ## auxiliary function to translate a variable into colors
+ makeColors <- function(x, col){ # x is a numeric vector, col is a vector of colors
+ if(length(x)==1) return(col[1])
+ nCol <- length(col)
+ res <- x - min(x)
+ res <- res / max(res)
+ res <- res * (nCol-1) + 1
+ res <- round(res)
+ res[res>nCol] <- nCol
+ res[res<1] <- 1
+ return(col[res])
+ }
+
+
+ ## auxiliary function to plot a single variable
+ ## max size of a symbol is set to SYMBSCALE*cex inches
+ plotaux <- function(x,y,var,symbol,cex){
+ if(any(var[!is.na(var)]<0)) {
+ usebw <- TRUE
+ } else {
+ usebw <- FALSE
+ }
+
+ if(usebw){
+ ispos <- var>0
+ fg.col <- rep("black",length(var))
+ fg.col[ispos] <- "white"
+ bg.col <- rep("white",length(var))
+ bg.col[ispos] <- "black"
+
+ if(symbol == "squares"){
+ symbols(x=x, y=y, squares=abs(var), inches=SYMBSCALE*cex, fg=fg.col, bg=bg.col, add=TRUE)
+ } # end squares
+
+ if(symbol == "circles"){
+ symbols(x=x, y=y, circles=abs(var), inches=SYMBSCALE*cex, fg=fg.col, bg=bg.col, add=TRUE)
+ } # end circles
+
+ if(symbol == "colors"){
+ myCol <- makeColors(var, col)
+ points(x=x, y=y, pch=pch, cex=cex, col=myCol)
+ } # end colors
+
+ } else {
+
+ if(symbol == "squares"){
+ symbols(x=x, y=y, squares=var, inches=SYMBSCALE*cex, fg="white", bg="black", add=TRUE)
+ } # end squares
+
+ if(symbol == "circles"){
+ symbols(x=x, y=y, circles=var, inches=SYMBSCALE*cex, fg="white", bg="black", add=TRUE)
+ } # end circles
+
+ if(symbol == "colors"){
+ myCol <- makeColors(var, col)
+ points(x=x, y=y, pch=pch, cex=cex, col=myCol)
+ } # end colors
+
+ } # end else
+
+ if(any(is.na(var))){
+ isNA <- is.na(var)
+ points(x[isNA],y[isNA],pch=4,cex=cex.symbol)
+ }
+ } # end plotaux
+
+
+ ## finally plot the data
+ ## carefull : all variables must be plotted in as a single vector, so that
+ ## scaling is the same for all variables
+ ## lapply(alldat, function(X) plotaux(X[,1],X[,2],X[,3],symbol,cex.symbol))
+ plotaux(alldat[,1],alldat[,2],alldat[,3],symbol,cex.symbol)
+
+#### plot labels for variables
+ if(show.var.label) text(x=x.grid, y=rep(min(y.grid)-1.5*y.inset, ncol(dat)), lab=var.label,
+ adj=1, srt=90, cex=cex.label)
+
+#### plot tip labels
+ if(show.tip.label){
+ x.base <- xrange.data[2] + x.inset
+ text(x=rep(x.base,plotres$Ntip), y=1:plotres$Ntip, lab=tip.label, font=font, cex=cex.label, pos=4)
+ }
+
+#### add a legend for symbols
+ if(legend){
+
+ ## Auxiliary function to add the legend
+ ## (x,y): coordinates of the lower-left annotation
+ ## z: a numeric vector whose values are being legended
+ addLegend <- function(x,y,z,cex.legend,cex.label,cex.symbol){
+ z <- z*cex.legend
+ leg.values <- pretty(z,n=4, min.n=1)
+ temp <- length(leg.values)
+ ## make sure to get maximum 4 symbols
+ if(temp>4) {
+ leg.values <- leg.values[c(1,2,temp-1,temp)]
+ }
+
+ leg.txt <- as.character(leg.values)
+
+ ## compute the maximum size taken by symbols in usr coordinates
+ if(symbol=="colors") {
+ sym.w <-strwidth("o",units="user",cex=cex.symbol)
+ sym.w <- rep(sym.w, length(leg.values))
+ sym.h <- strheight("o",units="user",cex=cex.symbol)
+ sym.h <- rep(sym.h, length(leg.values))
+ } else {
+ usr.w <- (par("usr")[2]-par("usr")[1]) / ratio.tree # because par("usr") is the one of plot.phylo
+ usr.h <- par("usr")[4]-par("usr")[3]
+ sym.w <- usr.w *
+ ((abs(leg.values)/max(abs(leg.values))) * SYMBSCALE * cex.symbol * cex.legend) / par("pin")[1]
+ sym.h <- usr.h * (SYMBSCALE * cex.symbol * cex.legend) / par("pin")[2]
+ }
+
+ ## compute the maximum size taken by annotations in usr coordinates
+ ann.w <- strwidth(leg.txt,units="user",cex=cex.label*cex.legend)
+ ann.h <- strheight(leg.txt,units="user",cex=cex.label*cex.legend)
+
+ ## retain relevant spaces between symbols / annotations
+ space.w.sym <- sapply(1:(length(sym.w)-1),function(i) sum(sym.w[c(i,i+1)]))
+ space.w.ann <- sapply(1:(length(ann.w)-1),function(i) sum(ann.w[c(i,i+1)])) / 2
+ temp <- cbind(space.w.sym, space.w.ann)
+ space.w <- apply(temp,1,max)
+ if(symbol=="colors"){
+ space.h <- sym.h + ann.h
+ } else {
+ space.w <- space.w + 0.01*usr.w
+ space.h <- sym.h + ann.h + 0.01*usr.h
+ }
+
+ ## define coordinates of annotations and symbols
+ ann.coordX <- c(x, x + cumsum(space.w)) + max(sym.w[1],ann.w[1]) + 0.01*usr.w
+ ann.coordY <- y
+ sym.coordX <- ann.coordX
+ sym.coordY <- y + space.h
+
+ ## plot annotations
+ text(ann.coordX, ann.coordY, leg.txt, cex=cex.label*cex.legend)
+
+ ## plot symbols
+ plotaux(sym.coordX, sym.coordY, leg.values, symbol, cex.symbol*cex.legend)
+ } # end addLegend
+
+ if(!is.null(coord.legend)){
+ x.leg <- coord.legend$x
+ y.leg <- coord.legend$y
+ } else {
+ usr.w <- (par("usr")[2]-par("usr")[1]) / ratio.tree
+ usr.h <- par("usr")[4]-par("usr")[3]
+
+ temp <- lab.height * usr.height / (1 - lab.height) ## need to substract temp from par("usr")[3]
+ y.base <- par("usr")[3] - temp - y.inset ## to get closer the actual par("usr")[3] !
+
+ x.leg <- par("usr")[1] + 0.01 * usr.w
+ y.leg <- y.base ## remember to use y.base instead of par("usr3")[3], which is wrong
+ }
+
+ addLegend(x=x.leg, y=y.leg, z=alldat[,3],
+ cex.legend=cex.legend, cex.label=cex.label, cex.symbol=cex.symbol)
+ ## FIXME ##
+ ## draw a rectangle around the legend
+ #rect.size <- c(diff(range(leg.x)) , diff(c(y.base, max(leg.y))) )
+ #rect(min(leg.x)- rect.size[1]*0.05,
+ # min(y.base) - rect.size[2]*0.05,
+ # max(leg.x) + rect.size[1]*0.05,
+ # max(y.base) + rect.size[2]*0.05)
+ } ## end legend
+
+ return(invisible())
+} # end table.phylo4d
diff --git a/R/utils.R b/R/utils.R
new file mode 100644
index 0000000..1c70543
--- /dev/null
+++ b/R/utils.R
@@ -0,0 +1,288 @@
+#' Low-level auxiliary functions for adephylo
+#'
+#' These hidden functions are utils for adephylo, used by other functions.
+#' Regular users can use them as well, but no validity checks are performed for
+#' the arguments: speed is here favored over safety. Most of these functions
+#' handle trees inheriting \linkS4class{phylo4} class.\cr
+#'
+#' \code{.tipToRoot} finds the set of nodes between a tip and the root of a
+#' tree.\cr
+#'
+#'
+#' @rdname miscUtils
+#' @aliases .tipToRoot
+#' @param x A valid tree of class \linkS4class{phylo4}.
+#' @param tip An integer identifying a tip by its numbers.
+#' @param root An integer identifying the root of the tree by its number.
+#' @param include.root a logical stating whether the root must be included as a
+#' node of the path from tip to root (TRUE), or not (FALSE, default).
+#' @return \code{.tipToRoot}: a vector of named integers identifying nodes.\cr
+#' @author Thibaut Jombart \email{tjombart@@imperial.ac.uk}
+#' @keywords manip
+#' @examples
+#'
+#' if(require(ape) & require(phylobase)){
+#' ## make a tree
+#' x <- as(rtree(20),"phylo4")
+#' plot(x,show.node=TRUE)
+#'
+#' ## .tipToRoot
+#' root <- rootNode(x)
+#' .tipToRoot(x, 1, root)
+#' lapply(1:nTips(x), function(i) .tipToRoot(x, i, root))
+#' }
+#'
+#' @import phylobase
+#' @export
+.tipToRoot <- function(x, tip, root, include.root=FALSE){
+ E <- x at edge
+ path <- NULL
+ curNode <- tip
+ while(curNode != root){
+ curNode <- E[(curNode==E[,2]),1] # one node <- its ancestor
+ path <- c(path, curNode)
+ } # end while
+
+ if(!include.root) {
+ path <- path[-length(path)] # exclude the root
+ }
+
+ return(getNode(x, path))
+} # end tipToRoot
+
+
+
+
+
+##########
+# sp.tips
+##########
+
+
+#' Find the shortest path between tips of a tree
+#'
+#' The function \code{sp.tips} finds the shortest path between tips of a tree,
+#' identified as \code{tip1} and \code{tip2}. This function applies to trees
+#' with the class \code{\link[ape:read.tree]{phylo}}, \linkS4class{phylo4} or
+#' \linkS4class{phylo4d}. Several tips can be provided at a time.
+#'
+#' The function checks if there are cases where tip1 and tip2 are the same.
+#' These cases are deleted when detected, issuing a warning (unless
+#' \code{quiet} is set to TRUE).
+#'
+#' @param x A tree of class \code{\link[ape:read.tree]{phylo}},
+#' \linkS4class{phylo4} or \linkS4class{phylo4d}.
+#' @param tip1 A vector of integers identifying tips by their numbers, or a
+#' vector of characters identifying tips by their names. Recycled if needed.
+#' @param tip2 A vector of integers identifying tips by their numbers, or a
+#' vector of characters identifying tips by their names. Recycled if needed.
+#' @param useTipNames a logical stating whether the output must be named using
+#' tip names in all cases (TRUE), or not (FALSE). If not, names of \code{tip1}
+#' and \code{tip2} will be used.
+#' @param quiet a logical stating whether a warning must be issued when
+#' tip1==tip2, or not (see details).
+#' @param include.mrca a logical stating whether the most recent common
+#' ancestor shall be included in the returned path (TRUE, default) or not
+#' (FALSE).
+#' @return A list whose components are vectors of named nodes forming the
+#' shortest path between a couple of tips.
+#' @author Thibaut Jombart \email{tjombart@@imperial.ac.uk}
+#' @seealso \code{\link[phylobase]{shortestPath}} which does the same thing as
+#' \code{sp.tips}, for any node (internal or tip), but much more slowly. \cr
+#' @keywords manip
+#' @examples
+#'
+#' \dontrun{
+#' if(require(ape) & require(phylobase)){
+#' ## make a tree
+#' x <- as(rtree(20),"phylo4")
+#' plot(x,show.node=TRUE)
+#' ## get shortest path between tip 1 and all other tips.
+#' sp.tips(x, "t1", "t2")
+#' sp.tips(x, 1, 2:20, TRUE)
+#' }
+#' }
+#'
+#' @import phylobase
+#' @export sp.tips
+sp.tips <- function(x, tip1, tip2, useTipNames=FALSE, quiet=FALSE, include.mrca=TRUE){
+ ## if(!require(phylobase)) stop("phylobase package is not installed")
+
+ ## conversion from phylo, phylo4 and phylo4d
+ x <- as(x, "phylo4")
+
+ ## some checks
+ if (is.character(checkval <- checkPhylo4(x))) stop(checkval)
+ t1 <- getNode(x, tip1)
+ t2 <- getNode(x, tip2)
+ if(any(is.na(c(t1,t2)))) stop("wrong tip specified")
+ if(any(c(t1,t2) > nTips(x))) stop("specified nodes are internal nodes")
+ if(length(t1) != length(t2)) { # recycle tip1 and tip2
+ maxLength <- max(length(t1), length(t2))
+ t1 <- rep(t1, length.out=maxLength)
+ t2 <- rep(t2, length.out=maxLength)
+ }
+ toRemove <- (t1==t2)
+ if(sum(toRemove)>0) {
+ t1 <- t1[!toRemove]
+ t2 <- t2[!toRemove]
+ if(length(t1)==0) stop("tip1 and tip2 are the same vectors")
+ if(!quiet) warning("tip1 and tip2 are sometimes the same; erasing these cases")
+ }
+
+
+ ## some global variables
+ N <- nTips(x)
+ root <- getNode(x, N+1)
+ E <- x at edge
+ allTips <- unique(c(t1,t2))
+
+
+ ## ## tipToRoot -> call to .tipToRoot
+ ## tipToRoot <- function(E, tip){
+ ## path <- NULL
+ ## curNode <- tip
+ ## while(curNode != root){
+ ## curNode <- E[(curNode==E[,2]),1] # one node <- its ancestor
+ ## path <- c(path, curNode)
+ ## } # end while
+
+ ## path <- getNode(x, path)
+ ## return(path)
+ ## } # end tipToRoot
+
+
+ ## function pathTwoTips (takes two path-to-root as args)
+ pathTwoTips <- function(path1, path2){
+ cpath <- c(path1, rev(path2))
+ temp <- factor(cpath, levels=unique(cpath))
+ CA <- temp[table(temp)==2][1] # most recent common ancestor (MRCA)
+ CA <- as.integer(as.character(CA)) # retrieve integer type
+ path1 <- path1[1:(which(path1==CA))] # cut path1 after MRCA (keep MRCA)
+ temp <- which(path2==CA)
+ if(temp==1) return(path1)
+ path2 <- path2[1:(temp-1)] # cut path2 after MRCA (erase MRCA)
+ return(c(path1,path2))
+ } # end pathTwoTips
+
+
+ pathTwoTips.no.mrca <- function(path1, path2){
+ cpath <- c(path1, rev(path2))
+ temp <- intersect(path1, path2)
+ res <- setdiff(cpath, temp)
+ return(res)
+ } # end pathTwoTips
+
+
+
+ ## main computations
+ allPathToRoot <- lapply(allTips, function(i) .tipToRoot(x, i, root, include.root=TRUE))
+ names(allPathToRoot) <- allTips
+
+ allPath1 <- allPathToRoot[as.character(t1)]
+ allPath2 <- allPathToRoot[as.character(t2)]
+
+ if(include.mrca) {
+ res <- lapply(1:length(allPath1), function(i) pathTwoTips(allPath1[[i]], allPath2[[i]]) )
+ } else {
+ res <- lapply(1:length(allPath1), function(i) pathTwoTips.no.mrca(allPath1[[i]], allPath2[[i]]) )
+ temp.names <- names(res)
+ temp <- sapply(res, function(vec) length(vec)>0)
+ res[temp] <- lapply(res[temp], function(vec) getNode(x, vec) ) # name the nodes
+ names(res) <- temp.names
+ }
+
+ if(useTipNames) {
+ names(res) <- paste(names(t1), names(t2), sep="-")
+ } else {
+ names(res) <- paste(t1,t2,sep="-")
+ }
+
+ return(res)
+} # end sp.tips
+
+
+
+# examples
+# source("/home/master/dev/adephylo/pkg/R/utils.R")
+#phy <- as(rtree(15),"phylo4")
+## plot(phy,show.n=T)
+## tip1 <- "t1"
+## tip2 <- "t2"
+
+
+## sp.tips(phy, "t1", "t2")
+## sp.tips(phy, rep(1,15), 1:15)
+## sp.tips(phy, rep(1, 15), 1:15, TRUE)
+
+## heavier tree
+# x <- as(rtree(1000), "phylo4")
+# system.time(sp.tips(x,1,1:1000))
+
+
+
+
+
+############
+# listDD
+############
+
+
+#' List direct descendants for all nodes of a tree
+#'
+#' The function \code{listDD} lists the direct descendants from each node of a
+#' tree. The tree can be of class \code{\link[ape:read.tree]{phylo}},
+#' \linkS4class{phylo4} or \linkS4class{phylo4d}.
+#'
+#'
+#' @param x A tree of class \code{\link[ape:read.tree]{phylo}},
+#' \linkS4class{phylo4} or \linkS4class{phylo4d}.
+#' @param nameBy a character string indicating whether the returned list must
+#' be named by node labels ("label") or by node numbers ("number").
+#' @return A list whose components are vectors of named nodes (or tips) for a
+#' given internal node.
+#' @author Thibaut Jombart \email{tjombart@@imperial.ac.uk}
+#' @seealso \code{\link{listTips}} which lists the tips descending from each
+#' node. \cr
+#'
+#' \code{\link{treePart}} which defines partitions of tips according to the
+#' tree topology.
+#' @keywords manip
+#' @examples
+#'
+#' if(require(ape) & require(phylobase)){
+#' ## make a tree
+#' x <- as(rtree(20),"phylo4")
+#' plot(x,show.node=TRUE)
+#' listDD(x)
+#' }
+#'
+#' @import phylobase
+#' @export listDD
+listDD <- function(x, nameBy=c("label","number")){
+ ## if(!require(phylobase)) stop("phylobase package is not installed")
+
+ ## conversion from phylo, phylo4 and phylo4d
+ x <- as(x, "phylo4")
+ nameBy <- match.arg(nameBy)
+
+ ## check phylo4 object
+ if (is.character(checkval <- checkPhylo4(x))) stop(checkval)
+
+ ## computations
+ nodIdx <- nTips(x)+1
+ nodIdx <- nodIdx:(nodIdx+nNodes(x)-1)
+ res <- lapply(nodIdx, function(i) children(x, i))
+
+ if(hasNodeLabels(x) & nameBy=="label") {
+ names(res) <- nodeLabels(x)
+ } else {
+ names(res) <- nodIdx
+ }
+
+ return(res)
+} # end listDD
+
+
+
+
diff --git a/R/zzz.R b/R/zzz.R
new file mode 100644
index 0000000..2f600df
--- /dev/null
+++ b/R/zzz.R
@@ -0,0 +1,3 @@
+## .First.lib <- function (lib, pkg){
+## library.dynam("adephylo", pkg, lib)
+## }
diff --git a/build/vignette.rds b/build/vignette.rds
new file mode 100644
index 0000000..2d1ee59
Binary files /dev/null and b/build/vignette.rds differ
diff --git a/data/carni19.RData b/data/carni19.RData
new file mode 100644
index 0000000..f5cafb6
Binary files /dev/null and b/data/carni19.RData differ
diff --git a/data/carni70.RData b/data/carni70.RData
new file mode 100644
index 0000000..c58f50e
Binary files /dev/null and b/data/carni70.RData differ
diff --git a/data/lizards.RData b/data/lizards.RData
new file mode 100644
index 0000000..da2f10c
Binary files /dev/null and b/data/lizards.RData differ
diff --git a/data/maples.RData b/data/maples.RData
new file mode 100644
index 0000000..e8ccd6f
Binary files /dev/null and b/data/maples.RData differ
diff --git a/data/mjrochet.RData b/data/mjrochet.RData
new file mode 100644
index 0000000..c1d1456
Binary files /dev/null and b/data/mjrochet.RData differ
diff --git a/data/palm.RData b/data/palm.RData
new file mode 100644
index 0000000..de2fbbd
Binary files /dev/null and b/data/palm.RData differ
diff --git a/data/procella.RData b/data/procella.RData
new file mode 100644
index 0000000..b001380
Binary files /dev/null and b/data/procella.RData differ
diff --git a/data/tithonia.RData b/data/tithonia.RData
new file mode 100644
index 0000000..65bf0c3
Binary files /dev/null and b/data/tithonia.RData differ
diff --git a/data/ungulates.RData b/data/ungulates.RData
new file mode 100644
index 0000000..70510f0
Binary files /dev/null and b/data/ungulates.RData differ
diff --git a/debian/README.test b/debian/README.test
deleted file mode 100644
index 57396d7..0000000
--- a/debian/README.test
+++ /dev/null
@@ -1,8 +0,0 @@
-Notes on how this package can be tested.
-────────────────────────────────────────
-
-This package can be tested by running the provided test:
-
- sh run-unit-test
-
-in order to confirm its integrity.
diff --git a/debian/changelog b/debian/changelog
deleted file mode 100644
index ce4f11a..0000000
--- a/debian/changelog
+++ /dev/null
@@ -1,23 +0,0 @@
-r-cran-adephylo (1.1-10-2) unstable; urgency=medium
-
- * Fix autopkgtest
-
- -- Andreas Tille <tille at debian.org> Sun, 15 Jan 2017 21:12:39 +0100
-
-r-cran-adephylo (1.1-10-1) unstable; urgency=medium
-
- * New upstream version
- * Fix cut-n-pasto (thanks to Michael Hudson-Doyle)
- * Convert to dh-r
- * Canonical homepage for CRAN
- * Update d/copyright
- * d/watch: version=4
- * debhelper 10
-
- -- Andreas Tille <tille at debian.org> Tue, 20 Dec 2016 11:19:17 +0100
-
-r-cran-adephylo (1.1-6-1) unstable; urgency=low
-
- * Initial release (Closes: #828962)
-
- -- Andreas Tille <tille at debian.org> Wed, 29 Jun 2016 14:56:07 +0200
diff --git a/debian/compat b/debian/compat
deleted file mode 100644
index f599e28..0000000
--- a/debian/compat
+++ /dev/null
@@ -1 +0,0 @@
-10
diff --git a/debian/control b/debian/control
deleted file mode 100644
index d068f64..0000000
--- a/debian/control
+++ /dev/null
@@ -1,27 +0,0 @@
-Source: r-cran-adephylo
-Maintainer: Debian Med Packaging Team <debian-med-packaging at lists.alioth.debian.org>
-Uploaders: Andreas Tille <tille at debian.org>
-Section: gnu-r
-Priority: optional
-Build-Depends: debhelper (>= 10),
- dh-r,
- r-base-dev,
- r-cran-ade4,
- r-cran-ape,
- r-cran-phylobase,
- r-cran-adegenet
-Standards-Version: 3.9.8
-Vcs-Browser: https://anonscm.debian.org/viewvc/debian-med/trunk/packages/R/r-cran-adephylo/trunk/
-Vcs-Svn: svn://anonscm.debian.org/debian-med/trunk/packages/R/r-cran-adephylo/trunk/
-Homepage: https://cran.r-project.org/package=adephylo
-
-Package: r-cran-adephylo
-Architecture: any
-Depends: ${misc:Depends},
- ${shlibs:Depends},
- ${R:Depends}
-Recommends: ${R:Recommends}
-Suggests: ${R:Suggests}
-Description: GNU R exploratory analyses for the phylogenetic comparative method
- This GNU R package provides multivariate tools to analyze comparative
- data, i.e. a phylogeny and some traits measured for each taxa.
diff --git a/debian/copyright b/debian/copyright
deleted file mode 100644
index 2047347..0000000
--- a/debian/copyright
+++ /dev/null
@@ -1,32 +0,0 @@
-Format: https://www.debian.org/doc/packaging-manuals/copyright-format/1.0/
-Upstream-Contact: Stéphane Dray <stephane.dray at univ-lyon1.fr>
-Upstream-Name: adephylo
-Source: https://cran.r-project.org/package=adephylo
-
-Files: *
-Copyright: 2013-2016 Thibaut Jombart <thibautjombart at gmail.com>,
- Stephane Dray <stephane.dray at univ-lyon1.fr>,
- Anders Ellern Bilgrau
-License: GPL-2+
-
-Files: debian/*
-Copyright: 2016 Andreas Tille <tille at debian.org>
-License: GPL-2+
-
-License: GPL-2+
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- (at your option) any later version.
- .
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
- .
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
- .
- On Debian systems, the complete text of the GNU General Public
- License can be found in `/usr/share/common-licenses/GPL-2'.
diff --git a/debian/docs b/debian/docs
deleted file mode 100644
index 9a4f4f8..0000000
--- a/debian/docs
+++ /dev/null
@@ -1,2 +0,0 @@
-debian/README.test
-debian/tests/run-unit-test
diff --git a/debian/examples b/debian/examples
deleted file mode 100644
index 18244c8..0000000
--- a/debian/examples
+++ /dev/null
@@ -1 +0,0 @@
-vignettes
diff --git a/debian/rules b/debian/rules
deleted file mode 100755
index 68d9a36..0000000
--- a/debian/rules
+++ /dev/null
@@ -1,4 +0,0 @@
-#!/usr/bin/make -f
-
-%:
- dh $@ --buildsystem R
diff --git a/debian/source/format b/debian/source/format
deleted file mode 100644
index 163aaf8..0000000
--- a/debian/source/format
+++ /dev/null
@@ -1 +0,0 @@
-3.0 (quilt)
diff --git a/debian/tests/control b/debian/tests/control
deleted file mode 100644
index b044b0c..0000000
--- a/debian/tests/control
+++ /dev/null
@@ -1,3 +0,0 @@
-Tests: run-unit-test
-Depends: @, r-cran-testthat
-Restrictions: allow-stderr
diff --git a/debian/tests/run-unit-test b/debian/tests/run-unit-test
deleted file mode 100644
index d29ed52..0000000
--- a/debian/tests/run-unit-test
+++ /dev/null
@@ -1,19 +0,0 @@
-#!/bin/sh -e
-oname=adephylo
-pkg=r-cran-`echo $oname | tr '[A-Z]' '[a-z]'`
-
-if [ "$ADTTMP" = "" ] ; then
- ADTTMP=`mktemp -d /tmp/${pkg}-test.XXXXXX`
- trap "rm -rf $ADTTMP" 0 INT QUIT ABRT PIPE TERM
-fi
-cd $ADTTMP
-cp -a /usr/share/doc/$pkg/examples/vignettes/* $ADTTMP
-find . -name "*.gz" -exec gunzip \{\} \;
-for rnw in `ls *.[rRS]nw` ; do
-rfile=`echo $rnw | sed 's/\.[rRS]nw/.R/'`
-R --no-save <<EOT
- Stangle("$rnw")
- source("$rfile", echo=TRUE)
-EOT
- echo "$rnw passed"
-done
diff --git a/debian/upstream/metadata b/debian/upstream/metadata
deleted file mode 100644
index 190a826..0000000
--- a/debian/upstream/metadata
+++ /dev/null
@@ -1,12 +0,0 @@
-Reference:
- Author: Thibaut Jombart and François Balloux and Stéphane Dray
- Title: "adephylo: new tools for investigating the phylogenetic signal in biological traits"
- Journal: Bioinformatics
- Year: 2010
- Volume: 26
- Number: 15
- Pages: 1907-1909
- DOI: 10.1093/bioinformatics/btq292
- PMID: 20525823
- URL: http://bioinformatics.oxfordjournals.org/content/26/15/1907
- eprint: http://bioinformatics.oxfordjournals.org/content/26/15/1907.full.pdf+html
diff --git a/debian/watch b/debian/watch
deleted file mode 100644
index b6a2fbc..0000000
--- a/debian/watch
+++ /dev/null
@@ -1,3 +0,0 @@
-version=4
-http://cran.r-project.org/src/contrib/adephylo_([-0-9\.]*).tar.gz
-
diff --git a/inst/CITATION b/inst/CITATION
new file mode 100644
index 0000000..4011a03
--- /dev/null
+++ b/inst/CITATION
@@ -0,0 +1,13 @@
+citHeader("To cite the adephylo package:")
+
+citEntry(
+entry="Article",
+title = "adephylo: exploratory analyses for the phylogenetic comparative method.",
+journal= "Bioinformatics",
+year = "2010",
+author = "T. Jombart, S. Dray",
+volume = "26",
+pages = "1907-1909",
+doi = "10.1093/bioinformatics/btq292",
+textVersion = "Jombart T., Dray S. (2008) adephylo: exploratory analyses for the phylogenetic comparative method."
+)
diff --git a/inst/doc/adephylo.R b/inst/doc/adephylo.R
new file mode 100644
index 0000000..7b00a7e
--- /dev/null
+++ b/inst/doc/adephylo.R
@@ -0,0 +1,283 @@
+### R code from vignette source 'adephylo.Rnw'
+### Encoding: UTF-8
+
+###################################################
+### code chunk number 1: adephylo.Rnw:105-106 (eval = FALSE)
+###################################################
+## vignette("phylobase")
+
+
+###################################################
+### code chunk number 2: load
+###################################################
+library(ape)
+library(phylobase)
+library(ade4)
+library(adephylo)
+search()
+
+
+###################################################
+### code chunk number 3: kludge
+###################################################
+cat("\n=== Old - deprecated- version ===\n")
+orthogram <- ade4::orthogram
+args(orthogram)
+cat("\n=== New version === \n")
+orthogram <- adephylo::orthogram
+args(orthogram)
+
+
+###################################################
+### code chunk number 4: adephylo.Rnw:168-169 (eval = FALSE)
+###################################################
+## ?adephylo
+
+
+###################################################
+### code chunk number 5: adephylo.Rnw:174-175 (eval = FALSE)
+###################################################
+## help("adephylo", package="adephylo", html=TRUE)
+
+
+###################################################
+### code chunk number 6: adephylo.Rnw:179-180 (eval = FALSE)
+###################################################
+## options(htmlhelp = FALSE)
+
+
+###################################################
+### code chunk number 7: readTree
+###################################################
+data(ungulates)
+ungulates$tre
+myTree <- read.tree(text=ungulates$tre)
+myTree
+plot(myTree, main="ape's plotting of a tree")
+
+
+###################################################
+### code chunk number 8: adephylo.Rnw:226-231
+###################################################
+temp <- as(myTree, "phylo4")
+class(temp)
+temp <- as(temp, "phylo")
+class(temp)
+all.equal(temp, myTree)
+
+
+###################################################
+### code chunk number 9: phylo4d
+###################################################
+ung <- phylo4d(myTree, ungulates$tab)
+class(ung)
+table.phylo4d(ung)
+
+
+###################################################
+### code chunk number 10: adephylo.Rnw:271-273
+###################################################
+x <- tdata(ung, type="tip")
+head(x)
+
+
+###################################################
+### code chunk number 11: moranI
+###################################################
+W <- proxTips(myTree, met="Abouheif")
+moran.idx(tdata(ung, type="tip")$afbw, W)
+moran.idx(tdata(ung, type="tip")[,1], W, addInfo=TRUE)
+
+
+###################################################
+### code chunk number 12: adephylo.Rnw:320-332
+###################################################
+afbw <- tdata(ung, type="tip")$afbw
+sim <- replicate(499, moran.idx(sample(afbw), W)) # permutations
+sim <- c(moran.idx(afbw, W), sim)
+
+cat("\n=== p-value (right-tail) === \n")
+pval <- mean(sim>=sim[1])
+pval
+
+plot(density(sim), main="Moran's I Monte Carlo test for 'bif'") # plot
+mtext("Density of permutations, and observation (in red)")
+abline(v=sim[1], col="red", lwd=3)
+
+
+
+###################################################
+### code chunk number 13: abouheif
+###################################################
+ung.abTests <- abouheif.moran(ung)
+ung.abTests
+plot(ung.abTests)
+
+
+###################################################
+### code chunk number 14: adephylo.Rnw:376-378
+###################################################
+hasEdgeLength(ung)
+myTree.withBrLe <- compute.brlen(myTree)
+
+
+###################################################
+### code chunk number 15: adephylo.Rnw:384-386
+###################################################
+myProx <- vcv.phylo(myTree.withBrLe)
+abouheif.moran(ung, W=myProx)
+
+
+###################################################
+### code chunk number 16: adephylo.Rnw:413-415
+###################################################
+x <- as(rtree(5),"phylo4")
+plot(x,show.n=TRUE)
+
+
+###################################################
+### code chunk number 17: adephylo.Rnw:418-420
+###################################################
+x.part <- treePart(x)
+x.part
+
+
+###################################################
+### code chunk number 18: adephylo.Rnw:423-425
+###################################################
+temp <- phylo4d(x, x.part)
+table.phylo4d(temp, cent=FALSE, scale=FALSE)
+
+
+###################################################
+### code chunk number 19: adephylo.Rnw:435-437
+###################################################
+args(treePart)
+temp <- phylo4d(x, treePart(x, result="orthobasis") )
+
+
+###################################################
+### code chunk number 20: orthobas1
+###################################################
+temp <- phylo4d(myTree, treePart(myTree, result="orthobasis") )
+par(mar=rep(.1,4))
+table.phylo4d(temp, repVar=1:8, ratio.tree=.3)
+
+
+###################################################
+### code chunk number 21: orthogram
+###################################################
+afbw.ortgTest <- orthogram(afbw, myTree)
+afbw.ortgTest
+
+
+###################################################
+### code chunk number 22: adephylo.Rnw:483-484
+###################################################
+me.phylo(myTree.withBrLe)
+
+
+###################################################
+### code chunk number 23: figFourBas
+###################################################
+ung.listBas <- list()
+ung.listBas[[1]] <- phylo4d(myTree, as.data.frame(me.phylo(myTree.withBrLe, method="patristic")))
+ung.listBas[[2]] <- phylo4d(myTree, as.data.frame(me.phylo(myTree, method="nNodes")))
+ung.listBas[[3]]<- phylo4d(myTree, as.data.frame(me.phylo(myTree, method="Abouheif")))
+ung.listBas[[4]] <- phylo4d(myTree, as.data.frame(me.phylo(myTree, method="sumDD")))
+par(mar=rep(.1,4), mfrow=c(2,2))
+invisible(lapply(ung.listBas, table.phylo4d, repVar=1:5, cex.sym=.7, show.tip.label=FALSE, show.node=FALSE))
+
+
+###################################################
+### code chunk number 24: lm1
+###################################################
+afbw <- log(ungulates$tab[,1])
+neonatw <- log((ungulates$tab[,2]+ungulates$tab[,3])/2)
+names(afbw) <- myTree$tip.label
+names(neonatw) <- myTree$tip.label
+plot(afbw, neonatw, main="Relationship between afbw and neonatw")
+lm1 <- lm(neonatw~afbw)
+abline(lm1, col="blue")
+anova(lm1)
+
+
+###################################################
+### code chunk number 25: resid
+###################################################
+resid <- residuals(lm1)
+names(resid) <- myTree$tip.label
+temp <- phylo4d(myTree,data.frame(resid))
+abouheif.moran(temp)
+table.phylo4d(temp)
+
+
+###################################################
+### code chunk number 26: adephylo.Rnw:537-544
+###################################################
+myBasis <- me.phylo(myTree, method="Abouheif")
+lm2 <- lm(neonatw~myBasis[,1] + afbw)
+resid <- residuals(lm2)
+names(resid) <- myTree$tip.label
+temp <- phylo4d(myTree,data.frame(resid))
+abouheif.moran(temp)
+anova(lm2)
+
+
+###################################################
+### code chunk number 27: adephylo.Rnw:570-575
+###################################################
+W <- proxTips(myTree, method="Abouheif", sym=FALSE)
+lagNeonatw <- W %*% neonatw
+lm3 <- lm(neonatw ~ lagNeonatw + afbw)
+resid <- residuals(lm3)
+abouheif.moran(resid,W)
+
+
+###################################################
+### code chunk number 28: pca1
+###################################################
+f1 <- function(x){
+ m <- mean(x,na.rm=TRUE)
+ x[is.na(x)] <- m
+ return(x)
+}
+
+data(maples)
+traits <- apply(maples$tab, 2, f1)
+pca1 <- dudi.pca(traits, scannf=FALSE, nf=1)
+barplot(pca1$eig, main="PCA eigenvalues", col=heat.colors(16))
+
+
+###################################################
+### code chunk number 29: pca2
+###################################################
+tre <- read.tree(text=maples$tre)
+W <- proxTips(tre)
+myComp <- data.frame(PC1=pca1$li[,1], lagPC1=W %*% pca1$li[,1])
+myComp.4d <- phylo4d(tre, myComp)
+nodeLabels(myComp.4d) <- names(nodeLabels(myComp.4d))
+table.phylo4d(myComp.4d)
+
+
+###################################################
+### code chunk number 30: aboutest
+###################################################
+myTest <- abouheif.moran(myComp[,1], W=W)
+plot(myTest, main="Abouheif's test using patristic proximity")
+mtext("First principal component - maples data", col="blue", line=1)
+
+
+###################################################
+### code chunk number 31: loadings
+###################################################
+ldgs <- pca1$c1[,1]
+plot(ldgs, type="h", xlab="Variable", xaxt="n", ylab="Loadings")
+s.label(cbind(1:31, ldgs), lab=colnames(traits), add.p=TRUE, clab=.8)
+temp <- abs(ldgs)
+thres <- quantile(temp, .75)
+abline(h=thres * c(-1,1), lty=2, col="blue3", lwd=3)
+title("Loadings for PC1")
+mtext("Quarter of most contributing variables indicated in blue", col="blue")
+
+
diff --git a/inst/doc/adephylo.Rnw b/inst/doc/adephylo.Rnw
new file mode 100644
index 0000000..7e3a8bc
--- /dev/null
+++ b/inst/doc/adephylo.Rnw
@@ -0,0 +1,665 @@
+\documentclass{article}
+% \VignettePackage{adephylo}
+% \VignetteIndexEntry{adephylo: exploratory analyses for the phylogenetic comparative method}
+
+\usepackage{graphicx}
+\usepackage[colorlinks=true,urlcolor=blue]{hyperref}
+\usepackage{array}
+\usepackage{color}
+
+\usepackage[utf8]{inputenc} % for UTF-8/single quotes from sQuote()
+\newcommand{\code}[1]{{{\tt #1}}}
+\title{\code{adephylo}: exploratory analyses for the phylogenetic comparative method}
+\author{Thibaut Jombart and St\'ephane Dray}
+\date{\today}
+
+
+
+
+\sloppy
+\hyphenpenalty 10000
+
+
+\begin{document}
+
+
+
+\definecolor{Soutput}{rgb}{0,0,0.56}
+\definecolor{Sinput}{rgb}{0.56,0,0}
+\DefineVerbatimEnvironment{Sinput}{Verbatim}
+{formatcom={\color{Sinput}},fontsize=\footnotesize, baselinestretch=0.75}
+\DefineVerbatimEnvironment{Soutput}{Verbatim}
+{formatcom={\color{Soutput}},fontsize=\footnotesize, baselinestretch=0.75}
+
+\color{black}
+
+\maketitle
+\tableofcontents
+
+
+
+%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%
+\section{Introduction}
+%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%
+
+\SweaveOpts{prefix.string = figs/adephylo, fig = FALSE, eps = FALSE, pdf = TRUE, width = 6, height = 6}
+
+
+This document describes the \code{adephylo} package for the R software.
+\code{adephylo} aims at implementing exploratory methods for the
+analysis of phylogenetic comparative data, i.e. biological traits measured for
+taxa whose phylogeny is also provided.
+This package extends and replaces implementation of phylogeny-related
+methods in the ade4 package \url{http://pbil.univ-lyon1.fr/ADE-4/home.php?lang=eng}.
+
+Procedures implemented in \code{adephylo} rely on exploratory data analysis. They include data
+visualization and manipulation, tests for phylogenetic autocorrelation, multivariate analysis,
+computation of phylogenetic proximities and distances, and modelling phylogenetic signal using
+orthonormal bases. \\
+
+These methods can be used to visualize, test, remove or investigate the phylogenetic signal in
+comparative data. The purpose of this document is to provide a general view of the main
+functionalities of \code{adephylo}, and to show how this package can be used along with \code{ape},
+\code{phylobase} and \code{ade4} to analyse comparative data.
+
+
+
+
+
+
+%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%
+\section{First steps}
+%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%
+
+
+
+%%%%%%%%%%%%%%%%%%%%%
+\subsection{Data representation: why we are not reinventing the weel}
+%%%%%%%%%%%%%%%%%%%%%
+
+Data representation can be defined as the way data are stored in a software
+(R, in our case). Technically, data representation is defined by classes of objects that contain
+the information. In the case of phylogeny and comparative data, very efficient data representation
+are already defined in other packages. Hence, it makes much more sense to use directly objects from
+these classes. \\
+
+
+Phylogenies are best represented in Emmanuel Paradis's \code{ape} package
+(\url{http://ape.mpl.ird.fr/}), as the class \code{phylo}. As \code{ape} is by far the largest
+package dedicated to phylogeny, using the \code{phylo} class assures a good interoperability of
+data. This class is defined in an online document:
+\url{http://ape.mpl.ird.fr/misc/FormatTreeR_28July2008.pdf}. \\
+
+However, data that are to be analyzed in \code{adephylo} do not only contain trees, but also traits
+associated to the tips of a tree. The package \code{phylobase}
+(\url{http://r-forge.r-project.org/projects/phylobase/}) is a collaborative effort designed to
+handling such data. Its representation of phylogenies slightly differs from that of \code{ape}; the
+class \code{phylo4} was originally an extension of the \code{phylo} class into formal (S4) class, but it
+has now evolved into something more original. The S4 class \code{phylo4d} (`d' for `data') can be used to store a
+tree and data associated to tips, internal nodes, or even edges of a tree. Classes of
+\code{phylobase} are described in a vignette of the package, accessible by typing:
+<<eval=FALSE>>=
+vignette("phylobase")
+@
+
+~\\ As trees and comparative data are already handled by \code{ape} and \code{phylobase}, no
+particular data format shall be defined in \code{adephylo}. In particular, we are no longer using
+\code{phylog} objects, which were used to represent phylogenies in \code{ade4} in a very \textit{ad
+ hoc} way, without much compatibility with other packages. This class is now deprecated, but all
+previous functionalities available for \code{phylog} objects have been re-implemented and -- in some
+cases -- improved in \code{adephylo}.
+
+
+
+
+
+%%%%%%%%%%%%%%%%%%%%%
+\subsection{Installing the package}
+%%%%%%%%%%%%%%%%%%%%%
+
+What is tricky here is that a vignette is basically available once the package
+is installed. Assuming you got this document before installing the package, here are some clues
+about installing \code{adephylo}. \\
+
+First of all, \code{adephylo} depends on other packages, being \code{methods}, \code{ape},
+\code{phylobase}, and \code{ade4}. These dependencies are mandatory, that is, you actually need to
+have these packages installed before using \code{adephylo}. Also, it is better to make sure you are
+using the latest versions of these packages. This can be achieved using
+the \texttt{update.packages} command, or by installing devel versions from R-Forge
+(\url{http://r-forge.r-project.org/}). In all cases, the latest version of \code{adephylo} can be
+found from \url{http://r-forge.r-project.org/R/?group_id=303}. \\
+
+We load \textit{adephylo}, alongside some useful packages:
+<<load>>=
+library(ape)
+library(phylobase)
+library(ade4)
+library(adephylo)
+search()
+@
+
+Note that possibly conflicting, deprecated functions or datasets from \code{ade4} are masked by
+\code{adephylo}. In case the converse would occur (i.e. deprecated function masking a function of
+\code{adephylo}), one can refer to the `good' version of a function by adding the prefix
+\code{adephylo::} to the function. Hence, it is possible to coerce the version of a masked
+function, using a kludge like:
+<<kludge>>=
+cat("\n=== Old - deprecated- version ===\n")
+orthogram <- ade4::orthogram
+args(orthogram)
+cat("\n=== New version === \n")
+orthogram <- adephylo::orthogram
+args(orthogram)
+@
+
+Luckily, this should not be required as long as one is not playing
+with loading and unloading \code{ade4} once \code{adephylo} is loaded.
+
+
+%%%%%%%%%%%%%%%%%%%%%
+\subsection{Getting started}
+%%%%%%%%%%%%%%%%%%%%%
+All the material of the package is summarized in a manpage accessible
+by typing:
+<<eval=FALSE>>=
+?adephylo
+@
+
+The html version of this manpage may be preferred to browse easily the content
+of \code{adephylo}; this is accessible by typing:
+<<eval=FALSE>>=
+help("adephylo", package="adephylo", html=TRUE)
+@
+
+To revert help back to text mode, simply type:
+<<eval=FALSE>>=
+options(htmlhelp = FALSE)
+@
+
+
+
+
+
+%%%%%%%%%%%%%%%%%%%%%
+\subsection{Putting data into shape}
+%%%%%%%%%%%%%%%%%%%%%
+
+While this is not the purpose of this document to go through the details of
+\code{phylo}, \code{phylo4} and \code{phylo4d} objects, we shall show briefly how these objects can
+be obtained.
+
+
+% % % % % % % % % % %
+\subsubsection{Making a \code{phylo} object}
+% % % % % % % % % % %
+The simplest way of turning a tree into a \code{phylo} object is using
+ape's function \code{read.tree}.
+This function reads a tree with the Newick (or `parentetic') format,
+from a file (default, argument \code{file}) of from a character string
+(argument \code{text}).
+<<readTree, plot=TRUE>>=
+data(ungulates)
+ungulates$tre
+myTree <- read.tree(text=ungulates$tre)
+myTree
+plot(myTree, main="ape's plotting of a tree")
+@
+
+
+It is easy to convert \code{ade4}'s \code{phylog} objects to a
+\code{phylo}, as \code{phylog} objects store the Newick format of the
+tree in the \code{\$tre} component.
+\\
+
+Note that \code{phylo} trees can also be constructed from alignements
+(see \code{read.GenBank}, \code{read.dna},
+\code{dist.dna}, \code{nj}, \code{bionj}, and \code{mlphylo}, all in
+\code{ape}), or even simulated (for instance, see \code{rtree}).
+\\
+
+Also note that, if needed, conversion can be done back and forward
+with \code{phylo4} trees:
+<<>>=
+temp <- as(myTree, "phylo4")
+class(temp)
+temp <- as(temp, "phylo")
+class(temp)
+all.equal(temp, myTree)
+@
+
+
+
+
+
+% % % % % % % % % % %
+\subsubsection{Making a \code{phylo4d} object}
+% % % % % % % % % % %
+
+\code{phylo4d} objects are S4 objects, and are thus created in a particular
+way. These objects can be obtained in two ways, by reading a Nexus file containing tree and data
+information, or by `assembling' a tree and data provided for tips, nodes, or edges.
+
+Nexus files containing both tree and data can be read by \code{phylobase}'s function
+\code{readNexus} (see corresponding manpage for more information).
+The other way of creating a \code{phylo4d} object is using the
+constructor, also named \code{phylo4d}. This is a function that takes two arguments: a tree
+(\code{phylo} or \code{phylo4} format) and a \code{data.frame} containing data, for tips by default (see
+\code{?phylo4d} for more information). Here is an example:
+<<phylo4d, fig=TRUE>>=
+ung <- phylo4d(myTree, ungulates$tab)
+class(ung)
+table.phylo4d(ung)
+@
+
+%% \noindent Note that the constructor checks the consistency of the
+%% names used for the tips of the tree and for the rows of the data.frame.
+%% Inconsistencies issue an error.
+%% To override this behaviour, one can specify
+%% \code{use.tip.names=FALSE}.
+%% However, this can be tricky: often, mismatches between names can
+%% indicate that data are not sorted adequately; moreover, object created
+%% with such mismatches will often be invalid objects, and may issue
+%% errors in further analyses.
+%% \\
+
+Data are stored inside the \code{@data} slot of the object.
+They can be accessed using the function \code{tdata}:
+<<>>=
+x <- tdata(ung, type="tip")
+head(x)
+@
+
+
+
+
+
+
+%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%
+\section{Exploratory data analysis}
+%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%
+
+
+
+
+%%%%%%%%%%%%%%%%%%%%%
+\subsection{Quantifying and testing phylogenetic signal}
+%%%%%%%%%%%%%%%%%%%%%
+
+In this document, the terms `phylogenetic signal' and `phylogenetic autocorrelation' are used
+interchangeably. They refer to the fact that values of life-history traits or ecological features
+are not independent in closely related taxa. Several procedures are implemented by \code{adephylo}
+to measure and test phylogenetic autocorrelation.
+
+
+% % % % % % % % % % %
+\subsubsection{Moran's $I$}
+% % % % % % % % % % %
+
+The function \code{moran.idx} computes Moran's $I$, the most widely-used autocorrelation measure.
+It can also provide additionnal information (argument \code{addInfo}), being the null value of $I$
+(i.e., the expected value in absence of phylogenetic autocorrelation), and the range of variation of
+$I$. It requires the degree of relatedness of tips on the phylogeny to be modelled by a matrix of
+phylogenetic proximities. Such a matrix can be obtained using different methods implemented by the
+function \code{proxTips}.
+
+<<moranI>>=
+W <- proxTips(myTree, met="Abouheif")
+moran.idx(tdata(ung, type="tip")$afbw, W)
+moran.idx(tdata(ung, type="tip")[,1], W, addInfo=TRUE)
+@
+
+From here, it is quite straightforward to build a non-parametric test
+based on Moran's $I$.
+For instance (taken from \code{?moran.idx}):
+<<fig=TRUE>>=
+afbw <- tdata(ung, type="tip")$afbw
+sim <- replicate(499, moran.idx(sample(afbw), W)) # permutations
+sim <- c(moran.idx(afbw, W), sim)
+
+cat("\n=== p-value (right-tail) === \n")
+pval <- mean(sim>=sim[1])
+pval
+
+plot(density(sim), main="Moran's I Monte Carlo test for 'bif'") # plot
+mtext("Density of permutations, and observation (in red)")
+abline(v=sim[1], col="red", lwd=3)
+
+@
+
+\noindent Here, \code{afbw} is likely not phylogenetically autocorrelated.
+
+
+
+
+
+% % % % % % % % % % %
+\subsubsection{Abouheif's test}
+% % % % % % % % % % %
+
+The test of Abouheif (see reference in \code{?abouheif.moran}) is
+designed to test the existence of phylogenetic signal.
+In fact, it has been shown that this test amounts to a Moran's $I$
+test with a particular proximity matrix (again, see references in the manpage).
+The implementation in \code{abouheif.moran} proposes different phylogenetic proximities,
+using by default the original one.
+
+The function can be used on different objects; in particular, it can
+be used with a \code{phylo4d} object.
+In such case, all traits inside the object are tested.
+The returned object is a \code{krandtest}, a class of object defined
+by \code{ade4} to store multiple Monte Carlo tests.
+Here is an example using the ungulates dataset:
+<<abouheif, plot=TRUE>>=
+ung.abTests <- abouheif.moran(ung)
+ung.abTests
+plot(ung.abTests)
+@
+
+\noindent In this case, it seems that all variables but \code{afbm} are
+phylogenetically structured.
+\\
+
+Note that other proximities than those proposed in
+\code{abouheif.moran} can be used: on has just to pass the appropriate
+proximity matrix to the function (argument \code{W}).
+For instance, we would like to use the correlation corresponding to a
+Brownian motion as a measure of phylogenetic proximity.
+
+First, we must estimate branch lengths, as our tree does
+not have any (ideally, we would already have a tree with meaningful branch lengths):
+<<>>=
+hasEdgeLength(ung)
+myTree.withBrLe <- compute.brlen(myTree)
+@
+
+\noindent Now, we can use ape's function \code{vcv.phylo} to compute
+the matrix of phylogenetic proximities, and use this matrix in
+Abouheif's test:
+<<>>=
+myProx <- vcv.phylo(myTree.withBrLe)
+abouheif.moran(ung, W=myProx)
+@
+
+\noindent In the present case, traits no longer appear as phylogenetically autocorrelated. Several
+explanation can be proposed: the procedure for estimating branch length may not be appropriate in
+this case, or the Brownian motion may fail to describe the evolution of the traits under study for
+this set of taxa.
+
+
+
+
+% % % % % % % % % % %
+\subsubsection{Phylogenetic decomposition of trait variation}
+% % % % % % % % % % %
+The phylogenetic decomposition of the variation of a trait proposed by Ollier
+et al. (2005, see references in \code{?orthogram}) is implemented by
+the function \code{orthogram}.
+This function replaces the former, deprecated version from \code{ade4}.
+\\
+
+The idea behind the method is to model different levels of variation
+on a phylogeny.
+Basically, these levels can be obtained from dummy vectors indicating
+which tip descends from a given node.
+A partition of tips can then be obtained for each node.
+This job is achieved by the function \code{treePart}.
+Here is an example using a small simulated tree:
+<<fig=TRUE>>=
+x <- as(rtree(5),"phylo4")
+plot(x,show.n=TRUE)
+@
+
+<<>>=
+x.part <- treePart(x)
+x.part
+@
+\noindent The obtained partition can also be plotted:
+<<fig=TRUE>>=
+temp <- phylo4d(x, x.part)
+table.phylo4d(temp, cent=FALSE, scale=FALSE)
+@
+
+\noindent What we would like to do is assess where the variation of a trait is structured on the
+phylogeny; to do so, we could use these dummy vectors as regressors and see how variation is
+distributed among these vectors. However, these dummy vectors cannot be used as regressors because
+they are linearly dependent. The orthogram circumvents this issue by transforming and selecting
+dummy vectors into a new set of variables that are orthonormal. The obtained orthonormal basis can
+be used to decompose the variation of the trait. Even if not necessary to get an orthogram, this basis
+can be obtained from \code{treePart}:
+<<>>=
+args(treePart)
+temp <- phylo4d(x, treePart(x, result="orthobasis") )
+@
+
+\noindent And here are the first 8 vectors of the orthonormal basis
+for the ungulate dataset:
+<<orthobas1, fig=TRUE>>=
+temp <- phylo4d(myTree, treePart(myTree, result="orthobasis") )
+par(mar=rep(.1,4))
+table.phylo4d(temp, repVar=1:8, ratio.tree=.3)
+@
+
+The decomposition of variance achieved by projecting a trait onto this
+orthonormal basis gives rise to several test statistics, that are
+performed by the function \code{orthogram}.
+Like the \code{abouheif.moran} function, \code{orthogram} outputs a
+\code{krandtest} object:
+<<orthogram, plot=TRUE>>=
+afbw.ortgTest <- orthogram(afbw, myTree)
+afbw.ortgTest
+@
+
+\noindent Here again, \code{afbw} does not seem to be phylogenetically structured.
+
+
+
+
+
+%%%%%%%%%%%%%%%%%%%%%
+\subsection{Modelling phylogenetic signal}
+%%%%%%%%%%%%%%%%%%%%%
+
+% % % % % % % % % % %
+\subsubsection{Using orthonormal bases}
+% % % % % % % % % % %
+
+The previous section describing the orthogram has shown that testing phylogenetic signal underlies a
+model of phylogenetic structure. In the case of the orthogram, several tests are based on the
+decomposition of the variance of a trait onto an orthonormal basis describing tree topology. In
+fact, it is possible to extend this principle to any orthonormal basis modelling phylogenetic
+topology. Another example of such bases is offered by Moran's eigenvectors, which can be used to
+model different observable phylogenetic structures (see references in \code{me.phylo}).
+
+Moran's phylogenetic eigenvectors are implemented by the function \code{me.phylo} (also nicknamed
+\code{orthobasis.phylo}). The returned object is a data.frame with the class \code{orthobasis}
+defined in \code{ade4}; columns of this object are Moran's eigenvectors. An \code{orthobasis} can
+be coerced to a regular \code{data.frame} or to a matrix using \code{as.data.frame} and \code{as.matrix}.
+<<>>=
+me.phylo(myTree.withBrLe)
+@
+
+\noindent Moran's eigenvectors are constructed from a matrix of
+phylogenetic proximities between tips.
+Any proximity can be used (argument \code{prox}); the 5 proximities
+implemented by the \code{proxTips} function are available by default, giving rise
+to different orthobases:
+<<figFourBas, fig=TRUE,include=FALSE, print=FALSE>>=
+ung.listBas <- list()
+ung.listBas[[1]] <- phylo4d(myTree, as.data.frame(me.phylo(myTree.withBrLe, method="patristic")))
+ung.listBas[[2]] <- phylo4d(myTree, as.data.frame(me.phylo(myTree, method="nNodes")))
+ung.listBas[[3]]<- phylo4d(myTree, as.data.frame(me.phylo(myTree, method="Abouheif")))
+ung.listBas[[4]] <- phylo4d(myTree, as.data.frame(me.phylo(myTree, method="sumDD")))
+par(mar=rep(.1,4), mfrow=c(2,2))
+invisible(lapply(ung.listBas, table.phylo4d, repVar=1:5, cex.sym=.7, show.tip.label=FALSE, show.node=FALSE))
+@
+
+\includegraphics[width=.8\textwidth]{figs/adephylo-figFourBas}
+
+\noindent In this case, the first Moran's eigenvectors are essentially similar. In other cases,
+however, the orthobases built from different proximities can be quite different. \\
+
+One of the interests of Moran's eigenvectors in phylogeny is to account for phylogenetic
+autocorrelation in a linear model. This can be achieved using the appropriate eigenvector as
+covariate. Here is an example when studying the link of two traits in ungulate dataset.
+<<lm1, fig=TRUE>>=
+afbw <- log(ungulates$tab[,1])
+neonatw <- log((ungulates$tab[,2]+ungulates$tab[,3])/2)
+names(afbw) <- myTree$tip.label
+names(neonatw) <- myTree$tip.label
+plot(afbw, neonatw, main="Relationship between afbw and neonatw")
+lm1 <- lm(neonatw~afbw)
+abline(lm1, col="blue")
+anova(lm1)
+@
+
+\noindent Are the residuals of this model independent?
+<<resid, fig=TRUE>>=
+resid <- residuals(lm1)
+names(resid) <- myTree$tip.label
+temp <- phylo4d(myTree,data.frame(resid))
+abouheif.moran(temp)
+table.phylo4d(temp)
+@
+
+\noindent No, residuals are clearly not independent, as they exhibit
+strong phylogenetic autocorrelation.
+In this case, autocorrelation can be removed by using the first
+Moran's eigenvector as a covariate.
+In general, the appropriate eigenvector(s) can be chosen by usual
+variable-selection approaches, like the forward selection, or using a
+selection based on the existence of autocorrelation in the residuals.
+<<>>=
+myBasis <- me.phylo(myTree, method="Abouheif")
+lm2 <- lm(neonatw~myBasis[,1] + afbw)
+resid <- residuals(lm2)
+names(resid) <- myTree$tip.label
+temp <- phylo4d(myTree,data.frame(resid))
+abouheif.moran(temp)
+anova(lm2)
+@
+
+The link between the two variables is still very statistically
+significant, but this time the model is not invalid because of
+non-independence of residuals.
+
+
+
+
+% % % % % % % % % % %
+\subsubsection{Autoregressive models}
+% % % % % % % % % % %
+Autoregressive models can also be used to remove phylogenetic
+autocorrelation from residuals.
+This approach implies the use of a phylogenetically lagged vector, for
+some or all of the variates of a model (see references in \code{?proxTips}).
+The lag vector of a trait $x$, denoted $\tilde{x}$, is computed as:
+$$
+\tilde{x} = Wx
+$$
+\noindent where $W$ is a matrix of phylogenetic proximities, as
+returned by \code{proxTips}.
+Hence, one can use an autoregressive approach to remove phylogenetic
+autocorrelation quite simply.
+We here re-use the example from the previous section:
+<<>>=
+W <- proxTips(myTree, method="Abouheif", sym=FALSE)
+lagNeonatw <- W %*% neonatw
+lm3 <- lm(neonatw ~ lagNeonatw + afbw)
+resid <- residuals(lm3)
+abouheif.moran(resid,W)
+@
+
+\noindent Here, this most simple autoregressive model may not be
+sufficient to account for all phylogenetic signal; yet, phylogenetic
+autocorrelation is no longer detected at the usual threshold
+$\alpha=0.05$.
+
+
+
+
+
+
+%%%%%%%%%%%%%%%%%%%%%
+\subsection{Using multivariate analyses}
+%%%%%%%%%%%%%%%%%%%%%
+
+Multivariate analyses can be used to identify the main biodemographic strategies in a large set of
+traits. This could be the topic of an entire book. Such application is not particular to
+\code{adephylo}, but some practices are made easier by the package, used together with \code{ade4}.
+We here provide a simple example, using the \code{maples} dataset. This dataset contains a tree and
+a set of 31 quantitative traits (see \code{?maples}).
+
+First of all, we seek a summary of the variability in traits using a principal component analysis.
+Missing data are replaced by mean values, so they are placed at the origin of the axes (the
+`non-informative' point).
+<<pca1, fig=TRUE>>=
+f1 <- function(x){
+ m <- mean(x,na.rm=TRUE)
+ x[is.na(x)] <- m
+ return(x)
+}
+
+data(maples)
+traits <- apply(maples$tab, 2, f1)
+pca1 <- dudi.pca(traits, scannf=FALSE, nf=1)
+barplot(pca1$eig, main="PCA eigenvalues", col=heat.colors(16))
+@
+
+\noindent One axis shall be retained. Does this axis reflect a phylogenetic structure? We can
+represent this principal component onto the phylogeny. In some cases, positive autocorrelation can
+be better perceived by examining the lag vector (see previous section on autoregressive models)
+instead of the original vector. Here, we shall plot both the retained principal component, and its
+lag vector:
+<<pca2, fig=TRUE>>=
+tre <- read.tree(text=maples$tre)
+W <- proxTips(tre)
+myComp <- data.frame(PC1=pca1$li[,1], lagPC1=W %*% pca1$li[,1])
+myComp.4d <- phylo4d(tre, myComp)
+nodeLabels(myComp.4d) <- names(nodeLabels(myComp.4d))
+table.phylo4d(myComp.4d)
+@
+
+\noindent It is quite clear that the main component of diversity among taxa separates descendants
+from node 19 from descendants of node 24. Phylogenetic autocorrelation can be checked in `PC1'
+(note that testing it in the lag vector would be circulary, as the lag vector already otimizes
+positive autocorrelation), for instance using Abouheif's test:
+<<aboutest, fig=TRUE>>=
+myTest <- abouheif.moran(myComp[,1], W=W)
+plot(myTest, main="Abouheif's test using patristic proximity")
+mtext("First principal component - maples data", col="blue", line=1)
+@
+
+\noindent To dig further into the interpretation of this structure,
+one can have a look at the loadings of the traits, to see to which
+biological traits these opposed life histories correspond:
+<<loadings, fig=TRUE>>=
+ldgs <- pca1$c1[,1]
+plot(ldgs, type="h", xlab="Variable", xaxt="n", ylab="Loadings")
+s.label(cbind(1:31, ldgs), lab=colnames(traits), add.p=TRUE, clab=.8)
+temp <- abs(ldgs)
+thres <- quantile(temp, .75)
+abline(h=thres * c(-1,1), lty=2, col="blue3", lwd=3)
+title("Loadings for PC1")
+mtext("Quarter of most contributing variables indicated in blue", col="blue")
+@
+
+\noindent As a reminder, species with a large black symbol would be on
+the top of this graph, while species with a large white symbol would
+lie on the bottom.
+
+
+
+%%%%%%%%%%%%%%%%%%%%%
+%\subsection{Performing a phylogenetic Principal Component Analysis}
+%%%%%%%%%%%%%%%%%%%%%
+
+
+
+
+\end{document}
diff --git a/inst/doc/adephylo.pdf b/inst/doc/adephylo.pdf
new file mode 100644
index 0000000..8af3498
Binary files /dev/null and b/inst/doc/adephylo.pdf differ
diff --git a/man/abouheif.Rd b/man/abouheif.Rd
new file mode 100644
index 0000000..d82351b
--- /dev/null
+++ b/man/abouheif.Rd
@@ -0,0 +1,115 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/abouheif.R
+\name{abouheif.moran}
+\alias{abouheif.moran}
+\title{Abouheif's test based on Moran's I}
+\usage{
+abouheif.moran(x, W = NULL, method = c("oriAbouheif", "patristic", "nNodes",
+ "Abouheif", "sumDD"), f = function(x) { 1/x }, nrepet = 999,
+ alter = c("greater", "less", "two-sided"))
+}
+\arguments{
+\item{x}{a data frame with continuous variables, or a \linkS4class{phylo4d}
+object (i.e. containing both a tree, and tip data). In the latter case,
+\code{method} argument is used to determine which proximity should be used.}
+
+\item{W}{a \emph{n} by \emph{n} matrix (\emph{n} being the number rows in x)
+of phylogenetic proximities, as produced by \code{\link{proxTips}}.}
+
+\item{method}{a character string (full or unambiguously abbreviated)
+specifying the type of proximity to be used. By default, the proximity used
+is that of the original Abouheif's test. See details in
+\code{\link{proxTips}} for information about other methods.}
+
+\item{f}{a function to turn a distance into a proximity (see
+\code{\link{proxTips}}).}
+
+\item{nrepet}{number of random permutations of data for the randomization
+test}
+
+\item{alter}{a character string specifying the alternative hypothesis, must
+be one of "greater" (default), "less" or "two-sided"}
+}
+\value{
+Returns an object of class \code{krandtest} (randomization tests
+from ade4), containing one Monte Carlo test for each trait.
+}
+\description{
+The test of Abouheif (1999) is designed to detect phylogenetic
+autocorrelation in a quantitative trait. Pavoine \emph{et al.} (2008) have
+shown that this tests is in fact a Moran's I test using a particular
+phylogenetic proximity between tips (see details). The function
+\code{abouheif.moran} performs basically Abouheif's test for several traits
+at a time, but it can incorporate other phylogenetic proximities as well.\cr
+}
+\details{
+Note that the original Abouheif's proximity (Abouheif, 1999; Pavoine
+\emph{et al.} 2008) unifies Moran's I and Geary'c tests (Thioulouse \emph{et
+al.} 1995).\cr
+
+\code{abouheif.moran} can be used in two ways:\cr - providing a data.frame
+of traits (\code{x}) and a matrix of phylogenetic proximities (\code{W})\cr
+- providing a \linkS4class{phylo4d} object (\code{x}) and specifying the
+type of proximity to be used (\code{method}).
+
+\code{W} is a squared symmetric matrix whose terms are all positive or
+null.\cr
+
+\code{W} is firstly transformed in frequency matrix A by dividing it by the
+total sum of data matrix : \deqn{a_{ij} =
+\frac{W_{ij}}{\sum_{i=1}^{n}\sum_{j=1}^{n}W_{ij}}}{a_ij = W_ij / (sum_i
+sum_j W_ij)} The neighbouring weights is defined by the matrix \eqn{D =
+diag(d_1,d_2, \ldots)} where \eqn{d_i = \sum_{j=1}^{n}W_{ij}}{d_i = sum_j
+W_ij}. For each vector x of the data frame x, the test is based on the Moran
+statistic \eqn{x^{t}Ax}{t(x)Ax} where x is D-centred.
+}
+\examples{
+
+
+if(require(ade4)&& require(ape) && require(phylobase)){
+## load data
+data(ungulates)
+tre <- read.tree(text=ungulates$tre)
+x <- phylo4d(tre, ungulates$tab)
+
+## Abouheif's tests for each trait
+myTests <- abouheif.moran(x)
+myTests
+plot(myTests)
+
+## a variant using another proximity
+plot(abouheif.moran(x, method="nNodes") )
+
+## Another example
+
+data(maples)
+tre <- read.tree(text=maples$tre)
+dom <- maples$tab$Dom
+
+## Abouheif's tests for each trait (equivalent to Cmean)
+W1 <- proxTips(tre,method="oriAbouheif")
+abouheif.moran(dom,W1)
+
+## Equivalence with moran.idx
+
+W2 <- proxTips(tre,method="Abouheif")
+abouheif.moran(dom,W2)
+moran.idx(dom,W2)
+}
+
+}
+\author{
+Original code from ade4 (gearymoran function) by Sebastien Ollier\cr
+Adapted and maintained by Thibaut Jombart <tjombart at imperial.ac.uk>.
+}
+\references{
+Thioulouse, J., Chessel, D. and Champely, S. (1995) Multivariate analysis of
+spatial patterns: a unified approach to local and global structures.
+\emph{Environmental and Ecological Statistics}, \bold{2}, 1--14.
+}
+\seealso{
+- \code{\link[ade4]{gearymoran}} from the ade4 package\cr -
+\code{\link[ape]{Moran.I}} from the ape package for the classical Moran's I
+test. \cr
+}
+
diff --git a/man/adephylo-package.Rd b/man/adephylo-package.Rd
new file mode 100644
index 0000000..26b0c9b
--- /dev/null
+++ b/man/adephylo-package.Rd
@@ -0,0 +1,132 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/adephylo-package.R
+\docType{package}
+\name{adephylo-package}
+\alias{adephylo}
+\alias{adephylo-package}
+\title{The adephylo package}
+\description{
+This package is devoted to exploratory analysis of phylogenetic comparative
+data. It re-implements and extends phylogenetic procedures from the
+\code{ade4} package (which are now deprecated).\cr
+}
+\details{
+Comparative data (phylogeny+traits) are handled as \linkS4class{phylo4d}
+objects, a canonical class implemented by the \code{phylobase} package.
+Trees are handled as \code{\link[ape:read.tree]{phylo}} objects (from the
+\code{ape} package) or as \linkS4class{phylo4} objects (\code{phylobase}'s
+extension of \code{phylo} objects).\cr
+
+Main functionalities of \code{adephylo} are summarized below.\cr
+
+=== TOPOLOGICAL INFORMATION ===\cr Several functions allow one to retrieve
+topological information from a tree; such information can be used, for
+instance, as a basis to compute distances or proximities between tips.\cr
+
+- \code{\link{listDD}}: lists the direct descendants from each node of a
+tree.\cr
+
+- \code{\link{listTips}}: lists the tips descending from each node of a
+tree.\cr
+
+- \code{\link{.tipToRoot}}: finds the set of nodes between a tip and the
+root of a tree.\cr
+
+- \code{\link{sp.tips}}: finds the shortest path between tips of a tree.\cr
+
+- \code{\link{treePart}}: defines partitions of tips reflecting the topology
+of a tree. This function can output non-independent dummy vectors, or
+alternatively an orthonormal basis used by the orthogram procedure.\cr
+
+=== PHYLOGENETIC PROXIMITIES/DISTANCES ===\cr Several phylogenetic
+proximities and distances are implemented. Auxiliary function easing the
+computation of other distances/proximities are also provided:\cr
+
+- \code{\link{distRoot}}: computes different distances of a set of tips to
+the root.\cr
+
+- \code{\link{distTips}}: computes different pairwise distances in a set of
+tips.\cr
+
+- \code{\link{proxTips}}: computes different proximities between a set of
+tips.\cr
+
+=== MEASURES/TESTS OF PHYLOGENETIC AUTOCORRELATION ===\cr Several procedures
+allow one to measure, and/or test phylogenetic signal in biological
+traits:\cr
+
+- \code{\link{abouheif.moran}}: performs Abouheif's test, designed to detect
+phylogenetic autocorrelation in a quantitative trait. This implementation is
+not based on original heuristic procedure, but on the exact formulation
+proposed by Pavoine et al. (2008), showing that the test is in fact a
+Moran's index test. This implementation further extends the procedure by
+allowing any measure of phylogenetic proximity (5 are proposed).\cr
+
+- \code{\link{orthogram}}: performs the orthonormal decomposition of
+variance of a quantitative variable on an orthonormal basis as in Ollier et
+al. (2005). It also returns the results of five non parametric tests
+associated to the variance decomposition.\cr
+
+- \code{\link{moran.idx}}: computes Moran's index of autocorrelation given a
+variable and a matrix of proximities among observations (no test).\cr
+
+=== MODELLING/INVESTIGATION OF PHYLOGENETIC SIGNAL ===\cr Rather than
+testing or measuring phylogenetic autocorrelation, these procedures can be
+used for further investigation of phylogenetic signal. Some, like
+\code{\link{me.phylo}}, can be used to remove phylogenetic autocorrelation.
+Others can be used to understand the nature of this autocorrelation (i.e.,
+to ascertain which traits and tips are concerned by phylogenetic
+non-independence).\cr
+
+- \code{\link{me.phylo}}/\code{\link{orthobasis.phylo}}: these synonymous
+functions compute Moran's eigenvectors (ME) associated to a tree. These
+vectors model different observable phylogenetic signals. They can be used as
+covariables to remove phylogenetic autocorrelation from data.\cr
+
+- \code{\link{orthogram}}: the orthogram mentioned above also provides a
+description of how biological variability is structured on a phylogeny.\cr
+
+- \code{\link{ppca}}: performs a phylogenetic Principal Component Analysis
+(pPCA, Jombart et al. 2010). This multivariate method investigates
+phylogenetic patterns in a set of quantitative traits.\cr
+
+=== GRAPHICS ===\cr Some plotting functions are proposed, most of them being
+devoted to representing phylogeny and a quantitative information at the same
+time.\cr
+
+- \code{\link{table.phylo4d}}: fairly customisable way of representing
+traits onto the tips of a phylogeny. Several traits can be plotted in a
+single graphic.\cr
+
+- \code{\link{bullseye}}: an alternative to \code{\link{table.phylo4d}}
+based on fan-like representation, better for large trees.\cr
+
+- \code{\link{scatter.ppca}}, \code{\link{screeplot.ppca}},
+\code{\link{plot.ppca}}: several plots associated to a phylogenetic
+principal component analysis (see \code{\link{ppca}}).\cr
+
+=== DATASETS ===\cr Several datasets are also proposed. Some of these
+datasets replace former version from \code{ade4}, which are now deprecated.
+Here is a list of available datasets: \code{\link{carni19}},
+\code{\link{carni70}}, \code{\link{lizards}}, \code{\link{maples}},
+\code{\link{mjrochet}}, \code{\link{palm}}, \code{\link{procella}},
+\code{\link{tithonia}}, and \code{\link{ungulates}}.\cr
+
+To cite adephylo, please use the reference given by
+\code{citation("adephylo")}.
+
+\tabular{ll}{ Package: \tab adephylo\cr Type: \tab Package\cr Version: \tab
+1.1-7\cr Date: \tab 2014-11-10 \cr License: \tab GPL (>=2) }
+}
+\author{
+Thibaut Jombart <tjombart at imperial.ac.uk>\cr with contributions
+Stephane Dray <stephane.dray at univ-lyon1.fr> and Anders Ellern Bilgrau
+<abilgrau at math.aau.dk>. \cr Parts of former code from \code{ade4} by Daniel
+Chessel and Sebastien Ollier.
+}
+\seealso{
+The \code{ade4} package for multivariate analysis.
+}
+\keyword{manip}
+\keyword{multivariate}
+
diff --git a/man/bullseye.Rd b/man/bullseye.Rd
new file mode 100644
index 0000000..fbb80cb
--- /dev/null
+++ b/man/bullseye.Rd
@@ -0,0 +1,97 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/bullseye.R
+\name{bullseye}
+\alias{bullseye}
+\title{Fan-like phylogeny with possible representation of traits on tips}
+\usage{
+bullseye(phy, traits = NULL, col.tips.by = NULL, col.pal = spectral,
+ circ.n = 6, circ.bg = transp("royalblue", 0.1), circ.unit = NULL,
+ legend = TRUE, leg.posi = "bottomleft", leg.title = "",
+ leg.bg = "white", traits.inset = 1.1, traits.space = 0.05,
+ traits.pch = 19, traits.cex = 1, alpha = 1, axis = TRUE, ...)
+}
+\arguments{
+\item{phy}{a tree in \code{phylo}, \linkS4class{phylo4} or
+\linkS4class{phylo4d} format.}
+
+\item{traits}{an optional data.frame of traits.}
+
+\item{col.tips.by}{an optional vector used to define colors for tip labels;
+if unamed, must be ordered in the same order as \code{phy$tip.label}.}
+
+\item{col.pal}{a function generating colors according to a given palette;
+several palettes can be provided as a list, in the case of several traits;
+the first palette is always reserved for the tip colors; this argument is
+recycled.}
+
+\item{circ.n}{the number of circles for the distance annotations.}
+
+\item{circ.bg}{the color of the circles.}
+
+\item{circ.unit}{the unit of the circles; if NULL, determined automatically
+from the data.}
+
+\item{legend}{a logical specifying whether a legend should be plotted; only
+one legend is displayed, with priority to tip colors first, and then to the
+first trait.}
+
+\item{leg.posi, leg.title, leg.bg}{position, title and background for the
+legend.}
+
+\item{traits.inset}{inset for positioning the traits; 1 corresponds to the
+circle crossing the furthest tip, 0 to the center of the plot.}
+
+\item{traits.space}{a coefficient indicating the spacing between traits.}
+
+\item{traits.pch, traits.cex}{type and size of the symbols used for the
+traits; recycled if needed.}
+
+\item{alpha}{alpha value to be used for the color transparency, between 0
+(invisible) and 1 (plain).}
+
+\item{axis}{a logical indicating whether an axis should be displayed.}
+
+\item{\dots}{further arguments to be passed to plot methods from \code{ape}.
+See \code{\link[ape]{plot.phylo}}.}
+}
+\description{
+This function represents a phylogeny as a fan, using circles to provide a
+legend for distances and optionally colored symbols to represent traits
+associated to the tips of the tree. This function uses and is compatible
+with ape's \code{\link[ape]{plot.phylo}}.
+}
+\examples{
+
+if(require(ape) && require(phylobase) && require(adegenet)){
+
+data(lizards)
+tre <- read.tree(text=lizards$hprA) # make a tree
+
+## basic plots
+bullseye(tre)
+bullseye(tre, lizards$traits)
+
+## customized
+par(mar=c(6,6,6,6))
+bullseye(tre, lizards$traits, traits.cex=sqrt(1:7), alpha=.7,
+ legend=FALSE, circ.unit=10, circ.bg=transp("black",.1),
+ edge.width=2)
+
+}
+
+}
+\author{
+Thibaut Jombart \email{tjombart at imperial.ac.uk}
+}
+\seealso{
+\code{\link{table.phylo4d}} for non-radial plots.\cr
+
+The \linkS4class{phylo4d} class for storing \code{phylogeny+data}.\cr
+
+\code{\link[ape]{plot.phylo}} from the \code{ape} package.\cr
+
+\code{\link[ade4]{dotchart.phylog}}.
+}
+\keyword{hplot}
+\keyword{multivariate}
+
diff --git a/man/carni19.Rd b/man/carni19.Rd
new file mode 100644
index 0000000..b24805b
--- /dev/null
+++ b/man/carni19.Rd
@@ -0,0 +1,37 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/adephylo-package.R
+\docType{data}
+\name{carni19}
+\alias{carni19}
+\title{Phylogeny and quantative trait of carnivora}
+\format{\code{carni19} is a list containing the 2 following objects :
+\describe{ \item{tre}{is a character string giving the phylogenetic tree in
+Newick format.} \item{bm}{is a numeric vector which values correspond to the
+body mass of the 19 species (log scale).} }}
+\source{
+Diniz-Filho, J. A. F., de Sant'Ana, C.E.R. and Bini, L.M. (1998) An
+eigenvector method for estimating phylogenetic inertia. \emph{Evolution},
+\bold{52}, 1247--1262.
+}
+\description{
+This data set describes the phylogeny of carnivora as reported by
+Diniz-Filho et al. (1998). It also gives the body mass of these 19 species.
+}
+\note{
+This dataset replaces the former version in ade4.
+}
+\examples{
+
+\dontrun{
+if(require(ape) && require(phylobase)){
+
+data(carni19)
+tre <- read.tree(text=carni19$tre)
+x <- phylo4d(tre, data.frame(carni19$bm))
+table.phylo4d(x, ratio=.5, center=FALSE)
+}
+}
+
+}
+\keyword{datasets}
+
diff --git a/man/carni70.Rd b/man/carni70.Rd
new file mode 100644
index 0000000..e1d1a32
--- /dev/null
+++ b/man/carni70.Rd
@@ -0,0 +1,55 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/adephylo-package.R
+\docType{data}
+\name{carni70}
+\alias{carni70}
+\title{Phylogeny and quantitative traits of carnivora}
+\format{\code{carni70} is a list containing the 2 following objects:
+\describe{ \item{tre}{is a character string giving the phylogenetic tree in
+Newick format. Branch lengths are expressed as divergence times (millions
+of years)} \item{tab}{is a data frame with 70 species and two traits: size
+(body size (kg)) ; range (geographic range size (km)).} }}
+\source{
+Diniz-Filho, J. A. F., and N. M. Torres. (2002) Phylogenetic
+comparative methods and the geographic range size-body size relationship in
+new world terrestrial carnivora. \emph{Evolutionary Ecology}, \bold{16},
+351--367.
+}
+\description{
+This data set describes the phylogeny of 70 carnivora as reported by
+Diniz-Filho and Torres (2002). It also gives the geographic range size and
+body size corresponding to these 70 species.
+}
+\note{
+This dataset replaces the former version in ade4.
+}
+\examples{
+
+\dontrun{
+if(require(ape) && require(phylobase)){
+
+data(carni70)
+rownames(carni70$tab) <- gsub("_", ".", rownames(carni70$tab))
+tre <- read.tree(text=carni70$tre)
+x <- phylo4d(tre, carni70$tab)
+table.phylo4d(x)
+
+par(mar=rep(.1,4))
+table.phylo4d(x,cex.lab=.5, show.n=FALSE, ratio=.5)
+
+
+## transform size in log and test for a phylogenetic signal
+size <- log(carni70$tab)[,1]
+names(size) <- row.names(carni70$tab)
+orthogram(size, tre)
+
+## transform range and test for a phylogenetic signal
+yrange <- scale(carni70$tab)[,2]
+names(yrange) <- row.names(carni70$tab)
+orthogram(yrange, tre)
+}
+}
+
+}
+\keyword{datasets}
+
diff --git a/man/dibas.Rd b/man/dibas.Rd
new file mode 100644
index 0000000..98aa9d3
--- /dev/null
+++ b/man/dibas.Rd
@@ -0,0 +1,149 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/dibas.R
+\name{dibas}
+\alias{dibas}
+\alias{dibas.dist}
+\alias{dibas.matrix}
+\alias{dibas.phylo}
+\alias{dibas.vector}
+\alias{simDatGroups}
+\title{DIstance-Based Assignment}
+\usage{
+dibas(x, ...)
+
+\method{dibas}{matrix}(x, grp, method = c("default", "leaveOneOut"), ...)
+
+\method{dibas}{vector}(x, grp, method = c("default", "leaveOneOut"),
+ n.items = NULL, ...)
+
+\method{dibas}{phylo}(x, grp, method = c("default", "leaveOneOut"),
+ fromRoot = FALSE, metric = c("Abouheif", "nNodes", "patristic", "sumDD"),
+ n.items = NULL, ...)
+
+\method{dibas}{dist}(x, grp, method = c("default", "leaveOneOut"), ...)
+}
+\arguments{
+\item{x}{a \code{phylo} object, or a symmetric matrix of pairwise distances
+of class \code{matrix} or \code{dist}.}
+
+\item{grp}{a \code{factor} indicating the groups of observations.}
+
+\item{method}{a character string indicating the method to be used for
+estimating the distribution of pairwise distances within groups. The
+default method ("default") uses all observations, while the "leaveOneOut"
+estimates separate group distributions for each individual, leaving this
+one out in the estimation process.}
+
+\item{n.items}{a vector of integers of the same length as x, stating how many
+times each items in 'x' should be repeated; used to take into account
+differences in abundances of the different items (e.g. sequences in
+multiple copies).}
+
+\item{fromRoot}{a logical indicating if distances from the root, rather than
+between groups, should be used.}
+
+\item{metric}{a character string matching "nNodes", "patristic", "Abouheif",
+or "sumDD" indicating the distance measure to be used. See
+\code{\link{distTips}} for more information. Note that patristic distances
+should be avoided in presence of one or more highly diverse group because
+of the 'hand fan' syndrome (see example).}
+
+\item{\dots}{further arguments passed to other methods. Can be used to
+provide arguments to \code{\link{table.phylo4d}} in \code{plot} method.}
+}
+\description{
+These functions are under development. Please do not use them unless asked by
+the author.
+}
+\examples{
+
+\dontrun{
+if(require(ape)){
+#### SIMPLE SIMULATED DATA ####
+## 50 variables, 2 groups, 30 indiv
+dat <- simDatGroups(k=2, p=50, n=c(15,15), mu=c(0,1))
+names(dat)
+
+## make a tree
+tre <- nj(dist(dat$dat))
+plot(tre,type="unr", tip.col=c("blue","red")[as.integer(dat$grp)],
+ main="simulated data - tree")
+
+## use dibas method
+res <- dibas(tre, dat$grp, metric="nNodes")
+res
+
+barplot(t(res$prob), main="group membership probabilities")
+
+
+
+#### NON-PARAMETRIC TEST BASED ON MEAN SUCCESSFUL ASSIGNMENT ####
+## use dibas method
+distHo <- replicate(100,
+ dibas(tre, sample(dat$grp), metric="patristic")$mean.ok)
+pval <- mean(res$mean.ok<=c(distHo,res$mean.ok))
+pval
+
+hist(c(distHo,res$mean.ok), col="grey",
+ main="Mean successful assignement - permuted values")
+abline(v=res$mean.ok, col="red")
+mtext(side=3, text="Observed value in red")
+
+
+
+#### HAND FAN SYNDROME ####
+## 50 variables, 2 groups, 30 indiv
+dat <- simDatGroups(k=2, p=50, n=c(15,15), mu=c(0,1), sigma=c(2,4))
+names(dat)
+
+## make a tree
+tre <- nj(dist(dat$dat))
+plot(tre,type="unr", tip.col=c("blue","red")[as.integer(dat$grp)],
+ main="simulated data - tree")
+mtext(side=3, text="hand-fan syndrome")
+
+## use dibas method
+res.patri <- dibas(tre, dat$grp, metric="patristic")
+res.patri$grp.tab # poor results
+plot(table(res.patri$groups), main="Group assignment - dibas patristic")
+
+res <- dibas(tre, dat$grp, metric="nNodes")
+res$grp.tab # results OK
+plot(table(res$groups), main="Group assignment - dibas nNodes")
+
+
+
+
+#### MORE COMPLEX DATASET ####
+if(require(adegenet)){
+
+dat <- simDatGroups(k=5, p=50, n=c(5,10,10,30,60), mu=sample(1:5, 5,
+ replace=TRUE), sigma=sample(1:5)/2)
+names(dat)
+
+## make a tree
+tre <- nj(dist(dat$dat))
+plot(tre,type="unr", tip.col=fac2col(dat$grp),main="simulated data - tree")
+
+## use dibas method
+res <- dibas(tre, dat$grp, metric="Abouheif")
+res
+
+plot(table(res$groups), main="Group assignment - dibas Abouheif")
+
+}
+}
+}
+
+
+
+
+
+
+
+}
+\author{
+Thibaut Jombart \email{tjombart at imperial.ac.uk}
+}
+\keyword{multivariate}
+
diff --git a/man/distRoot.Rd b/man/distRoot.Rd
new file mode 100644
index 0000000..80cc7c6
--- /dev/null
+++ b/man/distRoot.Rd
@@ -0,0 +1,74 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/distances.R
+\name{distRoot}
+\alias{distRoot}
+\title{Compute the distance of tips to the root}
+\usage{
+distRoot(x, tips = "all", method = c("patristic", "nNodes", "Abouheif",
+ "sumDD"))
+}
+\arguments{
+\item{x}{a tree of class \code{\link[ape:read.tree]{phylo}},
+\linkS4class{phylo4} or \linkS4class{phylo4d}.}
+
+\item{tips}{A vector of integers identifying tips by their numbers, or a
+vector of characters identifying tips by their names.}
+
+\item{method}{a character string (full or abbreviated without ambiguity)
+specifying the method used to compute distances ; possible values are:\cr -
+\code{patristic}: patristic distance, i.e. sum of branch lengths \cr -
+\code{nNodes}: number of nodes on the path between the nodes \cr -
+\code{Abouheif}: Abouheif's distance (see details) \cr - \code{sumDD}: sum
+of direct descendants of all nodes on the path (see details) \cr}
+}
+\value{
+A numeric vector containing one distance value for each tip.
+}
+\description{
+The function \code{distRoot} computes the distance of a set of tips to the
+root. Several distances can be used, defaulting to the sum of branch
+lengths.
+}
+\details{
+\code{Abouheif} distance refers to the phylogenetic distance underlying the
+test of Abouheif (see references). Let P be the set of all the nodes in the
+path going from \code{node1} to \code{node2}. Let DDP be the number of
+direct descendants from each node in P. Then, the so-called 'Abouheif'
+distance is the product of all terms in DDP.\cr
+
+\code{sumDD} refers to a phylogenetic distance quite similar to that of
+Abouheif. We consider the same sets P and DDP. But instead of computing the
+product of all terms in DDP, this distance computes the sum of all terms in
+DDP.
+}
+\examples{
+
+if(require(ape) & require(phylobase)){
+## make a tree
+x <- as(rtree(50),"phylo4")
+## compute 4 different distances
+met <- c("patristic","nNodes","Abouheif","sumDD")
+D <- lapply(met, function(e) distRoot(x, method=e) )
+names(D) <- met
+D <- as.data.frame(D)
+
+## plot these distances along with the tree
+temp <- phylo4d(x, D)
+table.phylo4d(temp, show.node=FALSE, cex.lab=.6)
+}
+
+}
+\author{
+Thibaut Jombart \email{tjombart at imperial.ac.uk}
+}
+\references{
+Pavoine, S.; Ollier, S.; Pontier, D. & Chessel, D. (2008)
+Testing for phylogenetic signal in life history variable: Abouheif's test
+revisited. \emph{Theoretical Population Biology}: \bold{73}, 79-91.
+}
+\seealso{
+\code{\link{distTips}} which computes the same phylogenetic
+distances, but between tips.
+}
+\keyword{manip}
+
diff --git a/man/distTips.Rd b/man/distTips.Rd
new file mode 100644
index 0000000..c00267e
--- /dev/null
+++ b/man/distTips.Rd
@@ -0,0 +1,100 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/distances.R
+\name{distTips}
+\alias{distTips}
+\title{Compute some phylogenetic distance between tips}
+\usage{
+distTips(x, tips = "all", method = c("patristic", "nNodes", "Abouheif",
+ "sumDD"), useC = TRUE)
+}
+\arguments{
+\item{x}{a tree of class \code{\link[ape:read.tree]{phylo}},
+\linkS4class{phylo4} or \linkS4class{phylo4d}.}
+
+\item{tips}{A vector of integers identifying tips by their numbers, or a
+vector of characters identifying tips by their names. Distances will be
+computed between all possible pairs of tips.}
+
+\item{method}{a character string (full or abbreviated without ambiguity)
+specifying the method used to compute distances ; possible values are:\cr -
+\code{patristic}: patristic distance, i.e. sum of branch lengths \cr -
+\code{nNodes}: number of nodes on the path between the nodes \cr -
+\code{Abouheif}: Abouheif's distance (see details) \cr - \code{sumDD}: sum
+of direct descendants of all nodes on the path (see details) \cr}
+
+\item{useC}{a logical indicating whether computations should be performed
+using compiled C code (TRUE, default), or using a pure R version (FALSE). C
+version is several orders of magnitude faster, and R version is kept for
+backward compatibility.}
+}
+\value{
+An object of class \code{dist}, containing phylogenetic distances.
+}
+\description{
+The function \code{distTips} computes a given distance between a set of tips
+of a phylogeny. A vector of tips is supplied: distances between all possible
+pairs of these tips are computed. The distances are computed from the
+shortest path between the tips. Several distances can be used, defaulting to
+the sum of branch lengths (see argument \code{method}).
+}
+\details{
+An option (enabled by default) allows computations to be run using compiled
+C code, which is much faster than pure R code. In this case, a matrix of all
+pairwise distances is returned (i.e., \code{tips} argument is ignored).
+
+\code{Abouheif} distance refers to the phylogenetic distance underlying the
+test of Abouheif (see references). Let P be the set of all the nodes in the
+path going from \code{node1} to \code{node2}. Let DDP be the number of
+direct descendants from each node in P. Then, the so-called 'Abouheif'
+distance is the product of all terms in DDP.\cr
+
+\code{sumDD} refers to a phylogenetic distance quite similar to that of
+Abouheif. We consider the same sets P and DDP. But instead of computing the
+product of all terms in DDP, this distance computes the sum of all terms in
+DDP.
+}
+\examples{
+
+if(require(ape) & require(phylobase)){
+## make a tree
+x <- as(rtree(10),"phylo4")
+plot(x, show.node=TRUE)
+axisPhylo()
+## compute different distances
+distTips(x, 1:3)
+distTips(x, 1:3, "nNodes")
+distTips(x, 1:3, "Abouheif")
+distTips(x, 1:3, "sumDD")
+
+## compare C and pure R code outputs
+x <- rtree(10)
+all.equal(as.matrix(distTips(x)), as.matrix(distTips(x, useC=FALSE)))
+all.equal(as.matrix(distTips(x, meth="nNode")),
+ as.matrix(distTips(x, meth="nNode", useC=FALSE)))
+all.equal(as.matrix(distTips(x, meth="Abou")),
+ as.matrix(distTips(x, meth="Abou", useC=FALSE)))
+all.equal(as.matrix(distTips(x, meth="sumDD")),
+ as.matrix(distTips(x, meth="sumDD", useC=FALSE)))
+
+## compare speed
+x <- rtree(50)
+tim1 <- system.time(distTips(x, useC=FALSE)) # old pure R version
+tim2 <- system.time(distTips(x)) # new version using C
+tim1[c(1,3)]/tim2[c(1,3)] # C is about a thousand time faster in this case
+}
+
+}
+\author{
+Thibaut Jombart \email{tjombart at imperial.ac.uk}
+}
+\references{
+Pavoine, S.; Ollier, S.; Pontier, D. & Chessel, D. (2008)
+Testing for phylogenetic signal in life history variable: Abouheif's test
+revisited. \emph{Theoretical Population Biology}: \bold{73}, 79-91.
+}
+\seealso{
+\code{\link{distTips}} which computes several phylogenetic
+distances between tips.
+}
+\keyword{manip}
+
diff --git a/man/listDD.Rd b/man/listDD.Rd
new file mode 100644
index 0000000..286c1ff
--- /dev/null
+++ b/man/listDD.Rd
@@ -0,0 +1,46 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/utils.R
+\name{listDD}
+\alias{listDD}
+\title{List direct descendants for all nodes of a tree}
+\usage{
+listDD(x, nameBy = c("label", "number"))
+}
+\arguments{
+\item{x}{A tree of class \code{\link[ape:read.tree]{phylo}},
+\linkS4class{phylo4} or \linkS4class{phylo4d}.}
+
+\item{nameBy}{a character string indicating whether the returned list must
+be named by node labels ("label") or by node numbers ("number").}
+}
+\value{
+A list whose components are vectors of named nodes (or tips) for a
+given internal node.
+}
+\description{
+The function \code{listDD} lists the direct descendants from each node of a
+tree. The tree can be of class \code{\link[ape:read.tree]{phylo}},
+\linkS4class{phylo4} or \linkS4class{phylo4d}.
+}
+\examples{
+
+if(require(ape) & require(phylobase)){
+## make a tree
+x <- as(rtree(20),"phylo4")
+plot(x,show.node=TRUE)
+listDD(x)
+}
+
+}
+\author{
+Thibaut Jombart \email{tjombart at imperial.ac.uk}
+}
+\seealso{
+\code{\link{listTips}} which lists the tips descending from each
+node. \cr
+
+\code{\link{treePart}} which defines partitions of tips according to the
+tree topology.
+}
+\keyword{manip}
+
diff --git a/man/listTips.Rd b/man/listTips.Rd
new file mode 100644
index 0000000..02c666f
--- /dev/null
+++ b/man/listTips.Rd
@@ -0,0 +1,42 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/partition.R
+\name{listTips}
+\alias{listTips}
+\title{List tips descendings from all nodes of a tree}
+\usage{
+listTips(x)
+}
+\arguments{
+\item{x}{A tree of class \code{\link[ape:read.tree]{phylo}},
+\linkS4class{phylo4} or \linkS4class{phylo4d}.}
+}
+\value{
+A list whose components are vectors of named tips for a given node.
+}
+\description{
+The function \code{listTips} lists the tips descending from each node of a
+tree. The tree can be of class \code{\link[ape:read.tree]{phylo}},
+\linkS4class{phylo4} or \linkS4class{phylo4d}.
+}
+\examples{
+
+if(require(ape) & require(phylobase)){
+## make a tree
+x <- as(rtree(20),"phylo4")
+plot(x,show.node=TRUE)
+listTips(x)
+}
+
+}
+\author{
+Thibaut Jombart \email{tjombart at imperial.ac.uk}
+}
+\seealso{
+\code{\link{listDD}} which lists the direct descendants for each
+node. \cr
+
+\code{\link{treePart}} which defines partitions of tips according to the
+tree topology.
+}
+\keyword{manip}
+
diff --git a/man/lizards.Rd b/man/lizards.Rd
new file mode 100644
index 0000000..2b54562
--- /dev/null
+++ b/man/lizards.Rd
@@ -0,0 +1,75 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/adephylo-package.R
+\docType{data}
+\name{lizards}
+\alias{lizards}
+\title{Phylogeny and quantitative traits of lizards}
+\format{\code{lizards} is a list containing the 3 following objects :
+\describe{ \item{traits}{is a data frame with 18 species and 8 traits.}
+\item{hprA}{is a character string giving the phylogenetic tree (hypothesized
+phylogenetic relationships based on immunological distances) in Newick
+format.} \item{hprB}{is a character string giving the phylogenetic tree
+(hypothesized phylogenetic relationships based on morphological
+characteristics) in Newick format.} }}
+\description{
+This data set describes the phylogeny of 18 lizards as reported by Bauwens
+and D\'iaz-Uriarte (1997). It also gives life-history traits corresponding
+to these 18 species.
+}
+\details{
+Variables of \code{lizards$traits} are the following ones : mean.L (mean
+length (mm)), matur.L (length at maturity (mm)), max.L (maximum length
+(mm)), hatch.L (hatchling length (mm)), hatch.m (hatchling mass (g)),
+clutch.S (Clutch size), age.mat (age at maturity (number of months of
+activity)), clutch.F (clutch frequency).
+}
+\note{
+This dataset replaces the former version in ade4.
+}
+\examples{
+
+\dontrun{
+if(require(ape) && require(phylobase)){
+
+## see data
+data(lizards)
+liz.tr <- read.tree(tex=lizards$hprA) # make a tree
+liz <- phylo4d(liz.tr, lizards$traits) # make a phylo4d object
+table.phylo4d(liz)
+
+## compute and plot principal components
+if(require(ade4)){
+liz.pca1 <- dudi.pca(lizards$traits, cent=TRUE,
+ scale=TRUE, scannf=FALSE, nf=2) # PCA of traits
+myPC <- phylo4d(liz.tr, liz.pca1$li) # store PC in a phylo4d object
+varlab <- paste("Principal \\ncomponent", 1:2) # make labels for PCs
+table.phylo4d(myPC, ratio=.8, var.lab=varlab) # plot the PCs
+add.scatter.eig(liz.pca1$eig,2,1,2,posi="topleft", inset=c(0,.15))
+title("Phylogeny and the principal components")
+
+## compute a pPCA ##
+## remove size effect
+temp <- lapply(liz.pca1$tab, function(e) residuals(lm(e~-1+liz.pca1$li[,1])) )
+temp <- data.frame(temp)
+row.names(temp) <- tipLabels(liz)
+
+## build corresponding phylo4d object
+liz.noSize <- phylo4d(liz.tr, temp)
+ppca1 <- ppca(liz.noSize, method="Abouheif", scale=FALSE, scannf=FALSE)
+plot(ppca1)
+
+}
+}
+}
+
+}
+\references{
+Bauwens, D., and D\'iaz-Uriarte, R. (1997) Covariation of
+life-history traits in lacertid lizards: a comparative study.
+\emph{American Naturalist}, \bold{149}, 91--111.
+
+See a data description at \url{http://pbil.univ-lyon1.fr/R/pdf/pps063.pdf}
+(in French).
+}
+\keyword{datasets}
+
diff --git a/man/maples.Rd b/man/maples.Rd
new file mode 100644
index 0000000..00cc723
--- /dev/null
+++ b/man/maples.Rd
@@ -0,0 +1,56 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/adephylo-package.R
+\docType{data}
+\name{maples}
+\alias{maples}
+\title{Phylogeny and quantitative traits of flowers}
+\format{\code{tithonia} is a list containing the 2 following objects : -
+tre: a character string giving the phylogenetic tree in Newick format.\cr -
+tab: a data frame with 17 species and 31 traits.\cr}
+\description{
+This data set describes the phylogeny of 17 flowers as reported by Ackerly
+and Donoghue (1998). It also gives 31 traits corresponding to these 17
+species.
+}
+\note{
+This dataset replaces the former version in ade4.
+}
+\examples{
+
+\dontrun{
+if(require(ape) && require(phylobase)){
+
+data(maples)
+
+## see the tree
+tre <- read.tree(text=maples$tre)
+plot(tre)
+axisPhylo()
+
+## look at two variables
+dom <- maples$tab$Dom
+bif <- maples$tab$Bif
+plot(bif,dom,pch = 20)
+abline(lm(dom~bif)) # a strong negative correlation ?
+summary(lm(dom~bif))
+cor.test(bif,dom)
+
+## look at the two variables onto the phylogeny
+temp <- phylo4d(tre, data.frame(dom,bif, row.names=tre$tip.label))
+table.phylo4d(temp) # correlation is strongly linked to phylogeny
+
+## use ape's PIC (phylogenetic independent contrasts)
+pic.bif <- pic(bif, tre)
+pic.dom <- pic(dom, tre)
+cor.test(pic.bif, pic.dom) # correlation is no longer significant
+}
+}
+
+}
+\references{
+Ackerly, D. D. and Donoghue, M.J. (1998) Leaf size, sappling
+allometry, and Corner's rules: phylogeny and correlated evolution in Maples
+(Acer). \emph{American Naturalist}, \bold{152}, 767--791.
+}
+\keyword{datasets}
+
diff --git a/man/miscUtils.Rd b/man/miscUtils.Rd
new file mode 100644
index 0000000..6367121
--- /dev/null
+++ b/man/miscUtils.Rd
@@ -0,0 +1,50 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/utils.R
+\name{.tipToRoot}
+\alias{.tipToRoot}
+\title{Low-level auxiliary functions for adephylo}
+\usage{
+.tipToRoot(x, tip, root, include.root = FALSE)
+}
+\arguments{
+\item{x}{A valid tree of class \linkS4class{phylo4}.}
+
+\item{tip}{An integer identifying a tip by its numbers.}
+
+\item{root}{An integer identifying the root of the tree by its number.}
+
+\item{include.root}{a logical stating whether the root must be included as a
+node of the path from tip to root (TRUE), or not (FALSE, default).}
+}
+\value{
+\code{.tipToRoot}: a vector of named integers identifying nodes.\cr
+}
+\description{
+These hidden functions are utils for adephylo, used by other functions.
+Regular users can use them as well, but no validity checks are performed for
+the arguments: speed is here favored over safety. Most of these functions
+handle trees inheriting \linkS4class{phylo4} class.\cr
+}
+\details{
+\code{.tipToRoot} finds the set of nodes between a tip and the root of a
+tree.\cr
+}
+\examples{
+
+if(require(ape) & require(phylobase)){
+## make a tree
+x <- as(rtree(20),"phylo4")
+plot(x,show.node=TRUE)
+
+## .tipToRoot
+root <- rootNode(x)
+.tipToRoot(x, 1, root)
+lapply(1:nTips(x), function(i) .tipToRoot(x, i, root))
+}
+
+}
+\author{
+Thibaut Jombart \email{tjombart at imperial.ac.uk}
+}
+\keyword{manip}
+
diff --git a/man/mjrochet.Rd b/man/mjrochet.Rd
new file mode 100644
index 0000000..8febde2
--- /dev/null
+++ b/man/mjrochet.Rd
@@ -0,0 +1,54 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/adephylo-package.R
+\docType{data}
+\name{mjrochet}
+\alias{mjrochet}
+\title{Phylogeny and quantitative traits of teleos fishes}
+\format{\code{mjrochet} is a list containing the 2 following objects :
+\describe{ \item{tre}{is a character string giving the phylogenetic tree in
+Newick format.} \item{tab}{is a data frame with 49 rows and 7 traits.} }}
+\description{
+This data set describes the phylogeny of 49 teleos fishes as reported by
+Rochet et al. (2000). It also gives life-history traits corresponding to
+these 49 species.
+}
+\details{
+Variables of \code{mjrochet$tab} are the following ones : tm (age at
+maturity (years)), lm (length at maturity (cm)), l05 (length at 5 per cent
+survival (cm)), t05 (time to 5 per cent survival (years)), fb (slope of the
+log-log fecundity-length relationship), fm (fecundity the year of maturity),
+egg (volume of eggs (\eqn{mm^{3}}{mm^3})).
+}
+\note{
+This dataset replaces the former version in ade4.
+}
+\examples{
+
+\dontrun{
+if(require(ape) && require(phylobase)){
+
+data(mjrochet)
+tre <- read.tree(text=mjrochet$tre) # make a tree
+traits <- log((mjrochet$tab))
+
+## build a phylo4d
+mjr <- phylo4d(tre, traits)
+
+## see data
+table.phylo4d(mjr,cex.lab=.5,show.node=FALSE,symb="square")
+
+## perform Abouheif's test for each trait
+mjr.tests <- abouheif.moran(mjr, nrep=499)
+mjr.tests
+
+}
+}
+
+}
+\references{
+Rochet, M. J., Cornillon, P-A., Sabatier, R. and Pontier, D.
+(2000) Comparative analysis of phylogenic and fishing effects in life
+history patterns of teleos fishes. \emph{Oikos}, \bold{91}, 255--270.
+}
+\keyword{datasets}
+
diff --git a/man/moranIdx.Rd b/man/moranIdx.Rd
new file mode 100644
index 0000000..11a8ed0
--- /dev/null
+++ b/man/moranIdx.Rd
@@ -0,0 +1,76 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/moran.R
+\name{moran.idx}
+\alias{moran.idx}
+\title{Computes Moran's index for a variable}
+\usage{
+moran.idx(x, prox, addInfo = FALSE)
+}
+\arguments{
+\item{x}{a numeric vector whose autocorrelation is computed.}
+
+\item{prox}{a matrix of proximities between observations, as computed by the
+\code{\link{proxTips}}. Off-diagonal terms must be positive or null, while
+diagonal terms must all equal zero.}
+
+\item{addInfo}{a logical indicating whether supplementary info (null value,
+minimum and maximum values) should be returned (TRUE) or not (FALSE,
+default); if computed, these quantities are returned as attributes.}
+}
+\value{
+The numeric value of Moran's index.
+}
+\description{
+This simple function computes Moran's index of autocorrelation given a
+variable and a matrix of proximities among observations.
+}
+\examples{
+
+\dontrun{
+## use maples dataset
+data(maples)
+tre <- read.tree(text=maples$tre)
+dom <- maples$tab$Dom
+bif <- maples$tab$Bif
+
+
+## get a proximity matrix between tips
+W <- proxTips(tre, met="Abouheif")
+
+## compute Moran's I for two traits (dom and bif)
+moran.idx(dom, W)
+moran.idx(bif, W)
+moran.idx(rnorm(nTips(tre)), W)
+
+## build a simple permutation test for 'bif'
+sim <- replicate(499, moran.idx(sample(bif), W)) # permutations
+sim <- c(moran.idx(bif, W), sim)
+
+pval <- mean(sim>=sim[1]) # right-tail p-value
+pval
+
+hist(sim, col="grey", main="Moran's I Monte Carlo test for 'bif'") # plot
+mtext("Histogram of permutations and observation (in red)")
+abline(v=sim[1], col="red", lwd=3)
+
+}
+}
+\author{
+Thibaut Jombart \email{tjombart at imperial.ac.uk}
+}
+\references{
+Moran, P.A.P. (1948) The interpretation of statistical maps.
+\emph{Journal of the Royal Statistical Society, B} \bold{10}, 243--251.
+
+Moran, P.A.P. (1950) Notes on continuous stochastic phenomena.
+\emph{Biometrika}, \bold{37}, 17--23.
+
+de Jong, P. and Sprenger, C. and van Veen, F. (1984) On extreme values of
+Moran's I and Geary's c. \emph{Geographical Analysis}, \bold{16}, 17--24.
+}
+\seealso{
+\code{\link{proxTips}} which computes phylogenetic proximities
+between tips of a phylogeny.
+}
+\keyword{manip}
+
diff --git a/man/orthobasis.Rd b/man/orthobasis.Rd
new file mode 100644
index 0000000..355eea9
--- /dev/null
+++ b/man/orthobasis.Rd
@@ -0,0 +1,125 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/orthobasis.R
+\name{orthobasis.phylo}
+\alias{me.phylo}
+\alias{orthobasis.phylo}
+\title{Computes Moran's eigenvectors from a tree or a phylogenetic proximity matrix}
+\usage{
+orthobasis.phylo(x = NULL, prox = NULL, method = c("patristic", "nNodes",
+ "oriAbouheif", "Abouheif", "sumDD"), f = function(x) { 1/x })
+}
+\arguments{
+\item{x}{A tree of class \code{\link[ape:read.tree]{phylo}},
+\linkS4class{phylo4} or \linkS4class{phylo4d}.}
+
+\item{prox}{a matrix of phylogenetic proximities as returned by
+\code{\link{proxTips}}.}
+
+\item{method}{a character string (full or abbreviated without ambiguity)
+specifying the method used to compute proximities; possible values are:\cr -
+\code{patristic}: (inversed sum of) branch lengths \cr - \code{nNodes}:
+(inversed) number of nodes on the path between the nodes \cr -
+\code{oriAbouheif}: original Abouheif's proximity, with diagonal (see
+details in \code{\link{proxTips}}) \cr - \code{Abouheif}: Abouheif's
+proximity (see details in \code{\link{proxTips}}) \cr - \code{sumDD}:
+(inversed) sum of direct descendants of all nodes on the path (see details
+in \code{\link{proxTips}}).}
+
+\item{f}{a function to change a distance into a proximity.}
+}
+\value{
+An object of class \code{orthobasis}. This is a data.frame with
+Moran's eigenvectors in column, with special attributes:\cr -
+attr(...,"values"): Moran's index for each vector - attr(...,"weights"):
+weights of tips; current implementation uses only uniform weights
+}
+\description{
+The function \code{orthobasis.phylo} (also nicknamed \code{me.phylo})
+computes Moran's eigenvectors (ME) associated to a tree. If the tree has 'n'
+tips, (n-1) vectors will be produced. These vectors form an orthonormal
+basis: they are centred to mean zero, have unit variance, and are
+uncorrelated. Each vector models a different pattern of phylogenetic
+autocorrelation. The first vectors are those with maximum positive
+autocorrelation, while the last vectors are those with maximum negative
+autocorrelation. ME can be used, for instance, as regressors to remove
+phylogenetic autocorrelation from data (see references).\cr
+}
+\details{
+ME can be obtained from a tree, specifying the phylogenetic proximity to be
+used. Alternatively, they can be obtained directly from a matrix of
+phylogenetic proximities as constructed by \code{\link{proxTips}}.
+}
+\examples{
+
+if(require(ape) && require(phylobase)){
+
+## SIMPLE EXAMPLE ##
+## make a tree
+x <- rtree(50)
+
+## compute Moran's eigenvectors
+ME <- me.phylo(x, met="Abouheif")
+ME
+
+## plot the 10 first vectors
+obj <- phylo4d(x, as.data.frame(ME[,1:10]))
+table.phylo4d(obj, cex.sym=.7, cex.lab=.7)
+
+
+\dontrun{
+## REMOVING PHYLOGENETIC AUTOCORRELATION IN A MODEL ##
+## use example in ungulates dataset
+data(ungulates)
+tre <- read.tree(text=ungulates$tre)
+plot(tre)
+
+## look at two traits
+afbw <- log(ungulates$tab[,1])
+neonatw <- log((ungulates$tab[,2]+ungulates$tab[,3])/2)
+names(afbw) <- tre$tip.label
+names(neonatw) <- tre$tip.label
+plot(afbw, neonatw) # relationship between traits
+lm1 <- lm(neonatw~afbw)
+abline(lm1)
+
+lm1
+resid1 <- residuals(lm1)
+orthogram(resid1, tre) # residuals are autocorrelated
+
+## compute Moran's eigenvectors (ME)
+myME <- me.phylo(tre, method="Abou")
+lm2 <- lm(neonatw ~ myME[,1] + afbw) # use for ME as covariable
+resid2 <- residuals(lm2)
+orthogram(resid2, tre) # there is no longer phylogenetic autocorrelation
+
+## see the difference
+table.phylo4d(phylo4d(tre, cbind.data.frame(resid1, resid2)))
+}
+}
+
+}
+\author{
+Thibaut Jombart \email{tjombart at imperial.ac.uk}
+}
+\references{
+Peres-Neto, P. (2006) A unified strategy for estimating and
+controlling spatial, temporal and phylogenetic autocorrelation in ecological
+models \emph{Oecologica Brasiliensis} \bold{10}: 105-119.\cr
+
+Dray, S.; Legendre, P. \& Peres-Neto, P. (2006) Spatial modelling: a
+comprehensive framework for principal coordinate analysis of neighbours
+matrices (PCNM) \emph{Ecological Modelling} \bold{196}: 483-493.\cr
+
+Griffith, D. \& Peres-Neto, P. (2006) Spatial modeling in ecology: the
+flexibility of eigenfunction spatial analyses \emph{Ecology} \bold{87}:
+2603-2613.\cr
+}
+\seealso{
+- \code{\link{proxTips}} which computes phylogenetic proximities
+between tips.\cr
+
+- \code{\link{treePart}} which can compute an orthobasis based on the
+topology of a phylogeny.\cr
+}
+\keyword{manip}
+
diff --git a/man/orthogram.Rd b/man/orthogram.Rd
new file mode 100644
index 0000000..073cd47
--- /dev/null
+++ b/man/orthogram.Rd
@@ -0,0 +1,154 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/orthogram.R
+\name{orthogram}
+\alias{orthogram}
+\title{Orthonormal decomposition of variance}
+\usage{
+orthogram(x, tre = NULL, orthobas = NULL, prox = NULL, nrepet = 999,
+ posinega = 0, tol = 1e-07, cdot = 1.5, cfont.main = 1.5, lwd = 2,
+ nclass, high.scores = 0, alter = c("greater", "less", "two-sided"))
+}
+\arguments{
+\item{x}{a numeric vector corresponding to the quantitative variable}
+
+\item{tre}{a tree of class \code{\link[ape:read.tree]{phylo}},
+\linkS4class{phylo4} or \linkS4class{phylo4d}.}
+
+\item{orthobas}{an object of class \code{'orthobasis'}}
+
+\item{prox}{a matrix of phylogenetic proximities as returned by
+\code{\link{proxTips}}.}
+
+\item{nrepet}{an integer giving the number of permutations}
+
+\item{posinega}{a parameter for the ratio test. If posinega > 0, the function
+computes the ratio test.}
+
+\item{tol}{a tolerance threshold for orthonormality condition}
+
+\item{cdot}{a character size for points on the cumulative decomposition
+display}
+
+\item{cfont.main}{a character size for titles}
+
+\item{lwd}{a character size for dash lines}
+
+\item{nclass}{a single number giving the number of cells for the histogram}
+
+\item{high.scores}{a single number giving the number of vectors to return. If
+> 0, the function returns labels of vectors that explains the larger part
+of variance.}
+
+\item{alter}{a character string specifying the alternative hypothesis, must
+be one of "greater" (default), "less" or "two-sided"}
+}
+\value{
+If (high.scores = 0), returns an object of class \code{'krandtest'}
+ (randomization tests) corresponding to the five non parametric tests. \cr
+ \cr If (high.scores > 0), returns a list containg : \item{w}{: an object of
+ class \code{'krandtest'} (randomization tests)} \item{scores.order}{: a
+ vector which terms give labels of vectors that explain the larger part of
+ variance}
+}
+\description{
+This function performs the orthonormal decomposition of variance of a
+quantitative variable on an orthonormal basis. It also returns the results of
+five non parametric tests associated to the variance decomposition. It thus
+provides tools (graphical displays and test) for analysing phylogenetic,
+pattern in one quantitative trait. This implementation replace the
+(deprecated) version from the \code{ade4} package.\cr
+}
+\details{
+Several orthonormal bases can be used. By default, basis is constructed from
+a partition of tips according to tree topology (as returned by
+\code{\link{treePart}}); for this, the argument \code{tre} must be provided.
+Alternatively, one can provide an orthonormal basis as returned by
+\code{\link{orthobasis.phylo}}/\code{\link{me.phylo}} (argument
+\code{orthobas}), or provide a proximity matrix from which an orthobasis
+based on Moran's eigenvectors will be constructed (argument \code{prox}).
+
+The function computes the variance decomposition of a quantitative vector x
+on an orthonormal basis B. The variable is normalized given the uniform
+weight to eliminate problem of scales. It plots the squared correlations
+\eqn{R^{2}}{R^2} between x and vectors of B (variance decomposition) and the
+cumulated squared correlations \eqn{SR^{2}}{SR^2} (cumulative decomposition).
+The function also provides five non parametric tests to test the existence of
+autocorrelation. The tests derive from the five following statistics :
+
+- R2Max=\eqn{\max(R^{2})}{max(R^2)}. It takes high value when a high part of
+the variability is explained by one score.\cr -
+SkR2k=\eqn{\sum_{i=1}^{n-1}(iR^{2}_i)}{sum_i^(n-1) i*(R^2)_i}. It compares
+the part of variance explained by internal nodes to the one explained by end
+nodes.\cr - Dmax=\eqn{\max_{m=1,...,n-1}(\sum_{j=1}^{m}R^{2}_j -
+}{max_(m=1,...,n-1)(sum_(j=1)^m(R^2_j) - (m/n-1))}\eqn{
+\frac{m}{n-1})}{max_(m=1,...,n-1)(sum_(j=1)^m(R^2_j) - (m/n-1))}. It examines
+the accumulation of variance for a sequence of scores.\cr -
+SCE=\eqn{\sum_{m=1}^{n-1} (\sum_{j=1}^{m}R^{2}_j -
+}{sum_(m=1)^(n-1)(sum_(j=1)^m(R^2_j) - (m/n-1))^2}\eqn{
+\frac{m}{n-1})^{2}}{sum_(m=1)^(n-1)(sum_(j=1)^m(R^2_j) - (m/n-1))^2}. It
+examines also the accumulation of variance for a sequence of scores.\cr -
+ratio: depends of the parameter posinega. If posinega > 0, the statistic
+ratio exists and equals \eqn{\sum_{i=1}^{posinega}R^{2}_i}{sum_i (R^2)_i with
+i < posinega + 1}. It compares the part of variance explained by internal
+nodes to the one explained by end nodes when we can define how many vectors
+correspond to internal nodes.
+}
+\note{
+This function replaces the former version from the ade4 package, which
+ is deprecated. Note that if ade4 is not loaded BEFORE adephylo, then the
+ version from ade4 will erase that of adephylo, which will still be
+ available from adephylo::orthogram. In practice, though, this should never
+ happen, since ade4 is loaded as a dependence by adephylo.
+}
+\examples{
+
+\dontrun{
+if(require(ape) && require(phylobase)){
+
+## a phylogenetic example
+data(ungulates)
+tre <- read.tree(text=ungulates$tre)
+plot(tre)
+
+## look at two traits
+afbw <- log(ungulates$tab[,1])
+neonatw <- log((ungulates$tab[,2]+ungulates$tab[,3])/2)
+names(afbw) <- tre$tip.label
+names(neonatw) <- tre$tip.label
+plot(afbw, neonatw) # relationship between traits
+lm1 <- lm(neonatw~afbw)
+resid <- residuals(lm1)
+abline(lm1)
+
+## plot the two traits and the residuals of lm1
+x <- phylo4d(tre, cbind.data.frame(afbw, neonatw, residuals=resid))
+table.phylo4d(x) # residuals are surely not independant
+
+## default orthogram for residuals of lm1
+orthogram(resid, tre)
+
+## using another orthonormal basis (derived from Abouheif's proximity)
+myOrthoBasis <- orthobasis.phylo(tre, method="oriAbouheif") # Abouheif's proximities
+orthogram(resid, ortho=myOrthoBasis) # significant phylog. signal
+
+## Abouheif's test
+W <- proxTips(tre, method="oriAbouheif") # proximity matrix
+abouheif.moran(resid, W)
+}
+}
+
+}
+\author{
+Original code: Sebastien Ollier and Daniel Chessel.\cr
+
+ Current maintainer: Stephane Dray <stephane.dray at univ-lyon1.fr>
+}
+\references{
+Ollier, S., Chessel, D. and Couteron, P. (2005) Orthonormal
+ Transform to Decompose the Variance of a Life-History Trait across a
+ Phylogenetic Tree. \emph{Biometrics}, \bold{62}, 471--477.
+}
+\seealso{
+\code{\link{orthobasis.phylo}}
+}
+
diff --git a/man/palm.Rd b/man/palm.Rd
new file mode 100644
index 0000000..624fe05
--- /dev/null
+++ b/man/palm.Rd
@@ -0,0 +1,59 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/adephylo-package.R
+\docType{data}
+\name{palm}
+\alias{palm}
+\title{Phylogenetic and quantitative traits of amazonian palm trees}
+\format{\code{palm} is a list containing the 2 following objects: \describe{
+\item{tre}{is a character string giving the phylogenetic tree in Newick
+format.} \item{traits}{is a data frame with 66 species (rows) and 7 traits
+(columns).} }}
+\source{
+This data set was obtained by Clementine Gimaret-Carpentier.
+}
+\description{
+This data set describes the phylogeny of 66 amazonian palm trees. It also
+gives 7 traits corresponding to these 66 species.
+}
+\details{
+Variables of \code{palm$traits} are the following ones: \cr - rord: specific
+richness with five ordered levels\cr - h: height in meter (squared
+transform)\cr - dqual: diameter at breast height in centimeter with five
+levels \code{sout : subterranean}, \code{ d1(0, 5 cm)}, \code{ d2(5, 15
+cm)}, \code{ d3(15, 30 cm)} and \code{ d4(30, 100 cm)}\cr - vfruit: fruit
+volume in \eqn{mm^{3}}{mm^3} (logged transform)\cr - vgrain: seed volume in
+\eqn{mm^{3}}{mm^3} (logged transform)\cr - aire: spatial distribution area
+(\eqn{km^{2}}{km^2})\cr - alti: maximum altitude in meter (logged
+transform)\cr
+}
+\note{
+This dataset replaces the former version in ade4.
+}
+\examples{
+
+\dontrun{
+if(require(ape) && require(phylobase)){
+
+## load data, make a tree and a phylo4d object
+data(palm)
+tre <- read.tree(text=palm$tre)
+rord <- as.integer(palm$traits$rord) # just use this for plotting purpose
+traits <- data.frame(rord, palm$traits[,-1])
+x <- phylo4d(tre, traits)
+
+## plot data
+par(mar=rep(.1,4))
+table.phylo4d(x, cex.lab=.6)
+
+## test phylogenetic autocorrelation
+if(require(ade4)){
+prox <- proxTips(x, method="sumDD")
+phylAutoTests <- gearymoran(prox, traits[,-3], nrep=499)
+plot(phylAutoTests)
+}
+}
+}
+
+}
+\keyword{datasets}
+
diff --git a/man/ppca.Rd b/man/ppca.Rd
new file mode 100644
index 0000000..6a60990
--- /dev/null
+++ b/man/ppca.Rd
@@ -0,0 +1,265 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ppca.R
+\name{ppca}
+\alias{plot.ppca}
+\alias{ppca}
+\alias{print.ppca}
+\alias{scatter.ppca}
+\alias{screeplot.ppca}
+\alias{summary.ppca}
+\title{Phylogenetic principal component analysis}
+\usage{
+ppca(x, prox = NULL, method = c("patristic", "nNodes", "oriAbouheif",
+ "Abouheif", "sumDD"), f = function(x) { 1/x }, center = TRUE,
+ scale = TRUE, scannf = TRUE, nfposi = 1, nfnega = 0)
+
+\method{scatter}{ppca}(x, axes = 1:ncol(x$li), useLag = FALSE, ...)
+
+\method{print}{ppca}(x, ...)
+
+\method{summary}{ppca}(object, ..., printres = TRUE)
+
+\method{screeplot}{ppca}(x, ..., main = NULL)
+
+\method{plot}{ppca}(x, axes = 1:ncol(x$li), useLag = FALSE, ...)
+}
+\arguments{
+\item{x}{a \linkS4class{phylo4d} object (for \code{ppca}) or a ppca object
+(for other methods).}
+
+\item{prox}{a marix of phylogenetic proximities as returned by
+\code{\link{proxTips}}. If not provided, this matrix will be constructed
+using the arguments \code{method} and \code{a}.}
+
+\item{method}{a character string (full or abbreviated without ambiguity)
+specifying the method used to compute proximities; possible values are:\cr
+- \code{patristic}: (inversed sum of) branch lengths \cr - \code{nNodes}:
+(inversed) number of nodes on the path between the nodes \cr -
+\code{oriAbouheif}: original Abouheif's proximity, with diagonal (see
+details in \code{\link{proxTips}}) \cr - \code{Abouheif}: Abouheif's
+proximity (see details in \code{\link{proxTips}}) \cr - \code{sumDD}:
+(inversed) sum of direct descendants of all nodes on the path (see details
+in \code{\link{proxTips}}).}
+
+\item{f}{a function to change a distance into a proximity.}
+
+\item{center}{a logical indicating whether traits should be centred to mean
+zero (TRUE, default) or not (FALSE).}
+
+\item{scale}{a logical indicating whether traits should be scaled to unit
+variance (TRUE, default) or not (FALSE).}
+
+\item{scannf}{a logical stating whether eigenvalues should be chosen
+interactively (TRUE, default) or not (FALSE).}
+
+\item{nfposi}{an integer giving the number of positive eigenvalues retained
+('global structures').}
+
+\item{nfnega}{an integer giving the number of negative eigenvalues retained
+('local structures').}
+
+\item{axes}{the index of the principal components to be represented.}
+
+\item{useLag}{a logical stating whether the lagged components (\code{x\$ls})
+should be used instead of the components (\code{x\$li}).}
+
+\item{object}{a \code{ppca} object.}
+
+\item{printres}{a logical stating whether results should be printed on the
+screen (TRUE, default) or not (FALSE).}
+
+\item{main}{a title for the screeplot; if NULL, a default one is used.}
+
+\item{\dots}{further arguments passed to other methods. Can be used to
+provide arguments to \code{\link{table.phylo4d}} in \code{plot} method.}
+}
+\value{
+The class \code{ppca} are given to lists with the following
+ components:\cr \item{eig}{a numeric vector of eigenvalues.}
+ \item{nfposi}{an integer giving the number of global structures retained.}
+ \item{nfnega}{an integer giving the number of local structures retained.}
+ \item{c1}{a data.frame of loadings of traits for each axis.} \item{li}{a
+ data.frame of coordinates of taxa onto the ppca axes (i.e., principal
+ components).} \item{ls}{a data.frame of lagged prinpal components; useful
+ to represent of global scores.} \item{as}{a data.frame giving the
+ coordinates of the axes of an 'ordinary' PCA onto the ppca axes.}
+ \item{call}{the matched call.} \item{tre}{a phylogenetic tre with class
+ \linkS4class{phylo4}.} \item{prox}{a matrix of phylogenetic proximities.}
+
+ Other functions have different outputs:\cr
+
+ - \code{scatter.ppca} returns the matched call.\cr
+}
+\description{
+These functions are designed to perform a phylogenetic principal component
+analysis (pPCA, Jombart et al. 2010) and to display the results.
+}
+\details{
+\code{ppca} performs the phylogenetic component analysis. Other functions
+are:\cr
+
+- \code{print.ppca}: prints the ppca content\cr
+
+- \code{summary.ppca}: provides useful information about a ppca object,
+including the decomposition of eigenvalues of all axes\cr
+
+- \code{scatter.ppca}: plot principal components using
+\code{\link{table.phylo4d}}\cr
+
+- \code{screeplot.ppca}: graphical display of the decomposition of pPCA
+eigenvalues\cr
+
+- \code{plot.ppca}: several graphics describing a ppca object\cr
+
+The phylogenetic Principal Component Analysis (pPCA, Jombart et al., 2010) is
+derived from the spatial Principal Component Analysis (spca, Jombart et al.
+2008), implemented in the adegenet package (see
+\code{\link[adegenet]{spca}}).\cr
+
+pPCA is designed to investigate phylogenetic patterns a set of quantitative
+traits. The analysis returns principal components maximizing the product of
+variance of the scores and their phylogenetic autocorrelation (Moran's I),
+therefore reflecting life histories that are phylogenetically structured.
+Large positive and large negative eigenvalues correspond to global and local
+structures.\cr
+}
+\examples{
+
+data(lizards)
+
+if(require(ape) && require(phylobase)){
+
+#### ORIGINAL EXAMPLE FROM JOMBART ET AL 2010 ####
+
+
+## BUILD A TREE AND A PHYLO4D OBJECT
+liz.tre <- read.tree(tex=lizards$hprA)
+liz.4d <- phylo4d(liz.tre, lizards$traits)
+par(mar=rep(.1,4))
+table.phylo4d(liz.4d,var.lab=c(names(lizards$traits),
+ "ACP 1\\n(\\"size effect\\")"),show.node=FALSE, cex.lab=1.2)
+
+
+## REMOVE DUPLICATED POPULATIONS
+liz.4d <- prune(liz.4d, c(7,14))
+table.phylo4d(liz.4d)
+
+
+## CORRECT LABELS
+lab <- c("Pa", "Ph", "Ll", "Lmca", "Lmcy", "Phha", "Pha",
+ "Pb", "Pm", "Ae", "Tt", "Ts", "Lviv", "La", "Ls", "Lvir")
+tipLabels(liz.4d) <- lab
+
+
+## REMOVE SIZE EFFECT
+dat <- tdata(liz.4d, type="tip")
+dat <- log(dat)
+newdat <- data.frame(lapply(dat, function(v) residuals(lm(v~dat$mean.L))))
+rownames(newdat) <- rownames(dat)
+tdata(liz.4d, type="tip") <- newdat[,-1] # replace data in the phylo4d object
+
+
+## pPCA
+liz.ppca <- ppca(liz.4d,scale=FALSE,scannf=FALSE,nfposi=1,nfnega=1, method="Abouheif")
+liz.ppca
+tempcol <- rep("grey",7)
+tempcol[c(1,7)] <- "black"
+barplot(liz.ppca$eig,main='pPCA eigenvalues',cex.main=1.8,col=tempcol)
+
+par(mar=rep(.1,4))
+plot(liz.ppca,ratio.tree=.7)
+
+
+## CONTRIBUTIONS TO PC (LOADINGS) (viewed as dotcharts)
+dotchart(liz.ppca$c1[,1],lab=rownames(liz.ppca$c1),main="Global principal
+component 1")
+abline(v=0,lty=2)
+
+dotchart(liz.ppca$c1[,2],lab=rownames(liz.ppca$c1),main="Local principal
+component 1")
+abline(v=0,lty=2)
+
+
+## REPRODUCE FIGURES FROM THE PAPER
+obj.ppca <- liz.4d
+tdata(obj.ppca, type="tip") <- liz.ppca$li
+myLab <- paste(" ",rownames(liz.ppca$li), sep="")
+
+## FIGURE 1
+par(mar=c(.1,2.4,2.1,1))
+table.phylo4d(obj.ppca, ratio=.7, var.lab=c("1st global PC", "1st local
+ PC"), tip.label=myLab,box=FALSE,cex.lab=1.4, cex.sym=1.2, show.node.label=TRUE)
+add.scatter.eig(liz.ppca$eig,1,1,1,csub=1.2, posi="topleft", ratio=.23)
+
+
+## FIGURE 2
+s.arrow(liz.ppca$c1,xlim=c(-1,1),clab=1.3,cgrid=1.3)
+
+
+
+#### ANOTHER EXAMPLE - INCLUDING NA REPLACEMENT ####
+## LOAD THE DATA
+data(maples)
+tre <- read.tree(text=maples$tre)
+x <- phylo4d(tre, maples$tab)
+omar <- par("mar")
+par(mar=rep(.1,4))
+table.phylo4d(x, cex.lab=.5, cex.sym=.6, ratio=.1) # note NAs in last trait ('x')
+
+## FUNCTION TO REPLACE NAS
+f1 <- function(vec){
+if(any(is.na(vec))){
+m <- mean(vec, na.rm=TRUE)
+vec[is.na(vec)] <- m
+}
+return(vec)
+}
+
+
+## PERFORM THE PPCA
+dat <- apply(maples$tab,2,f1) # replace NAs
+x.noNA <- phylo4d(tre, as.data.frame(dat))
+map.ppca <- ppca(x.noNA, scannf=FALSE, method="Abouheif")
+map.ppca
+
+
+## SOME GRAPHICS
+screeplot(map.ppca)
+scatter(map.ppca, useLag=TRUE)
+plot(map.ppca, useLag=TRUE)
+
+
+## MOST STRUCTURED TRAITS
+a <- map.ppca$c1[,1] # loadings on PC 1
+names(a) <- row.names(map.ppca$c1)
+highContrib <- a[a< quantile(a,0.1) | a>quantile(a,0.9)]
+datSel <- cbind.data.frame(dat[, names(highContrib)], map.ppca$li)
+temp <- phylo4d(tre, datSel)
+table.phylo4d(temp) # plot of most structured traits
+
+
+## PHYLOGENETIC AUTOCORRELATION TESTS FOR THESE TRAITS
+prox <- proxTips(tre, method="Abouheif")
+abouheif.moran(dat[, names(highContrib)], prox)
+
+}
+
+}
+\author{
+Thibaut Jombart \email{tjombart at imperial.ac.uk}
+}
+\references{
+Jombart, T.; Pavoine, S.; Dufour, A. & Pontier, D. (2010, in
+ press) Exploring phylogeny as a source of ecological variation: a
+ methodological approach. doi:10.1016/j.jtbi.2010.03.038
+
+ Jombart, T., Devillard, S., Dufour, A.-B. and Pontier, D. (2008) Revealing
+ cryptic phylogenetic patterns in genetic variability by a new multivariate
+ method. \emph{Heredity}, \bold{101}, 92--103.
+}
+\seealso{
+The implementation of \code{\link[adegenet]{spca}} in the adegenet
+ package (\code{\link[adegenet]{adegenet}}) \cr
+}
+\keyword{multivariate}
+
diff --git a/man/procella.Rd b/man/procella.Rd
new file mode 100644
index 0000000..e4ed801
--- /dev/null
+++ b/man/procella.Rd
@@ -0,0 +1,51 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/adephylo-package.R
+\docType{data}
+\name{procella}
+\alias{procella}
+\title{Phylogeny and quantitative traits of birds}
+\format{\code{procella} is a list containing the 2 following objects:
+\describe{ \item{tre}{is a character string giving the phylogenetic tree in
+Newick format.} \item{traits}{is a data frame with 19 species and 6 traits}
+}}
+\description{
+This data set describes the phylogeny of 19 birds as reported by Bried et
+al. (2002). It also gives 6 traits corresponding to these 19 species.
+}
+\details{
+Variables of \code{procella$traits} are the following ones: \cr - site.fid:
+a numeric vector that describes the percentage of site fidelity\cr -
+mate.fid: a numeric vector that describes the percentage of mate fidelity\cr
+- mass: an integer vector that describes the adult body weight (g)\cr - ALE:
+a numeric vector that describes the adult life expectancy (years)\cr - BF: a
+numeric vector that describes the breeding frequencies\cr - col.size: an
+integer vector that describes the colony size (no nests monitored)
+}
+\note{
+This dataset replaces the former version in ade4.
+}
+\examples{
+
+\dontrun{
+if(require(ape) && require(phylobase)){
+
+## load data, make tree and phylo4d object
+data(procella)
+tre <- read.tree(text=procella$tre)
+x <- phylo4d(tre, procella$traits)
+par(mar=rep(.1,4))
+table.phylo4d(x,cex.lab=.7)
+}
+}
+
+}
+\references{
+Bried, J., Pontier, D. and Jouventin, P. (2002) Mate fidelity in
+monogamus birds: a re-examination of the Procellariiformes. \emph{Animal
+Behaviour}, \bold{65}, 235--246.
+
+See a data description at \url{http://pbil.univ-lyon1.fr/R/pdf/pps037.pdf}
+(in French).
+}
+\keyword{datasets}
+
diff --git a/man/proxTips.Rd b/man/proxTips.Rd
new file mode 100644
index 0000000..9b00bde
--- /dev/null
+++ b/man/proxTips.Rd
@@ -0,0 +1,148 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/proximities.R
+\name{proxTips}
+\alias{proxTips}
+\title{Compute some phylogenetic proximities between tips}
+\usage{
+proxTips(x, tips = "all", method = c("patristic", "nNodes", "oriAbouheif",
+ "Abouheif", "sumDD"), f = function(x) { 1/x }, normalize = c("row",
+ "col", "none"), symmetric = TRUE, useC = TRUE)
+}
+\arguments{
+\item{x}{a tree of class \code{\link[ape:read.tree]{phylo}},
+\linkS4class{phylo4} or \linkS4class{phylo4d}.}
+
+\item{tips}{A vector of integers identifying tips by their numbers, or a
+vector of characters identifying tips by their names. Distances will be
+computed between all possible pairs of tips.}
+
+\item{method}{a character string (full or abbreviated without ambiguity)
+specifying the method used to compute proximities; possible values are:\cr -
+\code{patristic}: (inversed sum of) branch length \cr - \code{nNodes}:
+(inversed) number of nodes on the path between the nodes \cr -
+\code{oriAbouheif}: original Abouheif's proximity, with diagonal (see
+details) \cr - \code{Abouheif}: Abouheif's proximity without diagonal (see
+details) \cr - \code{sumDD}: (inversed) sum of direct descendants of all
+nodes on the path (see details) \cr}
+
+\item{f}{a function to change a distance into a proximity.}
+
+\item{normalize}{a character string specifying whether the matrix must be
+normalized by row (\code{row}), column (\code{col}), or not (\code{none}).
+Normalization amounts to dividing each row (or column) so that the marginal
+sum is 1. Hence, default is matrix with each row summing to 1.}
+
+\item{symmetric}{a logical stating whether M must be coerced to be symmetric
+(TRUE, default) or not. This is achieved by taking (denoting N the matrix of
+proximities before re-symmetrization): \deqn{M = 0.5 * (N + N^{T})} Note
+that \eqn{x^{T}Ny = x^{T}My}, but the latter has the advantage of using a
+bilinear symmetric form (more appropriate for optimization purposes).}
+
+\item{useC}{a logical indicating whether computations of distances (before
+transformation into proximities) should be performed using compiled C code
+(TRUE, default), or using a pure R version (FALSE). C version is several
+orders of magnitude faster, and R version is kept for backward
+compatibility.}
+}
+\value{
+A matrix of phylogenetic proximities.
+}
+\description{
+The function \code{proxTips} computes a given proximity between a set of
+tips of a phylogeny. A vector of tips is supplied: proximities between all
+possible pairs of these tips are computed. The proximities are computed
+from the shortest path between the tips. \cr
+}
+\details{
+Proximities are computed as the inverse (to the power \code{a}) of a
+phylogenetic distance (computed by \code{\link{distTips}}. Denoting
+\eqn{D=[d_{ij}]} a matrix of phylogenetic distances, the proximity matrix
+\eqn{M=[m_{ij}]} is computed as: \deqn{m_{ij} = \frac{1}{d_{ij}^a} \forall i
+\neq j}{ m_{ij} = (1/d_{ij})^a for all i different from j} and \deqn{m_{ii}
+= 0}
+
+Several distances can be used, defaulting to the sum of branch lengths (see
+argument \code{method}). Proximities are not true similarity measures,
+since the proximity of a tip with itself is always set to zero.\cr
+
+The obtained matrix of phylogenetic proximities (M) defines a bilinear
+symmetric form when M is symmetric (default):\cr \deqn{f(x,y) = x^{T}My}
+
+In general, M is not a metric because it is not positive-definite. Such a
+matrice can be used to measure phylogenetic autocorrelation (using Moran's
+index): \deqn{I(x) = \frac{x^TMx}{var(x)}}{I(x) = (x^{T}Mx)/(var(x)) }
+
+or to compute lag vectors (Mx) used in autoregressive models, like: \deqn{x
+= Mx + ... + e} where '...' is the non-autoregressive part of the model, and
+'e' are residuals.
+
+\code{Abouheif} proximity refers to the phylogenetic proximity underlying
+the test of Abouheif (see references). Let P be the set of all the nodes in
+the path going from \code{node1} to \code{node2}. Let DDP be the number of
+direct descendants from each node in P. Then, the so-called 'Abouheif'
+distance is the inverse of the product of all terms in DDP.
+\code{oriAbouheif} returns a matrix with non-null diagonal elements, as
+formulated in Pavoine \emph{et al.} (2008). This matrix is bistochastic (all
+marginal sums equal 1), but this bilinear symmetric form does not give rise
+to a Moran's index, since it requires a null diagonal. \code{Abouheif}
+contains Abouheif's proximities but has a null diagonal, giving rise to a
+Moran's index.\cr
+
+\code{sumDD} refers to a phylogenetic proximity quite similar to that of
+Abouheif. We consider the same sets P and DDP. But instead of taking the
+inverse of the product of all terms in DDP, this proximity computes the
+inverse of the sum of all terms in DDP. This matrix was denoted 'M' in
+Pavoine \emph{et al.} (2008), who reported that it is related to May's index
+(May, 1990).
+}
+\examples{
+
+if(require(ape) & require(phylobase)){
+## make a tree
+x <- as(rtree(10),"phylo4")
+plot(x, show.node=TRUE)
+axisPhylo()
+## compute different distances
+proxTips(x, 1:5)
+proxTips(x, 1:5, "nNodes")
+proxTips(x, 1:5, "Abouheif")
+proxTips(x, , "sumDD")
+
+## see what one proximity looks like
+M <- proxTips(x)
+obj <- phylo4d(x,as.data.frame(M))
+table.phylo4d(obj,symbol="sq")
+}
+
+}
+\author{
+Thibaut Jombart \email{tjombart at imperial.ac.uk}
+}
+\references{
+== About Moran's index with various proximities == \cr Pavoine,
+S.; Ollier, S.; Pontier, D.; Chessel, D. (2008) Testing for phylogenetic
+signal in life history variable: Abouheif's test revisited.
+\emph{Theoretical Population Biology}: \bold{73}, 79-91.\cr
+
+== About regression on phylogenetic lag vector == \cr Cheverud, J. M.; Dow,
+M. M.; Leutenegger, W. (1985) The quantitative assessment of phylogentic
+constaints in comparative analyses: sexual dimorphism in body weights among
+primates. \emph{Evolution} \bold{39}, 1335-1351.\cr
+
+Cheverud, J. M.; Dow, M. M. (1985) An autocorrelation analysis of genetic
+variation due to lineal fission in social groups of Rhesus macaques.
+\emph{American Journal of Phyisical Anthropology} \bold{67}, 113-121.\cr
+
+== Abouheif's original paper ==\cr Abouheif, E. (1999) A method for testing
+the assumption of phylogenetic independence in comparative data.
+\emph{Evolutionary Ecology Research}, \bold{1}, 895-909.\cr
+
+== May's index ==\cr May, R.M. (1990) Taxonomy as destiny. \emph{Nature}
+\bold{347}, 129-130.
+}
+\seealso{
+\code{\link{distTips}} which computes several phylogenetic
+distances between tips.
+}
+\keyword{manip}
+
diff --git a/man/sp.tips.Rd b/man/sp.tips.Rd
new file mode 100644
index 0000000..9cca2ba
--- /dev/null
+++ b/man/sp.tips.Rd
@@ -0,0 +1,68 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/utils.R
+\name{sp.tips}
+\alias{sp.tips}
+\title{Find the shortest path between tips of a tree}
+\usage{
+sp.tips(x, tip1, tip2, useTipNames = FALSE, quiet = FALSE,
+ include.mrca = TRUE)
+}
+\arguments{
+\item{x}{A tree of class \code{\link[ape:read.tree]{phylo}},
+\linkS4class{phylo4} or \linkS4class{phylo4d}.}
+
+\item{tip1}{A vector of integers identifying tips by their numbers, or a
+vector of characters identifying tips by their names. Recycled if needed.}
+
+\item{tip2}{A vector of integers identifying tips by their numbers, or a
+vector of characters identifying tips by their names. Recycled if needed.}
+
+\item{useTipNames}{a logical stating whether the output must be named using
+tip names in all cases (TRUE), or not (FALSE). If not, names of \code{tip1}
+and \code{tip2} will be used.}
+
+\item{quiet}{a logical stating whether a warning must be issued when
+tip1==tip2, or not (see details).}
+
+\item{include.mrca}{a logical stating whether the most recent common
+ancestor shall be included in the returned path (TRUE, default) or not
+(FALSE).}
+}
+\value{
+A list whose components are vectors of named nodes forming the
+shortest path between a couple of tips.
+}
+\description{
+The function \code{sp.tips} finds the shortest path between tips of a tree,
+identified as \code{tip1} and \code{tip2}. This function applies to trees
+with the class \code{\link[ape:read.tree]{phylo}}, \linkS4class{phylo4} or
+\linkS4class{phylo4d}. Several tips can be provided at a time.
+}
+\details{
+The function checks if there are cases where tip1 and tip2 are the same.
+These cases are deleted when detected, issuing a warning (unless
+\code{quiet} is set to TRUE).
+}
+\examples{
+
+\dontrun{
+if(require(ape) & require(phylobase)){
+## make a tree
+x <- as(rtree(20),"phylo4")
+plot(x,show.node=TRUE)
+## get shortest path between tip 1 and all other tips.
+sp.tips(x, "t1", "t2")
+sp.tips(x, 1, 2:20, TRUE)
+}
+}
+
+}
+\author{
+Thibaut Jombart \email{tjombart at imperial.ac.uk}
+}
+\seealso{
+\code{\link[phylobase]{shortestPath}} which does the same thing as
+\code{sp.tips}, for any node (internal or tip), but much more slowly. \cr
+}
+\keyword{manip}
+
diff --git a/man/table.phylo4d.Rd b/man/table.phylo4d.Rd
new file mode 100644
index 0000000..9de28bd
--- /dev/null
+++ b/man/table.phylo4d.Rd
@@ -0,0 +1,155 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/table.phylo4d.R
+\name{table.phylo4d}
+\alias{table.phylo4d}
+\title{Graphical display of phylogeny and traits}
+\usage{
+table.phylo4d(x, treetype = c("phylogram", "cladogram"),
+ symbol = c("circles", "squares", "colors"), repVar = 1:ncol(tdata(x, type
+ = "tip")), center = TRUE, scale = TRUE, legend = TRUE, grid = TRUE,
+ box = TRUE, show.tip.label = TRUE, show.node.label = TRUE,
+ show.var.label = TRUE, ratio.tree = 1/3, font = 3,
+ tip.label = tipLabels(x), var.label = colnames(tdata(x, type = "tip")),
+ cex.symbol = 1, cex.label = 1, cex.legend = 1, pch = 20,
+ col = heat.colors(100), coord.legend = NULL, ...)
+}
+\arguments{
+\item{x}{a \linkS4class{phylo4d} object}
+
+\item{treetype}{the type of tree to be plotted ("phylogram" or "cladogram")}
+
+\item{symbol}{the type of symbol used to represent data ("circles",
+"squares", or "colors")}
+
+\item{repVar}{the numerical index of variables to be plotted}
+
+\item{center}{a logical stating whether variables should be centred (TRUE,
+default) or not (FALSE)}
+
+\item{scale}{a logical stating whether variables should be scaled (TRUE,
+default) or not (FALSE)}
+
+\item{legend}{a logical stating whether a legend should be added to the plot
+(TRUE) or not (FALSE, default)}
+
+\item{grid}{a logical stating whether a grid should be added to the plot
+(TRUE, default) or not (FALSE)}
+
+\item{box}{a logical stating whether a box should be added around the plot
+(TRUE, default) or not (FALSE)}
+
+\item{show.tip.label}{a logical stating whether tip labels should be printed
+(TRUE, default) or not (FALSE)}
+
+\item{show.node.label}{a logical stating whether node labels should be
+printed (TRUE, default) or not (FALSE)}
+
+\item{show.var.label}{a logical stating whether labels of variables should be
+printed (TRUE, default) or not (FALSE)}
+
+\item{ratio.tree}{the proportion of width of the figure occupied by the tree}
+
+\item{font}{an integer specifying the type of font for the labels: 1 (plain
+text), 2 (bold), 3 (italic, default), or 4 (bold italic).}
+
+\item{tip.label}{a character vector giving the tip labels}
+
+\item{var.label}{a character vector giving the labels of variables}
+
+\item{cex.symbol}{a numeric giving the factor scaling the symbols}
+
+\item{cex.label}{a numeric giving the factor scaling all labels}
+
+\item{cex.legend}{a numeric giving the factor scaling the legend}
+
+\item{pch}{is \code{symbol} is set to 'colors', a number indicating the type
+of point to be plotted (see ?points)}
+
+\item{col}{is \code{symbol} is set to 'colors', a vector of colors to be used
+to represent the data}
+
+\item{coord.legend}{an optional list with two components 'x' and 'y'
+indicating the lower-left position of the legend. Can be set to
+\code{locator(1) to position the legend interactively.}}
+
+\item{\dots}{further arguments to be passed to plot methods from \code{ape}.
+See \code{\link[ape]{plot.phylo}}.}
+}
+\description{
+This function represents traits onto the tips of a phylogeny. Plotted objects
+must be valid \linkS4class{phylo4d} objects (implemented by the
+\code{phylobase} package). Current version allows plotting of a tree and one
+or more quantitative traits (possibly containing missing data, represented by
+an 'x').\cr
+}
+\details{
+The plot of phylogenies is performed by a call to
+\code{\link[ape]{plot.phylo}} from the \code{ape} package. Hence, many of the
+arguments of \code{\link[ape]{plot.phylo}} can be passed to
+\code{table.phylo4d}, through the \dots{} argument, but their names must be
+complete.
+
+For large trees, consider using \code{\link{bullseye}}.
+
+The function \code{table.phylo4d} is based on former plot method for
+\linkS4class{phylo4d} objects from the \code{phylobase} package. It replaces
+the deprecated \code{ade4} functions \code{\link[ade4]{symbols.phylog}} and
+\code{\link[ade4]{table.phylog}}.
+}
+\examples{
+
+if(require(ape) & require(phylobase) & require(ade4)){
+
+## simulated data
+tr <- rtree(20)
+dat <- data.frame(a = rnorm(20), b = scale(1:20), c=runif(20,-2,2) )
+dat[3:6, 2] <- NA # introduce some NAs
+obj <- phylo4d(tr, dat) # build a phylo4d object
+table.phylo4d(obj) # default scatterplot
+table.phylo4d(obj,cex.leg=.6, use.edge.length=FALSE) # customized
+table.phylo4d(obj,treetype="clad", show.node=FALSE, cex.leg=.6,
+use.edge.length=FALSE, edge.color="blue", edge.width=3) # more customized
+
+
+## teleost fishes data
+data(mjrochet)
+temp <- read.tree(text=mjrochet$tre) # make a tree
+mjr <- phylo4d(x=temp,tip.data=mjrochet$tab) # male a phylo4d object
+table.phylo4d(mjr,cex.lab=.5,show.node=FALSE,symb="square")
+
+
+## lizards data
+data(lizards)
+liz.tr <- read.tree(tex=lizards$hprA) # make a tree
+liz <- phylo4d(liz.tr, lizards$traits) # make a phylo4d object
+table.phylo4d(liz)
+
+
+## plotting principal components
+liz.pca1 <- dudi.pca(lizards$traits, scannf=FALSE, nf=2) # PCA of traits
+myPC <- phylo4d(liz.tr, liz.pca1$li) # store PC in a phylo4d object
+varlab <- paste("Principal \\ncomponent", 1:2) # make labels for PCs
+table.phylo4d(myPC, ratio=.8, var.lab=varlab) # plot the PCs
+add.scatter.eig(liz.pca1$eig,2,1,2,posi="topleft", inset=c(0,.15))
+title("Phylogeny and the principal components")
+
+}
+
+}
+\author{
+Thibaut Jombart \email{tjombart at imperial.ac.uk}
+}
+\seealso{
+The \linkS4class{phylo4d} class for storing
+ \code{phylogeny+data}.\cr
+
+ For large trees, consider using \code{\link{bullseye}}.
+
+ \code{\link[ape]{plot.phylo}} from the \code{ape} package.\cr
+
+ An alternative (deprecated) representation is available from
+ \code{\link[ade4]{dotchart.phylog}}.
+}
+\keyword{hplot}
+\keyword{multivariate}
+
diff --git a/man/tithonia.Rd b/man/tithonia.Rd
new file mode 100644
index 0000000..3d56614
--- /dev/null
+++ b/man/tithonia.Rd
@@ -0,0 +1,61 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/adephylo-package.R
+\docType{data}
+\name{tithonia}
+\alias{tithonia}
+\title{Phylogeny and quantitative traits of flowers}
+\format{\code{tithonia} is a list containing the 2 following objects :
+\describe{ \item{tre}{is a character string giving the phylogenetic tree in
+Newick format.} \item{tab}{is a data frame with 11 species and 14 traits (6
+morphologic traits and 8 demographic).} }}
+\source{
+Data were obtained from Morales, E. (2000) Estimating phylogenetic
+inertia in Tithonia (Asteraceae) : a comparative approach. \emph{Evolution},
+\bold{54}, 2, 475--484.
+}
+\description{
+This data set describes the phylogeny of 11 flowers as reported by Morales
+(2000). It also gives morphologic and demographic traits corresponding to
+these 11 species.
+}
+\details{
+Variables of \code{tithonia$tab} are the following ones : \cr morho1: is a
+numeric vector that describes the seed size (mm)\cr morho2: is a numeric
+vector that describes the flower size (mm)\cr morho3: is a numeric vector
+that describes the female leaf size (cm)\cr morho4: is a numeric vector that
+describes the head size (mm)\cr morho5: is a integer vector that describes
+the number of flowers per head \cr morho6: is a integer vector that
+describes the number of seeds per head \cr demo7: is a numeric vector that
+describes the seedling height (cm)\cr demo8: is a numeric vector that
+describes the growth rate (cm/day)\cr demo9: is a numeric vector that
+describes the germination time\cr demo10: is a numeric vector that describes
+the establishment (per cent)\cr demo11: is a numeric vector that describes
+the viability (per cent)\cr demo12: is a numeric vector that describes the
+germination (per cent)\cr demo13: is a integer vector that describes the
+resource allocation\cr demo14: is a numeric vector that describes the adult
+height (m)\cr
+}
+\note{
+This dataset replaces the former version in ade4.
+}
+\examples{
+
+\dontrun{
+if(require(ape) && require(phylobase)){
+
+data(tithonia)
+tre <- read.tree(text=tithonia$tre)
+traits <- log(tithonia$tab + 1)
+rownames(traits) <- gsub("_", ".", rownames(traits))
+
+## build a phylo4d object
+x <- phylo4d(tre, traits)
+par(mar=rep(.1,4))
+table.phylo4d(x)
+
+}
+}
+
+}
+\keyword{datasets}
+
diff --git a/man/treePart.Rd b/man/treePart.Rd
new file mode 100644
index 0000000..61286c9
--- /dev/null
+++ b/man/treePart.Rd
@@ -0,0 +1,67 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/partition.R
+\name{treePart}
+\alias{treePart}
+\title{Define partitions of tips according from a tree}
+\usage{
+treePart(x, result = c("dummy", "orthobasis"))
+}
+\arguments{
+\item{x}{a tree of class \code{\link[ape:read.tree]{phylo}},
+\linkS4class{phylo4} or \linkS4class{phylo4d}.}
+
+\item{result}{a character string specifying the type of result: either a
+basis of dummy vectors (\code{dummy}), or an orthobasis derived from these
+dummy vectors (\code{orthobasis}).}
+}
+\value{
+A matrix of numeric vectors (in columns) having one value for each
+tip (rows).
+}
+\description{
+The function \code{treePart} defines partitions of tips reflecting the
+topology of a tree. There are two possible outputs (handled by the argument
+\code{result}):\cr - \code{basis} mode: each node but the root is translated
+into a dummy vector having one value for each tip: this value is '1' if the
+tip descends from this node, and '0' otherwise.\cr - \code{orthobasis}: in
+this mode, an orthonormal basis is derived from the basis previously
+mentionned. This orthobasis was proposed in the orthogram (Ollier \emph{et
+al.} 2006).
+}
+\details{
+Orthobasis produced by this function are identical to those stored in the
+\$Bscores component of deprecated \link[ade4]{phylog} objects, from the ade4
+package.
+}
+\examples{
+
+\dontrun{
+
+if(require(ape) & require(phylobase)){
+## make a tree
+x <- as(rtree(10),"phylo4")
+partition <- treePart(x)
+partition
+
+## plot the dummy vectors with the tree
+temp <- phylo4d(x, partition)
+table.phylo4d(temp, cent=FALSE, scale=FALSE)
+}
+}
+
+}
+\author{
+Thibaut Jombart \email{tjombart at imperial.ac.uk}
+}
+\references{
+Ollier, S., Chessel, D. and Couteron, P. (2005) Orthonormal
+Transform to Decompose the Variance of a Life-History Trait across a
+Phylogenetic Tree. \emph{Biometrics}, \bold{62}, 471--477.
+}
+\seealso{
+- \code{\link{listDD}} which is called by \code{treePart}.\cr -
+\code{\link{orthogram}}, which uses by default the orthobasis produced by
+\code{treePart}.\cr
+}
+\keyword{manip}
+
diff --git a/man/ungulates.Rd b/man/ungulates.Rd
new file mode 100644
index 0000000..4507739
--- /dev/null
+++ b/man/ungulates.Rd
@@ -0,0 +1,58 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/adephylo-package.R
+\docType{data}
+\name{ungulates}
+\alias{ungulates}
+\title{Phylogeny and quantitative traits of ungulates.}
+\format{\code{fission} is a list containing the 2 following objects :
+\describe{ \item{tre}{is a character string giving the phylogenetic tree in
+Newick format.} \item{tab}{is a data frame with 18 species and 4 traits} }}
+\source{
+Data were obtained from Pelabon, C., Gaillard, J.M., Loison, A. and
+Portier, A. (1995) Is sex-biased maternal care limited by total maternal
+expenditure in polygynous ungulates? \emph{Behavioral Ecology and
+Sociobiology}, \bold{37}, 311--319.
+}
+\description{
+This data set describes the phylogeny of 18 ungulates as reported by
+Pelabon et al. (1995). It also gives 4 traits corresponding to these 18
+species.
+}
+\details{
+Variables of \code{ungulates$tab} are the following ones : \cr
+
+- afbw: is a numeric vector that describes the adult female body weight (g)
+\cr - mnw: is a numeric vector that describes the male neonatal weight (g)
+\cr - fnw: is a numeric vector that describes the female neonatal weight (g)
+\cr - ls: is a numeric vector that describes the litter size \cr
+}
+\note{
+This dataset replaces the former version in ade4.
+}
+\examples{
+
+\dontrun{
+if(require(ape) && require(phylobase)){
+## load data
+data(ungulates)
+tre <- read.tree(text=ungulates$tre)
+plot(tre)
+
+## look at two traits
+afbw <- log(ungulates$tab[,1])
+neonatw <- log((ungulates$tab[,2]+ungulates$tab[,3])/2)
+names(afbw) <- tre$tip.label
+names(neonatw) <- tre$tip.label
+plot(afbw, neonatw) # relationship between traits
+lm1 <- lm(neonatw~afbw)
+abline(lm1)
+x <- phylo4d(tre, cbind.data.frame(afbw, neonatw)) # traits on the phylogeny
+
+## test phylogenetic inertia in residuals
+orthogram(residuals(lm1), x)
+}
+}
+
+}
+\keyword{datasets}
+
diff --git a/src/adesub.c b/src/adesub.c
new file mode 100644
index 0000000..8ac100b
--- /dev/null
+++ b/src/adesub.c
@@ -0,0 +1,1152 @@
+#include <math.h>
+#include <time.h>
+#include <string.h>
+#include <stdlib.h>
+#include "adesub.h"
+#include <R.h>
+
+/***********************************************************************/
+double traceXtdLXq (double **X, double **L, double *d, double *q)
+/* Produit matriciel XtDLXQ avec LX comme lag.matrix */
+{
+ /* Declarations de variables C locales */
+ int j, i, lig, col;
+ double **auxi, **A, trace;
+
+
+
+ /* Allocation memoire pour les variables C locales */
+ lig = X[0][0];
+ col = X[1][0];
+ taballoc(&auxi, lig, col);
+ taballoc(&A, col, col);
+
+
+ /* Calcul de LX */
+ prodmatABC(L, X, auxi);
+
+ /* Calcul de DLX */
+ for (i=1;i<=lig;i++) {
+ for (j=1;j<=col;j++) {
+ auxi[i][j] = auxi[i][j] * d[i];
+ }
+ }
+
+ /* Calcul de XtDLX */
+ prodmatAtBC(X,auxi,A);
+
+ /* Calcul de trace(XtDLXQ) */
+ trace=0;
+ for (i=1;i<=col;i++) {
+ trace = trace + A[i][i] * q[i];
+ }
+
+ /* Lib�ration des r�servations locales */
+ freetab (auxi);
+ freetab (A);
+ return(trace);
+}
+
+/***********************************************************************/
+void tabintalloc (int ***tab, int l1, int c1)
+/*--------------------------------------------------
+* Allocation de memoire dynamique pour un tableau
+* d'entiers (l1, c1)
+--------------------------------------------------*/
+{
+ int i, j;
+
+ *tab = (int **) calloc(l1+1, sizeof(int *));
+
+ if ( *tab != NULL) {
+ for (i=0;i<=l1;i++) {
+
+ *(*tab+i)=(int *) calloc(c1+1, sizeof(int));
+ if ( *(*tab+i) == NULL ) {
+ for (j=0;j<i;j++) {
+ free(*(*tab+j));
+ }
+ return;
+ }
+ }
+ } else return;
+ **(*tab) = l1;
+ **(*tab+1) = c1;
+ for (i=1;i<=l1;i++) {
+ for (j=1;j<=c1;j++) {
+ (*tab)[i][j] = 0;
+ }
+ }
+}
+
+/***********************************************************************/
+void freeinttab (int **tab)
+/*--------------------------------------------------
+* Allocation de memoire dynamique pour un tableau
+--------------------------------------------------*/
+{
+ int i, n;
+
+ n = *(*(tab));
+
+ for (i=0;i<=n;i++) {
+ free((char *) *(tab+i) );
+ }
+
+ free((char *) tab);
+}
+
+
+/*********************/
+int dtodelta (double **data, double *pl)
+{
+ /* la matrice de distances d2ij dans data est associee aux poids pl
+ Elle est transformee par aij - ai. -a.j + a..
+ aij = -d2ij/2);*/
+
+ int lig, i, j;
+ double *moy, a0, moytot;
+
+ lig=data[0][0];
+ vecalloc(&moy, lig);
+
+ for (i=1; i<=lig; i++) {
+ for (j=1; j<=lig; j++) data[i][j] = 0.0 - data[i][j] * data[i][j] / 2.0;
+ }
+
+ for (i=1; i<=lig; i++) {
+ a0=0;
+ for (j=1; j<=lig; j++) a0 = a0 + pl[j]*data[i][j];
+ moy[i] = a0;
+ }
+ moytot=0;
+ for (i=1; i<=lig; i++) {
+ moytot = moytot+pl[i]*moy[i];
+ }
+ for (i=1; i<=lig; i++) {
+ for (j=1; j<=lig; j++) data[i][j] = data[i][j] - moy[i] - moy[j] + moytot;
+ }
+ freevec (moy);
+ return 1;
+}
+/***************************/
+void initvec (double *v1, double r)
+/*--------------------------------------------------
+* Initialisation des elements d'un vecteur
+--------------------------------------------------*/
+{
+ int i, c1;
+
+ c1 = v1[0];
+ for (i=1;i<=c1;i++) {
+ v1[i] = r;
+ }
+}
+/**************************/
+double alea (void)
+{
+ double w;
+ GetRNGstate();
+ /* w = ((double) rand())/ (double)RAND_MAX; */
+ w = unif_rand();
+ PutRNGstate();
+ return (w);
+}
+/*************************/
+void aleapermutmat (double **a)
+{
+ /* permute au hasard les lignes du tableau a
+ Manly p. 42 le tableau est modifi� */
+ int lig, i,j, col, n, k;
+ double z;
+
+ lig = a[0][0];
+ col = a[1][0];
+ for (i=1; i<=lig-1; i++) {
+ j=lig-i+1;
+ k = (int) (j*alea ()+1);
+ /*k = (int) (j*genrand()+1);*/
+ if (k>j) k=j;
+ for (n=1; n<=col; n++) {
+ z = a[j][n];
+ a[j][n]=a[k][n];
+ a[k][n] = z;
+ }
+ }
+}
+/*************************/
+void aleapermutvec (double *a)
+{
+ /* permute au hasard les �l�ments du vecteur a
+ Manly p. 42 Le vecteur est modifi�
+ from Knuth 1981 p. 139*/
+ int lig, i,j, k;
+ double z;
+
+ lig = a[0];
+ for (i=1; i<=lig-1; i++) {
+ j=lig-i+1;
+ k = (int) (j*alea()+1);
+ /*k = (int) (j*genrand()+1);*/
+ if (k>j) k=j;
+ z = a[j];
+ a[j]=a[k];
+ a[k] = z;
+ }
+}
+/***********************************************************************/
+void DiagobgComp (int n0, double **w, double *d, int *rang)
+/*--------------------------------------------------
+* Diagonalisation
+* T. FOUCART Analyse factorielle de tableaux multiples,
+* Masson, Paris 1984,185p., p. 62. D'apr?s VPROP et TRIDI,
+* de LEBART et coll.
+--------------------------------------------------*/
+{
+ double *s, epsilon;
+ double a, b, c, x, xp, q, bp, ab, ep, h, t, u , v;
+ double dble;
+ int ni, i, i2, j, k, jk, ijk, ij, l, ix, m, m1, isnou;
+
+ vecalloc(&s, n0);
+ a = 0.000000001;
+ epsilon = 0.0000001;
+ ni = 100;
+ if (n0 == 1) {
+ d[1] = w[1][1];
+ w[1][1] = 1.0;
+ *rang = 1;
+ freevec (s);
+ return;
+ }
+
+ for (i2=2;i2<=n0;i2++) {
+
+ b=0.0;
+ c=0.0;
+ i=n0-i2+2;
+ k=i-1;
+ if (k < 2) goto Et1;
+ for (l=1;l<=k;l++) {
+ c = c + fabs((double) w[i][l]);
+ }
+ if (c != 0.0) goto Et2;
+
+Et1: s[i] = w[i][k];
+ goto Etc;
+
+Et2: for (l=1;l<=k;l++) {
+ x = w[i][l] / c;
+ w[i][l] = x;
+ b = b + x * x;
+ }
+ xp = w[i][k];
+ ix = 1;
+ if (xp < 0.0) ix = -1;
+
+/* q = -sqrt(b) * ix; */
+ dble = b;
+ dble = -sqrt(dble);
+ q = dble * ix;
+
+ s[i] = c * q;
+ b = b - xp * q;
+ w[i][k] = xp - q;
+ xp = 0;
+ for (m=1;m<=k;m++) {
+ w[m][i] = w[i][m] / b / c;
+ q = 0;
+ for (l=1;l<=m;l++) {
+ q = q + w[m][l] * w[i][l];
+ }
+ m1 = m + 1;
+ if (k < m1) goto Et3;
+ for (l=m1;l<=k;l++) {
+ q = q + w[l][m] * w[i][l];
+ }
+
+Et3: s[m] = q / b;
+ xp = xp + s[m] * w[i][m];
+ }
+ bp = xp * 0.5 / b;
+ for (m=1;m<=k;m++) {
+ xp = w[i][m];
+ q = s[m] - bp * xp;
+ s[m] = q;
+ for (l=1;l<=m;l++) {
+ w[m][l] = w[m][l] - xp * s[l] - q * w[i][l];
+ }
+ }
+ for (l=1;l<=k;l++) {
+ w[i][l] = c * w[i][l];
+ }
+
+Etc: d[i] = b;
+ } /* for (i2=2;i2<n0;i2++) */
+
+ s[1] = 0.0;
+ d[1] = 0.0;
+
+ for (i=1;i<=n0;i++) {
+
+ k = i - 1;
+ if (d[i] == 0.0) goto Et4;
+ for (m=1;m<=k;m++) {
+ q = 0.0;
+ for (l=1;l<=k;l++) {
+ q = q + w[i][l] * w[l][m];
+ }
+ for (l=1;l<=k;l++) {
+ w[l][m] = w[l][m] - q * w[l][i];
+ }
+ }
+
+Et4: d[i] = w[i][i];
+ w[i][i] = 1.0;
+ if (k < 1) goto Et5;
+ for (m=1;m<=k;m++) {
+ w[i][m] = 0.0;
+ w[m][i] = 0.0;
+ }
+
+Et5:;
+ }
+
+ for (i=2;i<=n0;i++) {
+ s[i-1] = s[i];
+ }
+ s[n0] = 0.0;
+
+ for (k=1;k<=n0;k++) {
+
+ m = 0;
+
+Et6: for (j=k;j<=n0;j++) {
+ if (j == n0) goto Et7;
+ ab = fabs((double) s[j]);
+ ep = a * (fabs((double) d[j]) + fabs((double) d[j+1]));
+ if (ab < ep) goto Et7;
+ }
+
+Et7: isnou = 1;
+ h = d[k];
+ if (j == k) goto Eta;
+ if (m < ni) goto Etd;
+
+ /*err_message("Error: can't compute matrix eigenvalues");*/
+
+Etd: m = m + 1;
+ q = (d[k+1]-h) * 0.5 / s[k];
+
+/* t = sqrt(q * q + 1.0); */
+ dble = q * q + 1.0;
+ dble = sqrt(dble);
+ t = dble;
+
+ if (q < 0.0) isnou = -1;
+ q = d[j] - h + s[k] / (q + t * isnou);
+ u = 1.0;
+ v = 1.0;
+ h = 0.0;
+ jk = j-k;
+ for (ijk=1;ijk<=jk;ijk++) {
+ i = j - ijk;
+ xp = u * s[i];
+ b = v * s[i];
+ if (fabs((double) xp) < fabs((double) q)) goto Et8;
+ u = xp / q;
+
+/* t = sqrt(u * u + 1); */
+ dble = u * u + 1.0;
+ dble = sqrt(dble);
+ t = dble;
+
+ s[i+1] = q * t;
+ v = 1 / t;
+ u = u * v;
+ goto Et9;
+
+Et8: v = q / xp;
+
+/* t = sqrt(1 + v * v); */
+ dble = 1.0 + v * v;
+ dble = sqrt(dble);
+ t = dble;
+
+ s[i+1] = t * xp;
+ u = 1 / t;
+ v = v * u;
+
+Et9:
+ q = d[i+1] - h;
+ t = (d[i] - q) * u + 2.0 * v * b;
+ h = u * t;
+ d[i+1] = q + h;
+ q = v * t - b;
+ for (l=1;l<=n0;l++) {
+ xp = w[l][i+1];
+ w[l][i+1] = u * w[l][i] + v * xp;
+ w[l][i] = v * w[l][i] - u * xp;
+ }
+ }
+ d[k] = d[k] - h;
+ s[k] = q;
+ s[j] = 0.0;
+
+ goto Et6;
+
+Eta:;
+ } /* for (k=1;k<=n0;k++) */
+
+ for (ij=2;ij<=n0;ij++) {
+
+ i = ij - 1;
+ l = i;
+ h = d[i];
+ for (m=ij;m<=n0;m++) {
+ if (d[m] >= h) {
+ l = m;
+ h = d[m];
+ }
+ }
+ if (l == i) {
+ goto Etb;
+ } else {
+ d[l] = d[i];
+ d[i] = h;
+ }
+ for (m=1;m<=n0;m++) {
+ h = w[m][i];
+ w[m][i] = w[m][l];
+ w[m][l] = h;
+ }
+
+Etb:;
+ } /* for (ij=2;ij<=n0;ij++) */
+
+ *rang = 0;
+ for (i=1;i<=n0;i++) {
+ if (d[i] / d[1] < epsilon) d[i] = 0.0;
+ if (d[i] != 0.0) *rang = *rang + 1;
+ }
+ freevec(s);
+} /* DiagoCompbg */
+/***********************************************************************/
+void freeintvec (int *vec)
+/*--------------------------------------------------
+* liberation de memoire pour un vecteur
+--------------------------------------------------*/
+{
+
+ free((char *) vec);
+
+}
+/***********************************************************************/
+void freetab (double **tab)
+/*--------------------------------------------------
+* Allocation de memoire dynamique pour un tableau (l1, c1)
+--------------------------------------------------*/
+{
+ int i, n;
+
+ n = *(*(tab));
+ for (i=0;i<=n;i++) {
+ free((char *) *(tab+i) );
+ }
+ free((char *) tab);
+}
+/***********************************************************************/
+void freevec (double *vec)
+/*--------------------------------------------------
+* liberation de memoire pour un vecteur
+--------------------------------------------------*/
+{
+ free((char *) vec);
+}
+/***********************************************************************/
+void getpermutation (int *numero, int repet)
+/*----------------------
+* affectation d'une permutation al�atoire des n premiers entiers
+* dans dans un vecteur d'entiers de dimension n
+* vecintalloc pr�alable exig�
+* *numero est un vecteur d'entier
+* repet est un entier qui peut prendre une valeur arbitraire
+* utilise dans le germe du generateur de nb pseudo-aleatoires
+* si on l'incremente dans des appels repetes (e.g. simulation) garantit
+* que deux appels donnent deux resultats distincts (seed=clock+repet)
+------------------------*/
+{
+ int i, n, seed;
+ int *alea;
+
+ n=numero[0];
+ vecintalloc (&alea,n);
+
+ /*-------------
+ * numerotation dans numero
+ -----------*/
+ for (i=1;i<=n;i++) {
+ numero[i]=i;
+ }
+
+ /*-------------
+ * affectation de nombres aleatoires dans alea
+ ----------------*/
+ /* seed = clock(); */
+ /* seed = seed + repet; */
+ /* srand(seed); */
+ GetRNGstate();
+ for (i=1;i<=n;i++) {
+ alea[i]=unif_rand();
+ }
+ PutRNGstate();
+ trirapideint (alea , numero, 1, n);
+ freeintvec (alea);
+}
+/***********************************************************************/
+void matcentrage (double **A, double *poili, char *typ)
+{
+
+ if (strcmp (typ,"nc") == 0) {
+ return;
+ } else if (strcmp (typ,"cm") == 0) {
+ matmodifcm (A, poili);
+ return;
+ } else if (strcmp (typ,"cn") == 0) {
+ matmodifcn (A, poili);
+ return;
+ } else if (strcmp (typ,"cp") == 0) {
+ matmodifcp (A, poili);
+ return;
+ } else if (strcmp (typ,"cs") == 0) {
+ matmodifcs (A, poili);
+ return;
+ } else if (strcmp (typ,"fc") == 0) {
+ matmodiffc (A, poili);
+ return;
+ } else if (strcmp (typ,"fl") == 0) {
+ matmodifcm (A, poili);
+ return;
+ }
+}
+/***********************************************************************/
+void matmodifcm (double **tab, double *poili)
+/*--------------------------------------------------
+* tab est un tableau n lignes, m colonnes
+* disjonctif complet
+* poili est un vecteur n composantes
+* la procedure retourne tab centre par colonne
+* pour la ponderation poili (somme=1)
+* centrage type correspondances multiples
+--------------------------------------------------*/
+{
+ double poid;
+ int i, j, l1, m1;
+ double *poimoda;
+ double x, z;
+
+ l1 = tab[0][0];
+ m1 = tab[1][0];
+ vecalloc(&poimoda, m1);
+
+
+ for (i=1;i<=l1;i++) {
+ poid = poili[i];
+ for (j=1;j<=m1;j++) {
+ poimoda[j] = poimoda[j] + tab[i][j] * poid;
+ }
+ }
+
+ for (j=1;j<=m1;j++) {
+ x = poimoda[j];
+ if (x==0) {
+ for (i=1;i<=l1;i++) tab[i][j] = 0;
+ } else {
+
+ for (i=1;i<=l1;i++) {
+ z = tab[i][j]/x - 1.0;
+ tab[i][j] = z;
+ }
+ }
+ }
+ freevec (poimoda);
+}
+/***********************************************************************/
+void matmodifcn (double **tab, double *poili)
+/*--------------------------------------------------
+* tab est un tableau n lignes, p colonnes
+* poili est un vecteur n composantes
+* la procedure retourne tab norme par colonne
+* pour la ponderation poili (somme=1)
+--------------------------------------------------*/
+{
+ double poid, x, z, y, v2;
+ int i, j, l1, c1;
+ double *moy, *var;
+
+ l1 = tab[0][0];
+ c1 = tab[1][0];
+
+ vecalloc(&moy, c1);
+ vecalloc(&var, c1);
+
+
+/*--------------------------------------------------
+* calcul du tableau centre/norme
+--------------------------------------------------*/
+
+ for (i=1;i<=l1;i++) {
+ poid = poili[i];
+ for (j=1;j<=c1;j++) {
+ moy[j] = moy[j] + tab[i][j] * poid;
+ }
+ }
+
+ for (i=1;i<=l1;i++) {
+ poid=poili[i];
+ for (j=1;j<=c1;j++) {
+ x = tab[i][j] - moy[j];
+ var[j] = var[j] + poid * x * x;
+ }
+ }
+
+ for (j=1;j<=c1;j++) {
+ v2 = var[j];
+ if (v2<=0) v2 = 1;
+ v2 = sqrt(v2);
+ var[j] = v2;
+ }
+
+ for (i=1;i<=c1;i++) {
+ x = moy[i];
+ y = var[i];
+ for (j=1;j<=l1;j++) {
+ z = tab[j][i] - x;
+ z = z / y;
+ tab[j][i] = z;
+ }
+ }
+
+ freevec(moy);
+ freevec(var);
+
+}
+/***********************************************************************/
+void matmodifcs (double **tab, double *poili)
+/*--------------------------------------------------
+* tab est un tableau n lignes, p colonnes
+* poili est un vecteur n composantes
+* la procedure retourne tab standardise par colonne
+* pour la ponderation poili (somme=1)
+--------------------------------------------------*/
+{
+ double poid, x, z, y, v2;
+ int i, j, l1, c1;
+ double *var;
+
+ l1 = tab[0][0];
+ c1 = tab[1][0];
+
+ vecalloc(&var, c1);
+
+
+/*--------------------------------------------------
+* calcul du tableau standardise
+--------------------------------------------------*/
+
+ for (i=1;i<=l1;i++) {
+ poid=poili[i];
+ for (j=1;j<=c1;j++) {
+ x = tab[i][j];
+ var[j] = var[j] + poid * x * x;
+ }
+ }
+
+ for (j=1;j<=c1;j++) {
+ v2 = var[j];
+ if (v2<=0) v2 = 1;
+ v2 = sqrt(v2);
+ var[j] = v2;
+ }
+
+ for (i=1;i<=c1;i++) {
+ y = var[i];
+ for (j=1;j<=l1;j++) {
+ z = tab[j][i];
+ z = z / y;
+ tab[j][i] = z;
+ }
+ }
+ freevec(var);
+}
+/***********************************************************************/
+void matmodifcp (double **tab, double *poili)
+/*--------------------------------------------------
+* tab est un tableau n lignes, p colonnes
+* poili est un vecteur n composantes
+* la procedure retourne tab centre par colonne
+* pour la ponderation poili (somme=1)
+--------------------------------------------------*/
+{
+ double poid;
+ int i, j, l1, c1;
+ double *moy, x, z;
+
+ l1 = tab[0][0];
+ c1 = tab[1][0];
+ vecalloc(&moy, c1);
+
+
+/*--------------------------------------------------
+* calcul du tableau centre
+--------------------------------------------------*/
+
+ for (i=1;i<=l1;i++) {
+ poid = poili[i];
+ for (j=1;j<=c1;j++) {
+ moy[j] = moy[j] + tab[i][j] * poid;
+ }
+ }
+
+
+ for (i=1;i<=c1;i++) {
+ x = moy[i];
+ for (j=1;j<=l1;j++) {
+ z = tab[j][i] - x;
+ tab[j][i] = z;
+ }
+ }
+ freevec(moy);
+}
+/***********************************************************************/
+void matmodiffc (double **tab, double *poili)
+/*--------------------------------------------------
+* tab est un tableau n lignes, m colonnes
+* de nombres positifs ou nuls
+* poili est un vecteur n composantes
+* la procedure retourne tab centre doublement
+* pour la ponderation poili (somme=1)
+* centrage type correspondances simples
+--------------------------------------------------*/
+{
+ double poid;
+ int i, j, l1, m1;
+ double *poimoda;
+ double x, z;
+
+ l1 = tab[0][0];
+ m1 = tab[1][0];
+ vecalloc(&poimoda, m1);
+
+
+ for (i=1;i<=l1;i++) {
+ x = 0;
+ for (j=1;j<=m1;j++) {
+ x = x + tab[i][j];
+ }
+ if (x!=0) {
+ for (j=1;j<=m1;j++) {
+ tab[i][j] = tab[i][j]/x;
+ }
+ }
+ }
+
+ for (i=1;i<=l1;i++) {
+ poid = poili[i];
+ for (j=1;j<=m1;j++) {
+ poimoda[j] = poimoda[j] + tab[i][j] * poid;
+ }
+ }
+
+ for (j=1;j<=m1;j++) {
+ x = poimoda[j];
+ if (x==0) {
+ /*err_message("column has a nul weight (matmodiffc)");*/
+ }
+
+ for (i=1;i<=l1;i++) {
+ z = tab[i][j]/x - 1.0;
+ tab[i][j] = z;
+ }
+ }
+ freevec (poimoda);
+}
+/***********************************************************************/
+void matpermut (double **A, int *num, double **B)
+{
+/*---------------------------------------
+* A est une matrice n-p
+* B est une matrice n-p
+* num est une permutation al�atoire des n premiers entiers
+* B contient en sortie les lignes de A permut�es
+* ---------------------------------------*/
+
+ int lig, col,lig1, col1, lig2, i, j, k;
+
+ lig = A[0][0];
+ col = A[1][0];
+ lig1 = B[0][0];
+ col1 = B[1][0];
+ lig2 = num[0];
+
+
+ if ( (lig!=lig1) || (col!=col1) || (lig!=lig2) ) {
+ return;
+ }
+
+ for (i=1; i<=lig; i++) {
+ k=num[i];
+ for (j=1; j<=col; j++) {
+ B[i][j] = A[k][j];
+ }
+ }
+}
+/***********************************************************************/
+void prodmatABC (double **a, double **b, double **c)
+/*--------------------------------------------------
+* Produit matriciel AB
+--------------------------------------------------*/
+{
+ int j, k, i, lig, col, col2;
+ double s;
+
+ lig = a[0][0];
+ col = a[1][0];
+
+ col2 = b[1][0];
+
+ for (i=1;i<=lig;i++) {
+ for (k=1;k<=col2;k++) {
+ s = 0;
+ for (j=1;j<=col;j++) {
+ s = s + a[i][j] * b[j][k];
+ }
+ c[i][k] = s;
+ }
+ }
+}
+
+/***********************************************************************/
+void prodmatAtAB (double **a, double **b)
+/*--------------------------------------------------
+* Produit matriciel AtA
+--------------------------------------------------*/
+{
+ int j, k, i, lig, col;
+ double s;
+
+ lig = a[0][0];
+ col = a[1][0];
+
+ for (j=1;j<=col;j++) {
+ for (k=j;k<=col;k++) {
+ s = 0;
+ for (i=1;i<=lig;i++) {
+ s = s + a[i][k] * a[i][j];
+ }
+ b[j][k] = s;
+ b[k][j] = s;
+ }
+ }
+}
+/***********************************************************************/
+void prodmatAtBC (double **a, double **b, double **c)
+/*--------------------------------------------------
+* Produit matriciel AtB
+--------------------------------------------------*/
+{
+ int j, k, i, lig, col, col2;
+ double s;
+
+ lig = a[0][0];
+ col = a[1][0];
+
+ col2 = b[1][0];
+
+ for (j=1;j<=col;j++) {
+ for (k=1;k<=col2;k++) {
+ s = 0;
+ for (i=1;i<=lig;i++) {
+ s = s + a[i][j] * b[i][k];
+ }
+ c[j][k] = s;
+ }
+ }
+}
+/***********************************************************************/
+double maxvec (double *vec)
+/*--------------------------------------------------
+* calcul le max d'un vecteur
+--------------------------------------------------*/
+{
+ int i, len;
+ double x;
+
+ x = vec[1];
+ len = vec[0];
+ for (i=1;i<=len;i++) {
+ if (vec[i] > x) x = vec[i];
+ }
+ return(x);
+}
+/***********************************************************************/
+void prodmatAAtB (double **a, double **b)
+/*--------------------------------------------------
+* Produit matriciel B = AAt
+--------------------------------------------------*/
+{
+ int j, k, i, lig, col;
+ double s;
+
+ lig = a[0][0];
+ col = a[1][0];
+
+ for (j=1;j<=lig;j++) {
+ for (k=j;k<=lig;k++) {
+ s = 0;
+ for (i=1;i<=col;i++) {
+ s = s + a[j][i] * a[k][i];
+ }
+ b[j][k] = s;
+ b[k][j] = s;
+ }
+ }
+}
+/***********************************************************************/
+void prodmatAtBrandomC (double **a, double **b, double **c, int*permut)
+/*--------------------------------------------------
+* Produit matriciel AtB
+* les lignes de B sont permut�es par la permutation permut
+--------------------------------------------------*/
+{
+ int j, k, i, i0, lig, col, col2;
+ double s;
+
+ lig = a[0][0];
+ col = a[1][0];
+
+ col2 = b[1][0];
+
+ for (j=1;j<=col;j++) {
+ for (k=1;k<=col2;k++) {
+ s = 0;
+ for (i=1;i<=lig;i++) {
+ i0 = permut[i];
+ s = s + a[i][j] * b[i0][k];
+ }
+ c[j][k] = s;
+ }
+ }
+}
+/***********************************************************************/
+void sqrvec (double *v1)
+/*--------------------------------------------------
+* Racine carree des elements d'un vecteur
+--------------------------------------------------*/
+{
+ int i, c1;
+ double v2;
+
+ c1 = v1[0];
+
+ for (i=1;i<=c1;i++) {
+ v2 = v1[i];
+ /* if (v2 < 0.0) err_message("Error: Square root of negative number (sqrvec)");*/
+ v2 = sqrt(v2);
+ v1[i] = v2;
+ }
+}
+/***********************************************************************/
+void taballoc (double ***tab, int l1, int c1)
+/*--------------------------------------------------
+* Allocation de memoire dynamique pour un tableau (l1, c1)
+--------------------------------------------------*/
+{
+ int i, j;
+
+ if ( (*tab = (double **) calloc(l1+1, sizeof(double *))) != 0) {
+ for (i=0;i<=l1;i++) {
+ if ( (*(*tab+i)=(double *) calloc(c1+1, sizeof(double))) == 0 ) {
+ return;
+ for (j=0;j<i;j++) {
+ free(*(*tab+j));
+ }
+ }
+ }
+ }
+
+ **(*tab) = l1;
+ **(*tab+1) = c1;
+}
+/***********************************************************************/
+void trild (double *x , int *num, int gauche, int droite)
+/*--------------------------------------------------
+* Tri d'un tableau de double avec conservation du rang
+* dans un tableau entier.
+--------------------------------------------------*/
+{
+ int j, dernier, milieu;
+ double t;
+
+
+ if ( (droite-gauche)<=0) return;
+ milieu = (gauche+droite)/2;
+ trildswap (x, gauche, milieu);
+
+ trildintswap (num, gauche, milieu);
+ t=x[gauche];
+ dernier=gauche;
+ for (j = gauche+1; j<=droite; j++) {
+ if (x[j] > t) {
+ dernier = dernier + 1;
+ trildswap (x, dernier, j);
+ trildintswap (num, dernier, j);
+ }
+ }
+ trildswap (x, gauche, dernier);
+ trildintswap (num, gauche, dernier);
+ trild (x, num, gauche, dernier-1);
+ trild (x, num, dernier+1, droite);
+}
+/**************************/
+void trildintswap (int *v, int i, int j)
+{
+ int provi;
+
+ provi=v[i];
+ v[i]=v[j];
+ v[j]=provi;
+}
+/***********************************************************************/
+void trildswap (double *v, int i, int j)
+/*--------------------------------------------------
+* Echange les valeurs de deux double
+--------------------------------------------------*/
+{
+ double provi;
+
+ provi=v[i];
+ v[i]=v[j];
+ v[j]=provi;
+}
+
+/***********************************************************************/
+void trirap (double *x , int *num)
+/*--------------------------------------------------
+* Tri d'un tableau de double par ordre croissant
+* avec conservation du rang dans un tableau entier.
+--------------------------------------------------*/
+{
+ int i, n, *num2, gauche, droite;
+ double *x2;
+
+ n = x[0];
+ gauche = 1;
+ droite = n;
+ vecalloc(&x2, n);
+ vecintalloc(&num2, n);
+ for (i=1;i<=n;i++) num[i] = i;
+ trild(x, num, gauche, droite);
+ for (i=1;i<=n;i++) {
+ x2[i] = x[n - i + 1];
+ num2[i] = num[n - i + 1];
+ }
+ for (i=1;i<=n;i++) {
+ x[i] = x2[i];
+ num[i] = num2[i];
+ }
+ freevec(x2);
+ freeintvec(num2);
+}
+/***********************************************************************/
+void trirapideint (int *x , int *num, int gauche, int droite)
+{
+ int j, dernier, milieu, t;
+
+ if ( (droite-gauche)<=0) return;
+
+ milieu = (gauche+droite)/2;
+ trirapideintswap (x, gauche, milieu);
+ trirapideintswap (num, gauche, milieu);
+
+ t=x[gauche];
+ dernier=gauche;
+ for (j = gauche+1; j<=droite; j++) {
+ if (x[j] < t) {
+ dernier = dernier + 1;
+ trirapideintswap (x, dernier, j);
+ trirapideintswap (num, dernier, j);
+ }
+ }
+ trirapideintswap (x, gauche, dernier);
+ trirapideintswap (num, gauche, dernier);
+
+ trirapideint (x, num, gauche, dernier-1);
+ trirapideint (x, num, dernier+1, droite);
+
+}
+/***********************************************************************/
+void trirapideintswap (int *v, int i, int j)
+{
+ int provi;
+
+ provi=v[i];
+ v[i]=v[j];
+ v[j]=provi;
+}
+/***********************************************************************/
+void vecalloc (double **vec, int n)
+/*--------------------------------------------------
+* Allocation de memoire pour un vecteur de longueur n
+--------------------------------------------------*/
+{
+ if ( (*vec = (double *) calloc(n+1, sizeof(double))) != 0) {
+ **vec = n;
+ return;
+ } else {
+ return;
+ }
+}
+/***********************************************************************/
+void vecintalloc (int **vec, int n)
+/*--------------------------------------------------
+* Allocation de memoire pour un vecteur d'entiers de longueur n
+--------------------------------------------------*/
+{
+ if ( (*vec = (int *) calloc(n+1, sizeof(int))) != NULL) {
+ **vec = n;
+ return;
+ } else {
+ return;
+ }
+}
+
+
+
+/***********************************************************************/
+void vecpermut (double *A, int *num, double *B)
+{
+/*---------------------------------------
+* A est un vecteur n elements
+* B est une vecteur n elements
+* num est une permutation al�atoire des n premiers entiers
+* B contient en sortie les elements de A permut�es
+* ---------------------------------------*/
+
+ int lig, lig1, lig2, i, k;
+
+ lig = A[0];
+ lig1 = B[0];
+ lig2 = num[0];
+
+
+ if ( (lig!=lig1) || (lig!=lig2) ) {
+ /*err_message ("Illegal parameters (vecpermut)");
+ closelisting();*/
+ }
+
+ for (i=1; i<=lig; i++) {
+ k=num[i];
+ B[i] = A[k];
+ }
+}
diff --git a/src/adesub.h b/src/adesub.h
new file mode 100644
index 0000000..73904f1
--- /dev/null
+++ b/src/adesub.h
@@ -0,0 +1,45 @@
+#include <math.h>
+#include <time.h>
+#include <string.h>
+#include <stdlib.h>
+
+int dtodelta (double **data, double *pl);
+void initvec (double *v1, double r);
+double alea (void);
+void aleapermutvec (double *a);
+void aleapermutmat (double **a);
+void aleapermutmat (double **a);
+void aleapermutvec (double *a);
+void DiagobgComp (int n0, double **w, double *d, int *rang);
+void freeinttab (int **tab);
+void freeintvec (int *vec);
+void freetab (double **tab);
+void freevec (double *vec);
+void getpermutation (int *numero, int repet);
+void matcentrage (double **A, double *poili, char *typ);
+void matcentragehi (double **tab, double *poili, int *index, int *assign);
+void matmodifcm (double **tab, double *poili);
+void matmodifcn (double **tab, double *poili);
+void matmodifcp (double **tab, double *poili);
+void matmodifcs (double **tab, double *poili);
+void matmodiffc (double **tab, double *poili);
+void matpermut (double **A, int *num, double **B);
+double maxvec (double *vec);
+void prodmatAAtB (double **a, double **b);
+void prodmatABC (double **a, double **b, double **c);
+void prodmatAtAB (double **a, double **b);
+void prodmatAtBC (double **a, double **b, double **c);
+void prodmatAtBrandomC (double **a, double **b, double **c, int*permut);
+double traceXtdLXq (double **X, double **L, double *d, double *q);
+void sqrvec (double *v1);
+void taballoc (double ***tab, int l1, int c1);
+void tabintalloc (int ***tab, int l1, int c1);
+void trild (double *x , int *num, int gauche, int droite);
+void trildintswap (int *v, int i, int j);
+void trildswap (double *v, int i, int j);
+void trirap (double *x , int *num);
+void trirapideint (int *x , int *num, int gauche, int droite);
+void trirapideintswap (int *v, int i, int j);
+void vecalloc (double **vec, int n);
+void vecintalloc (int **vec, int n);
+void vecpermut (double *A, int *num, double *B);
diff --git a/src/distPhylo.c b/src/distPhylo.c
new file mode 100644
index 0000000..d88070d
--- /dev/null
+++ b/src/distPhylo.c
@@ -0,0 +1,368 @@
+/*
+ Coded by Thibaut Jombart (tjombart at imperial.ac.uk), March 2010.
+ Distributed with the adephylo package for the R software.
+ Licence: GPL >=2.
+
+ Notes:
+ These functions implement several different phylogenetic distances between all pairs of tips in a phylogeny.
+ These functions require sptips.c and adesub.c.
+*/
+
+
+#include <math.h>
+#include <time.h>
+#include <string.h>
+#include <stdlib.h>
+#include <R.h>
+#include <R_ext/Utils.h>
+#include "adesub.h"
+#include "sptips.h"
+#include <R_ext/Print.h>
+
+/*
+ =============================
+ UTILITARY (INTERNAL) FUNCTIONS
+ =============================
+*/
+
+
+/*
+ === FIND THE LENGTH OF AN EDGE ===
+ == for internal use only ==
+ - the edge is identified by the descending node
+ - ances, desc, and brlength must be created using vecintalloc
+ - N is the number of edges to represent the tree
+*/
+double findedgelength(int *desc, double *brlength, int N, int myNode){
+ int posi=0;
+
+
+ /* find the edge */
+ posi = intAinB(myNode, desc, N);
+
+ if(posi==0){
+ Rprintf("\n Likely error in findedgelength: edge not found");
+ /* printf("\n Likely error in findedgelength: edge not found"); */
+ return(0.0);
+ }
+
+ /* return corresponding length */
+ return(brlength[posi]);
+} /* end findedgelength */
+
+
+
+
+
+/*
+ === FIND THE NUMBER OF DIRECT DESCENDENTS (DD) OF A NODE ===
+ == for internal use only ==
+ - ances, desc, and brlength must be created using vecintalloc
+ - N is the number of edges to represent the tree
+*/
+int findNbDD(int *ances, int *desc, int N, int myNode){
+ int i, nbDD=0;
+
+
+ /* browse the ances vector */
+ for(i=1; i<=N; i++){
+ if(ances[i] == myNode) {
+ nbDD++;
+ }
+ }
+
+ if(nbDD==0){
+ Rprintf("\n Likely error in findNbDD: no direct descendent found.\n");
+ /* printf("\n Likely error in findNbDD: no direct descendent found.\n"); */
+ }
+
+ /* return corresponding length */
+ return(nbDD);
+} /* end findedgelength */
+
+
+
+
+
+
+
+/*
+ === DISTANCE(s) BETWEEN TWO TIPS ===
+ == for internal use only ==
+ - ances, desc, and brlength must be created using vecintalloc
+ - N is the number of edges to represent the tree
+ - 'method' indicates the type of distance: 1) patristic 2) nNodes 3) Abouheif 4) sumDD
+ - edges are identified by their descending node
+ - for patristic distances, the set of edge used is: {output of sp2tips} U {tipA, tipB} \ {output of mrca2tips}
+ - for all others: {output of sp2tips}
+*/
+double dist2tips(int *ances, int *desc, double *brlength, int N, int tipA, int tipB, int method){
+ /* declarations */
+ int *path, *lengthPath, *myMrca;
+ int i;
+ double res;
+
+
+ /* allocate memory */
+ vecintalloc(&path, N);
+ lengthPath = (int *) calloc(1, sizeof(int));
+ vecintalloc(&myMrca, 1); /* has to be this way, not a simple pointer, to be used in intANotInB */
+
+ /* /\* debugging *\/ */
+ /* printf("\n-- Input to dist2tips --\n"); */
+ /* printf("\nances:"); */
+ /* for(i=1;i<=N; i++){ */
+ /* printf(" %d", ances[i]); */
+ /* } */
+ /* printf("\ndesc:"); */
+ /* for(i=1;i<=N; i++){ */
+ /* printf(" %d", desc[i]); */
+ /* } */
+ /* printf("\nedge length:"); */
+ /* for(i=1;i<=N; i++){ */
+ /* printf(" %f", brlength[i]); */
+ /* } */
+
+
+ /* find the shortest path between the two tips */
+ sp2tips(ances, desc, N, tipA, tipB, path, lengthPath);
+ /* printf("\nShortest path found in dist2tips:"); */
+ /* for(i=1;i<=*lengthPath; i++){ */
+ /* printf(" %d", path[i]); */
+ /* } */
+
+
+ /* compute the distance */
+ switch( method )
+ {
+ case 1: /* patristic distance */
+ /* find the mrca */
+ myMrca[1] = 0;
+ myMrca[1] = mrca2tips(ances, desc, tipA, tipB, N);
+
+ /* remove mrca from the path */
+ /* printf("\nMRCA: %d", myMrca[1]); */
+ intANotInB(path, myMrca, *lengthPath, 1, path, lengthPath);
+
+ /* add tips to the path */
+ *lengthPath = *lengthPath + 1;
+ path[*lengthPath] = tipA;
+ *lengthPath = *lengthPath + 1;
+ path[*lengthPath] = tipB;
+
+ /* printf("\nPath used in patristic distance:"); */
+ /* for(i=1;i<=*lengthPath; i++){ */
+ /* printf(" %d", path[i]); */
+ /* } */
+
+ /* compute length */
+ res=0.0;
+ for(i=1; i<=*lengthPath; i++){
+ res = res + findedgelength(desc, brlength, N, path[i]);
+ /* printf("\nlength of edge terminating by %d: %f", path[i], findedgelength(desc, brlength, N, path[i])); */
+ /* printf("\n value of res: %f", res); */
+ }
+ break;
+
+ case 2: /* number of nodes */
+ res = *lengthPath;
+ break;
+
+ case 3: /* prod DD (Abouheif) */
+ res=1.0;
+ for(i=1; i<=*lengthPath; i++){
+ res = res * findNbDD(ances, desc, N, path[i]);
+ }
+ break;
+
+ case 4: /* sum DD */
+ res=0.0;
+ for(i=1; i<=*lengthPath; i++){
+ res = res + findNbDD(ances, desc, N, path[i]);
+ }
+ break;
+
+ default :
+ res=0.0;
+ Rprintf("\n\n Likely error in dist2tips: unknown method (%d):", method);
+ /* printf("\n\n Likely error in dist2tips: unknown method (%d):", method); */
+ break;
+ }
+
+ /* free memory */
+ freeintvec(path);
+ free(lengthPath);
+ freeintvec(myMrca);
+
+ /* printf("\nDistance between %d and %d: %f", tipA, tipB, res); */
+ return(res);
+} /* end dist2tips */
+
+
+
+
+
+/*
+ ==========================
+ MAIN (EXTERNAL) FUNCTION
+ ==========================
+*/
+
+
+
+/*
+ === FIND DISTANCES BETWEEN ALL PAIRS OF TIPS ===
+ == for internal/external uses ==
+ - all arguments are passed from R
+ - N is the number of edges to represent the tree
+ - nTips is the total number of tips in the tree
+ - 'method' indicates the type of distance: 1) patristic 2) nNodes 3) Abouheif 4) sumDD
+*/
+void distalltips(int *ances, int *desc, double *brlength, int *N, int *nTips, double *res, int *resSize, int *method){
+ /* declarations */
+ int i, j, k, temp;
+ int *ancesLoc, *descLoc; /* must use dynamic allocation */
+ double *brlengthLoc; /* must use dynamic allocation */
+
+ /* check resSize */
+ temp = (*nTips) * (*nTips-1) / 2;
+ if(*resSize != temp) {
+ Rprintf("\n Likely error in distalltips: resSize is %d, and should be %d.\n", *resSize, temp);
+ /* printf("\n Likely error in distalltips: resSize is %d, and should be %d.\n", *resSize, temp); */
+ return;
+ }
+
+
+ /* allocate memory for local variables */
+ vecintalloc(&ancesLoc, *N);
+ vecintalloc(&descLoc, *N);
+ vecalloc(&brlengthLoc, *N);
+
+
+ /* create local vectors for ancestors, descendents and branch lengths */
+ ancesLoc[0] = *N;
+ descLoc[0] = *N;
+ brlengthLoc[0] = *N ; /* implicit casting int->double */
+ for(i=0; i< *N; i++){
+ ancesLoc[i+1] = ances[i];
+ descLoc[i+1] = desc[i];
+ brlengthLoc[i+1] = brlength[i];
+ }
+
+
+ /* perform computations for all pairs of tips (indexed 'i,j') */
+ k = 0; /* used to browse 'res' */
+
+ for(i=1; i<=(*nTips-1); i++){
+ for(j=(i+1); j<=(*nTips); j++){
+ res[k] = dist2tips(ancesLoc, descLoc, brlengthLoc, *N, i, j, *method);
+ /*printf("\nDistance between tip %d and %d in main function: %f", i, j, res[k]);*/
+ k++;
+ }
+ }
+
+ /* free memory */
+ freeintvec(ancesLoc);
+ freeintvec(descLoc);
+ freevec(brlengthLoc);
+
+} /* end distalltips */
+
+
+
+
+
+
+
+/* /\* === FIND DISTANCES BETWEEN GIVEN PAIRS OF TIPS === *\/ */
+/* /\* === THIS HAS NOT BEEN TESTED === *\/ */
+/* void distpairtips(int *ances, int *desc, double *brlength, int *N, int *nTips, double *res, int *resSize, int *method, int *tipsA, int *tipsB){ */
+/* /\* declarations *\/ */
+/* int i, j, k, temp; */
+/* int *ancesLoc, *descLoc; /\* must use dynamic allocation *\/ */
+/* double *brlengthLoc; /\* must use dynamic allocation *\/ */
+
+/* /\* check resSize *\/ */
+/* temp = (*nTips) * (*nTips-1) / 2; */
+/* if(*resSize != temp) { */
+/* printf("\n Likely error in distalltips: resSize is %d, and should be %d.\n", *resSize, temp); */
+/* return; */
+/* } */
+
+
+/* /\* allocate memory for local variables *\/ */
+/* vecintalloc(&ancesLoc, *N); */
+/* vecintalloc(&descLoc, *N); */
+/* vecalloc(&brlengthLoc, *N); */
+
+
+/* /\* create local vectors for ancestors, descendents and branch lengths *\/ */
+/* ancesLoc[0] = *N; */
+/* descLoc[0] = *N; */
+/* brlengthLoc[0] = *N ; /\* implicit casting int->double *\/ */
+/* for(i=0; i< *N; i++){ */
+/* ancesLoc[i+1] = ances[i]; */
+/* descLoc[i+1] = desc[i]; */
+/* brlengthLoc[i+1] = brlength[i]; */
+/* } */
+
+
+/* /\* perform computations for all pairs of tips (indexed 'i,j') *\/ */
+/* k = 0; /\* used to browse 'res' *\/ */
+
+/* for(i=0; i<*resSize; i++){ */
+/* res[k++] = dist2tips(ancesLoc, descLoc, brlengthLoc, *N, tipsA[i], tipsB[j], *method); */
+/* /\*printf("\nDistance between tip %d and %d in main function: %f", i, j, res[k]);*\/ */
+/* } */
+
+/* /\* free memory *\/ */
+/* freeintvec(ancesLoc); */
+/* freeintvec(descLoc); */
+/* freevec(brlengthLoc); */
+
+/* } /\* end distpairtips *\/ */
+
+
+
+
+/* TESTING */
+/*
+
+library(adephylo)
+tre=rtree(5)
+#tre$edge.length <- round(tre$edge.length*10)
+#tre$edge.length[tre$edge.length<1] <- 1
+
+plot(tre)
+nodelabels()
+tiplabels()
+edgelabels(text=tre$edge.length)
+
+n <- as.integer(nTips(tre))
+resSize=as.integer(n*(n-1)/2)
+res <- numeric(resSize)
+
+
+# void distalltips(int *ances, int *desc, double *brlength, int *N, int *nTips, double *res, int *resSize, int *method){
+
+## patristic
+toto <- .C("distalltips", as.integer(tre$edge[,1]), as.integer(tre$edge[,2]), as.double(tre$edge.length), nrow(tre$edge), n, res, length(res), as.integer(1))
+res <- toto[[6]]
+res
+
+## nNodes
+toto <- .C("distalltips", as.integer(tre$edge[,1]), as.integer(tre$edge[,2]), as.double(tre$edge.length), nrow(tre$edge), n, res, length(res), as.integer(2))
+res <- toto[[6]]
+res
+
+## Abou
+toto <- .C("distalltips", as.integer(tre$edge[,1]), as.integer(tre$edge[,2]), as.double(tre$edge.length), nrow(tre$edge), n, res, length(res), as.integer(3))
+res <- toto[[6]]
+res
+
+## sumDD
+toto <- .C("distalltips", as.integer(tre$edge[,1]), as.integer(tre$edge[,2]), as.double(tre$edge.length), nrow(tre$edge), n, res, length(res), as.integer(4))
+res <- toto[[6]]
+res
+
+*/
diff --git a/src/misc.c b/src/misc.c
new file mode 100644
index 0000000..c044026
--- /dev/null
+++ b/src/misc.c
@@ -0,0 +1,29 @@
+#include <math.h>
+#include <time.h>
+#include <string.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <R_ext/Print.h>
+
+/* interpolate values in a density */
+/* x contais n values for which we want y=f(x) */
+void predict_density(double *densx, double *densy, int *densn, double *x, double *y, int *n){
+ int i, idx;
+
+ for(i=0;i<*n;i++){
+ idx=0;
+ while(idx < *densn && x[i]>densx[idx]){
+ idx++;
+ }
+ if(idx==0){
+ y[i] = densy[idx]/2.0;
+ /* printf("\nx: %.5f, idx: %d, x.chosen: %.5f, %.5f = %.5f / 2.0", x[i], idx, densx[idx], y[i], densy[idx]); */
+ } else if(idx==*densn){
+ y[i] = densy[idx-1]/2.0;
+ /* printf("\nx: %.5f, idx: %d, x.chosen: %.5f, %.5f = %.5f / 2.0", x[i], idx, densx[idx-1], y[i], densy[idx-1]); */
+ } else {
+ y[i] = (densy[idx-1] + densy[idx])/2.0;
+ /* printf("\nx: %.5f, idx: %d, x.before: %.5f, x.after: %.5f, %.5f = %.5f + %.5f / 2.0", x[i], idx, densx[idx-1], densx[idx], y[i], densy[idx-1], densy[idx]); */
+ }
+ }
+}
diff --git a/src/phylog.c b/src/phylog.c
new file mode 100644
index 0000000..51331b5
--- /dev/null
+++ b/src/phylog.c
@@ -0,0 +1,478 @@
+#include <math.h>
+#include <time.h>
+#include <string.h>
+#include <stdlib.h>
+#include <R.h>
+#include <R_ext/Utils.h>
+#include "adesub.h"
+
+void gearymoran (int *param, double *data, double *bilis,
+ double *obs, double *result, double *obstot, double *restot);
+
+void VarianceDecompInOrthoBasis (int *param, double *z, double *matvp,
+ double *phylogram, double *phylo95,double *sig025, double *sig975,
+ double *test1, double *test2, double*test3, double *test4, double *test5);
+
+void MVarianceDecompInOrthoBasis (int *param, double *z, int *nvar, double *inertot, double *matvp,
+ double *phylogram, double *phylo95,double *sig025, double *sig975,
+ double *test1, double *test2, double*test3, double *test4, double *test5);
+
+
+ void gearymoran (int *param, double *data, double *bilis,
+ double *obs, double *result, double *obstot, double *restot)
+{
+ /* Declarations des variables C locales */
+ int nobs, nvar, nrepet, i, j, k, krepet, kvar ;
+ int *numero;
+ double provi;
+ double *poili;
+ double **mat, **tab, **tabperm;
+
+
+ /* Allocation memoire pour les variables C locales */
+ nobs = param[0];
+ nvar = param [1];
+ nrepet = param [2];
+ vecalloc(&poili,nobs);
+ taballoc(&mat,nobs,nobs);
+ taballoc(&tab,nobs,nvar);
+ taballoc(&tabperm,nobs,nvar);
+ vecintalloc (&numero, nobs);
+
+ /* D�finitions des variables C locales */
+ k = 0;
+ for (i=1; i<=nvar; i++) {
+ for (j=1; j<=nobs; j++) {
+ tab[j][i] = data[k] ;
+ k = k+1 ;
+ }
+ }
+
+ k = 0;
+ provi = 0;
+ for (j=1; j<=nobs; j++) {
+ for (i=1; i<=nobs; i++) {
+ mat[i][j] = bilis[k] ;
+ provi = provi + bilis[k];
+ k = k+1 ;
+ }
+ }
+ for (j=1; j<=nobs; j++) {
+ for (i=1; i<=nobs; i++) {
+ mat[i][j] = mat[i][j]/provi ;
+ }
+ }
+ /* mat contient une distribution de fr�quence bivari�e */
+ for (j=1; j<=nobs; j++) {
+ poili[j] = 1/(double)(nobs);
+ }
+ /* poili contains uniform weights*/
+ matmodifcn(tab,poili);
+ /* data are standardized using uniform weights */
+
+ for (kvar=1; kvar<=nvar; kvar++) {
+ provi = 0;
+ for (j=1; j<=nobs; j++) {
+ for (i=1; i<=nobs; i++) {
+ provi = provi + tab[i][kvar]*tab[j][kvar]*mat[i][j] ;
+ }
+ }
+ obs[kvar-1] = provi;
+ }
+ k=0;
+ /* les r�sultats se suivent par simulation */
+ for (krepet=1; krepet<=nrepet; krepet++) {
+ getpermutation (numero, krepet);
+ matpermut (tab, numero, tabperm);
+
+ for (kvar=1; kvar<=nvar; kvar++) {
+ provi = 0;
+ for (j=1; j<=nobs; j++) {
+ for (i=1; i<=nobs; i++) {
+ provi = provi + tabperm[i][kvar]*tabperm[j][kvar]*mat[i][j] ;
+ }
+ }
+ result[k] = provi;
+ k = k+1;
+ }
+ }
+
+ /* lib�ration m�moire locale */
+ freevec(poili);
+ freetab(mat);
+ freeintvec(numero);
+ freetab(tab);
+ freetab(tabperm);
+}
+
+
+ void VarianceDecompInOrthoBasis (int *param, double *z, double *matvp,
+ double *phylogram, double *phylo95,double *sig025, double *sig975,
+ double *R2Max, double *SkR2k, double*Dmax, double *SCE, double *ratio)
+{
+
+ /* param contient 4 entiers : nobs le nombre de points, npro le nombre de vecteurs
+ nrepet le nombre de permutations, posinega la nombre de vecteurs de la classe posi
+ qui est nul si cette notion n'existe pas. Exemple : la base Bscores d'une phylog�nie a posinega = 0
+ mais la base Ascores a posinega � prendre dans Adim
+ z est un vecteur � nobs composantes de norme 1
+ pour la pond�ration uniforme. matvp est une matrice nobsxnpro contenant en
+ colonnes des vecteurs orthonorm�s pour la pond�ration uniforme. En g�n�
+ La proc�dure placera
+ dans phylogram les R2 de la d�composition de z dans la base matvp
+ dans phylo95 les quantiles 0.95 des R2
+ dans sig025 les quantiles 0.025 des R2 cumul�s
+ dans sig975 les quantiles 0.975 des R2 cumul�s
+
+ Ecrit � l'origine pour les phylog�nies
+ peut servir pour une base de vecteurs propres de voisinage */
+
+
+ /* Declarations des variables C locales */
+ int nobs, npro, nrepet, i, j, k, n1, n2, n3, n4;
+ int irepet, posinega, *numero, *vecrepet;
+ double **vecpro, *zperm, *znorm;
+ double *locphylogram, *modelnul;
+ double a1, provi, **simul, *copivec, *copicol;
+
+ /* Allocation memoire pour les variables C locales */
+ nobs = param[0];
+ npro = param [1];
+ nrepet = param [2];
+ posinega = param[3];
+ vecalloc (&znorm, nobs);
+ vecalloc (&zperm, nobs);
+ vecalloc (&copivec, npro);
+ vecalloc (&copicol, nrepet);
+ taballoc (&vecpro, nobs, npro);
+ taballoc (&simul, nrepet, npro);
+ vecalloc (&locphylogram, npro);
+ vecalloc (&modelnul, npro);
+ vecintalloc (&numero, nobs);
+ vecintalloc (&vecrepet, nrepet);
+
+ /* D�finitions des variables C locales */
+ for (i = 1 ; i<= nobs; i++) znorm[i] = z[i-1];
+ for (i = 1 ; i<= npro; i++) modelnul[i] = (double) i/ (double) npro;
+ k = 0;
+ for (j=1; j<=npro; j++) {
+ for (i=1; i<=nobs; i++) {
+ vecpro[i][j] = matvp[k] ;
+ k = k+1 ;
+ }
+ }
+
+ /* calcul du phylogramme observ� */
+ for (j = 1; j<= npro; j++) {
+ provi = 0;
+ for (i=1; i<=nobs; i++) provi = provi + vecpro[i][j]*znorm[i];
+ provi = provi*provi/nobs/nobs;
+ locphylogram[j] = provi;
+ }
+ for (i =1 ; i<= npro ; i++) phylogram[i-1] = locphylogram[i];
+ /* calcul des simulations
+ Chaque ligne de simul est un phylogramme apr�s permutation des donn�es */
+
+ for (irepet=1; irepet<=nrepet; irepet++) {
+ getpermutation (numero, irepet);
+ vecpermut (znorm, numero, zperm);
+ provi = 0;
+ for (j = 1; j<= npro; j++) {
+ provi = 0;
+ for (i=1; i<=nobs; i++) provi = provi + vecpro[i][j]*zperm[i];
+ provi = provi*provi/nobs/nobs;
+ simul[irepet][j] = provi;
+ }
+ }
+ /* calcul du test sur le max du phylogramme */
+ for (irepet=1; irepet<=nrepet; irepet++) {
+ for (j=1; j<=npro; j++) copivec[j] = simul[irepet][j];
+ R2Max[irepet] = maxvec(copivec);
+ provi=0;
+ for (j=1; j<=npro; j++) provi = provi + j*simul[irepet][j];
+ SkR2k[irepet] =provi;
+ if (posinega>0) {
+ provi=0;
+ for (j=1; j<posinega; j++) provi = provi + simul[irepet][j];
+ ratio[irepet] = provi;
+ }
+
+ }
+ R2Max[0] = maxvec(locphylogram);
+ provi=0;
+ for (j=1; j<=npro; j++) provi = provi + j*locphylogram[j];
+ SkR2k[0] =provi;
+ if (posinega>0) {
+ provi=0;
+ for (j=1; j<posinega; j++) provi = provi + locphylogram[j];
+ ratio[0] = provi;
+ }
+ /* quantiles 95 du sup */
+ n1 = (int) floor (nrepet*0.95);
+ n2 = (int) ceil (nrepet*0.95);
+ for (i =1; i<=npro; i++) {
+ for (irepet = 1; irepet<= nrepet; irepet++) {
+ copicol[irepet] = simul [irepet][i];
+ }
+ trirap (copicol, vecrepet);
+ phylo95[i-1] = 0.5*(copicol[n1]+copicol[n2]);
+ }
+
+
+ for (irepet=1; irepet<=nrepet; irepet++) {
+ provi = 0;
+ for (j=1; j<=npro; j++) {
+ provi = provi + simul[irepet][j];
+ copivec[j] = provi;
+ }
+ for (j=1; j<=npro; j++) simul[irepet][j] = copivec[j];
+ }
+ n1 = (int) floor (nrepet*0.025);
+ n2 = (int) ceil (nrepet*0.025);
+ n3 = (int) floor (nrepet*0.975);
+ n4 = (int) ceil (nrepet*0.975);
+ /* quantiles 2.5 du cumul */
+ for (i =1; i<=npro; i++) {
+ for (irepet = 1; irepet<= nrepet; irepet++) {
+ copicol[irepet] = simul [irepet][i];
+ }
+ trirap (copicol, vecrepet);
+ sig025[i-1] = 0.5*(copicol[n1]+copicol[n2]);
+ sig975[i-1] = 0.5*(copicol[n3]+copicol[n4]);
+ }
+
+ provi = 0;
+ for (j=1; j<=npro; j++) {
+ a1 = modelnul[j];
+ provi = provi + locphylogram[j];
+ locphylogram[j] = provi-a1;
+ for (irepet = 1; irepet<= nrepet; irepet++) {
+ simul [irepet][j] = simul [irepet][j]-a1;
+ }
+ }
+ /* simul contient maintenant les cumul�s simul�s en �carts */
+ /* locphylogram contient maintenant les cumul�s observ�s en �cart*/
+ /* Dmax */
+ for (j=1; j<=npro; j++) {
+ for (irepet=1; irepet<=nrepet; irepet++) {
+ for (j=1; j<=npro; j++) copivec[j] = simul[irepet][j];
+ Dmax[irepet] = maxvec(copivec);
+ provi=0;
+ for (j=1; j<=npro; j++) provi = provi + copivec[j]* copivec[j];
+ SCE[irepet] =provi;
+ }
+ }
+ Dmax[0] = maxvec (locphylogram);
+ provi=0;
+ for (j=1; j<=npro; j++) provi = provi +locphylogram[j]*locphylogram[j];
+ SCE[0] =provi;
+
+
+
+
+
+ /* retour */
+
+ freevec (znorm);
+ freevec (modelnul);
+ freevec(copivec);
+ freevec(copicol);
+ freevec (zperm);
+ freetab (vecpro);
+ freetab (simul);
+ freevec (locphylogram);
+ freeintvec (numero);
+ freeintvec (vecrepet);
+ }
+
+void MVarianceDecompInOrthoBasis (int *param, double *z, int *nvar, double *inertot, double *matvp,
+ double *phylogram, double *phylo95,double *sig025, double *sig975,
+ double *R2Max, double *SkR2k, double*Dmax, double *SCE, double *ratio)
+{
+
+ /* param contient 4 entiers : nobs le nombre de points, npro le nombre de vecteurs
+ nrepet le nombre de permutations, posinega la nombre de vecteurs de la classe posi
+ qui est nul si cette notion n'existe pas. Exemple : la base Bscores d'une phylog�nie a posinega = 0
+ mais la base Ascores a posinega � prendre dans Adim
+ z est un vecteur � nobs composantes de norme 1
+ pour la pond�ration uniforme. matvp est une matrice nobsxnpro contenant en
+ colonnes des vecteurs orthonorm�s pour la pond�ration uniforme. En g�n�
+ La proc�dure placera
+ dans phylogram les R2 de la d�composition de z dans la base matvp
+ dans phylo95 les quantiles 0.95 des R2
+ dans sig025 les quantiles 0.025 des R2 cumul�s
+ dans sig975 les quantiles 0.975 des R2 cumul�s
+
+ Ecrit � l'origine pour les phylog�nies
+ peut servir pour une base de vecteurs propres de voisinage */
+
+
+ /* Declarations des variables C locales */
+ int nobs, npro, nrepet, i, j, k, n1, n2, n3, n4;
+ int irepet, posinega, *numero, *vecrepet;
+ double **vecpro, *zperm, **tabz;
+ double *locphylogram, *modelnul;
+ double a1, provi, **simul, *copivec, *copicol;
+
+ /* Allocation memoire pour les variables C locales */
+ nobs = param[0];
+ npro = param [1];
+ nrepet = param [2];
+ posinega = param[3];
+ vecalloc (&copivec, npro);
+ vecalloc (&copicol, nrepet);
+ taballoc (&vecpro, nobs, npro);
+ taballoc (&tabz, nobs, nvar[0]);
+ taballoc (&simul, nrepet, npro);
+ vecalloc (&locphylogram, npro);
+ vecalloc (&modelnul, npro);
+
+ vecintalloc (&vecrepet, nrepet);
+
+ /* D�finitions des variables C locales */
+
+ for (i = 1 ; i<= npro; i++) modelnul[i] = (double) i/ (double) npro;
+ k = 0;
+ for (j=1; j<=npro; j++) {
+ for (i=1; i<=nobs; i++) {
+ vecpro[i][j] = matvp[k] ;
+ k = k+1 ;
+ }
+ }
+ k = 0;
+ for (j=1; j<=nvar[0]; j++) {
+ for (i=1; i<=nobs; i++) {
+ tabz[i][j] = z[k] ;
+ k = k+1 ;
+ }
+ }
+
+ /* calcul du phylogramme observ� */
+
+
+ for(k=1;k<=nvar[0];k++){
+ for (j = 1; j<= npro; j++) {
+ provi = 0;
+ for (i=1; i<=nobs; i++) provi = provi + vecpro[i][j]*tabz[i][k];
+ provi = provi*provi/nobs/nobs;
+ locphylogram[j] = locphylogram[j] + provi/inertot[0];
+ }
+ }
+ for (i =1 ; i<= npro ; i++) phylogram[i-1] = locphylogram[i];
+ /* calcul des simulations
+ Chaque ligne de simul est un phylogramme apr�s permutation des donn�es */
+
+ for (irepet=1; irepet<=nrepet; irepet++) {
+ aleapermutmat(tabz);
+ provi = 0;
+ for(k=1;k<=nvar[0];k++){
+ for (j = 1; j<= npro; j++) {
+ provi = 0;
+ for (i=1; i<=nobs; i++) provi = provi + vecpro[i][j]*tabz[i][k];
+ provi = provi*provi/nobs/nobs;
+ simul[irepet][j] = simul[irepet][j]+provi/inertot[0];
+
+ }
+ }
+ }
+ /* calcul du test sur le max du phylogramme */
+ for (irepet=1; irepet<=nrepet; irepet++) {
+ for (j=1; j<=npro; j++) copivec[j] = simul[irepet][j];
+ R2Max[irepet] = maxvec(copivec);
+ provi=0;
+ for (j=1; j<=npro; j++) provi = provi + j*simul[irepet][j];
+ SkR2k[irepet] =provi;
+ if (posinega>0) {
+ provi=0;
+ for (j=1; j<posinega; j++) provi = provi + simul[irepet][j];
+ ratio[irepet] = provi;
+ }
+
+ }
+ R2Max[0] = maxvec(locphylogram);
+ provi=0;
+ for (j=1; j<=npro; j++) provi = provi + j*locphylogram[j];
+ SkR2k[0] =provi;
+ if (posinega>0) {
+ provi=0;
+ for (j=1; j<posinega; j++) provi = provi + locphylogram[j];
+ ratio[0] = provi;
+ }
+ /* quantiles 95 du sup */
+ n1 = (int) floor (nrepet*0.95);
+ n2 = (int) ceil (nrepet*0.95);
+ for (i =1; i<=npro; i++) {
+ for (irepet = 1; irepet<= nrepet; irepet++) {
+ copicol[irepet] = simul [irepet][i];
+ }
+ trirap (copicol, vecrepet);
+ phylo95[i-1] = 0.5*(copicol[n1]+copicol[n2]);
+ }
+
+
+ for (irepet=1; irepet<=nrepet; irepet++) {
+ provi = 0;
+ for (j=1; j<=npro; j++) {
+ provi = provi + simul[irepet][j];
+ copivec[j] = provi;
+ }
+ for (j=1; j<=npro; j++) simul[irepet][j] = copivec[j];
+ }
+ n1 = (int) floor (nrepet*0.025);
+ n2 = (int) ceil (nrepet*0.025);
+ n3 = (int) floor (nrepet*0.975);
+ n4 = (int) ceil (nrepet*0.975);
+ /* quantiles 2.5 du cumul */
+ for (i =1; i<=npro; i++) {
+ for (irepet = 1; irepet<= nrepet; irepet++) {
+ copicol[irepet] = simul [irepet][i];
+ }
+ trirap (copicol, vecrepet);
+ sig025[i-1] = 0.5*(copicol[n1]+copicol[n2]);
+ sig975[i-1] = 0.5*(copicol[n3]+copicol[n4]);
+ }
+
+ provi = 0;
+ for (j=1; j<=npro; j++) {
+ a1 = modelnul[j];
+ provi = provi + locphylogram[j];
+ locphylogram[j] = provi-a1;
+ for (irepet = 1; irepet<= nrepet; irepet++) {
+ simul [irepet][j] = simul [irepet][j]-a1;
+ }
+ }
+ /* simul contient maintenant les cumul�s simul�s en �carts */
+ /* locphylogram contient maintenant les cumul�s observ�s en �cart*/
+ /* Dmax */
+ for (j=1; j<=npro; j++) {
+ for (irepet=1; irepet<=nrepet; irepet++) {
+ for (j=1; j<=npro; j++) copivec[j] = simul[irepet][j];
+ Dmax[irepet] = maxvec(copivec);
+ provi=0;
+ for (j=1; j<=npro; j++) provi = provi + copivec[j]* copivec[j];
+ SCE[irepet] =provi;
+ }
+ }
+ Dmax[0] = maxvec (locphylogram);
+ provi=0;
+ for (j=1; j<=npro; j++) provi = provi +locphylogram[j]*locphylogram[j];
+ SCE[0] =provi;
+
+
+
+
+
+ /* retour */
+
+ freetab (tabz);
+ freevec (modelnul);
+ freevec(copivec);
+ freevec(copicol);
+
+ freetab (vecpro);
+ freetab (simul);
+ freevec (locphylogram);
+
+ freeintvec (vecrepet);
+ }
+
diff --git a/src/sptips.c b/src/sptips.c
new file mode 100644
index 0000000..e925a5a
--- /dev/null
+++ b/src/sptips.c
@@ -0,0 +1,482 @@
+/*
+ Coded by Thibaut Jombart (tjombart at imperial.ac.uk), March 2010.
+ Distributed with the adephylo package for the R software.
+ Licence: GPL >=2.
+
+ Notes:
+ these functions are used to find the shortest path between specified pairs of tips.
+ The algorithm proceeds as follows:
+ 1) find the paths (pathA, pathB) to the root
+ 2) find the MRCA, defined as the first term of pathA in pathB (same as the converse)
+ 3) from A, go back to MRCA, adding crossed nodes to the result, not including the MRCA
+ 4) from B, go back to MRCA, adding crossed nodes to the result, not including the MRCA
+ 5) add the MRCA to the output
+ 6) return the output
+*/
+
+
+#include <math.h>
+#include <time.h>
+#include <string.h>
+#include <stdlib.h>
+#include <R.h>
+#include <R_ext/Utils.h>
+#include "adesub.h"
+#include <R_ext/Print.h>
+
+
+
+
+/*
+ =============================
+ UTILITARY (INTERNAL) FUNCTIONS
+ =============================
+*/
+
+
+/*
+ === REPLICATE %IN% / MATCH OPERATOR FOR INTEGERS ===
+ == for internal use only ==
+ - *b has to be a vector created using vecintalloc
+ - returns 0 if there are no matches, and the index of the first match otherwise
+*/
+int intAinB(int a, int *b, int lengthB){
+ if(lengthB == 0) return(0); /* avoid comparison with empty vector */
+
+ int i=1;
+
+ /* printf("\n AinB debugging: a=%d", a); */
+ while(i <= lengthB){
+ /* printf("\t i=%d \t bi=%d ", a, b[i]); */
+
+ if(b[i]==a) {
+ return(i);
+ } else {
+ i++;
+ }
+ }
+
+ return(0);
+} /* intAinB */
+
+
+
+
+
+/*
+ === REPLICATE SETDIFF MATCH OPERATOR FOR INTEGERS ===
+ == for internal use only ==
+ - *b has to be a vector created using vecintalloc
+ - finds (possibly duplicated) elements of a not in b
+*/
+void intANotInB(int *a, int *b, int lengthA, int lengthB, int *res, int *resSize){
+ int i;
+
+ /* a few checks */
+ if(lengthA==0) return;
+ if(lengthB==0){
+ *resSize = 0;
+ return;
+ }
+
+ /* main code */
+ *resSize = 0;
+
+ for(i=1; i<=lengthA; i++){
+ if(intAinB(a[i], b, lengthB)==0){
+ *resSize = *resSize+1;
+ res[*resSize] = a[i];
+ }
+ }
+
+} /* intANotInB */
+
+
+
+
+
+
+/*
+ === UNION OF TWO INTEGER VECTORS ===
+ == for internal use only ==
+ - a, b, and res have to be created by vecintalloc
+ - returns unique(c(a,b))
+*/
+void unionInt(int *a, int *b, int lengthA, int lengthB, int *res, int *resSize){
+ if(lengthA==0 && lengthB && 0) {
+ *res = 0;
+ *resSize = 0;
+ return;
+ }
+
+ int i, idx;
+
+ res[1] = a[1]; /* initialization of temp results */
+ *resSize = 1;
+
+ /* For a */
+ for(i=1;i<=lengthA;i++){
+ idx = intAinB(a[i], res, *resSize); /* check if element is in res */
+ if(idx==0) {
+ *resSize = *resSize + 1;
+ res[*resSize] = a[i];
+ }
+ }
+
+ /* For b */
+ for(i=1;i<=lengthB;i++){
+ idx = intAinB(b[i], res, *resSize); /* check if element is in res */
+ if(idx==0) {
+ *resSize = *resSize + 1;
+ res[*resSize] = b[i];
+ }
+ }
+} /* unionInt */
+
+
+
+
+
+
+/*
+ === INTERSECTION OF TWO INTEGER VECTORS ===
+ == for internal use only ==
+ - a, b, and res have to be created by vecintalloc
+*/
+void intersectInt(int *a, int *b, int lengthA, int lengthB, int *res, int *resSize){
+ if((lengthA * lengthB) ==0) {
+ *res = 0;
+ *resSize = 0;
+ return;
+ }
+ int i, idx;
+
+ *resSize = 0;
+
+ /* store elements of a present in b */
+ for(i=1;i<=lengthA;i++){
+ idx = intAinB(a[i], b, lengthB) * intAinB(a[i], res, *resSize); /* a in b and not already in res */
+ if(idx != 0) {
+ *resSize = *resSize + 1;
+ res[*resSize] = a[i];
+ }
+ }
+} /* intersectInt */
+
+
+
+
+
+/*
+ === FIND THE PATH FROM A TIP TO THE ROOT ===
+ == for internal use only ==
+ - ances, desc and path must have been created using vecintalloc; their indices start at 1.
+ - N is the number of edges in the tree, i.e. number of rows of $edge
+*/
+void pathTipToRoot(int tip, int *ances, int *desc, int N, int *res, int *resSize){
+ int i, curNode=0, keepOn=1, nextNodeId;
+
+ curNode = tip;
+ *resSize = 0;
+
+ /* printf("\nInput inside pathTipTo...: \n"); */
+ /* for(i=1; i<= N;i++){ */
+ /* printf(" %d", res[i]); */
+ /* } */
+
+ while(keepOn==1){
+ nextNodeId = intAinB(curNode, desc, N);
+ /* printf("\n%d in desc: %d", curNode, nextNodeId); */
+
+ if(nextNodeId > 0){
+ *resSize = *resSize + 1;
+ curNode = ances[nextNodeId];
+ res[*resSize] = curNode;
+ } else {
+ keepOn = 0;
+ }
+ }
+
+ /* /\* debugging *\/ */
+ /* printf("\nOutput from pathTip... :"); */
+ /* printf("\nresSize: %d \n", *resSize); */
+
+ /* for(i=1; i<= *resSize;i++){ */
+ /* printf(" %d", res[i]); */
+ /* } */
+
+} /* pathTipToRoot */
+
+
+
+
+
+/*
+ === FIND THE MRCA BETWEEN TWO TIPS ===
+ == for internal use only ==
+ - a and b are two tips
+ - ances and desc must be created using vecintalloc
+ - N is the number of edges
+*/
+int mrca2tips(int *ances, int*desc, int a, int b, int N){
+ int i, res, idx;
+ int *pathAroot, *pathBroot, *lengthPathA, *lengthPathB;
+
+ /* allocate memory */
+ vecintalloc(&pathAroot, N);
+ vecintalloc(&pathBroot, N);
+ lengthPathA = (int *) calloc(1, sizeof(int));
+ lengthPathB = (int *) calloc(1, sizeof(int));
+
+ /* printf("\n N: %d", N); */
+ /* printf("\nEmpty res passed to pathTip...:\n"); */
+ /* for(i=1; i<= N;i++){ */
+ /* printf(" %d", pathAroot[i]); */
+ /* } */
+
+ /* find paths to the root */
+ pathTipToRoot(a, ances, desc, N, pathAroot, lengthPathA);
+ pathTipToRoot(b, ances, desc, N, pathBroot, lengthPathB);
+
+ /* debugging*/
+ /* printf("\n Information found within mrca2tips:\n"); */
+ /* printf("\nlengthPathA: %d \n", *lengthPathA); */
+ /* printf("\nlengthPathB: %d \n", *lengthPathB); */
+
+ /* printf("\nPath from %d to the root:\n", a); */
+ /* for(i=1; i<= *lengthPathA;i++){ */
+ /* printf(" %d", pathAroot[i]); */
+ /* } */
+
+ /* printf("\nPath from %d to the root\n", b); */
+ /* for(i=1; i<= *lengthPathB;i++){ */
+ /* printf(" %d", pathBroot[i]); */
+ /* } */
+
+ /* initialization */
+ i = 0;
+ idx = 0;
+
+ /* printf("\n - marker within mrca2tips - \n"); */
+ while(idx==0){
+ if(i == *lengthPathA){ /* that would indicate an error */
+ /* printf("\n Likely error: no MRCA found between specified tips."); */
+ /* free memory */
+ freeintvec(pathAroot);
+ freeintvec(pathBroot);
+ free(lengthPathA);
+ free(lengthPathB);
+ return(0);
+ }
+ i++;
+ idx = intAinB(pathAroot[i], pathBroot, *lengthPathB);
+ /* printf("\ni: %d idx: %d node: %d", i, idx, pathAroot[i]); */
+ }
+
+ /* store the result in a local variable */
+ res = pathBroot[idx];
+
+ /* free memory */
+ freeintvec(pathAroot);
+ freeintvec(pathBroot);
+ free(lengthPathA);
+ free(lengthPathB);
+
+ return(res);
+} /* end mrca */
+
+
+
+
+
+
+/*
+ === FIND SHORTEST PATH BETWEEN TWO TIPS ===
+ == for internal use only ==
+ - ances and desc must be created using vecintalloc
+ - N is the number of edges to represent the tree
+*/
+void sp2tips(int *ances, int *desc, int N, int tipA, int tipB, int *res, int *resSize){
+ /* declarations */
+ int *pathAroot, *pathBroot, *lengthPathA, *lengthPathB;
+ int k, myMrca;
+
+
+ /* allocate memory */
+ vecintalloc(&pathAroot, N);
+ vecintalloc(&pathBroot, N);
+ lengthPathA = (int *) calloc(1, sizeof(int));
+ lengthPathB = (int *) calloc(1, sizeof(int));
+
+
+ /* find paths to the root */
+ pathTipToRoot(tipA, ances, desc, N, pathAroot, lengthPathA);
+ pathTipToRoot(tipB, ances, desc, N, pathBroot, lengthPathB);
+
+ /* find the MRCA between both tips */
+ myMrca = mrca2tips(ances, desc, tipA, tipB, N);
+
+ /* go back the paths and stop at MRCA (exclude MRCA) */
+ /* for A */
+ k = 1;
+ *resSize = 0;
+ while(pathAroot[k] != myMrca){
+ *resSize = *resSize + 1;
+ res[*resSize] = pathAroot[k];
+ k++;
+ }
+
+ /* printf("\nsp step a:"); */
+ /* int i; */
+ /* for(i=1; i<=*resSize; i++){ */
+ /* printf(" %d", res[i]); */
+ /* } */
+
+ /* for B */
+ k = 1;
+ while(pathBroot[k] != myMrca){
+ *resSize = *resSize + 1;
+ res[*resSize] = pathBroot[k];
+ k++;
+ }
+
+
+ /* printf("\nsp step b:"); */
+ /* for(i=1; i<=*resSize; i++){ */
+ /* printf(" %d", res[i]); */
+ /* } */
+
+ /* add the MRCA */
+ *resSize = *resSize + 1;
+ res[*resSize] = myMrca;
+
+ /* printf("\nsp step mrca (%d):", myMrca); */
+ /* for(i=1; i<=*resSize; i++){ */
+ /* printf(" %d", res[i]); */
+ /* } */
+
+
+ /* free memory */
+ freeintvec(pathAroot);
+ freeintvec(pathBroot);
+ free(lengthPathA);
+ free(lengthPathB);
+
+} /* end sp2tips */
+
+
+
+
+
+
+
+
+
+/*
+ ==========================
+ MAIN (EXTERNAL) FUNCTION
+ ==========================
+*/
+
+
+
+/*
+ === FIND SHORTEST PATH BETWEEN ALL PAIRS OF TIPS ===
+ == for internal/external uses ==
+ - all arguments are passed from R
+ - N is the number of edges to represent the tree
+ - nTips is the total number of tips in the tree
+ - resSize is the total size of the output vector; it can't be known in advance, so a fake value has to be passed
+ - resId indicates how the final result should be cut
+*/
+void spalltips(int *ances, int *desc, int *N, int *nTips, int *res, int *resId, int *resSize){
+ /* declarations */
+ int i, j, k, m, idPair;
+ int *ancesLoc, *descLoc, *tempRes, *tempResSize; /* must use dynamic allocation */
+
+ /* allocate memory for local variables */
+ vecintalloc(&ancesLoc, *N);
+ vecintalloc(&descLoc, *N);
+ vecintalloc(&tempRes, *N);
+ tempResSize = (int *) calloc(1, sizeof(int));
+
+
+ /* create local vectors for ancestors and descendents */
+ ancesLoc[0] = *N;
+ descLoc[0] = *N;
+ for(i=0; i< *N; i++){
+ ancesLoc[i+1] = ances[i];
+ descLoc[i+1] = desc[i];
+ }
+
+
+ /* perform computations for all pairs of tips (indexed 'i,j') */
+ *tempResSize = 0;
+ *resSize = 0;
+ m = 0; /* used to browse 'res' and 'resId' */
+ idPair = 0;
+
+ /* printf("\ngot to 1"); */
+ /* debugging*/
+/* printf("\nancesLoc:\n");
+ for(i=1; i<= *N;i++){
+ printf(" %d", ancesLoc[i]);
+ }
+
+ printf("\ndesc:\n");
+ for(i=1; i<= *N;i++){
+ printf(" %d", descLoc[i]);
+ }
+
+ printf("\nN: %d", *N);
+*/
+ for(i=1; i<=(*nTips-1); i++){
+ for(j=(i+1); j<=(*nTips); j++){
+ /* temp results are save in tempRes and tempResSize */
+ idPair++;
+ sp2tips(ancesLoc, descLoc, *N, i, j, tempRes, tempResSize); /* i and j are tips id */
+
+ /* copy temp results to returned results */
+ *resSize = *resSize + *tempResSize;
+ for(k=1; k <= *tempResSize; k++){
+ res[m] = tempRes[k];
+ resId[m] = idPair;
+ m++;
+ }
+ }
+ }
+ /* printf("\ngot to 4"); */
+
+ /* free memory */
+ freeintvec(ancesLoc);
+ freeintvec(descLoc);
+ freeintvec(tempRes);
+ free(tempResSize);
+
+} /* end sptips */
+
+
+
+
+/* TESTING */
+/*
+
+library(adephylo)
+tre=rtree(10)
+plot(tre)
+nodelabels()
+tiplabels()
+
+res <- resId <- integer(1e5)
+resSize=as.integer(1e5)
+
+# void spalltips(int *ances, int *desc, int *N, int *nTips, int *res, int *resId, int *resSize){
+
+toto <- .C("spalltips", as.integer(tre$edge[,1]), as.integer(tre$edge[,2]), nrow(tre$edge), as.integer(nTips(tre)), res, resId, resSize)
+toto[[5]] <- toto[[5]][1:toto[[7]]]
+toto[[6]] <- toto[[6]][1:toto[[7]]]
+
+res <- split(toto[[5]], toto[[6]])
+res
+
+*/
diff --git a/src/sptips.h b/src/sptips.h
new file mode 100644
index 0000000..6294974
--- /dev/null
+++ b/src/sptips.h
@@ -0,0 +1,17 @@
+#include <math.h>
+#include <time.h>
+#include <string.h>
+#include <stdlib.h>
+#include <R.h>
+#include <R_ext/Utils.h>
+#include "adesub.h"
+
+
+int intAinB(int a, int *b, int lengthB);
+void intANotInB(int *a, int *b, int lengthA, int lengthB, int *res, int *resSize);
+void unionInt(int *a, int *b, int lengthA, int lengthB, int *res, int *resSize);
+void intersectInt(int *a, int *b, int lengthA, int lengthB, int *res, int *resSize);
+void pathTipToRoot(int tip, int *ances, int *desc, int N, int *res, int *resSize);
+int mrca2tips(int *ances, int*desc, int a, int b, int N);
+void sp2tips(int *ances, int *desc, int N, int tipA, int tipB, int *res, int *resSize);
+void spalltips(int *ances, int *desc, int *N, int *nTips, int *res, int *resId, int *resSize);
diff --git a/vignettes/adephylo.Rnw b/vignettes/adephylo.Rnw
new file mode 100644
index 0000000..7e3a8bc
--- /dev/null
+++ b/vignettes/adephylo.Rnw
@@ -0,0 +1,665 @@
+\documentclass{article}
+% \VignettePackage{adephylo}
+% \VignetteIndexEntry{adephylo: exploratory analyses for the phylogenetic comparative method}
+
+\usepackage{graphicx}
+\usepackage[colorlinks=true,urlcolor=blue]{hyperref}
+\usepackage{array}
+\usepackage{color}
+
+\usepackage[utf8]{inputenc} % for UTF-8/single quotes from sQuote()
+\newcommand{\code}[1]{{{\tt #1}}}
+\title{\code{adephylo}: exploratory analyses for the phylogenetic comparative method}
+\author{Thibaut Jombart and St\'ephane Dray}
+\date{\today}
+
+
+
+
+\sloppy
+\hyphenpenalty 10000
+
+
+\begin{document}
+
+
+
+\definecolor{Soutput}{rgb}{0,0,0.56}
+\definecolor{Sinput}{rgb}{0.56,0,0}
+\DefineVerbatimEnvironment{Sinput}{Verbatim}
+{formatcom={\color{Sinput}},fontsize=\footnotesize, baselinestretch=0.75}
+\DefineVerbatimEnvironment{Soutput}{Verbatim}
+{formatcom={\color{Soutput}},fontsize=\footnotesize, baselinestretch=0.75}
+
+\color{black}
+
+\maketitle
+\tableofcontents
+
+
+
+%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%
+\section{Introduction}
+%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%
+
+\SweaveOpts{prefix.string = figs/adephylo, fig = FALSE, eps = FALSE, pdf = TRUE, width = 6, height = 6}
+
+
+This document describes the \code{adephylo} package for the R software.
+\code{adephylo} aims at implementing exploratory methods for the
+analysis of phylogenetic comparative data, i.e. biological traits measured for
+taxa whose phylogeny is also provided.
+This package extends and replaces implementation of phylogeny-related
+methods in the ade4 package \url{http://pbil.univ-lyon1.fr/ADE-4/home.php?lang=eng}.
+
+Procedures implemented in \code{adephylo} rely on exploratory data analysis. They include data
+visualization and manipulation, tests for phylogenetic autocorrelation, multivariate analysis,
+computation of phylogenetic proximities and distances, and modelling phylogenetic signal using
+orthonormal bases. \\
+
+These methods can be used to visualize, test, remove or investigate the phylogenetic signal in
+comparative data. The purpose of this document is to provide a general view of the main
+functionalities of \code{adephylo}, and to show how this package can be used along with \code{ape},
+\code{phylobase} and \code{ade4} to analyse comparative data.
+
+
+
+
+
+
+%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%
+\section{First steps}
+%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%
+
+
+
+%%%%%%%%%%%%%%%%%%%%%
+\subsection{Data representation: why we are not reinventing the weel}
+%%%%%%%%%%%%%%%%%%%%%
+
+Data representation can be defined as the way data are stored in a software
+(R, in our case). Technically, data representation is defined by classes of objects that contain
+the information. In the case of phylogeny and comparative data, very efficient data representation
+are already defined in other packages. Hence, it makes much more sense to use directly objects from
+these classes. \\
+
+
+Phylogenies are best represented in Emmanuel Paradis's \code{ape} package
+(\url{http://ape.mpl.ird.fr/}), as the class \code{phylo}. As \code{ape} is by far the largest
+package dedicated to phylogeny, using the \code{phylo} class assures a good interoperability of
+data. This class is defined in an online document:
+\url{http://ape.mpl.ird.fr/misc/FormatTreeR_28July2008.pdf}. \\
+
+However, data that are to be analyzed in \code{adephylo} do not only contain trees, but also traits
+associated to the tips of a tree. The package \code{phylobase}
+(\url{http://r-forge.r-project.org/projects/phylobase/}) is a collaborative effort designed to
+handling such data. Its representation of phylogenies slightly differs from that of \code{ape}; the
+class \code{phylo4} was originally an extension of the \code{phylo} class into formal (S4) class, but it
+has now evolved into something more original. The S4 class \code{phylo4d} (`d' for `data') can be used to store a
+tree and data associated to tips, internal nodes, or even edges of a tree. Classes of
+\code{phylobase} are described in a vignette of the package, accessible by typing:
+<<eval=FALSE>>=
+vignette("phylobase")
+@
+
+~\\ As trees and comparative data are already handled by \code{ape} and \code{phylobase}, no
+particular data format shall be defined in \code{adephylo}. In particular, we are no longer using
+\code{phylog} objects, which were used to represent phylogenies in \code{ade4} in a very \textit{ad
+ hoc} way, without much compatibility with other packages. This class is now deprecated, but all
+previous functionalities available for \code{phylog} objects have been re-implemented and -- in some
+cases -- improved in \code{adephylo}.
+
+
+
+
+
+%%%%%%%%%%%%%%%%%%%%%
+\subsection{Installing the package}
+%%%%%%%%%%%%%%%%%%%%%
+
+What is tricky here is that a vignette is basically available once the package
+is installed. Assuming you got this document before installing the package, here are some clues
+about installing \code{adephylo}. \\
+
+First of all, \code{adephylo} depends on other packages, being \code{methods}, \code{ape},
+\code{phylobase}, and \code{ade4}. These dependencies are mandatory, that is, you actually need to
+have these packages installed before using \code{adephylo}. Also, it is better to make sure you are
+using the latest versions of these packages. This can be achieved using
+the \texttt{update.packages} command, or by installing devel versions from R-Forge
+(\url{http://r-forge.r-project.org/}). In all cases, the latest version of \code{adephylo} can be
+found from \url{http://r-forge.r-project.org/R/?group_id=303}. \\
+
+We load \textit{adephylo}, alongside some useful packages:
+<<load>>=
+library(ape)
+library(phylobase)
+library(ade4)
+library(adephylo)
+search()
+@
+
+Note that possibly conflicting, deprecated functions or datasets from \code{ade4} are masked by
+\code{adephylo}. In case the converse would occur (i.e. deprecated function masking a function of
+\code{adephylo}), one can refer to the `good' version of a function by adding the prefix
+\code{adephylo::} to the function. Hence, it is possible to coerce the version of a masked
+function, using a kludge like:
+<<kludge>>=
+cat("\n=== Old - deprecated- version ===\n")
+orthogram <- ade4::orthogram
+args(orthogram)
+cat("\n=== New version === \n")
+orthogram <- adephylo::orthogram
+args(orthogram)
+@
+
+Luckily, this should not be required as long as one is not playing
+with loading and unloading \code{ade4} once \code{adephylo} is loaded.
+
+
+%%%%%%%%%%%%%%%%%%%%%
+\subsection{Getting started}
+%%%%%%%%%%%%%%%%%%%%%
+All the material of the package is summarized in a manpage accessible
+by typing:
+<<eval=FALSE>>=
+?adephylo
+@
+
+The html version of this manpage may be preferred to browse easily the content
+of \code{adephylo}; this is accessible by typing:
+<<eval=FALSE>>=
+help("adephylo", package="adephylo", html=TRUE)
+@
+
+To revert help back to text mode, simply type:
+<<eval=FALSE>>=
+options(htmlhelp = FALSE)
+@
+
+
+
+
+
+%%%%%%%%%%%%%%%%%%%%%
+\subsection{Putting data into shape}
+%%%%%%%%%%%%%%%%%%%%%
+
+While this is not the purpose of this document to go through the details of
+\code{phylo}, \code{phylo4} and \code{phylo4d} objects, we shall show briefly how these objects can
+be obtained.
+
+
+% % % % % % % % % % %
+\subsubsection{Making a \code{phylo} object}
+% % % % % % % % % % %
+The simplest way of turning a tree into a \code{phylo} object is using
+ape's function \code{read.tree}.
+This function reads a tree with the Newick (or `parentetic') format,
+from a file (default, argument \code{file}) of from a character string
+(argument \code{text}).
+<<readTree, plot=TRUE>>=
+data(ungulates)
+ungulates$tre
+myTree <- read.tree(text=ungulates$tre)
+myTree
+plot(myTree, main="ape's plotting of a tree")
+@
+
+
+It is easy to convert \code{ade4}'s \code{phylog} objects to a
+\code{phylo}, as \code{phylog} objects store the Newick format of the
+tree in the \code{\$tre} component.
+\\
+
+Note that \code{phylo} trees can also be constructed from alignements
+(see \code{read.GenBank}, \code{read.dna},
+\code{dist.dna}, \code{nj}, \code{bionj}, and \code{mlphylo}, all in
+\code{ape}), or even simulated (for instance, see \code{rtree}).
+\\
+
+Also note that, if needed, conversion can be done back and forward
+with \code{phylo4} trees:
+<<>>=
+temp <- as(myTree, "phylo4")
+class(temp)
+temp <- as(temp, "phylo")
+class(temp)
+all.equal(temp, myTree)
+@
+
+
+
+
+
+% % % % % % % % % % %
+\subsubsection{Making a \code{phylo4d} object}
+% % % % % % % % % % %
+
+\code{phylo4d} objects are S4 objects, and are thus created in a particular
+way. These objects can be obtained in two ways, by reading a Nexus file containing tree and data
+information, or by `assembling' a tree and data provided for tips, nodes, or edges.
+
+Nexus files containing both tree and data can be read by \code{phylobase}'s function
+\code{readNexus} (see corresponding manpage for more information).
+The other way of creating a \code{phylo4d} object is using the
+constructor, also named \code{phylo4d}. This is a function that takes two arguments: a tree
+(\code{phylo} or \code{phylo4} format) and a \code{data.frame} containing data, for tips by default (see
+\code{?phylo4d} for more information). Here is an example:
+<<phylo4d, fig=TRUE>>=
+ung <- phylo4d(myTree, ungulates$tab)
+class(ung)
+table.phylo4d(ung)
+@
+
+%% \noindent Note that the constructor checks the consistency of the
+%% names used for the tips of the tree and for the rows of the data.frame.
+%% Inconsistencies issue an error.
+%% To override this behaviour, one can specify
+%% \code{use.tip.names=FALSE}.
+%% However, this can be tricky: often, mismatches between names can
+%% indicate that data are not sorted adequately; moreover, object created
+%% with such mismatches will often be invalid objects, and may issue
+%% errors in further analyses.
+%% \\
+
+Data are stored inside the \code{@data} slot of the object.
+They can be accessed using the function \code{tdata}:
+<<>>=
+x <- tdata(ung, type="tip")
+head(x)
+@
+
+
+
+
+
+
+%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%
+\section{Exploratory data analysis}
+%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%
+
+
+
+
+%%%%%%%%%%%%%%%%%%%%%
+\subsection{Quantifying and testing phylogenetic signal}
+%%%%%%%%%%%%%%%%%%%%%
+
+In this document, the terms `phylogenetic signal' and `phylogenetic autocorrelation' are used
+interchangeably. They refer to the fact that values of life-history traits or ecological features
+are not independent in closely related taxa. Several procedures are implemented by \code{adephylo}
+to measure and test phylogenetic autocorrelation.
+
+
+% % % % % % % % % % %
+\subsubsection{Moran's $I$}
+% % % % % % % % % % %
+
+The function \code{moran.idx} computes Moran's $I$, the most widely-used autocorrelation measure.
+It can also provide additionnal information (argument \code{addInfo}), being the null value of $I$
+(i.e., the expected value in absence of phylogenetic autocorrelation), and the range of variation of
+$I$. It requires the degree of relatedness of tips on the phylogeny to be modelled by a matrix of
+phylogenetic proximities. Such a matrix can be obtained using different methods implemented by the
+function \code{proxTips}.
+
+<<moranI>>=
+W <- proxTips(myTree, met="Abouheif")
+moran.idx(tdata(ung, type="tip")$afbw, W)
+moran.idx(tdata(ung, type="tip")[,1], W, addInfo=TRUE)
+@
+
+From here, it is quite straightforward to build a non-parametric test
+based on Moran's $I$.
+For instance (taken from \code{?moran.idx}):
+<<fig=TRUE>>=
+afbw <- tdata(ung, type="tip")$afbw
+sim <- replicate(499, moran.idx(sample(afbw), W)) # permutations
+sim <- c(moran.idx(afbw, W), sim)
+
+cat("\n=== p-value (right-tail) === \n")
+pval <- mean(sim>=sim[1])
+pval
+
+plot(density(sim), main="Moran's I Monte Carlo test for 'bif'") # plot
+mtext("Density of permutations, and observation (in red)")
+abline(v=sim[1], col="red", lwd=3)
+
+@
+
+\noindent Here, \code{afbw} is likely not phylogenetically autocorrelated.
+
+
+
+
+
+% % % % % % % % % % %
+\subsubsection{Abouheif's test}
+% % % % % % % % % % %
+
+The test of Abouheif (see reference in \code{?abouheif.moran}) is
+designed to test the existence of phylogenetic signal.
+In fact, it has been shown that this test amounts to a Moran's $I$
+test with a particular proximity matrix (again, see references in the manpage).
+The implementation in \code{abouheif.moran} proposes different phylogenetic proximities,
+using by default the original one.
+
+The function can be used on different objects; in particular, it can
+be used with a \code{phylo4d} object.
+In such case, all traits inside the object are tested.
+The returned object is a \code{krandtest}, a class of object defined
+by \code{ade4} to store multiple Monte Carlo tests.
+Here is an example using the ungulates dataset:
+<<abouheif, plot=TRUE>>=
+ung.abTests <- abouheif.moran(ung)
+ung.abTests
+plot(ung.abTests)
+@
+
+\noindent In this case, it seems that all variables but \code{afbm} are
+phylogenetically structured.
+\\
+
+Note that other proximities than those proposed in
+\code{abouheif.moran} can be used: on has just to pass the appropriate
+proximity matrix to the function (argument \code{W}).
+For instance, we would like to use the correlation corresponding to a
+Brownian motion as a measure of phylogenetic proximity.
+
+First, we must estimate branch lengths, as our tree does
+not have any (ideally, we would already have a tree with meaningful branch lengths):
+<<>>=
+hasEdgeLength(ung)
+myTree.withBrLe <- compute.brlen(myTree)
+@
+
+\noindent Now, we can use ape's function \code{vcv.phylo} to compute
+the matrix of phylogenetic proximities, and use this matrix in
+Abouheif's test:
+<<>>=
+myProx <- vcv.phylo(myTree.withBrLe)
+abouheif.moran(ung, W=myProx)
+@
+
+\noindent In the present case, traits no longer appear as phylogenetically autocorrelated. Several
+explanation can be proposed: the procedure for estimating branch length may not be appropriate in
+this case, or the Brownian motion may fail to describe the evolution of the traits under study for
+this set of taxa.
+
+
+
+
+% % % % % % % % % % %
+\subsubsection{Phylogenetic decomposition of trait variation}
+% % % % % % % % % % %
+The phylogenetic decomposition of the variation of a trait proposed by Ollier
+et al. (2005, see references in \code{?orthogram}) is implemented by
+the function \code{orthogram}.
+This function replaces the former, deprecated version from \code{ade4}.
+\\
+
+The idea behind the method is to model different levels of variation
+on a phylogeny.
+Basically, these levels can be obtained from dummy vectors indicating
+which tip descends from a given node.
+A partition of tips can then be obtained for each node.
+This job is achieved by the function \code{treePart}.
+Here is an example using a small simulated tree:
+<<fig=TRUE>>=
+x <- as(rtree(5),"phylo4")
+plot(x,show.n=TRUE)
+@
+
+<<>>=
+x.part <- treePart(x)
+x.part
+@
+\noindent The obtained partition can also be plotted:
+<<fig=TRUE>>=
+temp <- phylo4d(x, x.part)
+table.phylo4d(temp, cent=FALSE, scale=FALSE)
+@
+
+\noindent What we would like to do is assess where the variation of a trait is structured on the
+phylogeny; to do so, we could use these dummy vectors as regressors and see how variation is
+distributed among these vectors. However, these dummy vectors cannot be used as regressors because
+they are linearly dependent. The orthogram circumvents this issue by transforming and selecting
+dummy vectors into a new set of variables that are orthonormal. The obtained orthonormal basis can
+be used to decompose the variation of the trait. Even if not necessary to get an orthogram, this basis
+can be obtained from \code{treePart}:
+<<>>=
+args(treePart)
+temp <- phylo4d(x, treePart(x, result="orthobasis") )
+@
+
+\noindent And here are the first 8 vectors of the orthonormal basis
+for the ungulate dataset:
+<<orthobas1, fig=TRUE>>=
+temp <- phylo4d(myTree, treePart(myTree, result="orthobasis") )
+par(mar=rep(.1,4))
+table.phylo4d(temp, repVar=1:8, ratio.tree=.3)
+@
+
+The decomposition of variance achieved by projecting a trait onto this
+orthonormal basis gives rise to several test statistics, that are
+performed by the function \code{orthogram}.
+Like the \code{abouheif.moran} function, \code{orthogram} outputs a
+\code{krandtest} object:
+<<orthogram, plot=TRUE>>=
+afbw.ortgTest <- orthogram(afbw, myTree)
+afbw.ortgTest
+@
+
+\noindent Here again, \code{afbw} does not seem to be phylogenetically structured.
+
+
+
+
+
+%%%%%%%%%%%%%%%%%%%%%
+\subsection{Modelling phylogenetic signal}
+%%%%%%%%%%%%%%%%%%%%%
+
+% % % % % % % % % % %
+\subsubsection{Using orthonormal bases}
+% % % % % % % % % % %
+
+The previous section describing the orthogram has shown that testing phylogenetic signal underlies a
+model of phylogenetic structure. In the case of the orthogram, several tests are based on the
+decomposition of the variance of a trait onto an orthonormal basis describing tree topology. In
+fact, it is possible to extend this principle to any orthonormal basis modelling phylogenetic
+topology. Another example of such bases is offered by Moran's eigenvectors, which can be used to
+model different observable phylogenetic structures (see references in \code{me.phylo}).
+
+Moran's phylogenetic eigenvectors are implemented by the function \code{me.phylo} (also nicknamed
+\code{orthobasis.phylo}). The returned object is a data.frame with the class \code{orthobasis}
+defined in \code{ade4}; columns of this object are Moran's eigenvectors. An \code{orthobasis} can
+be coerced to a regular \code{data.frame} or to a matrix using \code{as.data.frame} and \code{as.matrix}.
+<<>>=
+me.phylo(myTree.withBrLe)
+@
+
+\noindent Moran's eigenvectors are constructed from a matrix of
+phylogenetic proximities between tips.
+Any proximity can be used (argument \code{prox}); the 5 proximities
+implemented by the \code{proxTips} function are available by default, giving rise
+to different orthobases:
+<<figFourBas, fig=TRUE,include=FALSE, print=FALSE>>=
+ung.listBas <- list()
+ung.listBas[[1]] <- phylo4d(myTree, as.data.frame(me.phylo(myTree.withBrLe, method="patristic")))
+ung.listBas[[2]] <- phylo4d(myTree, as.data.frame(me.phylo(myTree, method="nNodes")))
+ung.listBas[[3]]<- phylo4d(myTree, as.data.frame(me.phylo(myTree, method="Abouheif")))
+ung.listBas[[4]] <- phylo4d(myTree, as.data.frame(me.phylo(myTree, method="sumDD")))
+par(mar=rep(.1,4), mfrow=c(2,2))
+invisible(lapply(ung.listBas, table.phylo4d, repVar=1:5, cex.sym=.7, show.tip.label=FALSE, show.node=FALSE))
+@
+
+\includegraphics[width=.8\textwidth]{figs/adephylo-figFourBas}
+
+\noindent In this case, the first Moran's eigenvectors are essentially similar. In other cases,
+however, the orthobases built from different proximities can be quite different. \\
+
+One of the interests of Moran's eigenvectors in phylogeny is to account for phylogenetic
+autocorrelation in a linear model. This can be achieved using the appropriate eigenvector as
+covariate. Here is an example when studying the link of two traits in ungulate dataset.
+<<lm1, fig=TRUE>>=
+afbw <- log(ungulates$tab[,1])
+neonatw <- log((ungulates$tab[,2]+ungulates$tab[,3])/2)
+names(afbw) <- myTree$tip.label
+names(neonatw) <- myTree$tip.label
+plot(afbw, neonatw, main="Relationship between afbw and neonatw")
+lm1 <- lm(neonatw~afbw)
+abline(lm1, col="blue")
+anova(lm1)
+@
+
+\noindent Are the residuals of this model independent?
+<<resid, fig=TRUE>>=
+resid <- residuals(lm1)
+names(resid) <- myTree$tip.label
+temp <- phylo4d(myTree,data.frame(resid))
+abouheif.moran(temp)
+table.phylo4d(temp)
+@
+
+\noindent No, residuals are clearly not independent, as they exhibit
+strong phylogenetic autocorrelation.
+In this case, autocorrelation can be removed by using the first
+Moran's eigenvector as a covariate.
+In general, the appropriate eigenvector(s) can be chosen by usual
+variable-selection approaches, like the forward selection, or using a
+selection based on the existence of autocorrelation in the residuals.
+<<>>=
+myBasis <- me.phylo(myTree, method="Abouheif")
+lm2 <- lm(neonatw~myBasis[,1] + afbw)
+resid <- residuals(lm2)
+names(resid) <- myTree$tip.label
+temp <- phylo4d(myTree,data.frame(resid))
+abouheif.moran(temp)
+anova(lm2)
+@
+
+The link between the two variables is still very statistically
+significant, but this time the model is not invalid because of
+non-independence of residuals.
+
+
+
+
+% % % % % % % % % % %
+\subsubsection{Autoregressive models}
+% % % % % % % % % % %
+Autoregressive models can also be used to remove phylogenetic
+autocorrelation from residuals.
+This approach implies the use of a phylogenetically lagged vector, for
+some or all of the variates of a model (see references in \code{?proxTips}).
+The lag vector of a trait $x$, denoted $\tilde{x}$, is computed as:
+$$
+\tilde{x} = Wx
+$$
+\noindent where $W$ is a matrix of phylogenetic proximities, as
+returned by \code{proxTips}.
+Hence, one can use an autoregressive approach to remove phylogenetic
+autocorrelation quite simply.
+We here re-use the example from the previous section:
+<<>>=
+W <- proxTips(myTree, method="Abouheif", sym=FALSE)
+lagNeonatw <- W %*% neonatw
+lm3 <- lm(neonatw ~ lagNeonatw + afbw)
+resid <- residuals(lm3)
+abouheif.moran(resid,W)
+@
+
+\noindent Here, this most simple autoregressive model may not be
+sufficient to account for all phylogenetic signal; yet, phylogenetic
+autocorrelation is no longer detected at the usual threshold
+$\alpha=0.05$.
+
+
+
+
+
+
+%%%%%%%%%%%%%%%%%%%%%
+\subsection{Using multivariate analyses}
+%%%%%%%%%%%%%%%%%%%%%
+
+Multivariate analyses can be used to identify the main biodemographic strategies in a large set of
+traits. This could be the topic of an entire book. Such application is not particular to
+\code{adephylo}, but some practices are made easier by the package, used together with \code{ade4}.
+We here provide a simple example, using the \code{maples} dataset. This dataset contains a tree and
+a set of 31 quantitative traits (see \code{?maples}).
+
+First of all, we seek a summary of the variability in traits using a principal component analysis.
+Missing data are replaced by mean values, so they are placed at the origin of the axes (the
+`non-informative' point).
+<<pca1, fig=TRUE>>=
+f1 <- function(x){
+ m <- mean(x,na.rm=TRUE)
+ x[is.na(x)] <- m
+ return(x)
+}
+
+data(maples)
+traits <- apply(maples$tab, 2, f1)
+pca1 <- dudi.pca(traits, scannf=FALSE, nf=1)
+barplot(pca1$eig, main="PCA eigenvalues", col=heat.colors(16))
+@
+
+\noindent One axis shall be retained. Does this axis reflect a phylogenetic structure? We can
+represent this principal component onto the phylogeny. In some cases, positive autocorrelation can
+be better perceived by examining the lag vector (see previous section on autoregressive models)
+instead of the original vector. Here, we shall plot both the retained principal component, and its
+lag vector:
+<<pca2, fig=TRUE>>=
+tre <- read.tree(text=maples$tre)
+W <- proxTips(tre)
+myComp <- data.frame(PC1=pca1$li[,1], lagPC1=W %*% pca1$li[,1])
+myComp.4d <- phylo4d(tre, myComp)
+nodeLabels(myComp.4d) <- names(nodeLabels(myComp.4d))
+table.phylo4d(myComp.4d)
+@
+
+\noindent It is quite clear that the main component of diversity among taxa separates descendants
+from node 19 from descendants of node 24. Phylogenetic autocorrelation can be checked in `PC1'
+(note that testing it in the lag vector would be circulary, as the lag vector already otimizes
+positive autocorrelation), for instance using Abouheif's test:
+<<aboutest, fig=TRUE>>=
+myTest <- abouheif.moran(myComp[,1], W=W)
+plot(myTest, main="Abouheif's test using patristic proximity")
+mtext("First principal component - maples data", col="blue", line=1)
+@
+
+\noindent To dig further into the interpretation of this structure,
+one can have a look at the loadings of the traits, to see to which
+biological traits these opposed life histories correspond:
+<<loadings, fig=TRUE>>=
+ldgs <- pca1$c1[,1]
+plot(ldgs, type="h", xlab="Variable", xaxt="n", ylab="Loadings")
+s.label(cbind(1:31, ldgs), lab=colnames(traits), add.p=TRUE, clab=.8)
+temp <- abs(ldgs)
+thres <- quantile(temp, .75)
+abline(h=thres * c(-1,1), lty=2, col="blue3", lwd=3)
+title("Loadings for PC1")
+mtext("Quarter of most contributing variables indicated in blue", col="blue")
+@
+
+\noindent As a reminder, species with a large black symbol would be on
+the top of this graph, while species with a large white symbol would
+lie on the bottom.
+
+
+
+%%%%%%%%%%%%%%%%%%%%%
+%\subsection{Performing a phylogenetic Principal Component Analysis}
+%%%%%%%%%%%%%%%%%%%%%
+
+
+
+
+\end{document}
diff --git a/vignettes/figs/adephylo-012.pdf b/vignettes/figs/adephylo-012.pdf
new file mode 100644
index 0000000..72ae87e
Binary files /dev/null and b/vignettes/figs/adephylo-012.pdf differ
diff --git a/vignettes/figs/adephylo-012.png b/vignettes/figs/adephylo-012.png
new file mode 100644
index 0000000..a47e037
Binary files /dev/null and b/vignettes/figs/adephylo-012.png differ
diff --git a/vignettes/figs/adephylo-016.pdf b/vignettes/figs/adephylo-016.pdf
new file mode 100644
index 0000000..b9801ee
Binary files /dev/null and b/vignettes/figs/adephylo-016.pdf differ
diff --git a/vignettes/figs/adephylo-017.pdf b/vignettes/figs/adephylo-017.pdf
new file mode 100644
index 0000000..64d979f
--- /dev/null
+++ b/vignettes/figs/adephylo-017.pdf
@@ -0,0 +1,293 @@
+%PDF-1.4
+%���ρ�\r
+1 0 obj
+<<
+/CreationDate (D:20081217172540)
+/ModDate (D:20081217172540)
+/Title (R Graphics Output)
+/Producer (R 2.8.0)
+/Creator (R)
+>>
+endobj
+2 0 obj
+<<
+/Type /Catalog
+/Pages 3 0 R
+>>
+endobj
+5 0 obj
+<<
+/Type /Page
+/Parent 3 0 R
+/Contents 6 0 R
+/Resources 4 0 R
+>>
+endobj
+6 0 obj
+<<
+/Length 7 0 R
+>>
+stream
+q
+Q q
+Q q 59.04 101.82 114.24 256.17 re W n
+0.000 0.000 0.000 RG
+0.75 w
+[] 0 d
+1 J
+1 j
+10.00 M
+63.27 140.96 m 63.27 274.37 l S
+134.75 111.31 m 134.75 170.60 l S
+70.23 229.90 m 70.23 318.85 l S
+119.32 289.20 m 119.32 348.50 l S
+134.75 111.31 m 169.05 111.31 l S
+134.75 170.60 m 169.05 170.60 l S
+70.23 229.90 m 169.05 229.90 l S
+119.32 289.20 m 169.05 289.20 l S
+119.32 348.50 m 169.05 348.50 l S
+63.27 140.96 m 134.75 140.96 l S
+63.27 274.37 m 70.23 274.37 l S
+70.23 318.85 m 119.32 318.85 l S
+BT
+0.000 0.000 0.000 rg
+/F4 1 Tf 12.00 0.00 -0.00 12.00 63.27 203.36 Tm (N1) Tj
+ET
+BT
+/F4 1 Tf 12.00 0.00 -0.00 12.00 134.75 136.65 Tm (N2) Tj
+ET
+BT
+/F4 1 Tf 12.00 0.00 -0.00 12.00 70.23 270.18 Tm (N3) Tj
+ET
+BT
+/F4 1 Tf 12.00 0.00 -0.00 12.00 119.32 314.54 Tm (N4) Tj
+ET
+Q q
+0.000 0.000 0.000 RG
+0.75 w
+[] 0 d
+1 J
+1 j
+10.00 M
+59.04 73.44 m
+401.76 73.44 l
+401.76 372.96 l
+59.04 372.96 l
+59.04 73.44 l
+S
+Q q 59.04 73.44 342.72 299.52 re W n
+0.745 0.745 0.745 RG
+0.75 w
+[] 0 d
+1 J
+1 j
+10.00 M
+183.45 111.31 m 183.45 348.50 l S
+273.20 111.31 m 273.20 348.50 l S
+362.95 111.31 m 362.95 348.50 l S
+183.45 111.31 m 183.45 348.50 l S
+273.20 111.31 m 273.20 348.50 l S
+183.45 111.31 m 362.95 111.31 l S
+183.45 170.60 m 362.95 170.60 l S
+183.45 229.90 m 362.95 229.90 l S
+183.45 289.20 m 362.95 289.20 l S
+183.45 348.50 m 362.95 348.50 l S
+0.000 0.000 0.000 rg
+1.000 1.000 1.000 RG
+ 169.05 111.31 m
+ 169.05 119.23 175.53 125.71 183.45 125.71 c
+ 191.37 125.71 197.85 119.23 197.85 111.31 c
+ 197.85 103.39 191.37 96.91 183.45 96.91 c
+ 175.53 96.91 169.05 103.39 169.05 111.31 c
+B
+ 169.05 170.60 m
+ 169.05 178.52 175.53 185.00 183.45 185.00 c
+ 191.37 185.00 197.85 178.52 197.85 170.60 c
+ 197.85 162.68 191.37 156.20 183.45 156.20 c
+ 175.53 156.20 169.05 162.68 169.05 170.60 c
+B
+BT
+/F1 1 Tf 2 Tr 2.77 0 0 2.77 182.35 228.94 Tm (l) Tj 0 Tr
+ET
+BT
+/F1 1 Tf 2 Tr 2.77 0 0 2.77 182.35 288.24 Tm (l) Tj 0 Tr
+ET
+BT
+/F1 1 Tf 2 Tr 2.77 0 0 2.77 182.35 347.54 Tm (l) Tj 0 Tr
+ET
+BT
+/F1 1 Tf 2 Tr 2.77 0 0 2.77 272.10 110.35 Tm (l) Tj 0 Tr
+ET
+BT
+/F1 1 Tf 2 Tr 2.77 0 0 2.77 272.10 169.64 Tm (l) Tj 0 Tr
+ET
+ 258.80 229.90 m
+ 258.80 237.82 265.28 244.30 273.20 244.30 c
+ 281.12 244.30 287.60 237.82 287.60 229.90 c
+ 287.60 221.98 281.12 215.50 273.20 215.50 c
+ 265.28 215.50 258.80 221.98 258.80 229.90 c
+B
+ 258.80 289.20 m
+ 258.80 297.12 265.28 303.60 273.20 303.60 c
+ 281.12 303.60 287.60 297.12 287.60 289.20 c
+ 287.60 281.28 281.12 274.80 273.20 274.80 c
+ 265.28 274.80 258.80 281.28 258.80 289.20 c
+B
+ 258.80 348.50 m
+ 258.80 356.42 265.28 362.90 273.20 362.90 c
+ 281.12 362.90 287.60 356.42 287.60 348.50 c
+ 287.60 340.58 281.12 334.10 273.20 334.10 c
+ 265.28 334.10 258.80 340.58 258.80 348.50 c
+B
+BT
+/F1 1 Tf 2 Tr 2.77 0 0 2.77 361.86 110.35 Tm (l) Tj 0 Tr
+ET
+BT
+/F1 1 Tf 2 Tr 2.77 0 0 2.77 361.86 169.64 Tm (l) Tj 0 Tr
+ET
+BT
+/F1 1 Tf 2 Tr 2.77 0 0 2.77 361.86 228.94 Tm (l) Tj 0 Tr
+ET
+ 348.55 289.20 m
+ 348.55 297.12 355.03 303.60 362.95 303.60 c
+ 370.87 303.60 377.35 297.12 377.35 289.20 c
+ 377.35 281.28 370.87 274.80 362.95 274.80 c
+ 355.03 274.80 348.55 281.28 348.55 289.20 c
+B
+ 348.55 348.50 m
+ 348.55 356.42 355.03 362.90 362.95 362.90 c
+ 370.87 362.90 377.35 356.42 377.35 348.50 c
+ 377.35 340.58 370.87 334.10 362.95 334.10 c
+ 355.03 334.10 348.55 340.58 348.55 348.50 c
+B
+BT
+/F2 1 Tf 0.00 12.00 -12.00 0.00 187.76 77.50 Tm (N2) Tj
+ET
+BT
+/F2 1 Tf 0.00 12.00 -12.00 0.00 277.39 77.50 Tm (N3) Tj
+ET
+BT
+/F2 1 Tf 0.00 12.00 -12.00 0.00 367.26 77.50 Tm (N4) Tj
+ET
+BT
+/F4 1 Tf 12.00 0.00 -0.00 12.00 384.55 108.43 Tm (t3) Tj
+ET
+BT
+/F4 1 Tf 12.00 0.00 -0.00 12.00 384.55 167.73 Tm (t2) Tj
+ET
+BT
+/F4 1 Tf 12.00 0.00 -0.00 12.00 384.55 227.03 Tm (t4) Tj
+ET
+BT
+/F4 1 Tf 12.00 0.00 -0.00 12.00 384.55 286.33 Tm (t1) Tj
+ET
+BT
+/F4 1 Tf 12.00 0.00 -0.00 12.00 384.55 345.62 Tm (t5) Tj
+ET
+BT
+/F2 1 Tf 12.00 0.00 -0.00 12.00 69.23 73.40 Tm (0) Tj
+ET
+BT
+/F2 1 Tf 12.00 0.00 -0.00 12.00 79.33 73.40 Tm (0.2) Tj
+ET
+BT
+/F2 1 Tf 12.00 0.00 -0.00 12.00 99.44 73.40 Tm (0.8) Tj
+ET
+BT
+/F2 1 Tf 12.00 0.00 -0.00 12.00 133.79 73.29 Tm (1) Tj
+ET
+BT
+/F1 1 Tf 2 Tr 2.77 0 0 2.77 71.47 100.04 Tm (l) Tj 0 Tr
+ET
+BT
+/F1 1 Tf 2 Tr 7.98 0 0 7.98 84.51 98.23 Tm (l) Tj 0 Tr
+ET
+ 96.26 101.00 m
+ 96.26 107.33 101.44 112.52 107.78 112.52 c
+ 114.11 112.52 119.30 107.33 119.30 101.00 c
+ 119.30 94.66 114.11 89.48 107.78 89.48 c
+ 101.44 89.48 96.26 94.66 96.26 101.00 c
+B
+ 122.72 101.00 m
+ 122.72 108.92 129.20 115.40 137.12 115.40 c
+ 145.04 115.40 151.52 108.92 151.52 101.00 c
+ 151.52 93.08 145.04 86.60 137.12 86.60 c
+ 129.20 86.60 122.72 93.08 122.72 101.00 c
+B
+Q
+endstream
+endobj
+7 0 obj
+4560
+endobj
+3 0 obj
+<<
+/Type /Pages
+/Kids [
+5 0 R
+]
+/Count 1
+/MediaBox [0 0 432 432]
+>>
+endobj
+4 0 obj
+<<
+/ProcSet [/PDF /Text]
+/Font << /F1 9 0 R /F2 10 0 R /F4 11 0 R >>
+/ExtGState << >>
+>>
+endobj
+8 0 obj
+<<
+/Type /Encoding
+/BaseEncoding /WinAnsiEncoding
+/Differences [ 45/minus 96/quoteleft
+144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent
+/dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space]
+>>
+endobj
+9 0 obj
+<<
+/Type /Font
+/Subtype /Type1
+/Name /F1
+/BaseFont /ZapfDingbats
+>>
+endobj
+10 0 obj <<
+/Type /Font
+/Subtype /Type1
+/Name /F2
+/BaseFont /Helvetica
+/Encoding 8 0 R
+>> endobj
+11 0 obj <<
+/Type /Font
+/Subtype /Type1
+/Name /F4
+/BaseFont /Helvetica-Oblique
+/Encoding 8 0 R
+>> endobj
+xref
+0 12
+0000000000 65535 f
+0000000021 00000 n
+0000000163 00000 n
+0000004925 00000 n
+0000005008 00000 n
+0000000212 00000 n
+0000000292 00000 n
+0000004905 00000 n
+0000005112 00000 n
+0000005369 00000 n
+0000005452 00000 n
+0000005549 00000 n
+trailer
+<<
+/Size 12
+/Info 1 0 R
+/Root 2 0 R
+>>
+startxref
+5654
+%%EOF
diff --git a/vignettes/figs/adephylo-017.png b/vignettes/figs/adephylo-017.png
new file mode 100644
index 0000000..ce8df01
Binary files /dev/null and b/vignettes/figs/adephylo-017.png differ
diff --git a/vignettes/figs/adephylo-018.pdf b/vignettes/figs/adephylo-018.pdf
new file mode 100644
index 0000000..c1d9a8d
Binary files /dev/null and b/vignettes/figs/adephylo-018.pdf differ
diff --git a/vignettes/figs/adephylo-aboutest.pdf b/vignettes/figs/adephylo-aboutest.pdf
new file mode 100644
index 0000000..76c4671
Binary files /dev/null and b/vignettes/figs/adephylo-aboutest.pdf differ
diff --git a/vignettes/figs/adephylo-figFourBas.pdf b/vignettes/figs/adephylo-figFourBas.pdf
new file mode 100644
index 0000000..83897f8
Binary files /dev/null and b/vignettes/figs/adephylo-figFourBas.pdf differ
diff --git a/vignettes/figs/adephylo-lm1.pdf b/vignettes/figs/adephylo-lm1.pdf
new file mode 100644
index 0000000..db38e10
Binary files /dev/null and b/vignettes/figs/adephylo-lm1.pdf differ
diff --git a/vignettes/figs/adephylo-loadings.pdf b/vignettes/figs/adephylo-loadings.pdf
new file mode 100644
index 0000000..abc561d
Binary files /dev/null and b/vignettes/figs/adephylo-loadings.pdf differ
diff --git a/vignettes/figs/adephylo-orthobas1.pdf b/vignettes/figs/adephylo-orthobas1.pdf
new file mode 100644
index 0000000..2e6353d
Binary files /dev/null and b/vignettes/figs/adephylo-orthobas1.pdf differ
diff --git a/vignettes/figs/adephylo-pca1.pdf b/vignettes/figs/adephylo-pca1.pdf
new file mode 100644
index 0000000..9d12405
Binary files /dev/null and b/vignettes/figs/adephylo-pca1.pdf differ
diff --git a/vignettes/figs/adephylo-pca2.pdf b/vignettes/figs/adephylo-pca2.pdf
new file mode 100644
index 0000000..31c694f
Binary files /dev/null and b/vignettes/figs/adephylo-pca2.pdf differ
diff --git a/vignettes/figs/adephylo-phylo4d.pdf b/vignettes/figs/adephylo-phylo4d.pdf
new file mode 100644
index 0000000..207a5e1
Binary files /dev/null and b/vignettes/figs/adephylo-phylo4d.pdf differ
diff --git a/vignettes/figs/adephylo-phylo4d.png b/vignettes/figs/adephylo-phylo4d.png
new file mode 100644
index 0000000..e18ab82
Binary files /dev/null and b/vignettes/figs/adephylo-phylo4d.png differ
diff --git a/vignettes/figs/adephylo-resid.pdf b/vignettes/figs/adephylo-resid.pdf
new file mode 100644
index 0000000..b63f5b5
Binary files /dev/null and b/vignettes/figs/adephylo-resid.pdf differ
diff --git a/vignettes/figs/adephylo-treePart.pdf b/vignettes/figs/adephylo-treePart.pdf
new file mode 100644
index 0000000..d85f6dd
--- /dev/null
+++ b/vignettes/figs/adephylo-treePart.pdf
@@ -0,0 +1,139 @@
+%PDF-1.4
+%���ρ�\r
+1 0 obj
+<<
+/CreationDate (D:20081216174754)
+/ModDate (D:20081216174754)
+/Title (R Graphics Output)
+/Producer (R 2.8.1)
+/Creator (R)
+>>
+endobj
+2 0 obj
+<<
+/Type /Catalog
+/Pages 3 0 R
+>>
+endobj
+5 0 obj
+<<
+/Type /Page
+/Parent 3 0 R
+/Contents 6 0 R
+/Resources 4 0 R
+>>
+endobj
+6 0 obj
+<<
+/Length 7 0 R
+>>
+stream
+q
+Q q
+Q q 59.04 73.44 342.72 299.52 re W n
+0.000 0.000 0.000 RG
+0.75 w
+[] 0 d
+1 J
+1 j
+10.00 M
+71.73 145.20 m 71.73 361.87 l S
+134.86 84.53 m 134.86 205.87 l S
+280.74 153.87 m 280.74 257.87 l S
+369.84 223.20 m 369.84 292.53 l S
+134.86 84.53 m 378.04 84.53 l S
+280.74 153.87 m 378.04 153.87 l S
+369.84 223.20 m 378.04 223.20 l S
+369.84 292.53 m 378.04 292.53 l S
+71.73 361.87 m 378.04 361.87 l S
+71.73 145.20 m 134.86 145.20 l S
+134.86 205.87 m 280.74 205.87 l S
+280.74 257.87 m 369.84 257.87 l S
+BT
+0.000 0.000 0.000 rg
+/F4 1 Tf 12.00 0.00 -0.00 12.00 378.04 80.36 Tm (t2) Tj
+ET
+BT
+/F4 1 Tf 12.00 0.00 -0.00 12.00 378.04 149.69 Tm (t1) Tj
+ET
+BT
+/F4 1 Tf 12.00 0.00 -0.00 12.00 378.04 219.10 Tm (t3) Tj
+ET
+BT
+/F4 1 Tf 12.00 0.00 -0.00 12.00 378.04 288.52 Tm (t5) Tj
+ET
+BT
+/F4 1 Tf 12.00 0.00 -0.00 12.00 378.04 357.69 Tm (t4) Tj
+ET
+BT
+/F4 1 Tf 12.00 0.00 -0.00 12.00 71.73 249.23 Tm (N1) Tj
+ET
+BT
+/F4 1 Tf 12.00 0.00 -0.00 12.00 134.86 140.89 Tm (N2) Tj
+ET
+BT
+/F4 1 Tf 12.00 0.00 -0.00 12.00 280.74 201.67 Tm (N3) Tj
+ET
+BT
+/F4 1 Tf 12.00 0.00 -0.00 12.00 369.84 253.56 Tm (N4) Tj
+ET
+Q
+endstream
+endobj
+7 0 obj
+1083
+endobj
+3 0 obj
+<<
+/Type /Pages
+/Kids [
+5 0 R
+]
+/Count 1
+/MediaBox [0 0 432 432]
+>>
+endobj
+4 0 obj
+<<
+/ProcSet [/PDF /Text]
+/Font <</F4 9 0 R >>
+/ExtGState << >>
+>>
+endobj
+8 0 obj
+<<
+/Type /Encoding
+/BaseEncoding /WinAnsiEncoding
+/Differences [ 45/minus 96/quoteleft
+144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent
+/dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space]
+>>
+endobj
+9 0 obj <<
+/Type /Font
+/Subtype /Type1
+/Name /F4
+/BaseFont /Helvetica-Oblique
+/Encoding 8 0 R
+>> endobj
+xref
+0 10
+0000000000 65535 f
+0000000021 00000 n
+0000000163 00000 n
+0000001448 00000 n
+0000001531 00000 n
+0000000212 00000 n
+0000000292 00000 n
+0000001428 00000 n
+0000001612 00000 n
+0000001869 00000 n
+trailer
+<<
+/Size 10
+/Info 1 0 R
+/Root 2 0 R
+>>
+startxref
+1973
+%%EOF
diff --git a/vignettes/figs/adephylo-treePart.png b/vignettes/figs/adephylo-treePart.png
new file mode 100644
index 0000000..661818d
Binary files /dev/null and b/vignettes/figs/adephylo-treePart.png differ
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-med/r-cran-adephylo.git
More information about the debian-med-commit
mailing list