[adegenet-commits] r184 - in pkg: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Oct 2 13:13:09 CEST 2008
Author: jombart
Date: 2008-10-02 13:13:09 +0200 (Thu, 02 Oct 2008)
New Revision: 184
Added:
pkg/R/loadingplot.R
pkg/man/loadingplot.Rd
Modified:
pkg/DESCRIPTION
pkg/R/spca.R
Log:
Added the loadingplot function and documentation.
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2008-09-30 16:35:07 UTC (rev 183)
+++ pkg/DESCRIPTION 2008-10-02 11:13:09 UTC (rev 184)
@@ -9,4 +9,4 @@
Description: Classes and functions for genetic data analysis within the multivariate framework.
License: GPL (>=2)
LazyLoad: yes
-Collate: classes.R auxil.R genind2genpop.R propTyped.R basicMethods.R old2new.R makefreq.R chooseCN.R dist.genpop.R export.R setAs.R gstat.randtest.R HWE.R import.R monmonier.R coords.monmonier.R spca.R spca.rtests.R zzz.R hybridize.R fstat.R propShared.R scale.R colorplot.R
+Collate: classes.R auxil.R genind2genpop.R propTyped.R basicMethods.R old2new.R makefreq.R chooseCN.R dist.genpop.R export.R setAs.R gstat.randtest.R HWE.R import.R monmonier.R coords.monmonier.R spca.R spca.rtests.R zzz.R hybridize.R fstat.R propShared.R scale.R colorplot.R loadingplot.R
Added: pkg/R/loadingplot.R
===================================================================
--- pkg/R/loadingplot.R (rev 0)
+++ pkg/R/loadingplot.R 2008-10-02 11:13:09 UTC (rev 184)
@@ -0,0 +1,62 @@
+##############
+# loadingplot
+##############
+loadingplot <- function(x, threshold=quantile(x,0.75), axis=1, fac=NULL,
+ lab=names(x), cex.lab=0.7, cex.fac=1, lab.jitter=0,
+ main="Loading plot", xlab="Variables", ylab="Loadings",...){
+ ## some checks
+ if(is.data.frame(x) || is.matrix(x)){
+ temp <- rownames(x)
+ x <- x[,axis]
+ names(x) <- temp
+ }
+ if(!is.numeric(x)) stop("x is not numeric")
+ if(any(is.na(x))) stop("NA entries in x")
+ if(any(x<0)) {
+ warning("Some values in x are less than 0\n Using abs(x) instead, but this might not be optimal.")
+ x <- abs(x)
+ }
+
+ ## preliminary computations
+ y.min <- min(min(x),0)
+ y.max <- max(max(x),0)
+ y.offset <- (y.max-y.min)*0.02
+ if(is.null(lab)) {lab <- 1:length(x)}
+
+ if(!is.null(fac)){
+ fac <- factor(fac, levels=unique(fac))
+ grp.idx <- cumsum(table(fac)) + 0.5
+ grp.lab.idx <- tapply(1:length(x), fac, mean)
+ grp.lab <- names(grp.idx)
+ grp.idx <- grp.idx[-length(grp.idx)]
+ } # end fac handling
+
+ ## start the plot
+ plot(x, type="h", xlab=xlab, ylab=ylab,
+ main=main, xaxt="n", ylim=c(y.min,y.max*1.2), ...)
+
+ ## add groups of variables (optional)
+ if(!is.null(fac)) {
+ abline(v=grp.idx,lty=2) # split groups of variables
+ text(x=grp.lab.idx,y=y.max*1.15, labels=grp.lab, cex=cex.fac) # annotate groups
+ }
+
+ ## annotate variables that are above the threshold
+ x.ann <- which(x > threshold)
+ x.ann <- jitter(x.ann,fac=lab.jitter)
+ y.ann <- x[x > threshold] + y.offset
+ y.ann <- jitter(y.ann,fac=lab.jitter)
+ txt.ann <- lab[x > threshold]
+ text(x=x.ann, y=y.ann, label=txt.ann, cex=cex.lab)
+
+ ## indicate the threshold
+ abline(h=threshold, col="grey")
+
+ ## build the result
+ res <- list(threshold=threshold,
+ var.names=txt.ann,
+ var.idx=which(x > threshold),
+ var.values=x[x > threshold])
+ return(invisible(res))
+
+} # end loadingplot
Modified: pkg/R/spca.R
===================================================================
--- pkg/R/spca.R 2008-09-30 16:35:07 UTC (rev 183)
+++ pkg/R/spca.R 2008-10-02 11:13:09 UTC (rev 184)
@@ -72,8 +72,10 @@
}
if(truenames){
- rownames(X) <- rownames(truenames(obj))
- colnames(X) <- colnames(truenames(obj))
+ temp <- truenames(obj) # ! can return a list or a matrix
+ if(is.list(temp)) {temp <- temp$tab}
+ rownames(X) <- rownames(temp)
+ colnames(X) <- colnames(temp)
}
# perform analyses
@@ -95,11 +97,16 @@
posaxes <- if(nfposi>0) {1:nfposi} else NULL
negaxes <- if(nfnega>0) {(length(spcaX$eig)-nfnega+1):length(spcaX$eig)} else NULL
keptaxes <- c(posaxes,negaxes)
-
+
+ ## set names of different components
colnames(spcaX$c1) <- paste("Axis",keptaxes)
colnames(spcaX$li) <- paste("Axis",keptaxes)
colnames(spcaX$ls) <- paste("Axis",keptaxes)
-
+ row.names(spcaX$c1) <- colnames(X)
+ colnames(spcaX$as) <- colnames(spcaX$c1)
+ temp <- row.names(spcaX$as)
+ row.names(spcaX$as) <- paste("PCA",temp)
+
class(spcaX) <- "spca"
return(spcaX)
Added: pkg/man/loadingplot.Rd
===================================================================
--- pkg/man/loadingplot.Rd (rev 0)
+++ pkg/man/loadingplot.Rd 2008-10-02 11:13:09 UTC (rev 184)
@@ -0,0 +1,61 @@
+\name{loadingplot}
+\alias{loadingplot}
+\alias{loadingplot.default}
+\title{Represents a cloud of points with colors}
+\description{
+ The \code{loadingplot} function represents positive values of a vector
+ and identifies the values above a given threshold. It can also
+ indicate groups of observations provided as a factor. \cr
+
+ Such graphics can be used, for instance, to assess the weight of each
+ variable (loadings) in a given analysis.
+}
+\usage{
+loadingplot(x, threshold=quantile(x,0.75), axis=1, fac=NULL,
+ lab=names(x), cex.lab=0.7, cex.fac=1, lab.jitter=0,
+ main="Loading plot", xlab="Variables", ylab="Loadings",\dots)
+
+}
+\arguments{
+ \item{x}{either a vector with numeric values to be plotted, or a
+ matrix-like object containing numeric values. In such case, the
+ \code{x[,axis]} is used as vector of values to be plotted.}
+ \item{threshold}{a threshold value above which values of x are
+ identified. By default, this is the third quartile of x.}
+ \item{axis}{an integer indicating the column of x to be plotted; used
+ only if x is a matrix-like object.}
+ \item{fac}{a factor defining groups of observations.}
+ \item{lab}{a character vector giving the labels used to annotate
+ values above the threshold.}
+ \item{cex.lab}{a numeric value indicating the size of annotations.}
+ \item{cex.fac}{a numeric value indicating the size of annotations for
+ groups of observations.}
+ \item{lab.jitter}{a numeric value indicating the factor of
+ randomisation for the position of annotations. Set to 0 (by default)
+ implies no randomisation.}
+ \item{main}{the main title of the figure.}
+ \item{xlab}{the title of the x axis.}
+ \item{ylab}{the title of the y axis.}
+ \item{\dots}{further arguments to be passed to the plot function.}
+}
+ \value{
+ Invisibly returns a list with the following components:\cr
+ - threshold: the threshold used\cr
+ - var.names: the names of observations above the threshold\cr
+ - var.idx: the indices of observations above the threshold\cr
+ - var.values: the values above the threshold\cr
+}
+\author{Thibaut Jombart \email{jombart at biomserv.univ-lyon1.fr}}
+\examples{
+x <- runif(20)
+names(x) <- letters[1:20]
+grp <- factor(paste("group", rep(1:4,each=5)))
+
+## basic plot
+loadingplot(x)
+
+## adding groups
+loadingplot(x,fac=grp,main="My title",cex.lab=1)
+}
+\keyword{multivariate}
+\keyword{hplot}
More information about the adegenet-commits
mailing list