[adegenet-commits] r504 - pkg/R

[noreply at r-forge.r-project.org]

Author: jombart
Date: 2009-12-01 21:51:09 +0100 (Tue, 01 Dec 2009)
New Revision: 504

Modified:
   pkg/R/dapc.R
Log:
assignplot works fine!


Modified: pkg/R/dapc.R
===================================================================
--- pkg/R/dapc.R	2009-12-01 19:10:59 UTC (rev 503)
+++ pkg/R/dapc.R	2009-12-01 20:51:09 UTC (rev 504)
@@ -299,8 +299,42 @@
 ############
 ## assignplot
 ############
-assignplot <- function(x, pop=NULL){
+assignplot <- function(x, only.pop=NULL, cex.lab=.75, pch=3){
+    if(!require(ade4, quiet=TRUE)) stop("ade4 library is required.")
+    if(!inherits(x, "dapc")) stop("x is not a dapc object")
 
+    if(!is.null(only.pop)){
+        only.pop <- as.character(only.pop)
+        myPop <- as.character(x$fac)
+        x$assign <- x$assign[only.pop==myPop]
+        x$posterior <- x$posterior[only.pop==myPop, , drop=FALSE]
+    }
+
+
+    ##table.paint(x$posterior, col.lab=myPop, ...)
+    ## symbols(x$posterior)
+
+
+    ## FIND PLOT PARAMETERS
+    n.pop <- ncol(x$posterior)
+    n.ind <- nrow(x$posterior)
+    Z <- t(x$posterior)
+    Z <- Z[,ncol(Z):1 ]
+
+    image(x=1:n.pop, y=seq(.5, by=1, le=n.ind), Z, col=rev(heat.colors(100)), yaxt="n", ylab="", xaxt="n", xlab="Clusters")
+    axis(side=1, at=1:n.pop,tick=FALSE, label=colnames(x$posterior))
+    axis(side=2, at=1:n.ind, label=rev(rownames(x$posterior)), las=1, cex.axis=cex.lab)
+    abline(h=1:n.ind, col="lightgrey")
+    abline(v=seq(0.5, by=1, le=n.pop))
+    box()
+
+    myPop <- colnames(x$posterior)
+    x.real.coord <- rev(match(as.character(x$assign), myPop))
+    y.real.coord <- seq(.5, by=1, le=n.ind)
+
+    points(x.real.coord, y.real.coord, col="deepskyblue2", pch=pch)
+
+    return(invisible())
 } # end assignplot