[Adephylo-commits] r62 - in pkg: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Dec 1 17:11:46 CET 2008
Author: jombart
Date: 2008-12-01 17:11:46 +0100 (Mon, 01 Dec 2008)
New Revision: 62
Added:
pkg/man/ppca.Rd
Modified:
pkg/R/ppca.R
pkg/R/s.phylo4d.R
pkg/man/carni19.Rd
pkg/man/carni70.Rd
pkg/man/lizards.Rd
pkg/man/maples.Rd
pkg/man/mjrochet.Rd
pkg/man/palm.Rd
pkg/man/procella.Rd
pkg/man/s.phylo4d.Rd
pkg/man/tithonia.Rd
Log:
Many small stuff. Code and Doc for ppca.
Modified: pkg/R/ppca.R
===================================================================
--- pkg/R/ppca.R 2008-11-28 18:04:04 UTC (rev 61)
+++ pkg/R/ppca.R 2008-12-01 16:11:46 UTC (rev 62)
@@ -11,14 +11,14 @@
## handle arguments
if(!require(ade4)) stop("The package ade4 is not installed.")
- if (is.character(chk <- check_phylo4d(x))) stop("Invalid phylo4d object: \n",chk)
+ if (is.character(chk <- check_phylo4(x))) stop("bad phylo4d object: ",chk)
+ if (is.character(chk <- check_data(x))) stop("bad phylo4d object: ",chk)
+
tre <- as(x, "phylo4")
method <- match.arg(method)
## proximity matrix
if(is.null(prox)){ # have to compute prox
- x <- as(x, "phylo4")
- if (is.character(checkval <- check_phylo4(x))) stop(checkval)
W <- proxTips(x, tips="all", method=method, a=a, normalize="row", symmetric=TRUE)
} else { # prox is provided
W <- as.matrix(prox)
@@ -62,18 +62,18 @@
## main computation ##
## make a skeleton of dudi
- res <- dudi.pca(X, center=FALSE, scale=FALSE, scannf=FALSE,nf=2)
+ 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, sym=TRUE)
+ decomp <- eigen((t(X) %*% W %*% X)/N, sym=TRUE)
U <- decomp$vectors # U: principal axes
p <- ncol(U)
- lambda <- U$values
+ lambda <- decomp$values
if(scannf){ # interactive part
- barplot(eig[1:rank])
+ barplot(lambda[1:res$rank])
cat("Select the number of global axes: ")
nfposi <- as.integer(readLines(n = 1))
cat("Select the number of local axes: ")
@@ -81,7 +81,7 @@
}
nfposi <- max(nfposi, 1)
- nfnega <- max(nfposi, 0)
+ nfnega <- max(nfnega, 0)
posi.idx <- 1:nfposi
if(nfnega<1) {
nega.idx <- NULL
@@ -100,6 +100,8 @@
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
@@ -115,17 +117,19 @@
row.names(res$li) <- X.rownames
res$ls <- as.data.frame(S) # lagged scores
- names(res$li) <- scores.lab
- row.names(res$li) <- X.rownames
+ names(res$ls) <- scores.lab
+ row.names(res$ls) <- X.rownames
res$as <- as.data.frame(A) # PCA axes onto pPCA axes
- names(res$li) <- axes.lab
- row.names(res$li) <- paste("PCA axis", 1:nrow(A))
+ names(res$as) <- axes.lab
+ row.names(res$as) <- paste("PCA axis", 1:nrow(A))
res$tre <- as(tre,"phylo4") # tree
- res$prox <- prox # proximity matrix
+ res$prox <- W # proximity matrix
+ res$call <- match.call() # call
+
class(res) <- "ppca"
return(res)
@@ -133,26 +137,90 @@
+
+
#####################
# Function plot.ppca
#####################
-plot.ppca <- function(x,laged=FALSE, ...){
- if(laged){
+plot.ppca <- function(x, axis=1:ncol(x$li), useLag=FALSE, ...){
+ if(useLag){
df <- as.data.frame(x$ls)
} else{
df <- as.data.frame(x$li)
}
+ if(any(axis < 1 | axis > ncol(x$li)) ) stop("Wrong axis specified.")
+ df <- df[, axis, 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(plot, args)
+ do.call(s.phylo4d, args)
}
+
+
+
+######################
+# Function print.ppca
+######################
+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, "axis-components saved")
+ cat("\n$nfnega:", x$nfnega, "axis-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
+
+
+
+
+
### testing
## obj <- phylo4d(read.tree(text=mjrochet$tre),mjrochet$tab)
## x at edge.length= rep(1,length(x at edge.label))
Modified: pkg/R/s.phylo4d.R
===================================================================
--- pkg/R/s.phylo4d.R 2008-11-28 18:04:04 UTC (rev 61)
+++ pkg/R/s.phylo4d.R 2008-12-01 16:11:46 UTC (rev 62)
@@ -10,8 +10,8 @@
{
## preliminary stuff and checks
- if (is.character(chk <- check_phylo4(x)))
- stop("bad phylo4d object: ",chk)
+ if (is.character(chk <- check_phylo4(x))) stop("bad phylo4d object: ",chk)
+ if (is.character(chk <- check_data(x))) stop("bad phylo4d object: ",chk)
if(!require(ape)) stop("the ape package is required")
if(cex.label<0.1) {
Modified: pkg/man/carni19.Rd
===================================================================
--- pkg/man/carni19.Rd 2008-11-28 18:04:04 UTC (rev 61)
+++ pkg/man/carni19.Rd 2008-12-01 16:11:46 UTC (rev 62)
@@ -16,7 +16,7 @@
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.
}
-\details{
+\note{
This dataset replaces the former version in ade4.
}
\examples{
Modified: pkg/man/carni70.Rd
===================================================================
--- pkg/man/carni70.Rd 2008-11-28 18:04:04 UTC (rev 61)
+++ pkg/man/carni70.Rd 2008-12-01 16:11:46 UTC (rev 62)
@@ -18,7 +18,7 @@
Diniz-Filho, J. A. F., and N. M. Tôrres. (2002) Phylogenetic comparative methods and the
geographic range size-body size relationship in new world terrestrial carnivora. \emph{Evolutionary Ecology}, \bold{16}, 351--367.
}
-\details{
+\note{
This dataset replaces the former version in ade4.
}
\examples{
Modified: pkg/man/lizards.Rd
===================================================================
--- pkg/man/lizards.Rd 2008-11-28 18:04:04 UTC (rev 61)
+++ pkg/man/lizards.Rd 2008-12-01 16:11:46 UTC (rev 62)
@@ -28,7 +28,7 @@
See a data description at \url{http://pbil.univ-lyon1.fr/R/pps/pps063.pdf} (in French).
}
-\details{
+\note{
This dataset replaces the former version in ade4.
}
\examples{
Modified: pkg/man/maples.Rd
===================================================================
--- pkg/man/maples.Rd 2008-11-28 18:04:04 UTC (rev 61)
+++ pkg/man/maples.Rd 2008-12-01 16:11:46 UTC (rev 62)
@@ -19,7 +19,7 @@
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.
}
-\details{
+\note{
This dataset replaces the former version in ade4.
}
\examples{
Modified: pkg/man/mjrochet.Rd
===================================================================
--- pkg/man/mjrochet.Rd 2008-11-28 18:04:04 UTC (rev 61)
+++ pkg/man/mjrochet.Rd 2008-12-01 16:11:46 UTC (rev 62)
@@ -37,7 +37,7 @@
Comparative analysis of phylogenic and fishing effects in life history patterns of teleos fishes.
\emph{Oïkos}, \bold{91}, 255--270.
}
-\details{
+\note{
This dataset replaces the former version in ade4.
}
\examples{
Modified: pkg/man/palm.Rd
===================================================================
--- pkg/man/palm.Rd 2008-11-28 18:04:04 UTC (rev 61)
+++ pkg/man/palm.Rd 2008-12-01 16:11:46 UTC (rev 62)
@@ -27,7 +27,7 @@
This data set was obtained by Clémentine Gimaret-Carpentier\cr
\email{gimaret at biomserv.univ-lyon1.fr}.
}
-\details{
+\note{
This dataset replaces the former version in ade4.
}
\examples{
Added: pkg/man/ppca.Rd
===================================================================
--- pkg/man/ppca.Rd (rev 0)
+++ pkg/man/ppca.Rd 2008-12-01 16:11:46 UTC (rev 62)
@@ -0,0 +1,160 @@
+\encoding{UTF-8}
+\name{ppca}
+\alias{ppca}
+\alias{print.ppca}
+\alias{plot.ppca}
+\title{Phylogenetic principal component analysis}
+\description{These functions are designed to perform a phylogenetic principal
+ component analysis (pPCA, Jombart et al. in prep) and to display the
+ results. As this method is not published yet, please email the author
+ before using it.
+
+ \code{ppca} performs the phylogenetic component analysis. Other
+ functions are:\cr
+
+ - \code{print.ppca}: prints the ppca content\cr
+
+ - \code{plot.ppca}: plot principal components using
+ \code{\link{s.phylo4d}}\cr
+
+}
+\usage{
+ppca(x, prox=NULL, method=c("patristic","nNodes","Abouheif","sumDD"), a=1,
+ center=TRUE, scale=TRUE, scannf=TRUE, nfposi=1, nfnega=0)
+
+\method{print}{ppca}(x, \dots)
+
+\method{plot}{ppca}(x, axis = 1, useLag=FALSE, \dots)
+}
+\arguments{
+ \item{x}{a \linkS4class{phylo4d} object (for \code{ppca}) or a ppca
+ object (for \code{print} and \code{plot} 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{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{\dots}{further arguments passed to other methods. Can be used to
+ provide arguments to \code{\link{s.phylo4d}} in \code{plot} method.}
+ \item{axis}{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}).}
+}
+\details{
+ The phylogenetic Principal Component Analysis (pPCA, Jombart et al.,
+ in prep) is derived from the spatial Principal Component Analysis
+ (spca, Jombart et al. 2008), implemented in the adegenet package (see
+ \code{\link[pkg:adegenet]{spca}}).\cr
+
+ pPCA is designed to investigate phylogenetic patterns in the variability of a set of
+ traits. The analysis returns principal components maximizing the
+ product of variance and phylogenetic autocorrelation (Moran's
+ I), therefore reflecting biodemographic strategies that are linked
+ to the phylogeny. Large positive and large negative eigenvalues
+ correspond to global and local structures.\cr
+}
+\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{plot.ppca} returns the matched call.\cr
+
+ - \code{screeplot.ppca} returns the matched call.
+}
+\references{
+ Jombart, T.; Pavoine, S.; Dufour, A.-B. & Pontier, D. (in prep)
+ Exploring phylogeny as a source of ecological variation: a
+ methodological approach \cr
+
+ Jombart, T., Devillard, S., Dufour, A.-B. and Pontier, D.
+ Revealing cryptic phylogenetic patterns in genetic variability by a new
+ multivariate method. \emph{Heredity}, \bold{101}, 92--103.
+
+ Wartenberg, D. E. (1985) Multivariate phylogenetic correlation: a method for
+ exploratory geographical analysis. \emph{Geographical Analysis},
+ \bold{17}, 263--283.
+
+ 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{The implementation of \code{\link[pkg:adegenet]{spca}} in the
+ adegenet package (?\code{\link[pkg:adegenet]{adegenet}}) \cr
+ }
+\author{ Thibaut Jombart \email{jombart at biomserv.univ-lyon1.fr} }
+\examples{
+## build an look at data
+data(maples)
+tre <- read.tree(text=maples$tre)
+x <- phylo4d(tre, maples$tab)
+omar <- par("mar")
+par(mar=rep(.1,4))
+s.phylo4d(x, cex.lab=.5, cex.sym=.6, ratio=.1) # note NAs in last trait ('x')
+
+## function to replace NA
+f1 <- function(vec){
+if(any(is.na(vec))){
+m <- mean(vec, na.rm=TRUE)
+vec[is.na(vec)] <- m
+}
+return(vec)
+}
+
+## compute a PCA
+dat <- apply(maples$tab,2,f1) # replace NAs
+x.noNA <- phylo4d(tre, as.data.frame(dat))
+ppca1 <- ppca(x.noNA, scannf=FALSE, method="Abouheif")
+ppca1
+
+## some graphics
+par(mar=omar)
+barplot(ppca1$eig, main="Eigenvalues") # screeplot
+
+a <- ppca1$c1[,1] # loadings on PC 1
+names(a) <- row.names(ppca1$c1)
+dotchart(a) # plot of loadings
+abline(v=median(a), lty=3)
+highContrib <- a[a< quantile(a,0.1) | a>quantile(a,0.9)]
+
+plot(ppca1) # ppca plot
+
+datSel <- cbind.data.frame(ppca1$li, dat[, names(highContrib)])
+temp <- phylo4d(tre, datSel))
+s.phylo4d(temp) # plot of most structured traits
+
+## phylogenetic autocorrelation tests for these traits
+prox <- proxTips(tre, method="Abouheif")
+gearymoran(prox, dat[, names(highContrib)]) # one test per trait
+
+}
+\keyword{multivariate}
\ No newline at end of file
Modified: pkg/man/procella.Rd
===================================================================
--- pkg/man/procella.Rd 2008-11-28 18:04:04 UTC (rev 61)
+++ pkg/man/procella.Rd 2008-12-01 16:11:46 UTC (rev 62)
@@ -27,7 +27,7 @@
See a data description at \url{http://pbil.univ-lyon1.fr/R/pps/pps037.pdf} (in French).
}
-\details{
+\note{
This dataset replaces the former version in ade4.
}
\examples{
Modified: pkg/man/s.phylo4d.Rd
===================================================================
--- pkg/man/s.phylo4d.Rd 2008-11-28 18:04:04 UTC (rev 61)
+++ pkg/man/s.phylo4d.Rd 2008-12-01 16:11:46 UTC (rev 62)
@@ -15,11 +15,11 @@
}
\usage{
s.phylo4d(x, treetype=c("phylogram","cladogram"), symbol=c("circles", "squares"),
- 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=x at tip.label, var.label=colnames(x at tip.data),
- cex.symbol=1, cex.label=1, cex.legend=1, coord.legend=NULL, \dots)
+ 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=x at tip.label, var.label=colnames(x at tip.data),
+ cex.symbol=1, cex.label=1, cex.legend=1, coord.legend=NULL, \dots)
}
\arguments{
\item{x}{a \linkS4class{phylo4d} object}
Modified: pkg/man/tithonia.Rd
===================================================================
--- pkg/man/tithonia.Rd 2008-11-28 18:04:04 UTC (rev 61)
+++ pkg/man/tithonia.Rd 2008-12-01 16:11:46 UTC (rev 62)
@@ -33,7 +33,7 @@
Data were obtained from Morales, E. (2000) Estimating phylogenetic inertia in Tithonia (Asteraceae) :
a comparative approach. \emph{Evolution}, \bold{54}, 2, 475--484.
}
-\details{
+\note{
This dataset replaces the former version in ade4.
}
\examples{
More information about the Adephylo-commits
mailing list