[adegenet-commits] r466 - pkg/R

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

Author: jombart
Date: 2009-11-10 17:41:38 +0100 (Tue, 10 Nov 2009)
New Revision: 466

Modified:
   pkg/R/haploPop.R
Log:
almost there


Modified: pkg/R/haploPop.R
===================================================================
--- pkg/R/haploPop.R	2009-11-10 16:10:21 UTC (rev 465)
+++ pkg/R/haploPop.R	2009-11-10 16:41:38 UTC (rev 466)
@@ -132,6 +132,7 @@
 ## summary.haploPop
 ##################
 summary.haploPop <- function(object, ...){
+    x <- object
     myCall <- x$call
     x$call <- NULL
     res <- list()
@@ -157,3 +158,39 @@
 
     return(invisible(res))
 } # end print.haploPop
+
+
+
+
+
+
+##################
+## sample.haploPop
+##################
+sample.haploPop <- function(x, n){
+    x <- unlist(x, recursive=FALSE)
+    res <- list()
+    res[[1]] <- sample(x, n)
+    class(res) <- "haploPop"
+    return(res)
+} # end sample.haploPop
+
+
+
+
+
+
+###############
+## dist.haploPop
+###############
+dist.haploPop <- function(x){
+    if(!inherits(x, "haploPop")) stop("x is not a haploPop object")
+
+    x <- unlist(x, recursive=FALSE)
+    f1 <- function(a,b){
+        return(sum(!union(a,b) %in% intersect(a,b)))
+    }
+
+    res <- outer(x, x, FUN=f1)
+    return(as.dist(res))
+} # end dist.haploPop