What is an adverb

Read carefully the purrr documentation

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 an adverb modifies a verb.

library(purrr)
safe_log <- safely(log)#high-order functions
safe_log("a")

## $result
## NULL
## 
## $error
## <simpleError in log(x = x, base = base): non-numeric argument to mathematical function>

# have a result and error

how to write your own?

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

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")

## [1] 1

how to implement this kind of behavior?

Let’s take a simple example with sleepy:

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

sleep_print <- sleepy(Sys.time, 5)
class(sleep_print)

## [1] "function"

sleep_print()

## [1] "2018-04-20 09:15:36 CST"

how?

First of all, the adverb functon should return another function, so we need to start with?

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

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

plop <- mean
plop(1:10)

## [1] 5.5

sys_time <- talky(Sys.time)
sys_time()

## [1] "2018-04-20 09:15:36 CST"

talky <- function(fun, mess){
  function(...){
    #add some command
    message(mess)#这里可以添加参数
    print(Sys.time())
    
    print("you can add anything")
    
    
    fun(...)#the function you want modify
  }
}

talky_sqrt<- talky(fun = sqrt, mess = "Hey there! You Rock!")#创建被修饰函数
talky_sqrt(4)#4 是传递给被修饰的函数的

## [1] "2018-04-20 09:15:36 CST"
## [1] "you can add anything"

## [1] 2

maybe <- function(fun){
  function(...){
    num <- sample(1:100, 1)
    if (num > 50) {
      fun(...)
    }
  }
}
maybe_sqrt <- maybe(fun = sqrt)
maybe_sqrt(1)

## [1] 1

maybe_sqrt(1)

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