## # A tibble: 1 x 8
-## species island bill_length_mm bill_depth_mm
-## <int> <int> <int> <int>
-## 1 0 0 2 2
-## # ... with 4 more variables: flipper_length_mm <int>,
-## # body_mass_g <int>, sex <int>, year <int>
## # A tibble: 1 x 8
-## species island bill_length_mm bill_depth_mm
-## <int> <int> <int> <int>
-## 1 0 0 2 2
-## # ... with 4 more variables: flipper_length_mm <int>,
-## # body_mass_g <int>, sex <int>, year <int>
-
# or
-penguins %>%
-summarise(
-across(everything(), ~sum(is.na(.)))
- )
-
## # A tibble: 1 x 8
-## species island bill_length_mm bill_depth_mm
-## <int> <int> <int> <int>
-## 1 0 0 2 2
-## # ... with 4 more variables: flipper_length_mm <int>,
-## # body_mass_g <int>, sex <int>, year <int>
## # A tibble: 10 x 3
-## grp x y
-## <chr> <dbl> <dbl>
-## 1 a -0.665 -0.387
-## 2 a -0.270 -0.839
-## 3 a 0.791 0.0371
-## 4 a -1.38 -0.144
-## 5 a 0.903 0.148
-## 6 b 1.55 0.143
-## 7 b 1.10 0.0986
-## 8 b -0.400 -1.11
-## 9 b -2.47 -0.670
-## 10 b -0.374 -0.440
## # A tibble: 10 x 2
-## grp y
-## <chr> <dbl>
-## 1 a -0.387
-## 2 a -0.839
-## 3 a 0.0371
-## 4 a -0.144
-## 5 a 0.148
-## 6 b 0.143
-## 7 b 0.0986
-## 8 b -1.11
-## 9 b -0.670
-## 10 b -0.440
## # A tibble: 10 x 3
-## grp x y
-## <chr> <dbl> <dbl>
-## 1 a -0.665 -0.387
-## 2 a -0.270 -0.839
-## 3 a 0.791 0.0371
-## 4 a -1.38 -0.144
-## 5 a 0.903 0.148
-## 6 b 1.55 0.143
-## 7 b 1.10 0.0986
-## 8 b -0.400 -1.11
-## 9 b -2.47 -0.670
-## 10 b -0.374 -0.440
## # A tibble: 10 x 2
-## grp y
-## <chr> <dbl>
-## 1 a -0.387
-## 2 a -0.839
-## 3 a 0.0371
-## 4 a -0.144
-## 5 a 0.148
-## 6 b 0.143
-## 7 b 0.0986
-## 8 b -1.11
-## 9 b -0.670
-## 10 b -0.440
## # A tibble: 10 x 3
-## group x y
-## <chr> <dbl> <dbl>
-## 1 a -0.665 -0.387
-## 2 a -0.270 -0.839
-## 3 a 0.791 0.0371
-## 4 a -1.38 -0.144
-## 5 a 0.903 0.148
-## 6 b 1.55 0.143
-## 7 b 1.10 0.0986
-## 8 b -0.400 -1.11
-## 9 b -2.47 -0.670
-## 10 b -0.374 -0.440
-
df %>%rename_with(toupper)
-
## # A tibble: 10 x 3
-## GRP X Y
-## <chr> <dbl> <dbl>
-## 1 a -0.665 -0.387
-## 2 a -0.270 -0.839
-## 3 a 0.791 0.0371
-## 4 a -1.38 -0.144
-## 5 a 0.903 0.148
-## 6 b 1.55 0.143
-## 7 b 1.10 0.0986
-## 8 b -0.400 -1.11
-## 9 b -2.47 -0.670
-## 10 b -0.374 -0.440
-
df %>%rename_with(toupper, is.numeric)
-
## # A tibble: 10 x 3
-## grp X Y
-## <chr> <dbl> <dbl>
-## 1 a -0.665 -0.387
-## 2 a -0.270 -0.839
-## 3 a 0.791 0.0371
-## 4 a -1.38 -0.144
-## 5 a 0.903 0.148
-## 6 b 1.55 0.143
-## 7 b 1.10 0.0986
-## 8 b -0.400 -1.11
-## 9 b -2.47 -0.670
-## 10 b -0.374 -0.440
-
df %>%rename_with(toupper, starts_with("x"))
-
## # A tibble: 10 x 3
-## grp X y
-## <chr> <dbl> <dbl>
-## 1 a -0.665 -0.387
-## 2 a -0.270 -0.839
-## 3 a 0.791 0.0371
-## 4 a -1.38 -0.144
-## 5 a 0.903 0.148
-## 6 b 1.55 0.143
-## 7 b 1.10 0.0986
-## 8 b -0.400 -1.11
-## 9 b -2.47 -0.670
-## 10 b -0.374 -0.440
## # A tibble: 10 x 3
-## grp x y
-## <chr> <dbl> <dbl>
-## 1 b -2.47 -0.670
-## 2 b 1.55 0.143
-## 3 a -1.38 -0.144
-## 4 b 1.10 0.0986
-## 5 a 0.903 0.148
-## 6 a 0.791 0.0371
-## 7 a -0.665 -0.387
-## 8 b -0.400 -1.11
-## 9 b -0.374 -0.440
-## 10 a -0.270 -0.839
-
我们现在想调整列的位置，比如，这里调整数据框三列的位置，让grp列放在x列的后面
-
df %>%select(x, grp, y)
-
## # A tibble: 10 x 3
-## x grp y
-## <dbl> <chr> <dbl>
-## 1 -0.665 a -0.387
-## 2 -0.270 a -0.839
-## 3 0.791 a 0.0371
-## 4 -1.38 a -0.144
-## 5 0.903 a 0.148
-## 6 1.55 b 0.143
-## 7 1.10 b 0.0986
-## 8 -0.400 b -1.11
-## 9 -2.47 b -0.670
-## 10 -0.374 b -0.440
-
如果列变量很多的时候，上面的方法就不太好用，因此推荐大家使用relocate()
-
df %>%relocate(grp, .after = y)
-
## # A tibble: 10 x 3
-## x y grp
-## <dbl> <dbl> <chr>
-## 1 -0.665 -0.387 a
-## 2 -0.270 -0.839 a
-## 3 0.791 0.0371 a
-## 4 -1.38 -0.144 a
-## 5 0.903 0.148 a
-## 6 1.55 0.143 b
-## 7 1.10 0.0986 b
-## 8 -0.400 -1.11 b
-## 9 -2.47 -0.670 b
-## 10 -0.374 -0.440 b
-
df %>%relocate(x, .before = grp)
-
## # A tibble: 10 x 3
-## x grp y
-## <dbl> <chr> <dbl>
-## 1 -0.665 a -0.387
-## 2 -0.270 a -0.839
-## 3 0.791 a 0.0371
-## 4 -1.38 a -0.144
-## 5 0.903 a 0.148
-## 6 1.55 b 0.143
-## 7 1.10 b 0.0986
-## 8 -0.400 b -1.11
-## 9 -2.47 b -0.670
-## 10 -0.374 b -0.440
-
还有
-
df %>%relocate(grp, .after =last_col())
-
## # A tibble: 10 x 3
-## x y grp
-## <dbl> <dbl> <chr>
-## 1 -0.665 -0.387 a
-## 2 -0.270 -0.839 a
-## 3 0.791 0.0371 a
-## 4 -1.38 -0.144 a
-## 5 0.903 0.148 a
-## 6 1.55 0.143 b
-## 7 1.10 0.0986 b
-## 8 -0.400 -1.11 b
-## 9 -2.47 -0.670 b
-## 10 -0.374 -0.440 b
## # A tibble: 6 x 3
-## g x y
-## <chr> <dbl> <dbl>
-## 1 b 0.603 0.415
-## 2 b 0.443 0.936
-## 3 c 0.0727 0.301
-## 4 c 0.749 0.888
-## 5 c 0.591 0.273
-## 6 a 0.278 0.259
-
df %>%
-group_by(g) %>%
-summarise(
-n =n()
- )
-
## # A tibble: 3 x 2
-## g n
-## <chr> <int>
-## 1 a 1
-## 2 b 2
-## 3 c 3
## # A tibble: 6 x 3
-## # Groups: g [3]
-## g x y
-## <chr> <chr> <chr>
-## 1 b x 0.6 y 0.42
-## 2 b x 0.44 y 0.94
-## 3 c x 0.07 y 0.3
-## 4 c x 0.75 y 0.89
-## 5 c x 0.59 y 0.27
-## 6 a x 0.28 y 0.26
## # A tibble: 6 x 3
-## g x y
-## <chr> <dbl> <dbl>
-## 1 b 0.121 0.332
-## 2 b 0.0885 0.749
-## 3 c 0.0145 0.241
-## 4 c 0.150 0.711
-## 5 c 0.118 0.219
-## 6 a 0.0555 0.207
df <-tibble(id = letters[1:6], w =10:15, x =20:25, y =30:35, z =40:45)
-df
-
## # A tibble: 6 x 5
-## id w x y z
-## <chr> <int> <int> <int> <int>
-## 1 a 10 20 30 40
-## 2 b 11 21 31 41
-## 3 c 12 22 32 42
-## 4 d 13 23 33 43
-## 5 e 14 24 34 44
-## 6 f 15 25 35 45
-
计算每行的均值，
-
df %>%mutate(avg =mean(c(w, x, y, z)))
-
## # A tibble: 6 x 6
-## id w x y z avg
-## <chr> <int> <int> <int> <int> <dbl>
-## 1 a 10 20 30 40 27.5
-## 2 b 11 21 31 41 27.5
-## 3 c 12 22 32 42 27.5
-## 4 d 13 23 33 43 27.5
-## 5 e 14 24 34 44 27.5
-## 6 f 15 25 35 45 27.5
## # A tibble: 6 x 6
-## # Rowwise: id
-## id w x y z total
-## <chr> <int> <int> <int> <int> <dbl>
-## 1 a 10 20 30 40 25
-## 2 b 11 21 31 41 26
-## 3 c 12 22 32 42 27
-## 4 d 13 23 33 43 28
-## 5 e 14 24 34 44 29
-## 6 f 15 25 35 45 30
## # A tibble: 6 x 6
-## # Rowwise: id
-## id w x y z mean
-## <chr> <int> <int> <int> <int> <dbl>
-## 1 a 10 20 30 40 25
-## 2 b 11 21 31 41 26
-## 3 c 12 22 32 42 27
-## 4 d 13 23 33 43 28
-## 5 e 14 24 34 44 29
-## 6 f 15 25 35 45 30
## name type newscore
-## 1 Alice english 80.2
-## 2 Alice math 90.5
-## 3 Bob english 92.2
-## 4 Bob math 90.8
-## 5 Carol english 82.5
-## 6 Carol math 84.6
-
dplyr语法这样写
-
mutate(df, newscore = score2020)
-
## name type newscore
-## 1 Alice english 80.2
-## 2 Alice math 90.5
-## 3 Bob english 92.2
-## 4 Bob math 90.8
-## 5 Carol english 82.5
-## 6 Carol math 84.6
## name type newscore
-## 1 Alice english 80.2
-## 2 Alice math 90.5
-## 3 Bob english 92.2
-## 4 Bob math 90.8
-## 5 Carol english 82.5
-## 6 Carol math 84.6
## name type newscore
-## 1 Alice english 80.2
-## 2 Alice math 90.5
-## 3 Bob english 92.2
-## 4 Bob math 90.8
-## 5 Carol english 82.5
-## 6 Carol math 84.6
-
-
-
6.3select()
-
select()顾名思义选择，就是选择数据框的某一列，或者某几列
-
-
我们还是以学生成绩的数据框为例
-
我们可以选择name列, 结果是只有一列的数据框（仍然数据框喔）
-
-
使用传统的方法
-
-
df["name"]
-
## name
-## 1 Alice
-## 2 Alice
-## 3 Bob
-## 4 Bob
-## 5 Carol
-## 6 Carol
-
-
dplyr 的方法
-
-
df %>%select(name)
-
## name
-## 1 Alice
-## 2 Alice
-## 3 Bob
-## 4 Bob
-## 5 Carol
-## 6 Carol
-
-
如果选取多列，用dplyr 就只是再写一个就行了
-
-
df %>%select(name, newscore)
-
## name newscore
-## 1 Alice 80.2
-## 2 Alice 90.5
-## 3 Bob 92.2
-## 4 Bob 90.8
-## 5 Carol 82.5
-## 6 Carol 84.6
-
如果不想要某列， 可以在变量前面加-， 结果与上面的一样
-
df %>%select(-type)
-
## name newscore
-## 1 Alice 80.2
-## 2 Alice 90.5
-## 3 Bob 92.2
-## 4 Bob 90.8
-## 5 Carol 82.5
-## 6 Carol 84.6
-
-
-
6.4filter()
-
select是列方向的选择，我们还可以对数据行方向的选择和筛选，选出符合我们条件的某些行
-
-
比如这里把成绩高于90分的同学筛选出来
-
df %>%filter(newscore >=90)
-
## name type newscore
-## 1 Alice math 90.5
-## 2 Bob english 92.2
-## 3 Bob math 90.8
## # A tibble: 3 x 3
-## name mean_score sd_score
-## <chr> <dbl> <dbl>
-## 1 Alice 85.4 7.28
-## 2 Bob 91.5 0.990
-## 3 Carol 83.6 1.48
-
-
-
6.7arrange()排序
-
-
这个很好理解的。比如我们按照考试成绩从低到高排序，然后输出
-
df %>%arrange(newscore)
-
## name type newscore
-## 1 Alice english 80.2
-## 2 Carol english 82.5
-## 3 Carol math 84.6
-## 4 Alice math 90.5
-## 5 Bob math 90.8
-## 6 Bob english 92.2
-
如果从高到低排序呢，有两种方法:
-
df %>%arrange(-newscore)
-
## name type newscore
-## 1 Bob english 92.2
-## 2 Bob math 90.8
-## 3 Alice math 90.5
-## 4 Carol math 84.6
-## 5 Carol english 82.5
-## 6 Alice english 80.2
-
写成下面这种形式也是降序排列，但可读性更强些
-
df %>%arrange(desc(newscore))
-
## name type newscore
-## 1 Bob english 92.2
-## 2 Bob math 90.8
-## 3 Alice math 90.5
-## 4 Carol math 84.6
-## 5 Carol english 82.5
-## 6 Alice english 80.2
-
也可对多个变量先后排序。先按学科排，然后按照成绩从高到底排序
-
df %>%
-arrange(type, desc(newscore))
-
## name type newscore
-## 1 Bob english 92.2
-## 2 Carol english 82.5
-## 3 Alice english 80.2
-## 4 Bob math 90.8
-## 5 Alice math 90.5
-## 6 Carol math 84.6
Four x-y datasets which have the same traditional statistical properties (mean, variance, correlation, regression line, etc.), yet are quite different.
## # A tibble: 8 x 3
-## id name vaules
-## <chr> <chr> <int>
-## 1 a x_1 1
-## 2 a x_2 3
-## 3 a y_1 5
-## 4 a y_2 8
-## 5 b x_1 2
-## 6 b x_2 4
-## 7 b y_1 6
-## 8 b y_2 9
## # A tibble: 8 x 3
-## id name vaules
-## <chr> <chr> <int>
-## 1 a x 1
-## 2 a x 3
-## 3 a y 5
-## 4 a y 8
-## 5 b x 2
-## 6 b x 4
-## 7 b y 6
-## 8 b y 9
## # A tibble: 8 x 3
-## id name vaules
-## <chr> <chr> <int>
-## 1 a 1 1
-## 2 a 2 3
-## 3 a 1 5
-## 4 a 2 8
-## 5 b 1 2
-## 6 b 2 4
-## 7 b 1 6
-## 8 b 2 9
## # A tibble: 8 x 4
-## id name group vaules
-## <chr> <chr> <chr> <int>
-## 1 a x 1 1
-## 2 a x 2 3
-## 3 a y 1 5
-## 4 a y 2 8
-## 5 b x 1 2
-## 6 b x 2 4
-## 7 b y 1 6
-## 8 b y 2 9
## # A tibble: 6 x 7
-## name english chinese math sport psy edu
-## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
-## 1 A 133 100 102 56 89 89
-## 2 B 120 120 86 88 45 75
-## 3 C 98 109 114 87 NA 84
-## 4 D 120 78 106 68 86 69
-## 5 E 110 99 134 98 75 70
-## 6 F NA 132 130 NA 68 88
-
-
46.1.1 缺失值检查
-
我们需要判断每一列的缺失值
-
example %>%
-summarise(
-na_in_english =sum(is.na(english)),
-na_in_chinese =sum(is.na(chinese)),
-na_in_math =sum(is.na(math)),
-na_in_sport =sum(is.na(sport)),
-na_in_psy =sum(is.na(math)), # tpyo here
-na_in_edu =sum(is.na(edu))
- )
-
## # A tibble: 1 x 6
-## na_in_english na_in_chinese na_in_math na_in_sport
-## <int> <int> <int> <int>
-## 1 1 0 0 1
-## # ... with 2 more variables: na_in_psy <int>,
-## # na_in_edu <int>
example %>%
-summarise(
-across(everything(), mean)
- )
-
## # A tibble: 1 x 7
-## name english chinese math sport psy edu
-## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
-## 1 NA NA 106. 112 NA NA 79.2
-
example %>%
-summarise(
-across(everything(), function(x) sum(is.na(x)) )
- )
-
## # A tibble: 1 x 7
-## name english chinese math sport psy edu
-## <int> <int> <int> <int> <int> <int> <int>
-## 1 0 1 0 0 1 1 0
-
-
-
46.1.2 数据预处理
-
-
直接丢弃缺失值所在的行
-
-
example %>%drop_na()
-
## # A tibble: 4 x 7
-## name english chinese math sport psy edu
-## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
-## 1 A 133 100 102 56 89 89
-## 2 B 120 120 86 88 45 75
-## 3 D 120 78 106 68 86 69
-## 4 E 110 99 134 98 75 70
-
-
用均值代替缺失值
-
-
d <- example %>%
-mutate(
-across(where(is.numeric), ~if_else(is.na(.), mean(., na.rm = T), .))
- )
-d
-
## # A tibble: 6 x 7
-## name english chinese math sport psy edu
-## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
-## 1 A 133 100 102 56 89 89
-## 2 B 120 120 86 88 45 75
-## 3 C 98 109 114 87 72.6 84
-## 4 D 120 78 106 68 86 69
-## 5 E 110 99 134 98 75 70
-## 6 F 116. 132 130 79.4 68 88
-
-
计算总分/均值
-
-
d %>%
-rowwise() %>%
-mutate(
-total =sum(c_across(-name))
- )
-
## # A tibble: 6 x 8
-## # Rowwise:
-## name english chinese math sport psy edu total
-## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
-## 1 A 133 100 102 56 89 89 569
-## 2 B 120 120 86 88 45 75 534
-## 3 C 98 109 114 87 72.6 84 565.
-## 4 D 120 78 106 68 86 69 527
-## 5 E 110 99 134 98 75 70 586
-## 6 F 116. 132 130 79.4 68 88 614.
-
d %>%
-rowwise() %>%
-mutate(
-mean =mean(c_across(-name))
- )
-
## # A tibble: 6 x 8
-## # Rowwise:
-## name english chinese math sport psy edu mean
-## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
-## 1 A 133 100 102 56 89 89 94.8
-## 2 B 120 120 86 88 45 75 89
-## 3 C 98 109 114 87 72.6 84 94.1
-## 4 D 120 78 106 68 86 69 87.8
-## 5 E 110 99 134 98 75 70 97.7
-## 6 F 116. 132 130 79.4 68 88 102.
-
-
数据标准化处理
-
-
standard <-function(x) {
- (x -mean(x)) /sd(x)
-}
-
d %>%
-mutate(
-across(where(is.numeric), standard)
- )
-
## # A tibble: 6 x 7
-## name english chinese math sport psy edu
-## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
-## 1 A 1.44 -0.339 -0.555 -1.54 1.04 1.10
-## 2 B 0.326 0.731 -1.44 0.566 -1.75 -0.464
-## 3 C -1.56 0.143 0.111 0.500 0 0.538
-## 4 D 0.326 -1.51 -0.333 -0.75 0.852 -1.13
-## 5 E -0.531 -0.392 1.22 1.22 0.153 -1.02
-## 6 F 0 1.37 0.999 0 -0.292 0.984
-
-
-
-
46.2 开始
-
-
46.2.1 文件管理中需要注意的地方
-
感谢康钦虹同学提供的数据，但这里有几点需要注意的地方：
-
-
-
-
事项
-
问题
-
解决办法
-
-
-
-
-
文件名
-
excel的文件名是中文
-
用英文，比如 data.xlsx
-
-
-
列名
-
列名中有-号，大小写不统一
-
规范列名，或用janitor::clean_names()偷懒
-
-
-
预处理
-
直接在原始数据中新增
-
不要在原始数据上改动，统计工作可以在R里实现
-
-
-
文件管理
-
没有层级
-
新建data文件夹装数据，与code.Rmd并列
-
-
-
-
data <- readxl::read_excel("demo_data/career-decision.xlsx", skip =1) %>%
- janitor::clean_names()
-
-#glimpse(data)
-
d <- data %>%select(1:61)
-#glimpse(d)
-
-
-
46.2.2 缺失值检查
-
d %>%
-summarise(
-across(everything(), ~sum(is.na(.)))
- )
## # A tibble: 50 x 15
-## animal_id dupe_count sex life_stage pregnant
-## <chr> <int> <chr> <chr> <lgl>
-## 1 GR_C01 2 f <NA> NA
-## 2 GR_C01 2 f <NA> NA
-## 3 GR_C02 2 f <NA> NA
-## 4 GR_C02 2 f <NA> NA
-## 5 GR_C04 2 f <NA> NA
-## 6 GR_C04 2 f <NA> NA
-## 7 GR_C05 2 f <NA> NA
-## 8 GR_C05 2 f <NA> NA
-## 9 GR_C06 2 f <NA> NA
-## 10 GR_C06 2 f <NA> NA
-## # ... with 40 more rows, and 10 more variables:
-## # with_calf <lgl>, death_cause <chr>,
-## # study_site <chr>, deploy_on_longitude <dbl>,
-## # deploy_on_latitude <dbl>,
-## # deploy_on_comments <chr>,
-## # deploy_off_longitude <dbl>,
-## # deploy_off_latitude <dbl>, deploy_off_type <chr>,
-## # deploy_off_comments <chr>
## # A tibble: 180 x 1
-## country_region
-## <chr>
-## 1 Afghanistan
-## 2 Albania
-## 3 Algeria
-## 4 Andorra
-## 5 Angola
-## 6 Antigua and Barbuda
-## 7 Argentina
-## 8 Armenia
-## 9 Australia
-## 10 Austria
-## # ... with 170 more rows
-
d1 %>%
-filter(country_region =="China")
-
## # A tibble: 70 x 3
-## country_region date cases
-## <chr> <date> <dbl>
-## 1 China 2020-01-22 548
-## 2 China 2020-01-23 643
-## 3 China 2020-01-24 920
-## 4 China 2020-01-25 1406
-## 5 China 2020-01-26 2075
-## 6 China 2020-01-27 2877
-## 7 China 2020-01-28 5509
-## 8 China 2020-01-29 6087
-## 9 China 2020-01-30 8141
-## 10 China 2020-01-31 9802
-## # ... with 60 more rows
## # A tibble: 12 x 3
-## full_name prize_year category
-## <chr> <dbl> <chr>
-## 1 Walter Houser Brattain 1956 Physics
-## 2 Chen Ning Yang 1957 Physics
-## 3 Tsung-Dao (T.D.) Lee 1957 Physics
-## 4 Edmond H. Fischer 1992 Medicine
-## 5 Daniel C. Tsui 1998 Physics
-## 6 Gao Xingjian 2000 Literature
-## 7 Charles Kuen Kao 2009 Physics
-## 8 Charles Kuen Kao 2009 Physics
-## 9 Ei-ichi Negishi 2010 Chemistry
-## 10 Liu Xiaobo 2010 Peace
-## 11 Mo Yan 2012 Literature
-## 12 Youyou Tu 2015 Medicine
-
我们发现获奖者有多个地址，就会有重复的情况，比如 Charles Kuen Kao在2009年Physics有两次，为什么重复计数了呢？
## # A tibble: 11 x 3
-## full_name prize_year category
-## <chr> <dbl> <chr>
-## 1 walter houser brattain 1956 physics
-## 2 chen ning yang 1957 physics
-## 3 tsung-dao (t.d.) lee 1957 physics
-## 4 edmond h. fischer 1992 medicine
-## 5 daniel c. tsui 1998 physics
-## 6 gao xingjian 2000 literature
-## 7 charles kuen kao 2009 physics
-## 8 ei-ichi negishi 2010 chemistry
-## 9 liu xiaobo 2010 peace
-## 10 mo yan 2012 literature
-## 11 youyou tu 2015 medicine
-
-
-
39.8 哪些大神多次获得诺贝尔奖
-
nobel_winners %>%count(full_name, sort = T)
-
## # A tibble: 904 x 2
-## full_name n
-## <chr> <int>
-## 1 "comité international de la croix rouge (inte~ 3
-## 2 "frederick sanger" 2
-## 3 "john bardeen" 2
-## 4 "linus carl pauling" 2
-## 5 "marie curie, née sklodowska" 2
-## 6 "office of the united nations high commission~ 2
-## 7 " lie ducommun" 1
-## 8 "a. michael spence" 1
-## 9 "aage niels bohr" 1
-## 10 "aaron ciechanover" 1
-## # ... with 894 more rows
## # A tibble: 45 x 2
-## death_country n
-## <chr> <int>
-## 1 <NA> 329
-## 2 united states of america 203
-## 3 united kingdom 79
-## 4 germany 56
-## 5 france 51
-## 6 sweden 28
-## 7 switzerland 26
-## 8 italy 14
-## 9 russia 11
-## 10 spain 10
-## # ... with 35 more rows
## Reading layer `TM_WORLD_BORDERS_SIMPL-0.3' from data source `G:\R_for_Data_Science\demo_data\worldmap\TM_WORLD_BORDERS_SIMPL-0.3.shp' using driver `ESRI Shapefile'
-## Simple feature collection with 246 features and 11 fields
-## geometry type: MULTIPOLYGON
-## dimension: XY
-## bbox: xmin: -180 ymin: -90 xmax: 180 ymax: 83.57
-## geographic CRS: WGS 84
-
global %>%
-full_join(nobel_winners_birth_country, by ="ISO3") %>%
-ggplot() +
-geom_sf(aes(fill = n),
-color ="white",
-size =0.1
- ) +
-labs(
-x =NULL, y =NULL,
-title ="Nobel Winners by country",
-subtitle ="color of map indicates number of Nobel lauretes",
-fill ="num of Nobel lauretes",
-caption ="Made: wang_minjie"
- ) +
-scale_fill_gradientn(colors =c("royalblue1", "magenta", "orange", "gold"), na.value ="white") +
-# scale_fill_gradient(low = "wheat1", high = "red") +
-theme_void() +
-theme(
-legend.position =c(0.1, 0.3),
-plot.background =element_rect(fill ="gray")
- )
-
-
# Determine to 10 Countries
-topCountries <- nobel_winners_clean %>%
-count(birth_country, sort =TRUE) %>%
-na.omit() %>%
-top_n(8)
-
-topCountries
-
## # A tibble: 8 x 2
-## birth_country n
-## <chr> <int>
-## 1 united states of america 259
-## 2 united kingdom 99
-## 3 germany 80
-## 4 france 54
-## 5 sweden 29
-## 6 poland 26
-## 7 russia 26
-## 8 japan 24
## # A tibble: 1 x 8
-## species island bill_length_mm bill_depth_mm
-## <int> <int> <int> <int>
-## 1 0 0 2 2
-## # ... with 4 more variables: flipper_length_mm <int>,
-## # body_mass_g <int>, sex <int>, year <int>
-
有缺失值的地方找出来看看
-
penguins %>%filter_all(
-any_vars(is.na(.))
-)
-
## # A tibble: 11 x 8
-## species island bill_length_mm bill_depth_mm
-## <chr> <chr> <dbl> <dbl>
-## 1 Adelie Torge~ NA NA
-## 2 Adelie Torge~ 34.1 18.1
-## 3 Adelie Torge~ 42 20.2
-## 4 Adelie Torge~ 37.8 17.1
-## 5 Adelie Torge~ 37.8 17.3
-## 6 Adelie Dream 37.5 18.9
-## 7 Gentoo Biscoe 44.5 14.3
-## 8 Gentoo Biscoe 46.2 14.4
-## 9 Gentoo Biscoe 47.3 13.8
-## 10 Gentoo Biscoe 44.5 15.7
-## 11 Gentoo Biscoe NA NA
-## # ... with 4 more variables: flipper_length_mm <dbl>,
-## # body_mass_g <dbl>, sex <chr>, year <dbl>
-
发现共有11行至少有一处有缺失值，于是我们就删除这些行
-
penguins <- penguins %>%drop_na()
-penguins
-
## # A tibble: 333 x 8
-## species island bill_length_mm bill_depth_mm
-## <chr> <chr> <dbl> <dbl>
-## 1 Adelie Torge~ 39.1 18.7
-## 2 Adelie Torge~ 39.5 17.4
-## 3 Adelie Torge~ 40.3 18
-## 4 Adelie Torge~ 36.7 19.3
-## 5 Adelie Torge~ 39.3 20.6
-## 6 Adelie Torge~ 38.9 17.8
-## 7 Adelie Torge~ 39.2 19.6
-## 8 Adelie Torge~ 41.1 17.6
-## 9 Adelie Torge~ 38.6 21.2
-## 10 Adelie Torge~ 34.6 21.1
-## # ... with 323 more rows, and 4 more variables:
-## # flipper_length_mm <dbl>, body_mass_g <dbl>,
-## # sex <chr>, year <dbl>
-
-
-
-
45.2 探索性分析
-
大家可以提出自己想探索的内容：
-
-
每种类型企鹅有多少只？
-
每种类型企鹅各种属性的均值和分布？
-
嘴峰长度和深度的关联？
-
体重与翅膀长度的关联？
-
嘴峰长度与嘴峰深度的比例？
-
不同种类的宝宝，体重具有显著性差异？
-
这体征中哪个因素对性别影响最大？
-
…
-
-
-
45.2.1 每种类型企鹅有多少只
-
penguins %>%
-count(species, sort = T)
-
## # A tibble: 3 x 2
-## species n
-## <chr> <int>
-## 1 Adelie 146
-## 2 Gentoo 119
-## 3 Chinstrap 68
-
-
-
45.2.2 每个岛屿有多少企鹅？
-
penguins %>%
-count(island, sort = T)
-
## # A tibble: 3 x 2
-## island n
-## <chr> <int>
-## 1 Biscoe 163
-## 2 Dream 123
-## 3 Torgersen 47
## # A tibble: 5 x 3
-## Month month_short `Mean Temperature [F]`
-## <fct> <fct> <int>
-## 1 January Jan 24
-## 2 January Jan 23
-## 3 January Jan 23
-## 4 January Jan 17
-## 5 January Jan 29
p1 + p2 +
-plot_annotation(
-tag_levels ="A",
-title ="The surprising truth about mtcars",
-subtitle ="These 3 plots will reveal yet-untold secrets about our beloved data-set",
-caption ="Disclaimer: None of these plots are insightful"
- )
-
-
再来一个
-
library(palmerpenguins)
-
-g1 <- penguins %>%
-ggplot(aes(bill_length_mm, body_mass_g, color = species)) +
-geom_point() +
-theme_bw(base_size =14) +
-labs(tag ="(A)", x ="Bill length (mm)", y ="Body mass (g)", color ="Species")
-
-g2 <- penguins %>%
-ggplot(aes(bill_length_mm, bill_depth_mm, color = species)) +
-geom_point() +
-theme_bw(base_size =14) +
-labs(tag ="(B)", x ="Bill length (mm)", y ="Bill depth (mm)", color ="Species")
-
-g1 + g2 + patchwork::plot_layout(guides ="collect")
-
-
patchwork 使用方法很简单，根本不需要记
-
-
-
-
17.3.2 保存图片
-
使用ggsave()函数，将图片保存为所需要的格式，如“.pdf,” “.png”等， 还可以指定图片的高度和宽度，默认units是英寸，也可以使用“cm,” or “mm.”
## # A tibble: 12 x 6
-## country continent year lifeExp pop gdpPercap
-## <chr> <chr> <dbl> <dbl> <dbl> <dbl>
-## 1 China Asia 1952 44 556263527 400.
-## 2 China Asia 1957 50.5 637408000 576.
-## 3 China Asia 1962 44.5 665770000 488.
-## 4 China Asia 1967 58.4 754550000 613.
-## 5 China Asia 1972 63.1 862030000 677.
-## 6 China Asia 1977 64.0 943455000 741.
-## 7 China Asia 1982 65.5 1000281000 962.
-## 8 China Asia 1987 67.3 1084035000 1379.
-## 9 China Asia 1992 68.7 1164970000 1656.
-## 10 China Asia 1997 70.4 1230075000 2289.
-## 11 China Asia 2002 72.0 1280400000 3119.
-## 12 China Asia 2007 73.0 1318683096 4959.
-
gapdata %>%
-ggplot(
-aes(x = year, y = lifeExp, color = continent, group = country)
- ) +
-geom_line() +
-gghighlight(
- country =="China", # which is passed to dplyr::filter().
-label_key = country
- )
-
-
gapdata %>%filter(continent =="Asia")
-
## # A tibble: 396 x 6
-## country continent year lifeExp pop gdpPercap
-## <chr> <chr> <dbl> <dbl> <dbl> <dbl>
-## 1 Afghanist~ Asia 1952 28.8 8.43e6 779.
-## 2 Afghanist~ Asia 1957 30.3 9.24e6 821.
-## 3 Afghanist~ Asia 1962 32.0 1.03e7 853.
-## 4 Afghanist~ Asia 1967 34.0 1.15e7 836.
-## 5 Afghanist~ Asia 1972 36.1 1.31e7 740.
-## 6 Afghanist~ Asia 1977 38.4 1.49e7 786.
-## 7 Afghanist~ Asia 1982 39.9 1.29e7 978.
-## 8 Afghanist~ Asia 1987 40.8 1.39e7 852.
-## 9 Afghanist~ Asia 1992 41.7 1.63e7 649.
-## 10 Afghanist~ Asia 1997 41.8 2.22e7 635.
-## # ... with 386 more rows
gapdata %>%
-group_by(continent, year) %>%
-summarise(mean_lifeExp =mean(lifeExp)) %>%
-ggplot(aes(x = year, y = continent, size = mean_lifeExp)) +
-geom_point(shape =21, color ="red", fill ="white") +
-scale_size_continuous(range =c(7, 15)) +
-geom_text(aes(label =round(mean_lifeExp, 2)), size =3, color ="black") +
-theme(legend.position ="none")
-
-
-
-
-
13.5 主题风格
-
gapdata %>%
-ggplot(aes(x = gdpPercap, y = lifeExp, color = continent)) +
-geom_point() +
-geom_smooth(lwd =3, se =FALSE, method ="lm")
-
-
gapdata %>%
-ggplot(aes(x = gdpPercap, y = lifeExp, color = continent)) +
-geom_point() +
-geom_smooth(lwd =3, se =FALSE, method ="lm") +
-ggtitle("Life expectancy over time by continent")
-
-
gapdata %>%
-ggplot(aes(x = gdpPercap, y = lifeExp, color = continent)) +
-geom_point() +
-geom_smooth(lwd =3, se =FALSE, method ="lm") +
-theme_grey() # the default
-
-
gapdata %>%
-ggplot(aes(x = gdpPercap, y = lifeExp, color = continent)) +
-geom_point() +
-geom_smooth(lwd =3, se =FALSE, method ="lm") +
-theme_bw()
-
-
gapdata %>%
-ggplot(aes(x = gdpPercap, y = lifeExp, color = continent)) +
-geom_point() +
-geom_smooth(lwd =3, se =FALSE, method ="lm") +
- ggthemes::theme_calc() +
-ggtitle("ggthemes::theme_calc()")
-
-
gapdata %>%
-ggplot(aes(x = gdpPercap, y = lifeExp, color = continent)) +
-geom_point() +
-geom_smooth(lwd =3, se =FALSE, method ="lm") +
- ggthemes::theme_economist() +
-ggtitle("ggthemes::theme_economist()")
-
-
gapdata %>%
-ggplot(aes(x = gdpPercap, y = lifeExp, color = continent)) +
-geom_point() +
-geom_smooth(lwd =3, se =FALSE, method ="lm") +
- ggthemes::theme_economist_white() +
-ggtitle("ggthemes::theme_economist_white()")
-
-
gapdata %>%
-ggplot(aes(x = gdpPercap, y = lifeExp, color = continent)) +
-geom_point() +
-geom_smooth(lwd =3, se =FALSE, method ="lm") +
- ggthemes::theme_few() +
-ggtitle("ggthemes::theme_few()")
-
-
gapdata %>%
-ggplot(aes(x = gdpPercap, y = lifeExp, color = continent)) +
-geom_point() +
-geom_smooth(lwd =3, se =FALSE, method ="lm") +
- ggthemes::theme_gdocs() +
-ggtitle("ggthemes::theme_gdocs()")
-
-
gapdata %>%
-ggplot(aes(x = gdpPercap, y = lifeExp, color = continent)) +
-geom_point() +
-geom_smooth(lwd =3, se =FALSE, method ="lm") +
- ggthemes::theme_tufte() +
-ggtitle("ggthemes::theme_tufte()")
-
-
gapdata %>%
-ggplot(aes(x = gdpPercap, y = lifeExp, color = continent)) +
-geom_point() +
-geom_smooth(lwd =3, se =FALSE, method ="lm") +
- ggthemes::theme_wsj() +
-ggtitle("ggthemes::theme_wsj()")
动图可以将其理解为多张静态图堆在一起，当然不是随意的堆放，而是按照一定的规则，比如按照时间的顺序，或者类别的顺序。一般而言，动图制作包括两个步骤: 静态图制作及图形组装。静态图制作，前面几章我们讲过主要用ggplot2宏包实现；对于图形组装，需要用到今天我们要讲Thomas Lin Pedersen的gganimate宏包，来自同一工厂的产品，用起来自然是无缝衔接啦。
transition_states(states = ) +
-labs(title ="previous is {previous_state},
- current is {closest_state},
- next is {next_state}")
-
-transition_layers() +
-labs(title ="previous is {previous_layers},
- current is {closest_layers},
- next is {next_layers}")
-
-transition_time(time = ) +
-labs(title ="now is {frame_time}")
-
-
-transition_reveal(along = ) +
-labs(title ="now is {frame_along}")
-
-
-
57.10 保存
-
-
57.10.1 Renderer options
-
## # A tibble: 6 x 2
-## Function Description
-## <chr> <chr>
-## 1 gifski_rende~ Default, super fast gif renderer.
-## 2 magick_rende~ Somewhat slower gif renderer.
-## 3 ffmpeg_rende~ Uses ffmpeg to create a video from the~
-## 4 av_renderer Uses the av package to create a video ~
-## 5 file_renderer Dumps a list of image frames from the ~
-## 6 sprite_rende~ Creates a spritesheet from frames of t~
## # A tibble: 30 x 3
-## group subject score
-## <fct> <int> <dbl>
-## 1 A 1 76.9
-## 2 A 2 66.2
-## 3 A 3 28.5
-## 4 A 4 31.4
-## 5 A 5 18.3
-## 6 A 6 46.0
-## 7 A 7 64.9
-## 8 A 8 46.8
-## 9 A 9 17.9
-## 10 A 10 51.6
-## # ... with 20 more rows
No summary function supplied, defaulting to `mean_se()`
-
看到了吧，summary function，说明我们猜对了，这就是stat_*()神秘的地方。
-
-
首先，对于stat_summary()中的fun.data参数，它的默认值是mean_se()
-
其次，我们看看这个函数
-
-
mean_se
-
function (x, mult =1)
-{
- x <- stats::na.omit(x)
- se <- mult *sqrt(stats::var(x)/length(x))
- mean <-mean(x)
-new_data_frame(list(y = mean, ymin = mean - se, ymax = mean +
- se), n =1)
-}
-<bytecode:0x0000021aef28aa10>
-<environment: namespace:ggplot2>
## x group y ymin ymax PANEL flipped_aes colour
-## 1 1 1 170.2 168.6 171.9 1 FALSE black
-## size linetype shape fill alpha stroke
-## 1 0.5 1 19 NA NA 1
-
喔喔，结果很丰富，我们注意到y, ymin, and ymax 的值与 mean_se() 计算的结果一致。
Unfortunately, due to an early design mistake I called these either stat_() or geom_(). A better decision would have been to call them layer_() functions: that’s a more accurate description because every layer involves a stat and a geom
## # A tibble: 8 x 3
-## NASA party n
-## <fct> <fct> <int>
-## 1 TOO LITTLE Dem 8
-## 2 TOO LITTLE Ind 13
-## 3 TOO LITTLE Rep 9
-## 4 ABOUT RIGHT Dem 22
-## 5 ABOUT RIGHT Ind 37
-## 6 ABOUT RIGHT Rep 17
-## 7 TOO MUCH Dem 13
-## 8 TOO MUCH Ind 22
-
gss %>%
-ggplot(aes(x = party, fill = NASA)) +
-geom_bar()
-
-
假设：
-
-
零假设 \(H_0\):
-
-
不同党派对预算的态度的构成比(TOO LITTLE, ABOUT RIGHT, TOO MUCH) 没有区别
-
-
备选假设 \(H_a\):
-
-
不同党派对预算的态度的构成比(TOO LITTLE, ABOUT RIGHT, TOO MUCH) 存在区别
## # A tibble: 146 x 5
-## Eth Sex Age Lrn Days
-## <fct> <fct> <fct> <fct> <int>
-## 1 A M F0 SL 2
-## 2 A M F0 SL 11
-## 3 A M F0 SL 14
-## 4 A M F0 AL 5
-## 5 A M F0 AL 5
-## 6 A M F0 AL 13
-## 7 A M F0 AL 20
-## 8 A M F0 AL 22
-## 9 A M F1 SL 6
-## 10 A M F1 SL 6
-## # ... with 136 more rows
-
从民族背景有两组（A， N）来看，性别为 F 的占比 是否有区别？
-
td %>%count(Eth, Sex)
-
## # A tibble: 4 x 3
-## Eth Sex n
-## <fct> <fct> <int>
-## 1 A F 38
-## 2 A M 31
-## 3 N F 42
-## 4 N M 35
-
-
32.3.1 传统方法
-
prop.test(table(td$Eth, td$Sex), correct =FALSE)
-
##
-## 2-sample test for equality of proportions
-## without continuity correction
-##
-## data: table(td$Eth, td$Sex)
-## X-squared = 0.0041, df = 1, p-value = 0.9
-## alternative hypothesis: two.sided
-## 95 percent confidence interval:
-## -0.1564 0.1670
-## sample estimates:
-## prop 1 prop 2
-## 0.5507 0.5455
Warning in install.packages :
- unable to access index for repository http://cran.rstudio.com/src/contrib:
- cannot open URL 'http://cran.rstudio.com/src/contrib/PACKAGES'
## # A tibble: 3 x 6
-## id `count/num` W.t Case `time--d` `%percent`
-## <int> <chr> <int> <chr> <int> <int>
-## 1 1 china 3 w 5 25
-## 2 2 us 4 f 6 34
-## 3 3 india 5 q 8 78
-
fake_raw %>% janitor::clean_names()
-
## # A tibble: 3 x 6
-## id count_num w_t case time_d percent_percent
-## <int> <chr> <int> <chr> <int> <int>
-## 1 1 china 3 w 5 25
-## 2 2 us 4 f 6 34
-## 3 3 india 5 q 8 78
-
-
-
58.2 比count()更懂我的心
-
mtcars %>%
- dplyr::count(cyl)
-
## # A tibble: 3 x 2
-## cyl n
-## <dbl> <int>
-## 1 4 11
-## 2 6 7
-## 3 8 14
model <-lm(Sepal.Length ~ Species, data = iris)
-report(model)
-
We fitted a linear model (estimated using OLS) to predict Sepal.Length with Species (formula = Sepal.Length ~ Species). Standardized parameters were obtained by fitting the model on a standardized version of the dataset. Effect sizes were labelled following Cohen’s (1988) recommendations.
-
The model explains a significant and substantial proportion of variance (R2 = 0.62, F(2, 147) = 119.26, p < .001, adj. R2 = 0.61). The model’s intercept, corresponding to Sepal.Length = 0 and Species = setosa, is at 5.01 (SE = 0.07, 95% CI [4.86, 5.15], p < .001). Within this model:
-
-
The effect of Species [versicolor] is positive and can be considered as large and significant (beta = 0.93, SE = 0.10, 95% CI [0.73, 1.13], std. beta = 1.12, p < .001).
-
The effect of Species [virginica] is positive and can be considered as large and significant (beta = 1.58, SE = 0.10, 95% CI [1.38, 1.79], std. beta = 1.91, p < .001).
## https://github.com/EmilHvitfeldt/gganonymize
-library(ggplot2)
-library(gganonymize)
-
-ggg <-
-ggplot(mtcars, aes(as.factor(cyl))) +
-geom_bar() +
-labs(
-title ="Test title",
-subtitle ="Test subtitle, this one have a lot lot lot lot lot more text then the rest",
-caption ="Test caption",
-tag =1
- ) +
-facet_wrap(~vs)
-
-gganonomize(ggg)
-
-
-
-
-
-
-这样写也是可以的，只不过最好先tidy数据
-早知道nature文章这么简单，10年前我也可以写啊！
-男宝宝的嘴巴要长些，哈哈。
-
-
-
-
-
-
-
-
-
-
-
-
-你肯定不会觉得这图好看。
-
-
-
