本文于r format(Sys.Date(), "%Y-%m-%d")更新。 如发现问题或者有建议，欢迎提交 Issue

{r setup, include=FALSE} knitr::opts_chunk$set(eval = FALSE)

map

map函数相当于for循环，但是不需要注意for(){}的缩进，而且代码写起来，简单些。

{r} mtcars %>% group_by(cyl) %>% nest() %>% mutate(p = map(data, function(x){ p <- x %>% ggplot(aes(x = mpg, y = disp)) + geom_point() + labs( x = "Miles/(US) gallon", y = "Displacement (cu.in.)", subtitle = paste("cyl =",cyl), title = "The scatter diagram for Miles/(US) gallon by Displacement (cu.in.)", caption = "Data source: mtcars ) + theme_minimal() print(p)}))

purrr::map可以批量跑函数，但是会出现报错，这个时候possibly和safely可以给报错的打个标签，继续跑 rdata.lu Blog 。 @hadleymap 在第四和第五部分主要解释了这两个函数。

safely()函数

```{r eval=F} # Create safe_readLines() by passing readLines() to safely() safe_readLines <- safely(readLines)

Call safe_readLines() on “http://example.org

safe_readLines(“http://example.org”)

Call safe_readLines() on “http://asdfasdasdkfjlda

safe_readLines(“http://asdfasdasdkfjlda”)

@WickhamWritingFunctions42 给出了`safely()`函数的例子。
显然第二个例子不是一个网页，因此会报错，因此两个例子的区别在于，

- 成功了，因此`$result`非空，`$error`空
- 失败了，因此`$result`空，`$error`非空

## map 和 safely

```
urls <- list(
  example = "http://example.org",
  rproj = "http://www.r-project.org",
  asdf = "http://asdfasdasdkfjlda
)
# Define safe_readLines()
safe_readLines <- safely(readLines)

# Use the safe_readLines() function with map(): html
html <- map(urls, safe_readLines)

# Call str() on html
str(html)

# Extract the result from one of the successful elements
map(html, "result")

# Extract the error from the element that was unsuccessful
map(html, "error")

这里提供了提取result和error的方式 [@WickhamWritingFunctions43]。

possibly函数解释

possibly_some_function = possibly(some_function, otherwise = "something wrong here")是safely的简单版本。

pwalk批量操作

看了一下 @Wickham2017R 的书，真是不错啊，不小心重新看一下， 如获至宝。 例如，

@Wickham2017R [pp. 336]提到批量保存ggplot图片的方式。

library(ggplot2)
    plots <- mtcars %>%
      split(.$cyl) %>%
      map(~ggplot(., aes(mpg, wt)) + geom_point())
    paths <- stringr::str_c(names(plots), ".pdf")
pwalk(list(paths, plots), ggsave, path = getwd())

• 使用了split和map函数，批量使用函数ggplot。
• str_c用于图片命名，功效类似于paste。
• 最后最强的是pwalk，给予一个list，然后使用ggsave。

rerun: resample

{r} library(purrr) 10 %>% rerun(rnorm(5)) 10 %>% rerun(x = rnorm(5),y= rnorm(5)) %>% map_dbl(~ cor(.x$x, .x$y))

map替代mutate

@FAYpurrrstatistics 提供的例子。

{r} library(purrr) airquality %>% glimpse()

shapiro.test: Performs the Shapiro-Wilk test of normality.

{r} airquality %>% map(shapiro.test)

keep替代filter

{r} airquality %>% map(shapiro.test)%>% keep(~ .x$p.value > 0.05) @FAYpurrrstatistics 提供的例子。 keep业务上非常方便，直接选择shapiro.test反馈的结果.$...之一作为筛选条件，不需要建立data.frame再使用filter函数。

map_if替代mutate_if

{r} map_if(iris, is.numeric, shapiro.test)

map_if allows you to map only on numeric variables in your data.frame

因此map功效远大于mutate， map将每个columns当成一个element。 @FAYpurrrstatistics 提供的例子。

{r} numbers <- list(11, 12, 13, 14) is_even <- function(x){ !as.logical(x %% 2) } map_if(numbers, is_even, sqrt)

map_if函数的例子来自 @Rodrigues2017。

map_at

{r} map_at(numbers, c(1,3), sqrt)

map_at函数的例子来自 @Rodrigues2017。

transpose函数

这里主要介绍transpose函数[@WickhamWritingFunctions44]。

例如

{r eval=F} nested_list <- list( x1 = list(a = 1, b = 2), x2 = list(a = 3, b = 4) )

当我们想要提取x1中的a时，我们需要写nested_list[[x1]][[a]]，按着正序写的。 但是当我们对listnested_list使用transpose函数后，可以倒序写，transpose(nested_list)[[a]][[x1]]。 因此当我们的需要提取一个list中，非常inside的数据时，并且，都是统一命名，例如a，这个方法会非常管用。

```{r eval=F} # Define save_readLines() and html safe_readLines <- safely(readLines) html <- map(urls, safe_readLines)

Examine the structure of transpose(html)

str(transpose(html))

Extract the results: res

res <- transpose(html)[[“result”]]

Extract the errors: errs

errs <- transpose(html)[[“error”]]

这里可以看到，以`result`和`error`的list顺序排在了前面，不是原来的`example`、`rproj`和`asdf`。


```
# Initialize some objects
safe_readLines <- safely(readLines)
html <- map(urls, safe_readLines)
res <- transpose(html)[["result"]]
errs <- transpose(html)[["error"]]

# Create a logical vector is_ok
is_ok <- map_lgl(errs, is_null)

# Extract the successful results
res[is_ok]

# Extract the input from the unsuccessful results
urls[!is_ok]

最后一步就提取出来那一个元素出了问题urls[!is_ok]。 [@WickhamWritingFunctions45]

transpose和modify_depth

{r} numbers_with_error <- list(1, 2, 3, "spam", 4) numbers_with_error safe_sqrt <- safely(sqrt, otherwise = NA_real_) safe_result_list <- numbers_with_error %>% map(safe_sqrt) safe_result_list transposed_list <- transpose(safe_result_list) transposed_list transposed_list %>% modify_depth(2, is_null)

modify_depth可以直接使用函数作用于对应的层级 @Rodrigues2017。

map的替换

```{r} mylist <- list( list01= list( var01 = 1:3 ,var02 = 1:5 ,var03 = 1:7 ) ,list02= list( var01 = 1:9 ,var02 = 1:11 ,var03 = 1:13 )

)

str(mylist)

library(purrr) mylist %>% transpose() %>% .$var02 %>% unlist %>% table()

or TBT8’s answer

https://stackoverflow.com/a/53213468/8625228

mylist %>% map(~ .[[‘var02’]] == 1) %>% unlist %>% sum

# Set names of list elements

```
name_element <- c("sqrt()", "ok?")
transposed_list %>% set_names(name_element)

set_names函数来自purrr包，详见 复制一个data.frame。

reduce反馈最后一个值

{r} numbers reduce(numbers, `*`)

还可以批量完成计算。 reduce函数的例子来自 @Rodrigues2017。

{r} set.seed(123) mat1 <- matrix(rnorm(10), nrow = 2) mat2 <- matrix(rnorm(10), nrow = 2) mat3 <- matrix(rnorm(10), nrow = 2) list_mat <- list(mat1, mat2, mat3) reduce(list_mat, `+`)

想象从每一个矩阵的对应位置$A_{i,j}$取出一个值，作为一个list，一起完成+的计算。 reduce函数的例子来自 @Rodrigues2017。

reduce 多表合并

{r} df1 <- as.data.frame(mat1) df2 <- as.data.frame(mat2) df3 <- as.data.frame(mat3) list_df <- list(df1, df2, df3) reduce(list_df, dplyr::full_join)

reduce函数的例子来自 @Rodrigues2017。

因此可以多表read进行合并。

as.list(list.files()) %>% map(function(x) read.csv(x)) %>% reduce(rbind)

accumulate和accumulate_right

{r} accumulate(numbers, `*`) accumulate_right(numbers, `*`)

• accumulate是按左向右滚动
• accumulate_right是按右向左滚动 例子来自 @Rodrigues2017。

``{r} 1:3 %>% accumulate(+) 1:10 %>% accumulate_right(*`)

From Haskell’s scanl documentation

1:10 %>% accumulate(max, .init = 5)

Understanding the arguments .x and .y when .f

is a lambda function

.x is the accumulating value

1:10 %>% accumulate(~ .x) 1:10 %>% accumulate(~ 1) # .y is element in the list 1:10 %>% accumulate(~ .y)

library(dplyr) library(ggplot2)

set.seed(123) rerun(5, rnorm(100)) %>% set_names(paste0(“sim”, 1:5)) %>% map(~ accumulate(., ~ .05 + .x + .y)) %>% map_dfr(~ data_frame(value = .x, step = 1:100), .id = “simulation”) %>% ggplot(aes(x = step, y = value)) + geom_line(aes(color = simulation)) + ggtitle(“Simulations of a random walk with drift”)

`rerun`参考 \@ref(rerunresample)。

# 相关系数$\rho$和p value分析

@FAYpurrrstatistics 提供的例子。
使用函数`tidy_comb_all`[@tidystringdist]进行。

```
library(tidystringdist)
comb <- tidy_comb_all(names(airquality))
comb

{r} bulk_cor <- comb %>% pmap(~ cor.test(airquality[[.x]], airquality[[.y]])) %>% map_df(broom::tidy) %>% bind_cols(comb, .) bulk_cor

[[.x]] 这种写法非常优秀，达到了哈希匹配的方式。

partial提前预设参数，进行函数封装

@FAYpurrrstatistics 提供的例子。

{r eval=F} titanic <- read_csv("../../../picbackup/titanic.csv") set.seed(20) train <- rerun(20, sample_frac(titanic, size = 0.8)) validation <- map(train, ~ anti_join(titanic, .x))

• rerun: 实现bootstrap的功能。
• anti_join: 实现train and test split，并且不用建立index，一行代码完成。

{r eval=F} map_int(validation, nrow) %>% every(~ .x == 262)

检验每个测试集的样本量一样。

{r eval=F} library(rpart) rpart_pimped <- partial(rpart, formula = survived ~ sex, method = "class") res <- map(train, ~ rpart_pimped(data = .x))

{r eval=F} prediction <- map2(validation, res, ~ predict(.y, .x, type = "class")) w_prediction <- map2(validation, prediction, ~ mutate(.x, prediction = .y))

{r eval=F} library(caret) conf_mats <- map(w_prediction, ~ confusionMatrix(.x$prediction, .x$survived))

Error:dataandreferenceshould be factors with the same levels.这里有报错。 应该是$y$和$\hat y$长度不一样。

{r eval=F} map_dbl(conf_mats, ~ .x$byClass["Sensitivity"]) %>% every(~ .x > 0.8)

some 和 every

{r} mtcars %>% some(is.infinite)

• 这使得infinity的检验可以产生类似于anyNA的效果。
• some(): 列表中的某些元素是否满足要求？ 返回结果TRUE/FALSE
• every(): 列表中的每个元素是否满足要求？[@邬书豪purrr]

Use list, UDF in map*

my_summarise_f函数参考 @Rodriguespurrrpmap。

{r} my_summarise_f <- function(dataset, cols, funcs){ dataset %>% summarise_at(vars(!!!cols), funs(!!!funcs)) }

{r} mtcars %>% my_summarise_f(quos(mpg, drat, hp), quos(mean, sd, max))

```{r} data_list = list(mtcars, iris)

cols_mtcars = quos(mpg, drat, hp)
cols_iris = quos(Sepal.Length, Sepal.Width)

cols_list = list(cols_mtcars, cols_iris)

funcs_mtcars = quos(mean, sd, max)
funcs_iris = quos(median, min)

funcs_list = list(funcs_mtcars, funcs_iris)

map2(data_list, cols_list, my_summarise_f, funcs = quos(mean, sd, max))

pmap( list( dataset = data_list, cols = cols_list, funcs = funcs_list ), my_summarise_f) ```

反馈 NULL 的解决情况

map 反馈 NULL 的情况有些讨论Github Issue 231，参考Stack Overflow使用 if else 完成。

具体参考github的代码。

参考文献