# these are simple function that setup onAttach and onLoad calls.
.onAttach <- function(libname, pkgname) {
# packageStartupMessage("Welcome to ecomix, let's get mixing. To run finite mixture models on ecological data see ?species_mix or ?regional_mix")
}
.onLoad <- function(libname, pkgname) {
# Generic DLL loader
dll.path <- file.path(libname, pkgname, "libs")
if (nzchar(subarch <- .Platform$r_arch)) {
dll.path <- file.path(dll.path, subarch)
}
this.ext <- paste(sub(".", "[.]", .Platform$dynlib.ext, fixed = TRUE), "$", sep = "")
dlls <- dir(dll.path, pattern = this.ext, full.names = FALSE)
names(dlls) <- dlls
if (length(dlls)){
lapply(dlls, function(x) library.dynam(sub(this.ext, "", x), package = pkgname, lib.loc = libname))
}
}
## utilites
"plapply" <- function (X, FUN, ..., .parallel = 1, .seed = NULL, .verbose = TRUE) {
if (!(useCluster <- inherits(.parallel, "cluster"))) {
stopifnot(length(.parallel) == 1L, is.vector(.parallel,
"numeric"), .parallel >= 1)
.parallel <- as.vector(.parallel, mode = "integer")
if (.Platform$OS.type == "windows" && .parallel > 1L) {
useCluster <- TRUE
.parallel <- parallel::makeCluster(.parallel)
on.exit(parallel::stopCluster(.parallel))
}
}
FUN <- match.fun(FUN)
.FUN <- if (useCluster || is.primitive(FUN)) {
FUN
}
else {
verboseExpr <- if (isTRUE(.verbose)) {
if (.parallel == 1L && interactive()) {
env <- new.env(hash = FALSE, parent = environment(FUN))
environment(FUN) <- env
env$pb <- txtProgressBar(min = 0, max = length(X),
initial = 0, style = 3)
on.exit(close(env$pb), add = TRUE)
quote(setTxtProgressBar(pb, pb$getVal() + 1L))
}
else {
on.exit(cat("\n"), add = TRUE)
quote(cat("."))
}
}
else if (is.call(.verbose) || is.expression(.verbose)) {
.verbose
}
else if (is.character(.verbose)) {
on.exit(cat("\n"), add = TRUE)
substitute(cat(.verbose))
}
do.call(add.on.exit, list(FUN, verboseExpr))
}
if (!is.null(.seed)) {
if (useCluster) {
parallel::clusterSetRNGStream(cl = .parallel, iseed = .seed)
}
else {
if (!exists(".Random.seed", envir = .GlobalEnv,
inherits = FALSE)) {
set.seed(NULL)
}
.orig.seed <- get(".Random.seed", envir = .GlobalEnv)
on.exit(assign(".Random.seed", .orig.seed, envir = .GlobalEnv),
add = TRUE)
if (.parallel == 1L) {
set.seed(seed = .seed)
}
else {
stopifnot(requireNamespace("parallel", quietly = TRUE))
set.seed(seed = .seed, kind = "L'Ecuyer-CMRG")
parallel::mc.reset.stream()
}
}
}
if (useCluster) {
parallel::parLapply(cl = .parallel, X = X, fun = .FUN,
...)
}
else if (.parallel == 1L) {
lapply(X = X, FUN = .FUN, ...)
}
else {
parallel::mclapply(X = X, FUN = .FUN, ..., mc.preschedule = TRUE,
mc.set.seed = TRUE, mc.silent = FALSE, mc.cores = .parallel)
}
}
"add.on.exit" <- function (FUN, expr){
FUN <- match.fun(FUN)
if (is.null(expr <- substitute(expr))) {
return(FUN)
}
if (is.primitive(FUN)) {
stop("not implemented for primitive functions")
}
onexitexpr <- substitute(on.exit(expr))
obody <- body(FUN)
body(FUN) <- if (is.call(obody) && identical(as.name("{"),
obody[[1L]])) {
as.call(append(x = as.list(obody), values = onexitexpr,
after = 1L))
}
else {
as.call(c(as.name("{"), onexitexpr, obody))
}
FUN
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.