R Under development (unstable) (2025-07-18 r88431 ucrt) -- "Unsuffered Consequences" Copyright (C) 2025 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > #devtools::install_github("psolymos/pbapply") > > ## --- standard examples --- > > library(pbapply) > > example(apply) apply> ## Compute row and column sums for a matrix: apply> x <- cbind(x1 = 3, x2 = c(4:1, 2:5)) apply> dimnames(x)[[1]] <- letters[1:8] apply> apply(x, 2, mean, trim = .2) x1 x2 3 3 apply> col.sums <- apply(x, 2, sum) apply> row.sums <- apply(x, 1, sum) apply> rbind(cbind(x, Rtot = row.sums), Ctot = c(col.sums, sum(col.sums))) x1 x2 Rtot a 3 4 7 b 3 3 6 c 3 2 5 d 3 1 4 e 3 2 5 f 3 3 6 g 3 4 7 h 3 5 8 Ctot 24 24 48 apply> stopifnot( apply(x, 2, is.vector)) apply> ## Sort the columns of a matrix apply> apply(x, 2, sort) x1 x2 [1,] 3 1 [2,] 3 2 [3,] 3 2 [4,] 3 3 [5,] 3 3 [6,] 3 4 [7,] 3 4 [8,] 3 5 apply> ## keeping named dimnames apply> names(dimnames(x)) <- c("row", "col") apply> x3 <- array(x, dim = c(dim(x),3), apply+ dimnames = c(dimnames(x), list(C = paste0("cop.",1:3)))) apply> identical(x, apply( x, 2, identity)) [1] TRUE apply> identical(x3, apply(x3, 2:3, identity)) [1] TRUE apply> ## Don't show: apply> xN <- x; dimnames(xN) <- list(row=NULL, col=NULL) apply> x2 <- x; names(dimnames(x2)) <- NULL apply> fXY <- function(u) c(X=u[1], Y=u[2]) apply> ax1 <- apply(x, 1, fXY) apply> ax2 <- apply(x2,1, fXY) apply> stopifnot(identical(dimnames(ax1), list(col=c("X.x1", "Y.x2"), row=letters[1:8])), apply+ identical(dimnames(ax2), unname(dimnames(ax1))), apply+ identical( x, apply( x, 2, identity)), apply+ identical(xN, apply(xN, 2, identity)), apply+ identical(dimnames(x), apply+ dimnames(apply(x, 2, format))), apply+ identical(x3, apply(x3, 2:3, identity)), apply+ identical(dimnames(apply(x3, 2:1, identity)), apply+ dimnames(x3)[3:1])) apply> rm(xN, x2, fXY, ax1, ax2) apply> ## End(Don't show) apply> ##- function with extra args: apply> cave <- function(x, c1, c2) c(mean(x[c1]), mean(x[c2])) apply> apply(x, 1, cave, c1 = "x1", c2 = c("x1","x2")) row a b c d e f g h [1,] 3.0 3 3.0 3 3.0 3 3.0 3 [2,] 3.5 3 2.5 2 2.5 3 3.5 4 apply> ma <- matrix(c(1:4, 1, 6:8), nrow = 2) apply> ma [,1] [,2] [,3] [,4] [1,] 1 3 1 7 [2,] 2 4 6 8 apply> apply(ma, 1, table) #--> a list of length 2 [[1]] 1 3 7 2 1 1 [[2]] 2 4 6 8 1 1 1 1 apply> apply(ma, 1, stats::quantile) # 5 x n matrix with rownames [,1] [,2] 0% 1 2.0 25% 1 3.5 50% 2 5.0 75% 4 6.5 100% 7 8.0 apply> stopifnot(dim(ma) == dim(apply(ma, 1:2, sum))) apply> ## Example with different lengths for each call apply> z <- array(1:24, dim = 2:4) apply> zseq <- apply(z, 1:2, function(x) seq_len(max(x))) apply> zseq ## a 2 x 3 matrix [,1] [,2] [,3] [1,] integer,19 integer,21 integer,23 [2,] integer,20 integer,22 integer,24 apply> typeof(zseq) ## list [1] "list" apply> dim(zseq) ## 2 3 [1] 2 3 apply> zseq[1,] [[1]] [1] 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 [[2]] [1] 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 [[3]] [1] 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 apply> apply(z, 3, function(x) seq_len(max(x))) [[1]] [1] 1 2 3 4 5 6 [[2]] [1] 1 2 3 4 5 6 7 8 9 10 11 12 [[3]] [1] 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 [[4]] [1] 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 apply> # a list without a dim attribute apply> apply> apply> > example(lapply) lapply> require(stats); require(graphics) lapply> x <- list(a = 1:10, beta = exp(-3:3), logic = c(TRUE,FALSE,FALSE,TRUE)) lapply> # compute the list mean for each list element lapply> lapply(x, mean) $a [1] 5.5 $beta [1] 4.535125 $logic [1] 0.5 lapply> # median and quartiles for each list element lapply> lapply(x, quantile, probs = 1:3/4) $a 25% 50% 75% 3.25 5.50 7.75 $beta 25% 50% 75% 0.2516074 1.0000000 5.0536690 $logic 25% 50% 75% 0.0 0.5 1.0 lapply> sapply(x, quantile) a beta logic 0% 1.00 0.04978707 0.0 25% 3.25 0.25160736 0.0 50% 5.50 1.00000000 0.5 75% 7.75 5.05366896 1.0 100% 10.00 20.08553692 1.0 lapply> i39 <- sapply(3:9, seq) # list of vectors lapply> sapply(i39, fivenum) [,1] [,2] [,3] [,4] [,5] [,6] [,7] [1,] 1.0 1.0 1 1.0 1.0 1.0 1 [2,] 1.5 1.5 2 2.0 2.5 2.5 3 [3,] 2.0 2.5 3 3.5 4.0 4.5 5 [4,] 2.5 3.5 4 5.0 5.5 6.5 7 [5,] 3.0 4.0 5 6.0 7.0 8.0 9 lapply> vapply(i39, fivenum, lapply+ c(Min. = 0, "1st Qu." = 0, Median = 0, "3rd Qu." = 0, Max. = 0)) [,1] [,2] [,3] [,4] [,5] [,6] [,7] Min. 1.0 1.0 1 1.0 1.0 1.0 1 1st Qu. 1.5 1.5 2 2.0 2.5 2.5 3 Median 2.0 2.5 3 3.5 4.0 4.5 5 3rd Qu. 2.5 3.5 4 5.0 5.5 6.5 7 Max. 3.0 4.0 5 6.0 7.0 8.0 9 lapply> ## sapply(*, "array") -- artificial example lapply> (v <- structure(10*(5:8), names = LETTERS[1:4])) A B C D 50 60 70 80 lapply> f2 <- function(x, y) outer(rep(x, length.out = 3), y) lapply> (a2 <- sapply(v, f2, y = 2*(1:5), simplify = "array")) , , A [,1] [,2] [,3] [,4] [,5] [1,] 100 200 300 400 500 [2,] 100 200 300 400 500 [3,] 100 200 300 400 500 , , B [,1] [,2] [,3] [,4] [,5] [1,] 120 240 360 480 600 [2,] 120 240 360 480 600 [3,] 120 240 360 480 600 , , C [,1] [,2] [,3] [,4] [,5] [1,] 140 280 420 560 700 [2,] 140 280 420 560 700 [3,] 140 280 420 560 700 , , D [,1] [,2] [,3] [,4] [,5] [1,] 160 320 480 640 800 [2,] 160 320 480 640 800 [3,] 160 320 480 640 800 lapply> a.2 <- vapply(v, f2, outer(1:3, 1:5), y = 2*(1:5)) lapply> stopifnot(dim(a2) == c(3,5,4), all.equal(a2, a.2), lapply+ identical(dimnames(a2), list(NULL,NULL,LETTERS[1:4]))) lapply> hist(replicate(100, mean(rexp(10)))) lapply> ## use of replicate() with parameters: lapply> foo <- function(x = 1, y = 2) c(x, y) lapply> # does not work: bar <- function(n, ...) replicate(n, foo(...)) lapply> bar <- function(n, x) replicate(n, foo(x = x)) lapply> bar(5, x = 3) [,1] [,2] [,3] [,4] [,5] [1,] 3 3 3 3 3 [2,] 2 2 2 2 2 > > ## run examples without progress bar > pboptions(type = "none") > example(splitpb, run.dontrun = TRUE) spltpb> ## define 1 job / worker at a time and repeat spltpb> splitpb(10, 4) [[1]] [1] 1 2 3 4 [[2]] [1] 5 6 7 8 [[3]] [1] 9 10 spltpb> ## compare this to the no-progress-bar split spltpb> ## that defines all the jubs / worker up front spltpb> parallel::splitIndices(10, 4) [[1]] [1] 1 2 3 [[2]] [1] 4 5 [[3]] [1] 6 7 [[4]] [1] 8 9 10 spltpb> ## cap the length of the output spltpb> splitpb(20, 2, nout = NULL) [[1]] [1] 1 2 [[2]] [1] 3 4 [[3]] [1] 5 6 [[4]] [1] 7 8 [[5]] [1] 9 10 [[6]] [1] 11 12 [[7]] [1] 13 14 [[8]] [1] 15 16 [[9]] [1] 17 18 [[10]] [1] 19 20 spltpb> splitpb(20, 2, nout = 5) [[1]] [1] 1 2 3 4 [[2]] [1] 5 6 7 8 [[3]] [1] 9 10 11 12 [[4]] [1] 13 14 15 16 [[5]] [1] 17 18 19 20 > example(timerProgressBar, run.dontrun = TRUE) tmrPrB> ## increase sluggishness to admire the progress bar longer tmrPrB> sluggishness <- 0.02 tmrPrB> test_fun <- function(...) tmrPrB+ { tmrPrB+ pb <- timerProgressBar(...) tmrPrB+ on.exit(close(pb)) tmrPrB+ for (i in seq(0, 1, 0.05)) { tmrPrB+ Sys.sleep(sluggishness) tmrPrB+ setTimerProgressBar(pb, i) tmrPrB+ } tmrPrB+ invisible(NULL) tmrPrB+ } tmrPrB> ## check the different styles tmrPrB> test_fun(width = 35, char = "+", style = 1) | | 0 % elapsed=00s | | 0 % elapsed=00s |++ | 5 % elapsed=00s, remaining~02s |++++ | 10% elapsed=00s, remaining~01s |++++++ | 15% elapsed=00s, remaining~01s |+++++++ | 20% elapsed=00s, remaining~01s |+++++++++ | 25% elapsed=00s, remaining~01s |+++++++++++ | 30% elapsed=00s, remaining~01s |+++++++++++++ | 35% elapsed=00s, remaining~01s |++++++++++++++ | 40% elapsed=00s, remaining~00s |++++++++++++++++ | 45% elapsed=00s, remaining~00s |++++++++++++++++++ | 50% elapsed=00s, remaining~00s |++++++++++++++++++++ | 55% elapsed=00s, remaining~00s |++++++++++++++++++++++ | 60% elapsed=00s, remaining~00s |+++++++++++++++++++++++ | 65% elapsed=00s, remaining~00s |+++++++++++++++++++++++++ | 70% elapsed=00s, remaining~00s |+++++++++++++++++++++++++++ | 75% elapsed=01s, remaining~00s |++++++++++++++++++++++++++++ | 80% elapsed=01s, remaining~00s |++++++++++++++++++++++++++++++ | 85% elapsed=01s, remaining~00s |++++++++++++++++++++++++++++++++ | 90% elapsed=01s, remaining~00s |++++++++++++++++++++++++++++++++++ | 95% elapsed=01s, remaining~00s |+++++++++++++++++++++++++++++++++++| 100% elapsed=01s, remaining~00s tmrPrB> test_fun(style = 2) / 0 % elapsed=00s / 0 % elapsed=00s - 5 % elapsed=00s, remaining~01s \ 10% elapsed=00s, remaining~01s | 15% elapsed=00s, remaining~01s / 20% elapsed=00s, remaining~01s - 25% elapsed=00s, remaining~01s \ 30% elapsed=00s, remaining~01s | 35% elapsed=00s, remaining~00s / 40% elapsed=00s, remaining~00s - 45% elapsed=00s, remaining~00s \ 50% elapsed=00s, remaining~00s | 55% elapsed=00s, remaining~00s / 60% elapsed=00s, remaining~00s - 65% elapsed=00s, remaining~00s \ 70% elapsed=00s, remaining~00s | 75% elapsed=00s, remaining~00s / 80% elapsed=01s, remaining~00s - 85% elapsed=01s, remaining~00s \ 90% elapsed=01s, remaining~00s | 95% elapsed=01s, remaining~00s / 100% elapsed=01s, remaining~00s tmrPrB> test_fun(width = 50, char = ".", style = 3) | | 0 % ~calculating | | 0 % ~calculating |... | 5 % ~01s |..... | 10% ~01s |........ | 15% ~01s |.......... | 20% ~01s |............. | 25% ~01s |................ | 30% ~01s |.................. | 35% ~00s |.................... | 40% ~00s |....................... | 45% ~00s |......................... | 50% ~00s |............................ | 55% ~00s |............................... | 60% ~00s |................................. | 65% ~00s |................................... | 70% ~00s |...................................... | 75% ~00s |........................................ | 80% ~00s |........................................... | 85% ~00s |............................................. | 90% ~00s |................................................ | 95% ~00s |..................................................| 100% elapsed=01s tmrPrB> test_fun(style = 4) / 0 % ~calculating / 0 % ~calculating - 5 % ~01s \ 10% ~01s | 15% ~01s / 20% ~01s - 25% ~01s \ 30% ~00s | 35% ~00s / 40% ~00s - 45% ~00s \ 50% ~00s | 55% ~00s / 60% ~00s - 65% ~00s \ 70% ~00s | 75% ~00s / 80% ~00s - 85% ~00s \ 90% ~00s | 95% ~00s / 100% elapsed=01s tmrPrB> test_fun(width = 35, char = "[=-]", style = 5) [-----------------------------------] 0 % elapsed=00s [-----------------------------------] 0 % elapsed=00s [==---------------------------------] 5 % elapsed=00s, remaining~01s [====-------------------------------] 10% elapsed=00s, remaining~01s [======-----------------------------] 15% elapsed=00s, remaining~01s [=======----------------------------] 20% elapsed=00s, remaining~01s [=========--------------------------] 25% elapsed=00s, remaining~01s [===========------------------------] 30% elapsed=00s, remaining~01s [=============----------------------] 35% elapsed=00s, remaining~00s [==============---------------------] 40% elapsed=00s, remaining~00s [================-------------------] 45% elapsed=00s, remaining~00s [==================-----------------] 50% elapsed=00s, remaining~00s [====================---------------] 55% elapsed=00s, remaining~00s [======================-------------] 60% elapsed=00s, remaining~00s [=======================------------] 65% elapsed=00s, remaining~00s [=========================----------] 70% elapsed=00s, remaining~00s [===========================--------] 75% elapsed=00s, remaining~00s [============================-------] 80% elapsed=01s, remaining~00s [==============================-----] 85% elapsed=01s, remaining~00s [================================---] 90% elapsed=01s, remaining~00s [==================================-] 95% elapsed=01s, remaining~00s [===================================] 100% elapsed=01s, remaining~00s tmrPrB> test_fun(width = 50, char = "{*.}", style = 6) {..................................................} 0 % ~calculating {..................................................} 0 % ~calculating {***...............................................} 5 % ~01s {*****.............................................} 10% ~01s {********..........................................} 15% ~01s {**********........................................} 20% ~01s {*************.....................................} 25% ~01s {****************..................................} 30% ~01s {******************................................} 35% ~00s {********************..............................} 40% ~00s {***********************...........................} 45% ~00s {*************************.........................} 50% ~00s {****************************......................} 55% ~00s {*******************************...................} 60% ~00s {*********************************.................} 65% ~00s {***********************************...............} 70% ~00s {**************************************............} 75% ~00s {****************************************..........} 80% ~00s {*******************************************.......} 85% ~00s {*********************************************.....} 90% ~00s {************************************************..} 95% ~00s {**************************************************} 100% elapsed=01s tmrPrB> ## no bar only percent and elapsed tmrPrB> test_fun(width = 0, char = " ", style = 6) 0 % ~calculating 0 % ~calculating 5 % ~01s 10% ~01s 15% ~01s 20% ~01s 25% ~01s 30% ~01s 35% ~00s 40% ~00s 45% ~00s 50% ~00s 55% ~00s 60% ~00s 65% ~00s 70% ~00s 75% ~00s 80% ~00s 85% ~00s 90% ~00s 95% ~00s 100% elapsed=01s tmrPrB> ## this should produce a progress bar based on min_time tmrPrB> (elapsed <- system.time(test_fun(width = 35, min_time = 0))["elapsed"]) | | 0 % elapsed=00s | | 0 % elapsed=00s |== | 5 % elapsed=00s, remaining~01s |==== | 10% elapsed=00s, remaining~01s |====== | 15% elapsed=00s, remaining~01s |======= | 20% elapsed=00s, remaining~01s |========= | 25% elapsed=00s, remaining~01s |=========== | 30% elapsed=00s, remaining~01s |============= | 35% elapsed=00s, remaining~00s |============== | 40% elapsed=00s, remaining~00s |================ | 45% elapsed=00s, remaining~00s |================== | 50% elapsed=00s, remaining~00s |==================== | 55% elapsed=00s, remaining~00s |====================== | 60% elapsed=00s, remaining~00s |======================= | 65% elapsed=00s, remaining~00s |========================= | 70% elapsed=00s, remaining~00s |=========================== | 75% elapsed=00s, remaining~00s |============================ | 80% elapsed=01s, remaining~00s |============================== | 85% elapsed=01s, remaining~00s |================================ | 90% elapsed=01s, remaining~00s |================================== | 95% elapsed=01s, remaining~00s |===================================| 100% elapsed=01s, remaining~00s elapsed 0.66 tmrPrB> ## this should not produce a progress bar based on min_time tmrPrB> system.time(test_fun(min_time = 2 * elapsed))["elapsed"] elapsed 0.66 tmrPrB> ## time formatting tmrPrB> getTimeAsString(NULL) [1] "calculating" tmrPrB> getTimeAsString(15) [1] "15s" tmrPrB> getTimeAsString(65) [1] "01m 05s" tmrPrB> getTimeAsString(6005) [1] "01h 40m 05s" tmrPrB> ## example usage of getTimeAsString, use sluggishness <- 1 tmrPrB> n <- 10 tmrPrB> t0 <- proc.time()[3] tmrPrB> ETA <- NULL tmrPrB> for (i in seq_len(n)) { tmrPrB+ cat(i, "/", n, "- ETA:", getTimeAsString(ETA)) tmrPrB+ flush.console() tmrPrB+ Sys.sleep(sluggishness) tmrPrB+ dt <- proc.time()[3] - t0 tmrPrB+ cat(" - elapsed:", getTimeAsString(dt), "\n") tmrPrB+ ETA <- (n - i) * dt / i tmrPrB+ } 1 / 10 - ETA: calculating - elapsed: 00s 2 / 10 - ETA: 00s - elapsed: 00s 3 / 10 - ETA: 00s - elapsed: 00s 4 / 10 - ETA: 00s - elapsed: 00s 5 / 10 - ETA: 00s - elapsed: 00s 6 / 10 - ETA: 00s - elapsed: 00s 7 / 10 - ETA: 00s - elapsed: 00s 8 / 10 - ETA: 00s - elapsed: 00s 9 / 10 - ETA: 00s - elapsed: 00s 10 / 10 - ETA: 00s - elapsed: 00s > example(pbapply, run.dontrun = TRUE) pbpply> ## --- simple linear model simulation --- pbpply> set.seed(1234) pbpply> n <- 200 pbpply> x <- rnorm(n) pbpply> y <- rnorm(n, crossprod(t(model.matrix(~ x)), c(0, 1)), sd = 0.5) pbpply> d <- data.frame(y, x) pbpply> ## model fitting and bootstrap pbpply> mod <- lm(y ~ x, d) pbpply> ndat <- model.frame(mod) pbpply> B <- 100 pbpply> bid <- sapply(1:B, function(i) sample(nrow(ndat), nrow(ndat), TRUE)) pbpply> fun <- function(z) { pbpply+ if (missing(z)) pbpply+ z <- sample(nrow(ndat), nrow(ndat), TRUE) pbpply+ coef(lm(mod$call$formula, data=ndat[z,])) pbpply+ } pbpply> ## standard '*apply' functions pbpply> system.time(res1 <- lapply(1:B, function(i) fun(bid[,i]))) user system elapsed 0.14 0.00 0.14 pbpply> system.time(res2 <- sapply(1:B, function(i) fun(bid[,i]))) user system elapsed 0.13 0.00 0.12 pbpply> system.time(res3 <- apply(bid, 2, fun)) user system elapsed 0.10 0.02 0.11 pbpply> system.time(res4 <- replicate(B, fun())) user system elapsed 0.10 0.00 0.09 pbpply> ## 'pb*apply' functions pbpply> ## try different settings: pbpply> ## "none", "txt", "tk", "win", "timer" pbpply> op <- pboptions(type = "timer") # default pbpply> system.time(res1pb <- pblapply(1:B, function(i) fun(bid[,i]))) | | 0 % ~calculating |+ | 1 % ~01s |+ | 2 % ~00s |++ | 3 % ~00s |++ | 4 % ~00s |+++ | 5 % ~00s |+++ | 6 % ~00s |++++ | 7 % ~00s |++++ | 8 % ~00s |+++++ | 9 % ~00s |+++++ | 10% ~00s |++++++ | 11% ~00s |++++++ | 12% ~00s |+++++++ | 13% ~00s |+++++++ | 14% ~00s |++++++++ | 15% ~00s |++++++++ | 16% ~00s |+++++++++ | 17% ~00s |+++++++++ | 18% ~00s |++++++++++ | 19% ~00s |++++++++++ | 20% ~00s |+++++++++++ | 21% ~00s |+++++++++++ | 22% ~00s |++++++++++++ | 23% ~00s |++++++++++++ | 24% ~00s |+++++++++++++ | 25% ~00s |+++++++++++++ | 26% ~00s |++++++++++++++ | 27% ~00s |++++++++++++++ | 28% ~00s |+++++++++++++++ | 29% ~00s |+++++++++++++++ | 30% ~00s |++++++++++++++++ | 31% ~00s |++++++++++++++++ | 32% ~00s |+++++++++++++++++ | 33% ~00s |+++++++++++++++++ | 34% ~00s |++++++++++++++++++ | 35% ~00s |++++++++++++++++++ | 36% ~00s |+++++++++++++++++++ | 37% ~00s |+++++++++++++++++++ | 38% ~00s |++++++++++++++++++++ | 39% ~00s |++++++++++++++++++++ | 40% ~00s |+++++++++++++++++++++ | 41% ~00s |+++++++++++++++++++++ | 42% ~00s |++++++++++++++++++++++ | 43% ~00s |++++++++++++++++++++++ | 44% ~00s |+++++++++++++++++++++++ | 45% ~00s |+++++++++++++++++++++++ | 46% ~00s |++++++++++++++++++++++++ | 47% ~00s |++++++++++++++++++++++++ | 48% ~00s |+++++++++++++++++++++++++ | 49% ~00s |+++++++++++++++++++++++++ | 50% ~00s |++++++++++++++++++++++++++ | 51% ~00s |++++++++++++++++++++++++++ | 52% ~00s |+++++++++++++++++++++++++++ | 53% ~00s |+++++++++++++++++++++++++++ | 54% ~00s |++++++++++++++++++++++++++++ | 55% ~00s |++++++++++++++++++++++++++++ | 56% ~00s |+++++++++++++++++++++++++++++ | 57% ~00s |+++++++++++++++++++++++++++++ | 58% ~00s |++++++++++++++++++++++++++++++ | 59% ~00s |++++++++++++++++++++++++++++++ | 60% ~00s |+++++++++++++++++++++++++++++++ | 61% ~00s |+++++++++++++++++++++++++++++++ | 62% ~00s |++++++++++++++++++++++++++++++++ | 63% ~00s |++++++++++++++++++++++++++++++++ | 64% ~00s |+++++++++++++++++++++++++++++++++ | 65% ~00s |+++++++++++++++++++++++++++++++++ | 66% ~00s |++++++++++++++++++++++++++++++++++ | 67% ~00s |++++++++++++++++++++++++++++++++++ | 68% ~00s |+++++++++++++++++++++++++++++++++++ | 69% ~00s |+++++++++++++++++++++++++++++++++++ | 70% ~00s |++++++++++++++++++++++++++++++++++++ | 71% ~00s |++++++++++++++++++++++++++++++++++++ | 72% ~00s |+++++++++++++++++++++++++++++++++++++ | 73% ~00s |+++++++++++++++++++++++++++++++++++++ | 74% ~00s |++++++++++++++++++++++++++++++++++++++ | 75% ~00s |++++++++++++++++++++++++++++++++++++++ | 76% ~00s |+++++++++++++++++++++++++++++++++++++++ | 77% ~00s |+++++++++++++++++++++++++++++++++++++++ | 78% ~00s |++++++++++++++++++++++++++++++++++++++++ | 79% ~00s |++++++++++++++++++++++++++++++++++++++++ | 80% ~00s |+++++++++++++++++++++++++++++++++++++++++ | 81% ~00s |+++++++++++++++++++++++++++++++++++++++++ | 82% ~00s |++++++++++++++++++++++++++++++++++++++++++ | 83% ~00s |++++++++++++++++++++++++++++++++++++++++++ | 84% ~00s |+++++++++++++++++++++++++++++++++++++++++++ | 85% ~00s |+++++++++++++++++++++++++++++++++++++++++++ | 86% ~00s |++++++++++++++++++++++++++++++++++++++++++++ | 87% ~00s |++++++++++++++++++++++++++++++++++++++++++++ | 88% ~00s |+++++++++++++++++++++++++++++++++++++++++++++ | 89% ~00s |+++++++++++++++++++++++++++++++++++++++++++++ | 90% ~00s |++++++++++++++++++++++++++++++++++++++++++++++ | 91% ~00s |++++++++++++++++++++++++++++++++++++++++++++++ | 92% ~00s |+++++++++++++++++++++++++++++++++++++++++++++++ | 93% ~00s |+++++++++++++++++++++++++++++++++++++++++++++++ | 94% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++ | 95% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++ | 96% ~00s |+++++++++++++++++++++++++++++++++++++++++++++++++ | 97% ~00s |+++++++++++++++++++++++++++++++++++++++++++++++++ | 98% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 99% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s user system elapsed 0.14 0.00 0.14 pbpply> pboptions(op) pbpply> pboptions(type = "txt") pbpply> system.time(res2pb <- pbsapply(1:B, function(i) fun(bid[,i]))) | | | 0% | | | 1% | |+ | 2% | |++ | 3% | |++ | 4% | |++ | 5% | |+++ | 6% | |++++ | 7% | |++++ | 8% | |++++ | 9% | |+++++ | 10% | |++++++ | 11% | |++++++ | 12% | |++++++ | 13% | |+++++++ | 14% | |++++++++ | 15% | |++++++++ | 16% | |++++++++ | 17% | |+++++++++ | 18% | |++++++++++ | 19% | |++++++++++ | 20% | |++++++++++ | 21% | |+++++++++++ | 22% | |++++++++++++ | 23% | |++++++++++++ | 24% | |++++++++++++ | 25% | |+++++++++++++ | 26% | |++++++++++++++ | 27% | |++++++++++++++ | 28% | |++++++++++++++ | 29% | |+++++++++++++++ | 30% | |++++++++++++++++ | 31% | |++++++++++++++++ | 32% | |++++++++++++++++ | 33% | |+++++++++++++++++ | 34% | |++++++++++++++++++ | 35% | |++++++++++++++++++ | 36% | |++++++++++++++++++ | 37% | |+++++++++++++++++++ | 38% | |++++++++++++++++++++ | 39% | |++++++++++++++++++++ | 40% | |++++++++++++++++++++ | 41% | |+++++++++++++++++++++ | 42% | |++++++++++++++++++++++ | 43% | |++++++++++++++++++++++ | 44% | |++++++++++++++++++++++ | 45% | |+++++++++++++++++++++++ | 46% | |++++++++++++++++++++++++ | 47% | |++++++++++++++++++++++++ | 48% | |++++++++++++++++++++++++ | 49% | |+++++++++++++++++++++++++ | 50% | |++++++++++++++++++++++++++ | 51% | |++++++++++++++++++++++++++ | 52% | |++++++++++++++++++++++++++ | 53% | |+++++++++++++++++++++++++++ | 54% | |++++++++++++++++++++++++++++ | 55% | |++++++++++++++++++++++++++++ | 56% | |++++++++++++++++++++++++++++ | 57% | |+++++++++++++++++++++++++++++ | 58% | |++++++++++++++++++++++++++++++ | 59% | |++++++++++++++++++++++++++++++ | 60% | |++++++++++++++++++++++++++++++ | 61% | |+++++++++++++++++++++++++++++++ | 62% | |++++++++++++++++++++++++++++++++ | 63% | |++++++++++++++++++++++++++++++++ | 64% | |++++++++++++++++++++++++++++++++ | 65% | |+++++++++++++++++++++++++++++++++ | 66% | |++++++++++++++++++++++++++++++++++ | 67% | |++++++++++++++++++++++++++++++++++ | 68% | |++++++++++++++++++++++++++++++++++ | 69% | |+++++++++++++++++++++++++++++++++++ | 70% | |++++++++++++++++++++++++++++++++++++ | 71% | |++++++++++++++++++++++++++++++++++++ | 72% | |++++++++++++++++++++++++++++++++++++ | 73% | |+++++++++++++++++++++++++++++++++++++ | 74% | |++++++++++++++++++++++++++++++++++++++ | 75% | |++++++++++++++++++++++++++++++++++++++ | 76% | |++++++++++++++++++++++++++++++++++++++ | 77% | |+++++++++++++++++++++++++++++++++++++++ | 78% | |++++++++++++++++++++++++++++++++++++++++ | 79% | |++++++++++++++++++++++++++++++++++++++++ | 80% | |++++++++++++++++++++++++++++++++++++++++ | 81% | |+++++++++++++++++++++++++++++++++++++++++ | 82% | |++++++++++++++++++++++++++++++++++++++++++ | 83% | |++++++++++++++++++++++++++++++++++++++++++ | 84% | |++++++++++++++++++++++++++++++++++++++++++ | 85% | |+++++++++++++++++++++++++++++++++++++++++++ | 86% | |++++++++++++++++++++++++++++++++++++++++++++ | 87% | |++++++++++++++++++++++++++++++++++++++++++++ | 88% | |++++++++++++++++++++++++++++++++++++++++++++ | 89% | |+++++++++++++++++++++++++++++++++++++++++++++ | 90% | |++++++++++++++++++++++++++++++++++++++++++++++ | 91% | |++++++++++++++++++++++++++++++++++++++++++++++ | 92% | |++++++++++++++++++++++++++++++++++++++++++++++ | 93% | |+++++++++++++++++++++++++++++++++++++++++++++++ | 94% | |++++++++++++++++++++++++++++++++++++++++++++++++ | 95% | |++++++++++++++++++++++++++++++++++++++++++++++++ | 96% | |++++++++++++++++++++++++++++++++++++++++++++++++ | 97% | |+++++++++++++++++++++++++++++++++++++++++++++++++ | 98% | |++++++++++++++++++++++++++++++++++++++++++++++++++| 99% | |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% user system elapsed 0.16 0.00 0.16 pbpply> pboptions(op) pbpply> pboptions(type = "txt", style = 1, char = "=") pbpply> system.time(res3pb <- pbapply(bid, 2, fun)) ================================================== user system elapsed 0.12 0.00 0.13 pbpply> pboptions(op) pbpply> pboptions(type = "txt", char = ":") pbpply> system.time(res4pb <- pbreplicate(B, fun())) | | | 0% | | | 1% | |: | 2% | |:: | 3% | |:: | 4% | |:: | 5% | |::: | 6% | |:::: | 7% | |:::: | 8% | |:::: | 9% | |::::: | 10% | |:::::: | 11% | |:::::: | 12% | |:::::: | 13% | |::::::: | 14% | |:::::::: | 15% | |:::::::: | 16% | |:::::::: | 17% | |::::::::: | 18% | |:::::::::: | 19% | |:::::::::: | 20% | |:::::::::: | 21% | |::::::::::: | 22% | |:::::::::::: | 23% | |:::::::::::: | 24% | |:::::::::::: | 25% | |::::::::::::: | 26% | |:::::::::::::: | 27% | |:::::::::::::: | 28% | |:::::::::::::: | 29% | |::::::::::::::: | 30% | |:::::::::::::::: | 31% | |:::::::::::::::: | 32% | |:::::::::::::::: | 33% | |::::::::::::::::: | 34% | |:::::::::::::::::: | 35% | |:::::::::::::::::: | 36% | |:::::::::::::::::: | 37% | |::::::::::::::::::: | 38% | |:::::::::::::::::::: | 39% | |:::::::::::::::::::: | 40% | |:::::::::::::::::::: | 41% | |::::::::::::::::::::: | 42% | |:::::::::::::::::::::: | 43% | |:::::::::::::::::::::: | 44% | |:::::::::::::::::::::: | 45% | |::::::::::::::::::::::: | 46% | |:::::::::::::::::::::::: | 47% | |:::::::::::::::::::::::: | 48% | |:::::::::::::::::::::::: | 49% | |::::::::::::::::::::::::: | 50% | |:::::::::::::::::::::::::: | 51% | |:::::::::::::::::::::::::: | 52% | |:::::::::::::::::::::::::: | 53% | |::::::::::::::::::::::::::: | 54% | |:::::::::::::::::::::::::::: | 55% | |:::::::::::::::::::::::::::: | 56% | |:::::::::::::::::::::::::::: | 57% | |::::::::::::::::::::::::::::: | 58% | |:::::::::::::::::::::::::::::: | 59% | |:::::::::::::::::::::::::::::: | 60% | |:::::::::::::::::::::::::::::: | 61% | |::::::::::::::::::::::::::::::: | 62% | |:::::::::::::::::::::::::::::::: | 63% | |:::::::::::::::::::::::::::::::: | 64% | |:::::::::::::::::::::::::::::::: | 65% | |::::::::::::::::::::::::::::::::: | 66% | |:::::::::::::::::::::::::::::::::: | 67% | |:::::::::::::::::::::::::::::::::: | 68% | |:::::::::::::::::::::::::::::::::: | 69% | |::::::::::::::::::::::::::::::::::: | 70% | |:::::::::::::::::::::::::::::::::::: | 71% | |:::::::::::::::::::::::::::::::::::: | 72% | |:::::::::::::::::::::::::::::::::::: | 73% | |::::::::::::::::::::::::::::::::::::: | 74% | |:::::::::::::::::::::::::::::::::::::: | 75% | |:::::::::::::::::::::::::::::::::::::: | 76% | |:::::::::::::::::::::::::::::::::::::: | 77% | |::::::::::::::::::::::::::::::::::::::: | 78% | |:::::::::::::::::::::::::::::::::::::::: | 79% | |:::::::::::::::::::::::::::::::::::::::: | 80% | |:::::::::::::::::::::::::::::::::::::::: | 81% | |::::::::::::::::::::::::::::::::::::::::: | 82% | |:::::::::::::::::::::::::::::::::::::::::: | 83% | |:::::::::::::::::::::::::::::::::::::::::: | 84% | |:::::::::::::::::::::::::::::::::::::::::: | 85% | |::::::::::::::::::::::::::::::::::::::::::: | 86% | |:::::::::::::::::::::::::::::::::::::::::::: | 87% | |:::::::::::::::::::::::::::::::::::::::::::: | 88% | |:::::::::::::::::::::::::::::::::::::::::::: | 89% | |::::::::::::::::::::::::::::::::::::::::::::: | 90% | |:::::::::::::::::::::::::::::::::::::::::::::: | 91% | |:::::::::::::::::::::::::::::::::::::::::::::: | 92% | |:::::::::::::::::::::::::::::::::::::::::::::: | 93% | |::::::::::::::::::::::::::::::::::::::::::::::: | 94% | |:::::::::::::::::::::::::::::::::::::::::::::::: | 95% | |:::::::::::::::::::::::::::::::::::::::::::::::: | 96% | |:::::::::::::::::::::::::::::::::::::::::::::::: | 97% | |::::::::::::::::::::::::::::::::::::::::::::::::: | 98% | |::::::::::::::::::::::::::::::::::::::::::::::::::| 99% | |::::::::::::::::::::::::::::::::::::::::::::::::::| 100% user system elapsed 0.13 0.00 0.13 pbpply> pboptions(op) pbpply> ## parallel evaluation using the parallel package pbpply> ## (n = 2000 and B = 1000 will give visible timing differences) pbpply> pbpply> library(parallel) pbpply> cl <- makeCluster(2L) pbpply> clusterExport(cl, c("fun", "mod", "ndat", "bid")) pbpply> ## parallel with no progress bar: snow type cluster pbpply> ## (RNG is set in the main process to define the object bid) pbpply> system.time(res1cl <- parLapply(cl = cl, 1:B, function(i) fun(bid[,i]))) user system elapsed 0.00 0.00 0.09 pbpply> system.time(res2cl <- parSapply(cl = cl, 1:B, function(i) fun(bid[,i]))) user system elapsed 0.02 0.00 0.08 pbpply> system.time(res3cl <- parApply(cl, bid, 2, fun)) user system elapsed 0.01 0.00 0.08 pbpply> ## parallel with progress bar: snow type cluster pbpply> ## (RNG is set in the main process to define the object bid) pbpply> system.time(res1pbcl <- pblapply(1:B, function(i) fun(bid[,i]), cl = cl)) user system elapsed 0.00 0.00 0.06 pbpply> system.time(res2pbcl <- pbsapply(1:B, function(i) fun(bid[,i]), cl = cl)) user system elapsed 0.00 0.00 0.08 pbpply> ## (RNG needs to be set when not using bid) pbpply> parallel::clusterSetRNGStream(cl, iseed = 0L) pbpply> system.time(res4pbcl <- pbreplicate(B, fun(), cl = cl)) user system elapsed 0.00 0.00 0.06 pbpply> system.time(res3pbcl <- pbapply(bid, 2, fun, cl = cl)) user system elapsed 0.02 0.00 0.08 pbpply> stopCluster(cl) pbpply> if (.Platform$OS.type != "windows") { pbpply+ ## parallel with no progress bar: multicore type forking pbpply+ ## (mc.set.seed = TRUE in parallel::mclapply by default) pbpply+ system.time(res2mc <- mclapply(1:B, function(i) fun(bid[,i]), mc.cores = 2L)) pbpply+ ## parallel with progress bar: multicore type forking pbpply+ ## (mc.set.seed = TRUE in parallel::mclapply by default) pbpply+ system.time(res1pbmc <- pblapply(1:B, function(i) fun(bid[,i]), cl = 2L)) pbpply+ system.time(res2pbmc <- pbsapply(1:B, function(i) fun(bid[,i]), cl = 2L)) pbpply+ system.time(res4pbmc <- pbreplicate(B, fun(), cl = 2L)) pbpply+ } pbpply> ## --- Examples taken from standard '*apply' functions --- pbpply> pbpply> ## --- sapply, lapply, and replicate --- pbpply> pbpply> require(stats); require(graphics) pbpply> x <- list(a = 1:10, beta = exp(-3:3), logic = c(TRUE,FALSE,FALSE,TRUE)) pbpply> # compute the list mean for each list element pbpply> pblapply(x, mean) $a [1] 5.5 $beta [1] 4.535125 $logic [1] 0.5 pbpply> pbwalk(x, mean) pbpply> # median and quartiles for each list element pbpply> pblapply(x, quantile, probs = 1:3/4) $a 25% 50% 75% 3.25 5.50 7.75 $beta 25% 50% 75% 0.2516074 1.0000000 5.0536690 $logic 25% 50% 75% 0.0 0.5 1.0 pbpply> pbsapply(x, quantile) a beta logic 0% 1.00 0.04978707 0.0 25% 3.25 0.25160736 0.0 50% 5.50 1.00000000 0.5 75% 7.75 5.05366896 1.0 100% 10.00 20.08553692 1.0 pbpply> i39 <- sapply(3:9, seq) # list of vectors pbpply> pbsapply(i39, fivenum) [,1] [,2] [,3] [,4] [,5] [,6] [,7] [1,] 1.0 1.0 1 1.0 1.0 1.0 1 [2,] 1.5 1.5 2 2.0 2.5 2.5 3 [3,] 2.0 2.5 3 3.5 4.0 4.5 5 [4,] 2.5 3.5 4 5.0 5.5 6.5 7 [5,] 3.0 4.0 5 6.0 7.0 8.0 9 pbpply> pbvapply(i39, fivenum, pbpply+ c(Min. = 0, "1st Qu." = 0, Median = 0, "3rd Qu." = 0, Max. = 0)) [,1] [,2] [,3] [,4] [,5] [,6] [,7] Min. 1.0 1.0 1 1.0 1.0 1.0 1 1st Qu. 1.5 1.5 2 2.0 2.5 2.5 3 Median 2.0 2.5 3 3.5 4.0 4.5 5 3rd Qu. 2.5 3.5 4 5.0 5.5 6.5 7 Max. 3.0 4.0 5 6.0 7.0 8.0 9 pbpply> ## sapply(*, "array") -- artificial example pbpply> (v <- structure(10*(5:8), names = LETTERS[1:4])) A B C D 50 60 70 80 pbpply> f2 <- function(x, y) outer(rep(x, length.out = 3), y) pbpply> (a2 <- pbsapply(v, f2, y = 2*(1:5), simplify = "array")) , , A [,1] [,2] [,3] [,4] [,5] [1,] 100 200 300 400 500 [2,] 100 200 300 400 500 [3,] 100 200 300 400 500 , , B [,1] [,2] [,3] [,4] [,5] [1,] 120 240 360 480 600 [2,] 120 240 360 480 600 [3,] 120 240 360 480 600 , , C [,1] [,2] [,3] [,4] [,5] [1,] 140 280 420 560 700 [2,] 140 280 420 560 700 [3,] 140 280 420 560 700 , , D [,1] [,2] [,3] [,4] [,5] [1,] 160 320 480 640 800 [2,] 160 320 480 640 800 [3,] 160 320 480 640 800 pbpply> a.2 <- pbvapply(v, f2, outer(1:3, 1:5), y = 2*(1:5)) pbpply> stopifnot(dim(a2) == c(3,5,4), all.equal(a2, a.2), pbpply+ identical(dimnames(a2), list(NULL,NULL,LETTERS[1:4]))) pbpply> summary(pbreplicate(100, mean(rexp(10)))) Min. 1st Qu. Median Mean 3rd Qu. Max. 0.4786 0.7273 0.9091 0.9666 1.1917 2.3021 pbpply> ## use of replicate() with parameters: pbpply> foo <- function(x = 1, y = 2) c(x, y) pbpply> # does not work: bar <- function(n, ...) replicate(n, foo(...)) pbpply> bar <- function(n, x) pbreplicate(n, foo(x = x)) pbpply> bar(5, x = 3) [,1] [,2] [,3] [,4] [,5] [1,] 3 3 3 3 3 [2,] 2 2 2 2 2 pbpply> ## --- apply --- pbpply> pbpply> ## Compute row and column sums for a matrix: pbpply> x <- cbind(x1 = 3, x2 = c(4:1, 2:5)) pbpply> dimnames(x)[[1]] <- letters[1:8] pbpply> pbapply(x, 2, mean, trim = .2) x1 x2 3 3 pbpply> col.sums <- pbapply(x, 2, sum) pbpply> row.sums <- pbapply(x, 1, sum) pbpply> rbind(cbind(x, Rtot = row.sums), Ctot = c(col.sums, sum(col.sums))) x1 x2 Rtot a 3 4 7 b 3 3 6 c 3 2 5 d 3 1 4 e 3 2 5 f 3 3 6 g 3 4 7 h 3 5 8 Ctot 24 24 48 pbpply> stopifnot( pbapply(x, 2, is.vector)) pbpply> ## Sort the columns of a matrix pbpply> pbapply(x, 2, sort) x1 x2 [1,] 3 1 [2,] 3 2 [3,] 3 2 [4,] 3 3 [5,] 3 3 [6,] 3 4 [7,] 3 4 [8,] 3 5 pbpply> ## keeping named dimnames pbpply> names(dimnames(x)) <- c("row", "col") pbpply> x3 <- array(x, dim = c(dim(x),3), pbpply+ dimnames = c(dimnames(x), list(C = paste0("cop.",1:3)))) pbpply> identical(x, pbapply( x, 2, identity)) [1] TRUE pbpply> identical(x3, pbapply(x3, 2:3, identity)) [1] TRUE pbpply> ##- function with extra args: pbpply> cave <- function(x, c1, c2) c(mean(x[c1]), mean(x[c2])) pbpply> pbapply(x, 1, cave, c1 = "x1", c2 = c("x1","x2")) row a b c d e f g h [1,] 3.0 3 3.0 3 3.0 3 3.0 3 [2,] 3.5 3 2.5 2 2.5 3 3.5 4 pbpply> ma <- matrix(c(1:4, 1, 6:8), nrow = 2) pbpply> ma [,1] [,2] [,3] [,4] [1,] 1 3 1 7 [2,] 2 4 6 8 pbpply> pbapply(ma, 1, table) #--> a list of length 2 [[1]] 1 3 7 2 1 1 [[2]] 2 4 6 8 1 1 1 1 pbpply> pbapply(ma, 1, stats::quantile) # 5 x n matrix with rownames [,1] [,2] 0% 1 2.0 25% 1 3.5 50% 2 5.0 75% 4 6.5 100% 7 8.0 pbpply> stopifnot(dim(ma) == dim(pbapply(ma, 1:2, sum))) pbpply> ## Example with different lengths for each call pbpply> z <- array(1:24, dim = 2:4) pbpply> zseq <- pbapply(z, 1:2, function(x) seq_len(max(x))) pbpply> zseq ## a 2 x 3 matrix [,1] [,2] [,3] [1,] integer,19 integer,21 integer,23 [2,] integer,20 integer,22 integer,24 pbpply> typeof(zseq) ## list [1] "list" pbpply> dim(zseq) ## 2 3 [1] 2 3 pbpply> zseq[1,] [[1]] [1] 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 [[2]] [1] 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 [[3]] [1] 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 pbpply> pbapply(z, 3, function(x) seq_len(max(x))) [[1]] [1] 1 2 3 4 5 6 [[2]] [1] 1 2 3 4 5 6 7 8 9 10 11 12 [[3]] [1] 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 [[4]] [1] 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 pbpply> # a list without a dim attribute pbpply> pbpply> ## --- mapply and .mapply --- pbpply> pbpply> pbmapply(rep, 1:4, 4:1) [[1]] [1] 1 1 1 1 [[2]] [1] 2 2 2 [[3]] [1] 3 3 [[4]] [1] 4 pbpply> pbmapply(rep, times = 1:4, x = 4:1) [[1]] [1] 4 [[2]] [1] 3 3 [[3]] [1] 2 2 2 [[4]] [1] 1 1 1 1 pbpply> pbmapply(rep, times = 1:4, MoreArgs = list(x = 42)) [[1]] [1] 42 [[2]] [1] 42 42 [[3]] [1] 42 42 42 [[4]] [1] 42 42 42 42 pbpply> pbmapply(function(x, y) seq_len(x) + y, pbpply+ c(a = 1, b = 2, c = 3), # names from first pbpply+ c(A = 10, B = 0, C = -10)) $a [1] 11 $b [1] 1 2 $c [1] -9 -8 -7 pbpply> word <- function(C, k) paste(rep.int(C, k), collapse = "") pbpply> utils::str(pbmapply(word, LETTERS[1:6], 6:1, SIMPLIFY = FALSE)) List of 6 $ A: chr "AAAAAA" $ B: chr "BBBBB" $ C: chr "CCCC" $ D: chr "DDD" $ E: chr "EE" $ F: chr "F" pbpply> pb.mapply(rep, pbpply+ dots = list(1:4, 4:1), pbpply+ MoreArgs = list()) [[1]] [1] 1 1 1 1 [[2]] [1] 2 2 2 [[3]] [1] 3 3 [[4]] [1] 4 pbpply> pb.mapply(rep, pbpply+ dots = list(times = 1:4, x = 4:1), pbpply+ MoreArgs = list()) [[1]] [1] 4 [[2]] [1] 3 3 [[3]] [1] 2 2 2 [[4]] [1] 1 1 1 1 pbpply> pb.mapply(rep, pbpply+ dots = list(times = 1:4), pbpply+ MoreArgs = list(x = 42)) [[1]] [1] 42 [[2]] [1] 42 42 [[3]] [1] 42 42 42 [[4]] [1] 42 42 42 42 pbpply> pb.mapply(function(x, y) seq_len(x) + y, pbpply+ dots = list(c(a = 1, b = 2, c = 3), # names from first pbpply+ c(A = 10, B = 0, C = -10)), pbpply+ MoreArgs = list()) [[1]] [1] 11 [[2]] [1] 1 2 [[3]] [1] -9 -8 -7 pbpply> ## --- Map --- pbpply> pbpply> pbMap(`+`, 1, 1 : 3) ; 1 + 1:3 [[1]] [1] 2 [[2]] [1] 3 [[3]] [1] 4 [1] 2 3 4 pbpply> ## --- eapply --- pbpply> pbpply> env <- new.env(hash = FALSE) pbpply> env$a <- 1:10 pbpply> env$beta <- exp(-3:3) pbpply> env$logic <- c(TRUE, FALSE, FALSE, TRUE) pbpply> pbeapply(env, mean) $logic [1] 0.5 $beta [1] 4.535125 $a [1] 5.5 pbpply> unlist(pbeapply(env, mean, USE.NAMES = FALSE)) [1] 0.500000 4.535125 5.500000 pbpply> pbeapply(env, quantile, probs = 1:3/4) $logic 25% 50% 75% 0.0 0.5 1.0 $beta 25% 50% 75% 0.2516074 1.0000000 5.0536690 $a 25% 50% 75% 3.25 5.50 7.75 pbpply> pbeapply(env, quantile) $logic 0% 25% 50% 75% 100% 0.0 0.0 0.5 1.0 1.0 $beta 0% 25% 50% 75% 100% 0.04978707 0.25160736 1.00000000 5.05366896 20.08553692 $a 0% 25% 50% 75% 100% 1.00 3.25 5.50 7.75 10.00 pbpply> ## --- tapply --- pbpply> pbpply> require(stats) pbpply> groups <- as.factor(rbinom(32, n = 5, prob = 0.4)) pbpply> pbtapply(groups, groups, length) #- is almost the same as 10 11 13 14 18 1 1 1 1 1 pbpply> table(groups) groups 10 11 13 14 18 1 1 1 1 1 pbpply> ## contingency table from data.frame : array with named dimnames pbpply> pbtapply(warpbreaks$breaks, warpbreaks[,-1], sum) tension wool L M H A 401 216 221 B 254 259 169 pbpply> pbtapply(warpbreaks$breaks, warpbreaks[, 3, drop = FALSE], sum) tension L M H 655 475 390 pbpply> n <- 17; fac <- factor(rep_len(1:3, n), levels = 1:5) pbpply> table(fac) fac 1 2 3 4 5 6 6 5 0 0 pbpply> pbtapply(1:n, fac, sum) 1 2 3 4 5 51 57 45 NA NA pbpply> pbtapply(1:n, fac, sum, default = 0) # maybe more desirable 1 2 3 4 5 51 57 45 0 0 pbpply> pbtapply(1:n, fac, sum, simplify = FALSE) $`1` [1] 51 $`2` [1] 57 $`3` [1] 45 $`4` NULL $`5` NULL pbpply> pbtapply(1:n, fac, range) $`1` [1] 1 16 $`2` [1] 2 17 $`3` [1] 3 15 $`4` NULL $`5` NULL pbpply> pbtapply(1:n, fac, quantile) $`1` 0% 25% 50% 75% 100% 1.00 4.75 8.50 12.25 16.00 $`2` 0% 25% 50% 75% 100% 2.00 5.75 9.50 13.25 17.00 $`3` 0% 25% 50% 75% 100% 3 6 9 12 15 $`4` NULL $`5` NULL pbpply> pbtapply(1:n, fac, length) ## NA's 1 2 3 4 5 6 6 5 NA NA pbpply> pbtapply(1:n, fac, length, default = 0) # == table(fac) 1 2 3 4 5 6 6 5 0 0 pbpply> ## example of ... argument: find quarterly means pbpply> pbtapply(presidents, cycle(presidents), mean, na.rm = TRUE) 1 2 3 4 58.44828 56.43333 57.22222 53.07143 pbpply> ind <- list(c(1, 2, 2), c("A", "A", "B")) pbpply> table(ind) ind.2 ind.1 A B 1 1 0 2 1 1 pbpply> pbtapply(1:3, ind) #-> the split vector [1] 1 2 4 pbpply> pbtapply(1:3, ind, sum) A B 1 1 NA 2 2 3 pbpply> ## Some assertions (not held by all patch propsals): pbpply> nq <- names(quantile(1:5)) pbpply> stopifnot( pbpply+ identical(pbtapply(1:3, ind), c(1L, 2L, 4L)), pbpply+ identical(pbtapply(1:3, ind, sum), pbpply+ matrix(c(1L, 2L, NA, 3L), 2, dimnames = list(c("1", "2"), c("A", "B")))), pbpply+ identical(pbtapply(1:n, fac, quantile)[-1], pbpply+ array(list(`2` = structure(c(2, 5.75, 9.5, 13.25, 17), .Names = nq), pbpply+ `3` = structure(c(3, 6, 9, 12, 15), .Names = nq), pbpply+ `4` = NULL, `5` = NULL), dim=4, dimnames=list(as.character(2:5))))) pbpply> ## --- by --- pbpply> pbpply> pbby(warpbreaks[, 1:2], warpbreaks[,"tension"], summary) warpbreaks[, "tension"]: L breaks wool Min. :14.00 A:9 1st Qu.:26.00 B:9 Median :29.50 Mean :36.39 3rd Qu.:49.25 Max. :70.00 ------------------------------------------------------------ warpbreaks[, "tension"]: M breaks wool Min. :12.00 A:9 1st Qu.:18.25 B:9 Median :27.00 Mean :26.39 3rd Qu.:33.75 Max. :42.00 ------------------------------------------------------------ warpbreaks[, "tension"]: H breaks wool Min. :10.00 A:9 1st Qu.:15.25 B:9 Median :20.50 Mean :21.67 3rd Qu.:25.50 Max. :43.00 pbpply> pbby(warpbreaks[, 1], warpbreaks[, -1], summary) wool: A tension: L Min. 1st Qu. Median Mean 3rd Qu. Max. 25.00 26.00 51.00 44.56 54.00 70.00 ------------------------------------------------------------ wool: B tension: L Min. 1st Qu. Median Mean 3rd Qu. Max. 14.00 20.00 29.00 28.22 31.00 44.00 ------------------------------------------------------------ wool: A tension: M Min. 1st Qu. Median Mean 3rd Qu. Max. 12 18 21 24 30 36 ------------------------------------------------------------ wool: B tension: M Min. 1st Qu. Median Mean 3rd Qu. Max. 16.00 21.00 28.00 28.78 39.00 42.00 ------------------------------------------------------------ wool: A tension: H Min. 1st Qu. Median Mean 3rd Qu. Max. 10.00 18.00 24.00 24.56 28.00 43.00 ------------------------------------------------------------ wool: B tension: H Min. 1st Qu. Median Mean 3rd Qu. Max. 13.00 15.00 17.00 18.78 21.00 28.00 pbpply> pbby(warpbreaks, warpbreaks[,"tension"], pbpply+ function(x) lm(breaks ~ wool, data = x)) warpbreaks[, "tension"]: L Call: lm(formula = breaks ~ wool, data = x) Coefficients: (Intercept) woolB 44.56 -16.33 ------------------------------------------------------------ warpbreaks[, "tension"]: M Call: lm(formula = breaks ~ wool, data = x) Coefficients: (Intercept) woolB 24.000 4.778 ------------------------------------------------------------ warpbreaks[, "tension"]: H Call: lm(formula = breaks ~ wool, data = x) Coefficients: (Intercept) woolB 24.556 -5.778 pbpply> tmp <- with(warpbreaks, pbpply+ pbby(warpbreaks, tension, pbpply+ function(x) lm(breaks ~ wool, data = x))) pbpply> sapply(tmp, coef) L M H (Intercept) 44.55556 24.000000 24.555556 woolB -16.33333 4.777778 -5.777778 > example(pboptions, run.dontrun = TRUE) pbptns> ## increase sluggishness to admire the progress bar longer pbptns> sluggishness <- 0.01 pbptns> ## for loop pbptns> fun1 <- function() { pbptns+ pb <- startpb(0, 10) pbptns+ on.exit(closepb(pb)) pbptns+ for (i in 1:10) { pbptns+ Sys.sleep(sluggishness) pbptns+ setpb(pb, i) pbptns+ } pbptns+ invisible(NULL) pbptns+ } pbptns> ## while loop pbptns> fun2 <- function() { pbptns+ pb <- startpb(0, 10-1) pbptns+ on.exit(closepb(pb)) pbptns+ i <- 1 pbptns+ while (i < 10) { pbptns+ Sys.sleep(sluggishness) pbptns+ setpb(pb, i) pbptns+ i <- i + 1 pbptns+ } pbptns+ invisible(NULL) pbptns+ } pbptns> ## using original settings pbptns> fun1() pbptns> ## resetting pboptions pbptns> opb <- pboptions(style = 1, char = ">") pbptns> ## check new settings pbptns> getOption("pboptions") $type [1] "none" $char [1] ">" $txt.width [1] 50 $gui.width [1] 300 $style [1] 1 $initial [1] 0 $title [1] "R progress bar" $label [1] "" $nout [1] 100 $min_time [1] 0 $use_lb [1] FALSE pbptns> ## running again with new settings pbptns> fun2() pbptns> ## resetting original pbptns> pboptions(opb) pbptns> ## check reset pbptns> getOption("pboptions") $type [1] "none" $char [1] "+" $txt.width [1] 50 $gui.width [1] 300 $style [1] 3 $initial [1] 0 $title [1] "R progress bar" $label [1] "" $nout [1] 100 $min_time [1] 0 $use_lb [1] FALSE pbptns> fun1() pbptns> ## dealing with nested progress bars pbptns> ## when only one the 1st one is needed pbptns> f <- function(x) Sys.sleep(sluggishness) pbptns> g <- function(x) pblapply(1:10, f) pbptns> tmp <- lapply(1:10, g) # undesirable pbptns> ## here is the desirable solution pbptns> h <- function(x) { pbptns+ opb <- pboptions(type="none") pbptns+ on.exit(pboptions(opb)) pbptns+ pblapply(1:10, f) pbptns+ } pbptns> tmp <- pblapply(1:10, h) pbptns> ## list available pb types pbptns> pbtypes() [1] "timer" "txt" "tk" "none" "shiny" "win" > > ## run examples with progress bar > pboptions(type = "timer") > example(splitpb, run.dontrun = TRUE) spltpb> ## define 1 job / worker at a time and repeat spltpb> splitpb(10, 4) [[1]] [1] 1 2 3 4 [[2]] [1] 5 6 7 8 [[3]] [1] 9 10 spltpb> ## compare this to the no-progress-bar split spltpb> ## that defines all the jubs / worker up front spltpb> parallel::splitIndices(10, 4) [[1]] [1] 1 2 3 [[2]] [1] 4 5 [[3]] [1] 6 7 [[4]] [1] 8 9 10 spltpb> ## cap the length of the output spltpb> splitpb(20, 2, nout = NULL) [[1]] [1] 1 2 [[2]] [1] 3 4 [[3]] [1] 5 6 [[4]] [1] 7 8 [[5]] [1] 9 10 [[6]] [1] 11 12 [[7]] [1] 13 14 [[8]] [1] 15 16 [[9]] [1] 17 18 [[10]] [1] 19 20 spltpb> splitpb(20, 2, nout = 5) [[1]] [1] 1 2 3 4 [[2]] [1] 5 6 7 8 [[3]] [1] 9 10 11 12 [[4]] [1] 13 14 15 16 [[5]] [1] 17 18 19 20 > example(timerProgressBar, run.dontrun = TRUE) tmrPrB> ## increase sluggishness to admire the progress bar longer tmrPrB> sluggishness <- 0.02 tmrPrB> test_fun <- function(...) tmrPrB+ { tmrPrB+ pb <- timerProgressBar(...) tmrPrB+ on.exit(close(pb)) tmrPrB+ for (i in seq(0, 1, 0.05)) { tmrPrB+ Sys.sleep(sluggishness) tmrPrB+ setTimerProgressBar(pb, i) tmrPrB+ } tmrPrB+ invisible(NULL) tmrPrB+ } tmrPrB> ## check the different styles tmrPrB> test_fun(width = 35, char = "+", style = 1) | | 0 % elapsed=00s | | 0 % elapsed=00s |++ | 5 % elapsed=00s, remaining~01s |++++ | 10% elapsed=00s, remaining~01s |++++++ | 15% elapsed=00s, remaining~01s |+++++++ | 20% elapsed=00s, remaining~01s |+++++++++ | 25% elapsed=00s, remaining~01s |+++++++++++ | 30% elapsed=00s, remaining~01s |+++++++++++++ | 35% elapsed=00s, remaining~00s |++++++++++++++ | 40% elapsed=00s, remaining~00s |++++++++++++++++ | 45% elapsed=00s, remaining~00s |++++++++++++++++++ | 50% elapsed=00s, remaining~00s |++++++++++++++++++++ | 55% elapsed=00s, remaining~00s |++++++++++++++++++++++ | 60% elapsed=00s, remaining~00s |+++++++++++++++++++++++ | 65% elapsed=00s, remaining~00s |+++++++++++++++++++++++++ | 70% elapsed=00s, remaining~00s |+++++++++++++++++++++++++++ | 75% elapsed=00s, remaining~00s |++++++++++++++++++++++++++++ | 80% elapsed=01s, remaining~00s |++++++++++++++++++++++++++++++ | 85% elapsed=01s, remaining~00s |++++++++++++++++++++++++++++++++ | 90% elapsed=01s, remaining~00s |++++++++++++++++++++++++++++++++++ | 95% elapsed=01s, remaining~00s |+++++++++++++++++++++++++++++++++++| 100% elapsed=01s, remaining~00s tmrPrB> test_fun(style = 2) / 0 % elapsed=00s / 0 % elapsed=00s - 5 % elapsed=00s, remaining~01s \ 10% elapsed=00s, remaining~01s | 15% elapsed=00s, remaining~01s / 20% elapsed=00s, remaining~01s - 25% elapsed=00s, remaining~01s \ 30% elapsed=00s, remaining~01s | 35% elapsed=00s, remaining~00s / 40% elapsed=00s, remaining~00s - 45% elapsed=00s, remaining~00s \ 50% elapsed=00s, remaining~00s | 55% elapsed=00s, remaining~00s / 60% elapsed=00s, remaining~00s - 65% elapsed=00s, remaining~00s \ 70% elapsed=00s, remaining~00s | 75% elapsed=00s, remaining~00s / 80% elapsed=01s, remaining~00s - 85% elapsed=01s, remaining~00s \ 90% elapsed=01s, remaining~00s | 95% elapsed=01s, remaining~00s / 100% elapsed=01s, remaining~00s tmrPrB> test_fun(width = 50, char = ".", style = 3) | | 0 % ~calculating | | 0 % ~calculating |... | 5 % ~01s |..... | 10% ~01s |........ | 15% ~01s |.......... | 20% ~01s |............. | 25% ~01s |................ | 30% ~01s |.................. | 35% ~00s |.................... | 40% ~00s |....................... | 45% ~00s |......................... | 50% ~00s |............................ | 55% ~00s |............................... | 60% ~00s |................................. | 65% ~00s |................................... | 70% ~00s |...................................... | 75% ~00s |........................................ | 80% ~00s |........................................... | 85% ~00s |............................................. | 90% ~00s |................................................ | 95% ~00s |..................................................| 100% elapsed=01s tmrPrB> test_fun(style = 4) / 0 % ~calculating / 0 % ~calculating - 5 % ~01s \ 10% ~01s | 15% ~01s / 20% ~01s - 25% ~01s \ 30% ~00s | 35% ~00s / 40% ~00s - 45% ~00s \ 50% ~00s | 55% ~00s / 60% ~00s - 65% ~00s \ 70% ~00s | 75% ~00s / 80% ~00s - 85% ~00s \ 90% ~00s | 95% ~00s / 100% elapsed=01s tmrPrB> test_fun(width = 35, char = "[=-]", style = 5) [-----------------------------------] 0 % elapsed=00s [-----------------------------------] 0 % elapsed=00s [==---------------------------------] 5 % elapsed=00s, remaining~01s [====-------------------------------] 10% elapsed=00s, remaining~01s [======-----------------------------] 15% elapsed=00s, remaining~01s [=======----------------------------] 20% elapsed=00s, remaining~01s [=========--------------------------] 25% elapsed=00s, remaining~01s [===========------------------------] 30% elapsed=00s, remaining~01s [=============----------------------] 35% elapsed=00s, remaining~00s [==============---------------------] 40% elapsed=00s, remaining~00s [================-------------------] 45% elapsed=00s, remaining~00s [==================-----------------] 50% elapsed=00s, remaining~00s [====================---------------] 55% elapsed=00s, remaining~00s [======================-------------] 60% elapsed=00s, remaining~00s [=======================------------] 65% elapsed=00s, remaining~00s [=========================----------] 70% elapsed=00s, remaining~00s [===========================--------] 75% elapsed=00s, remaining~00s [============================-------] 80% elapsed=01s, remaining~00s [==============================-----] 85% elapsed=01s, remaining~00s [================================---] 90% elapsed=01s, remaining~00s [==================================-] 95% elapsed=01s, remaining~00s [===================================] 100% elapsed=01s, remaining~00s tmrPrB> test_fun(width = 50, char = "{*.}", style = 6) {..................................................} 0 % ~calculating {..................................................} 0 % ~calculating {***...............................................} 5 % ~01s {*****.............................................} 10% ~01s {********..........................................} 15% ~01s {**********........................................} 20% ~01s {*************.....................................} 25% ~01s {****************..................................} 30% ~01s {******************................................} 35% ~00s {********************..............................} 40% ~00s {***********************...........................} 45% ~00s {*************************.........................} 50% ~00s {****************************......................} 55% ~00s {*******************************...................} 60% ~00s {*********************************.................} 65% ~00s {***********************************...............} 70% ~00s {**************************************............} 75% ~00s {****************************************..........} 80% ~00s {*******************************************.......} 85% ~00s {*********************************************.....} 90% ~00s {************************************************..} 95% ~00s {**************************************************} 100% elapsed=01s tmrPrB> ## no bar only percent and elapsed tmrPrB> test_fun(width = 0, char = " ", style = 6) 0 % ~calculating 0 % ~calculating 5 % ~01s 10% ~01s 15% ~01s 20% ~01s 25% ~01s 30% ~01s 35% ~00s 40% ~00s 45% ~00s 50% ~00s 55% ~00s 60% ~00s 65% ~00s 70% ~00s 75% ~00s 80% ~00s 85% ~00s 90% ~00s 95% ~00s 100% elapsed=01s tmrPrB> ## this should produce a progress bar based on min_time tmrPrB> (elapsed <- system.time(test_fun(width = 35, min_time = 0))["elapsed"]) | | 0 % elapsed=00s | | 0 % elapsed=00s |== | 5 % elapsed=00s, remaining~01s |==== | 10% elapsed=00s, remaining~01s |====== | 15% elapsed=00s, remaining~01s |======= | 20% elapsed=00s, remaining~01s |========= | 25% elapsed=00s, remaining~01s |=========== | 30% elapsed=00s, remaining~01s |============= | 35% elapsed=00s, remaining~00s |============== | 40% elapsed=00s, remaining~00s |================ | 45% elapsed=00s, remaining~00s |================== | 50% elapsed=00s, remaining~00s |==================== | 55% elapsed=00s, remaining~00s |====================== | 60% elapsed=00s, remaining~00s |======================= | 65% elapsed=00s, remaining~00s |========================= | 70% elapsed=00s, remaining~00s |=========================== | 75% elapsed=00s, remaining~00s |============================ | 80% elapsed=01s, remaining~00s |============================== | 85% elapsed=01s, remaining~00s |================================ | 90% elapsed=01s, remaining~00s |================================== | 95% elapsed=01s, remaining~00s |===================================| 100% elapsed=01s, remaining~00s elapsed 0.66 tmrPrB> ## this should not produce a progress bar based on min_time tmrPrB> system.time(test_fun(min_time = 2 * elapsed))["elapsed"] elapsed 0.66 tmrPrB> ## time formatting tmrPrB> getTimeAsString(NULL) [1] "calculating" tmrPrB> getTimeAsString(15) [1] "15s" tmrPrB> getTimeAsString(65) [1] "01m 05s" tmrPrB> getTimeAsString(6005) [1] "01h 40m 05s" tmrPrB> ## example usage of getTimeAsString, use sluggishness <- 1 tmrPrB> n <- 10 tmrPrB> t0 <- proc.time()[3] tmrPrB> ETA <- NULL tmrPrB> for (i in seq_len(n)) { tmrPrB+ cat(i, "/", n, "- ETA:", getTimeAsString(ETA)) tmrPrB+ flush.console() tmrPrB+ Sys.sleep(sluggishness) tmrPrB+ dt <- proc.time()[3] - t0 tmrPrB+ cat(" - elapsed:", getTimeAsString(dt), "\n") tmrPrB+ ETA <- (n - i) * dt / i tmrPrB+ } 1 / 10 - ETA: calculating - elapsed: 00s 2 / 10 - ETA: 00s - elapsed: 00s 3 / 10 - ETA: 00s - elapsed: 00s 4 / 10 - ETA: 00s - elapsed: 00s 5 / 10 - ETA: 00s - elapsed: 00s 6 / 10 - ETA: 00s - elapsed: 00s 7 / 10 - ETA: 00s - elapsed: 00s 8 / 10 - ETA: 00s - elapsed: 00s 9 / 10 - ETA: 00s - elapsed: 00s 10 / 10 - ETA: 00s - elapsed: 00s > example(pbapply, run.dontrun = TRUE) pbpply> ## --- simple linear model simulation --- pbpply> set.seed(1234) pbpply> n <- 200 pbpply> x <- rnorm(n) pbpply> y <- rnorm(n, crossprod(t(model.matrix(~ x)), c(0, 1)), sd = 0.5) pbpply> d <- data.frame(y, x) pbpply> ## model fitting and bootstrap pbpply> mod <- lm(y ~ x, d) pbpply> ndat <- model.frame(mod) pbpply> B <- 100 pbpply> bid <- sapply(1:B, function(i) sample(nrow(ndat), nrow(ndat), TRUE)) pbpply> fun <- function(z) { pbpply+ if (missing(z)) pbpply+ z <- sample(nrow(ndat), nrow(ndat), TRUE) pbpply+ coef(lm(mod$call$formula, data=ndat[z,])) pbpply+ } pbpply> ## standard '*apply' functions pbpply> system.time(res1 <- lapply(1:B, function(i) fun(bid[,i]))) user system elapsed 0.09 0.00 0.09 pbpply> system.time(res2 <- sapply(1:B, function(i) fun(bid[,i]))) user system elapsed 0.09 0.00 0.09 pbpply> system.time(res3 <- apply(bid, 2, fun)) user system elapsed 0.08 0.00 0.08 pbpply> system.time(res4 <- replicate(B, fun())) user system elapsed 0.08 0.01 0.09 pbpply> ## 'pb*apply' functions pbpply> ## try different settings: pbpply> ## "none", "txt", "tk", "win", "timer" pbpply> op <- pboptions(type = "timer") # default pbpply> system.time(res1pb <- pblapply(1:B, function(i) fun(bid[,i]))) | | 0 % ~calculating |+ | 1 % ~00s |+ | 2 % ~00s |++ | 3 % ~00s |++ | 4 % ~00s |+++ | 5 % ~00s |+++ | 6 % ~00s |++++ | 7 % ~00s |++++ | 8 % ~00s |+++++ | 9 % ~00s |+++++ | 10% ~00s |++++++ | 11% ~00s |++++++ | 12% ~00s |+++++++ | 13% ~00s |+++++++ | 14% ~00s |++++++++ | 15% ~00s |++++++++ | 16% ~00s |+++++++++ | 17% ~00s |+++++++++ | 18% ~00s |++++++++++ | 19% ~00s |++++++++++ | 20% ~00s |+++++++++++ | 21% ~00s |+++++++++++ | 22% ~00s |++++++++++++ | 23% ~00s |++++++++++++ | 24% ~00s |+++++++++++++ | 25% ~00s |+++++++++++++ | 26% ~00s |++++++++++++++ | 27% ~00s |++++++++++++++ | 28% ~00s |+++++++++++++++ | 29% ~00s |+++++++++++++++ | 30% ~00s |++++++++++++++++ | 31% ~00s |++++++++++++++++ | 32% ~00s |+++++++++++++++++ | 33% ~00s |+++++++++++++++++ | 34% ~00s |++++++++++++++++++ | 35% ~00s |++++++++++++++++++ | 36% ~00s |+++++++++++++++++++ | 37% ~00s |+++++++++++++++++++ | 38% ~00s |++++++++++++++++++++ | 39% ~00s |++++++++++++++++++++ | 40% ~00s |+++++++++++++++++++++ | 41% ~00s |+++++++++++++++++++++ | 42% ~00s |++++++++++++++++++++++ | 43% ~00s |++++++++++++++++++++++ | 44% ~00s |+++++++++++++++++++++++ | 45% ~00s |+++++++++++++++++++++++ | 46% ~00s |++++++++++++++++++++++++ | 47% ~00s |++++++++++++++++++++++++ | 48% ~00s |+++++++++++++++++++++++++ | 49% ~00s |+++++++++++++++++++++++++ | 50% ~00s |++++++++++++++++++++++++++ | 51% ~00s |++++++++++++++++++++++++++ | 52% ~00s |+++++++++++++++++++++++++++ | 53% ~00s |+++++++++++++++++++++++++++ | 54% ~00s |++++++++++++++++++++++++++++ | 55% ~00s |++++++++++++++++++++++++++++ | 56% ~00s |+++++++++++++++++++++++++++++ | 57% ~00s |+++++++++++++++++++++++++++++ | 58% ~00s |++++++++++++++++++++++++++++++ | 59% ~00s |++++++++++++++++++++++++++++++ | 60% ~00s |+++++++++++++++++++++++++++++++ | 61% ~00s |+++++++++++++++++++++++++++++++ | 62% ~00s |++++++++++++++++++++++++++++++++ | 63% ~00s |++++++++++++++++++++++++++++++++ | 64% ~00s |+++++++++++++++++++++++++++++++++ | 65% ~00s |+++++++++++++++++++++++++++++++++ | 66% ~00s |++++++++++++++++++++++++++++++++++ | 67% ~00s |++++++++++++++++++++++++++++++++++ | 68% ~00s |+++++++++++++++++++++++++++++++++++ | 69% ~00s |+++++++++++++++++++++++++++++++++++ | 70% ~00s |++++++++++++++++++++++++++++++++++++ | 71% ~00s |++++++++++++++++++++++++++++++++++++ | 72% ~00s |+++++++++++++++++++++++++++++++++++++ | 73% ~00s |+++++++++++++++++++++++++++++++++++++ | 74% ~00s |++++++++++++++++++++++++++++++++++++++ | 75% ~00s |++++++++++++++++++++++++++++++++++++++ | 76% ~00s |+++++++++++++++++++++++++++++++++++++++ | 77% ~00s |+++++++++++++++++++++++++++++++++++++++ | 78% ~00s |++++++++++++++++++++++++++++++++++++++++ | 79% ~00s |++++++++++++++++++++++++++++++++++++++++ | 80% ~00s |+++++++++++++++++++++++++++++++++++++++++ | 81% ~00s |+++++++++++++++++++++++++++++++++++++++++ | 82% ~00s |++++++++++++++++++++++++++++++++++++++++++ | 83% ~00s |++++++++++++++++++++++++++++++++++++++++++ | 84% ~00s |+++++++++++++++++++++++++++++++++++++++++++ | 85% ~00s |+++++++++++++++++++++++++++++++++++++++++++ | 86% ~00s |++++++++++++++++++++++++++++++++++++++++++++ | 87% ~00s |++++++++++++++++++++++++++++++++++++++++++++ | 88% ~00s |+++++++++++++++++++++++++++++++++++++++++++++ | 89% ~00s |+++++++++++++++++++++++++++++++++++++++++++++ | 90% ~00s |++++++++++++++++++++++++++++++++++++++++++++++ | 91% ~00s |++++++++++++++++++++++++++++++++++++++++++++++ | 92% ~00s |+++++++++++++++++++++++++++++++++++++++++++++++ | 93% ~00s |+++++++++++++++++++++++++++++++++++++++++++++++ | 94% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++ | 95% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++ | 96% ~00s |+++++++++++++++++++++++++++++++++++++++++++++++++ | 97% ~00s |+++++++++++++++++++++++++++++++++++++++++++++++++ | 98% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 99% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s user system elapsed 0.08 0.00 0.07 pbpply> pboptions(op) pbpply> pboptions(type = "txt") pbpply> system.time(res2pb <- pbsapply(1:B, function(i) fun(bid[,i]))) | | | 0% | | | 1% | |+ | 2% | |++ | 3% | |++ | 4% | |++ | 5% | |+++ | 6% | |++++ | 7% | |++++ | 8% | |++++ | 9% | |+++++ | 10% | |++++++ | 11% | |++++++ | 12% | |++++++ | 13% | |+++++++ | 14% | |++++++++ | 15% | |++++++++ | 16% | |++++++++ | 17% | |+++++++++ | 18% | |++++++++++ | 19% | |++++++++++ | 20% | |++++++++++ | 21% | |+++++++++++ | 22% | |++++++++++++ | 23% | |++++++++++++ | 24% | |++++++++++++ | 25% | |+++++++++++++ | 26% | |++++++++++++++ | 27% | |++++++++++++++ | 28% | |++++++++++++++ | 29% | |+++++++++++++++ | 30% | |++++++++++++++++ | 31% | |++++++++++++++++ | 32% | |++++++++++++++++ | 33% | |+++++++++++++++++ | 34% | |++++++++++++++++++ | 35% | |++++++++++++++++++ | 36% | |++++++++++++++++++ | 37% | |+++++++++++++++++++ | 38% | |++++++++++++++++++++ | 39% | |++++++++++++++++++++ | 40% | |++++++++++++++++++++ | 41% | |+++++++++++++++++++++ | 42% | |++++++++++++++++++++++ | 43% | |++++++++++++++++++++++ | 44% | |++++++++++++++++++++++ | 45% | |+++++++++++++++++++++++ | 46% | |++++++++++++++++++++++++ | 47% | |++++++++++++++++++++++++ | 48% | |++++++++++++++++++++++++ | 49% | |+++++++++++++++++++++++++ | 50% | |++++++++++++++++++++++++++ | 51% | |++++++++++++++++++++++++++ | 52% | |++++++++++++++++++++++++++ | 53% | |+++++++++++++++++++++++++++ | 54% | |++++++++++++++++++++++++++++ | 55% | |++++++++++++++++++++++++++++ | 56% | |++++++++++++++++++++++++++++ | 57% | |+++++++++++++++++++++++++++++ | 58% | |++++++++++++++++++++++++++++++ | 59% | |++++++++++++++++++++++++++++++ | 60% | |++++++++++++++++++++++++++++++ | 61% | |+++++++++++++++++++++++++++++++ | 62% | |++++++++++++++++++++++++++++++++ | 63% | |++++++++++++++++++++++++++++++++ | 64% | |++++++++++++++++++++++++++++++++ | 65% | |+++++++++++++++++++++++++++++++++ | 66% | |++++++++++++++++++++++++++++++++++ | 67% | |++++++++++++++++++++++++++++++++++ | 68% | |++++++++++++++++++++++++++++++++++ | 69% | |+++++++++++++++++++++++++++++++++++ | 70% | |++++++++++++++++++++++++++++++++++++ | 71% | |++++++++++++++++++++++++++++++++++++ | 72% | |++++++++++++++++++++++++++++++++++++ | 73% | |+++++++++++++++++++++++++++++++++++++ | 74% | |++++++++++++++++++++++++++++++++++++++ | 75% | |++++++++++++++++++++++++++++++++++++++ | 76% | |++++++++++++++++++++++++++++++++++++++ | 77% | |+++++++++++++++++++++++++++++++++++++++ | 78% | |++++++++++++++++++++++++++++++++++++++++ | 79% | |++++++++++++++++++++++++++++++++++++++++ | 80% | |++++++++++++++++++++++++++++++++++++++++ | 81% | |+++++++++++++++++++++++++++++++++++++++++ | 82% | |++++++++++++++++++++++++++++++++++++++++++ | 83% | |++++++++++++++++++++++++++++++++++++++++++ | 84% | |++++++++++++++++++++++++++++++++++++++++++ | 85% | |+++++++++++++++++++++++++++++++++++++++++++ | 86% | |++++++++++++++++++++++++++++++++++++++++++++ | 87% | |++++++++++++++++++++++++++++++++++++++++++++ | 88% | |++++++++++++++++++++++++++++++++++++++++++++ | 89% | |+++++++++++++++++++++++++++++++++++++++++++++ | 90% | |++++++++++++++++++++++++++++++++++++++++++++++ | 91% | |++++++++++++++++++++++++++++++++++++++++++++++ | 92% | |++++++++++++++++++++++++++++++++++++++++++++++ | 93% | |+++++++++++++++++++++++++++++++++++++++++++++++ | 94% | |++++++++++++++++++++++++++++++++++++++++++++++++ | 95% | |++++++++++++++++++++++++++++++++++++++++++++++++ | 96% | |++++++++++++++++++++++++++++++++++++++++++++++++ | 97% | |+++++++++++++++++++++++++++++++++++++++++++++++++ | 98% | |++++++++++++++++++++++++++++++++++++++++++++++++++| 99% | |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% user system elapsed 0.1 0.0 0.1 pbpply> pboptions(op) pbpply> pboptions(type = "txt", style = 1, char = "=") pbpply> system.time(res3pb <- pbapply(bid, 2, fun)) ================================================== user system elapsed 0.08 0.00 0.08 pbpply> pboptions(op) pbpply> pboptions(type = "txt", char = ":") pbpply> system.time(res4pb <- pbreplicate(B, fun())) | | | 0% | | | 1% | |: | 2% | |:: | 3% | |:: | 4% | |:: | 5% | |::: | 6% | |:::: | 7% | |:::: | 8% | |:::: | 9% | |::::: | 10% | |:::::: | 11% | |:::::: | 12% | |:::::: | 13% | |::::::: | 14% | |:::::::: | 15% | |:::::::: | 16% | |:::::::: | 17% | |::::::::: | 18% | |:::::::::: | 19% | |:::::::::: | 20% | |:::::::::: | 21% | |::::::::::: | 22% | |:::::::::::: | 23% | |:::::::::::: | 24% | |:::::::::::: | 25% | |::::::::::::: | 26% | |:::::::::::::: | 27% | |:::::::::::::: | 28% | |:::::::::::::: | 29% | |::::::::::::::: | 30% | |:::::::::::::::: | 31% | |:::::::::::::::: | 32% | |:::::::::::::::: | 33% | |::::::::::::::::: | 34% | |:::::::::::::::::: | 35% | |:::::::::::::::::: | 36% | |:::::::::::::::::: | 37% | |::::::::::::::::::: | 38% | |:::::::::::::::::::: | 39% | |:::::::::::::::::::: | 40% | |:::::::::::::::::::: | 41% | |::::::::::::::::::::: | 42% | |:::::::::::::::::::::: | 43% | |:::::::::::::::::::::: | 44% | |:::::::::::::::::::::: | 45% | |::::::::::::::::::::::: | 46% | |:::::::::::::::::::::::: | 47% | |:::::::::::::::::::::::: | 48% | |:::::::::::::::::::::::: | 49% | |::::::::::::::::::::::::: | 50% | |:::::::::::::::::::::::::: | 51% | |:::::::::::::::::::::::::: | 52% | |:::::::::::::::::::::::::: | 53% | |::::::::::::::::::::::::::: | 54% | |:::::::::::::::::::::::::::: | 55% | |:::::::::::::::::::::::::::: | 56% | |:::::::::::::::::::::::::::: | 57% | |::::::::::::::::::::::::::::: | 58% | |:::::::::::::::::::::::::::::: | 59% | |:::::::::::::::::::::::::::::: | 60% | |:::::::::::::::::::::::::::::: | 61% | |::::::::::::::::::::::::::::::: | 62% | |:::::::::::::::::::::::::::::::: | 63% | |:::::::::::::::::::::::::::::::: | 64% | |:::::::::::::::::::::::::::::::: | 65% | |::::::::::::::::::::::::::::::::: | 66% | |:::::::::::::::::::::::::::::::::: | 67% | |:::::::::::::::::::::::::::::::::: | 68% | |:::::::::::::::::::::::::::::::::: | 69% | |::::::::::::::::::::::::::::::::::: | 70% | |:::::::::::::::::::::::::::::::::::: | 71% | |:::::::::::::::::::::::::::::::::::: | 72% | |:::::::::::::::::::::::::::::::::::: | 73% | |::::::::::::::::::::::::::::::::::::: | 74% | |:::::::::::::::::::::::::::::::::::::: | 75% | |:::::::::::::::::::::::::::::::::::::: | 76% | |:::::::::::::::::::::::::::::::::::::: | 77% | |::::::::::::::::::::::::::::::::::::::: | 78% | |:::::::::::::::::::::::::::::::::::::::: | 79% | |:::::::::::::::::::::::::::::::::::::::: | 80% | |:::::::::::::::::::::::::::::::::::::::: | 81% | |::::::::::::::::::::::::::::::::::::::::: | 82% | |:::::::::::::::::::::::::::::::::::::::::: | 83% | |:::::::::::::::::::::::::::::::::::::::::: | 84% | |:::::::::::::::::::::::::::::::::::::::::: | 85% | |::::::::::::::::::::::::::::::::::::::::::: | 86% | |:::::::::::::::::::::::::::::::::::::::::::: | 87% | |:::::::::::::::::::::::::::::::::::::::::::: | 88% | |:::::::::::::::::::::::::::::::::::::::::::: | 89% | |::::::::::::::::::::::::::::::::::::::::::::: | 90% | |:::::::::::::::::::::::::::::::::::::::::::::: | 91% | |:::::::::::::::::::::::::::::::::::::::::::::: | 92% | |:::::::::::::::::::::::::::::::::::::::::::::: | 93% | |::::::::::::::::::::::::::::::::::::::::::::::: | 94% | |:::::::::::::::::::::::::::::::::::::::::::::::: | 95% | |:::::::::::::::::::::::::::::::::::::::::::::::: | 96% | |:::::::::::::::::::::::::::::::::::::::::::::::: | 97% | |::::::::::::::::::::::::::::::::::::::::::::::::: | 98% | |::::::::::::::::::::::::::::::::::::::::::::::::::| 99% | |::::::::::::::::::::::::::::::::::::::::::::::::::| 100% user system elapsed 0.11 0.00 0.11 pbpply> pboptions(op) pbpply> ## parallel evaluation using the parallel package pbpply> ## (n = 2000 and B = 1000 will give visible timing differences) pbpply> pbpply> library(parallel) pbpply> cl <- makeCluster(2L) pbpply> clusterExport(cl, c("fun", "mod", "ndat", "bid")) pbpply> ## parallel with no progress bar: snow type cluster pbpply> ## (RNG is set in the main process to define the object bid) pbpply> system.time(res1cl <- parLapply(cl = cl, 1:B, function(i) fun(bid[,i]))) user system elapsed 0.00 0.00 0.09 pbpply> system.time(res2cl <- parSapply(cl = cl, 1:B, function(i) fun(bid[,i]))) user system elapsed 0.00 0.00 0.06 pbpply> system.time(res3cl <- parApply(cl, bid, 2, fun)) user system elapsed 0.00 0.00 0.08 pbpply> ## parallel with progress bar: snow type cluster pbpply> ## (RNG is set in the main process to define the object bid) pbpply> system.time(res1pbcl <- pblapply(1:B, function(i) fun(bid[,i]), cl = cl)) | | 0 % ~calculating |+ | 2 % ~00s |++ | 4 % ~00s |+++ | 6 % ~00s |++++ | 8 % ~00s |+++++ | 10% ~00s |++++++ | 12% ~00s |+++++++ | 14% ~00s |++++++++ | 16% ~00s |+++++++++ | 18% ~00s |++++++++++ | 20% ~00s |+++++++++++ | 22% ~00s |++++++++++++ | 24% ~00s |+++++++++++++ | 26% ~00s |++++++++++++++ | 28% ~00s |+++++++++++++++ | 30% ~00s |++++++++++++++++ | 32% ~00s |+++++++++++++++++ | 34% ~00s |++++++++++++++++++ | 36% ~00s |+++++++++++++++++++ | 38% ~00s |++++++++++++++++++++ | 40% ~00s |+++++++++++++++++++++ | 42% ~00s |++++++++++++++++++++++ | 44% ~00s |+++++++++++++++++++++++ | 46% ~00s |++++++++++++++++++++++++ | 48% ~00s |+++++++++++++++++++++++++ | 50% ~00s |++++++++++++++++++++++++++ | 52% ~00s |+++++++++++++++++++++++++++ | 54% ~00s |++++++++++++++++++++++++++++ | 56% ~00s |+++++++++++++++++++++++++++++ | 58% ~00s |++++++++++++++++++++++++++++++ | 60% ~00s |+++++++++++++++++++++++++++++++ | 62% ~00s |++++++++++++++++++++++++++++++++ | 64% ~00s |+++++++++++++++++++++++++++++++++ | 66% ~00s |++++++++++++++++++++++++++++++++++ | 68% ~00s |+++++++++++++++++++++++++++++++++++ | 70% ~00s |++++++++++++++++++++++++++++++++++++ | 72% ~00s |+++++++++++++++++++++++++++++++++++++ | 74% ~00s |++++++++++++++++++++++++++++++++++++++ | 76% ~00s |+++++++++++++++++++++++++++++++++++++++ | 78% ~00s |++++++++++++++++++++++++++++++++++++++++ | 80% ~00s |+++++++++++++++++++++++++++++++++++++++++ | 82% ~00s |++++++++++++++++++++++++++++++++++++++++++ | 84% ~00s |+++++++++++++++++++++++++++++++++++++++++++ | 86% ~00s |++++++++++++++++++++++++++++++++++++++++++++ | 88% ~00s |+++++++++++++++++++++++++++++++++++++++++++++ | 90% ~00s |++++++++++++++++++++++++++++++++++++++++++++++ | 92% ~00s |+++++++++++++++++++++++++++++++++++++++++++++++ | 94% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++ | 96% ~00s |+++++++++++++++++++++++++++++++++++++++++++++++++ | 98% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s user system elapsed 0.08 0.10 0.23 pbpply> system.time(res2pbcl <- pbsapply(1:B, function(i) fun(bid[,i]), cl = cl)) | | 0 % ~calculating |+ | 2 % ~00s |++ | 4 % ~00s |+++ | 6 % ~00s |++++ | 8 % ~00s |+++++ | 10% ~00s |++++++ | 12% ~00s |+++++++ | 14% ~00s |++++++++ | 16% ~00s |+++++++++ | 18% ~00s |++++++++++ | 20% ~00s |+++++++++++ | 22% ~00s |++++++++++++ | 24% ~00s |+++++++++++++ | 26% ~00s |++++++++++++++ | 28% ~00s |+++++++++++++++ | 30% ~00s |++++++++++++++++ | 32% ~00s |+++++++++++++++++ | 34% ~00s |++++++++++++++++++ | 36% ~00s |+++++++++++++++++++ | 38% ~00s |++++++++++++++++++++ | 40% ~00s |+++++++++++++++++++++ | 42% ~00s |++++++++++++++++++++++ | 44% ~00s |+++++++++++++++++++++++ | 46% ~00s |++++++++++++++++++++++++ | 48% ~00s |+++++++++++++++++++++++++ | 50% ~00s |++++++++++++++++++++++++++ | 52% ~00s |+++++++++++++++++++++++++++ | 54% ~00s |++++++++++++++++++++++++++++ | 56% ~00s |+++++++++++++++++++++++++++++ | 58% ~00s |++++++++++++++++++++++++++++++ | 60% ~00s |+++++++++++++++++++++++++++++++ | 62% ~00s |++++++++++++++++++++++++++++++++ | 64% ~00s |+++++++++++++++++++++++++++++++++ | 66% ~00s |++++++++++++++++++++++++++++++++++ | 68% ~00s |+++++++++++++++++++++++++++++++++++ | 70% ~00s |++++++++++++++++++++++++++++++++++++ | 72% ~00s |+++++++++++++++++++++++++++++++++++++ | 74% ~00s |++++++++++++++++++++++++++++++++++++++ | 76% ~00s |+++++++++++++++++++++++++++++++++++++++ | 78% ~00s |++++++++++++++++++++++++++++++++++++++++ | 80% ~00s |+++++++++++++++++++++++++++++++++++++++++ | 82% ~00s |++++++++++++++++++++++++++++++++++++++++++ | 84% ~00s |+++++++++++++++++++++++++++++++++++++++++++ | 86% ~00s |++++++++++++++++++++++++++++++++++++++++++++ | 88% ~00s |+++++++++++++++++++++++++++++++++++++++++++++ | 90% ~00s |++++++++++++++++++++++++++++++++++++++++++++++ | 92% ~00s |+++++++++++++++++++++++++++++++++++++++++++++++ | 94% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++ | 96% ~00s |+++++++++++++++++++++++++++++++++++++++++++++++++ | 98% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s user system elapsed 0.15 0.01 0.28 pbpply> ## (RNG needs to be set when not using bid) pbpply> parallel::clusterSetRNGStream(cl, iseed = 0L) pbpply> system.time(res4pbcl <- pbreplicate(B, fun(), cl = cl)) | | 0 % ~calculating |+ | 2 % ~01s |++ | 4 % ~00s |+++ | 6 % ~00s |++++ | 8 % ~00s |+++++ | 10% ~00s |++++++ | 12% ~00s |+++++++ | 14% ~00s |++++++++ | 16% ~00s |+++++++++ | 18% ~00s |++++++++++ | 20% ~00s |+++++++++++ | 22% ~00s |++++++++++++ | 24% ~00s |+++++++++++++ | 26% ~00s |++++++++++++++ | 28% ~00s |+++++++++++++++ | 30% ~00s |++++++++++++++++ | 32% ~00s |+++++++++++++++++ | 34% ~00s |++++++++++++++++++ | 36% ~00s |+++++++++++++++++++ | 38% ~00s |++++++++++++++++++++ | 40% ~00s |+++++++++++++++++++++ | 42% ~00s |++++++++++++++++++++++ | 44% ~00s |+++++++++++++++++++++++ | 46% ~00s |++++++++++++++++++++++++ | 48% ~00s |+++++++++++++++++++++++++ | 50% ~00s |++++++++++++++++++++++++++ | 52% ~00s |+++++++++++++++++++++++++++ | 54% ~00s |++++++++++++++++++++++++++++ | 56% ~00s |+++++++++++++++++++++++++++++ | 58% ~00s |++++++++++++++++++++++++++++++ | 60% ~00s |+++++++++++++++++++++++++++++++ | 62% ~00s |++++++++++++++++++++++++++++++++ | 64% ~00s |+++++++++++++++++++++++++++++++++ | 66% ~00s |++++++++++++++++++++++++++++++++++ | 68% ~00s |+++++++++++++++++++++++++++++++++++ | 70% ~00s |++++++++++++++++++++++++++++++++++++ | 72% ~00s |+++++++++++++++++++++++++++++++++++++ | 74% ~00s |++++++++++++++++++++++++++++++++++++++ | 76% ~00s |+++++++++++++++++++++++++++++++++++++++ | 78% ~00s |++++++++++++++++++++++++++++++++++++++++ | 80% ~00s |+++++++++++++++++++++++++++++++++++++++++ | 82% ~00s |++++++++++++++++++++++++++++++++++++++++++ | 84% ~00s |+++++++++++++++++++++++++++++++++++++++++++ | 86% ~00s |++++++++++++++++++++++++++++++++++++++++++++ | 88% ~00s |+++++++++++++++++++++++++++++++++++++++++++++ | 90% ~00s |++++++++++++++++++++++++++++++++++++++++++++++ | 92% ~00s |+++++++++++++++++++++++++++++++++++++++++++++++ | 94% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++ | 96% ~00s |+++++++++++++++++++++++++++++++++++++++++++++++++ | 98% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s user system elapsed 0.02 0.00 0.14 pbpply> system.time(res3pbcl <- pbapply(bid, 2, fun, cl = cl)) | | 0 % ~calculating |+ | 2 % ~00s |++ | 4 % ~00s |+++ | 6 % ~00s |++++ | 8 % ~00s |+++++ | 10% ~00s |++++++ | 12% ~00s |+++++++ | 14% ~00s |++++++++ | 16% ~00s |+++++++++ | 18% ~00s |++++++++++ | 20% ~00s |+++++++++++ | 22% ~00s |++++++++++++ | 24% ~00s |+++++++++++++ | 26% ~00s |++++++++++++++ | 28% ~00s |+++++++++++++++ | 30% ~00s |++++++++++++++++ | 32% ~00s |+++++++++++++++++ | 34% ~00s |++++++++++++++++++ | 36% ~00s |+++++++++++++++++++ | 38% ~00s |++++++++++++++++++++ | 40% ~00s |+++++++++++++++++++++ | 42% ~00s |++++++++++++++++++++++ | 44% ~00s |+++++++++++++++++++++++ | 46% ~00s |++++++++++++++++++++++++ | 48% ~00s |+++++++++++++++++++++++++ | 50% ~00s |++++++++++++++++++++++++++ | 52% ~00s |+++++++++++++++++++++++++++ | 54% ~00s |++++++++++++++++++++++++++++ | 56% ~00s |+++++++++++++++++++++++++++++ | 58% ~00s |++++++++++++++++++++++++++++++ | 60% ~00s |+++++++++++++++++++++++++++++++ | 62% ~00s |++++++++++++++++++++++++++++++++ | 64% ~00s |+++++++++++++++++++++++++++++++++ | 66% ~00s |++++++++++++++++++++++++++++++++++ | 68% ~00s |+++++++++++++++++++++++++++++++++++ | 70% ~00s |++++++++++++++++++++++++++++++++++++ | 72% ~00s |+++++++++++++++++++++++++++++++++++++ | 74% ~00s |++++++++++++++++++++++++++++++++++++++ | 76% ~00s |+++++++++++++++++++++++++++++++++++++++ | 78% ~00s |++++++++++++++++++++++++++++++++++++++++ | 80% ~00s |+++++++++++++++++++++++++++++++++++++++++ | 82% ~00s |++++++++++++++++++++++++++++++++++++++++++ | 84% ~00s |+++++++++++++++++++++++++++++++++++++++++++ | 86% ~00s |++++++++++++++++++++++++++++++++++++++++++++ | 88% ~00s |+++++++++++++++++++++++++++++++++++++++++++++ | 90% ~00s |++++++++++++++++++++++++++++++++++++++++++++++ | 92% ~00s |+++++++++++++++++++++++++++++++++++++++++++++++ | 94% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++ | 96% ~00s |+++++++++++++++++++++++++++++++++++++++++++++++++ | 98% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s user system elapsed 0.15 0.00 0.26 pbpply> stopCluster(cl) pbpply> if (.Platform$OS.type != "windows") { pbpply+ ## parallel with no progress bar: multicore type forking pbpply+ ## (mc.set.seed = TRUE in parallel::mclapply by default) pbpply+ system.time(res2mc <- mclapply(1:B, function(i) fun(bid[,i]), mc.cores = 2L)) pbpply+ ## parallel with progress bar: multicore type forking pbpply+ ## (mc.set.seed = TRUE in parallel::mclapply by default) pbpply+ system.time(res1pbmc <- pblapply(1:B, function(i) fun(bid[,i]), cl = 2L)) pbpply+ system.time(res2pbmc <- pbsapply(1:B, function(i) fun(bid[,i]), cl = 2L)) pbpply+ system.time(res4pbmc <- pbreplicate(B, fun(), cl = 2L)) pbpply+ } pbpply> ## --- Examples taken from standard '*apply' functions --- pbpply> pbpply> ## --- sapply, lapply, and replicate --- pbpply> pbpply> require(stats); require(graphics) pbpply> x <- list(a = 1:10, beta = exp(-3:3), logic = c(TRUE,FALSE,FALSE,TRUE)) pbpply> # compute the list mean for each list element pbpply> pblapply(x, mean) | | 0 % ~calculating |+++++++++++++++++ | 33% ~00s |++++++++++++++++++++++++++++++++++ | 67% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s $a [1] 5.5 $beta [1] 4.535125 $logic [1] 0.5 pbpply> pbwalk(x, mean) | | 0 % ~calculating |+++++++++++++++++ | 33% ~00s |++++++++++++++++++++++++++++++++++ | 67% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s pbpply> # median and quartiles for each list element pbpply> pblapply(x, quantile, probs = 1:3/4) | | 0 % ~calculating |+++++++++++++++++ | 33% ~00s |++++++++++++++++++++++++++++++++++ | 67% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s $a 25% 50% 75% 3.25 5.50 7.75 $beta 25% 50% 75% 0.2516074 1.0000000 5.0536690 $logic 25% 50% 75% 0.0 0.5 1.0 pbpply> pbsapply(x, quantile) | | 0 % ~calculating |+++++++++++++++++ | 33% ~00s |++++++++++++++++++++++++++++++++++ | 67% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s a beta logic 0% 1.00 0.04978707 0.0 25% 3.25 0.25160736 0.0 50% 5.50 1.00000000 0.5 75% 7.75 5.05366896 1.0 100% 10.00 20.08553692 1.0 pbpply> i39 <- sapply(3:9, seq) # list of vectors pbpply> pbsapply(i39, fivenum) | | 0 % ~calculating |++++++++ | 14% ~00s |+++++++++++++++ | 29% ~00s |++++++++++++++++++++++ | 43% ~00s |+++++++++++++++++++++++++++++ | 57% ~00s |++++++++++++++++++++++++++++++++++++ | 71% ~00s |+++++++++++++++++++++++++++++++++++++++++++ | 86% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s [,1] [,2] [,3] [,4] [,5] [,6] [,7] [1,] 1.0 1.0 1 1.0 1.0 1.0 1 [2,] 1.5 1.5 2 2.0 2.5 2.5 3 [3,] 2.0 2.5 3 3.5 4.0 4.5 5 [4,] 2.5 3.5 4 5.0 5.5 6.5 7 [5,] 3.0 4.0 5 6.0 7.0 8.0 9 pbpply> pbvapply(i39, fivenum, pbpply+ c(Min. = 0, "1st Qu." = 0, Median = 0, "3rd Qu." = 0, Max. = 0)) | | 0 % ~calculating |++++++++ | 14% ~00s |+++++++++++++++ | 29% ~00s |++++++++++++++++++++++ | 43% ~00s |+++++++++++++++++++++++++++++ | 57% ~00s |++++++++++++++++++++++++++++++++++++ | 71% ~00s |+++++++++++++++++++++++++++++++++++++++++++ | 86% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s [,1] [,2] [,3] [,4] [,5] [,6] [,7] Min. 1.0 1.0 1 1.0 1.0 1.0 1 1st Qu. 1.5 1.5 2 2.0 2.5 2.5 3 Median 2.0 2.5 3 3.5 4.0 4.5 5 3rd Qu. 2.5 3.5 4 5.0 5.5 6.5 7 Max. 3.0 4.0 5 6.0 7.0 8.0 9 pbpply> ## sapply(*, "array") -- artificial example pbpply> (v <- structure(10*(5:8), names = LETTERS[1:4])) A B C D 50 60 70 80 pbpply> f2 <- function(x, y) outer(rep(x, length.out = 3), y) pbpply> (a2 <- pbsapply(v, f2, y = 2*(1:5), simplify = "array")) | | 0 % ~calculating |+++++++++++++ | 25% ~00s |+++++++++++++++++++++++++ | 50% ~00s |++++++++++++++++++++++++++++++++++++++ | 75% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s , , A [,1] [,2] [,3] [,4] [,5] [1,] 100 200 300 400 500 [2,] 100 200 300 400 500 [3,] 100 200 300 400 500 , , B [,1] [,2] [,3] [,4] [,5] [1,] 120 240 360 480 600 [2,] 120 240 360 480 600 [3,] 120 240 360 480 600 , , C [,1] [,2] [,3] [,4] [,5] [1,] 140 280 420 560 700 [2,] 140 280 420 560 700 [3,] 140 280 420 560 700 , , D [,1] [,2] [,3] [,4] [,5] [1,] 160 320 480 640 800 [2,] 160 320 480 640 800 [3,] 160 320 480 640 800 pbpply> a.2 <- pbvapply(v, f2, outer(1:3, 1:5), y = 2*(1:5)) | | 0 % ~calculating |+++++++++++++ | 25% ~00s |+++++++++++++++++++++++++ | 50% ~00s |++++++++++++++++++++++++++++++++++++++ | 75% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s pbpply> stopifnot(dim(a2) == c(3,5,4), all.equal(a2, a.2), pbpply+ identical(dimnames(a2), list(NULL,NULL,LETTERS[1:4]))) pbpply> summary(pbreplicate(100, mean(rexp(10)))) | | 0 % ~calculating |+ | 1 % ~00s |+ | 2 % ~00s |++ | 3 % ~00s |++ | 4 % ~00s |+++ | 5 % ~00s |+++ | 6 % ~00s |++++ | 7 % ~00s |++++ | 8 % ~00s |+++++ | 9 % ~00s |+++++ | 10% ~00s |++++++ | 11% ~00s |++++++ | 12% ~00s |+++++++ | 13% ~00s |+++++++ | 14% ~00s |++++++++ | 15% ~00s |++++++++ | 16% ~00s |+++++++++ | 17% ~00s |+++++++++ | 18% ~00s |++++++++++ | 19% ~00s |++++++++++ | 20% ~00s |+++++++++++ | 21% ~00s |+++++++++++ | 22% ~00s |++++++++++++ | 23% ~00s |++++++++++++ | 24% ~00s |+++++++++++++ | 25% ~00s |+++++++++++++ | 26% ~00s |++++++++++++++ | 27% ~00s |++++++++++++++ | 28% ~00s |+++++++++++++++ | 29% ~00s |+++++++++++++++ | 30% ~00s |++++++++++++++++ | 31% ~00s |++++++++++++++++ | 32% ~00s |+++++++++++++++++ | 33% ~00s |+++++++++++++++++ | 34% ~00s |++++++++++++++++++ | 35% ~00s |++++++++++++++++++ | 36% ~00s |+++++++++++++++++++ | 37% ~00s |+++++++++++++++++++ | 38% ~00s |++++++++++++++++++++ | 39% ~00s |++++++++++++++++++++ | 40% ~00s |+++++++++++++++++++++ | 41% ~00s |+++++++++++++++++++++ | 42% ~00s |++++++++++++++++++++++ | 43% ~00s |++++++++++++++++++++++ | 44% ~00s |+++++++++++++++++++++++ | 45% ~00s |+++++++++++++++++++++++ | 46% ~00s |++++++++++++++++++++++++ | 47% ~00s |++++++++++++++++++++++++ | 48% ~00s |+++++++++++++++++++++++++ | 49% ~00s |+++++++++++++++++++++++++ | 50% ~00s |++++++++++++++++++++++++++ | 51% ~00s |++++++++++++++++++++++++++ | 52% ~00s |+++++++++++++++++++++++++++ | 53% ~00s |+++++++++++++++++++++++++++ | 54% ~00s |++++++++++++++++++++++++++++ | 55% ~00s |++++++++++++++++++++++++++++ | 56% ~00s |+++++++++++++++++++++++++++++ | 57% ~00s |+++++++++++++++++++++++++++++ | 58% ~00s |++++++++++++++++++++++++++++++ | 59% ~00s |++++++++++++++++++++++++++++++ | 60% ~00s |+++++++++++++++++++++++++++++++ | 61% ~00s |+++++++++++++++++++++++++++++++ | 62% ~00s |++++++++++++++++++++++++++++++++ | 63% ~00s |++++++++++++++++++++++++++++++++ | 64% ~00s |+++++++++++++++++++++++++++++++++ | 65% ~00s |+++++++++++++++++++++++++++++++++ | 66% ~00s |++++++++++++++++++++++++++++++++++ | 67% ~00s |++++++++++++++++++++++++++++++++++ | 68% ~00s |+++++++++++++++++++++++++++++++++++ | 69% ~00s |+++++++++++++++++++++++++++++++++++ | 70% ~00s |++++++++++++++++++++++++++++++++++++ | 71% ~00s |++++++++++++++++++++++++++++++++++++ | 72% ~00s |+++++++++++++++++++++++++++++++++++++ | 73% ~00s |+++++++++++++++++++++++++++++++++++++ | 74% ~00s |++++++++++++++++++++++++++++++++++++++ | 75% ~00s |++++++++++++++++++++++++++++++++++++++ | 76% ~00s |+++++++++++++++++++++++++++++++++++++++ | 77% ~00s |+++++++++++++++++++++++++++++++++++++++ | 78% ~00s |++++++++++++++++++++++++++++++++++++++++ | 79% ~00s |++++++++++++++++++++++++++++++++++++++++ | 80% ~00s |+++++++++++++++++++++++++++++++++++++++++ | 81% ~00s |+++++++++++++++++++++++++++++++++++++++++ | 82% ~00s |++++++++++++++++++++++++++++++++++++++++++ | 83% ~00s |++++++++++++++++++++++++++++++++++++++++++ | 84% ~00s |+++++++++++++++++++++++++++++++++++++++++++ | 85% ~00s |+++++++++++++++++++++++++++++++++++++++++++ | 86% ~00s |++++++++++++++++++++++++++++++++++++++++++++ | 87% ~00s |++++++++++++++++++++++++++++++++++++++++++++ | 88% ~00s |+++++++++++++++++++++++++++++++++++++++++++++ | 89% ~00s |+++++++++++++++++++++++++++++++++++++++++++++ | 90% ~00s |++++++++++++++++++++++++++++++++++++++++++++++ | 91% ~00s |++++++++++++++++++++++++++++++++++++++++++++++ | 92% ~00s |+++++++++++++++++++++++++++++++++++++++++++++++ | 93% ~00s |+++++++++++++++++++++++++++++++++++++++++++++++ | 94% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++ | 95% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++ | 96% ~00s |+++++++++++++++++++++++++++++++++++++++++++++++++ | 97% ~00s |+++++++++++++++++++++++++++++++++++++++++++++++++ | 98% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 99% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s Min. 1st Qu. Median Mean 3rd Qu. Max. 0.4786 0.7273 0.9091 0.9666 1.1917 2.3021 pbpply> ## use of replicate() with parameters: pbpply> foo <- function(x = 1, y = 2) c(x, y) pbpply> # does not work: bar <- function(n, ...) replicate(n, foo(...)) pbpply> bar <- function(n, x) pbreplicate(n, foo(x = x)) pbpply> bar(5, x = 3) | | 0 % ~calculating |++++++++++ | 20% ~00s |++++++++++++++++++++ | 40% ~00s |++++++++++++++++++++++++++++++ | 60% ~00s |++++++++++++++++++++++++++++++++++++++++ | 80% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s [,1] [,2] [,3] [,4] [,5] [1,] 3 3 3 3 3 [2,] 2 2 2 2 2 pbpply> ## --- apply --- pbpply> pbpply> ## Compute row and column sums for a matrix: pbpply> x <- cbind(x1 = 3, x2 = c(4:1, 2:5)) pbpply> dimnames(x)[[1]] <- letters[1:8] pbpply> pbapply(x, 2, mean, trim = .2) | | 0 % ~calculating |+++++++++++++++++++++++++ | 50% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s x1 x2 3 3 pbpply> col.sums <- pbapply(x, 2, sum) | | 0 % ~calculating |+++++++++++++++++++++++++ | 50% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s pbpply> row.sums <- pbapply(x, 1, sum) | | 0 % ~calculating |+++++++ | 12% ~00s |+++++++++++++ | 25% ~00s |+++++++++++++++++++ | 38% ~00s |+++++++++++++++++++++++++ | 50% ~00s |++++++++++++++++++++++++++++++++ | 62% ~00s |++++++++++++++++++++++++++++++++++++++ | 75% ~00s |++++++++++++++++++++++++++++++++++++++++++++ | 88% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s pbpply> rbind(cbind(x, Rtot = row.sums), Ctot = c(col.sums, sum(col.sums))) x1 x2 Rtot a 3 4 7 b 3 3 6 c 3 2 5 d 3 1 4 e 3 2 5 f 3 3 6 g 3 4 7 h 3 5 8 Ctot 24 24 48 pbpply> stopifnot( pbapply(x, 2, is.vector)) | | 0 % ~calculating |+++++++++++++++++++++++++ | 50% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s pbpply> ## Sort the columns of a matrix pbpply> pbapply(x, 2, sort) | | 0 % ~calculating |+++++++++++++++++++++++++ | 50% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s x1 x2 [1,] 3 1 [2,] 3 2 [3,] 3 2 [4,] 3 3 [5,] 3 3 [6,] 3 4 [7,] 3 4 [8,] 3 5 pbpply> ## keeping named dimnames pbpply> names(dimnames(x)) <- c("row", "col") pbpply> x3 <- array(x, dim = c(dim(x),3), pbpply+ dimnames = c(dimnames(x), list(C = paste0("cop.",1:3)))) pbpply> identical(x, pbapply( x, 2, identity)) | | 0 % ~calculating |+++++++++++++++++++++++++ | 50% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s [1] TRUE pbpply> identical(x3, pbapply(x3, 2:3, identity)) | | 0 % ~calculating |+++++++++ | 17% ~00s |+++++++++++++++++ | 33% ~00s |+++++++++++++++++++++++++ | 50% ~00s |++++++++++++++++++++++++++++++++++ | 67% ~00s |++++++++++++++++++++++++++++++++++++++++++ | 83% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s [1] TRUE pbpply> ##- function with extra args: pbpply> cave <- function(x, c1, c2) c(mean(x[c1]), mean(x[c2])) pbpply> pbapply(x, 1, cave, c1 = "x1", c2 = c("x1","x2")) | | 0 % ~calculating |+++++++ | 12% ~00s |+++++++++++++ | 25% ~00s |+++++++++++++++++++ | 38% ~00s |+++++++++++++++++++++++++ | 50% ~00s |++++++++++++++++++++++++++++++++ | 62% ~00s |++++++++++++++++++++++++++++++++++++++ | 75% ~00s |++++++++++++++++++++++++++++++++++++++++++++ | 88% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s row a b c d e f g h [1,] 3.0 3 3.0 3 3.0 3 3.0 3 [2,] 3.5 3 2.5 2 2.5 3 3.5 4 pbpply> ma <- matrix(c(1:4, 1, 6:8), nrow = 2) pbpply> ma [,1] [,2] [,3] [,4] [1,] 1 3 1 7 [2,] 2 4 6 8 pbpply> pbapply(ma, 1, table) #--> a list of length 2 | | 0 % ~calculating |+++++++++++++++++++++++++ | 50% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s [[1]] 1 3 7 2 1 1 [[2]] 2 4 6 8 1 1 1 1 pbpply> pbapply(ma, 1, stats::quantile) # 5 x n matrix with rownames | | 0 % ~calculating |+++++++++++++++++++++++++ | 50% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s [,1] [,2] 0% 1 2.0 25% 1 3.5 50% 2 5.0 75% 4 6.5 100% 7 8.0 pbpply> stopifnot(dim(ma) == dim(pbapply(ma, 1:2, sum))) | | 0 % ~calculating |+++++++ | 12% ~00s |+++++++++++++ | 25% ~00s |+++++++++++++++++++ | 38% ~00s |+++++++++++++++++++++++++ | 50% ~00s |++++++++++++++++++++++++++++++++ | 62% ~00s |++++++++++++++++++++++++++++++++++++++ | 75% ~00s |++++++++++++++++++++++++++++++++++++++++++++ | 88% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s pbpply> ## Example with different lengths for each call pbpply> z <- array(1:24, dim = 2:4) pbpply> zseq <- pbapply(z, 1:2, function(x) seq_len(max(x))) | | 0 % ~calculating |+++++++++ | 17% ~00s |+++++++++++++++++ | 33% ~00s |+++++++++++++++++++++++++ | 50% ~00s |++++++++++++++++++++++++++++++++++ | 67% ~00s |++++++++++++++++++++++++++++++++++++++++++ | 83% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s pbpply> zseq ## a 2 x 3 matrix [,1] [,2] [,3] [1,] integer,19 integer,21 integer,23 [2,] integer,20 integer,22 integer,24 pbpply> typeof(zseq) ## list [1] "list" pbpply> dim(zseq) ## 2 3 [1] 2 3 pbpply> zseq[1,] [[1]] [1] 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 [[2]] [1] 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 [[3]] [1] 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 pbpply> pbapply(z, 3, function(x) seq_len(max(x))) | | 0 % ~calculating |+++++++++++++ | 25% ~00s |+++++++++++++++++++++++++ | 50% ~00s |++++++++++++++++++++++++++++++++++++++ | 75% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s [[1]] [1] 1 2 3 4 5 6 [[2]] [1] 1 2 3 4 5 6 7 8 9 10 11 12 [[3]] [1] 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 [[4]] [1] 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 pbpply> # a list without a dim attribute pbpply> pbpply> ## --- mapply and .mapply --- pbpply> pbpply> pbmapply(rep, 1:4, 4:1) | | 0 % ~calculating |+++++++++++++ | 25% ~00s |+++++++++++++++++++++++++ | 50% ~00s |++++++++++++++++++++++++++++++++++++++ | 75% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s [[1]] [1] 1 1 1 1 [[2]] [1] 2 2 2 [[3]] [1] 3 3 [[4]] [1] 4 pbpply> pbmapply(rep, times = 1:4, x = 4:1) | | 0 % ~calculating |+++++++++++++ | 25% ~00s |+++++++++++++++++++++++++ | 50% ~00s |++++++++++++++++++++++++++++++++++++++ | 75% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s [[1]] [1] 4 [[2]] [1] 3 3 [[3]] [1] 2 2 2 [[4]] [1] 1 1 1 1 pbpply> pbmapply(rep, times = 1:4, MoreArgs = list(x = 42)) | | 0 % ~calculating |+++++++++++++ | 25% ~00s |+++++++++++++++++++++++++ | 50% ~00s |++++++++++++++++++++++++++++++++++++++ | 75% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s [[1]] [1] 42 [[2]] [1] 42 42 [[3]] [1] 42 42 42 [[4]] [1] 42 42 42 42 pbpply> pbmapply(function(x, y) seq_len(x) + y, pbpply+ c(a = 1, b = 2, c = 3), # names from first pbpply+ c(A = 10, B = 0, C = -10)) | | 0 % ~calculating |+++++++++++++++++ | 33% ~00s |++++++++++++++++++++++++++++++++++ | 67% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s $a [1] 11 $b [1] 1 2 $c [1] -9 -8 -7 pbpply> word <- function(C, k) paste(rep.int(C, k), collapse = "") pbpply> utils::str(pbmapply(word, LETTERS[1:6], 6:1, SIMPLIFY = FALSE)) | | 0 % ~calculating |+++++++++ | 17% ~00s |+++++++++++++++++ | 33% ~00s |+++++++++++++++++++++++++ | 50% ~00s |++++++++++++++++++++++++++++++++++ | 67% ~00s |++++++++++++++++++++++++++++++++++++++++++ | 83% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s List of 6 $ A: chr "AAAAAA" $ B: chr "BBBBB" $ C: chr "CCCC" $ D: chr "DDD" $ E: chr "EE" $ F: chr "F" pbpply> pb.mapply(rep, pbpply+ dots = list(1:4, 4:1), pbpply+ MoreArgs = list()) | | 0 % ~calculating |+++++++++++++ | 25% ~00s |+++++++++++++++++++++++++ | 50% ~00s |++++++++++++++++++++++++++++++++++++++ | 75% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s [[1]] [1] 1 1 1 1 [[2]] [1] 2 2 2 [[3]] [1] 3 3 [[4]] [1] 4 pbpply> pb.mapply(rep, pbpply+ dots = list(times = 1:4, x = 4:1), pbpply+ MoreArgs = list()) | | 0 % ~calculating |+++++++++++++ | 25% ~00s |+++++++++++++++++++++++++ | 50% ~00s |++++++++++++++++++++++++++++++++++++++ | 75% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s [[1]] [1] 4 [[2]] [1] 3 3 [[3]] [1] 2 2 2 [[4]] [1] 1 1 1 1 pbpply> pb.mapply(rep, pbpply+ dots = list(times = 1:4), pbpply+ MoreArgs = list(x = 42)) | | 0 % ~calculating |+++++++++++++ | 25% ~00s |+++++++++++++++++++++++++ | 50% ~00s |++++++++++++++++++++++++++++++++++++++ | 75% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s [[1]] [1] 42 [[2]] [1] 42 42 [[3]] [1] 42 42 42 [[4]] [1] 42 42 42 42 pbpply> pb.mapply(function(x, y) seq_len(x) + y, pbpply+ dots = list(c(a = 1, b = 2, c = 3), # names from first pbpply+ c(A = 10, B = 0, C = -10)), pbpply+ MoreArgs = list()) | | 0 % ~calculating |+++++++++++++++++ | 33% ~00s |++++++++++++++++++++++++++++++++++ | 67% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s [[1]] [1] 11 [[2]] [1] 1 2 [[3]] [1] -9 -8 -7 pbpply> ## --- Map --- pbpply> pbpply> pbMap(`+`, 1, 1 : 3) ; 1 + 1:3 | | 0 % ~calculating |+++++++++++++++++ | 33% ~00s |++++++++++++++++++++++++++++++++++ | 67% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s [[1]] [1] 2 [[2]] [1] 3 [[3]] [1] 4 [1] 2 3 4 pbpply> ## --- eapply --- pbpply> pbpply> env <- new.env(hash = FALSE) pbpply> env$a <- 1:10 pbpply> env$beta <- exp(-3:3) pbpply> env$logic <- c(TRUE, FALSE, FALSE, TRUE) pbpply> pbeapply(env, mean) | | 0 % ~calculating |+++++++++++++++++ | 33% ~00s |++++++++++++++++++++++++++++++++++ | 67% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s $logic [1] 0.5 $beta [1] 4.535125 $a [1] 5.5 pbpply> unlist(pbeapply(env, mean, USE.NAMES = FALSE)) | | 0 % ~calculating |+++++++++++++++++ | 33% ~00s |++++++++++++++++++++++++++++++++++ | 67% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s [1] 0.500000 4.535125 5.500000 pbpply> pbeapply(env, quantile, probs = 1:3/4) | | 0 % ~calculating |+++++++++++++++++ | 33% ~00s |++++++++++++++++++++++++++++++++++ | 67% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s $logic 25% 50% 75% 0.0 0.5 1.0 $beta 25% 50% 75% 0.2516074 1.0000000 5.0536690 $a 25% 50% 75% 3.25 5.50 7.75 pbpply> pbeapply(env, quantile) | | 0 % ~calculating |+++++++++++++++++ | 33% ~00s |++++++++++++++++++++++++++++++++++ | 67% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s $logic 0% 25% 50% 75% 100% 0.0 0.0 0.5 1.0 1.0 $beta 0% 25% 50% 75% 100% 0.04978707 0.25160736 1.00000000 5.05366896 20.08553692 $a 0% 25% 50% 75% 100% 1.00 3.25 5.50 7.75 10.00 pbpply> ## --- tapply --- pbpply> pbpply> require(stats) pbpply> groups <- as.factor(rbinom(32, n = 5, prob = 0.4)) pbpply> pbtapply(groups, groups, length) #- is almost the same as | | 0 % ~calculating |++++++++++ | 20% ~00s |++++++++++++++++++++ | 40% ~00s |++++++++++++++++++++++++++++++ | 60% ~00s |++++++++++++++++++++++++++++++++++++++++ | 80% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s 10 11 13 14 18 1 1 1 1 1 pbpply> table(groups) groups 10 11 13 14 18 1 1 1 1 1 pbpply> ## contingency table from data.frame : array with named dimnames pbpply> pbtapply(warpbreaks$breaks, warpbreaks[,-1], sum) | | 0 % ~calculating |+++++++++ | 17% ~00s |+++++++++++++++++ | 33% ~00s |+++++++++++++++++++++++++ | 50% ~00s |++++++++++++++++++++++++++++++++++ | 67% ~00s |++++++++++++++++++++++++++++++++++++++++++ | 83% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s tension wool L M H A 401 216 221 B 254 259 169 pbpply> pbtapply(warpbreaks$breaks, warpbreaks[, 3, drop = FALSE], sum) | | 0 % ~calculating |+++++++++++++++++ | 33% ~00s |++++++++++++++++++++++++++++++++++ | 67% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s tension L M H 655 475 390 pbpply> n <- 17; fac <- factor(rep_len(1:3, n), levels = 1:5) pbpply> table(fac) fac 1 2 3 4 5 6 6 5 0 0 pbpply> pbtapply(1:n, fac, sum) | | 0 % ~calculating |+++++++++++++++++ | 33% ~00s |++++++++++++++++++++++++++++++++++ | 67% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s 1 2 3 4 5 51 57 45 NA NA pbpply> pbtapply(1:n, fac, sum, default = 0) # maybe more desirable | | 0 % ~calculating |+++++++++++++++++ | 33% ~00s |++++++++++++++++++++++++++++++++++ | 67% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s 1 2 3 4 5 51 57 45 0 0 pbpply> pbtapply(1:n, fac, sum, simplify = FALSE) | | 0 % ~calculating |+++++++++++++++++ | 33% ~00s |++++++++++++++++++++++++++++++++++ | 67% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s $`1` [1] 51 $`2` [1] 57 $`3` [1] 45 $`4` NULL $`5` NULL pbpply> pbtapply(1:n, fac, range) | | 0 % ~calculating |+++++++++++++++++ | 33% ~00s |++++++++++++++++++++++++++++++++++ | 67% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s $`1` [1] 1 16 $`2` [1] 2 17 $`3` [1] 3 15 $`4` NULL $`5` NULL pbpply> pbtapply(1:n, fac, quantile) | | 0 % ~calculating |+++++++++++++++++ | 33% ~00s |++++++++++++++++++++++++++++++++++ | 67% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s $`1` 0% 25% 50% 75% 100% 1.00 4.75 8.50 12.25 16.00 $`2` 0% 25% 50% 75% 100% 2.00 5.75 9.50 13.25 17.00 $`3` 0% 25% 50% 75% 100% 3 6 9 12 15 $`4` NULL $`5` NULL pbpply> pbtapply(1:n, fac, length) ## NA's | | 0 % ~calculating |+++++++++++++++++ | 33% ~00s |++++++++++++++++++++++++++++++++++ | 67% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s 1 2 3 4 5 6 6 5 NA NA pbpply> pbtapply(1:n, fac, length, default = 0) # == table(fac) | | 0 % ~calculating |+++++++++++++++++ | 33% ~00s |++++++++++++++++++++++++++++++++++ | 67% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s 1 2 3 4 5 6 6 5 0 0 pbpply> ## example of ... argument: find quarterly means pbpply> pbtapply(presidents, cycle(presidents), mean, na.rm = TRUE) | | 0 % ~calculating |+++++++++++++ | 25% ~00s |+++++++++++++++++++++++++ | 50% ~00s |++++++++++++++++++++++++++++++++++++++ | 75% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s 1 2 3 4 58.44828 56.43333 57.22222 53.07143 pbpply> ind <- list(c(1, 2, 2), c("A", "A", "B")) pbpply> table(ind) ind.2 ind.1 A B 1 1 0 2 1 1 pbpply> pbtapply(1:3, ind) #-> the split vector [1] 1 2 4 pbpply> pbtapply(1:3, ind, sum) | | 0 % ~calculating |+++++++++++++++++ | 33% ~00s |++++++++++++++++++++++++++++++++++ | 67% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s A B 1 1 NA 2 2 3 pbpply> ## Some assertions (not held by all patch propsals): pbpply> nq <- names(quantile(1:5)) pbpply> stopifnot( pbpply+ identical(pbtapply(1:3, ind), c(1L, 2L, 4L)), pbpply+ identical(pbtapply(1:3, ind, sum), pbpply+ matrix(c(1L, 2L, NA, 3L), 2, dimnames = list(c("1", "2"), c("A", "B")))), pbpply+ identical(pbtapply(1:n, fac, quantile)[-1], pbpply+ array(list(`2` = structure(c(2, 5.75, 9.5, 13.25, 17), .Names = nq), pbpply+ `3` = structure(c(3, 6, 9, 12, 15), .Names = nq), pbpply+ `4` = NULL, `5` = NULL), dim=4, dimnames=list(as.character(2:5))))) | | 0 % ~calculating |+++++++++++++++++ | 33% ~00s |++++++++++++++++++++++++++++++++++ | 67% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s | | 0 % ~calculating |+++++++++++++++++ | 33% ~00s |++++++++++++++++++++++++++++++++++ | 67% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s pbpply> ## --- by --- pbpply> pbpply> pbby(warpbreaks[, 1:2], warpbreaks[,"tension"], summary) | | 0 % ~calculating |+++++++++++++++++ | 33% ~00s |++++++++++++++++++++++++++++++++++ | 67% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s warpbreaks[, "tension"]: L breaks wool Min. :14.00 A:9 1st Qu.:26.00 B:9 Median :29.50 Mean :36.39 3rd Qu.:49.25 Max. :70.00 ------------------------------------------------------------ warpbreaks[, "tension"]: M breaks wool Min. :12.00 A:9 1st Qu.:18.25 B:9 Median :27.00 Mean :26.39 3rd Qu.:33.75 Max. :42.00 ------------------------------------------------------------ warpbreaks[, "tension"]: H breaks wool Min. :10.00 A:9 1st Qu.:15.25 B:9 Median :20.50 Mean :21.67 3rd Qu.:25.50 Max. :43.00 pbpply> pbby(warpbreaks[, 1], warpbreaks[, -1], summary) | | 0 % ~calculating |+++++++++ | 17% ~00s |+++++++++++++++++ | 33% ~00s |+++++++++++++++++++++++++ | 50% ~00s |++++++++++++++++++++++++++++++++++ | 67% ~00s |++++++++++++++++++++++++++++++++++++++++++ | 83% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s wool: A tension: L Min. 1st Qu. Median Mean 3rd Qu. Max. 25.00 26.00 51.00 44.56 54.00 70.00 ------------------------------------------------------------ wool: B tension: L Min. 1st Qu. Median Mean 3rd Qu. Max. 14.00 20.00 29.00 28.22 31.00 44.00 ------------------------------------------------------------ wool: A tension: M Min. 1st Qu. Median Mean 3rd Qu. Max. 12 18 21 24 30 36 ------------------------------------------------------------ wool: B tension: M Min. 1st Qu. Median Mean 3rd Qu. Max. 16.00 21.00 28.00 28.78 39.00 42.00 ------------------------------------------------------------ wool: A tension: H Min. 1st Qu. Median Mean 3rd Qu. Max. 10.00 18.00 24.00 24.56 28.00 43.00 ------------------------------------------------------------ wool: B tension: H Min. 1st Qu. Median Mean 3rd Qu. Max. 13.00 15.00 17.00 18.78 21.00 28.00 pbpply> pbby(warpbreaks, warpbreaks[,"tension"], pbpply+ function(x) lm(breaks ~ wool, data = x)) | | 0 % ~calculating |+++++++++++++++++ | 33% ~00s |++++++++++++++++++++++++++++++++++ | 67% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s warpbreaks[, "tension"]: L Call: lm(formula = breaks ~ wool, data = x) Coefficients: (Intercept) woolB 44.56 -16.33 ------------------------------------------------------------ warpbreaks[, "tension"]: M Call: lm(formula = breaks ~ wool, data = x) Coefficients: (Intercept) woolB 24.000 4.778 ------------------------------------------------------------ warpbreaks[, "tension"]: H Call: lm(formula = breaks ~ wool, data = x) Coefficients: (Intercept) woolB 24.556 -5.778 pbpply> tmp <- with(warpbreaks, pbpply+ pbby(warpbreaks, tension, pbpply+ function(x) lm(breaks ~ wool, data = x))) | | 0 % ~calculating |+++++++++++++++++ | 33% ~00s |++++++++++++++++++++++++++++++++++ | 67% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s pbpply> sapply(tmp, coef) L M H (Intercept) 44.55556 24.000000 24.555556 woolB -16.33333 4.777778 -5.777778 > example(pboptions, run.dontrun = TRUE) pbptns> ## increase sluggishness to admire the progress bar longer pbptns> sluggishness <- 0.01 pbptns> ## for loop pbptns> fun1 <- function() { pbptns+ pb <- startpb(0, 10) pbptns+ on.exit(closepb(pb)) pbptns+ for (i in 1:10) { pbptns+ Sys.sleep(sluggishness) pbptns+ setpb(pb, i) pbptns+ } pbptns+ invisible(NULL) pbptns+ } pbptns> ## while loop pbptns> fun2 <- function() { pbptns+ pb <- startpb(0, 10-1) pbptns+ on.exit(closepb(pb)) pbptns+ i <- 1 pbptns+ while (i < 10) { pbptns+ Sys.sleep(sluggishness) pbptns+ setpb(pb, i) pbptns+ i <- i + 1 pbptns+ } pbptns+ invisible(NULL) pbptns+ } pbptns> ## using original settings pbptns> fun1() | | 0 % ~calculating |+++++ | 10% ~00s |++++++++++ | 20% ~00s |+++++++++++++++ | 30% ~00s |++++++++++++++++++++ | 40% ~00s |+++++++++++++++++++++++++ | 50% ~00s |++++++++++++++++++++++++++++++ | 60% ~00s |+++++++++++++++++++++++++++++++++++ | 70% ~00s |++++++++++++++++++++++++++++++++++++++++ | 80% ~00s |+++++++++++++++++++++++++++++++++++++++++++++ | 90% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s pbptns> ## resetting pboptions pbptns> opb <- pboptions(style = 1, char = ">") pbptns> ## check new settings pbptns> getOption("pboptions") $type [1] "timer" $char [1] ">" $txt.width [1] 50 $gui.width [1] 300 $style [1] 1 $initial [1] 0 $title [1] "R progress bar" $label [1] "" $nout [1] 100 $min_time [1] 0 $use_lb [1] FALSE pbptns> ## running again with new settings pbptns> fun2() | | 0 % elapsed=00s |>>>>>> | 11% elapsed=00s, remaining~00s |>>>>>>>>>>>> | 22% elapsed=00s, remaining~00s |>>>>>>>>>>>>>>>>> | 33% elapsed=00s, remaining~00s |>>>>>>>>>>>>>>>>>>>>>>> | 44% elapsed=00s, remaining~00s |>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 56% elapsed=00s, remaining~00s |>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 67% elapsed=00s, remaining~00s |>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 78% elapsed=00s, remaining~00s |>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 89% elapsed=00s, remaining~00s |>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>| 100% elapsed=00s, remaining~00s pbptns> ## resetting original pbptns> pboptions(opb) pbptns> ## check reset pbptns> getOption("pboptions") $type [1] "timer" $char [1] "+" $txt.width [1] 50 $gui.width [1] 300 $style [1] 3 $initial [1] 0 $title [1] "R progress bar" $label [1] "" $nout [1] 100 $min_time [1] 0 $use_lb [1] FALSE pbptns> fun1() | | 0 % ~calculating |+++++ | 10% ~00s |++++++++++ | 20% ~00s |+++++++++++++++ | 30% ~00s |++++++++++++++++++++ | 40% ~00s |+++++++++++++++++++++++++ | 50% ~00s |++++++++++++++++++++++++++++++ | 60% ~00s |+++++++++++++++++++++++++++++++++++ | 70% ~00s |++++++++++++++++++++++++++++++++++++++++ | 80% ~00s |+++++++++++++++++++++++++++++++++++++++++++++ | 90% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s pbptns> ## dealing with nested progress bars pbptns> ## when only one the 1st one is needed pbptns> f <- function(x) Sys.sleep(sluggishness) pbptns> g <- function(x) pblapply(1:10, f) pbptns> tmp <- lapply(1:10, g) # undesirable | | 0 % ~calculating |+++++ | 10% ~00s |++++++++++ | 20% ~00s |+++++++++++++++ | 30% ~00s |++++++++++++++++++++ | 40% ~00s |+++++++++++++++++++++++++ | 50% ~00s |++++++++++++++++++++++++++++++ | 60% ~00s |+++++++++++++++++++++++++++++++++++ | 70% ~00s |++++++++++++++++++++++++++++++++++++++++ | 80% ~00s |+++++++++++++++++++++++++++++++++++++++++++++ | 90% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s | | 0 % ~calculating |+++++ | 10% ~00s |++++++++++ | 20% ~00s |+++++++++++++++ | 30% ~00s |++++++++++++++++++++ | 40% ~00s |+++++++++++++++++++++++++ | 50% ~00s |++++++++++++++++++++++++++++++ | 60% ~00s |+++++++++++++++++++++++++++++++++++ | 70% ~00s |++++++++++++++++++++++++++++++++++++++++ | 80% ~00s |+++++++++++++++++++++++++++++++++++++++++++++ | 90% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s | | 0 % ~calculating |+++++ | 10% ~00s |++++++++++ | 20% ~00s |+++++++++++++++ | 30% ~00s |++++++++++++++++++++ | 40% ~00s |+++++++++++++++++++++++++ | 50% ~00s |++++++++++++++++++++++++++++++ | 60% ~00s |+++++++++++++++++++++++++++++++++++ | 70% ~00s |++++++++++++++++++++++++++++++++++++++++ | 80% ~00s |+++++++++++++++++++++++++++++++++++++++++++++ | 90% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s | | 0 % ~calculating |+++++ | 10% ~00s |++++++++++ | 20% ~00s |+++++++++++++++ | 30% ~00s |++++++++++++++++++++ | 40% ~00s |+++++++++++++++++++++++++ | 50% ~00s |++++++++++++++++++++++++++++++ | 60% ~00s |+++++++++++++++++++++++++++++++++++ | 70% ~00s |++++++++++++++++++++++++++++++++++++++++ | 80% ~00s |+++++++++++++++++++++++++++++++++++++++++++++ | 90% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s | | 0 % ~calculating |+++++ | 10% ~00s |++++++++++ | 20% ~00s |+++++++++++++++ | 30% ~00s |++++++++++++++++++++ | 40% ~00s |+++++++++++++++++++++++++ | 50% ~00s |++++++++++++++++++++++++++++++ | 60% ~00s |+++++++++++++++++++++++++++++++++++ | 70% ~00s |++++++++++++++++++++++++++++++++++++++++ | 80% ~00s |+++++++++++++++++++++++++++++++++++++++++++++ | 90% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s | | 0 % ~calculating |+++++ | 10% ~00s |++++++++++ | 20% ~00s |+++++++++++++++ | 30% ~00s |++++++++++++++++++++ | 40% ~00s |+++++++++++++++++++++++++ | 50% ~00s |++++++++++++++++++++++++++++++ | 60% ~00s |+++++++++++++++++++++++++++++++++++ | 70% ~00s |++++++++++++++++++++++++++++++++++++++++ | 80% ~00s |+++++++++++++++++++++++++++++++++++++++++++++ | 90% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s | | 0 % ~calculating |+++++ | 10% ~00s |++++++++++ | 20% ~00s |+++++++++++++++ | 30% ~00s |++++++++++++++++++++ | 40% ~00s |+++++++++++++++++++++++++ | 50% ~00s |++++++++++++++++++++++++++++++ | 60% ~00s |+++++++++++++++++++++++++++++++++++ | 70% ~00s |++++++++++++++++++++++++++++++++++++++++ | 80% ~00s |+++++++++++++++++++++++++++++++++++++++++++++ | 90% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s | | 0 % ~calculating |+++++ | 10% ~00s |++++++++++ | 20% ~00s |+++++++++++++++ | 30% ~00s |++++++++++++++++++++ | 40% ~00s |+++++++++++++++++++++++++ | 50% ~00s |++++++++++++++++++++++++++++++ | 60% ~00s |+++++++++++++++++++++++++++++++++++ | 70% ~00s |++++++++++++++++++++++++++++++++++++++++ | 80% ~00s |+++++++++++++++++++++++++++++++++++++++++++++ | 90% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s | | 0 % ~calculating |+++++ | 10% ~00s |++++++++++ | 20% ~00s |+++++++++++++++ | 30% ~00s |++++++++++++++++++++ | 40% ~00s |+++++++++++++++++++++++++ | 50% ~00s |++++++++++++++++++++++++++++++ | 60% ~00s |+++++++++++++++++++++++++++++++++++ | 70% ~00s |++++++++++++++++++++++++++++++++++++++++ | 80% ~00s |+++++++++++++++++++++++++++++++++++++++++++++ | 90% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s | | 0 % ~calculating |+++++ | 10% ~00s |++++++++++ | 20% ~00s |+++++++++++++++ | 30% ~00s |++++++++++++++++++++ | 40% ~00s |+++++++++++++++++++++++++ | 50% ~00s |++++++++++++++++++++++++++++++ | 60% ~00s |+++++++++++++++++++++++++++++++++++ | 70% ~00s |++++++++++++++++++++++++++++++++++++++++ | 80% ~00s |+++++++++++++++++++++++++++++++++++++++++++++ | 90% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s pbptns> ## here is the desirable solution pbptns> h <- function(x) { pbptns+ opb <- pboptions(type="none") pbptns+ on.exit(pboptions(opb)) pbptns+ pblapply(1:10, f) pbptns+ } pbptns> tmp <- pblapply(1:10, h) | | 0 % ~calculating |+++++ | 10% ~01s |++++++++++ | 20% ~01s |+++++++++++++++ | 30% ~01s |++++++++++++++++++++ | 40% ~01s |+++++++++++++++++++++++++ | 50% ~01s |++++++++++++++++++++++++++++++ | 60% ~01s |+++++++++++++++++++++++++++++++++++ | 70% ~00s |++++++++++++++++++++++++++++++++++++++++ | 80% ~00s |+++++++++++++++++++++++++++++++++++++++++++++ | 90% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=02s pbptns> ## list available pb types pbptns> pbtypes() [1] "timer" "txt" "tk" "none" "shiny" "win" > > ## check potential changes in formal arguments > check_args <- function(fun1, fun2, cl=TRUE, dots=TRUE) { + f1 <- formals(fun1) + f2 <- formals(fun2) + if (!dots) { + f1 <- f1[names(f1) != "..."] + f2 <- f2[names(f2) != "..."] + } + args1 <- names(f1) + args2cl <- names(f2) + args2 <- if (cl) + args2cl[seq_len(length(args2cl)-1L)] else args2cl + vals1 <- unname(f1) + vals2cl <- unname(f2) + vals2 <- if (cl) + vals2cl[seq_len(length(vals2cl)-1L)] else vals2cl + if (length(args1) != length(args2)) { + msg <- c("Number of arguments is different:\n - fun1 [", + length(args1), "]: ", paste0(args1, collapse=", "), + "\n - fun2 [", + length(args2), "]: ", paste0(args2, collapse=", ")) + stop(paste0(msg, collapse="")) + } + if (!all(args1 == args2)) { + msg <- c("Argument mismatches:\n - in fun1 but not fun2: ", + paste0(setdiff(args1, args2), collapse=", "), + "\n - in fun2 but not fun1: ", + paste0(setdiff(args2, args1), collapse=", ")) + stop(paste0(msg, collapse="")) + } + if (!all(sapply(1:length(vals1),function(i) identical(vals1[[i]], vals2[[i]])))) { + msg <- c("Number of arguments is different:\n - fun1: ", + paste0(vals1, collapse=", "), + "\n - fun2: ", + paste0(vals2, collapse=", ")) + stop(paste0(msg, collapse="")) + } + invisible(TRUE) + } > > check_args(lapply, pblapply) > check_args(lapply, pbwalk) > check_args(apply, pbapply) > check_args(sapply, pbsapply) > check_args(replicate, pbreplicate, dots=FALSE) # don't check ... > check_args(tapply, pbtapply) > check_args(eapply, pbeapply) > check_args(vapply, pbvapply) > check_args(by, pbby) > > check_args(mapply, pbmapply, cl=FALSE) > check_args(Map, pbMap, cl=FALSE) > check_args(.mapply, pb.mapply, cl=FALSE) > > ## --- 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) | | 0 % ~calculating |+++++++++++++++++ | 33% ~00s |++++++++++++++++++++++++++++++++++ | 67% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s > r1 $a [1] 2 [[2]] [1] 4 $c NULL > r2 $a [1] 2 [[2]] [1] 4 $c NULL > stopifnot(identical(r1, r2)) > > ## --- timings --- > > if (FALSE) { + + #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 <- 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 + } + + i <- seq_len(100) + t1 <- system.time(lapply(i, function(i) Sys.sleep(0.1))) + t2 <- system.time(lapply_pb(i, function(i) Sys.sleep(0.1))) + #t3 <- system.time(l_ply(i, function(i) Sys.sleep(0.1), .progress="text")) + t4 <- system.time(pblapply(i, function(i) Sys.sleep(0.1))) + + } > > ## --- knitr related tests --- > > if (FALSE) { + + sink("~/repos/pbapply/tests/pb.Rmd") + cat("--- + title: \"Test pbapply with knitr\" + date: \"`r format(Sys.time(), '%B %d, %Y')`\" + output: pdf_document + --- + + # Introduction + + Play nice! + + ```{r setup} + library(knitr) + library(pbapply) + interactive() + getOption(\"knitr.in.progress\") + is.null(getOption(\"knitr.in.progress\")) + pboptions()$type + ``` + + ```{r chunk} + pbsapply(1:100, function(z) {Sys.sleep(0.01); sqrt(z)}) + ``` + ") + sink() + #knitr::knit("~/repos/pbapply/tests/pb.Rmd", "~/repos/pbapply/tests/pb.md") + unlink("~/repos/pbapply/tests/pb.Rmd") + unlink("~/repos/pbapply/tests/pb.md") + + } > > ## --- tests for issue #17: single core in cl --- > > f <- function(i) Sys.sleep(0.1) > > library(parallel) > cl <- makeCluster(1L) > > pblapply(1:10, f, cl = cl) | | 0 % ~calculating |+++++ | 10% ~01s |++++++++++ | 20% ~01s |+++++++++++++++ | 30% ~01s |++++++++++++++++++++ | 40% ~01s |+++++++++++++++++++++++++ | 50% ~01s |++++++++++++++++++++++++++++++ | 60% ~00s |+++++++++++++++++++++++++++++++++++ | 70% ~00s |++++++++++++++++++++++++++++++++++++++++ | 80% ~00s |+++++++++++++++++++++++++++++++++++++++++++++ | 90% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=01s [[1]] NULL [[2]] NULL [[3]] NULL [[4]] NULL [[5]] NULL [[6]] NULL [[7]] NULL [[8]] NULL [[9]] NULL [[10]] NULL > > stopCluster(cl) > > ## --- tests for issue #33: return empty list for empty vector --- > > tmp1 <- lapply(character(0), identity) > tmp2 <- pblapply(character(0), identity) > stopifnot(length(tmp1) == length(tmp2)) > stopifnot(identical(tmp1, tmp2)) > > tmp1 <- sapply(character(0), identity) > tmp2 <- pbsapply(character(0), identity) > stopifnot(length(tmp1) == length(tmp2)) > stopifnot(identical(tmp1, tmp2)) > > tmp1 <- apply(matrix(numeric(0), 0, 0), 1, identity) > tmp2 <- pbapply(matrix(numeric(0), 0, 0), 1, identity) > stopifnot(length(tmp1) == length(tmp2)) > stopifnot(identical(tmp1, tmp2)) > > tmp1 <- apply(matrix(numeric(0), 0, 0), 2, identity) > tmp2 <- pbapply(matrix(numeric(0), 0, 0), 2, identity) > stopifnot(length(tmp1) == length(tmp2)) > stopifnot(identical(tmp1, tmp2)) > > ## --- tests for issue #48: pbwalk --- > > tmp <- tempdir() > # f <- function(i, dir) { > # x <- rnorm(100) > # png(file.path(dir, paste0("plot-", i, ".png"))) > # hist(x, col=i) > # dev.off() > # x > # } > f <- function(i, dir) { + x <- data.frame(i=i, j=rnorm(5)) + write.csv(x, row.names=FALSE, file=file.path(dir, paste0("file-", i, ".csv"))) + x + } > # pblapply(1:3, f, dir=tmp) > pbwalk(1:3, f, dir=tmp) | | 0 % ~calculating |+++++++++++++++++ | 33% ~00s |++++++++++++++++++++++++++++++++++ | 67% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s > # unlink(file.path(tmp, paste0("plot-", 1:3, ".png"))) > unlink(file.path(tmp, paste0("file-", 1:3, ".csv"))) > > pbwalk(1:3, f, dir=tmp, cl=2) | | 0 % ~calculating |+++++++++++++++++ | 33% ~00s |++++++++++++++++++++++++++++++++++ | 67% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s > # unlink(file.path(tmp, paste0("plot-", 1:3, ".png"))) > unlink(file.path(tmp, paste0("file-", 1:3, ".csv"))) > > cl <- parallel::makeCluster(2) > pbwalk(1:3, f, dir=tmp, cl=cl) | | 0 % ~calculating |+++++++++++++++++++++++++ | 50% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s > parallel::stopCluster(cl) > # unlink(file.path(tmp, paste0("plot-", 1:3, ".png"))) > unlink(file.path(tmp, paste0("file-", 1:3, ".csv"))) > > ## this could be a quartz issue ... > # f <- function(i, dir) { > # x <- rnorm(100) > # png(file.path(dir, paste0("plot-", i, ".png"))) > # hist(x, col=i) > # dev.off() > # x > # } > ## all this works > # f(1, tmp) > # pbapply::pblapply(1:3, f, dir=tmp) > # pbapply::pbwalk(1:3, f, dir=tmp) > # unlink(file.path(tmp, paste0("plot-", 1:3, ".png"))) > ## all this does not > # pbapply::pbwalk(1:3, f, dir=tmp, cl=2) > # parallel::mclapply(1:3, f, dir=tmp, mc.cores=2) > > > library(future) > > l <- list(a = 1, 2, c = -1) > f <- function(z) { + Sys.sleep(0.1) + if (z < 0) return(NULL) else return(2 * z) + } > > plan(sequential) > r2 <- pblapply(l, f, cl = "future") Loading required namespace: future.apply | | 0 % ~calculating |+++++++++++++++++ | 33% ~00s |++++++++++++++++++++++++++++++++++ | 67% ~00s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=00s > > plan(multisession, workers = 2) > r2 <- pblapply(l, f, cl = "future") | | 0 % ~calculating |+++++++++++++++++++++++++ | 50% ~01s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=01s > > cl <- parallel::makeCluster(2) > plan(cluster, workers = cl) > r2 <- pblapply(l, f, cl = "future") | | 0 % ~calculating |+++++++++++++++++++++++++ | 50% ~01s |++++++++++++++++++++++++++++++++++++++++++++++++++| 100% elapsed=01s > parallel::stopCluster(cl) > plan(sequential) > > proc.time() user system elapsed 5.65 0.35 31.70