Functional programming

2019-12-13

github.com/k-hench

Motivation

Writing your own functions in R can help you to write better R code.

By better I mean:

clearer scripts that are easier to understand
shorter scripts
less chances of (copy & paste) errors
scripts that are easier to debug

To follow this tutorial you’ll
need to install a few packages:

install.packages("devtools")
devtools::install_github("hadley/tidyverse")
devtools::install_github("r-lib/rlang")
devtools::install_github("k-hench/hypoimg")
devtools::install_github('k-hench/stupid1')
devtools::install_github('k-hench/stupid2')

Creating a function

To create a new function, use function():

Our new function is going to be called add_1(), it is going to have a single parameter x and return the sum of x + 1:

function( x ) { x + 1 }

add_1 <- function(x){x + 1}

After assigning the function, we can call it like any other R function:

add_1
#> function(x){x + 1}

add_1( x = 3 )
#> [1] 4

Defaults

We can also define default values for parameters.

sum_of_two <- function(x, y = 4){ x + y }
sum_of_two(x = 1)
#> [1] 5

sum_of_two(x = 1, y = 1)
#> [1] 2

add_1(y = 1)
#> Error in add_1(y = 1): unused argument (y = 1)

Environments

add_2a <- function(){x + 2}
add_2b <- function(){ x <- 4; x + 2 }
add_2c <- function(x = 4){ x + 2 }

add_2a()
#> Error in add_2a(): object 'x' not found

add_2b()
#> [1] 6
add_2c()
#> [1] 6

x <- 6
add_2a()
#> [1] 8
add_2b()
#> [1] 6
add_2c()
#> [1] 6

Search path

library(rlang)
paster_0 <- function(){paste0(c('X: ','Y: '), c(stupid_x, stupid_y))}
paster_1 <- function(){stupid_y <- "Z";  paste0(c('X: ','Y: '), c(stupid_x, stupid_y))}

library(stupid1)
paster_0()
#> [1] "X: A" "Y: B"

stupid_x
#> [1] "A"
stupid_y
#> [1] "B"

library(stupid2)
paster_0()
#> [1] "X: C" "Y: B"

env_names(search_envs()[['package:stupid1']])
#> [1] "stupid_x"   "stupid_y"   "stupid_fun"
env_names(search_envs()[['package:stupid2']])
#> [1] "stupid_x"

stupid1::stupid_x
#> [1] "A"
stupid2::stupid_x
#> [1] "C"

stupid_x <- 'D'
stupid_y <- '!'
paster_0()
#> [1] "X: D" "Y: !"
paster_1()
#> [1] "X: D" "Y: Z"

The … argument

function( x, … ) { message(x) }

paster_2 <- function(x, ...){ message(x) }
paster_2(x = 'test')
#> test
paster_2(x = 'test', y = 'something', z = 'else')
#> test

paster_3 <- function(x, ...){ 
  message(paste('x: ', x))
  message(paste('other parameters:', ...))
}
paster_3(x = 'test')
#> x:  test
#> other parameters:
paster_3(x = 'test', y = 'something', z = 'else')
#> x:  test
#> other parameters: something else

The %>% operator

One of the core fuctionalities of the tidyverse is the implementation of the pipe (%>%) into the data wrangling process:

data %>% do_something( x, other, paramerters )

All that it does is to pass the object on its left as the first argument into the function on its right.

This operator was introduced by the magrittr package:

Pipelines

function( x ) { x + 1 }

library(magrittr)

The pipe is an elegant way of connecting severeal functions that are executed one after the other.

Using our silly function that simply addes 1 to an input value, there are several ways to get from 1 to 4:

sequential

a <- 1
b <- add_1(a)
c <- add_1(b)
d <- add_1(c)
d
#> [1] 4

nested

add_1(add_1(add_1(1)))
#> [1] 4

pipeline

1 %>%
  add_1() %>%
  add_1() %>%
  add_1()
#> [1] 4

Fishes

library(tidyverse)
library(hypoimg)
#> --- Welcome to hypoimg ---

svg_file <- system.file("extdata",
                        "logo2.c.svg", 
                        package = "hypoimg")

svg <- hypo_read_svg(svg_file)

library(cowplot)
ggdraw(svg)

Recolor

hypo_recolor_svg
#> function (svg, layer = 1, color = "darkgray") 
#> {
#>     svg[[4]][[1]][[4]][[1]][[4]][[layer]]$gp$fill <- color
#>     svg
#> }
#> <bytecode: 0x9729920>
#> <environment: namespace:hypoimg>

svg %>% hypo_recolor_svg(layer = 1, color = 'red') %>% ggdraw()

Map

1:4 %>% 
  purrr::map(add_1)
#> [[1]]
#> [1] 2
#> 
#> [[2]]
#> [1] 3
#> 
#> [[3]]
#> [1] 4
#> 
#> [[4]]
#> [1] 5

1:4 %>% 
  purrr::map(add_1) %>% 
  unlist()
#> [1] 2 3 4 5

add_1 <- function( x ) { x + 1 }

Two parameters

map(.x = 1:3, .f = sum_of_two, 
    y = (1:3)*10)
#> [[1]]
#> [1] 11 21 31
#> 
#> [[2]]
#> [1] 12 22 32
#> 
#> [[3]]
#> [1] 13 23 33

map2(.x = 1:3, .y = (1:3)*10,
     .f = sum_of_two)
#> [[1]]
#> [1] 11
#> 
#> [[2]]
#> [1] 22
#> 
#> [[3]]
#> [1] 33

sum_of_two <- function( x, y ) { x + y }

Painting fish

clr <- c( "#FFFFFF", "#BDB596", "#A16D5A", "#590D0E")

map2(.x = 1:4, .y = clr, .f = hypo_recolor_svg, svg = svg) %>%  plot_grid(plotlist = .)

Variants

Alternative output format

mix_of_two <- function(x, y = 4){ 
  tibble( x = x, y = y,
          s = x + y, 
          p = x * y)
}
mix_of_two(1,2)
#> # A tibble: 1 x 4
#>       x     y     s     p
#>   <dbl> <dbl> <dbl> <dbl>
#> 1     1     2     3     2

map2_dfr(.x = 1:3, .y = (1:3)*10,
         .f =  mix_of_two)
#> # A tibble: 3 x 4
#>       x     y     s     p
#>   <int> <dbl> <dbl> <dbl>
#> 1     1    10    11    10
#> 2     2    20    22    40
#> 3     3    30    33    90

Silent function call:

create_file <- function(input){ 
  name <- str_c("tmp/", input, ".txt")
  write_lines(x = input,
              path = name)
}

dir.create('tmp')
#> Warning in dir.create("tmp"): 'tmp' already exists
letters[1:2] %>%
  map(create_file)
#> [[1]]
#> [1] "a"
#> 
#> [[2]]
#> [1] "b"

letters[3:4] %>%
  walk(create_file)

dir(path = "tmp",pattern = "txt")
#> [1] "a.txt" "b.txt" "c.txt" "d.txt"

Reduce

reduce(1:3,sum_of_two,.init = 6) 
#> [1] 12
# 6 + 1 + 2 + 3

reduce2(.x = 1:4,
        .y = clr,
        .f = hypo_recolor_svg,
        .init = svg) %>% 
  ggdraw()