[adegenet-commits] r682 - pkg/R

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

Author: jombart
Date: 2010-10-06 17:07:05 +0200 (Wed, 06 Oct 2010)
New Revision: 682

Modified:
   pkg/R/dapc.R
Log:
Added a dudi method for DAPC. 
Now DAPC can use any pre-defined multivariate method (speeds up computations when having to run multiple analyses with different n.pca).


Modified: pkg/R/dapc.R
===================================================================
--- pkg/R/dapc.R	2010-10-01 09:53:27 UTC (rev 681)
+++ pkg/R/dapc.R	2010-10-06 15:07:05 UTC (rev 682)
@@ -8,7 +8,7 @@
 #################
 dapc.data.frame <- function(x, grp, n.pca=NULL, n.da=NULL,
                             center=TRUE, scale=FALSE, var.contrib=FALSE,
-                            pca.select=c("nbEig","percVar"), perc.pca=NULL, ...){
+                            pca.select=c("nbEig","percVar"), perc.pca=NULL, ..., dudi=NULL){
 
     ## FIRST CHECKS
     if(!require(ade4, quiet=TRUE)) stop("ade4 library is required.")
@@ -18,22 +18,27 @@
     pca.select <- match.arg(pca.select)
     if(!is.null(perc.pca) & is.null(n.pca)) pca.select <- "percVar"
     if(is.null(perc.pca) & !is.null(n.pca)) pca.select <- "nbEig"
+    if(!is.null(dudi) && !inherits(dudi, "dudi")) stop("dudi provided, but not of class 'dudi'")
 
 
     ## SOME GENERAL VARIABLES
     N <- nrow(x)
 
-    ## PERFORM PCA ##
-    maxRank <- min(dim(x))
 
-    pcaX <- dudi.pca(x, center = center, scale = scale, scannf = FALSE, nf=maxRank)
+    if(is.null(dudi)){ # if no dudi provided
+        ## PERFORM PCA ##
+        maxRank <- min(dim(x))
+        pcaX <- dudi.pca(x, center = center, scale = scale, scannf = FALSE, nf=maxRank)
+    } else { # else use the provided dudi
+        pcaX <- dudi
+    }
     cumVar <- 100 * cumsum(pcaX$eig)/sum(pcaX$eig)
 
     ## select the number of retained PC for PCA
     if(is.null(n.pca) & pca.select=="nbEig"){
-            plot(cumVar, xlab="Number of retained PCs", ylab="Cumulative variance (%)", main="Variance explained by PCA")
-            cat("Choose the number PCs to retain (>=1): ")
-            n.pca <- as.integer(readLines(n = 1))
+        plot(cumVar, xlab="Number of retained PCs", ylab="Cumulative variance (%)", main="Variance explained by PCA")
+        cat("Choose the number PCs to retain (>=1): ")
+        n.pca <- as.integer(readLines(n = 1))
     }
 
     if(is.null(perc.pca) & pca.select=="percVar"){
@@ -165,6 +170,15 @@
 
 
 
+##################
+# Function dapc.dudi
+##################
+dapc.dudi <- function(x, grp, ...){
+    return(dapc.data.frame(x$li, grp, dudi=x, ...))
+}
+
+
+
 ######################
 # Function print.dapc
 ######################