[How to] Write a purrr-like adverb

April 17, 2018
By

(This article was first published on Colin Fay, and kindly contributed to R-bloggers)

Create your own safely, compose and friends!

What is an adverb

If you read carefully the purrr documentation, you’ll find this simple explanation :

Adverbs modify the action of a function; taking a function as input and returning a function with modified action as output.

In other words, adverbs take a function, and return this function modified. Yes, just as an adverb modifies a verb. So if you do :

library(purrr)
safe_log <- safely(log)

The returned object is another function that you can use just as a regular one.

class(safe_log)
## [1] "function"
safe_log("a")
## $result
## NULL
## 
## $error
## 

In computer science, these adverbs are what is called “high-order functions”.

How to write your own?

I’ve been playing with adverbs in {attempt}, notably through these adverbs :

library(attempt)

# Silently only return the errors, and nothing if the function succeeds
silent_log <- silently(log)
silent_log(1)
# Surely make a function always work, without stopping the process
sure_log <- surely(log)
sure_log(1)
## [1] 0
sure_log("a")
# with_message and with_warning
as_num_msg <- with_message(as.numeric, msg = "We're performing a numeric conversion")
as_num_warn <- with_warning(as.numeric, msg = "We're performing a numeric conversion")
as_num_msg("1")
## We're performing a numeric conversion

## [1] 1
as_num_warn("1")
## Warning in as_num_warn("1"): We're performing a numeric conversion

## [1] 1

So, how to implement this kind of behavior? Let’s take a simple example with sleepy, also shared on Twitter.

sleepy <- function(fun, sleep){
  function(...){
    Sys.sleep(sleep)
    fun(...)
  }
}

sleep_print <- sleepy(Sys.time, 5)
class(sleep_print)
## [1] "function"
# Let's try
Sys.time()
## [1] "2018-04-19 10:20:58 CEST"
sleep_print()
## [1] "2018-04-19 10:21:03 CEST"

Let’s decompose what we’ve got here.

First of all, the function should return another function, so we need to start with :

talky <- function(){
  function(){
    
  }
}

What this function will take as a first argument is another function, that will be executed when our future new function is called.

So let’s do this:

talky <- function(fun){
  function(){
    fun()
  }
}

Because you know, with R referential transparency, you can create a variable that is a function:

plop <- mean
plop(1:10)
## [1] 5.5

This simple skeleton will work if we take a function without any args:

sys_time <- talky(Sys.time)
sys_time()
## [1] "2018-04-19 10:21:03 CEST"

But hey, this is not what we want: we need this new function to be able to take arguments. So let’s use our friend ....

talky <- function(fun){
  function(...){
    fun(...)
  }
}

Now, our new adverb creates a function that can take arguments. But as you’ve notice, this is still not really an adverb: we need to modify something. Now you’re only limited by your imagination 😉

# Print the time
talky <- function(fun){
  function(...){
    print(Sys.time())
    fun(...)
  }
}
talky_sqrt <- talky(sqrt)
talky_sqrt(10)
## [1] "2018-04-19 10:21:03 CEST"

## [1] 3.162278
# Or with a kind message ? 
talky <- function(fun, mess){
  function(...){
    message(mess)
    fun(...)
  }
}
talky_sqrt<- talky(fun = sqrt, mess = "Hey there! You Rock!")
talky_sqrt(1)
## Hey there! You Rock!

## [1] 1
# Run it or not ?
maybe <- function(fun){
  function(...){
    num <- sample(1:100, 1)
    if (num > 50) {
      fun(...)
    }
  }
}
maybe_sqrt <- maybe(fun = sqrt)
maybe_sqrt(1)
maybe_sqrt(1)
## [1] 1
maybe_sqrt(1)
## [1] 1
# Create a log file of a function 
log_calls <- function(fun, file){
  function(...){
    write(as.character(Sys.time()), file, append = TRUE, sep = "\n")
    fun(...)
  }
}
log_sqrt <- log_calls(sqrt, file = "logs")
log_sqrt(10)
## [1] 3.162278
log_sqrt(13)
## [1] 3.605551
readLines("logs")
## [1] "2018-04-19 10:21:03" "2018-04-19 10:21:03"

To leave a comment for the author, please follow the link and comment on their blog: Colin Fay.

R-bloggers.com offers daily e-mail updates about R news and tutorials on topics such as: Data science, Big Data, R jobs, visualization (ggplot2, Boxplots, maps, animation), programming (RStudio, Sweave, LaTeX, SQL, Eclipse, git, hadoop, Web Scraping) statistics (regression, PCA, time series, trading) and more...



If you got this far, why not subscribe for updates from the site? Choose your flavor: e-mail, twitter, RSS, or facebook...

Comments are closed.

Search R-bloggers

Sponsors

Never miss an update!
Subscribe to R-bloggers to receive
e-mails with the latest R posts.
(You will not see this message again.)

Click here to close (This popup will not appear again)