[adegenet-commits] r381 - pkg/R

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

Author: jombart
Date: 2009-06-08 17:26:42 +0200 (Mon, 08 Jun 2009)
New Revision: 381

Modified:
   pkg/R/seqTrack.R
Log:
Added get.result.by, which can translate results from seqTrack and optimize...
by DNA sequence, spatial coords, or whatever else.


Modified: pkg/R/seqTrack.R
===================================================================
--- pkg/R/seqTrack.R	2009-06-08 10:59:23 UTC (rev 380)
+++ pkg/R/seqTrack.R	2009-06-08 15:26:42 UTC (rev 381)
@@ -617,7 +617,58 @@
 
 
 
+
 #################
+## get.result.by
+#################
+get.result.by <- function(x, bydat){
+    dat <- bydat
+
+    ## define new values
+    if(class(dat)=="DNAbin"){
+        if(!is.matrix(dat)) dat <- as.matrix(dat)
+        dat <- as.character(dat)
+    }
+
+    ori.dim <- dim(dat)
+    dat <- as.character(bydat)
+    dim(dat) <- ori.dim
+
+    newval <- apply(dat, 1, function(vec) paste(vec, collapse=""))
+    newval <- unclass(factor(newval))
+    newlev <- levels(newval)
+
+
+    ## if x is a single output of seqTrack
+    if(is.vector(x$ances)){
+        newId <- newval # new values
+        newAnces <- newval[x$ances] # new values
+        ## make output
+        res <- x
+        res$id <- newId
+        res$ances <- newAnces
+        attr(res$ances, "levels") <- newlev
+    }
+
+
+    ## if x is an optimize.seqTrack output
+    if(is.matrix(x$ances)){
+        res <- x
+        ori.ncol <- ncol(res$ances)
+        res$ances <- matrix(newval[res$ances], ncol=ori.ncol)
+        attr(res$ances, "levels") <- newlev
+    }
+
+    return(res)
+
+} # end get.result.by
+
+
+
+
+
+
+#################
 ## get.consensus
 #################
 get.consensus <- function(listres){