[adegenet-commits] r364 - pkg/R

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

Author: jombart
Date: 2009-06-04 17:58:35 +0200 (Thu, 04 Jun 2009)
New Revision: 364

Modified:
   pkg/R/haploSim.R
Log:
God damn works again.


Modified: pkg/R/haploSim.R
===================================================================
--- pkg/R/haploSim.R	2009-06-04 13:26:44 UTC (rev 363)
+++ pkg/R/haploSim.R	2009-06-04 15:58:35 UTC (rev 364)
@@ -76,14 +76,19 @@
 
     ## check result size and resize it if needed
     resize.result <- function(){
-        curSize <- length(res$date)
-        if(curSize < max.nb.haplo) return(NULL)
-        toKeep <- sample(1:curSize, size=max.nb.haplo, replace=FALSE)
+        curSize <- length(res$dates)
+        if(curSize <= max.nb.haplo) return(NULL)
+        toKeep <- rep(FALSE, curSize)
+        toKeep[sample(1:curSize, size=max.nb.haplo, replace=FALSE)] <- TRUE
         removed.strains <- rownames(res$seq)[!toKeep]
         res$seq <<- res$seq[toKeep,]
-        res$date <<- res$date[toKeep]
+        res$dates <<- res$dates[toKeep]
         res$ances <<- res$ances[toKeep]
-        res$ances[as.character(res$ances) %in% removed.strains] <- NA
+        toExpand <<- toExpand[toKeep]
+        temp <- as.character(res$ances) %in% removed.strains
+        if(any(temp)) {
+            res$ances[temp] <<- NA
+        }
 
         return(NULL)
     }
@@ -129,8 +134,14 @@
 
     ## SHAPE AND RETURN OUTPUT ##
     ## shift ances as characters to indices in others slots
+    cat("\nres$ances\n")
+    print(res$ances)
+    cat("\nres$seq names\n")
+    print(rownames(res$seq))
+
+    nbAncesNAOk <- sum(is.na(res$ances))
     res$ances <- match(res$ances, rownames(res$seq))
-    if(sum(is.na(res$ances))>1){ # there is always one trivial NA for the root
+    if(sum(is.na(res$ances))> nbAncesNAOk){ # in case non-NA ancestors are not in res$seq
         warning("NA introduced when converting ances to indices, likely indicating a bug")
     }
 
@@ -165,7 +176,7 @@
 
         cat(paste("$", names(x)[i], sep=""),"\n")
         if(names(x)[i]!="seq") {
-            cat(head(x[[i]],10), "...\n")
+            cat(head(x[[i]],10), ifelse(length(x[[i]])>10,"...",""),"\n")
         } else print(x[[i]])
     }