[adegenet-commits] r177 - in pkg: . R man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Sun Sep 14 15:22:27 CEST 2008


Author: jombart
Date: 2008-09-14 15:22:27 +0200 (Sun, 14 Sep 2008)
New Revision: 177

Added:
   pkg/man/colorplot.Rd
Modified:
   pkg/R/colorplot.R
   pkg/R/spca.R
   pkg/TODO
   pkg/man/spca.Rd
   pkg/man/spcaIllus.Rd
Log:
colorplot implemented ; check is Ok with R 2.7.1


Modified: pkg/R/colorplot.R
===================================================================
--- pkg/R/colorplot.R	2008-09-10 14:13:25 UTC (rev 176)
+++ pkg/R/colorplot.R	2008-09-14 13:22:27 UTC (rev 177)
@@ -1,7 +1,29 @@
-colorplot <- function(xy, X, axes=1:ncol(X), add.plot=FALSE, defaultLevel=0, ...){
+##
+## COLOR PLOT
+##
+## used to plot up to 3 variables in space using RGB system
+##
+## all coded in S3 method (arguments vary largely)
+##
 
+
+##########
+# generic
+##########
+colorplot <- function(...){
+    UseMethod("colorplot")
+}
+
+
+
+#################
+# default method
+#################
+colorplot.default <- function(xy, X, axes=1:ncol(X), add.plot=FALSE, defaultLevel=0, ...){
+
     ## some checks
     if(any(is.na(xy))) stop("NAs exist in xy")
+    xy <- as.matrix(xy)
     if(!is.numeric(xy)) stop("xy is not numeric")
     if(nrow(xy) != nrow(X)) stop("xy and X have different row numbers")
     X <- as.matrix(X[,axes,drop=FALSE])
@@ -11,7 +33,9 @@
 
     ## function mapping x to [0,+inf[
     f1 <- function(x){
-        x <- x + abs(min(x))
+        if(any(x<0)) {
+            x <- x + abs(min(x))
+        }
         return(x)
     }
 
@@ -19,16 +43,26 @@
     X <- apply(X, 2, f1)
 
     v1 <- X[,1]
-    if(ncol(X)==2) {v2 <- X[,2]} else {v2 <- defaultLevel}
-    if(ncol(X)==3) {v2 <- X[,3]} else {v3 <- defaultLevel}
+    if(ncol(X)>=2) {v2 <- X[,2]} else {v2 <- defaultLevel}
+    if(ncol(X)>=3) {v3 <- X[,3]} else {v3 <- defaultLevel}
 
-    ## find the colors
+    ## make colors
     col <- rgb(v1, v2, v3, maxColorValue=max(X))
 
+    ## handle ...
+    listArgs <- list(...)
+    if(is.null(listArgs$pch)) {listArgs$pch <- 20}
+
+    ## build list of arguments
+    listArgs$x <- xy
+    listArgs$col <- col
+    
     ## plot data
     if(!add.plot) {
-        plot(xy, pch=20, col=col, ...)
+        do.call(plot,listArgs)
     } else {
-        points(xy, pch=20, col=col, ...)
+        do.call(points,listArgs)
     }
-}
+
+    return(invisible(match.call()))
+} # end colorplot.default

Modified: pkg/R/spca.R
===================================================================
--- pkg/R/spca.R	2008-09-10 14:13:25 UTC (rev 176)
+++ pkg/R/spca.R	2008-09-14 13:22:27 UTC (rev 177)
@@ -398,3 +398,28 @@
   
   return(invisible(match.call()))
 }
+
+
+
+
+
+###################
+# colorplot method
+###################
+colorplot.spca <- function(x, axes=1:ncol(x$li), useLag=FALSE, ...){
+    ## some checks
+    if(!any(inherits(x,"spca"))) stop("x in not a spca object.")
+
+    ## get args to be passed to colorplot
+    xy <- x$xy
+
+    if(useLag) {
+        X <- as.matrix(x$ls)
+    } else {
+        X <- as.matrix(x$li)
+    }
+
+    ## call to colorplot
+    colorplot(xy, X, axes, ...)
+
+} # end colorplot.spca

Modified: pkg/TODO
===================================================================
--- pkg/TODO	2008-09-10 14:13:25 UTC (rev 176)
+++ pkg/TODO	2008-09-14 13:22:27 UTC (rev 177)
@@ -35,7 +35,7 @@
 
 # NEW IMPLEMENTATIONS:
 =====================
-* color plot for the sPCA results, based on RGB representation of Cavalli-Sforza
+* color plot for the sPCA results, based on RGB representation of Cavalli-Sforza -- done(TJ)
 
 
 # TESTING:

Added: pkg/man/colorplot.Rd
===================================================================
--- pkg/man/colorplot.Rd	                        (rev 0)
+++ pkg/man/colorplot.Rd	2008-09-14 13:22:27 UTC (rev 177)
@@ -0,0 +1,58 @@
+\name{colorplot}
+\alias{colorplot}
+\alias{colorplot.default}
+\title{Represents a cloud of points with colors}
+\description{
+  The \code{colorplot} function represents a cloud of points with colors
+  corresponding to a combination of 1,2 or 3 quantitative variables,
+  assigned to RGB (Red, Green, Blue) channels. For instance, this can be useful to
+  represent up to 3 principal components in space. Note that the
+  property of such representation to convey multidimensional information
+  has not been investigated.\cr
+
+  \code{colorplot} is a S3 generic function. Methods are defined for
+  particular objects, like \code{\link{spca}} objects.
+
+}
+\usage{
+colorplot(\dots)
+
+\method{colorplot}{default}(xy, X, axes=1:ncol(X), add.plot=FALSE, defaultLevel=0, \dots)
+}
+\arguments{
+  \item{xy}{a numeric matrix with two columns (e.g. a matrix of spatial coordinates.}
+  \item{X}{a matrix-like containing numeric values that are translated
+    into the RGB system. Variables are considered to be in columns.}
+  \item{axes}{the index of the columns of X to be represented. Up to
+    three axes can be chosen.}
+  \item{add.plot}{a logical stating whether the colorplot should be
+    added to the existing plot (defaults to FALSE).}
+  \item{defaultLevel}{a numeric value between 0 and 1, giving the
+    default level in a color for which values are not specified. Used
+    whenever less than three axes are specified.}
+  \item{\dots}{further arguments to be passed to other methods. In
+    \code{colorplot.default}, these arguments are passed to plot/points
+    functions. See \code{?plot.default} and \code{?points}.}
+}
+\value{
+  Invisibly returns the matched call. 
+}
+\author{Thibaut Jombart \email{jombart at biomserv.univ-lyon1.fr}}
+\examples{
+# a toy example
+xy <- expand.grid(1:10,1:10)
+df <- data.frame(x=1:100, y=100:1, z=runif(100,0,100))
+colorplot(xy,df,cex=10,main="colorplot: toy example")
+
+# a genetic example using a sPCA
+if(require(spdep) & require(ade4)){
+data(spcaIllus)
+dat3 <- spcaIllus$dat3
+spca3 <- spca(dat3,xy=dat3$other$xy,ask=FALSE,type=1,plot=FALSE,scannf=FALSE,nfposi=1,nfnega=1)
+colorplot(spca3, cex=4, main="colorplot: a sPCA example")
+text(spca3$xy[,1], spca3$xy[,2], dat3$pop)
+mtext("P1-P2 in cline\tP3 random \tP4 local repulsion")
+}
+}
+\keyword{multivariate}
+\keyword{hplot}

Modified: pkg/man/spca.Rd
===================================================================
--- pkg/man/spca.Rd	2008-09-10 14:13:25 UTC (rev 176)
+++ pkg/man/spca.Rd	2008-09-14 13:22:27 UTC (rev 177)
@@ -5,6 +5,7 @@
 \alias{summary.spca}
 \alias{plot.spca}
 \alias{screeplot.spca}
+\alias{colorplot.spca}
 \title{Spatial principal component analysis}
 \description{These functions are designed to perform a spatial principal
   component analysis and to display the results. They call upon
@@ -15,8 +16,8 @@
   
   - \code{print.spca}: prints the spca content\cr
   
-  - \code{summary.spca}: gives variance and autocorrelation
-  statistics\cr
+  - \code{summary.spca}: gives variance and autocorrelation\cr
+  statistics
   
   - \code{plot.spca}: usefull graphics (connection network, 3 different
   representations of map of scores, eigenvalues barplot and
@@ -24,11 +25,14 @@
   
   - \code{screeplot.spca}: decomposes spca eigenvalues into variance and
   autocorrelation\cr
+
+  - \code{colorplot.spca}: represents principal components of sPCA in
+  space using the RGB system.\cr
 }
 \usage{
-spca(obj, xy=NULL, cn=NULL, scale=FALSE, scannf=TRUE, nfposi=1, nfnega=1, type=NULL, ask=TRUE,
-plot.nb=TRUE, edit.nb=FALSE ,truenames=TRUE, d1=NULL, d2=NULL, k=NULL,
-  a=NULL, dmin=NULL)
+spca(obj, xy=NULL, cn=NULL, scale=FALSE, scannf=TRUE, nfposi=1,
+  nfnega=1, type=NULL, ask=TRUE,plot.nb=TRUE, edit.nb=FALSE
+  ,truenames=TRUE, d1=NULL, d2=NULL, k=NULL, a=NULL, dmin=NULL)
 
 \method{print}{spca}(x, \dots)
 
@@ -37,6 +41,8 @@
 \method{plot}{spca}(x, axis = 1, \dots)
 
 \method{screeplot}{spca}(x, \dots, main=NULL)
+
+\method{colorplot}{spca}(x, axes=1:ncol(x$li), useLag=FALSE, \dots)
 }
 \arguments{
   \item{obj}{a \code{genind} or \code{genpop} object.}
@@ -87,6 +93,10 @@
   \item{main}{a title for the screeplot; if NULL, a default one is
     used.}
   \item{\dots}{further arguments passed to other methods.}
+  \item{axes}{the index of the columns of X to be represented. Up to
+    three axes can be chosen.}
+  \item{useLag}{a logical stating whether the lagged components
+    (\code{x\$ls}) should be used instead of the components (\code{x\$li}).}
 }
 \details{The spatial principal component analysis (sPCA) is designed to
   investigate spatial patterns in the genetic variability. Given

Modified: pkg/man/spcaIllus.Rd
===================================================================
--- pkg/man/spcaIllus.Rd	2008-09-10 14:13:25 UTC (rev 176)
+++ pkg/man/spcaIllus.Rd	2008-09-14 13:22:27 UTC (rev 177)
@@ -103,6 +103,13 @@
 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
+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)
 }



More information about the adegenet-commits mailing list