第 13 章 dplyr进阶

本章主要关注dplyr的一些应用。

13.1 导入数据

今天讲一个关于企鹅的数据故事。

13.2 变量含义

variable class description
species character 企鹅种类 (Adelie, Gentoo, Chinstrap)
island character 所在岛屿 (Biscoe, Dream, Torgersen)
bill_length_mm double 嘴峰长度 (单位毫米)
bill_depth_mm double 嘴峰深度 (单位毫米)
flipper_length_mm integer 鰭肢长度 (单位毫米)
body_mass_g integer 体重 (单位克)
sex character 性别
year integer 记录年份

13.3 简单回顾

13.3.1 选择”bill_“开始的列

penguins %>% select(bill_length_mm, bill_depth_mm)
penguins %>% select(starts_with("bill_"))
## # A tibble: 333 × 2
##   bill_length_mm bill_depth_mm
##            <dbl>         <dbl>
## 1           39.1          18.7
## 2           39.5          17.4
## 3           40.3          18  
## 4           36.7          19.3
## 5           39.3          20.6
## 6           38.9          17.8
## # … with 327 more rows

13.3.2 选择”_mm”结尾的列

penguins %>% select(bill_length_mm, bill_depth_mm, flipper_length_mm)
penguins %>% select(ends_with("_mm"))
## # A tibble: 333 × 3
##   bill_length_mm bill_depth_mm flipper_length_mm
##            <dbl>         <dbl>             <int>
## 1           39.1          18.7               181
## 2           39.5          17.4               186
## 3           40.3          18                 195
## 4           36.7          19.3               193
## 5           39.3          20.6               190
## 6           38.9          17.8               181
## # … with 327 more rows

13.3.3 选择含有”length”的列

penguins %>% select(bill_length_mm, flipper_length_mm)
penguins %>% select(contains("length"))
## # A tibble: 333 × 2
##   bill_length_mm flipper_length_mm
##            <dbl>             <int>
## 1           39.1               181
## 2           39.5               186
## 3           40.3               195
## 4           36.7               193
## 5           39.3               190
## 6           38.9               181
## # … with 327 more rows

13.3.4 选择数值型的列

penguins %>% select(where(is.numeric))
## # A tibble: 333 × 5
##   bill_length_mm bill_depth_mm flipper_length_mm
##            <dbl>         <dbl>             <int>
## 1           39.1          18.7               181
## 2           39.5          17.4               186
## 3           40.3          18                 195
## 4           36.7          19.3               193
## 5           39.3          20.6               190
## 6           38.9          17.8               181
## # … with 327 more rows, and 2 more variables:
## #   body_mass_g <int>, year <int>

13.3.5 选择字符串类型的列

penguins %>% select(where(is.character))
## # A tibble: 333 × 0

13.3.6 选择字符串类型以外的列

penguins %>% select(!where(is.character))
## # A tibble: 333 × 8
##   species island    bill_length_mm bill_depth_mm
##   <fct>   <fct>              <dbl>         <dbl>
## 1 Adelie  Torgersen           39.1          18.7
## 2 Adelie  Torgersen           39.5          17.4
## 3 Adelie  Torgersen           40.3          18  
## 4 Adelie  Torgersen           36.7          19.3
## 5 Adelie  Torgersen           39.3          20.6
## 6 Adelie  Torgersen           38.9          17.8
## # … with 327 more rows, and 4 more variables:
## #   flipper_length_mm <int>, body_mass_g <int>,
## #   sex <fct>, year <int>

13.3.7 可以用多种组合来选择

penguins %>% select(species, starts_with("bill_"))
## # A tibble: 333 × 3
##   species bill_length_mm bill_depth_mm
##   <fct>            <dbl>         <dbl>
## 1 Adelie            39.1          18.7
## 2 Adelie            39.5          17.4
## 3 Adelie            40.3          18  
## 4 Adelie            36.7          19.3
## 5 Adelie            39.3          20.6
## 6 Adelie            38.9          17.8
## # … with 327 more rows

13.3.8 返回向量还是数据框

对应数据框my_tibble, 注意返回向量还是数据框的区别

  • 返回向量
my_tibble[["x"]] 

my_tibble$x 

my_tibble %>% 
  pull(x)
  • 返回数据框
my_tibble["x"]

my_tibble %>% 
  select(x)

13.3.9 选择全部为0的列

tb <- tibble(
  x = 1:5,
  y = 0,
  z = 5:1,
  w = 0
)
tb
## # A tibble: 5 × 4
##       x     y     z     w
##   <int> <dbl> <int> <dbl>
## 1     1     0     5     0
## 2     2     0     4     0
## 3     3     0     3     0
## 4     4     0     2     0
## 5     5     0     1     0
myfun <- function(x) sum(x) == 0
tb %>%
  select(where(myfun))
## # A tibble: 5 × 2
##       y     w
##   <dbl> <dbl>
## 1     0     0
## 2     0     0
## 3     0     0
## 4     0     0
## 5     0     0
# or
tb %>%
  select(where(~sum(.x) == 0))
## # A tibble: 5 × 2
##       y     w
##   <dbl> <dbl>
## 1     0     0
## 2     0     0
## 3     0     0
## 4     0     0
## 5     0     0

课堂练习:剔除全部为NA的列

df <- tibble(
  x = c(NA, NA, NA),
  y = c(2, 3, NA),
  z = c(NA, 5, NA)
)


df %>%
  select(where(~ !all(is.na(.x))))
## # A tibble: 3 × 2
##       y     z
##   <dbl> <dbl>
## 1     2    NA
## 2     3     5
## 3    NA    NA
# or
df %>%
  filter(
    if_any(everything(), ~ !is.na(.x))
  )
## # A tibble: 2 × 3
##   x         y     z
##   <lgl> <dbl> <dbl>
## 1 NA        2    NA
## 2 NA        3     5

13.3.10 寻找男企鹅

函数 filter() 中的逻辑运算符

Operator Meaning
== Equal to
> Greater than
< Less than
>= Greater than or equal to
<= Less than or equal to
!= Not equal to
%in% in
is.na is a missing value (NA)
!is.na is not a missing value
& and
| or
penguins %>% filter(sex == "male")
## # A tibble: 168 × 8
##   species island    bill_length_mm bill_depth_mm
##   <fct>   <fct>              <dbl>         <dbl>
## 1 Adelie  Torgersen           39.1          18.7
## 2 Adelie  Torgersen           39.3          20.6
## 3 Adelie  Torgersen           39.2          19.6
## 4 Adelie  Torgersen           38.6          21.2
## 5 Adelie  Torgersen           34.6          21.1
## 6 Adelie  Torgersen           42.5          20.7
## # … with 162 more rows, and 4 more variables:
## #   flipper_length_mm <int>, body_mass_g <int>,
## #   sex <fct>, year <int>
penguins %>% filter(species %in% c("Adelie", "Gentoo"))
## # A tibble: 265 × 8
##   species island    bill_length_mm bill_depth_mm
##   <fct>   <fct>              <dbl>         <dbl>
## 1 Adelie  Torgersen           39.1          18.7
## 2 Adelie  Torgersen           39.5          17.4
## 3 Adelie  Torgersen           40.3          18  
## 4 Adelie  Torgersen           36.7          19.3
## 5 Adelie  Torgersen           39.3          20.6
## 6 Adelie  Torgersen           38.9          17.8
## # … with 259 more rows, and 4 more variables:
## #   flipper_length_mm <int>, body_mass_g <int>,
## #   sex <fct>, year <int>
penguins %>%
  filter(species == "Adelie" &  bill_length_mm > 40)
## # A tibble: 50 × 8
##   species island    bill_length_mm bill_depth_mm
##   <fct>   <fct>              <dbl>         <dbl>
## 1 Adelie  Torgersen           40.3          18  
## 2 Adelie  Torgersen           41.1          17.6
## 3 Adelie  Torgersen           42.5          20.7
## 4 Adelie  Torgersen           46            21.5
## 5 Adelie  Biscoe              40.6          18.6
## 6 Adelie  Biscoe              40.5          17.9
## # … with 44 more rows, and 4 more variables:
## #   flipper_length_mm <int>, body_mass_g <int>,
## #   sex <fct>, year <int>
penguins %>%
  filter(species == "Adelie", bill_length_mm > 40)
## # A tibble: 50 × 8
##   species island    bill_length_mm bill_depth_mm
##   <fct>   <fct>              <dbl>         <dbl>
## 1 Adelie  Torgersen           40.3          18  
## 2 Adelie  Torgersen           41.1          17.6
## 3 Adelie  Torgersen           42.5          20.7
## 4 Adelie  Torgersen           46            21.5
## 5 Adelie  Biscoe              40.6          18.6
## 6 Adelie  Biscoe              40.5          17.9
## # … with 44 more rows, and 4 more variables:
## #   flipper_length_mm <int>, body_mass_g <int>,
## #   sex <fct>, year <int>

课堂练习,说出以下代码的含义

penguins %>%
  filter(species == "Adelie", bill_length_mm == max(bill_length_mm) )

13.4 更多应用

希望介绍一个技术,对应一个应用场景

13.4.1 弱水三千,只取一瓢

penguins %>% 
  head()
## # A tibble: 6 × 8
##   species island    bill_length_mm bill_depth_mm
##   <fct>   <fct>              <dbl>         <dbl>
## 1 Adelie  Torgersen           39.1          18.7
## 2 Adelie  Torgersen           39.5          17.4
## 3 Adelie  Torgersen           40.3          18  
## 4 Adelie  Torgersen           36.7          19.3
## 5 Adelie  Torgersen           39.3          20.6
## 6 Adelie  Torgersen           38.9          17.8
## # … with 4 more variables: flipper_length_mm <int>,
## #   body_mass_g <int>, sex <fct>, year <int>
penguins %>% 
  tail()
## # A tibble: 6 × 8
##   species   island bill_length_mm bill_depth_mm
##   <fct>     <fct>           <dbl>         <dbl>
## 1 Chinstrap Dream            45.7          17  
## 2 Chinstrap Dream            55.8          19.8
## 3 Chinstrap Dream            43.5          18.1
## 4 Chinstrap Dream            49.6          18.2
## 5 Chinstrap Dream            50.8          19  
## 6 Chinstrap Dream            50.2          18.7
## # … with 4 more variables: flipper_length_mm <int>,
## #   body_mass_g <int>, sex <fct>, year <int>
penguins %>% 
  slice(1)
## # A tibble: 1 × 8
##   species island    bill_length_mm bill_depth_mm
##   <fct>   <fct>              <dbl>         <dbl>
## 1 Adelie  Torgersen           39.1          18.7
## # … with 4 more variables: flipper_length_mm <int>,
## #   body_mass_g <int>, sex <fct>, year <int>
penguins %>% 
  group_by(species) %>% 
  slice(1)
## # A tibble: 3 × 8
## # Groups:   species [3]
##   species   island    bill_length_mm bill_depth_mm
##   <fct>     <fct>              <dbl>         <dbl>
## 1 Adelie    Torgersen           39.1          18.7
## 2 Chinstrap Dream               46.5          17.9
## 3 Gentoo    Biscoe              46.1          13.2
## # … with 4 more variables: flipper_length_mm <int>,
## #   body_mass_g <int>, sex <fct>, year <int>

13.4.2 嘴峰长度最大那一行

三种方法

penguins %>%
  filter(bill_length_mm == max(bill_length_mm) )
## # A tibble: 1 × 8
##   species island bill_length_mm bill_depth_mm
##   <fct>   <fct>           <dbl>         <dbl>
## 1 Gentoo  Biscoe           59.6            17
## # … with 4 more variables: flipper_length_mm <int>,
## #   body_mass_g <int>, sex <fct>, year <int>
penguins %>% 
  arrange(desc(bill_length_mm)) %>% 
  slice(1)
## # A tibble: 1 × 8
##   species island bill_length_mm bill_depth_mm
##   <fct>   <fct>           <dbl>         <dbl>
## 1 Gentoo  Biscoe           59.6            17
## # … with 4 more variables: flipper_length_mm <int>,
## #   body_mass_g <int>, sex <fct>, year <int>
penguins %>% 
  slice_max(bill_length_mm)
## # A tibble: 1 × 8
##   species island bill_length_mm bill_depth_mm
##   <fct>   <fct>           <dbl>         <dbl>
## 1 Gentoo  Biscoe           59.6            17
## # … with 4 more variables: flipper_length_mm <int>,
## #   body_mass_g <int>, sex <fct>, year <int>

13.4.3 separate

tb <- tibble::tribble(
  ~day, ~price,
  1,   "30-45",
  2,   "40-95",
  3,   "89-65",
  4,   "45-63",
  5,   "52-42"
)
tb1 <- tb %>% 
  separate(price, into = c("low", "high"), sep = "-")
tb1
## # A tibble: 5 × 3
##     day low   high 
##   <dbl> <chr> <chr>
## 1     1 30    45   
## 2     2 40    95   
## 3     3 89    65   
## 4     4 45    63   
## 5     5 52    42

13.4.4 unite

tb1 %>% 
  unite(col = "price", c(low, high), sep = ":", remove = FALSE)
## # A tibble: 5 × 4
##     day price low   high 
##   <dbl> <chr> <chr> <chr>
## 1     1 30:45 30    45   
## 2     2 40:95 40    95   
## 3     3 89:65 89    65   
## 4     4 45:63 45    63   
## 5     5 52:42 52    42

13.4.5 distinct

distinct()处理的对象是data.frame;功能是筛选不重复的row;返回data.frame

df <- tibble::tribble(
  ~x, ~y, ~z,
  1, 1, 1,
  1, 1, 2,
  1, 1, 1,
  2, 1, 2,
  2, 2, 3,
  3, 3, 1
)
df
## # A tibble: 6 × 3
##       x     y     z
##   <dbl> <dbl> <dbl>
## 1     1     1     1
## 2     1     1     2
## 3     1     1     1
## 4     2     1     2
## 5     2     2     3
## 6     3     3     1
## # A tibble: 5 × 3
##       x     y     z
##   <dbl> <dbl> <dbl>
## 1     1     1     1
## 2     1     1     2
## 3     2     1     2
## 4     2     2     3
## 5     3     3     1
## # A tibble: 3 × 1
##       x
##   <dbl>
## 1     1
## 2     2
## 3     3
df %>%
  distinct(x, y)
## # A tibble: 4 × 2
##       x     y
##   <dbl> <dbl>
## 1     1     1
## 2     2     1
## 3     2     2
## 4     3     3
df %>%
  distinct(x, y, .keep_all = TRUE) # 只保留最先出现的row
## # A tibble: 4 × 3
##       x     y     z
##   <dbl> <dbl> <dbl>
## 1     1     1     1
## 2     2     1     2
## 3     2     2     3
## 4     3     3     1
df %>%
  distinct(
    across(c(x, y)),
    .keep_all = TRUE
  )
df %>%
  group_by(x) %>%
  distinct(y, .keep_all = TRUE)
## # A tibble: 4 × 3
## # Groups:   x [3]
##       x     y     z
##   <dbl> <dbl> <dbl>
## 1     1     1     1
## 2     2     1     2
## 3     2     2     3
## 4     3     3     1

n_distinct()处理的对象是vector;功能是统计不同的元素有多少个;返回一个数值

c(1, 1, 1, 2, 2, 1, 3, 3) %>% n_distinct()
## [1] 3
## [1] 3
## # A tibble: 3 × 2
##       x     n
##   <dbl> <int>
## 1     1     2
## 2     2     2
## 3     3     1

13.4.6 有关NA的计算

NA很讨厌,凡是它参与的四则运算,结果都是NA

sum(c(1, 2, NA, 4))
## [1] NA

所以需要事先把它删除,增加参数说明 na.rm = TRUE

sum(c(1, 2, NA, 4), na.rm = TRUE)
## [1] 7
mean(c(1, 2, NA, 4), na.rm = TRUE)
## [1] 2.333

13.4.7 寻找企鹅中的胖子

penguins %>% 
  mutate(
    body = if_else(body_mass_g > 4200, "you are fat", "you are fine")
)
## # A tibble: 333 × 9
##   species island    bill_length_mm bill_depth_mm
##   <fct>   <fct>              <dbl>         <dbl>
## 1 Adelie  Torgersen           39.1          18.7
## 2 Adelie  Torgersen           39.5          17.4
## 3 Adelie  Torgersen           40.3          18  
## 4 Adelie  Torgersen           36.7          19.3
## 5 Adelie  Torgersen           39.3          20.6
## 6 Adelie  Torgersen           38.9          17.8
## # … with 327 more rows, and 5 more variables:
## #   flipper_length_mm <int>, body_mass_g <int>,
## #   sex <fct>, year <int>, body <chr>

随堂练习:用考试成绩的均值代替缺失值

df <- tibble::tribble(
    ~name,     ~type, ~score,
  "Alice", "english",    80,
  "Alice",    "math",    NA,
    "Bob", "english",    70,
    "Bob",    "math",    69,
  "Carol", "english",    NA,
  "Carol",    "math",    90
  )
df
## # A tibble: 6 × 3
##   name  type    score
##   <chr> <chr>   <dbl>
## 1 Alice english    80
## 2 Alice math       NA
## 3 Bob   english    70
## 4 Bob   math       69
## 5 Carol english    NA
## 6 Carol math       90
df %>% 
  group_by(type) %>% 
  mutate(mean_score = mean(score, na.rm = TRUE)) %>% 
  mutate(newscore = if_else(is.na(score), mean_score, score))
## # A tibble: 6 × 5
## # Groups:   type [2]
##   name  type    score mean_score newscore
##   <chr> <chr>   <dbl>      <dbl>    <dbl>
## 1 Alice english    80       75       80  
## 2 Alice math       NA       79.5     79.5
## 3 Bob   english    70       75       70  
## 4 Bob   math       69       79.5     69  
## 5 Carol english    NA       75       75  
## 6 Carol math       90       79.5     90

13.4.8 给企鹅身材分类

penguins %>% 
  mutate(
   body = case_when(
     body_mass_g < 3500                       ~ "best",
     body_mass_g >= 3500 & body_mass_g < 4500 ~ "good",
     body_mass_g >= 4500 & body_mass_g < 5500 ~ "general",
     TRUE                                     ~ "other"
  )
)
## # A tibble: 333 × 9
##   species island    bill_length_mm bill_depth_mm
##   <fct>   <fct>              <dbl>         <dbl>
## 1 Adelie  Torgersen           39.1          18.7
## 2 Adelie  Torgersen           39.5          17.4
## 3 Adelie  Torgersen           40.3          18  
## 4 Adelie  Torgersen           36.7          19.3
## 5 Adelie  Torgersen           39.3          20.6
## 6 Adelie  Torgersen           38.9          17.8
## # … with 327 more rows, and 5 more variables:
## #   flipper_length_mm <int>, body_mass_g <int>,
## #   sex <fct>, year <int>, body <chr>

随堂练习:按嘴峰长度分成A, B, C, D 4个等级

penguins %>% 
  mutate(
    degree = case_when(
      bill_length_mm < 35                        ~ "A",
      bill_length_mm >= 35 & bill_length_mm < 45 ~ "B",
      bill_length_mm >= 45 & bill_length_mm < 55 ~ "C",
      TRUE                                       ~ "D"
  )
)
## # A tibble: 333 × 9
##   species island    bill_length_mm bill_depth_mm
##   <fct>   <fct>              <dbl>         <dbl>
## 1 Adelie  Torgersen           39.1          18.7
## 2 Adelie  Torgersen           39.5          17.4
## 3 Adelie  Torgersen           40.3          18  
## 4 Adelie  Torgersen           36.7          19.3
## 5 Adelie  Torgersen           39.3          20.6
## 6 Adelie  Torgersen           38.9          17.8
## # … with 327 more rows, and 5 more variables:
## #   flipper_length_mm <int>, body_mass_g <int>,
## #   sex <fct>, year <int>, degree <chr>

13.4.9 每种类型企鹅有多少只?

知识点:n()函数,统计当前分组数据框的行数

penguins %>%
  summarise(
    n = n()
  ) 
## # A tibble: 1 × 1
##       n
##   <int>
## 1   333
penguins %>%
  group_by(species) %>%
  summarise(
    n = n()
  )
## # A tibble: 3 × 2
##   species       n
##   <fct>     <int>
## 1 Adelie      146
## 2 Chinstrap    68
## 3 Gentoo      119

统计某个变量中各组出现的次数,可以使用count()函数

penguins %>% count(species)
## # A tibble: 3 × 2
##   species       n
##   <fct>     <int>
## 1 Adelie      146
## 2 Chinstrap    68
## 3 Gentoo      119

不同性别的企鹅各有多少

penguins %>% count(sex, sort = TRUE)
## # A tibble: 2 × 2
##   sex        n
##   <fct>  <int>
## 1 male     168
## 2 female   165

可以统计不同组合出现的次数

penguins %>% count(island, species)
## # A tibble: 5 × 3
##   island    species       n
##   <fct>     <fct>     <int>
## 1 Biscoe    Adelie       44
## 2 Biscoe    Gentoo      119
## 3 Dream     Adelie       55
## 4 Dream     Chinstrap    68
## 5 Torgersen Adelie       47

可以在count()里构建新变量,并利用这个新变量完成统计。 比如,统计嘴巴长度大于40的企鹅个数

  • 常规做法
penguins %>%
  filter(bill_length_mm > 40) %>% 
  summarise(
    n = n()
  )
## # A tibble: 1 × 1
##       n
##   <int>
## 1   237
penguins %>% count(longer_bill = bill_length_mm > 40)
## # A tibble: 2 × 2
##   longer_bill     n
##   <lgl>       <int>
## 1 FALSE          96
## 2 TRUE          237

解析思路:bill_length_mm > 40 比较算符 返回逻辑型向量,向量里面只有TRUR和FALSE两种值,因此上面的代码相当于统计TRUE有多少个,FALSE有多少个?

13.4.10 强制转换

矢量中的元素必须是相同的类型,但如果不一样呢,会发生什么? 这个时候R会强制转换成相同的类型。这就涉及数据类型的转换层级

  • character > numeric > logical
  • double > integer

比如这里会强制转换成字符串类型

c("foo", 1, TRUE)
## [1] "foo"  "1"    "TRUE"

这里会强制转换成数值型

c(1, TRUE, FALSE)
## [1] 1 1 0
c(TRUE, TRUE, FALSE) %>% sum()
## [1] 2

随堂练习:补全下面代码,求嘴峰长度大于40mm的占比?

penguins %>% 
  mutate(is_bigger40 = bill_length_mm > 40)
## # A tibble: 333 × 9
##   species island    bill_length_mm bill_depth_mm
##   <fct>   <fct>              <dbl>         <dbl>
## 1 Adelie  Torgersen           39.1          18.7
## 2 Adelie  Torgersen           39.5          17.4
## 3 Adelie  Torgersen           40.3          18  
## 4 Adelie  Torgersen           36.7          19.3
## 5 Adelie  Torgersen           39.3          20.6
## 6 Adelie  Torgersen           38.9          17.8
## # … with 327 more rows, and 5 more variables:
## #   flipper_length_mm <int>, body_mass_g <int>,
## #   sex <fct>, year <int>, is_bigger40 <lgl>

13.5 across()之美

我们想知道,嘴巴长度和厚度的均值

penguins %>%
  summarize(
    length = mean(bill_length_mm)
  )
## # A tibble: 1 × 1
##   length
##    <dbl>
## 1   44.0

接着添加下个变量

penguins %>%
  summarize(
    length = mean(bill_length_mm),
    depth  = mean(bill_length_mm)
  )
## # A tibble: 1 × 2
##   length depth
##    <dbl> <dbl>
## 1   44.0  44.0

长度和厚度惊人的相等。我是不是发现新大陆了?

13.5.1 across()函数

更安全、更简练的写法,王老师的最爱

penguins %>%
  summarize(
     across(c(bill_depth_mm, bill_length_mm), mean)
 )
## # A tibble: 1 × 2
##   bill_depth_mm bill_length_mm
##           <dbl>          <dbl>
## 1          17.2           44.0

翅膀的长度加进去看看

penguins %>%
  summarize(
     across(c(bill_depth_mm, bill_length_mm, flipper_length_mm), mean)
 )
## # A tibble: 1 × 3
##   bill_depth_mm bill_length_mm flipper_length_mm
##           <dbl>          <dbl>             <dbl>
## 1          17.2           44.0              201.

还可以更简练喔

penguins %>%
  summarize(
    across(ends_with("_mm"), mean)
 )
## # A tibble: 1 × 3
##   bill_length_mm bill_depth_mm flipper_length_mm
##            <dbl>         <dbl>             <dbl>
## 1           44.0          17.2              201.

across()函数用法

across(.cols = everything(), .fns = NULL, ..., .names = NULL)

13.5.2 数据中心化

penguins %>%
  mutate(
    bill_length_mm = bill_length_mm - mean(bill_length_mm),
    bill_depth_mm  = bill_depth_mm  - mean(bill_depth_mm)
    )
## # A tibble: 333 × 8
##   species island    bill_length_mm bill_depth_mm
##   <fct>   <fct>              <dbl>         <dbl>
## 1 Adelie  Torgersen          -4.89         1.54 
## 2 Adelie  Torgersen          -4.49         0.235
## 3 Adelie  Torgersen          -3.69         0.835
## 4 Adelie  Torgersen          -7.29         2.14 
## 5 Adelie  Torgersen          -4.69         3.44 
## 6 Adelie  Torgersen          -5.09         0.635
## # … with 327 more rows, and 4 more variables:
## #   flipper_length_mm <int>, body_mass_g <int>,
## #   sex <fct>, year <int>

更清晰的办法

centralized <- function(x) {
  x - mean(x)
}


penguins %>%
  mutate(
    across(c(bill_length_mm, bill_depth_mm), centralized)
  )
## # A tibble: 333 × 8
##   species island    bill_length_mm bill_depth_mm
##   <fct>   <fct>              <dbl>         <dbl>
## 1 Adelie  Torgersen          -4.89         1.54 
## 2 Adelie  Torgersen          -4.49         0.235
## 3 Adelie  Torgersen          -3.69         0.835
## 4 Adelie  Torgersen          -7.29         2.14 
## 5 Adelie  Torgersen          -4.69         3.44 
## 6 Adelie  Torgersen          -5.09         0.635
## # … with 327 more rows, and 4 more variables:
## #   flipper_length_mm <int>, body_mass_g <int>,
## #   sex <fct>, year <int>

13.5.3 数据标准化

std <- function(x) {
  (x - mean(x, na.rm = TRUE)) / sd(x, na.rm = TRUE)
}


penguins %>%
  mutate(
    across(c(bill_length_mm, bill_depth_mm), std)
  )
## # A tibble: 333 × 8
##   species island    bill_length_mm bill_depth_mm
##   <fct>   <fct>              <dbl>         <dbl>
## 1 Adelie  Torgersen         -0.895         0.780
## 2 Adelie  Torgersen         -0.822         0.119
## 3 Adelie  Torgersen         -0.675         0.424
## 4 Adelie  Torgersen         -1.33          1.08 
## 5 Adelie  Torgersen         -0.858         1.74 
## 6 Adelie  Torgersen         -0.931         0.323
## # … with 327 more rows, and 4 more variables:
## #   flipper_length_mm <int>, body_mass_g <int>,
## #   sex <fct>, year <int>

或者使用更简洁的方法

# using across() and purrr style
penguins %>%
  summarise(
    across(starts_with("bill_"), ~ (.x - mean(.x)) / sd(.x))
  )
## # A tibble: 333 × 2
##   bill_length_mm bill_depth_mm
##            <dbl>         <dbl>
## 1         -0.895         0.780
## 2         -0.822         0.119
## 3         -0.675         0.424
## 4         -1.33          1.08 
## 5         -0.858         1.74 
## 6         -0.931         0.323
## # … with 327 more rows

13.5.4 多列多个统计函数

penguins %>%
  group_by(species) %>%
  summarise(
    across(ends_with("_mm"), list(mean = mean, sd = sd), na.rm = TRUE)
  )
## # A tibble: 3 × 7
##   species   bill_length_mm_mean bill_length_mm_sd
##   <fct>                   <dbl>             <dbl>
## 1 Adelie                   38.8              2.66
## 2 Chinstrap                48.8              3.34
## 3 Gentoo                   47.6              3.11
## # … with 4 more variables: bill_depth_mm_mean <dbl>,
## #   bill_depth_mm_sd <dbl>,
## #   flipper_length_mm_mean <dbl>,
## #   flipper_length_mm_sd <dbl>

随堂练习:以sex分组,对”bill_“开头的列,求出每列的最大值和最小值

penguins %>%
  group_by(sex) %>%
  summarise(
    across(starts_with("bill_"), list(max = max, min = min), na.rm = TRUE)
  )
## # A tibble: 2 × 5
##   sex    bill_length_mm_max bill_length_mm_min
##   <fct>               <dbl>              <dbl>
## 1 female               58                 32.1
## 2 male                 59.6               34.6
## # … with 2 more variables: bill_depth_mm_max <dbl>,
## #   bill_depth_mm_min <dbl>

在第 40 章到第 43 章会继续讲王老师的最爱across()函数。