第一题 编写代码
利用nycflights13包的flights数据集是2013年从纽约三大机场(JFK、LGA、EWR)起飞的所有航班的准点数据,共336776条记录。
计算纽约三大机场2013起飞航班数和平均延误时间(可使用group_by, summarise函数)
library (nycflights13)
library (dplyr)
# 按机场分组统计
result <- flights %>%
group_by (origin) %>% # 按机场分组(origin 列)
summarise (
total_flights = n (), # 计算总航班数
avg_dep_delay = mean (dep_delay, na.rm = TRUE ) # 平均起飞延误(忽略 NA)
) %>%
mutate (avg_dep_delay = round (avg_dep_delay, 2 )) # 四舍五入保留两位小数
# 查看结果
print (result)
# A tibble: 3 × 3
origin total_flights avg_dep_delay
<chr> <int> <dbl>
1 EWR 120835 15.1
2 JFK 111279 12.1
3 LGA 104662 10.4
# 输出格式化结果
result %>%
knitr:: kable (caption = "纽约三大机场航班统计(2013年)" )
纽约三大机场航班统计(2013年)
EWR
120835
15.11
JFK
111279
12.11
LGA
104662
10.35
计算不同航空公司2013从纽约起飞航班数和平均延误时间
# 按航空公司分组统计
result <- flights %>%
left_join (airlines, by = "carrier" ) %>% # 关联航空公司名称
group_by (name) %>% # 按航空公司全名分组
summarise (
total_flights = n (), # 总航班数
avg_dep_delay = mean (dep_delay, na.rm = TRUE ), # 平均起飞延误
avg_arr_delay = mean (arr_delay, na.rm = TRUE ) # 平均到达延误(可选)
) %>%
mutate (
avg_dep_delay = round (avg_dep_delay, 2 ), # 四舍五入保留两位小数
avg_arr_delay = round (avg_arr_delay, 2 )
) %>%
arrange (desc (total_flights)) # 按航班数降序排序
# 查看结果
print (result)
# A tibble: 16 × 4
name total_flights avg_dep_delay avg_arr_delay
<chr> <int> <dbl> <dbl>
1 United Air Lines Inc. 58665 12.1 3.56
2 JetBlue Airways 54635 13.0 9.46
3 ExpressJet Airlines Inc. 54173 20.0 15.8
4 Delta Air Lines Inc. 48110 9.26 1.64
5 American Airlines Inc. 32729 8.59 0.36
6 Envoy Air 26397 10.6 10.8
7 US Airways Inc. 20536 3.78 2.13
8 Endeavor Air Inc. 18460 16.7 7.38
9 Southwest Airlines Co. 12275 17.7 9.65
10 Virgin America 5162 12.9 1.76
11 AirTran Airways Corporation 3260 18.7 20.1
12 Alaska Airlines Inc. 714 5.8 -9.93
13 Frontier Airlines Inc. 685 20.2 21.9
14 Mesa Airlines Inc. 601 19 15.6
15 Hawaiian Airlines Inc. 342 4.9 -6.92
16 SkyWest Airlines Inc. 32 12.6 11.9
计算纽约三大机场排名前三个目的地和平均飞行距离(可使用group_by, summarise, arrange, slice_max函数)
# 计算每个机场的前三目的地及其平均飞行距离
result <- flights %>%
# 按出发机场和目的地分组
group_by (origin, dest) %>%
# 计算航班次数和平均距离
summarise (
flights_count = n (),
avg_distance = round (mean (distance, na.rm = TRUE ), 1 ),
.groups = "drop"
) %>%
# 按出发机场分组,选择航班次数前三的目的地
group_by (origin) %>%
slice_max (flights_count, n = 3 ) %>%
# 按出发机场和航班次数排序
arrange (origin, desc (flights_count)) %>%
ungroup ()
# 查看结果
print (result, n = nrow (result))
# A tibble: 9 × 4
origin dest flights_count avg_distance
<chr> <chr> <int> <dbl>
1 EWR ORD 6100 719
2 EWR BOS 5327 200
3 EWR SFO 5127 2565
4 JFK LAX 11262 2475
5 JFK SFO 8204 2586
6 JFK BOS 5898 187
7 LGA ATL 10263 762
8 LGA ORD 8857 733
9 LGA CLT 6168 544
第二题 解释代码
代码含义:
# 对鸢尾花数据按物种分组,并在组内优先展示萼片更大(长度和宽度)的观测值。
tibble (iris) %>%
arrange (Species,across (starts_with ("Sepal" ), desc))
# A tibble: 150 × 5
Sepal.Length Sepal.Width Petal.Length Petal.Width Species
<dbl> <dbl> <dbl> <dbl> <fct>
1 5.8 4 1.2 0.2 setosa
2 5.7 4.4 1.5 0.4 setosa
3 5.7 3.8 1.7 0.3 setosa
4 5.5 4.2 1.4 0.2 setosa
5 5.5 3.5 1.3 0.2 setosa
6 5.4 3.9 1.7 0.4 setosa
7 5.4 3.9 1.3 0.4 setosa
8 5.4 3.7 1.5 0.2 setosa
9 5.4 3.4 1.7 0.2 setosa
10 5.4 3.4 1.5 0.4 setosa
# ℹ 140 more rows
代码含义:
# 输出一个数据框,包含每个性别组中质量高于该组平均值的角色信息。
starwars %>%
group_by (gender) %>%
filter (mass > mean (mass, na.rm = TRUE ))
# A tibble: 15 × 14
# Groups: gender [3]
name height mass hair_color skin_color eye_color birth_year sex gender
<chr> <int> <dbl> <chr> <chr> <chr> <dbl> <chr> <chr>
1 Darth … 202 136 none white yellow 41.9 male mascu…
2 Owen L… 178 120 brown, gr… light blue 52 male mascu…
3 Beru W… 165 75 brown light blue 47 fema… femin…
4 Chewba… 228 112 brown unknown blue 200 male mascu…
5 Jabba … 175 1358 <NA> green-tan… orange 600 herm… mascu…
6 Jek To… 180 110 brown fair blue NA <NA> <NA>
7 IG-88 200 140 none metal red 15 none mascu…
8 Bossk 190 113 none green red 53 male mascu…
9 Ayla S… 178 55 none blue hazel 48 fema… femin…
10 Gregar… 185 85 black dark brown NA <NA> <NA>
11 Lumina… 170 56.2 black yellow blue 58 fema… femin…
12 Zam We… 168 55 blonde fair, gre… yellow NA fema… femin…
13 Shaak … 178 57 none red, blue… black NA fema… femin…
14 Grievo… 216 159 none brown, wh… green, y… NA male mascu…
15 Tarfful 234 136 brown brown blue NA male mascu…
# ℹ 5 more variables: homeworld <chr>, species <chr>, films <list>,
# vehicles <list>, starships <list>
代码含义:
# 将字符型的分类变量转换为因子类型
starwars %>%
select (name, homeworld, species) %>%
mutate (across (! name, as.factor))
# A tibble: 87 × 3
name homeworld species
<chr> <fct> <fct>
1 Luke Skywalker Tatooine Human
2 C-3PO Tatooine Droid
3 R2-D2 Naboo Droid
4 Darth Vader Tatooine Human
5 Leia Organa Alderaan Human
6 Owen Lars Tatooine Human
7 Beru Whitesun Lars Tatooine Human
8 R5-D4 Tatooine Droid
9 Biggs Darklighter Tatooine Human
10 Obi-Wan Kenobi Stewjon Human
# ℹ 77 more rows
代码含义:
# 对数据集进行分组和变量转换,最终生成一个新数据框。
tibble (mtcars) %>%
group_by (vs) %>%
mutate (hp_cut = cut (hp, 3 )) %>%
group_by (hp_cut)
# A tibble: 32 × 12
# Groups: hp_cut [6]
mpg cyl disp hp drat wt qsec vs am gear carb hp_cut
<dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <fct>
1 21 6 160 110 3.9 2.62 16.5 0 1 4 4 (90.8,172]
2 21 6 160 110 3.9 2.88 17.0 0 1 4 4 (90.8,172]
3 22.8 4 108 93 3.85 2.32 18.6 1 1 4 1 (75.7,99.3]
4 21.4 6 258 110 3.08 3.22 19.4 1 0 3 1 (99.3,123]
5 18.7 8 360 175 3.15 3.44 17.0 0 0 3 2 (172,254]
6 18.1 6 225 105 2.76 3.46 20.2 1 0 3 1 (99.3,123]
7 14.3 8 360 245 3.21 3.57 15.8 0 0 3 4 (172,254]
8 24.4 4 147. 62 3.69 3.19 20 1 0 4 2 (51.9,75.7]
9 22.8 4 141. 95 3.92 3.15 22.9 1 0 4 2 (75.7,99.3]
10 19.2 6 168. 123 3.92 3.44 18.3 1 0 4 4 (99.3,123]
# ℹ 22 more rows
第三题 查找帮助理解函数
阅读 https://dplyr.tidyverse.org/reference/mutate-joins.html 内容,说明4个数据集链接函数函数的作用。分别举一个实际例子演示并解释其输出结果。
inner_join()
:
# 作用:保留两个表中 完全匹配的行(交集),丢弃不匹配的行。
employees <- tibble (
id = c (1 , 2 , 3 ),
name = c ("Alice" , "Bob" , "Charlie" )
)
departments <- tibble (
id = c (2 , 3 , 4 ),
dept = c ("Sales" , "IT" , "HR" )
)
inner_join (employees, departments, by = "id" )
# A tibble: 2 × 3
id name dept
<dbl> <chr> <chr>
1 2 Bob Sales
2 3 Charlie IT
left_join()
:
#作用:保留左表所有行,右表无匹配时填充 NA。
left_join (employees, departments, by = "id" )
# A tibble: 3 × 3
id name dept
<dbl> <chr> <chr>
1 1 Alice <NA>
2 2 Bob Sales
3 3 Charlie IT
right_join()
:
#作用:保留右表所有行,左表无匹配时填充 NA。
right_join (employees, departments, by = "id" )
# A tibble: 3 × 3
id name dept
<dbl> <chr> <chr>
1 2 Bob Sales
2 3 Charlie IT
3 4 <NA> HR
full_join()
:
#作用:保留两个表的所有行,无匹配时填充 NA(并集)。
full_join (employees, departments, by = "id" )
# A tibble: 4 × 3
id name dept
<dbl> <chr> <chr>
1 1 Alice <NA>
2 2 Bob Sales
3 3 Charlie IT
4 4 <NA> HR