[adegenet-commits] r541 - in pkg: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Feb 1 16:32:11 CET 2010
Author: jombart
Date: 2010-02-01 16:32:11 +0100 (Mon, 01 Feb 2010)
New Revision: 541
Added:
pkg/man/dapc.Rd
pkg/man/dapcIllus.Rd
pkg/man/eHGDP.Rd
pkg/man/h3n2.Rd
Modified:
pkg/R/dapc.R
Log:
Doc for DAPC, and a few changes (labelling of objects/args) in dapc functions.
Modified: pkg/R/dapc.R
===================================================================
--- pkg/R/dapc.R 2010-01-23 00:58:38 UTC (rev 540)
+++ pkg/R/dapc.R 2010-02-01 15:32:11 UTC (rev 541)
@@ -7,8 +7,8 @@
## dapc.data.frame
#################
dapc.data.frame <- function(x, grp, n.pca=NULL, n.da=NULL,
- center=TRUE, scale=TRUE, var.contrib=FALSE,
- pca.select=c("nbEig","propVar"), perc.pca=NULL){
+ center=TRUE, scale=FALSE, var.contrib=FALSE,
+ pca.select=c("nbEig","percVar"), perc.pca=NULL){
## FIRST CHECKS
if(!require(ade4, quiet=TRUE)) stop("ade4 library is required.")
@@ -16,7 +16,7 @@
grp <- as.factor(grp)
if(length(grp) != nrow(x)) stop("Inconsistent length for grp")
pca.select <- match.arg(pca.select)
- if(!is.null(perc.pca) & is.null(n.pca)) pca.select <- "propVar"
+ if(!is.null(perc.pca) & is.null(n.pca)) pca.select <- "percVar"
if(is.null(perc.pca) & !is.null(n.pca)) pca.select <- "nbEig"
@@ -36,7 +36,7 @@
n.pca <- as.integer(readLines(n = 1))
}
- if(is.null(perc.pca) & pca.select=="propVar"){
+ if(is.null(perc.pca) & pca.select=="percVar"){
plot(cumVar, xlab="Number of retained PCs", ylab="Cumulative variance (%)", main="Variance explained by PCA")
cat("Choose the percentage of variance to retain (0-100): ")
nperc.pca <- as.numeric(readLines(n = 1))
@@ -82,7 +82,7 @@
res$grp <- grp
res$var <- XU.lambda
res$eig <- ldaX$svd^2
- res$disc.func <- ldaX$scaling[, 1:n.da, drop=FALSE]
+ res$loadings <- ldaX$scaling[, 1:n.da, drop=FALSE]
res$ind.coord <-predX$x
res$grp.coord <- apply(res$ind.coord, 2, tapply, grp, mean)
res$prior <- ldaX$prior
@@ -123,8 +123,8 @@
## dapc.genind
#############
dapc.genind <- function(x, pop=NULL, n.pca=NULL, n.da=NULL,
- scale=TRUE, scale.method=c("sigma", "binom"), truenames=TRUE, all.contrib=FALSE,
- pca.selec=c("nbEig","propVar"), perc.pca=NULL){
+ scale=FALSE, scale.method=c("sigma", "binom"), truenames=TRUE, all.contrib=FALSE,
+ pca.select=c("nbEig","percVar"), perc.pca=NULL){
## FIRST CHECKS
if(!require(ade4, quiet=TRUE)) stop("ade4 library is required.")
@@ -153,7 +153,7 @@
## CALL DATA.FRAME METHOD ##
res <- dapc(X, grp=pop.fac, n.pca=n.pca, n.da=n.da,
center=FALSE, scale=FALSE, var.contrib=all.contrib,
- pca.selec=pca.selec, perc.pca=perc.pca)
+ pca.select=pca.select, perc.pca=perc.pca)
res$call <- match.call()
@@ -178,7 +178,7 @@
print(x$call)
cat("\n$n.pca:", x$n.pca, "first PCs of PCA used")
cat("\n$n.da:", x$n.da, "discriminant functions saved")
- cat("\n$varn (proportion of conserved variance):", round(x$var,3))
+ cat("\n$var (proportion of conserved variance):", round(x$var,3))
cat("\n\n$eig (eigenvalues): ")
l0 <- sum(x$eig >= 0)
cat(signif(x$eig, 4)[1:(min(5, l0))])
@@ -198,8 +198,8 @@
cat("\n")
sumry <- array("", c(5, 4), list(1:5, c("data.frame", "nrow", "ncol", "content")))
sumry[1, ] <- c("$tab", nrow(x$tab), ncol(x$tab), "retained PCs of PCA")
- sumry[2, ] <- c("$disc.func", nrow(x$disc.func), ncol(x$disc.func), "discriminant functions")
- sumry[3, ] <- c("$ind.coord", nrow(x$ind.coord), ncol(x$ind.coord), "coordinates of individuals")
+ sumry[2, ] <- c("$loadings", nrow(x$loadings), ncol(x$loadings), "loadings of variables")
+ sumry[3, ] <- c("$ind.coord", nrow(x$ind.coord), ncol(x$ind.coord), "coordinates of individuals (principal components)")
sumry[4, ] <- c("$grp.coord", nrow(x$grp.coord), ncol(x$grp.coord), "coordinates of groups")
sumry[5, ] <- c("$posterior", nrow(x$posterior), ncol(x$posterior), "posterior membership probabilities")
class(sumry) <- "table"
@@ -226,7 +226,7 @@
res <- list()
## number of dimensions
- res$n.dim <- ncol(x$disc.func)
+ res$n.dim <- ncol(x$loadings)
res$n.pop <- length(levels(x$grp))
## assignment success
@@ -255,9 +255,9 @@
par(bg=bg)
s.class(x$ind.coord[,axes], fac=x$grp, col=col, ...)
if(ratio>0.001) {
- add.scatter.eig(x$eig, ncol(x$disc.func), axes[1], axes[2], posi=posi, ratio=ratio, csub=csub)
+ add.scatter.eig(x$eig, ncol(x$loadings), axes[1], axes[2], posi=posi, ratio=ratio, csub=csub)
}
- return(invisible())
+ return(invisible(match.call()))
} # end scatter.dapc
@@ -308,7 +308,7 @@
points(x.real.coord, y.real.coord, col="deepskyblue2", pch=pch)
- return(invisible())
+ return(invisible(match.call()))
} # end assignplot
Added: pkg/man/dapc.Rd
===================================================================
--- pkg/man/dapc.Rd (rev 0)
+++ pkg/man/dapc.Rd 2010-02-01 15:32:11 UTC (rev 541)
@@ -0,0 +1,180 @@
+\encoding{UTF-8}
+\name{dapc}
+\alias{dapc}
+\alias{dapc.data.frame}
+\alias{dapc.matrix}
+\alias{dapc.genind}
+\alias{print.dapc}
+\alias{summary.dapc}
+\alias{scatter.dapc}
+\alias{assignplot}
+\title{Discriminant Analysis of Principal Components (DAPC)}
+\description{These functions implement the Discriminant Analysis of
+ Principal Components (DAPC). See 'details' section for a succint
+ description of the method. \cr
+
+ DAPC implementation calls upon \code{dudi.pca} from the \code{ade4} package and
+ \code{lda} from the \code{MASS} package.\cr
+
+ \code{dapc} performs the DAPC on a \code{data.frame}, a \code{matrix},
+ or a \code{\linkS4class{genind}} object, and returns an object with
+ class \code{dapc}. Of data are stored in a \code{data.frame} or a
+ \code{matrix}, these have to be quantitative data (i.e., \code{numeric} or
+ \code{integers}), as opposed to \code{characters} or \code{factors}. \cr
+
+ Other functions are:\cr
+
+ - \code{print.dapc}: prints the content of a \code{dapc} object\cr
+
+ - \code{summary.dapc}: gives variance and autocorrelation\cr
+ statistics
+
+ - \code{scatter.dapc}: produces scatterplots of principal components
+ (or 'discriminant functions'), with a screeplot of eigenvalues as inset.\cr
+
+ - \code{assignplot}: plot showing the probabilities of assignment of
+ individuals to the different clusters.\cr
+}
+\usage{
+\method{dapc}{data.frame}(x, grp, n.pca=NULL, n.da=NULL, center=TRUE,
+ scale=FALSE, var.contrib=FALSE,
+ pca.select=c("nbEig","percVar"), perc.pca=NULL)
+
+\method{dapc}{matrix}(x, \ldots)
+
+\method{dapc}{genind}(x, pop=NULL, n.pca=NULL, n.da=NULL, scale=FALSE,
+ scale.method=c("sigma", "binom"), truenames=TRUE,
+ all.contrib=FALSE, pca.select=c("nbEig","percVar"),
+ perc.pca=NULL)
+
+\method{print}{dapc}(x, \dots)
+
+\method{summary}{dapc}(object, \dots)
+
+\method{scatter}{dapc}(x, xax=1, yax=2, col=rainbow(length(levels(x$grp))),
+posi="bottomleft", bg="grey", ratio=0.3, csub=1.2, \ldots)
+
+\method{assignplot}{dapc}(x, only.grp=NULL, subset=NULL, cex.lab=.75, pch=3)
+}
+\arguments{
+\item{x}{\code{a data.frame}, \code{matrix}, or \code{\linkS4class{genind}}
+ object. For the \code{data.frame} and \code{matrix} arguments, only
+ quantitative variables should be provided.}
+\item{grp,pop}{a \code{factor} indicating the group membership of individuals}
+\item{n.pca}{an \code{integer} indicating the number of axes retained in the
+ Principal Component Analysis (PCA) step. If \code{NULL}, interactive selection is triggered.}
+\item{n.da}{an \code{integer} indicating the number of axes retained in the
+ Discriminant Analysis step. If \code{NULL}, interactive selection is triggered.}
+\item{center}{a \code{logical} indicating whether variables should be centred to
+mean 0 (TRUE, default) or not (FALSE). Always TRUE for \linkS4class{genind} objects.}
+\item{scale}{a \code{logical} indicating whether variables should be scaled
+ (TRUE) or not (FALSE, default). Scaling consists in dividing variables by their
+ (estimated) standard deviation to account for trivial differences in
+ variances. Further scaling options are available for \linkS4class{genind}
+ objects (see argument \code{scale.method}).}
+\item{var.contrib,all.contrib}{a \code{logical} indicating whether the
+ contribution of original variables (alleles, for \linkS4class{genind} objects)
+ should be provided (TRUE) or not (FALSE, default). Such output can be useful,
+ but can also create huge matrices when there the original size of the dataset
+ is huge.}
+\item{pca.select}{a \code{character} indicating the mode of selection of PCA
+ axes, matching approximately "nbEig" or "percVar". For "nbEig", the user
+ has to specify the number of axes retained (interactively, or via
+ \code{n.pca}). For "percVar", the user has to specify the minimum amount of
+ the total variance to be preserved by the retained axes, expressed as a
+ percentage (interactively, or via \code{perc.pca}). }
+\item{perc.pca}{a \code{numeric} value between 0 and 100 indicating the
+ minimal percentage of the total variance of the data to be expressed by the
+ retained axes of PCA.}
+\item{\ldots}{further arguments to be passed to other functions. For
+ \code{dapc.matrix}, arguments are to match those of \code{dapc.data.frame}.}
+\item{scale.method}{a \code{character} specifying the scaling method to be used
+ for allele frequencies, which must match "sigma" (usual estimate of standard
+ deviation) or "binom" (based on binomial distribution). See \code{\link{scaleGen}} for
+ further details.}
+\item{truenames}{a \code{logical} indicating whether true (i.e., user-specified)
+ labels should be used in object outputs (TRUE, default) or not (FALSE).}
+\item{xax,yax}{\code{integers} specifying which principal components of DAPC
+ should be shown in x and y axes. }
+\item{col}{a suitable color to be used for groups. Not that the specified vector
+should match the number of groups, not the number of individuals.}
+\item{posi,bg,ratio,csub}{arguments used to customize the inset in scatterplots
+ of DAPC results. See \code{\link[pkg:ade4]{add.scatter}} documentation in the
+ ade4 package for
+ more details.}
+\item{only.grp}{a \code{character} vector indicating which groups should be
+ displayed. Values should match values of \code{x$grp}. If \code{NULL}, all
+ results are displayed}
+\item{subset}{\code{integer} or \code{logical} vector indicating which
+ individuals should be displayed. If \code{NULL}, all
+ results are displayed}
+\item{cex.lab}{a \code{numeric} indicating the size of labels.}
+\item{pch}{a \code{numeric} indicating the type of point to be used to indicate
+ the prior group of individuals (see \code{\link{points}} documentation for
+ more details).}
+}
+\details{
+ The Discriminant Analysis of Principal Components (DAPC) is designed to
+ investigatey. \cr
+
+ \cr
+}
+\value{
+ === dapc objects ===\cr
+ The class \code{dapc} is a list with the following
+ components:\cr
+ \item{call}{the matched call.}
+ \item{n.pca}{number of PCA axes retained}
+ \item{n.da}{number of DA axes retained}
+ \item{var}{proportion of variance conserved by PCA principal components}
+ \item{eig}{a numeric vector of eigenvalues.}
+ \item{grp}{a factor giving prior group assignment}
+ \item{prior}{a numeric vector giving prior group probabilities}
+ \item{assign}{a factor giving posterior group assignment}
+ \item{tab}{matrix of retained principal components of PCA}
+ \item{loadings}{principal axes of DAPC, giving coefficients of the linear
+ combination of retained PCA axes.}
+ \item{ind.coord}{principal components of DAPC, giving the coordinates of individuals onto
+ principal axes of DAPC; also called the discriminant functions.}
+ \item{grp.coord}{coordinates of the groups onto the principal axes of DAPC.}
+ \item{posterior}{a data.frame giving posterior membership probabilities for
+ all individuals and all clusters.}
+ \item{var.contr}{(optional) a data.frame giving the contributions of original
+ variables (alleles in the case of genetic data) to the principal components
+ of DAPC.}\cr
+
+ === other outputs ===\cr
+ Other functions have different outputs:\cr
+ - \code{summary.dapc} returns a list with 6 components: \code{n.dim} (number
+ of retained DAPC axes), \code{n.pop} (number of groups/populations),
+ \code{assign.prop} (proportion of overall correct assignment),
+ \code{assign.per.pop} (proportion of correct assignment per group),
+ \code{prior.grp.size} (prior group sizes), and \code{post.grp.size} (posterior
+ group sizes).\cr
+
+ - \code{scatter.dapc, assignplot} return the matched call.\cr
+}
+\references{
+Jombart, T., Devillard, S. and Balloux, F.
+Discriminant analysis of principal components: a new method for the analysis of
+genetically structured populations. Submitted to \emph{PLoS genetics}.
+}
+\seealso{\code{\link{dapcIllus}}, a set of simulated data illustrating
+ the dapc, and \code{\link{eHGDP}} and \code{\link{H3N2}}, which also
+}
+\author{ Thibaut Jombart \email{t.jombart at imperial.ac.uk} }
+\examples{
+## data(dapcIllus), data(eHGDP), and data(H3N2) illustrate the dapc
+## see ?dapcIllus, ?eHGDP, ?H3N2
+##
+
+example(dapcIllus)
+
+
+\dontrun{
+example(eHGDP)
+example(H3N2)
+}
+
+}
+\keyword{multivariate}
\ No newline at end of file
Added: pkg/man/dapcIllus.Rd
===================================================================
--- pkg/man/dapcIllus.Rd (rev 0)
+++ pkg/man/dapcIllus.Rd 2010-02-01 15:32:11 UTC (rev 541)
@@ -0,0 +1,121 @@
+\encoding{UTF-8}
+\name{spcaIllus}
+\alias{spcaIllus}
+\docType{data}
+\title{Simulated data illustrating the sPCA}
+\description{
+ Datasets illustrating the spatial Principal Component Analysis
+ (Jombart et al. submitted).
+ These data were simulated using various models using Easypop (2.0.1).
+ Spatial coordinates were defined so that different spatial patterns
+ existed in the data. The \code{spca-illus} is a list containing the
+ following \linkS4class{genind} or \linkS4class{genpop} objects:\cr
+ - dat2A: 2 patches \cr
+ - dat2B: cline between two pop \cr
+ - dat2C: repulsion among individuals from the same gene pool \cr
+ - dat3: cline and repulsion \cr
+ - dat4: patches and local alternance \cr
+
+ See "source" for a reference providing simulation details.
+}
+\usage{data(spcaIllus)}
+\format{
+ \code{spcaIllus} is list of 5 components being either genind or genpop objects.
+}
+\source{
+ Jombart, T., Devillard, S., Dufour, A.-B. and Pontier, D.
+Revealing cryptic spatial patterns in genetic variability by a new
+multivariate method. \emph{Heredity}, \bold{101}, 92--103.
+}
+\author{
+ Thibaut Jombart \email{t.jombart at imperial.ac.uk}
+}
+\seealso{ \code{\link{spca}} }
+\references{
+ Jombart T, Devillard S, Dufour A-B and Pontier D
+Revealing cryptic spatial patterns in genetic variability by a new
+multivariate method. Submitted to \emph{Heredity}.
+
+ Balloux F (2001) Easypop (version 1.7): a computer program for oppulation
+ genetics simulations \emph{Journal of Heredity}, \bold{92}: 301-302
+}
+\examples{
+if(require(spdep) & require(ade4)){
+
+data(spcaIllus)
+attach(spcaIllus)
+opar <- par(no.readonly=TRUE)
+## comparison PCA vs sPCA
+
+# PCA
+pca2A <- dudi.pca(dat2A$tab,center=TRUE,scale=FALSE,scannf=FALSE)
+pca2B <- dudi.pca(dat2B$tab,center=TRUE,scale=FALSE,scannf=FALSE)
+pca2C <- dudi.pca(dat2C$tab,center=TRUE,scale=FALSE,scannf=FALSE)
+pca3 <- dudi.pca(dat3$tab,center=TRUE,scale=FALSE,scannf=FALSE,nf=2)
+pca4 <- dudi.pca(dat4$tab,center=TRUE,scale=FALSE,scannf=FALSE,nf=2)
+
+# sPCA
+spca2A <- spca(dat2A,xy=dat2A$other$xy,ask=FALSE,type=1,plot=FALSE,scannf=FALSE,nfposi=1,nfnega=0)
+
+spca2B <- spca(dat2B,xy=dat2B$other$xy,ask=FALSE,type=1,plot=FALSE,scannf=FALSE,nfposi=1,nfnega=0)
+
+spca2C <- spca(dat2C,xy=dat2C$other$xy,ask=FALSE,type=1,plot=FALSE,scannf=FALSE,nfposi=0,nfnega=1)
+
+spca3 <- spca(dat3,xy=dat3$other$xy,ask=FALSE,type=1,plot=FALSE,scannf=FALSE,nfposi=1,nfnega=1)
+
+spca4 <- spca(dat4,xy=dat4$other$xy,ask=FALSE,type=1,plot=FALSE,scannf=FALSE,nfposi=1,nfnega=1)
+
+# an auxiliary function for graphics
+plotaux <- function(x,analysis,axis=1,lab=NULL,...){
+neig <- NULL
+if(inherits(analysis,"spca")) neig <- nb2neig(analysis$lw$neighbours)
+xrange <- range(x$other$xy[,1])
+xlim <- xrange + c(-diff(xrange)*.1 , diff(xrange)*.45)
+yrange <- range(x$other$xy[,2])
+ylim <- yrange + c(-diff(yrange)*.45 , diff(yrange)*.1)
+
+s.value(x$other$xy,analysis$li[,axis],include.ori=FALSE,addaxes=FALSE,cgrid=0,grid=FALSE,neig=neig,cleg=0,xlim=xlim,ylim=ylim,
+...)
+
+par(mar=rep(.1,4))
+if(is.null(lab)) lab = gsub("[P]","",x$pop)
+text(x$other$xy, lab=lab, col="blue", cex=1.2, font=2)
+add.scatter({barplot(analysis$eig,col="grey");box();title("Eigenvalues",line=-1)},posi="bottomright",ratio=.3)
+}
+
+# plots
+plotaux(dat2A,pca2A,sub="dat2A - PCA",pos="bottomleft",csub=2)
+plotaux(dat2A,spca2A,sub="dat2A - sPCA glob1",pos="bottomleft",csub=2)
+
+plotaux(dat2B,pca2B,sub="dat2B - PCA",pos="bottomleft",csub=2)
+plotaux(dat2B,spca2B,sub="dat2B - sPCA glob1",pos="bottomleft",csub=2)
+
+plotaux(dat2C,pca2C,sub="dat2C - PCA",pos="bottomleft",csub=2)
+plotaux(dat2C,spca2C,sub="dat2C - sPCA loc1",pos="bottomleft",csub=2,axis=2)
+
+par(mfrow=c(2,2))
+plotaux(dat3,pca3,sub="dat3 - PCA axis1",pos="bottomleft",csub=2)
+plotaux(dat3,spca3,sub="dat3 - sPCA glob1",pos="bottomleft",csub=2)
+plotaux(dat3,pca3,sub="dat3 - PCA axis2",pos="bottomleft",csub=2,axis=2)
+plotaux(dat3,spca3,sub="dat3 - sPCA loc1",pos="bottomleft",csub=2,axis=2)
+
+plotaux(dat4,pca4,lab=dat4$other$sup.pop,sub="dat4 - PCA axis1",pos="bottomleft",csub=2)
+plotaux(dat4,spca4,lab=dat4$other$sup.pop,sub="dat4 - sPCA glob1",pos="bottomleft",csub=2)
+plotaux(dat4,pca4,lab=dat4$other$sup.pop,sub="dat4 - PCA axis2",pos="bottomleft",csub=2,axis=2)
+plotaux(dat4,spca4,lab=dat4$other$sup.pop,sub="dat4 - sPCA loc1",pos="bottomleft",csub=2,axis=2)
+
+# color plot
+par(opar)
+colorplot(spca3, cex=4, main="colorplot sPCA dat3")
+text(spca3$xy[,1], spca3$xy[,2], dat3$pop)
+
+colorplot(spca4, cex=4, main="colorplot sPCA dat4")
+text(spca4$xy[,1], spca4$xy[,2], dat4$other$sup.pop)
+
+# detach data
+detach(spcaIllus)
+}
+}
+\keyword{datasets}
+\keyword{spatial}
+
Added: pkg/man/eHGDP.Rd
===================================================================
--- pkg/man/eHGDP.Rd (rev 0)
+++ pkg/man/eHGDP.Rd 2010-02-01 15:32:11 UTC (rev 541)
@@ -0,0 +1,105 @@
+\encoding{UTF-8}
+\name{microbov}
+\alias{microbov}
+\docType{data}
+\title{Microsatellites genotypes of 15 cattle breeds}
+\description{
+This data set gives the genotypes of 704 cattle individuals for 30
+microsatellites recommended by the FAO. The individuals are divided into
+two countries (Afric, France), two species (Bos taurus, Bos indicus) and
+15 breeds. Individuals were chosen in order to avoid pseudoreplication
+according to their exact genealogy.
+}
+\usage{data(microbov)}
+\format{
+ \code{microbov} is a genind object with 3 supplementary components:
+ \describe{
+ \item{coun}{a factor giving the country of each individual (AF:
+ Afric; FR: France).}
+ \item{breed}{a factor giving the breed of each individual.}
+ \item{spe}{is a factor giving the species of each individual
+ (BT: Bos taurus; BI: Bos indicus).}
+ }
+}
+\source{
+Data prepared by Katayoun Moazami-Goudarzi and Denis Lalo\"e (INRA,
+Jouy-en-Josas, France)
+}
+\references{
+ Lalo\"e D., Jombart T., Dufour A.-B. and Moazami-Goudarzi K. (2007)
+ Consensus genetic structuring and typological value of markers using
+ Multiple Co-Inertia Analysis. \emph{Genetics Selection Evolution}.
+ \bold{39}: 545--567.
+}
+\examples{
+data(microbov)
+microbov
+summary(microbov)
+
+# make Y, a genpop object
+Y <- genind2genpop(microbov)
+
+# make allelic frequency table
+temp <- makefreq(Y,missing="mean")
+X <- temp$tab
+nsamp <- temp$nobs
+
+# perform 1 PCA per marker
+
+if(require(ade4)){
+kX <- ktab.data.frame(data.frame(X),Y at loc.nall)
+
+kpca <- list()
+for(i in 1:30) {kpca[[i]] <- dudi.pca(kX[[i]],scannf=FALSE,nf=2,center=TRUE,scale=FALSE)}
+}
+
+sel <- sample(1:30,4)
+col = rep('red',15)
+col[c(2,10)] = 'darkred'
+col[c(4,12,14)] = 'deepskyblue4'
+col[c(8,15)] = 'darkblue'
+
+# display %PCA
+par(mfrow=c(2,2))
+for(i in sel) {
+s.multinom(kpca[[i]]$c1,kX[[i]],n.sample=nsamp[,i],coulrow=col,sub=Y at loc.names[i])
+add.scatter.eig(kpca[[i]]$eig,3,xax=1,yax=2,posi="top")
+}
+
+# perform a Multiple Coinertia Analysis
+kXcent <- kX
+for(i in 1:30) kXcent[[i]] <- as.data.frame(scalewt(kX[[i]],center=TRUE,scale=FALSE))
+mcoa1 <- mcoa(kXcent,scannf=FALSE,nf=3, option="uniform")
+
+# coordinated %PCA
+mcoa.axes <- split(mcoa1$axis,Y at loc.fac)
+mcoa.coord <- split(mcoa1$Tli,mcoa1$TL[,1])
+var.coord <- lapply(mcoa.coord,function(e) apply(e,2,var))
+
+par(mfrow=c(2,2))
+for(i in sel) {
+s.multinom(mcoa.axes[[i]][,1:2],kX[[i]],n.sample=nsamp[,i],coulrow=col,sub=Y at loc.names[i])
+add.scatter.eig(var.coord[[i]],2,xax=1,yax=2,posi="top")
+}
+
+# reference typology
+par(mfrow=c(1,1))
+s.label(mcoa1$SynVar,lab=microbov at pop.names,sub="Reference typology",csub=1.5)
+add.scatter.eig(mcoa1$pseudoeig,nf=3,xax=1,yax=2,posi="top")
+
+# typologial values
+tv <- mcoa1$cov2
+tv <- apply(tv,2,function(c) c/sum(c))*100
+rownames(tv) <- Y at loc.names
+tv <- tv[order(Y at loc.names),]
+
+par(mfrow=c(3,1),mar=c(5,3,3,4),las=3)
+for(i in 1:3){
+barplot(round(tv[,i],3),ylim=c(0,12),yaxt="n",main=paste("Typological value -
+structure",i))
+axis(side=2,at=seq(0,12,by=2),labels=paste(seq(0,12,by=2),"\%"),cex=3)
+abline(h=seq(0,12,by=2),col="grey",lty=2)
+}
+
+}
+\keyword{datasets}
Added: pkg/man/h3n2.Rd
===================================================================
--- pkg/man/h3n2.Rd (rev 0)
+++ pkg/man/h3n2.Rd 2010-02-01 15:32:11 UTC (rev 541)
@@ -0,0 +1,105 @@
+\encoding{UTF-8}
+\name{microbov}
+\alias{microbov}
+\docType{data}
+\title{Microsatellites genotypes of 15 cattle breeds}
+\description{
+This data set gives the genotypes of 704 cattle individuals for 30
+microsatellites recommended by the FAO. The individuals are divided into
+two countries (Afric, France), two species (Bos taurus, Bos indicus) and
+15 breeds. Individuals were chosen in order to avoid pseudoreplication
+according to their exact genealogy.
+}
+\usage{data(microbov)}
+\format{
+ \code{microbov} is a genind object with 3 supplementary components:
+ \describe{
+ \item{coun}{a factor giving the country of each individual (AF:
+ Afric; FR: France).}
+ \item{breed}{a factor giving the breed of each individual.}
+ \item{spe}{is a factor giving the species of each individual
+ (BT: Bos taurus; BI: Bos indicus).}
+ }
+}
+\source{
+Data prepared by Katayoun Moazami-Goudarzi and Denis Lalo\"e (INRA,
+Jouy-en-Josas, France)
+}
+\references{
+ Lalo\"e D., Jombart T., Dufour A.-B. and Moazami-Goudarzi K. (2007)
+ Consensus genetic structuring and typological value of markers using
+ Multiple Co-Inertia Analysis. \emph{Genetics Selection Evolution}.
+ \bold{39}: 545--567.
+}
+\examples{
+data(microbov)
+microbov
+summary(microbov)
+
+# make Y, a genpop object
+Y <- genind2genpop(microbov)
+
+# make allelic frequency table
+temp <- makefreq(Y,missing="mean")
+X <- temp$tab
+nsamp <- temp$nobs
+
+# perform 1 PCA per marker
+
+if(require(ade4)){
+kX <- ktab.data.frame(data.frame(X),Y at loc.nall)
+
+kpca <- list()
+for(i in 1:30) {kpca[[i]] <- dudi.pca(kX[[i]],scannf=FALSE,nf=2,center=TRUE,scale=FALSE)}
+}
+
+sel <- sample(1:30,4)
+col = rep('red',15)
+col[c(2,10)] = 'darkred'
+col[c(4,12,14)] = 'deepskyblue4'
+col[c(8,15)] = 'darkblue'
+
+# display %PCA
+par(mfrow=c(2,2))
+for(i in sel) {
+s.multinom(kpca[[i]]$c1,kX[[i]],n.sample=nsamp[,i],coulrow=col,sub=Y at loc.names[i])
+add.scatter.eig(kpca[[i]]$eig,3,xax=1,yax=2,posi="top")
+}
+
+# perform a Multiple Coinertia Analysis
+kXcent <- kX
+for(i in 1:30) kXcent[[i]] <- as.data.frame(scalewt(kX[[i]],center=TRUE,scale=FALSE))
+mcoa1 <- mcoa(kXcent,scannf=FALSE,nf=3, option="uniform")
+
+# coordinated %PCA
+mcoa.axes <- split(mcoa1$axis,Y at loc.fac)
+mcoa.coord <- split(mcoa1$Tli,mcoa1$TL[,1])
+var.coord <- lapply(mcoa.coord,function(e) apply(e,2,var))
+
+par(mfrow=c(2,2))
+for(i in sel) {
+s.multinom(mcoa.axes[[i]][,1:2],kX[[i]],n.sample=nsamp[,i],coulrow=col,sub=Y at loc.names[i])
+add.scatter.eig(var.coord[[i]],2,xax=1,yax=2,posi="top")
+}
+
+# reference typology
+par(mfrow=c(1,1))
+s.label(mcoa1$SynVar,lab=microbov at pop.names,sub="Reference typology",csub=1.5)
+add.scatter.eig(mcoa1$pseudoeig,nf=3,xax=1,yax=2,posi="top")
+
+# typologial values
+tv <- mcoa1$cov2
+tv <- apply(tv,2,function(c) c/sum(c))*100
+rownames(tv) <- Y at loc.names
+tv <- tv[order(Y at loc.names),]
+
+par(mfrow=c(3,1),mar=c(5,3,3,4),las=3)
+for(i in 1:3){
+barplot(round(tv[,i],3),ylim=c(0,12),yaxt="n",main=paste("Typological value -
+structure",i))
+axis(side=2,at=seq(0,12,by=2),labels=paste(seq(0,12,by=2),"\%"),cex=3)
+abline(h=seq(0,12,by=2),col="grey",lty=2)
+}
+
+}
+\keyword{datasets}
More information about the adegenet-commits
mailing list