1 map

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

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 。 Wickham et al. (n.d.) 在第四和第五部分主要解释了这两个函数。

2 safely()函数

# 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")

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

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

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")

3 possibly函数解释

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

4 pwalk批量操作

看了一下 Wickham and Grolemund (2017) 的书，真是不错啊，不小心重新看一下， 如获至宝。 例如，

Wickham and Grolemund (2017, 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。

5 rerun: resample

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

6 map替代mutate

FAY (2017) 提供的例子。

library(purrr)
airquality %>% glimpse()

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

airquality %>% map(shapiro.test)

7 keep替代filter

airquality %>%
  map(shapiro.test)%>%
  keep(~ .x$p.value > 0.05)

FAY (2017) 提供的例子。 keep业务上非常方便，直接选择shapiro.test反馈的结果.$...之一作为筛选条件，不需要建立data.frame再使用filter函数。

8 map_if替代mutate_if

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。 FAY (2017) 提供的例子。

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

map_if函数的例子来自 Rodrigues (2017)。

9 map_at

map_at(numbers, c(1,3), sqrt)

map_at函数的例子来自 Rodrigues (2017)。

10 transpose函数

这里主要介绍transpose函数(Wickham 2018d)。

例如

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，这个方法会非常管用。

# 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]。 (Wickham 2018c)

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)

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

11 Set names of list elements

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

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

12 reduce反馈最后一个值

numbers
reduce(numbers, `*`)

还可以批量完成计算。 reduce函数的例子来自 Rodrigues (2017)。

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函数的例子来自 Rodrigues (2017)。

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)

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

13 accumulate和accumulate_right

accumulate(numbers, `*`)
accumulate_right(numbers, `*`)

• accumulate是按左向右滚动
• accumulate_right是按右向左滚动 例子来自 Rodrigues (2017)。

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参考 5。

14 相关系数\(\rho\)和p value分析

FAY (2017) 提供的例子。 使用函数tidy_comb_all(Fay 2018)进行。

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

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

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

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

FAY (2017) 提供的例子。

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，一行代码完成。

map_int(validation, nrow) %>% every(~ .x == 262)

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

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

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

library(caret)
conf_mats <- map(w_prediction, ~ confusionMatrix(.x$prediction, .x$survived))

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

map_dbl(conf_mats, ~ .x$byClass["Sensitivity"]) %>% every(~ .x > 0.8)

16 some 和 every

mtcars %>%
    some(is.infinite)

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

17 Use list, UDF in map*

my_summarise_f函数参考 Rodrigues (2018)。

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

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

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)

18 反馈 NULL 的解决情况

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

具体参考github的代码。