习题是我自己写的，没有参考答案，不对请指出

• 废话不多说，下面这个例子综合了列表中存储函数（后面还有更详细的例子）、隐函数和lapply()的用法
• 目的：对mtcars的每一列计算mean、median、sd、mad和IQR

#首先上面五个需求函数存储在列表中，然后lapply把它们交给隐函数（没有名字的函数），分别变成mean(x,na.rm = TRUE)、median(x,na.rm = TRUE)......
summary <- function(x) {
  funs <- c(mean, median, sd, mad, IQR)
  lapply(funs, function(f) f(x, na.rm = TRUE))
}
a <- lapply(mtcars,summary)
str(a)
List of 11
 $ mpg :List of 5
  ..$ : num 20.1
  ..$ : num 19.2
  ..$ : num 6.03
  ..$ : num 5.41
  ..$ : num 7.38
 $ cyl :List of 5
  ..$ : num 6.19
  ..$ : num 6
  ..$ : num 1.79
  ..$ : num 2.97
  ..$ : num 4
 $ disp:List of 5
  ..$ : num 231
  ..$ : num 196
  ..$ : num 124
  ..$ : num 140
  ..$ : num 205
 $ hp  :List of 5
  ..$ : num 147
  ..$ : num 123
  ..$ : num 68.6
  ..$ : num 77.1
  ..$ : num 83.5
 $ drat:List of 5
  ..$ : num 3.6
  ..$ : num 3.7
  ..$ : num 0.535
  ..$ : num 0.704
  ..$ : num 0.84
 $ wt  :List of 5
  ..$ : num 3.22
  ..$ : num 3.33
  ..$ : num 0.978
  ..$ : num 0.767
  ..$ : num 1.03
 $ qsec:List of 5
  ..$ : num 17.8
  ..$ : num 17.7
  ..$ : num 1.79
  ..$ : num 1.42
  ..$ : num 2.01
 $ vs  :List of 5
  ..$ : num 0.438
  ..$ : num 0
  ..$ : num 0.504
  ..$ : num 0
  ..$ : num 1
 $ am  :List of 5
  ..$ : num 0.406
  ..$ : num 0
  ..$ : num 0.499
  ..$ : num 0
  ..$ : num 1
 $ gear:List of 5
  ..$ : num 3.69
  ..$ : num 4
  ..$ : num 0.738
  ..$ : num 1.48
  ..$ : num 1
 $ carb:List of 5
  ..$ : num 2.81
  ..$ : num 2
  ..$ : num 1.62
  ..$ : num 1.48
  ..$ : num 2

• 来，再来一题：利用lapply()和隐函数计算mtcars数据集中所有列的变异系数（标准差/平均值）

> lapply(mtcars,function(x) sd(x)/mean(x))
$mpg
[1] 0.2999881

$cyl
[1] 0.2886338

$disp
[1] 0.5371779

$hp
[1] 0.4674077

$drat
[1] 0.1486638

$wt
[1] 0.3041285

$qsec
[1] 0.1001159

$vs
[1] 1.152037

$am
[1] 1.228285

$gear
[1] 0.2000825

$carb
[1] 0.5742933

• 求解y = x^2 -x 在[0,10]的积分

> y <- function(x) x ^ 2 - x
> integrate(y,0,10)
283.3333 with absolute error < 3.1e-12

闭包：它可以将父函数的环境封装，并可以访问它的所有变量。

对象是带有函数的数据，闭包是带有数据的函数 ——John D.cook

#闭包就是函数编写的函数，常用到隐函数来实现
#下面利用父层次控制运算，子层次进行工作的思想创建一组幂函数
power <- function(exponent) {
  function(x) {
    x ^ exponent
  }
}

square <- power(2)
square(2)
#> [1] 4
square(4)
#> [1] 16

cube <- power(3)
cube(2)
#> [1] 8
cube(4)
#> [1] 64
#查看闭包的不同环境
library(pryr)
unenclose(square)
#> function (x) 
#> {
#>     x^2
#> }
unenclose(cube)
#> function (x) 
#> {
#>     x^3
#> }
#通常情况下自己写的函数的环境就是全局环境，别人写的函数就是添加包环境，元函数(primitive function)，直接调用C代码，且没有相关联的环境

• 可变状态

#一般来说，函数的执行环境是临时的，但是闭包可以一直访问它创建的环境
#下面的例子中，counter_one和counter_two在执行是都可以获取它们自己的封闭环境，所以各自计数互不影响
> new_counter <- function() {
+     i <- 0
+     function() {
+         i <<- i + 1
+         i
+     }
+ }
> counter_one <- new_counter()
> counter_two <- new_counter()
> 
> counter_one()
[1] 1
> counter_one()
[1] 2
> counter_two()
[1] 1
> counter_two()
[1] 2
> counter_two()
[1] 3
#不用全局赋值，就是下面这样
> i <- 0
> new_counter2 <- function() {
+   i <<- i + 1
+   i
+ }
> new_counter2()
[1] 1
> new_counter3 <- function() {
+   i <- 0
+   function() {
+     i <- i + 1
+     i
+   }
+ }
> new_counter3()
function() {
    i <- i + 1
    i
  }
<environment: 0x0000018dd806dd20>
#这个new_counter3()没有输出，是因为虽然它可以向上查找其父环境中的i，但是执行完函数又被清除了（个人理解）

• 习题：创建一个pick函数，它根据给出的索引i值，返回带有参数x的函数，这个函数可以根据i值对x进行自己选取

> pick <- function(i){
+   function(x) x[[i]]
+ }
> pick(5)
function(x) x[[i]]
<environment: 0x0000025bb7088b90>
> head(lapply(mtcars,pick(5)))
$mpg
[1] 18.7
$cyl
[1] 8
$disp
[1] 360
$hp
[1] 175
$drat
[1] 3.15
$wt
[1] 3.44
#检查结果
> head(lapply(mtcars,function(x) x[[5]]))
$mpg
[1] 18.7
$cyl
[1] 8
$disp
[1] 360
$hp
[1] 175
$drat
[1] 3.15
$wt
[1] 3.44

• 函数列表

#利用函数列表的思想比较三种不同方法计算平均值所需的时间
compute_mean <- list(
  base = function(x) mean(x),
  sum = function(x) sum(x) / length(x),
  manual = function(x) {
    total <- 0
    n <- length(x)
    for (i in seq_along(x)) {
      total <- total + x[i] / n
    }
    total
  }
)
x <- runif(1e5)
system.time(compute_mean$base(x))
#>    user  system elapsed 
#>   0.001   0.000   0.001
system.time(compute_mean[[2]](x))
#>    user  system elapsed 
#>   0.000   0.000   0.001
system.time(compute_mean[["manual"]](x))
#>    user  system elapsed 
#>   0.023   0.000   0.023
> is.primitive(sum)
[1] TRUE
> is.primitive(mean)
[1] FALSE
#看看，元函数sum的快可见一斑。还有就是尽量避免使用循环，你看这个“manual”就慢的不像话
#lapply，让函数调用更简单
lapply(compute_mean, function(f) f(x))
#> $base
#> [1] 0.4994664
#> 
#> $sum
#> [1] 0.4994664
#> 
#> $manual
#> [1] 0.4994664
#如果需要额外的参数呢？有...在，你尽管放心加。
funs2 <- list(
  sum = function(x, ...) sum(x, ..., na.rm = TRUE),
  mean = function(x, ...) mean(x, ..., na.rm = TRUE),
  median = function(x, ...) median(x, ..., na.rm = TRUE)
)
lapply(funs2, function(f) f(x))
#> $sum
#> [1] 55
#> 
#> $mean
#> [1] 5.5
#> 
#> $median
#> [1] 5.5
#当然还可以更简单
lapply(funs, function(f) f(x, na.rm = TRUE))

将函数列表移到全局环境

simple_tag <- function(tag) {
  force(tag)
  function(...) {
    paste0("<", tag, ">", paste0(...), "</", tag, ">")
  }
}
tags <- c("p", "b", "i")
html <- lapply(setNames(tags, tags), simple_tag)
html$p("This is ", html$b("bold"), " text.")
#> [1] "<p>This is <b>bold</b> text.</p>"
#三种方法终止html$的作用
1. with()，适合临时。最为推荐
with(html, p("This is ", b("bold"), " text."))
#> [1] "<p>This is <b>bold</b> text.</p>"
2. attach()，适合长时间。使用完成后，detach()解除即可
attach(html)
p("This is ", b("bold"), " text.")
#> [1] "<p>This is <b>bold</b> text.</p>"
detach(html)
3. list2env()，复制到全局环境
list2env(html, environment())
#> <environment: R_GlobalEnv>
p("This is ", b("bold"), " text.")
#> [1] "<p>This is <b>bold</b> text.</p>"
rm(list = names(html), envir = environment())

积分案例略
下课~