1aple.mc <- function(x, listw, nsim, override_similarity_check=FALSE, 2 useTrace=TRUE) { 3 aple.boot <- function(var, i, ...) { 4 var <- var[i] 5 return(inAple(x=var, ...)) 6 } 7 pre <- preAple(x=x, listw=listw, 8 override_similarity_check=override_similarity_check, useTrace=useTrace) 9 10 cores <- get.coresOption() 11 if (is.null(cores)) { 12 parallel <- "no" 13 } else { 14 parallel <- ifelse (get.mcOption(), "multicore", "snow") 15 } 16 ncpus <- ifelse(is.null(cores), 1L, cores) 17 cl <- NULL 18 if (parallel == "snow") { 19 cl <- get.ClusterOption() 20 if (is.null(cl)) { 21 parallel <- "no" 22 warning("no cluster in ClusterOption, parallel set to no") 23 } 24 } 25 res <- boot(x, statistic=aple.boot, R=nsim, sim="permutation", pre=pre, 26 parallel=parallel, ncpus=ncpus, cl=cl) 27 28 res 29} 30 31boot_wrapper_in <- function(cl, nsim) { 32 if (requireNamespace("parallel", quietly = TRUE)) { 33# require(rlecuyer) 34 rlseed <- get("rlecuyerSeed", envir = .spdepOptions) 35 if (storage.mode(rlseed) != "integer") rlseed <- as.integer(rlseed) 36 if (length(rlseed) != 6L) rlseed <- rep(12345L, 6) 37 parallel::clusterSetRNGStream(cl, iseed=rlseed) 38 parallel::clusterEvalQ(cl, library(spdep)) 39 nnsim <- ceiling(nsim/length(cl)) 40 nnsim 41 } else { 42 stop("parallel not available") 43 } 44} 45 46boot_wrapper_out <- function(lres, mcall) { 47 res <- list() 48 res$t0 <- lres[[1]]$t0 49 res$t <- matrix(c(sapply(lres, function(x) x$t)), ncol=1) 50 res$R <- sum(sapply(lres, function(x) x$R)) 51 res$data <- lres[[1]]$data 52 res$seed <- c(sapply(lres, function(x) x$seed)) 53 res$statistic <- lres[[1]]$statistic 54 res$sim <- lres[[1]]$sim 55 res$call <- mcall 56 res$stype <- lres[[1]]$stype 57 res$strata <- lres[[1]]$strata 58 class(res) <- "boot" 59 res 60} 61