Timing functions

library(microbenchmark)
tm <- microbenchmark(
  rchisq(100, 0),
  rchisq(100, 1),
  rchisq(100, 2),
  rchisq(100, 3),
  rchisq(100, 5), times = 1000L)
print(tm)
## Unit: microseconds
##            expr    min      lq      mean  median      uq      max neval
##  rchisq(100, 0)  2.760  4.7865  7.595027  5.2305  7.0640  464.713  1000
##  rchisq(100, 1) 12.090 17.1445 43.352769 18.6020 20.6010 8709.076  1000
##  rchisq(100, 2) 11.057 16.6490 25.911390 18.5040 20.7090  881.254  1000
##  rchisq(100, 3)  9.556 16.0940 28.057496 18.0895 20.3285 4326.028  1000
##  rchisq(100, 5)  9.989 15.8530 33.119251 18.2750 20.7675 6180.271  1000
autoplot(tm)
## Coordinate system already present. Adding new coordinate system, which will replace the existing one.

library(tictoc)
tic()
x <- runif(1e7)
toc()
## 1.574 sec elapsed
tic("outer")
x1 <- runif(1e7)
tic("middle")
x2 <- runif(1e7)
tic("inner")
x3 <- runif(1e7)
toc()
## inner: 0.728 sec elapsed
toc()
## middle: 2.306 sec elapsed
toc()
## outer: 3.964 sec elapsed

Setting up multiprocess

# general purpose parallelization package
library(future)
availableCores()
## system 
##      4
plan(multiprocess)

Running map functions in parallel

Note: purrr is planning built-in parallelization support in the near future but in the mean time furrr provides future versions of the most common functions.

library(furrr)
df <- 
  data_frame(
    mean = 1:4
  )

# sequential
tic()
df2 <- df %>% 
  mutate(
    norm_sd = map_dbl(mean, ~rnorm(1e7, mean = .x) %>% sd())
  )
toc()
## 6.065 sec elapsed
# parallel
tic()
df2 <- df %>% 
  mutate(
    norm_sd = future_map_dbl(mean, ~rnorm(1e7, mean = .x) %>% sd())
  )
toc()
## 3.97 sec elapsed

Caveat

Sending large data sets between cores makes even parallel things slower!

# sequential
tic()
df2 <- df %>% 
  mutate(
    data = map(mean, ~rnorm(1e7, mean = .x)),
    norm_sd = map_dbl(data, ~sd(.x))
  )
toc()
## 4.617 sec elapsed
# parallel
tic()
df2 <- df %>% 
  mutate(
    data = future_map(mean, ~rnorm(1e7, mean = .x)),
    norm_sd = future_map_dbl(data, ~sd(.x))
  )
toc()
## 5.021 sec elapsed

Progress Bar

# not built into purrr yet but will come
# this type of progress bar is only visible in interactive use (not knitted)
library(progress)
df <- data_frame(mean = 1:100)
pb <- progress_bar$new(
  total = nrow(df), 
  format = "(:spin) [:bar] :percent :elapsed")

tic()
df <- df %>% 
  mutate(
    data = map(mean, ~{
      pb$tick(); rnorm(1e6, mean = .x); .x
    })
  )
toc()
## 11.917 sec elapsed
# parallel processing with furrr (build-in progress bar)
tic()
df %>% 
  mutate(
    data = future_map(mean, ~rnorm(1e6, mean = .x), .progress = TRUE)
  )
## 
 Progress: ───────────────                                                  100%
 Progress: ────────────────────                                             100%
 Progress: ────────────────────────                                         100%
 Progress: ───────────────────────────────                                  100%
 Progress: ──────────────────────────────────────────                       100%
 Progress: ───────────────────────────────────────────────────────          100%
 Progress: ──────────────────────────────────────────────────────────────── 100%
 Progress: ──────────────────────────────────────────────────────────────── 100%
 Progress: ──────────────────────────────────────────────────────────────── 100%
 Progress: ──────────────────────────────────────────────────────────────── 100%
toc()
## 11.76 sec elapsed

Parallel Fun with Fractals

library("Julia")
#' convert julia set output to a tidy data frame
convert_julia_to_data_frame <- function(set) {
  # convert to dplyr data frame
  set %>% as.data.frame.table() %>% tbl_df() %>%
    # rename dimensions and value
    rename(x = Var1, y = Var2, value = Freq) %>%
    # convert dimensions to numbers
    mutate_if(is.factor, as.integer)
}
#' plot julia set
plot_julia_data_frame <-
  function(julia_df, colors = topo.colors(16)) {
    julia_df %>%
      ggplot() +
      aes(x, y, fill = value) +
      geom_raster() +
      scale_fill_gradientn(colors = colors) +
      coord_equal() +
      scale_x_continuous(expand = c(0, 0)) +
      scale_y_continuous(expand = c(0, 0))
  }

Example

library(tictoc)
tic()
set <- JuliaImage(500, centre = 0 + 0i, L = 3.5, C = -0.4 + 0.6i)
set %>% convert_julia_to_data_frame() %>% plot_julia_data_frame()

toc()
## 6.03 sec elapsed

Different Fractals

Cs <- c(
  a = -0.618,
  b = -0.4     + 0.6i,
  c =  0.285   + 0i,
  d =  0.285   + 0.01i,
  e = -0.70176 - 0.3842i,
  f =  0.835   - 0.2321i,
  g = -0.8     + 0.156i,
  h = -0.7269  + 0.1889i,
  i =          - 0.8i
)
Cs
##                a                b                c                d 
## -0.61800+0.0000i -0.40000+0.6000i  0.28500+0.0000i  0.28500+0.0100i
##                e                f                g                h 
## -0.70176-0.3842i  0.83500-0.2321i -0.80000+0.1560i -0.72690+0.1889i
##                i 
##  0.00000-0.8000i
# sequential
tic()
pset <- 
  Cs %>%
  map(~JuliaImage(500, centre = 0 + 0i, L = 3.5, C = .x))
toc()
## 20.363 sec elapsed
library(future)
library(furrr)
# parallel
tic()
pset <- 
  Cs %>%
  future_map(~JuliaImage(500, centre = 0 + 0i, L = 3.5, C = .x), .progress = TRUE)
## 
 Progress:                                                                  100%
 Progress:                                                                  100%
 Progress: ──────────────                                                   100%
 Progress: ──────────────                                                   100%
 Progress: ────────────────────────────                                     100%
 Progress: ───────────────────────────────────                              100%
 Progress: ───────────────────────────────────                              100%
 Progress: ─────────────────────────────────────────────────                100%
 Progress: ─────────────────────────────────────────────────                100%
 Progress: ────────────────────────────────────────────────────────         100%
 Progress: ──────────────────────────────────────────────────────────────── 100%
toc()
## 8.133 sec elapsed

Visualize

plot_df <-
  data_frame(
    set = names(pset),
    data = map(pset, convert_julia_to_data_frame)
  ) 
plot_df
plot_df %>% unnest(data) %>% plot_julia_data_frame() + facet_wrap(~set)