## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)
library(functionals)
set.seed(1)

## -----------------------------------------------------------------------------
fmap(1:4, function(x) x^2)

## -----------------------------------------------------------------------------
# one call per data-frame row, row supplied as a named list
fmapr(head(mtcars, 3), function(row) row$mpg / row$cyl)

# one call per column, with the column name available
fmapc(data.frame(a = 1:3, b = 4:6), function(x, nm) sprintf("%s: %.1f", nm, mean(x)))

# one call per group
fmapg(iris, function(d) mean(d$Sepal.Length), by = "Species")

# one call per aligned tuple (list names are matched to .f's arguments)
fmapn(list(x = 1:3, y = 4:6), function(x, y) x + y)

## -----------------------------------------------------------------------------
invisible(fwalk(1:3, function(i) cat("row", i, "\n")))

## -----------------------------------------------------------------------------
power_of <- function(k) function(x) x^k
powers   <- fmap(1:4, power_of)          # a list of functions
powers[[3]](2)                            # 2^3

## -----------------------------------------------------------------------------
standardise <- fcompose(function(x) round(x, 2), scale, as.numeric)
standardise(c(1, 2, 3, 4))

freduce(1:5, `+`)
freduce(1:5, `+`, .accumulate = TRUE)

## -----------------------------------------------------------------------------
pipeline <- fcompose(
  function(x) Filter(function(v) v > 0, x),
  function(x) fmap(x, function(v) v - mean(unlist(x)))
)
str(pipeline(list(-2, 1, 4, 9)))

## -----------------------------------------------------------------------------
grid <- expand.grid(n = c(10, 50), sd = c(1, 2))
res  <- fmapn(
  list(n = grid$n, sd = grid$sd),
  function(n, sd) c(n = n, sd = sd, se = sd / sqrt(n))
)
do.call(rbind, res)

## -----------------------------------------------------------------------------
out <- fmap(list(1, "oops", 3), function(x) x * 10, .on_error = "pass")
vapply(out, function(e) if (inherits(e, "functionals_error")) NA_real_ else e, numeric(1))

## -----------------------------------------------------------------------------
a <- fmap(1:5, function(i) round(rnorm(1), 3), .seed = 42)
b <- fmap(1:5, function(i) round(rnorm(1), 3), .seed = 42, ncores = 1)
identical(a, b)

## ----eval = FALSE-------------------------------------------------------------
# slow <- function(x) { Sys.sleep(0.2); x^2 }
# fmap(1:20, slow, ncores = 4, pb = TRUE)

## ----bench-table, echo = FALSE------------------------------------------------
rds <- system.file("benchmarks/bench-purrr-results.rds", package = "functionals")
if (nzchar(rds)) {
  b <- readRDS(rds)
  r <- b$results
  keep <- r$expression %in% c("functionals::fmap", "purrr::map", "base::lapply")
  wide <- reshape(
    r[keep, c("expression", "n", "payload", "median_ms")],
    idvar = c("n", "payload"), timevar = "expression", direction = "wide"
  )
  names(wide) <- sub("median_ms\\.", "", names(wide))
  wide[order(wide$payload, wide$n), ]
} else {
  message("benchmark rds not installed; run inst/benchmarks/bench-purrr.R")
}

## ----bench-note, echo = FALSE, results = "asis"-------------------------------
if (nzchar(rds)) {
  cat(sprintf(
    "\n_Timings in milliseconds (median). %s, %s; functionals %s, purrr %s._\n",
    b$sysname, b$r_version, b$versions[["functionals"]], b$versions[["purrr"]]
  ))
}