pbmcapply/0000755000176200001440000000000013511451404012237 5ustar liggesuserspbmcapply/src/0000755000176200001440000000000013511445276013040 5ustar liggesuserspbmcapply/src/process.c0000755000176200001440000000142313511127430014652 0ustar liggesusers#define R_NO_REMAP #include #include #include #ifndef WIN32 # include # include #endif void R_init_pbmcapply(DllInfo* info) { R_registerRoutines(info, NULL, NULL, NULL, NULL); R_useDynamicSymbols(info, TRUE); } SEXP setpgid_(SEXP x_) { int res = 0; #ifndef WIN32 int id = Rf_asInteger(x_); if (setpgid(id, id) == 1) res = 1; #else Rf_warning("set group process id is not supported on this platform"); #endif return Rf_ScalarLogical(res); } SEXP killp_(SEXP pgid_) { int res = 0; #ifndef WIN32 int id = Rf_asInteger(pgid_); if (killpg(id, SIGTERM) == 0) res = 1; #else Rf_warning("kill process is not supported on this platform"); #endif return Rf_ScalarLogical(res); } pbmcapply/NAMESPACE0000755000176200001440000000061313445237135013472 0ustar liggesusers# Generated by roxygen2: do not edit by hand export(pbmclapply) export(pbmcmapply) export(progressBar) import(parallel) importFrom(parallel,mclapply) importFrom(parallel,mcmapply) importFrom(utils,flush.console) importFrom(utils,setTxtProgressBar) importFrom(utils,txtProgressBar) useDynLib(pbmcapply, .registration=TRUE) useDynLib(pbmcapply,killp_) useDynLib(pbmcapply,setpgid_) pbmcapply/R/0000755000176200001440000000000013511445276012452 5ustar liggesuserspbmcapply/R/utils.R0000755000176200001440000000716413511150157013737 0ustar liggesusers.verifyLength <- function(length) { if (length <= 0) return(FALSE) return(TRUE) } .isOSWindows <- function() { return(.Platform$OS.type == "windows") } .establishFifo <- function(description) { # Try to establish a fifo progressFifo <- fifo(description, open = "w+b", blocking = T) return(progressFifo) } .updateProgress <- function(length, progressFifo, mc.style, mc.substyle) { pb <- progressBar(0, length, style = mc.style, substyle = mc.substyle) setTxtProgressBar(pb, 0) progress <- 0 hasErrorWarning <- 0 while (progress < length) { progressUpdate <- readBin(progressFifo, "integer", n = 100) # Check if any warning or error in the update # Negative progress updates indicate: # Errors (-2) or warnings (-1) if (any(progressUpdate == -2)) { hasErrorWarning <- -2 break() } else if (any(progressUpdate == -1)) { hasErrorWarning <- -1 break() } progress <- progress + sum(progressUpdate) setTxtProgressBar(pb, progress) } # Print an line break to the stdout cat("\n") # Return error status return(hasErrorWarning) } # Handle the "missing global mccollect function" NOTE in CRAN check on Windows mccollect <- function(...) { if (.Platform$OS.type == "windows") { warning("mccollect is not available on Windows") } else { suppressWarnings(parallel::mccollect(...)) } } # code from r-core source (https://svn.r-project.org/R/tags/R-3-5-3/src/library/parallel/R/unix/mcparallel.R) # with a simple modification where a group process id # is assigned to the forked process in order to be able # to kill the child process and its descendants on exit # of the main process # Copyright (C) 1995-2018 The R Core Team #' @import parallel .customized_mcparallel <- function (expr, name, mc.set.seed = TRUE, silent = FALSE, mc.affinity = NULL, mc.interactive = FALSE, detached = FALSE) { # loading hidden functions pkg <- asNamespace('parallel') mcfork <- get('mcfork', pkg) mc.advance.stream <- get('mc.advance.stream', pkg) mcexit <- get('mcexit', pkg) mcinteractive <- get('mcinteractive', pkg) sendMaster <- get('sendMaster', pkg) mcaffinity <- get('mcaffinity', pkg) closeStdout <- get('closeStdout', pkg) mc.set.stream <- get('mc.set.stream', pkg) f <- mcfork(detached) env <- parent.frame() if (isTRUE(mc.set.seed)) mc.advance.stream() if (inherits(f, "masterProcess")) { on.exit(mcexit(1L, structure("fatal error in wrapper code", class = "try-error"))) if (isTRUE(mc.set.seed)) mc.set.stream() mc.interactive <- as.logical(mc.interactive) if (isTRUE(mc.interactive)) mcinteractive(TRUE) if (isTRUE(!mc.interactive)) mcinteractive(FALSE) if (!is.null(mc.affinity)) mcaffinity(mc.affinity) if (isTRUE(silent)) closeStdout(TRUE) if (detached) { on.exit(mcexit(1L)) eval(expr, env) mcexit(0L) } # reset the group process id of the forked process .setpgid(f$pid) sendMaster(try(eval(expr, env), silent = TRUE)) mcexit(0L) } if (!missing(name) && !is.null(name)) f$name <- as.character(name)[1L] class(f) <- c("parallelJob", class(f)) f } .cleanup <- function(pid) { # kill the process and its descendants with group process id # which is set to its pid if (.killp(pid)) { # clean up the zombie process invisible(mccollect(pid)) } } #' @useDynLib pbmcapply, .registration=TRUE #' @useDynLib pbmcapply setpgid_ .setpgid <- function(pid) { .Call(setpgid_, pid) } #' @useDynLib pbmcapply killp_ .killp <- function(pgid) { .Call(killp_, pgid) } pbmcapply/R/debugger.R0000755000176200001440000000023113445237135014357 0ustar liggesusers# Load packages library(parallel) library(utils) # Load R scripts source("R/progressBar.R") source("R/txtProgressBarETA.R") source("R/utils.R") pbmcapply/R/pbmclapply.R0000755000176200001440000000700013511147112014724 0ustar liggesusers# Debug flag DEBUG_FLAG = F # Load R files during development if(DEBUG_FLAG) { source("R/debugger.R") warning("in pbmclapply.R: disable these lines before publishing package!") } #' @importFrom parallel mclapply #' @export pbmclapply <- function(X, FUN, ..., mc.style = "ETA", mc.substyle = NA, mc.cores = getOption("mc.cores", 2L), ignore.interactive = getOption("ignore.interactive", F), mc.preschedule = TRUE, mc.set.seed = TRUE, mc.cleanup = TRUE, mc.allow.recursive = TRUE) { FUN <- match.fun(FUN) if (!is.vector(X) | is.object(X)) { X <- as.list(X) } length <- length(X) if (!.verifyLength(length)) { return(X) } # If not in interactive mode and interactive state is not ignored, just pass to mclapply if (!interactive() & !ignore.interactive) { return(mclapply(X, FUN, ..., mc.cores = mc.cores, mc.preschedule = mc.preschedule, mc.set.seed = mc.set.seed, mc.cleanup = mc.cleanup, mc.allow.recursive = mc.allow.recursive)) } # If running in Windows, mc.cores must be 1 if (.isOSWindows()) { # Stop if multiple cores are assigned if (mc.cores > 1) { warning("mc.cores > 1 is not supported on Windows due to limitation of mc*apply() functions.\n mc.core is set to 1.") mc.cores = 1 } ### ### Temp fix to bypass the fifo() on Windows ### TODO: a proper message passing interface on Windows ### # Initialize progress bar pb <- progressBar(0, length, style = mc.style, substyle = mc.substyle) setTxtProgressBar(pb, 0) parentEnvironment <- environment() progress <- 0 # Update progress bar after within each iteration result <- lapply(X, function(...) { res <- FUN(...) parentEnvironment$progress <- parentEnvironment$progress + 1 setTxtProgressBar(pb, progress) return(res) }, ...) return(result) } progressFifo <- .establishFifo(tempfile()) on.exit(close(progressFifo), add = T) progressMonitor <- .customized_mcparallel({ # Get results # Derived from `tryCatch.W.E` # Copyright (C) 2010-2012 The R Core Team # Handle warnings W <- NULL w.handler <- function(w) { W <<- w invokeRestart("muffleWarning") } result <- withCallingHandlers(tryCatch( { mclapply(X, function(...) { res <- FUN(...) writeBin(1L, progressFifo) return(res) }, ..., mc.cores = mc.cores, mc.preschedule = mc.preschedule, mc.set.seed = mc.set.seed, mc.cleanup = mc.cleanup, mc.allow.recursive = mc.allow.recursive) }, error = function(cond) { # Errors are represented as -3 writeBin(-2L, progressFifo) return(cond) }), warning=w.handler) # Check if warnings are triggered if (!is.null(W)) { writeBin(-1L, progressFifo) result = list(value = result, warning = W) } # Close the FIFO connection. close(progressFifo) result }) # clean up processes on exit on.exit(.cleanup(progressMonitor$pid), add = T) hasErrorInProgress <- .updateProgress(length, progressFifo, mc.style, mc.substyle) # Retrieve the result results <- suppressWarnings(mccollect(progressMonitor$pid)[[as.character(progressMonitor$pid)]]) # Check if errors happened if (hasErrorInProgress == -1) { warning(results$warning) return(results$value) } else if (hasErrorInProgress == -2) { stop(results) } return(results) } pbmcapply/R/progressBar.R0000755000176200001440000000204313445237135015067 0ustar liggesusersvalidStyles <- c("txt", "ETA") #' @importFrom utils txtProgressBar #' @export progressBar <- function(min = 0, max = 1, initial = 0, style = "ETA", substyle = NA, char = "=", width = NA, file = "") { # Check whether arguments are acceptable type if (!is.numeric(c(min, max, initial))) { stop("arguments of progress bar is not valid.") } # Check whether min < max if (min > max) { stop("must have max bigger than min.") } # Check whether the style is valid if (!style %in% validStyles) { stop("style must be valid.") } # Route to sub-functions based on style switch(style, "txt" = return(txtProgressBar(min = min, max = max, initial = initial, style = ifelse(is.na(substyle), 3, substyle), char = char, width = width, file = file)), "ETA" = return(txtProgressBarETA(min = min, max = max, initial = initial, char = char, width = width, file = file)) ) } pbmcapply/R/txtProgressBarETA.R0000755000176200001440000001237613445237135016133 0ustar liggesusers# A progress bar with estimated time to completion. # # @details This is an extended version of the \code{txtProgressBar} # function from the \code{utils} package. Please refer to that for # documentation (\code{help(utils::txtProgressBar)}). The original # \code{utils::setTxtProgressBar} can be used to update the bar. Use # \code{library(pbarETA)} to override \code{utils::setTxtProgressBar} # with \code{pbarETA::setTxtProgressBar}. Use # \code{help(setTxtProgressBar, "utils")} to get help about the # original function. # # @author Francesco Napolitano \email{franapoli@@gmail.com} # @license LGPL-3 # Format time from seconds to YYMMDD HHMMSS format. # Comment added by Kevin Kuang. formatTime <- function(seconds) { if (seconds == Inf || is.nan(seconds) || is.na(seconds)) return("NA") seconds <- round(seconds) sXmin <- 60 sXhr <- sXmin * 60 sXday <- sXhr * 24 sXweek <- sXday * 7 sXmonth <- sXweek * 4.22 sXyear <- sXmonth * 12 years <- floor(seconds / sXyear) seconds <- seconds - years * sXyear months <- floor(seconds / sXmonth) seconds <- seconds - months * sXmonth weeks <- floor(seconds / sXweek) seconds <- seconds - weeks * sXweek days <- floor(seconds / sXday) seconds <- seconds - days * sXday hours <- floor(seconds / sXhr) seconds <- seconds - hours * sXhr minutes <- floor(seconds / sXmin) seconds <- seconds - minutes * sXmin ETA <- c(years, months, days, hours, minutes, seconds) # Add labels for years, months, days labels <- c("year", "years", "month", "months", "day", "days") # Kevin - Always show minutes startst <- which(ETA > 0)[1] if (is.na(startst) | startst == 6) startst <- 5 # Kevin - Split year;month;day and HH:MM:SS if (startst <= 3) { # Kevin - Handle plurals ymt <- labels[startst:3 * 2 - as.integer(ETA[startst:3] == 1)] fmtstr <- paste(paste("%01d", ymt, collapse = " "), paste(rep("%02d", length(ETA) - 3), collapse = ":")) } else { fmtstr <- rep("%02d", length(ETA))[startst:length(ETA)] fmtstr <- paste(fmtstr, collapse = ":") } return(do.call(sprintf, as.list(c( as.list(fmtstr), ETA[startst:length(ETA)] )))) } #' @importFrom utils setTxtProgressBar flush.console txtProgressBarETA <- function (min = 0, max = 1, initial = 0, char = "=", width = NA, title, label, file = "") { if (!identical(file, "") && !(inherits(file, "connection") && isOpen(file))) { stop("'file' must be \"\" or an open connection object") } .val <- initial .killed <- FALSE .nb <- 0 .pc <- -1L .time0 <- NA .timenow <- NA .firstUpdate <- T .autoWidth <- is.na(width) # Kevin - Set previous length .prevLength <- 0 if (max < min) { stop("must have 'max' > 'min'") } # Kevin - Adjust width based on Windows or *nix platforms nw <- nchar(char, "w") if (.autoWidth) { if (.Platform$OS.type == "windows" | Sys.getenv("COLUMNS") == "") { width <- getOption("width") } else { width <- as.integer(Sys.getenv("COLUMNS")) } } width <- trunc(width / nw) up <- function(value, calledOnCreation = F) { timenow <- proc.time()[["elapsed"]] if (!calledOnCreation && .firstUpdate) { .time0 <<- timenow .timenow <<- timenow .firstUpdate <<- F } if (!is.finite(value) || value < min || value > max) { return() } .val <<- value nb <- (value - min) / (max - min) pc <- round(100 * nb) # Kevin - if width is too small, we cannot draw a proper progress bar if (width < 40) { line = sprintf("\r %3d%% ", pc) } else { # Kevin - Just return if no need to redraw the progress bar if (nb == .nb && pc == .pc && timenow - .timenow < 1) { return() } .timenow <<- timenow span <- timenow - .time0 timeXiter <- span / (.val - min) ETA <- (max - .val) * timeXiter ETAstr <- formatTime(ETA) # Kevin - Display elapsed time when completed. Otherwise, display ETA. if (value == max) { elapsedString <- paste(c(sprintf("| %3d%%", pc), ", Elapsed ", formatTime(span)), collapse = "") barWidth <- width - nchar("\r |") - nchar(elapsedString) barFill <- round(barWidth * nb) line = paste(c("\r |", rep.int(char, barFill), rep.int(" ", nw * (barWidth - barFill)), elapsedString), collapse = "") } else { ETAString <- paste(c(sprintf("| %3d%%", pc), ", ETA ", ETAstr), collapse = "") barWidth <- width - nchar("\r |") - nchar(ETAString) barFill <- round(barWidth * nb) line = paste(c("\r |", rep.int(char, barFill), rep.int(" ", nw * (barWidth - barFill)), ETAString), collapse = "") } .nb <<- nb .pc <<- pc } cat(line, file = file) flush.console() .prevLength <<- nchar(line) } getVal <- function() { return(.val) } kill <- function() { if (!.killed) { cat("\n", file = file) flush.console() .killed <<- TRUE } } up(initial, T) return(structure(list(getVal = getVal, up = up, kill = kill), class = "txtProgressBar")) } pbmcapply/R/pbmcmapply.R0000755000176200001440000000706013511150363014735 0ustar liggesusers# Debug flag DEBUG_FLAG = F # Load R files during development if(DEBUG_FLAG) { source("R/debugger.R") warning("in pbmcmapply.R: disable these lines before publishing package!") } #' @importFrom parallel mcmapply #' @export pbmcmapply <- function(FUN, ..., MoreArgs = NULL, mc.style = "ETA", mc.substyle = NA, mc.cores = getOption("mc.cores", 2L), ignore.interactive = getOption("ignore.interactive", F), mc.preschedule = TRUE, mc.set.seed = TRUE, mc.cleanup = TRUE) { FUN <- match.fun(FUN) # Get the max length of elements in ... length <- max(mapply(function(element) { if (is.null(nrow(element))) { return(length(element)) } else { return(nrow(element)) } }, list(...))) if (!.verifyLength(length)) { return(list()) } # If not in interactive mode, just pass to mclapply if (!interactive() & !ignore.interactive) { return(mcmapply(FUN, ..., MoreArgs = MoreArgs, mc.cores = mc.cores, mc.preschedule = mc.preschedule, mc.set.seed = mc.set.seed, mc.cleanup = mc.cleanup)) } # If running in Windows, mc.cores must be 1 if (.isOSWindows()) { # Stop if multiple cores are assigned if (mc.cores > 1) { warning("mc.cores > 1 is not supported on Windows due to limitation of mc*apply() functions.\n mc.core is set to 1.") mc.cores = 1 } ### ### Temp fix to bypass the fifo() on Windows ### TODO: a proper message passing interface on Windows ### # Initialize progress bar pb <- progressBar(0, length, style = mc.style, substyle = mc.substyle) setTxtProgressBar(pb, 0) parentEnvironment <- environment() progress <- 0 # Update progress bar after within each iteration result <- mapply(function(...) { res <- FUN(...) parentEnvironment$progress <- parentEnvironment$progress + 1 setTxtProgressBar(pb, progress) return(res) }, ..., MoreArgs = MoreArgs) return(result) } progressFifo <- .establishFifo(tempfile()) on.exit(close(progressFifo), add = T) progressMonitor <- .customized_mcparallel({ # Get results # Derived from `tryCatch.W.E` # Copyright (C) 2010-2012 The R Core Team # Handle warnings W <- NULL w.handler <- function(w) { W <<- w invokeRestart("muffleWarning") } result <- withCallingHandlers(tryCatch( { mcmapply(function(...) { res <- FUN(...) writeBin(1L, progressFifo) return(res) }, ..., MoreArgs = MoreArgs, mc.cores = mc.cores, mc.preschedule = mc.preschedule, mc.set.seed = mc.set.seed, mc.cleanup = mc.cleanup) }, error = function(cond) { # Errors are represented as -3 writeBin(-2L, progressFifo) return(cond) }), warning=w.handler) # Check if warnings are triggered if (!is.null(W)) { writeBin(-1L, progressFifo) result = list(value = result, warning = W) } # Close the FIFO connection close(progressFifo) result }) # clean up processes on exit on.exit(.cleanup(progressMonitor$pid), add = T) hasErrorInProgress <- .updateProgress(length, progressFifo, mc.style, mc.substyle) # Retrieve the result results <- suppressWarnings(mccollect(progressMonitor$pid)[[as.character(progressMonitor$pid)]]) # Check if errors happened if (hasErrorInProgress == -1) { warning(results$warning) return(results$value) } else if (hasErrorInProgress == -2) { stop(results) } return(results) } pbmcapply/MD50000644000176200001440000000117013511451404012546 0ustar liggesusers2f4d14e13331279436e4c91b995e483a *DESCRIPTION 48e66c6d7fb3d84d84ba2187eef1ea48 *LICENSE 074b76368bc77ab2b3b91bd986f72bef *NAMESPACE 10a6ad78c83e8cc79ab251d6e4bb8426 *R/debugger.R d3c55616d1be4a16ba8c097fbb88e349 *R/pbmclapply.R 817bbca4c9c82c3fe77a0534b26a3c8f *R/pbmcmapply.R 06613586ef565ede5ef4873a618c0fff *R/progressBar.R 32c0b358a3a08767cacb8fdf60e2aa05 *R/txtProgressBarETA.R 722423f7105355b2df87a21afbd65c85 *R/utils.R 9b26c9de6545ebfa50bc00d8e5ac9050 *man/pbmclapply.Rd 63176abe1ecce44afd3be1b3880e0d8f *man/pbmcmapply.Rd 5c657cf20694bcd593eaceaca9c384b2 *man/progressBar.Rd 1b47a58f7842d4b9caacc09a03806ad6 *src/process.c pbmcapply/DESCRIPTION0000755000176200001440000000154413511451404013754 0ustar liggesusersPackage: pbmcapply Type: Package Title: Tracking the Progress of Mc*pply with Progress Bar Version: 1.5.0 Author: Kevin Kuang (aut), Quyu Kong (ctb), Francesco Napolitano (ctb) Maintainer: Kevin kuang Description: A light-weight package helps you track and visualize the progress of parallel version of vectorized R functions (mc*apply). Parallelization (mc.core > 1) works only on *nix (Linux, Unix such as macOS) system due to the lack of fork() functionality, which is essential for mc*apply, on Windows. Depends: utils, parallel BugReports: https://github.com/kvnkuang/pbmcapply/issues URL: https://github.com/kvnkuang/pbmcapply License: MIT + file LICENSE LazyData: TRUE RoxygenNote: 6.1.1 Encoding: UTF-8 NeedsCompilation: yes Packaged: 2019-07-10 20:29:50 UTC; kevin Repository: CRAN Date/Publication: 2019-07-10 21:05:08 UTC pbmcapply/man/0000755000176200001440000000000013445237135013023 5ustar liggesuserspbmcapply/man/progressBar.Rd0000755000176200001440000000403613445173072015610 0ustar liggesusers\name{progressBar} \alias{progressBar} \title{ Progress bar with the estimated time to completion (ETA). } \description{ This is an extended version of the \code{txtProgressBar} function with the estimated time to completion (ETA). Please refer to that for documentation (\code{help(utils::txtProgressBar)}). The original \code{utils::setTxtProgressBar} can be used to update the bar. Use \code{help(setTxtProgressBar, "utils")} to get help about the original function. } \usage{ progressBar(min = 0, max = 1, initial = 0, style = "ETA", substyle = NA, char = "=", width = NA, file = "") } \arguments{ \item{min, max, initial}{ see \code{\link{txtProgressBar}}. } \item{style}{ style of the progress bar - see 'Details'. } \item{substyle}{ substyle of the progress bar - only needed when style is set to certain value (see 'Details'). } \item{char, width, file}{ see \code{\link{txtProgressBar}}. } } \details{ When style = "txt", it performs exactly the same as the original \code{txtProgressBar}. In this case, substyle shall be treated as the style in the original \code{txtProgressBar}. Please refer to the 'Detail' of \code{\link{txtProgressBar}} for the meanings of substyles. When style = "ETA", it shows a progress bar with the estimated time to completion (ETA). Substyle is not used in this case. However, when running in a terminal and the width of the terminal windows is smaller than 40 characters, the progress bar will not be displayed. } \value{ An object of class "txtProgressBar". } \note{ Code derived from library \code{pbarETA} (https://github.com/franapoli/pbarETA) by Francesco Napolitano \email{franapoli@@gmail.com}. } \seealso{ \code{\link{txtProgressBar}} } \examples{ # Test function testit <- function(x, ...) { pb <- progressBar(...) for(i in c(0, x, 1)) { setTxtProgressBar(pb, i) } close(pb) } # Txt progress bar testit(sort(runif(10)), style = "txt", substyle = 3) # ETA progress bar testit(sort(runif(10)), style = "ETA") } pbmcapply/man/pbmcmapply.Rd0000755000176200001440000000432513445237135015465 0ustar liggesusers\name{pbmcmapply} \alias{pbmcmapply} \title{Tracking mcmapply with progress bar} \description{ \code{pbmcmapply} is a wrapper around the \code{mcmapply} function. It adds a progress bar to \code{mcmapply} function. \strong{Parallelization (mc.core > 1) works only on *nix (Linux, Unix such as macOS) system due to the lack of \code{fork()} functionality, which is essential for mcapply, on Windows.} } \usage{ pbmcmapply(FUN, ..., MoreArgs = NULL, mc.style = "ETA", mc.substyle = NA, mc.cores = getOption("mc.cores", 2L), ignore.interactive = getOption("ignore.interactive", F), mc.preschedule = TRUE, mc.set.seed = TRUE, mc.cleanup = TRUE) } \arguments{ \item{FUN}{ the function to be applied in parallel to ... } \item{...}{ arguments to vectorize over (vectors or lists of strictly positive length, or all of zero length). } \item{MoreArgs}{ a list of other arguments to FUN. } \item{mc.cores}{ see \code{\link{mcmapply}}. } \item{mc.style, mc.substyle}{ style of the progress bar. See \code{\link{progressBar}}. } \item{ignore.interactive}{ whether the \code{interactive()} is ignored. If set to TRUE, the progress bar will be printed even in a non-interactive environment (e.g. called by Rscript). Can be set as an option "ignore.interactive". } \item{mc.preschedule, mc.set.seed, mc.cleanup}{ See \code{\link{mcmapply}}. } } \examples{ # A lazy sqrt function which doesn't care about efficiency lazySqrt <- function(num) { # Sleep randomly between 0 to 0.5 second Sys.sleep(runif(1, 0, 0.5)) return(sqrt(num)) } # On Windows, set cores to be 1 if (.Platform$OS.type == "windows") { cores = 1 } else { cores = 2 } # A lazy and chatty sqrt function. # An example of passing arguments to pbmcmapply. lazyChattySqrt <- function(num, name) { # Sleep randomly between 0 to 0.5 second Sys.sleep(runif(1, 0, 0.5)) return(sprintf("Hello \%s, the sqrt of \%f is \%f.", toString(name), num, sqrt(num))) } # Get the sqrt of 1-3 in parallel result <- pbmcmapply(lazySqrt, 1:3, mc.cores = cores) chattyResult <- pbmcmapply(lazyChattySqrt, 1:3, MoreArgs = list("Bob"), mc.cores = cores) } pbmcapply/man/pbmclapply.Rd0000755000176200001440000000435213445237135015464 0ustar liggesusers\name{pbmclapply} \alias{pbmclapply} \title{Tracking mclapply with progress bar} \description{ \code{pbmclapply} is a wrapper around the \code{mclapply} function. It adds a progress bar to \code{mclapply} function. \strong{Parallelization (mc.core > 1) works only on *nix (Linux, Unix such as macOS) system due to the lack of \code{fork()} functionality, which is essential for mcapply, on Windows.} } \usage{ pbmclapply(X, FUN, ..., mc.style = "ETA", mc.substyle = NA, mc.cores = getOption("mc.cores", 2L), ignore.interactive = getOption("ignore.interactive", F), mc.preschedule = TRUE, mc.set.seed = TRUE, mc.cleanup = TRUE, mc.allow.recursive = TRUE) } \arguments{ \item{X}{ a vector (atomic or list) or an expressions vector. Other objects (including classed objects) will be coerced by \code{'as.list'}. } \item{FUN}{ the function to be applied to. } \item{...}{ optional arguments to FUN. } \item{mc.cores}{ see \code{\link{mclapply}}. } \item{mc.style, mc.substyle}{ style of the progress bar. See \code{\link{progressBar}}. } \item{ignore.interactive}{ whether the \code{interactive()} is ignored. If set to TRUE, the progress bar will be printed even in a non-interactive environment (e.g. called by Rscript). Can be set as an option "ignore.interactive". } \item{mc.preschedule, mc.set.seed, mc.cleanup, mc.allow.recursive}{ See \code{\link{mclapply}}. } } \examples{ # A lazy sqrt function which doesn't care about efficiency lazySqrt <- function(num) { # Sleep randomly between 0 to 0.5 second Sys.sleep(runif(1, 0, 0.5)) return(sqrt(num)) } # On Windows, set cores to be 1 if (.Platform$OS.type == "windows") { cores = 1 } else { cores = 2 } # A lazy and chatty sqrt function. # An example of passing arguments to pbmclapply. lazyChattySqrt <- function(num, name) { # Sleep randomly between 0 to 0.5 second Sys.sleep(runif(1, 0, 0.5)) return(sprintf("Hello \%s, the sqrt of \%f is \%f.", toString(name), num, sqrt(num))) } # Get the sqrt of 1-3 in parallel result <- pbmclapply(1:3, lazySqrt, mc.cores = cores) chattyResult <- pbmclapply(1:3, lazyChattySqrt, "Bob", mc.cores = cores) } pbmcapply/LICENSE0000755000176200001440000000005113075500312013241 0ustar liggesusersYEAR: 2016 COPYRIGHT HOLDER: Kevin Kuang