pbapply/0000755000176200001440000000000012625165706011733 5ustar liggesuserspbapply/inst/0000755000176200001440000000000012625153462012704 5ustar liggesuserspbapply/inst/ChangeLog0000644000176200001440000000263612625153462014465 0ustar liggesusers# pbapply package version history ## Version 1.1-3, Nov 24, 2015 * R (>= 3.2.0) dependency added because check failed on R-oldrelease (R-3.1.3) with error 'could not find function "forceAndCall"' that is part of the apply() source code. Reported by Uwe Ligges. ## Version 1.1-2, Nov 21, 2015 * Using on.exit and invisible(NULL) in examples. * pblapply did not return NULL values, reported by J. Barrett. Now fixed. * pblapply did not return list names. Now fixed. * pbapply, pbsapply, pbreplicate: code follows base original. * Examples updated to follow base R examples. * Rd file to match code changes. ## Version 1.1-1, Feb 3, 2014 * pblapply did not pass ... when not in interactive mode. Bug reported by R. D. Morey (U Groningen). ## Version 1.1-0, Sept 25, 2013 * Removed ::: to satisfy R 3.0.2 check. ## Version 1.0-5, July 6, 2012 * inst/COPYING removed * .Internal call removed from pblapply ## Version 1.0-4, September 8, 2011 * .onLoad added to zzz.R * Help files a bit reworked ## Version 1.0-3, September 9, 2010 * pboptions.Rd modified: pb type values added ## Version 1.0-2, September 4, 2010 * pboptions reworked * functions simplified ## Version 1.0-1, September 3, 2010 * pbreplicate added * tests directory created * check failed on unix systems: man an R directory reworked ## Version 1.0-0, September 2, 2010 * first release pbapply/tests/0000755000176200001440000000000012625153462013071 5ustar liggesuserspbapply/tests/tests.R0000644000176200001440000000220112625153462014351 0ustar liggesuserslibrary(pbapply) example(pboptions) example(pbapply) example(lapply) example(apply) ## #library(plyr) ## from http://ryouready.wordpress.com/2010/01/11/progress-bars-in-r-part-ii-a-wrapper-for-apply-functions/#comment-122 lapply_pb <- function(X, FUN, ...) { env <- environment() pb_Total <- length(X) counter <- 0 pb <- txtProgressBar(min = 0, max = pb_Total, style = 3) # wrapper around FUN wrapper <- function(...){ curVal <- get("counter", envir = env) assign("counter", curVal +1 ,envir=env) setTxtProgressBar(get("pb", envir=env), curVal +1) FUN(...) } res <- lapply(X, wrapper, ...) close(pb) res } system.time(x1 <- lapply(1:10, function(i) Sys.sleep(0.2))) system.time(x1 <- lapply_pb(1:10, function(i) Sys.sleep(0.2))) #system.time(x1 <- l_ply(1:10, function(i) Sys.sleep(0.2), .progress=create_progress_bar(name = "text"))) system.time(x1 <- pblapply(1:10, function(i) Sys.sleep(0.2))) ## test for NULL case in lapply l <- list(a=1,2,c=-1) f <- function(z) if (z<0) return(NULL) else return(2*z) r1 <- lapply(l, f) r2 <- pblapply(l, f) r1 r2 stopifnot(identical(r1, r2)) pbapply/NAMESPACE0000644000176200001440000000052112625153462013144 0ustar liggesusersif (Sys.getenv("R_OSTYPE") == "windows" || .Platform$OS.type == "windows") { importFrom(utils, winProgressBar, getWinProgressBar, setWinProgressBar) } importFrom(utils, txtProgressBar, getTxtProgressBar, setTxtProgressBar) export(pbapply, pbsapply, pblapply, pbreplicate, startpb, setpb, getpb, closepb, dopb, pboptions) pbapply/R/0000755000176200001440000000000012625153462012130 5ustar liggesuserspbapply/R/pbreplicate.R0000644000176200001440000000022712625153462014546 0ustar liggesuserspbreplicate <- function (n, expr, simplify = "array") pbsapply(integer(n), eval.parent(substitute(function(...) expr)), simplify = simplify) pbapply/R/windows/0000755000176200001440000000000012625153462013622 5ustar liggesuserspbapply/R/windows/dopb.R0000644000176200001440000000047512625153462014677 0ustar liggesusersdopb <- function() { progress.bar <- getOption("pboptions")$type if (!is.null(progress.bar)) { progress.bar <- match.arg(progress.bar, c("txt", "win", "tk", "none")) if (progress.bar == "none") progress.bar <- NULL } interactive() && !is.null(progress.bar) } pbapply/R/windows/getpb.R0000644000176200001440000000046612625153462015054 0ustar liggesusersgetpb <- function(pb) { if (dopb()) { progress.bar <- getOption("pboptions")$type rval <- switch(progress.bar, txt = getTxtProgressBar(pb), win = getWinProgressBar(pb), tk = tcltk::getTkProgressBar(pb)) } else rval <- NULL rval } pbapply/R/windows/startpb.R0000644000176200001440000000125212625153462015424 0ustar liggesusersstartpb <- function(min=0, max=1) { if (dopb()) { control <- getOption("pboptions") pb <- switch(control$type, txt = txtProgressBar(min, max, initial=control$initial, style = control$style, width = control$txt.width, char = control$char), win = winProgressBar(min=min, max=max, initial=control$initial, title = control$title, label = control$label, width = control$gui.width), tk = tcltk::tkProgressBar(min=min, max=max, initial=control$initial, title = control$title, label = control$label, width = control$gui.width)) } else pb <- NULL invisible(pb) } pbapply/R/windows/setpb.R0000644000176200001440000000057512625153462015071 0ustar liggesuserssetpb <- function(pb, value) { if (dopb()) { control <- getOption("pboptions") rval <- switch(control$type, txt = setTxtProgressBar(pb, value), win = setWinProgressBar(pb, value, label=control$label), tk = tcltk::setTkProgressBar(pb, value, label=control$label)) } else rval <- NULL invisible(rval) } pbapply/R/unix/0000755000176200001440000000000012625153462013113 5ustar liggesuserspbapply/R/unix/dopb.R0000644000176200001440000000046612625153462014170 0ustar liggesusersdopb <- function() { progress.bar <- getOption("pboptions")$type if (!is.null(progress.bar)) { progress.bar <- match.arg(progress.bar, c("txt", "tk", "none")) if (progress.bar == "none") progress.bar <- NULL } interactive() && !is.null(progress.bar) } pbapply/R/unix/getpb.R0000644000176200001440000000041412625153462014336 0ustar liggesusersgetpb <- function(pb) { if (dopb()) { progress.bar <- getOption("pboptions")$type rval <- switch(progress.bar, txt = getTxtProgressBar(pb), tk = tcltk::getTkProgressBar(pb)) } else rval <- NULL rval } pbapply/R/unix/startpb.R0000644000176200001440000000100212625153462014706 0ustar liggesusersstartpb <- function(min=0, max=1) { if (dopb()) { control <- getOption("pboptions") pb <- switch(control$type, txt = txtProgressBar(min, max, initial=control$initial, style = control$style, width = control$txt.width, char = control$char), tk = tcltk::tkProgressBar(min=min, max=max, initial=control$initial, title = control$title, label = control$label, width = control$gui.width)) } else pb <- NULL invisible(pb) } pbapply/R/unix/setpb.R0000644000176200001440000000046712625153462014362 0ustar liggesuserssetpb <- function(pb, value) { if (dopb()) { control <- getOption("pboptions") rval <- switch(control$type, txt = setTxtProgressBar(pb, value), tk = tcltk::setTkProgressBar(pb, value, label=control$label)) } else rval <- NULL invisible(rval) } pbapply/R/pbapply.R0000644000176200001440000000610212625153462013721 0ustar liggesuserspbapply <- function (X, MARGIN, FUN, ...) { FUN <- match.fun(FUN) dl <- length(dim(X)) if (!dl) stop("dim(X) must have a positive length") if (is.object(X)) X <- if (dl == 2L) as.matrix(X) else as.array(X) d <- dim(X) dn <- dimnames(X) ds <- seq_len(dl) if (is.character(MARGIN)) { if (is.null(dnn <- names(dn))) stop("'X' must have named dimnames") MARGIN <- match(MARGIN, dnn) if (anyNA(MARGIN)) stop("not all elements of 'MARGIN' are names of dimensions") } s.call <- ds[-MARGIN] s.ans <- ds[MARGIN] d.call <- d[-MARGIN] d.ans <- d[MARGIN] dn.call <- dn[-MARGIN] dn.ans <- dn[MARGIN] d2 <- prod(d.ans) if (d2 == 0L) { newX <- array(vector(typeof(X), 1L), dim = c(prod(d.call), 1L)) ans <- forceAndCall(1, FUN, if (length(d.call) < 2L) newX[, 1] else array(newX[, 1L], d.call, dn.call), ...) return(if (is.null(ans)) ans else if (length(d.ans) < 2L) ans[1L][-1L] else array(ans, d.ans, dn.ans)) } newX <- aperm(X, c(s.call, s.ans)) dim(newX) <- c(prod(d.call), d2) ans <- vector("list", d2) pb <- startpb(0, d2) # pb_specific_code if (length(d.call) < 2L) { if (length(dn.call)) dimnames(newX) <- c(dn.call, list(NULL)) for (i in 1L:d2) { tmp <- forceAndCall(1, FUN, newX[, i], ...) if (!is.null(tmp)) ans[[i]] <- tmp setpb(pb, i) # pb_specific_code } } else for (i in 1L:d2) { tmp <- forceAndCall(1, FUN, array(newX[, i], d.call, dn.call), ...) if (!is.null(tmp)) ans[[i]] <- tmp setpb(pb, i) # pb_specific_code } closepb(pb) # pb_specific_code ans.list <- is.recursive(ans[[1L]]) l.ans <- length(ans[[1L]]) ans.names <- names(ans[[1L]]) if (!ans.list) ans.list <- any(unlist(lapply(ans, length)) != l.ans) if (!ans.list && length(ans.names)) { all.same <- vapply(ans, function(x) identical(names(x), ans.names), NA) if (!all(all.same)) ans.names <- NULL } len.a <- if (ans.list) d2 else length(ans <- unlist(ans, recursive = FALSE)) if (length(MARGIN) == 1L && len.a == d2) { names(ans) <- if (length(dn.ans[[1L]])) dn.ans[[1L]] return(ans) } if (len.a == d2) return(array(ans, d.ans, dn.ans)) if (len.a && len.a%%d2 == 0L) { if (is.null(dn.ans)) dn.ans <- vector(mode = "list", length(d.ans)) dn1 <- if (length(dn.call) && length(ans.names) == length(dn.call[[1L]])) dn.call[1L] else list(ans.names) dn.ans <- c(dn1, dn.ans) return(array(ans, c(len.a%/%d2, d.ans), if (!is.null(names(dn.ans)) || !all(vapply(dn.ans, is.null, NA))) dn.ans)) } return(ans) } pbapply/R/pboptions.R0000644000176200001440000000057512625153462014277 0ustar liggesuserspboptions <- function(...) { opar <- getOption("pboptions") args <- list(...) if (length(args)) { if (length(args)==1 && is.list(args[[1]])) { npar <- args[[1]] } else { npar <- opar npar[match(names(args), names(npar))] <- args } options("pboptions"=npar) } invisible(opar) } pbapply/R/pbsapply.R0000644000176200001440000000062412625153462014107 0ustar liggesuserspbsapply <- function (X, FUN, ..., simplify = TRUE, USE.NAMES = TRUE) { FUN <- match.fun(FUN) answer <- pblapply(X = X, FUN = FUN, ...) # pb_specific_code if (USE.NAMES && is.character(X) && is.null(names(answer))) names(answer) <- X if (!identical(simplify, FALSE) && length(answer)) simplify2array(answer, higher = (simplify == "array")) else answer } pbapply/R/pblapply.R0000644000176200001440000000067512625153462014106 0ustar liggesuserspblapply <- function (X, FUN, ...) { FUN <- match.fun(FUN) if (!is.vector(X) || is.object(X)) X <- as.list(X) B <- length(X) if (!(interactive() && dopb() && B >= 1)) return(lapply(X, FUN, ...)) pb <- startpb(0, B) rval <- vector("list", B) for (i in 1:B) { rval[i] <- list(FUN(X[[i]], ...)) setpb(pb, i) } close(pb) names(rval) <- names(X) rval } pbapply/R/closepb.R0000644000176200001440000000013212625153462013676 0ustar liggesusersclosepb <- function(pb) if (is.null(pb)) invisible(NULL) else close(pb) pbapply/R/zzz.R0000644000176200001440000000055412625153462013114 0ustar liggesusers.onLoad <- function(libname, pkgname){ if (is.null(getOption("pboptions"))) options("pboptions"=list(type="txt", char="+", txt.width=50, gui.width=300, style=3, initial=0, title="R progress bar", label="")) invisible(NULL) } .onUnload <- function(libpath){ options("pboptions"=NULL) invisible(NULL) } pbapply/MD50000644000176200001440000000177312625165706012253 0ustar liggesusersbadf18455877103e846b35d478ee82cd *DESCRIPTION 0e4fec8b5e37ccc7d06d4203b3acc231 *NAMESPACE 178d8a843fd01f8e5968a2040e40ed51 *R/closepb.R 394b77aae0a3e0f6e6c14a349b1ab175 *R/pbapply.R 9d26834a07284c218a07a37ac866b3ff *R/pblapply.R 13fbfb5aabeadfe8e67088d674315061 *R/pboptions.R cef7560e586710dc6e68330216dd9080 *R/pbreplicate.R 7b3f3f92847dd3815e0c8a03926c61d8 *R/pbsapply.R c82e65d8522884460bc3c9b219140878 *R/unix/dopb.R bfbda3087e5af96d27d719d225338ddf *R/unix/getpb.R f286024b6cd0cdd5b58eb686dd7c7588 *R/unix/setpb.R d34f1b434df5b2cc1909c9d2ff514e0d *R/unix/startpb.R 3c99369dbbb2e6bdea6e04e2a620fc37 *R/windows/dopb.R 9a1b072ea37e8dc30770c6381683f423 *R/windows/getpb.R 514f8bb3db324d9ab299f4cfb4b048ce *R/windows/setpb.R 9cc645e5fc2d13c8998ba19983ec3311 *R/windows/startpb.R 3eef430429c51829c9c21dd570f22fa9 *R/zzz.R 3a959a314344a7065667e5275aad3b32 *inst/ChangeLog 27f6a88705a9d730f8e06ca1afb949f7 *man/pbapply.Rd 9b09d9f7ddfb93adbefe2e23254c1c0a *man/pboptions.Rd f679e4e4972fb9bfe188ac1cd5a51027 *tests/tests.R pbapply/DESCRIPTION0000644000176200001440000000115012625165706013436 0ustar liggesusersPackage: pbapply Type: Package Title: Adding Progress Bar to '*apply' Functions Version: 1.1-3 Date: 2015-10-24 Author: Peter Solymos Maintainer: Peter Solymos Description: A lightweight package that adds progress bar to vectorized R functions ('*apply'). The implementation can easily be added to functions, where showing the progress is useful for the user (e.g. bootstrap). Depends: R (>= 3.2.0) License: GPL-2 URL: https://github.com/psolymos/pbapply LazyLoad: yes NeedsCompilation: no Packaged: 2015-11-24 21:31:30 UTC; Peter Repository: CRAN Date/Publication: 2015-11-24 23:59:18 pbapply/man/0000755000176200001440000000000012625153462012502 5ustar liggesuserspbapply/man/pboptions.Rd0000644000176200001440000000747312625153462015021 0ustar liggesusers\name{pboptions} \alias{pboptions} \alias{startpb} \alias{setpb} \alias{getpb} \alias{closepb} \alias{dopb} \title{ Creating Progress Bar and Setting Options } \description{ Creating progress bar and setting options. } \usage{ pboptions(...) startpb(min = 0, max = 1) setpb(pb, value) getpb(pb) closepb(pb) dopb() } \arguments{ \item{\dots}{ Arguments in \code{tag = value} form, or a list of tagged values. The tags must come from the parameters described below. } \item{pb}{ A progress bar object created by \code{startpb}. } \item{min, max}{ Finite numeric values for the extremes of the progress bar. Must have \code{min < max}. } \item{value}{ New value for the progress bar. } } \details{ \code{pboptions} is a convenient way of handling options related to progress bar. Other functions can be used for conveniently adding progress bar to \code{for}-like loops (see Examples). } \value{ When parameters are set by \code{pboptions}, their former values are returned in an invisible named list. Such a list can be passed as an argument to \code{pboptions} to restore the parameter values. Tags are the following: \item{type}{Type of the progress bar: text (\code{"txt"}), Windows (\code{"win"}), TclTk (\code{"tk"}), or none (\code{"none"}). Default value is \code{"txt"}.} \item{char}{The character (or character string) to form the progress bar. Default value is \code{"+"}.} \item{txt.width}{The width of the text based progress bar, as a multiple of the width of \code{char}. If \code{NA}, the number of characters is that which fits into \code{getOption("width")}. Default value is \code{50}.} \item{gui.width}{The width of the GUI based progress bar in pixels: the dialogue box will be 40 pixels wider (plus frame). Default value is \code{300}.} \item{style}{The style of the bar, see \code{\link[utils]{txtProgressBar}}. Default value is \code{3}.} \item{initial}{Initial value for the progress bar. Default value is \code{0}.} \item{title}{Character string giving the window title on the GUI dialogue box. Default value is \code{"R progress bar"}.} \item{label}{Character string giving the window label on the GUI dialogue box. Default value is \code{""}.} For \code{startpb} a progress bar object. For \code{getpb} and \code{setpb}, a length-one numeric vector giving the previous value (invisibly for \code{setpb}). The return value is \code{NULL} if the progress bar is turned off by \code{getOption("pbapply.pb")} (\code{"none"} or \code{NULL} value). \code{dopb} returns a logical value if progress bar is to be shown based on the option \code{getOption("pbapply.pb")}. It is \code{FALSE} if the type of progress bar is \code{"none"} or \code{NULL}. For \code{closepb} closes the connection for the progress bar. } \author{ Peter Solymos } \seealso{ Progress bars used in the functions: #ifdef windows \code{\link[utils]{winProgressBar}}, #endif \code{\link[utils]{txtProgressBar}}, \code{\link[tcltk]{tkProgressBar}} } \examples{ ## for loop fun1 <- function() { pb <- startpb(0, 10) on.exit(closepb(pb)) for (i in 1:10) { Sys.sleep(0.15) setpb(pb, i) } invisible(NULL) } ## while loop fun2 <- function() { pb <- startpb(0, 10-1) on.exit(closepb(pb)) i <- 1 while (i < 10) { Sys.sleep(0.15) setpb(pb, i) i <- i + 1 } invisible(NULL) } ## using original settings fun1() ## resetting pboptions opb <- pboptions(style=1, char=">") ## check new settings getOption("pboptions") ## running again with new settings fun2() ## resetting original pboptions(opb) ## check reset getOption("pboptions") fun1() } \keyword{ IO } \keyword{ utilities } pbapply/man/pbapply.Rd0000644000176200001440000001340212625153462014440 0ustar liggesusers\name{pbapply} \alias{pbapply} \alias{pbsapply} \alias{pblapply} \alias{pbreplicate} \title{ Adding Progress Bar to '*apply' Functions } \description{ Adding progress bar to \code{*apply} functions} \usage{ pblapply(X, FUN, ...) pbapply(X, MARGIN, FUN, ...) pbsapply(X, FUN, ..., simplify = TRUE, USE.NAMES = TRUE) pbreplicate(n, expr, simplify = "array") } \arguments{ \item{X}{ For \code{pbsapply} and \code{pblapply}, a vector (atomic or list) or an expressions vector (other objects including classed objects will be coerced by \code{\link{as.list}}.) For \code{pbapply} an array, including a matrix. } \item{MARGIN}{ A vector giving the subscripts which the function will be applied over. \code{1} indicates rows, \code{2} indicates columns, \code{c(1,2)} indicates rows and columns. } \item{FUN}{ The function to be applied to each element of \code{X}: see \code{\link{apply}}, \code{\link{sapply}}, and \code{\link{lapply}}. } \item{\dots}{ Optional arguments to \code{FUN}. } \item{simplify}{ Logical; should the result be simplified to a vector or matrix if possible? } \item{USE.NAMES}{ Logical; if \code{TRUE} and if \code{X} is character, use \code{X} as names for the result unless it had names already. } \item{n}{ Number of replications. } \item{expr}{ Expression (language object, usually a call) to evaluate repeatedly. } } \details{ The behaviour of the progress bar is controlled by the option \code{type} in \code{\link{pboptions}}, it can take values \code{c("txt", "win", "tk", "none",)} on Windows, and \code{c("txt", "tk", "none",)} on Unix systems. Other options have elements that are arguments used in the functions \code{\link[utils]{txtProgressBar}} (for \code{"pbapply.txt"} option), #ifdef windows \code{\link[utils]{winProgressBar}}, #endif and \code{\link[tcltk]{tkProgressBar}}. See \code{\link{pboptions}} for how to conveniently set these. } \value{ Similar to the value returned by the standard \code{*apply} functions. A progress bar is showed as a side effect. } \author{ Peter Solymos } \note{ Progress bar can add an overhead to the computation. } \seealso{ Progress bars used in the functions: #ifdef windows \code{\link[utils]{winProgressBar}}, #endif \code{\link[utils]{txtProgressBar}}, \code{\link[tcltk]{tkProgressBar}} Standard \code{*apply} functions: \code{\link{apply}}, \code{\link{sapply}}, \code{\link{lapply}}, \code{\link{replicate}} Setting the options: \code{\link{pboptions}} Conveniently add progress bar to \code{for}-like loops: \code{\link{startpb}}, \code{\link{setpb}}, \code{\link{getpb}}, \code{\link{closepb}} } \examples{ ## --- simple linear model simulation --- n <- 200 x <- rnorm(n) y <- rnorm(n, model.matrix(~x) \%*\% c(0,1), sd=0.5) d <- data.frame(y, x) ## model fitting and bootstrap mod <- lm(y~x, d) ndat <- model.frame(mod) B <- 100 bid <- sapply(1:B, function(i) sample(nrow(ndat), nrow(ndat), TRUE)) fun <- function(z) { ndat <- ndat[sample(nrow(ndat), nrow(ndat), TRUE),] coef(lm(mod$call$formula, data=ndat[z,])) } ## standard '*apply' functions system.time(res1 <- lapply(1:B, function(i) fun(bid[,i]))) system.time(res2 <- sapply(1:B, function(i) fun(bid[,i]))) system.time(res3 <- apply(bid, 2, fun)) ## 'pb*apply' functions ## try different settings: ## "none", "txt", "tk" options("pbapply.pb"="txt") system.time(res4 <- pblapply(1:B, function(i) fun(bid[,i]))) system.time(res5 <- pbsapply(1:B, function(i) fun(bid[,i]))) system.time(res6 <- pbapply(bid, 2, fun)) ## --- Examples taken from standard '*apply' functions --- ## --- sapply, lapply, and replicate --- require(stats); require(graphics) x <- list(a = 1:10, beta = exp(-3:3), logic = c(TRUE,FALSE,FALSE,TRUE)) # compute the list mean for each list element pblapply(x, mean) # median and quartiles for each list element pblapply(x, quantile, probs = 1:3/4) pbsapply(x, quantile) i39 <- sapply(3:9, seq) # list of vectors pbsapply(i39, fivenum) ## sapply(*, "array") -- artificial example (v <- structure(10*(5:8), names = LETTERS[1:4])) f2 <- function(x, y) outer(rep(x, length.out = 3), y) (a2 <- pbsapply(v, f2, y = 2*(1:5), simplify = "array")) hist(pbreplicate(100, mean(rexp(10)))) ## use of replicate() with parameters: foo <- function(x = 1, y = 2) c(x, y) # does not work: bar <- function(n, ...) replicate(n, foo(...)) bar <- function(n, x) pbreplicate(n, foo(x = x)) bar(5, x = 3) ## --- apply --- ## Compute row and column sums for a matrix: x <- cbind(x1 = 3, x2 = c(4:1, 2:5)) dimnames(x)[[1]] <- letters[1:8] pbapply(x, 2, mean, trim = .2) col.sums <- pbapply(x, 2, sum) row.sums <- pbapply(x, 1, sum) rbind(cbind(x, Rtot = row.sums), Ctot = c(col.sums, sum(col.sums))) stopifnot( pbapply(x, 2, is.vector)) ## Sort the columns of a matrix pbapply(x, 2, sort) ## keeping named dimnames names(dimnames(x)) <- c("row", "col") x3 <- array(x, dim = c(dim(x),3), dimnames = c(dimnames(x), list(C = paste0("cop.",1:3)))) identical(x, pbapply( x, 2, identity)) identical(x3, pbapply(x3, 2:3, identity)) ##- function with extra args: cave <- function(x, c1, c2) c(mean(x[c1]), mean(x[c2])) pbapply(x, 1, cave, c1 = "x1", c2 = c("x1","x2")) ma <- matrix(c(1:4, 1, 6:8), nrow = 2) ma pbapply(ma, 1, table) #--> a list of length 2 pbapply(ma, 1, stats::quantile) # 5 x n matrix with rownames stopifnot(dim(ma) == dim(pbapply(ma, 1:2, sum))) ## Example with different lengths for each call z <- array(1:24, dim = 2:4) zseq <- pbapply(z, 1:2, function(x) seq_len(max(x))) zseq ## a 2 x 3 matrix typeof(zseq) ## list dim(zseq) ## 2 3 zseq[1,] pbapply(z, 3, function(x) seq_len(max(x))) # a list without a dim attribute } \keyword{ manip } \keyword{ utilities }