[adegenet-commits] r768 - pkg/R

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

Author: jombart
Date: 2011-01-18 19:34:37 +0100 (Tue, 18 Jan 2011)
New Revision: 768

Modified:
   pkg/R/SNPbin.R
   pkg/R/glFunctions.R
Log:
mc.preschedule=FALSE to avoid duplicating memory


Modified: pkg/R/SNPbin.R
===================================================================
--- pkg/R/SNPbin.R	2011-01-18 16:16:30 UTC (rev 767)
+++ pkg/R/SNPbin.R	2011-01-18 18:34:37 UTC (rev 768)
@@ -182,7 +182,8 @@
             }
             ##input$gen <- lapply(1:nrow(input$gen), function(i) as.integer(input$gen[i,]))
             if(multicore){
-                x at gen <- mclapply(1:nrow(input$gen), function(i) new("SNPbin", as.integer(input$gen[i,])), mc.cores=n.cores, mc.silent=TRUE, mc.cleanup=TRUE)
+                x at gen <- mclapply(1:nrow(input$gen), function(i) new("SNPbin", as.integer(input$gen[i,])),
+                                  mc.cores=n.cores, mc.silent=TRUE, mc.cleanup=TRUE, mc.preschedule=FALSE)
             } else {
                 x at gen <- lapply(1:nrow(input$gen), function(i) new("SNPbin", as.integer(input$gen[i,])) )
             }
@@ -209,7 +210,7 @@
 
             ## create SNPbin list
             if(multicore){
-                x at gen <- mclapply(input$gen, function(e) new("SNPbin",e), mc.cores=n.cores, mc.silent=TRUE, mc.cleanup=TRUE)
+                x at gen <- mclapply(input$gen, function(e) new("SNPbin",e), mc.cores=n.cores, mc.silent=TRUE, mc.cleanup=TRUE, mc.preschedule=FALSE)
             } else {
                 x at gen <- lapply(input$gen, function(e) new("SNPbin",e))
             }
@@ -737,9 +738,9 @@
 
 
 ## SIMPLE TESTS
-dat <- c(1,0,0,1,0,0,1,1,1,0,1)
-x <- new("SNPbin",dat)$snp[[1]]
-as.integer(x)==dat
+## dat <- c(1,0,0,1,0,0,1,1,1,0,1)
+## x <- new("SNPbin",dat)$snp[[1]]
+## as.integer(x)==dat
 
 
 ## library(adegenet)

Modified: pkg/R/glFunctions.R
===================================================================
--- pkg/R/glFunctions.R	2011-01-18 16:16:30 UTC (rev 767)
+++ pkg/R/glFunctions.R	2011-01-18 18:34:37 UTC (rev 768)
@@ -230,7 +230,7 @@
     allComb <- combn(1:nInd(x), 2)
     if(multicore){
         allProd <- unlist(mclapply(1:ncol(allComb), function(i) dotProd(x at gen[[allComb[1,i]]], x at gen[[allComb[2,i]]], myPloidy[allComb[1,i]], myPloidy[allComb[2,i]]),
-                                   mc.cores=n.cores, mc.silent=TRUE, mc.cleanup=TRUE))
+                                   mc.cores=n.cores, mc.silent=TRUE, mc.cleanup=TRUE, mc.preschedule=FALSE))
     } else {
         allProd <- unlist(lapply(1:ncol(allComb), function(i) dotProd(x at gen[[allComb[1,i]]], x at gen[[allComb[2,i]]], myPloidy[allComb[1,i]], myPloidy[allComb[2,i]]) ))
     }
@@ -246,7 +246,7 @@
     ## compute the diagonal
     if(multicore){
         temp <- unlist(mclapply(1:nInd(x), function(i) dotProd(x at gen[[i]], x at gen[[i]], myPloidy[i], myPloidy[i]),
-                                mc.cores=n.cores, mc.silent=TRUE, mc.cleanup=TRUE))/nInd(x)
+                                mc.cores=n.cores, mc.silent=TRUE, mc.cleanup=TRUE, mc.preschedule=FALSE))/nInd(x)
     } else {
         temp <- unlist(lapply(1:nInd(x), function(i) dotProd(x at gen[[i]], x at gen[[i]], myPloidy[i], myPloidy[i]) ))/nInd(x)
     }
@@ -389,10 +389,16 @@
 
 ## ## LARGE SCALE TEST ##
 ## ## perform glPca
-## M <- matrix(sample(c(0,1), 50*1e5, replace=TRUE), nrow=50)
-## x <- new("genlight",M)
-## toto <- glPca(x, nf=4, multicore=FALSE)
+M <- matrix(sample(c(0,1), 100*1e6, replace=TRUE), nrow=100)
+x <- new("genlight",M)
+system.time(toto <- glPca(x, nf=4, n.core=6))
+system.time(titi <- dudi.pca(M,center=TRUE,scale=FALSE, scannf=FALSE, nf=4))
 
-## round(cor(toto$scores),10) # must be diag(1,4)
-## round(t(toto$loadings) %*% toto$loadings,10) # must be diag(1,4)
 
+
+round(cor(toto$scores),10) # must be diag(1,4)
+round(t(toto$loadings) %*% toto$loadings,10) # must be diag(1,4)
+
+## comparison ade4 / adegenet
+all(round(abs(titi$c1),8) == round(abs(toto$loadings),8))
+all(round(abs(titi$li),8) == round(abs(toto$scores),8))