[adegenet-commits] r572 - pkg/R

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

Author: jombart
Date: 2010-02-17 19:44:54 +0100 (Wed, 17 Feb 2010)
New Revision: 572

Modified:
   pkg/R/haploGen.R
   pkg/R/seqTrack.R
Log:
Adjustment to graphNEL conversions.


Modified: pkg/R/haploGen.R
===================================================================
--- pkg/R/haploGen.R	2010-02-17 17:00:58 UTC (rev 571)
+++ pkg/R/haploGen.R	2010-02-17 18:44:54 UTC (rev 572)
@@ -592,8 +592,18 @@
 ##########################
 setOldClass("haploGen")
 setAs("haploGen", "graphNEL", def=function(from){
+    if(!require(ape)) stop("package ape is required")
+    if(!require(graph)) stop("package graph is required")
+
     N <- length(from$ances)
     areNA <- is.na(from$ances)
-    res <- ftM2graphNEL(cbind(from$ances[!areNA], (1:N)[!areNA]))
+
+    ## EXTRACT WEIGHTS (nb of mutations)
+    M <- as.matrix(dist.dna(from$seq, model="raw")*ncol(from$seq))
+    w <- mapply(function(i,j) {M[i, j]}, i=as.integer(from$ances[!areNA]), j=(1:N)[!areNA])
+
+
+    ## CONVERT TO GRAPH
+    res <- ftM2graphNEL(ft=cbind(from$ances[!areNA], (1:N)[!areNA]), W=w, edgemode = "directed")
     return(res)
 })

Modified: pkg/R/seqTrack.R
===================================================================
--- pkg/R/seqTrack.R	2010-02-17 17:00:58 UTC (rev 571)
+++ pkg/R/seqTrack.R	2010-02-17 18:44:54 UTC (rev 572)
@@ -1128,9 +1128,13 @@
 ##########################
 setOldClass("seqTrack")
 setAs("seqTrack", "graphNEL", def=function(from){
-    N <- nrow(from)
-    from <- from[!is.na(from$ances), ]
-    res <- ftM2graphNEL(cbind(from$ances, from$id))
+    if(!require(ape)) stop("package ape is required")
+    if(!require(graph)) stop("package graph is required")
+
+    from <- from[!is.na(from$ances),,drop=FALSE]
+
+    ## CONVERT TO GRAPH
+    res <- ftM2graphNEL(ft=cbind(from$ances, from$id), W=from$weight, edgemode = "directed")
     return(res)
 })