[adegenet-commits] r696 - pkg/R

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

Author: jombart
Date: 2010-10-19 18:11:46 +0200 (Tue, 19 Oct 2010)
New Revision: 696

Modified:
   pkg/R/dapc.R
Log:
Added a procedure for 1-dim sctterplot in DAPC


Modified: pkg/R/dapc.R
===================================================================
--- pkg/R/dapc.R	2010-10-19 15:31:18 UTC (rev 695)
+++ pkg/R/dapc.R	2010-10-19 16:11:46 UTC (rev 696)
@@ -268,11 +268,30 @@
 ##############
 scatter.dapc <- function(x, xax=1, yax=2, col=rainbow(length(levels(x$grp))), posi="bottomleft", bg="grey", ratio=0.3, csub=1.2, ...){
     if(!require(ade4, quiet=TRUE)) stop("ade4 library is required.")
-    axes <- c(xax,yax)
-    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$loadings), axes[1], axes[2], posi=posi, ratio=ratio, csub=csub)
+    ONEDIM <- xax==yax | ncol(x$ind.coord)==1
+
+    if(!ONEDIM){
+        axes <- c(xax,yax)
+        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$loadings), axes[1], axes[2], posi=posi, ratio=ratio, csub=csub)
+        }
+    } else {
+        ## get densities
+        ldens <- tapply(x$ind.coord[,1], x$grp, density)
+        allx <- unlist(lapply(ldens, function(e) e$x))
+        ally <- unlist(lapply(ldens, function(e) e$y))
+        if(ncol(x$ind.coord)==1) {
+            pcLab <- 1
+        } else{
+            pcLab <- xax
+        }
+        par(bg=bg)
+        plot(allx, ally, type="n", xlab=paste("Discriminant function", pcLab), ylab="Density")
+        for(i in 1:length(ldens)){
+            lines(ldens[[i]]$x,ldens[[i]]$y, col=col[i], lwd=2)
+        }
     }
     return(invisible(match.call()))
 } # end scatter.dapc