[adegenet-commits] r855 - pkg/R

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

Author: jombart
Date: 2011-03-29 23:33:41 +0200 (Tue, 29 Mar 2011)
New Revision: 855

Modified:
   pkg/R/dapc.R
Log:
predict.dapc seems to work


Modified: pkg/R/dapc.R
===================================================================
--- pkg/R/dapc.R	2011-03-29 20:58:02 UTC (rev 854)
+++ pkg/R/dapc.R	2011-03-29 21:33:41 UTC (rev 855)
@@ -780,20 +780,30 @@
         }
 
         ## project as supplementary individuals
-        XU <- newdata %*% object$pca.loadings
+        XU <- newdata %*% as.matrix(object$pca.loadings)
     } else {
         XU <- object$tab
     }
 
+    ## FORCE IDENTICAL VARIABLE NAMES ##
+    colnames(XU) <- colnames(object$tab)
 
+
     ## HANDLE DIMEN ##
     if(!missing(dimen)){
         if(dimen > object$n.da) stop(paste("Too many dimensions requested. \nOnly", object$n.da, "discriminant functions were saved in DAPC."))
     }
 
     ## CALL PREDICT.LDA ##
-    res <- predict(x, XU, prior, dimen, method, ...)
+    temp <- predict(x, XU, prior, dimen, method, ...)
 
+
+    ## FORMAT OUTPUT ##
+    res <- list()
+    res$assign <- temp$class
+    res$posterior <- temp$posterior
+    res$ind.scores <- temp$x
+
     return(res)
 
 } # end predict.dapc
@@ -821,3 +831,24 @@
 ## ##randtest.dapc <- function(x, nperm = 999, ...){
 
 ## ##} # end randtest.dapc
+
+
+
+
+######## TESTS IN R #######
+
+## TEST PREDICT.DAPC ##
+data(sim2pop)
+dat <- sim2pop[70:130]
+temp <- seppop(sim2pop)
+hyb <- hybridize(temp[[1]], temp[[2]], n=20)
+newdat <- repool(dat,hyb)
+
+dapc1 <- dapc(newdat[1:61],n.pca=10,n.da=1)
+scatter(dapc1)
+
+hyb.pred <- predict(dapc1, newdat[62:81])
+points(hyb.pred$ind.scores, rep(.1,5))
+
+
+