函数是一个以向量作为输入参数，同时结果也以向量的形式生成。在 R 基础包中我们已经接触了一些，apply
lapply tapply 等等，使用函数是为了替代 for-loop
今天，主要介绍函数式编程 Purrr 包的一些使用
library(tidyverse)## ─ Attaching packages ─────────────────────── tidyverse 1.2.1 ─## ✔ ggplot2 3.2.0 ✔ purrr 0.3.2
## ✔ tibble 2.1.3 ✔ dplyr 0.8.3
## ✔ tidyr 0.8.3 ✔ stringr 1.4.0
## ✔ readr 1.3.1 ✔ forcats 0.4.0## ─ Conflicts ──────────────────────── tidyverse_conflicts() ─
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()library(purrr)map() 是作为 purrr 包的一个奠基者，接受一个向量和函数，返回一个列表
map(1:3,sqrt)## [[1]]
## [1] 1
##
## [[2]]
## [1] 1.414214
##
## [[3]]
## [1] 1.732051map 返回一个 list,可以存放更多的数据结构，但这里的结果简单是以 list 的形式展示，不利于查看
map_chr 返回字符串向量
map_chr(mtcars,typeof)## mpg cyl disp hp drat wt qsec vs
## "double" "double" "double" "double" "double" "double" "double" "double"
## am gear carb
## "double" "double" "double"map_lgl 返回一个逻辑向量
map_lgl(mtcars,is.double)## mpg cyl disp hp drat wt qsec vs am gear carb
## TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUEmap_int 返回一个整数向量
map_int(mtcars,length)## mpg cyl disp hp drat wt qsec vs am gear carb
## 32 32 32 32 32 32 32 32 32 32 32map_dbl 返回一个浮点数向量
map_dbl(mtcars,mean)## mpg cyl disp hp drat wt
## 20.090625 6.187500 230.721875 146.687500 3.596563 3.217250
## qsec vs am gear carb
## 17.848750 0.437500 0.406250 3.687500 2.812500所有的 map 函数都返回与输入向量相同长度的结果，包括原子向量和 list,如果返回结果复杂的话要使用
因为 list 中的每一个元素可以存储任何的数据结构
pair <- function(x) c(x, x)
#map_int(1:2,pair) 将会报错，输出向量长度与输入不一致，所以只能用 map ,返回一个 list
map(1:2,pair)## [[1]]
## [1] 1 1
##
## [[2]]
## [1] 2 2map() 除了可以使用内置的函数，你也可以自定义函数，创建一个匿名函数
map_dbl(mtcars,function(x) length(unique(x)))## mpg cyl disp hp drat wt qsec vs am gear carb
## 25 3 27 22 22 29 30 2 2 3 6上面的这个匿名函数略显啰嗦，因此 purrr 提供了简写方法
map_dbl(mtcars,~length(unique(.x)))## mpg cyl disp hp drat wt qsec vs am gear carb
## 25 3 27 22 22 29 30 2 2 3 6上面的函数参数看着有点古怪，“.” 表示的是前面向量中的元素 “~” 表示一个匿名函数
map 函数族同时提供了获取向量元素的简便方法，这个对于处理复杂的 list 结构很有帮助
x <- list(
list(-1, x = 1, y = c(2), z = "a"),
list(-2, x = 4, y = c(5, 6), z = "b"),
list(-3, x = 8, y = c(9, 10, 11))
)select by name
map_dbl(x,'x')## [1] 1 4 8select by position
map_dbl(x,1)## [1] -1 -2 -3select by name and position
map_dbl(x,list('y',1))## [1] 2 5 9向 mean 函数传递 na.rm = T,一个方法是构造匿名函数
x <- list(1:5, c(1:10, NA))
map_dbl(x, ~ mean(.x, na.rm = TRUE))## [1] 3.0 5.5但在 map 中可以直接传递其他参数，不需要构造匿名函数
map_dbl(x,mean,na.rm = T)## [1] 3.0 5.5上面这两种方式有细微的不同，通过构造匿名函数传递额外参数，这个参数每一次都会被执行，而直接传递
给 map 将只会执行一次额外参数传递
通常 map 的第一个参数将传递给后面的函数作为该函数的第一个参数，但是如果第一个参数是定值，第二个
参数是变量值，该怎么办
trims <- c(0, 0.1, 0.2, 0.5)
x <- rcauchy(1000)计算不同 trim 后的均值计算,在前面直接将多余参数传递给 map 然而，这个额外参数是定值，这里情况正
好相反，因此需要使用匿名函数处理
map_dbl(trims,~mean(x,trim = .x)) # 这里每一次循环调用一次 .x 中的值，而前面一个 x 表示的是trims## [1] 0.082155703 -0.047868710 -0.001398778 0.030602905# 和下面等价
# map_dbl(trims,function(trim) mean(x,trim = trim))
map_dbl(trims,mean,x = x)## [1] 0.082155703 -0.047868710 -0.001398778 0.030602905在实际生活中，我们来看看 purrr 包解决问题的书写风格，以模型拟合并提取系数为例
以 cyl 变量拆分 mtcars 数据
by_cyl <- split(mtcars,mtcars$cyl)对 cyl 变量的每一因子进行拟合模型
by_cyl %>% map(~lm(mpg ~ wt,data = .x)) %>%
map(coef) %>%
map_dbl('wt')## 4 6 8
## -5.647025 -2.780106 -2.192438modify()
same type of output as input
假如，你想对一个数据框的每一列进行数值乘以 2，你首先想到用 map ,但是结果返回一个 list
df <- data.frame(
x = 1:3,
y = 6:4
)map(df,~ .x * 2)## $x
## [1] 2 4 6
##
## $y
## [1] 12 10 8如果你想输出结果和输入保持一致都为数据框，那么可以使用 modify()
modify(df, ~ .x * 2)## x y
## 1 2 12
## 2 4 10
## 3 6 8map2()
map() 是通常向量化一个参数实现循环,意味着 .f 只能接受一个 .x
加入你想计算一组数据的加权平均值，且权值也不是固定的
xs <- map(1:8,~runif(10))
xs[[1]][[1]] <- NA
ws <- map(1:8,~rpois(10,5) + 1)使用 map_dbL()—-报错,由于 map_dbl 不能对 ws 进行向量化，因此每次循环会将整个 ws 传递给函数
因此可以使用 map2()
map2_dbl(xs,ws,weighted.mean)## [1] NA 0.4246739 0.4181405 0.4716715 0.4486457 0.4679170 0.4724023
## [8] 0.4695921map2_dbl(xs,ws,weighted.mean,na.rm = T)## [1] 0.3960370 0.4246739 0.4181405 0.4716715 0.4486457 0.4679170 0.4724023
## [8] 0.4695921walk()
大多数函数都会返回输出结果，有时候却不希望产生返回值
welcome <- function(x) {
cat("Welcome ", x, "!\n", sep = "")
}
names <- c("Hadley", "Jenny")map(names, welcome)## Welcome Hadley!
## Welcome Jenny!## [[1]]
## NULL
##
## [[2]]
## NULLwalk(names,welcome)## Welcome Hadley!
## Welcome Jenny!第一种方式类似于 map 家族，第二、三种方式类似于 imap 家族。imap 类似于 map2 可接收两个参数,但
还是有些不同，imp 两个参数都来源于一个向量 imp(x,f) 等同于 map2(x,names(x),f)
imap_chr(iris, ~ paste0("The first value of ", .y, " is ", .x[[1]])) ## Sepal.Length
## "The first value of Sepal.Length is 5.1"
## Sepal.Width
## "The first value of Sepal.Width is 3.5"
## Petal.Length
## "The first value of Petal.Length is 1.4"
## Petal.Width
## "The first value of Petal.Width is 0.2"
## Species
## "The first value of Species is setosa"当你同时想处理向量的元素和索引可以使用 imap
pmap 可以接受任何数量的参数，前提是要将参数整合成一个 list, 通常情况每一个参数的向量长度应该相同
map2(x,y,f) 等价于 pmap(list(x,y),f)
pmap(list(xs,ws),weighted.mean)## [[1]]
## [1] NA
##
## [[2]]
## [1] 0.4246739
##
## [[3]]
## [1] 0.4181405
##
## [[4]]
## [1] 0.4716715
##
## [[5]]
## [1] 0.4486457
##
## [[6]]
## [1] 0.467917
##
## [[7]]
## [1] 0.4724023
##
## [[8]]
## [1] 0.4695921pmap(list(xs,ws),weighted.mean,na.rm = T) # 非向量参数放在函数后面## [[1]]
## [1] 0.396037
##
## [[2]]
## [1] 0.4246739
##
## [[3]]
## [1] 0.4181405
##
## [[4]]
## [1] 0.4716715
##
## [[5]]
## [1] 0.4486457
##
## [[6]]
## [1] 0.467917
##
## [[7]]
## [1] 0.4724023
##
## [[8]]
## [1] 0.4695921对于之前求不同 trim 后的均值求取可以使用 pmap, 使得代码更加清晰
trims <- c(0, 0.1, 0.2, 0.5)
x <- rcauchy(1000)
pmap_dbl(list(trim = trims), mean, x = x) ## [1] -3.90654894 -0.01015534 -0.02711470 -0.03219927将参数作为数据框传递给 pmap 中的函数是非常方便的写法
params <- tibble::tribble( # 注意参数名要和函数的参数名统一
~ n, ~ min, ~ max,
1L, 0, 1,
2L, 10, 100,
3L, 100, 1000
)
pmap(params, runif) ## [[1]]
## [1] 0.7117793
##
## [[2]]
## [1] 34.96277 97.16119
##
## [[3]]
## [1] 936.0952 934.0755 422.4480reduce() 接收一个长度为 n 的向量输入，返回结果是长度为 1 的向量
比如需要你找出 list 中所有元素的交集，该怎么做 ?
l <- map(1:4, ~ sample(1:10,15,replace = T))
# l <- map(1:4, sample(1:10,15,replace = T)) # 将报错，因此 map 中直接使用非匿名函数，该函数只会调用一次out <- l[[1]]
out <- intersect(out, l[[2]])
out <- intersect(out, l[[3]])
out <- intersect(out, l[[4]])
out## [1] 1 2 4 6利用 reduce 可以实现一行代码解决问题
reduce(l,intersect)## [1] 1 2 4 6在基础包中有 Reduce 函数和这个类似，不同地方在于，Reduce 不能添加额外参数，而且 Reduce 第一个参数
为函数，第二参数为向量
Reduce(intersect,l)## [1] 1 2 4 6accumulate
这是 reduce 函数的一个变体，会输出中间结果
accumulate(l,intersect)## [[1]]
## [1] 1 2 3 2 10 4 10 3 8 4 6 9 9 3 2
##
## [[2]]
## [1] 1 2 3 4 6
##
## [[3]]
## [1] 1 2 4 6
##
## [[4]]
## [1] 1 2 4 6谓词函数返回单个 TRUE 或 FALSE。purrr 包提供了6个有用的谓词函数
some(.x, .p)
任何一个可以匹配则返回 TRUE
df <- data.frame(x = 1:3, y = c("a", "b", "c"),stringsAsFactors = F)some(df,is.character)## [1] TRUEevery(.x, .p) 所有的都能匹配才返回 TRUE
every(df,is.character)## [1] FALSEevery(df,is.numeric)## [1] FALSEdetect(.x, .p) 返回第一个匹配的元素
detect(df,is.character)## [1] "a" "b" "c"detect_index(.x, .p)
返回第一个匹配的索引
detect_index(df,is.character)## [1] 2keep(.x, .p) 保留所有能匹配的元素
keep(df,is.character)## y
## 1 a
## 2 b
## 3 cdiscard(.x, .p)
舍去所有能匹配的元素
discard(df,is.character)## x
## 1 1
## 2 2
## 3 3str(keep(df, is.factor))## 'data.frame': 3 obs. of 0 variablesstr(discard(df, is.character))## 'data.frame': 3 obs. of 1 variable:
## $ x: int 1 2 3map 和 modify 变异函数可以结合谓词函数，这样就可以只转换为 TRUE 的变量
df <- data.frame(
num1 = c(0, 10, 20),
num2 = c(5, 6, 7),
chr1 = c("a", "b", "c"),
stringsAsFactors = FALSE
)str(map_if(df,is.numeric,mean))## List of 3
## $ num1: num 10
## $ num2: num 6
## $ chr1: chr [1:3] "a" "b" "c"str(modify_if(df,is.numeric,mean))## 'data.frame': 3 obs. of 3 variables:
## $ num1: num 10 10 10
## $ num2: num 6 6 6
## $ chr1: chr "a" "b" "c"str(map(keep(df,is.numeric),mean))## List of 2
## $ num1: num 10
## $ num2: num 6有一个值得注意的就是 is.na() 不是一个谓词函数，它会返回与原向量相等长度逻辑向量，可以使用 anyNA()
df <- data.frame(a = 1:5,
b = c(10,20,30,NA,40))
detect(df,anyNA)## [1] 10 20 30 NA 40detect_index(df,anyNA)## [1] 2