class: center, middle, inverse, title-slide # Chapter 11: Function Operators ## Tony ElHabr ### R4DS Reading Group --- <style> hide { display: none; } .remark-slide-content h1 { font-size: 45px; } h1 { font-size: 2em; margin-block-start: 0.67em; margin-block-end: 0.67em; } .remark-slide-content { font-size: 16px } .remark-code { font-size: 14px; } code.r { font-size: 14px; } pre { margin-top: 0px; margin-bottom: 0px; } .red { color: #FF0000; } .footnote { color: #800020; font-size: 9px; } </style> # What are function operators (FO)? Chapter 9 is about functionals. Chapter 10 is about function factories. What makes function operators different? --
Term
Required Input
Optional Input
Output
Functionals
Function
Vector
Vector
Function Factory
Vector, Function
Function
Function Operator
Function
Vector
Function
-- FOs are probably best studied by thinking about how they operate on functions. + __Behavioral FO__: Changes the behavior of a function, e.g. logging, running a function only when necessary + `memoise::memoise()` + __Output FO__: Manipulates the output of a function + `purrr::possibly()`, `purrr::safely()`, `purrr::quietly()` + __Input FO__: Maniuplates the input of a function + `purrr::partial()` -- `purrr::safely()` docs: ... "They are all adverbs because they modify the action of a verb (a function)." --- # Behavior FO Example #1 Now with an additional input, vector `n` ```r slowly <- function(f, n){ force(f) force(n) function(...){ stopifnot(is.numeric(n)) cat( glue::glue('Sleeping for {n} seconds.'), sep = '\n' ) Sys.sleep(n) f(...) } } purrr::walk( c('hello', 'world'), * slowly(cat, 0.1), sep = '\n' # Passed to `f()` via `...` ) ``` ``` ## Sleeping for 0.1 seconds. ## hello ## Sleeping for 0.1 seconds. ## world ``` .footnote[ https://gist.github.com/ColinFay/d32cf4c9c5fb8d849f12a4e98d6c0549 ] --- # Behavioral FO Example #2 ```r twice <- function(f){ force(f) function(...){ f(...) f(...) } } purrr::walk( c('hello', 'world'), * twice(cat), sep = '\n' # Passed to `f()` via `...` ) ``` ``` ## hello ## hello ## world ## world ``` .footnote[ Inspiration: https://realpython.com/primer-on-python-decorators/ ] --- # Behavioral FO Example #2 With `python` <svg style="height:0.8em;top:.04em;position:relative;" viewBox="0 0 448 512"><path d="M439.8 200.5c-7.7-30.9-22.3-54.2-53.4-54.2h-40.1v47.4c0 36.8-31.2 67.8-66.8 67.8H172.7c-29.2 0-53.4 25-53.4 54.3v101.8c0 29 25.2 46 53.4 54.3 33.8 9.9 66.3 11.7 106.8 0 26.9-7.8 53.4-23.5 53.4-54.3v-40.7H226.2v-13.6h160.2c31.1 0 42.6-21.7 53.4-54.2 11.2-33.5 10.7-65.7 0-108.6zM286.2 404c11.1 0 20.1 9.1 20.1 20.3 0 11.3-9 20.4-20.1 20.4-11 0-20.1-9.2-20.1-20.4.1-11.3 9.1-20.3 20.1-20.3zM167.8 248.1h106.8c29.7 0 53.4-24.5 53.4-54.3V91.9c0-29-24.4-50.7-53.4-55.6-35.8-5.9-74.7-5.6-106.8.1-45.2 8-53.4 24.7-53.4 55.6v40.7h106.9v13.6h-147c-31.1 0-58.3 18.7-66.8 54.2-9.8 40.7-10.2 66.1 0 108.6 7.6 31.6 25.7 54.2 56.8 54.2H101v-48.8c0-35.3 30.5-66.4 66.8-66.4zm-6.7-142.6c-11.1 0-20.1-9.1-20.1-20.3.1-11.3 9-20.4 20.1-20.4 11 0 20.1 9.2 20.1 20.4s-9 20.3-20.1 20.3z"/></svg> ```python def do_twice(f): def wrapper(*args, **kwargs): f(*args, **kwargs) f(*args, **kwargs) return wrapper @do_twice def say(x): print(x) ``` ```python list(map(say, ['hello', 'world'])) ``` ``` ## hello ## hello ## world ## world ## [None, None] ``` --- # Behavioral FO Example #3 ```r download_beers <- function(name, verbose = TRUE) { base_url <- 'https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-03-31/' url <- glue::glue('{base_url}{name}.csv') if(verbose) { cat(glue::glue('Downloading {name}.csv'), sep = '\n') } readr::read_csv(url) } ``` Using `memoise::memoise()` for caching ```r download_beers_quickly <- memoise::memoise(download_beers) bench::mark( download_beers('brewer_size', verbose = FALSE), download_beers_quickly('brewer_size', verbose = FALSE) ) %>% dplyr::select(expression, min, median) ``` ``` ## # A tibble: 2 x 3 ## expression min median ## <bch:expr> <bch:tm> <bch:tm> ## 1 download_beers("brewer_size", verbose = FALSE) 161ms 167ms ## 2 download_beers_quickly("brewer_size", verbose = FALSE) 142us 148us ``` <hide> This is useful for scraping... and also a tutorial, where there are repeated actions across code chunks :P. Should memoisization be used when scraping? It depends. If the data really won't ever change, then it should be fine. </hide> --- # Behavioral FO Example #4 Testing the speed of `memoise::memoise()` ```r # Forgive the contrived function. slow_function <- function(x) { Sys.sleep(0.2) x * runif(1) } fast_function <- memoise::memoise(slow_function) ``` <br /> ```r system.time(slow_function(1)) ``` ``` ## user system elapsed ## 0.00 0.00 0.21 ``` ```r *system.time(slow_function(1)) ``` ``` ## user system elapsed ## 0.0 0.0 0.2 ``` ```r system.time(fast_function(11)) ``` ``` ## user system elapsed ## 0.0 0.0 0.2 ``` ```r *system.time(fast_function(11)) ``` ``` ## user system elapsed ## 0.01 0.00 0.02 ``` --- # Behavioral FO Example #4 Even if you've changed the inputs since the most recent call, it will still be fast. ```r system.time(fast_function(22)) ``` ``` ## user system elapsed ## 0.00 0.00 0.21 ``` ```r system.time(fast_function(33)) ``` ``` ## user system elapsed ## 0.0 0.0 0.2 ``` ```r *system.time(fast_function(22)) ``` ``` ## user system elapsed ## 0 0 0 ``` -- In fact, it remembers everything from the same session (assuming you haven't used `memoise::forget()`). ```r system.time(fast_function(11)) ``` ``` ## user system elapsed ## 0 0 0 ``` ```r system.time(fast_function(22)) ``` ``` ## user system elapsed ## 0 0 0 ``` ```r system.time(fast_function(33)) ``` ``` ## user system elapsed ## 0 0 0 ``` --- # Input FO Example #1 Setting `na.rm = TRUE` ```r stat_robust <- function(f, ...) { function(...) { f(..., na.rm = TRUE) } } mean_robust <- stat_robust(mean) min_robust <- stat_robust(min) quantile_robust <- stat_robust(quantile) ``` <br /> -- .pull-left[ ```r x1 <- 1L:10L mean_robust(x1) ``` ``` ## [1] 5.5 ``` ```r min_robust(x1) ``` ``` ## [1] 1 ``` ```r quantile_robust(x1, 0.25) ``` ``` ## 25% ## 3.25 ``` ] .pull-right[ ```r x2 <- x1; x2[1] <- NA mean_robust(x2) ``` ``` ## [1] 6 ``` ```r min_robust(x2) ``` ``` ## [1] 2 ``` ```r quantile_robust(x2, 0.25) ``` ``` ## 25% ## 4 ``` ] --- # Input FO Example #1 Using `purrr::partial()` to set `na.rm = TRUE` ```r mean_partial <- partial(mean, na.rm = TRUE) min_partial <- partial(min, na.rm = TRUE) quantile_partial <- partial(quantile, na.rm = TRUE, ... = ) ``` -- Without `purrr::partial()` ```r mean_wrapper <- function(...) { mean(..., na.rm = TRUE) } ``` --- # Input FO Example #2 Using the `brewer_size` data set ```r brewer_size %>% summarize_at( vars(total_barrels, total_shipped), * list(mean = mean, mean_robust = mean_robust) ) %>% mutate_all( ~scales::number(., scale = 1e-3, big.mark = ',', suffix = ' k') ) %>% glimpse() ``` ``` ## Rows: 1 ## Columns: 4 ## $ total_barrels_mean <chr> NA ## $ total_shipped_mean <chr> NA ## $ total_barrels_mean_robust <chr> "30,796 k" ## $ total_shipped_mean_robust <chr> "885 k" ``` --- # Output FO Example #1 Using `purrr::safely()` ```r download_beers_safely <- purrr::safely(download_beers) ``` ```r brewing_material <- download_beers_safely('brewing_material') # Oops! ``` ``` ## Downloading brewing_material.csv ``` ```r brewing_material ``` ``` ## $result ## NULL ## ## $error ## <simpleError in open.connection(con, "rb"): HTTP error 404.> ``` <br /> ```r brewing_materials <- download_beers_safely('brewing_materials') # Good ``` ``` ## Downloading brewing_materials.csv ``` ```r brewing_materials$result %>% head(5) ``` ``` ## # A tibble: 5 x 9 ## data_type material_type year month type month_current month_prior_year ## <chr> <chr> <dbl> <dbl> <chr> <dbl> <dbl> ## 1 Pounds o~ Grain Produc~ 2008 1 Malt~ 374165152 365300134 ## 2 Pounds o~ Grain Produc~ 2008 1 Corn~ 57563519 41647092 ## 3 Pounds o~ Grain Produc~ 2008 1 Rice~ 72402143 81050102 ## 4 Pounds o~ Grain Produc~ 2008 1 Barl~ 3800844 2362162 ## 5 Pounds o~ Grain Produc~ 2008 1 Whea~ 1177186 1195381 ## # ... with 2 more variables: ytd_current <dbl>, ytd_prior_year <dbl> ``` <hide> In a real-world example, it is more likely that the error is with something unexpected on the web-page, not in the user's code. </hide> --- # Output FO Example #2 Using `purrr::possibly()` ```r download_beers_possibly <- purrr::possibly(download_beers, otherwise = tibble()) ``` ```r brewing_material <- download_beers_possibly('brewing_material') # Oops! ``` ``` ## Downloading brewing_material.csv ``` ```r brewing_material ``` ``` ## # A tibble: 0 x 0 ``` <hide> `purrr::safely()` also has an `otherwise` argument, but I think it makes more sense to use in conjuction with `possibly()`. </hide> --- # Output FO Example #3 Using `purrr::quietly()` ```r download_beers_quietly <- purrr::quietly(download_beers) ``` ```r brewing_materials <- download_beers_quietly('brewing_materials') names(brewing_materials) ``` ``` ## [1] "result" "output" "warnings" "messages" ``` ```r brewing_materials$result %>% head(5) ``` ``` ## # A tibble: 5 x 9 ## data_type material_type year month type month_current month_prior_year ## <chr> <chr> <dbl> <dbl> <chr> <dbl> <dbl> ## 1 Pounds o~ Grain Produc~ 2008 1 Malt~ 374165152 365300134 ## 2 Pounds o~ Grain Produc~ 2008 1 Corn~ 57563519 41647092 ## 3 Pounds o~ Grain Produc~ 2008 1 Rice~ 72402143 81050102 ## 4 Pounds o~ Grain Produc~ 2008 1 Barl~ 3800844 2362162 ## 5 Pounds o~ Grain Produc~ 2008 1 Whea~ 1177186 1195381 ## # ... with 2 more variables: ytd_current <dbl>, ytd_prior_year <dbl> ``` --- # Combining FOs Example ```r nms <- c('woops', 'brewing_materials', 'beer_taxed', 'brewer_size', 'beer_states') %>% setNames(., .) ``` ```r download_beers_nicely <- slowly(download_beers_safely, 0.1) beers <- nms %>% map(., * ~download_beers_nicely(..1) %>% purrr::pluck('result') ) ``` ``` ## Sleeping for 0.1 seconds. ## Downloading woops.csv ## Sleeping for 0.1 seconds. ## Downloading brewing_materials.csv ## Sleeping for 0.1 seconds. ## Downloading beer_taxed.csv ## Sleeping for 0.1 seconds. ## Downloading brewer_size.csv ## Sleeping for 0.1 seconds. ## Downloading beer_states.csv ``` ```r beers %>% map(dim) %>% str() ``` ``` ## List of 5 ## $ woops : NULL ## $ brewing_materials: int [1:2] 1440 9 ## $ beer_taxed : int [1:2] 1580 10 ## $ brewer_size : int [1:2] 137 6 ## $ beer_states : int [1:2] 1872 4 ``` --- # Combining FOs Example And a real-world use-case for `purrr::reduce()`! ```r beers %>% purrr::discard(is.null) %>% purrr::reduce(dplyr::left_join) %>% dim() ``` ``` ## [1] 15984 18 ``` --- # FOs in the Wild + `{scales}` and `{ggplot2}`'s `scale_(color|fill)_*()` + `{glue}` with it's transformers + Sparingly in `{styler}` and `{lintr}` -- + `{plumber}` uses R6 😯 --- # FIN