77.ADR之Functionals编程

本贴我会把3个小节的内容整合在一起，篇幅可能很长很长，由于这是一个比较系统的概念，部分知识要用到前面的帖子中介绍的，例如： lazy function, function enviroments 等等[s:11]

R的核心其实就是一门函数式编程语言，简称FP

一切的一切，从lapply说起，这是一个底层用C写的，用R code意思如下的functional:

<br />
#lapply(x,f,...) 概念上等价于<br />
out <- vector("list", length(x))<br />
for (i in seq_along(x)) {<br />
  out[[i]] <- f(x[[i]], ...)<br />
}

这是基础中的基础，我们用的大部分概念思想源于这个函数，我的总结就是：

1. 一个函数用在一个数据list的不同部分，这里的一个函数也指包装了多个函数的

summary <- function(x) {<br />
  c(mean(x), median(x), sd(x), mad(x), IQR(x))<br />
}<br />
lapply(df, summary)

2.多个函数用在一个数据上，主要思想是将函数分别存储在list里,这就是list of functions的概念

x <- 1:10<br />
funs <- list(<br />
  sum = sum,<br />
  mean = mean,<br />
  median = median<br />
)<br />
lapply(funs, function(f) f(x))

充分理解这两点，其实就可以灵活的使用lapply了，这是一个双向思维，可以这样理解：既可以把函数用于数据，也可以把数据用于函数

3.结合上述2点，加上Anonymous functions 和Closures的概念

前面两点已经刻画了lapply的双向思维，这里来刻画使用的FUN，我们都是使用mean,同样我们也可以自定义一个函数再用它，或者直接使用lapply(x,function(x) {})这样的代码，这就是Anonymous functions了，所以没什么好说的，下面重点说下Closures，比如我们的FUN是power(2)：

其实就是函数返回函数，但这里其实内容很深，但如果你熟悉了我前面介绍的函数环境的概念以及惰性求值的概念，那么这里你会轻松很多，否则我猜你可能云里雾里[s:12]

power <- function(exponent) {<br />
  function(x) {<br />
    x ^ exponent<br />
  }<br />
}<br />
square <- power(2)<br />
square(2)<br />
#> [1] 4<br />
square(4)<br />
#> [1] 16</p>
<p>cube <- power(3)<br />
cube(2)<br />
#> [1] 8<br />
cube(4)<br />
#> [1] 64

这是一个很简单易懂的例子，这个例子里基本上就是解释了什么是闭包Closures.

这里要结合前面深究一下，也就是squre,cube的ee就是power的exe e，我们可以通过如下2种途径看squre,cube的代码

<br />
#不行的方法<br />
square<br />
#> function(x) {<br />
#>     x ^ exponent<br />
#>   }<br />
#> <environment: 0x2b3c6d8><br />
cube<br />
#> function(x) {<br />
#>     x ^ exponent<br />
#>   }<br />
#> <environment: 0x2d8cda0><br />
#方法之一;<br />
as.list(environment(square))<br />
#> $exponent<br />
#> [1] 2<br />
as.list(environment(cube))<br />
#> $exponent<br />
#> [1] 3<br />
#方法之二<br />
library(pryr)<br />
unenclose(square)<br />
#> function (x)<br />
#> {<br />
#>     x^2<br />
#> }<br />
unenclose(cube)<br />
#> function (x)<br />
#> {<br />
#>     x^3<br />
#> }<br />

再用同样的知识，可以实现一个叫mutable state的概念，代码如下：

new_counter <- function() {<br />
  i <- 0<br />
  function() {<br />
    i <<- i + 1<br />
    i<br />
  }<br />
}<br />
counter_one <- new_counter()<br />
counter_two <- new_counter()</p>
<p>counter_one()<br />
#> [1] 1<br />
counter_one()<br />
#> [1] 2<br />
counter_two()<br />
#> [1] 1

其实就是用Closures的ee是工厂函数（产生闭包的函数）的exe e，并且这个exe e不变的原理（前面介绍过）

这个Closures的概念下面还会提到，因为它也是FO的概念的基础，那里还会提到惰性求值的问题.

所以到这里，1,2,3点就概括了基础的东西，这里省略了很多细节的东西了，不然篇幅太长[s:11]

上面基于lapply,下面从它扩展For loop functionals：

sapply,vapply,Map,mclapply等

其实，这些函数系列，初学很烦，感觉很多，分不清，其实lapply是list进list出，而sapply是vector出,出的类型没有vapply严格，它们都是用lapply实现的，只是对于结果做了一些转变，对于Map，它是多个input而已，对于mclapply貌似很厉害，因为lapply的计算顺序不一定，所以可以实现这个mvapply，但是它不是windows下的东西，最后我们用apply,sweep,outer,tapply去实现操作矩阵，数据框，这些函数都是具体的去学的东西，我并不会详细介绍它们的本质就是指定行列之后，就成了1d的了，至于3维以上的也是一定，指定dim,但暂时用不到就不提了，tapply值得看一下，后面有个作业，我自己完成了自己的split版本

<br />
split2=function(x,y){<br />
 tmp=lapply(unique(y),function(x,data=y) {<br />
    which(data==x)<br />
    } )<br />
 results=lapply(tmp,function(data) x[data])<br />
 names(results)=unique(y)<br />
 return(results)<br />
}

大家做的时候可以参考一下哈，然后就是其它的一些函数Predicate functionals：: Filter(), Find() and Position().Mathematical functionals：integrate()，uniroot()，optimise()。大家就自己去看看吧

这部分，最后我要说这样的概念，文章介绍的是sum的制作过程：

首先写个普通的add函数

然后写个处理NA的函数,确定默认值，这两个函数都是处理2个参数的

最后利用Reduce实现到一个向量上，当然其中还有一些控制参数，我自己做练习实现min，pmin,如果你也遇到，我这里可以给你参考：

<br />
rm_na <- function(x, y, identity) {<br />
  if (is.na(x) && is.na(y)) {<br />
    identity<br />
  } else if (is.na(x)) {<br />
    y<br />
  } else {<br />
    x<br />
  }<br />
}<br />
smaller=function(x,y,na.rm=FALSE){<br />
  if (na.rm && (is.na(x) || is.na(y))) rm_na(x, y, Inf) else ifelse(x>y,y,x)   </p>
<p>}<br />
r_smaller <- function(xs, na.rm = TRUE) {<br />
  Reduce(function(x, y) smaller(x, y, na.rm = na.rm), xs,init=Inf)<br />
}<br />
v_smaller <- function(x, y, na.rm = FALSE) {<br />
  stopifnot(length(x) == length(y), is.numeric(x), is.numeric(y))<br />
  if (length(x) == 0) return(numeric())<br />
  simplify2array(Map(function(x, y) smaller(x, y, na.rm = na.rm), x, y))<br />
}

好了，两个部分介绍完了，最后来介绍FO的概念Function operators，总的来说就是在Closures上下文章[s:11]

比如作者举的例子，让一个函数延迟执行:

delay_by <- function(delay, f) {<br />
  function(...) {<br />
    Sys.sleep(delay)<br />
    f(...)<br />
  }<br />
}<br />
system.time(runif(100))<br />
#>    user  system elapsed<br />
#>       0       0       0<br />
system.time(delay_by(0.1, runif)(100))<br />
#>    user  system elapsed<br />
#>   0.000   0.000   0.102

利用这个基本的框架思想，作者开发了非常多的用法思路，确实惊艳，比如Capturing function invocations

怎么做？

其实就是这样：

ignore <- function(...) NULL<br />
tee <- function(f, on_input = ignore, on_output = ignore) {<br />
  function(...) {<br />
    on_input(...)<br />
    output <- f(...)<br />
    on_output(output)<br />
    output<br />
  }<br />
}<br />
g <- function(x) cos(x) - x<br />
show_x <- function(x, ...) cat(sprintf("%+.08f", x), "\n")</p>
<p># The location where the function is evaluated:<br />
zero <- uniroot(tee(g, on_input = show_x), c(-5, 5))

神奇吗？这个...经常出现在这个框架思路中，非常厉害的思想。上面2个基于Closures的FO，作者叫它Behavioural FOs，总共还有Output FOs，Input FOs，Combining FOs,其实思路都一样，只不过功能不同，对于OFO，我只摘出这个例子

failwith <- function(default = NULL, f, quiet = FALSE) {<br />
  force(f)<br />
  function(...) {<br />
    out <- default<br />
    try(out <- f(...), silent = quiet)<br />
    out<br />
  }<br />
}<br />
log("a")<br />
#> Error: non-numeric argument to mathematical function<br />
failwith(NA, log)("a")<br />
#> [1] NA<br />
failwith(NA, log, quiet = TRUE)("a")<br />
#> [1] NA

神奇吗？它给了一个函数失败时提供默认值的功能，其实它做了什么？它什么都没做！就是用一个Closures把...传给了内部的函数。。。但是用处大吗？会很大。。。作者举了个GLM的例子，大概是说你要对一系模型拟合，显然有些会失败，但你不想失败的时候会停下，你只想记录失败的，回头再集中研究失败的，这个failwith就可以很好的完成任务。

对于Input FOs，我提2个东西，一个是partial,一个是多个参数传入函数

前者其实就是固定特定参数，后者是这样的

splat <- function (f) {<br />
  force(f)<br />
  function(args) {<br />
    do.call(f, args)<br />
  }<br />
}<br />
x <- c(NA, runif(100), 1000)<br />
args <- list(<br />
  list(x),<br />
  list(x, na.rm = TRUE),<br />
  list(x, na.rm = TRUE, trim = 0.1)<br />
)<br />
lapply(args, splat(mean))

对于最后一种FO，其实就是

compose <- function(f, g) {<br />
  function(...) f(g(...))<br />
}

没什么说的了

最后，我要提4个特别重要的概念：

1.base::Vectorize()

sample2 <- Vectorize(sample, "size", SIMPLIFY = FALSE)<br />
sample2(1:5, c(1, 1, 3))

2.Memoisation

<br />
library(memoise)<br />
slow_function <- function(x) {<br />
  Sys.sleep(1)<br />
  10<br />
}<br />
system.time(slow_function())<br />
#>    user  system elapsed<br />
#>   0.000   0.001   1.002<br />
system.time(slow_function())<br />
#>    user  system elapsed<br />
#>   0.001   0.000   1.000<br />
fast_function <- memoise(slow_function)<br />
system.time(fast_function())<br />
#>    user  system elapsed<br />
#>   0.001   0.000   1.000<br />
system.time(fast_function())<br />
#>    user  system elapsed<br />
#>       0       0       0<br />

很显然，这个东西是把函数每次的结果存起来了，再调用同样的东西会直接给结果，特别适合斐波那契数列

3.Lazynesss

<br />
funop <- function(f, otherargs) {<br />
  function(...) {<br />
    # maybe do something<br />
    res <- f(...)<br />
    # maybe do something else<br />
    res<br />
  }<br />
}

对于这种框架，如果放入lapply,Map可能会出问题：

funs <- list(mean = mean, sum = sum)<br />
funs_m <- lapply(funs, delay_by, delay = 0.1)</p>
<p>funs_m$mean(1:10)<br />
#> [1] 55

所以要

delay_by <- function(delay, f) {<br />
  force(f)<br />
  function(...) {<br />
    Sys.sleep(delay)<br />
    f(...)<br />
  }<br />
}</p>
<p>funs_m <- lapply(funs, delay_by, delay = 0.1)<br />
funs_m$mean(1:10)

这看上去难理解，如果你理解了函数是个对象的时候，然后结合前面的惰性求值的介绍，也许不那么难理解了

4.最后的最后

remember <- function() {<br />
  memory <- list()<br />
  f <- function(...) {<br />
    # This is inefficient!<br />
    memory <<- append(memory, list(...))<br />
    invisible()<br />
  }</p>
<p>  structure(f, class = "remember")<br />
}<br />
as.list.remember <- function(x, ...) {<br />
  environment(x)$memory<br />
}<br />
print.remember <- function(x, ...) {<br />
  cat("Remembering...\n")<br />
  str(as.list(x))<br />
}<br />
locs <- remember()<br />
vals <- remember()<br />
zero <- uniroot(tee(g, locs, vals), c(-5, 5))<br />
x <- unlist(as.list(locs))<br />
error <- unlist(as.list(vals))<br />
plot(x, type = "b"); abline(h = 0.739, col = "grey50")

这段代码让我赞叹不已，它又让我震惊了，它结合了函数环境+S3方法的本质（把函数转成list都可以。。。而且这种转换得是多巧妙。。。。）+Closures

PS：这部分写的比较混乱，可能同时写3小结的原因，显得是写给我自己的一样，因为我略去了很多，下次我决定分开写了
</p>