library(tidyverse)

1 自定义函数

在 R 中，函数是执行特定任务的代码块，可以接受输入参数并返回输出结果。自定义函数可以帮助我们封装重复使用的代码，提高代码的可读性和维护性。

函数：

实际上是一段代码的封装，就可以复用，
提供输入，执行函数体，返回输出，
输入，由功能决定，必须都有才能往下计算，
输出，你想要几个返回结果都行。

1.1 编写自定义函数

加入我们想设计一个函数，将百分制分数转化为三个级别(例如大于80分则评级为”优”)，我们可以按照以下步骤来定义这个函数：

先写一个具体的输入，测试单个输入的结果，确保函数逻辑正确。

score <- 85

if (score > 80) {
  grade <- "优"
} else if (score > 60) {
  grade <- "良"
} else {
  grade <- "差"
}
grade

[1] "优"

定义函数主体：函数名 <- function(参数列表) { 函数体 }，注意要写好注释，说明函数的功能、输入参数和输出结果。

convert_score_to_grade <- function(score){
  # 将百分制转化为三级制分数
  # 输入：1个百分制分数（double）
  # 输出：1个三级制分数（character）
}

将第1步调试好的代码体放入函数体

convert_score_to_grade <- function(score){
  # 将百分制转化为三级制分数
  # 输入：1个百分制分数（double）
  # 输出：1个三级制分数（character）
  
  if (score > 80) {
    grade <- "优"
  } else if (score > 60) {
    grade <- "良"
  } else {
    grade <- "差"
  }
  
  return(grade)
}

1.2 调用函数

convert_score_to_grade(score = 57)

[1] "差"

值得注意的是，在调用函数时，参数可以通过位置传递（positional argument）或命名传递（named argument）：

函数的输入参数可以有默认值，例如 function(score = 0)，如果调用函数时没有提供参数值，则使用默认值。
如果参数写为了参数名 =，则调用函数时可以通过命名传递参数值，例如 convert_score_to_grade(score = 85)，这样可以提高代码的可读性。
建议在定义函数时，尽量使用命名参数，并为参数提供默认值，这样可以使函数更灵活和易于使用。

1.3 函数的向量化改写

可以使用for循环来实现函数的向量化改写，但在R中，向量化操作通常更高效且更简洁。我们可以使用case_when()函数来实现向量化改写：

convert_score_to_grade_vectorized <- function(scores) {
  # 将百分制转化为三级制分数
  # 输入：一个百分制分数的向量（double）
  # 输出：一个三级制分数的向量（character）

  grades <- case_when(
    scores > 80 ~ "优",
    scores > 60 ~ "良",
    TRUE ~ "差"
  )

  return(grades)
}

# 测试向量化函数
convert_score_to_grade_vectorized(c(85, 75, 55))

[1] "优" "良" "差"

1.4 返回多个值

R 不支持直接返回多个值，只能将多个返回值打包成 1 个列表（如果可以，打包成 1 个数据框也行）。

# 计算均值和标准差
mean_std <- function(x) {
  n = length(x)
  mu = mean(x)
  std = sqrt(sum((x - mu)^2) / (n - 1))
  list(mean = mu, std = std)
}

x <- c(100, 62, 65, 34)
mean_std(x)

$mean
[1] 65.25

$std
[1] 27.0478

1.5 默认参数值

调用函数时，若不提供其实参，则按默认值。

mean_std_1 <- function(x, type = 1) {
  n = length(x)
  mu = mean(x)

  if (!type %in% c(1, 2)) {
    stop("Invalid type. Use 1 for population std and 2 for sample std.")
  }

  std = case_when(
    type == 1 ~ sqrt(sum((x - mu)^2) / n), # 总体标准差
    type == 2 ~ sqrt(sum((x - mu)^2) / (n - 1)), # 样本标准差
  )
  list(mean = mu, std = std)
}

# 测试默认参数值
mean_std_1(x) # 使用默认参数type = 1

$mean
[1] 65.25

$std
[1] 23.42408

mean_std_1(x, type = 2) # 指定参数type = 2

$mean
[1] 65.25

$std
[1] 27.0478

# mean_std_1(x, type = 3) # 无效参数值，触发错误

1.6 `...`参数

...参数允许函数接受任意数量的参数，这些参数可以在函数体内通过list(...)来访问。这对于编写灵活的函数非常有用，特别是当你不确定需要多少参数时。例如，可以使用...参数来实现一个能够处理任意数量输入的函数。

my_sum <- function(...) {
  sum(...)
}
my_sum(1, 2, 3, 4)

[1] 10

Important

R 自带函数，直接使用；
R 包函数，加载 R 包或包名::函数()使用；
多查阅函数帮助：?函数名

2 泛函式循环迭代

purrr包是一个非常强大的包，它提供了一种更简洁的方式来处理循环和迭代。它的核心思想是使用函数式编程的方式来处理数据，而不是使用传统的for循环。

循环迭代，本质上是将一个函数依次应用到序列¹的每一个元素上，在purrr中，这个函数就是map()。map()函数的基本语法为purrr::map(.x, .f, ...)。

在最新的purrr中，为使逻辑更清晰一致，已经建议弃用map_df/map_dfr/map_dfc这些一步到位的操作，改用map+list_bind/list_cbind。

2.1 修改多列

2.1.1 选择多列并调用单个函数

library(tidyverse)
df <- tibble(
  a = rnorm(10),
  b = rnorm(10),
  c = rnorm(10),
  d = rnorm(10)
)

df |>
  summarise(
    n = n(),
    a = median(a),
    b = median(b),
    c = median(c),
    d = median(d),
  )

# A tibble: 1 × 5
      n      a      b     c     d
  <int>  <dbl>  <dbl> <dbl> <dbl>
1    10 -0.174 -0.401 0.517 0.119

上述代码在计算df各列时，median()函数被重复执行了四次，意味着我们进行了多次的复制粘贴操作，这与“在代码中永远不要复制粘贴超过2次”的原则相违背。试想如果数据集中有10个以上的列，多次进行复制粘贴不仅繁琐，而且容易产生错误。幸好，在tidyverse中的acorss()函数就排上了用场。

across()是一个功能异常强大的函数，它有3个关键的参数：

.cols，操作的目标列，可以是多列，where()、which()、everything()、starts_with()等在此处同样适用。
.fns，对目标列进行操作的函数，同样可以是多个函数，如果是多个函数，则需要以列表的形式传入。
.names，控制输出列的名称，在与mutate()连用时非常有用。

那么上述代码可以使用across()进行改写。

df |>
  summarise(
    across(a:d, median)
  )

# A tibble: 1 × 4
       a      b     c     d
   <dbl>  <dbl> <dbl> <dbl>
1 -0.174 -0.401 0.517 0.119

Important

across()函数有两个使用注意点一定要牢记：

across()不能单独使用，它必须在summarise()、mutate()等函数中使用。
across()的.fns传入函数时，函数后不需要加括号。如果函数中需要传入参数，则需要使用匿名函数。有关匿名函数，在下节中会有描述。

2.1.2 选择多列并调用多个函数

# 生成一个可操作的数据集
rnorm_na <- function(n, n_na, mean = 0, sd = 1) {
  sample(c(rnorm(n - n_na, mean = mean, sd = sd), rep(NA, n_na)))
} # 生成包含缺失值的正态分布数列，项数为n-n_na，其中有n-n_na项缺失值
df_miss <- tibble(
  a = rnorm_na(5, 1),
  b = rnorm_na(5, 1),
  c = rnorm_na(5, 2),
  d = rnorm(5)
)

# 计算df_miss各列的中数，计算时需要去掉缺失值
df_miss |>
  summarise(
    across(a:d, \(x) median(x, na.rm = TRUE))
  )

# A tibble: 1 × 4
      a      b      c      d
  <dbl>  <dbl>  <dbl>  <dbl>
1 0.124 -0.583 -0.673 -0.326

Warning

上述代码的匿名函数写作了\(x) median(x, na.rm = TRUE)，而我们更熟悉的写法是~median(.x, na.rm = TRUE)。Hadley之所以修改写法基于以下两个方面：

.x的写法只适用于tidyverse函数内。
.x有时指代比较抽象，不便理解。

基于此，Hadley建议使用\(x)的写法，例如~.x + 1建议写为\(x) x + 1

如果我们系统同时计算数据集中每列的中数并求和呢？这就需要调用两个函数。

df_miss |>
  summarise(
    across(
      a:d, # 一定要指定列
      list(
        median = \(x) median(x, na.rm = TRUE),
        sum = \(x) sum(x, na.rm = TRUE)
      )
    )
  )

# A tibble: 1 × 8
  a_median a_sum b_median b_sum c_median c_sum d_median d_sum
     <dbl> <dbl>    <dbl> <dbl>    <dbl> <dbl>    <dbl> <dbl>
1    0.124  1.40   -0.583 -2.23   -0.673 -1.20   -0.326 -4.10

上述代码输出的结果列的名称是使用一个类似于 {.col}_{.fn} 的 glue 规范命名的，其中 .col 是原始列的名称，.fn 是函数的名称。我们可以使用 .names 参数来提供您自己的 glue 规范。

df_miss |>
  summarise(
    across(
      a:d, # 一定要指定列
      list(
        median = \(x) median(x, na.rm = TRUE),
        sum = \(x) sum(x, na.rm = TRUE)
      ),
      .names = "{.fn}-{.col}"
    )
  )

# A tibble: 1 × 8
  `median-a` `sum-a` `median-b` `sum-b` `median-c` `sum-c` `median-d` `sum-d`
       <dbl>   <dbl>      <dbl>   <dbl>      <dbl>   <dbl>      <dbl>   <dbl>
1      0.124    1.40     -0.583   -2.23     -0.673   -1.20     -0.326   -4.10

.names参数在与mutate()连用时非常有用，通常用来对比新生成的列与原有列的不同。

# 求数据集的绝对值
df_miss |>
  mutate(
    across(a:d, \(x) abs(x), .names = "{.col}_abs")
  )

# A tibble: 5 × 8
        a      b      c       d   a_abs  b_abs  c_abs  d_abs
    <dbl>  <dbl>  <dbl>   <dbl>   <dbl>  <dbl>  <dbl>  <dbl>
1 -0.213  -0.967  0.175 -0.0340  0.213   0.967  0.175 0.0340
2  1.37   -0.198 NA     -0.272   1.37    0.198 NA     0.272 
3 NA      -1.33  -0.706 -1.38   NA       1.33   0.706 1.38  
4  0.154  NA     NA     -0.326   0.154  NA     NA     0.326 
5  0.0939  0.270 -0.673 -2.09    0.0939  0.270  0.673 2.09

2.2 行操作

across()和summarize()，mutate()匹配度很好，但都是针对列的操作，有没有针对filter()的行的操作呢？

dplyr中if_any()，if_all()两个函数功能就是across()针对行操作的变种。我们具体来看：

# 选择包含缺失值的所有行
x <- df_miss |>
  filter(
    if_any(a:d, is.na)
  )

# 选择全是缺失值的所有行
df_miss |>
  filter(
    if_all(a:d, is.na)
  )

# A tibble: 0 × 4
# ℹ 4 variables: a <dbl>, b <dbl>, c <dbl>, d <dbl>

这部分更详细的说明可参看:https://bookdown.org/wangminjie/R4DS/tidyverse-beauty-of-across2.html#dplyr-1.0.4-if_any-and-if_all。

2.3 在自定义函数中使用across()

expand_dates <- function(df) {
  df |>
    mutate(across(where(is.Date), list(year = year, month = month, day = mday)))
}

上述函数的作用为：将所有日期列扩展为年、月和日列：

df_date <- tibble(
  name = c("Amy", "Bob"),
  date = ymd(c("2009-08-03", "2010-01-16"))
)
df_date

# A tibble: 2 × 2
  name  date      
  <chr> <date>    
1 Amy   2009-08-03
2 Bob   2010-01-16

df_date |>
  expand_dates()

# A tibble: 2 × 5
  name  date       date_year date_month date_day
  <chr> <date>         <dbl>      <dbl>    <int>
1 Amy   2009-08-03      2009          8        3
2 Bob   2010-01-16      2010          1       16

across()还可以与非标准性评估(tidy eval)结合，实现给一个参数传入多个列的操作，只要注意将这些传入多个列的参数用两个大括号括起来。关于非标准性评估(tidy eval)，可参看这里和这里。还有我自己的blogTidyverse包中的across()函数

2.4 与pivot_longer()连用

pivot_longer()和across()间有许多有趣的联系，它们可以实现相同的操作并得到一致的结果。我们看一个例子，例如我们需要计算df数据集每列的中数和众数。

使用across()：我们可以看到结果是一个宽表格，每列的名称的形式为”列名_函数名”。

df |>
  summarise(
    across(a:d, list(median = median, mean = mean))
  )

# A tibble: 1 × 8
  a_median    a_mean b_median b_mean c_median c_mean d_median d_mean
     <dbl>     <dbl>    <dbl>  <dbl>    <dbl>  <dbl>    <dbl>  <dbl>
1   -0.174 -0.000982   -0.401 -0.514    0.517  0.446    0.119  0.545

使用pivot_longer()：输出结果是一个整洁的表格。

long <- df |>
  pivot_longer(a:d) |>
  group_by(name) |>
  summarise(
    median = median(value),
    mean = mean(value)
  )
long

# A tibble: 4 × 3
  name  median      mean
  <chr>  <dbl>     <dbl>
1 a     -0.174 -0.000982
2 b     -0.401 -0.514   
3 c      0.517  0.446   
4 d      0.119  0.545

如果我们希望使用pivot_longer()的同时，使输出的结果与across()输出结果相同呢?

long |>
  pivot_wider(
    names_from = name,
    values_from = c(median, mean),
    names_vary = "slowest",
    names_glue = "{name}_{.value}"
  )

# A tibble: 1 × 8
  a_median    a_mean b_median b_mean c_median c_mean d_median d_mean
     <dbl>     <dbl>    <dbl>  <dbl>    <dbl>  <dbl>    <dbl>  <dbl>
1   -0.174 -0.000982   -0.401 -0.514    0.517  0.446    0.119  0.545

这个操作在我们无法使用across()的时候非常有用：即当我们需要同时计算一组多列的时候。例如，数据框同时包含了数值列和权重列，我们需要计算加权平均值时(我理解其实就是数据不整洁的时候)：

df_paired <- tibble(
  a_val = rnorm(10),
  a_wts = runif(10),
  b_val = rnorm(10),
  b_wts = runif(10),
  c_val = rnorm(10),
  c_wts = runif(10),
  d_val = rnorm(10),
  d_wts = runif(10)
)
df_paired

# A tibble: 10 × 8
     a_val  a_wts  b_val   b_wts   c_val  c_wts  d_val d_wts
     <dbl>  <dbl>  <dbl>   <dbl>   <dbl>  <dbl>  <dbl> <dbl>
 1  0.944  0.0491  2.14  0.676    0.270  0.321  -0.629 0.111
 2  2.49   0.826   0.476 0.00893 -1.25   0.310  -1.03  0.693
 3  0.941  0.263  -0.799 0.944    0.753  0.608   0.483 0.786
 4 -0.233  0.175  -0.469 0.409   -1.33   0.0464 -0.508 0.982
 5 -0.0734 0.305  -0.663 0.432    0.615  0.148  -0.926 0.999
 6  0.761  0.380   1.38  0.261    0.168  0.271   0.273 0.713
 7 -1.22   0.208   1.50  0.0911   0.558  0.504  -1.68  0.410
 8  0.244  0.0755 -0.824 0.865    0.394  0.865   0.617 0.595
 9 -0.823  0.402   0.367 0.605   -0.0253 0.397   0.828 0.987
10 -0.0627 0.239  -0.967 0.422    2.00   0.638  -2.49  0.842

df_paired数据框是不整洁的，我们无法使用across()函数，此时我们需要进行转换：

df_long <- df_paired |>
  pivot_longer(
    everything(),
    names_to = c("group", ".value"),
    names_sep = "_"
  )
df_long

# A tibble: 40 × 3
   group    val     wts
   <chr>  <dbl>   <dbl>
 1 a      0.944 0.0491 
 2 b      2.14  0.676  
 3 c      0.270 0.321  
 4 d     -0.629 0.111  
 5 a      2.49  0.826  
 6 b      0.476 0.00893
 7 c     -1.25  0.310  
 8 d     -1.03  0.693  
 9 a      0.941 0.263  
10 b     -0.799 0.944  
# ℹ 30 more rows

df_long |>
  group_by(group) |>
  summarise(mean = weighted.mean(val, wts)) |>
  pivot_wider(
    names_from = group,
    values_from = mean,
    names_glue = "{group}_{.value}"
  )

# A tibble: 1 × 4
  a_mean  b_mean c_mean d_mean
   <dbl>   <dbl>  <dbl>  <dbl>
1  0.682 -0.0395  0.516 -0.454

Footnotes

序列由一系列可以根据位置索引的元素构成，向量、列表、数据框都是经常用作序列的数据结构。↩︎

1 自定义函数

1.1 编写自定义函数

1.2 调用函数

1.3 函数的向量化改写

1.4 返回多个值

1.5 默认参数值

1.6 ...参数

2 泛函式循环迭代

2.1 修改多列

2.1.1 选择多列并调用单个函数

2.1.2 选择多列并调用多个函数

2.2 行操作

2.3 在自定义函数中使用across()

2.4 与pivot_longer()连用

Footnotes

1.6 `...`参数