Add bootgen2genind() to fix #112

NAMESPACE

@@ -23,6 +23,7 @@ export(as.genclone)
 export(as.snpclone)
 export(bitwise.dist)
 export(bitwise.ia)
+export(bootgen2genind)
 export(bruvo.boot)
 export(bruvo.dist)
 export(bruvo.msn)

R/methods.r

@@ -157,7 +157,7 @@ setMethod(
     }
     num_alleles                <- slot(gen, "loc.n.all")
     num_loci                   <- length(num_alleles)
-    slot(.Object, "tab")       <- tab(gen, NA.method = na, freq = freq)     
+    slot(.Object, "tab")       <- tab(gen, NA.method = na, freq = freq)
     slot(.Object, "loc.fac")   <- slot(gen, "loc.fac")
     slot(.Object, "loc.n.all") <- num_alleles  
     slot(.Object, "all.names") <- slot(gen, "all.names") 
@@ -176,6 +176,30 @@ setMethod(
     return(x@tab)
   })
 
+#==============================================================================#
+#' @export
+#' @rdname coercion-methods
+#' @param bg a bootgen object
+#' @aliases bootgen2genind,bootgen-method
+#' @docType methods
+#==============================================================================#
+bootgen2genind <- function(bg){
+  standardGeneric("bootgen2genind")
+}
+
+#' @export
+setGeneric("bootgen2genind")
+
+setMethod(
+  f = "bootgen2genind",
+  signature = "bootgen",
+  definition = function(bg){
+    xtab <- tab(bg)
+    if (is.numeric(xtab)) xtab[] <- as.integer(xtab*bg@ploidy)
+    res <- new("genind", tab = xtab)
+    return(res)
+  })
+
 ################################################################################
 #------------------------------------------------------------------------------#
 # BRUVOMAT METHODS
@@ -713,6 +737,7 @@ setMethod(
 #'   
 #' @seealso \code{\link{splitStrata}}, \code{\linkS4class{genclone}},
 #'   \code{\link{read.genalex}}
+#'   \code{\link{aboot}}
 #' @author Zhian N. Kamvar
 #' @examples
 #' data(Aeut)
@@ -721,6 +746,11 @@ setMethod(
 #' Aeut.gc
 #' Aeut.gi <- genclone2genind(Aeut.gc)
 #' Aeut.gi
+#' data(nancycats)
+#' nan.bg  <- new("bootgen", nancycats[pop = 9])
+#' nan.bg
+#' nan.gid <- bootgen2genind(nan)
+#' nan.gid
 #==============================================================================#
 as.genclone <- function(x, ..., mlg, mlgclass = TRUE){
   standardGeneric("as.genclone")

tests/testthat/test-trees.R

@@ -56,6 +56,16 @@ test_that("aboot can utilize anonymous functions", {
 	expect_is(nantree, "phylo")
 })
 
+test_that("aboot can utilize bootgen2genind", {
+  skip_on_cran()
+  suppressWarnings(nantreebg <- aboot(nan9, dist = function(x) nei.dist(bootgen2genind(x)), sample = 20, quiet = TRUE))
+  suppressWarnings(nantree   <- aboot(nan9, dist = "nei.dist", sample = 20, quiet = TRUE))
+  expect_is(nantreebg, "phylo")
+  expect_is(nantree, "phylo")
+  expect_equivalent(nantreebg$edge.length, nantree$edge.length)
+})
+
+
 test_that("aboot can handle populations", {
   skip_on_cran()
 	set.seed(999)