神器purrr包是Hadley Wickham大神编写的高级函数编程语言包，它可以填充R功能性编程中的缺失部分，使得你的编程更加函数化。
purrr包提供了大量的类似map的函数。可以服务于减少循环、处理嵌套数据、多模型等应用需求。
map()函数
library("purrr") #加载包
data(mtcars) #使用数据集mtcars
head(mtcars) #查看mtcars数据的前五行
dim(mtcars) #查看数据mtcars的维度
##求mtcars数据的均值
map_dbl(mtcars, mean)
mtcars %>% map_dbl(mean)
##对mtcars的数据进行标准化
mtcars %>% map(function(x) (x - mean(x)/max(x)-min(x))) # list
mtcars %>% map_df(function(x) (x - mean(x)/max(x)-min(x)))# data.frame
map2()
n <- list(4,5,6)
m <- list(1,2,3)
map2(m,n, `+`)
by_cyl <- mtcars %>% split(.$cyl)
mods <- by_cyl %>% map(~ lm(mpg ~ wt, data = .))
map2(mods, by_cyl, predict)
pmap()
x <- list(1, 10, 100)
y <- list(1, 2, 3)
z <- list(5, 50, 500)
pmap(list(x, y, z), sum)
pmap(list(x, y, z), function(a, b ,c) a / (b + c))
accumulate() # 行列长度不变
mtcars[1,]
mtcars[1,] %>% accumulate(`+`) # 从左向右
mtcars[1,] %>% accumulate(`*`)
mtcars[1,] %>% accumulate_right(`+`) # 从右向左
mtcars[1,] %>% accumulate_right(`*`)
reduce () # 获得一个值
mtcars[,1]
mtcars[,1] %>% reduce(`+`) # 从左向右
mtcars[,1] %>% reduce(`*`)
mtcars[,1] %>% reduce_right(`+`) # 从右向左
mtcars[,1] %>% reduce_right(`*`)
detect () # 找到第一个匹配的值
mtcars[2,]
mtcars[2,] %>% detect(~. >50)
# detect_index() 并返回它的位置
mtcars[2,] %>% detect_index(~. >50)
some() 列表中的某些元素是否满足要求？ 返回结果TRUE/FALSE
every() 列表中的每个元素是否满足要求？
mtcars %>% some(is_numeric)
mtcars %>% some(is_character)
mtcars %>% every(is_numeric)
mtcars %>% every(is_character)
x <- list(1:5,'R','ruby','python')
x %>% every(is_character)
x %>% some(is_character)
x %>% every(is_numeric)
x %>% some(is_numeric)
head_while() 找到所有满足头部匹配的值
tail_while() 找到所有满足尾部匹配的值
mtcars[1,]
mtcars[1,] %>% head_while(~. >5)
mtcars[1,] %>% head_while(~. >15)
mtcars[,1]
mtcars[,1] %>% tail_while(~. >25)
mtcars[,1] %>% tail_while(~. >21)
fun <- function(x) x >= 1
head_while(5:-5, fun)
head_while(-1:-5, fun)
x <- sample(10)
x
x %>% head_while(~. >5)
x %>% tail_while(~. >5)
transpose() 将列表对变成列表/将一个列表对成一个清单
mtcars %>% transpose()
mtcars %>% transpose() %>%simplify_all()
x <- list(list(a=1,b=2),list(a=3,b=4))
x
x %>% transpose()
x %>% transpose() %>%simplify_all()
ll <- list(
list(x = 1, y = "one"),
list(z = "deux", x = 2)
)
ll %>% transpose()
ll %>% transpose() %>%simplify_all()
keep() 使用函数保留元素
discard() 使用函数放弃元素 保存于放弃是对立的
head(mtcars)
mtcars[1:5,] %>% keep(function(x) mean(x) > 10)
mtcars[1:5,] %>% keep(function(x) mean(x) < 10)
mtcars[1:5,] %>% discard(function(x) mean(x) < 10)
mtcars[1:5,] %>% discard(function(x) mean(x) > 10)
rep(3, 2) %>% # rep(a,time=)
map(rnorm, n=5) %>% #每行个数
keep(function(x) mean(x) > 2)
rep(3, 2) %>% # rep(a,time=)
map(rnorm, n=5) %>% #每行个数
discard(function(x) mean(x) >4)
safely #函数包装功能，不通过打印输出消息，警告和错误
# safely() 返回一个带有组件结果和错误的列表
# quietly() 返回一个包含组件结果/输出/警告和消息
# possibly() 包装函数在发生错误时使用默认值（否则）
fun_log <- safely(log) #log
str(fun_log(10))
list("a",100,9) %>% map(fun_log)
list(99,100,9) %>% map(fun_log) %>% transpose()
fun_log(mtcars[1,])
mean_fun <-quietly(mean) #mean
mean_fun(c(1,3)) %>% transpose()
mean_fun(mtcars[,1])
mean(mtcars[,1])
x <- list(1, 10, "a") #log
x %>% map_dbl(possibly(log, NA_real_)) # otherwise
walk 无形的返回第一个参数，经常与管道函数并用
# walk()
# pwalk()
# walk2()
x <- list(1, "a", 3)
x %>% walk(print)