added gl.sample

NAMESPACE

@@ -112,6 +112,7 @@ export(gl.report.secondaries)
 export(gl.report.sexlinked)
 export(gl.report.taglength)
 export(gl.run.structure)
+export(gl.sample)
 export(gl.save)
 export(gl.select.colors)
 export(gl.select.shapes)

R/gl.sample.r

@@ -0,0 +1,55 @@
+#'@name gl.sample
+#'
+#'@title Samples individuals from populations
+#'
+#'@description This is a convenience function to prepare a bootstrap approach in dartR. For a bootstrap approach it is often desirable to sample a defined number of individuals for each of the populations in a genlight object and then calculate a certain quantity for that subset (redo a 1000 times)
+#'
+#'@param x genlight object containing SNP/silicodart genotypes
+#'@param nsample the number of individuals that should be sampled
+#'@param replace a switch to sample by replacement (default).
+#'@details This is convenience function to facilitate a bootstrap approach
+#'@return returns a genlight object with nsample samples from each populations.
+#'
+#'@author Bernd Gruber (Post to \url{https://groups.google.com/d/forum/dartr})
+#'
+#'@examples 
+#'@dontrun {
+#' #bootstrap for 2 possums populations to check effect of sample size on fixed alleles
+#' gl.set.verbosity(0)
+#' pp <- possums.gl[1:60,]
+#' nrep <- 1:10
+#' nss <- seq(1,10,2)
+#' res <- expand.grid(nrep=nrep, nss=nss)
+#' for (i in 1:nrow(res)) {
+#' dummy <- gl.sample(pp, nsample=res$nss[i], replace=TRUE)
+#' pas <- gl.report.pa(dummy, plot.out = F)
+#' res$fixed[i] <- pas$fixed[1]
+#' }
+#' boxplot(fixed ~ nss, data=res)
+#'}
+#'@family base dartR
+#'@export 
+#'
+gl.sample <- function(x,
+                  nsample = min(table(pop(x))),
+                  replace = TRUE,
+                  verbose = NULL) {
+
+  # SET VERBOSITY
+  verbose <- gl.check.verbosity(verbose)
+  # FLAG SCRIPT START
+ funname <- match.call()[[1]]
+  utils.flag.start(func=funname,build="Jody",v=verbose)
+  # CHECK DATATYPE
+  datatype <- utils.check.datatype(x, verbose=verbose)
+  # FUNCTION SPECIFIC ERROR CHECKING
+
+  # DO THE JOB
+  #find samples
+  ss <- sapply(1:nPop(x), function(z) which(pop(x)==levels(pop(x))[z]), simplify = F) 
+  samps <- unlist(lapply(ss, function(x) sample(x, nsample, replace=replace))) 
+  #subset x by samples
+  xx <- x[samps, ]
+  return(xx)
+}
+

R/gl.sort.r

@@ -13,14 +13,15 @@
 #'@author Bernd Gruber (Post to \url{https://groups.google.com/d/forum/dartr})
 #'
 #'@examples 
-#'sort by populations
+#'#sort by populations
 #'bc <- gl.sort(bandicoot.gl)
 #'#sort from West to East
 #'bc2 <- gl.sort(bandicoot.gl, sort.by="pop" ,
 #'order.by=c("WA", "SA", "VIC", "NSW", "QLD"))
 #'#sort by missing values
-#'miss <- rowSums(is.na(as.matrix(bandicoot.gl))
+#'miss <- rowSums(is.na(as.matrix(bandicoot.gl)))
 #'bc3 <- gl.sort(bandicoot.gl, sort.by="ind", order.by=miss)
+#'gl.smearplot(bc3)
 #'@family base dartR
 #'@export 
 #'