TokyoR#108_NestedDataHandling

第108回Tokyo.Rでトークした際のスライド資料です。

Transcript

1. #108 @kilometer00 2021.09.02 Nested data handling
2. Who！？ Who?
3. Who！？ ・ @kilometer ・特任教員 (Ph.D. Eng.) ・神経科学 ・⾏動計算論 ・データ可視化 ・R： ~ 15 years ・近況：京極堂 (鵺でるよ！)
4. 宣伝!!（書籍の翻訳に参加しました。） 絶賛販売中！
5. 宣伝!! ☝ Rを使ったデータ科学の基礎を 統数研 on siteで2⽇間かけて学びます！ (宿泊・交通費の補助あり！) 12⽉に開催予定！
6. #108 @kilometer00 2021.09.02 Nested data handling
7. 表データの加⼯と可視化の概観 Long Wide Nested plot Figures Data table read_csv write_csv pivot_longer pivot_wider group_nest unnest ggplot ggsave wrap_plots map rowwise
8. 基礎知識
9. 1JQF
   BMHFCSB X %>% f X %>% f(y) X %>% f %>% g X %>% f(y, .) f(X) f(X, y) g(f(X)) f(y, X) %>% {magrittr} 「dplyr再⼊⾨（基本編）」yutanihilation https://speakerdeck.com/yutannihilation/dplyrzai-ru-men-ji-ben-bian
10. ?data.frame list( x = c(1:3), y = letters[1:3], z = seq(3, 5, by = 1)) ## $x ## [1] 1 2 3 ## ## $y ## [1] "a" "b" "c" ## ## $z ## [1] 3 4 5
11. ?data.frame data.frame( x = c(1:3), y = letters[1:3], z = seq(3, 5, by = 1)) ## x y z ## 1 1 a 3 ## 2 2 b 4 ## 3 3 c 5
12. ?data.frame data.frame( x = c(1:3), y = letters[1:3], z = seq(3, 5, by = 1)) ## x y z ## 1 1 a 3 ## 2 2 b 4 ## 3 3 c 5 observation variable
13. Nested dataの準備
14. dat <- palmerpenguins::penguins %>% na.omit() # NAを含む行の除去 パイプ演算⼦ パッケージ名 > dat # A tibble: 333 × 8 species island bill_length_mm bill_depth_mm flipper_length_mm body_mass_g sex year <fct> <fct> <dbl> <dbl> <int> <int> <fct> <int> 1 Adelie Torgersen 39.1 18.7 181 3750 male 2007 2 Adelie Torgersen 39.5 17.4 186 3800 female 2007 3 Adelie Torgersen 40.3 18 195 3250 female 2007 4 Adelie Torgersen 36.7 19.3 193 3450 female 2007 5 Adelie Torgersen 39.3 20.6 190 3650 male 2007 6 Adelie Torgersen 38.9 17.8 181 3625 female 2007 7 Adelie Torgersen 39.2 19.6 195 4675 male 2007 8 Adelie Torgersen 41.1 17.6 182 3200 female 2007 9 Adelie Torgersen 38.6 21.2 191 3800 male 2007 10 Adelie Torgersen 34.6 21.1 198 4400 male 2007 # … with 323 more rows # ℹ Use `print(n = ...)` to see more rows データの準備
15. 「 tibble?ああ, あれは美味しいよね.」 data.frameに⽐べて ・⾊々厳密になっている → 再利⽤規則, データ型, 変数参照, etc. ・遅延評価に対応 → tibble::tibble()で作成するときなど ・list型オブジェクトをカラムに取れる ・⾏名は指定できない(数字表記のみ)
16. tibble::tibble( chr = letters[1:3], num = list(1:2, 2:3, 3:4) ) # A tibble: 3 × 2 chr num <chr> <list> 1 a <int [2]> 2 b <int [2]> 3 c <int [2]> 「 tibble?ああ, あれは美味しいよね.」 ・Nested data = listを内包するtibble list型 .$num[[1]]に c(1:2)が畳み込まれている
17. データを畳み込む dplyr::group_nest()
18. > dat # A tibble: 333 × 8 species island bill_length_mm bill_depth_mm flipper_length_mm body_mass_g sex year <fct> <fct> <dbl> <dbl> <int> <int> <fct> <int> 1 Adelie Torgersen 39.1 18.7 181 3750 male 2007 2 Adelie Torgersen 39.5 17.4 186 3800 female 2007 3 Adelie Torgersen 40.3 18 195 3250 female 2007 4 Adelie Torgersen 36.7 19.3 193 3450 female 2007 5 Adelie Torgersen 39.3 20.6 190 3650 male 2007 6 Adelie Torgersen 38.9 17.8 181 3625 female 2007 7 Adelie Torgersen 39.2 19.6 195 4675 male 2007 8 Adelie Torgersen 41.1 17.6 182 3200 female 2007 9 Adelie Torgersen 38.6 21.2 191 3800 male 2007 10 Adelie Torgersen 34.6 21.1 198 4400 male 2007 # … with 323 more rows # ℹ Use `print(n = ...)` to see more rows dat %>% tidyr::nest() # A tibble: 1 × 1 data <list> 1 <tibble [333 × 8]> データの畳み込み
19. dat %>% tidyr::nest() %>% .$data [[1]] # A tibble: 333 × 8 species island bill_length…¹ bill_…² flipp…³ body_…⁴ sex year <fct> <fct> <dbl> <dbl> <int> <int> <fct> <int> 1 Adelie Torgersen 39.1 18.7 181 3750 male 2007 2 Adelie Torgersen 39.5 17.4 186 3800 fema… 2007 3 Adelie Torgersen 40.3 18 195 3250 fema… 2007 4 Adelie Torgersen 36.7 19.3 193 3450 fema… 2007 5 Adelie Torgersen 39.3 20.6 190 3650 male 2007 6 Adelie Torgersen 38.9 17.8 181 3625 fema… 2007 7 Adelie Torgersen 39.2 19.6 195 4675 male 2007 8 Adelie Torgersen 41.1 17.6 182 3200 fema… 2007 9 Adelie Torgersen 38.6 21.2 191 3800 male 2007 10 Adelie Torgersen 34.6 21.1 198 4400 male 2007 # … with 323 more rows, and abbreviated variable names # ¹bill_length_mm, ²bill_depth_mm, ³flipper_length_mm, ⁴body_mass_g # ℹ Use `print(n = ...)` to see more rows
20. dat %>% tidyr::nest() %$% data [[1]] # A tibble: 333 × 8 species island bill_length…¹ bill_…² flipp…³ body_…⁴ sex year <fct> <fct> <dbl> <dbl> <int> <int> <fct> <int> 1 Adelie Torgersen 39.1 18.7 181 3750 male 2007 2 Adelie Torgersen 39.5 17.4 186 3800 fema… 2007 3 Adelie Torgersen 40.3 18 195 3250 fema… 2007 4 Adelie Torgersen 36.7 19.3 193 3450 fema… 2007 5 Adelie Torgersen 39.3 20.6 190 3650 male 2007 6 Adelie Torgersen 38.9 17.8 181 3625 fema… 2007 7 Adelie Torgersen 39.2 19.6 195 4675 male 2007 8 Adelie Torgersen 41.1 17.6 182 3200 fema… 2007 9 Adelie Torgersen 38.6 21.2 191 3800 male 2007 10 Adelie Torgersen 34.6 21.1 198 4400 male 2007 # … with 323 more rows, and abbreviated variable names # ¹bill_length_mm, ²bill_depth_mm, ³flipper_length_mm, ⁴body_mass_g # ℹ Use `print(n = ...)` to see more rows ドル演算⼦ (magrittrパッケージ) リストになっていることに注意
21. dat %>% tidyr::nest() %$% data %>% .[[1]] # A tibble: 333 × 8 species island bill_length…¹ bill_…² flipp…³ body_…⁴ sex year <fct> <fct> <dbl> <dbl> <int> <int> <fct> <int> 1 Adelie Torgersen 39.1 18.7 181 3750 male 2007 2 Adelie Torgersen 39.5 17.4 186 3800 fema… 2007 3 Adelie Torgersen 40.3 18 195 3250 fema… 2007 4 Adelie Torgersen 36.7 19.3 193 3450 fema… 2007 5 Adelie Torgersen 39.3 20.6 190 3650 male 2007 6 Adelie Torgersen 38.9 17.8 181 3625 fema… 2007 7 Adelie Torgersen 39.2 19.6 195 4675 male 2007 8 Adelie Torgersen 41.1 17.6 182 3200 fema… 2007 9 Adelie Torgersen 38.6 21.2 191 3800 male 2007 10 Adelie Torgersen 34.6 21.1 198 4400 male 2007 # … with 323 more rows, and abbreviated variable names # ¹bill_length_mm, ²bill_depth_mm, ³flipper_length_mm, ⁴body_mass_g # ℹ Use `print(n = ...)` to see more rows ドル演算⼦ (magrittrパッケージ)
22. dat %>% dplyr::group_by(island) %>% tidyr::nest() # A tibble: 3 × 2 # Groups: island [3] island data <fct> <list> 1 Torgersen <tibble [47 × 7]> 2 Biscoe <tibble [163 × 7]> 3 Dream <tibble [123 × 7]> 畳み込みたい⽔準で 事前にグループ化しておく
23. dat %>% dplyr::group_by(island) %>% tidyr::nest() # A tibble: 3 × 2 # Groups: island [3] island data <fct> <list> 1 Torgersen <tibble [47 × 7]> 2 Biscoe <tibble [163 × 7]> 3 Dream <tibble [123 × 7]> 畳み込みたい⽔準で 事前にグループ化しておく
24. dat %>% dplyr::group_by(island) %>% tidyr::nest() 畳み込みたい⽔準で 事前にグループ化しておく dat %>% tidyr::nest(.by = island) dat %>% dplyr::group_nest(island) グループ化と畳み込みを ⼀括でやってくれる
25. > group_nest function (.tbl, ..., .key = "data", keep = FALSE) { lifecycle::signal_stage("experimental", "group_nest()") UseMethod("group_nest") } <bytecode: 0x7fad13ae5120> <environment: namespace:dplyr> 畳み込みたいデータ (data.frame / tibble) 畳み込む⽔準 (カラム名, NSE) 畳み込み先のカラム名 (⽂字列) 畳み込み⽔準も畳み込むか (TRUE / FALSE)
26. dat %>% dplyr::group_nest() # A tibble: 1 × 1 data <list> 1 <tibble [333 × 8]> dat %>% dplyr::group_nest(species) # A tibble: 3 × 2 species data <fct> <list<tibble[,7]>> 1 Adelie [146 × 7] 2 Chinstrap [68 × 7] 3 Gentoo [119 × 7] dat %>% dplyr::group_nest(.key = "hoge") # A tibble: 1 × 1 hoge <list> 1 <tibble [333 × 8]> 指定なし＝データ全体を1x1に畳み込む tidyr::nest()関数でも同じ結果になる。 畳み込み⽔準を指定 畳み込み先のカラム名を⽂字列で指定
27. dat %>% dplyr::group_nest(species) # A tibble: 3 × 2 species data <fct> <list<tibble[,7]>> 1 Adelie [146 × 7] 2 Chinstrap [68 × 7] 3 Gentoo [119 × 7] dat %>% dplyr::group_nest("species") # A tibble: 1 × 2 `"species"` data <chr> <list<tibble[,8]>> 1 species [333 × 8] 畳み込み⽔準を⽂字列で指定 新しいchrカラムを作ってそれで 全体を畳み込むという挙動になる (⾮推奨) 畳み込み⽔準をNSEで指定 (推奨)
28. dat %>% group_nest(species, keep = TRUE) # A tibble: 3 × 2 species data <fct> <list<tibble[,8]>> 1 Adelie [146 × 8] 2 Chinstrap [68 × 8] 3 Gentoo [119 × 8] dat %>% group_nest(species, keep = FALSE) # A tibble: 3 × 2 species data <fct> <list<tibble[,7]>> 1 Adelie [146 × 7] 2 Chinstrap [68 × 7] 3 Gentoo [119 × 7]
29. dat %>% group_nest(species, keep = TRUE) %$% data %>% .[[1]] %>% names() dat %>% group_nest(species, keep = FALSE) %$% data %>% .[[1]] %>% names() [1] "species" "island" "bill_length_mm" [4] "bill_depth_mm" "flipper_length_mm" "body_mass_g" [7] "sex" "year" [1] "island" "bill_length_mm" "bill_depth_mm" [4] "flipper_length_mm" "body_mass_g" "sex" [7] "year"
30. dat %>% group_nest(species, island) # A tibble: 5 × 3 species island data <fct> <fct> <list<tibble[,6]>> 1 Adelie Biscoe [44 × 6] 2 Adelie Dream [55 × 6] 3 Adelie Torgersen [47 × 6] 4 Chinstrap Dream [68 × 6] 5 Gentoo Biscoe [119 × 6] 複数の⽔準を指定できる
31. 畳み込みデータを展開する tidyr::unnest()
32. dat_nest <- dat %>% dplyr::group_nest(species) # A tibble: 3 × 2 species data <fct> <list<tibble[,7]>> 1 Adelie [146 × 7] 2 Chinstrap [68 × 7] 3 Gentoo [119 × 7] dat_nest %>% tidyr::unnest(cols = data) データの展開 展開するカラム名 (NSE or ⽂字列)
33. dat_nest_ex <- tibble::tibble( chr = list(letters[1:3]), num = list(1:3) ) # A tibble: 1 × 2 chr num <list> <list> 1 <chr [3]> <int [3]> dat_nest_ex %>% tidyr::unnest(cols = chr) # A tibble: 3 × 2 chr num <chr> <list> 1 a <int [3]> 2 b <int [3]> 3 c <int [3]> 指定されたchrは展開され、 展開されなかったnumは複製される
34. dat_nest_ex2 <- tibble::tibble( chr1 = list(letters[1:3]), chr2 = list(letters[4:6]), num = list(1:3) ) # A tibble: 1 × 3 chr1 chr2 num <list> <list> <list> 1 <chr [3]> <chr [3]> <int [3]>
35. dat_nest_ex2 %>% tidyr::unnest(cols = chr1) # A tibble: 3 × 3 chr1 chr2 num <chr> <list> <list> 1 a <chr [3]> <int [3]> 2 b <chr [3]> <int [3]> 3 c <chr [3]> <int [3]>
36. dat_nest_ex2 %>% tidyr::unnest(cols = chr1) %>% tidyr::unnest(cols = chr2) # A tibble: 9 × 3 chr1 chr2 num <chr> <chr> <list> 1 a d <int [3]> 2 a e <int [3]> 3 a f <int [3]> 4 b d <int [3]> 5 b e <int [3]> 6 b f <int [3]> 7 c d <int [3]> 8 c e <int [3]> 9 c f <int [3]>
37. dat_nest_ex2 %>% tidyr::unnest(cols = c(chr1, chr2)) # A tibble: 3 × 3 chr1 chr2 num <chr> <chr> <list> 1 a d <int [3]> 2 b e <int [3]> 3 c f <int [3]> ⼀度に展開される列同⼠では対応関係が 保持される（要素数が等しくないとエラー）
38. dat_nest_ex2 %>% tidyr::unnest( tidyselect::starts_with("chr") ) # A tibble: 3 × 3 chr1 chr2 num <chr> <chr> <list> 1 a d <int [3]> 2 b e <int [3]> 3 c f <int [3]> 列指定にはselectヘルプ関数が使える
39. dat_nest_ex2 %>% tidyr::unnest( tidyselect::everything() ) # A tibble: 3 × 3 chr1 chr2 num <chr> <chr> <int> 1 a d 1 2 b e 2 3 c f 3 列指定にはselectヘルプ関数が使える
40. データを畳み込む dplyr::group_nest() 畳み込みデータを展開する tidyr::unnest()
41. 畳み込みデータを使う purrr::map()
42. a <- c(1:5) a * 3 [1] 3 6 9 12 15 b <- list(1:2, 3:4) b * 3 Error in b * 3 : non-numeric argument to binary operator ベクトルの要素に対する演算 リストの要素に対する演算
43. a <- c(1:5) a * 3 [1] 3 6 9 12 15 b <- list(1:2, 3:4) b %>% purrr::map(function(x){x * 3}) [[1]] [1] 3 6 [[2]] [1] 9 12 ベクトルの要素に対する演算 リストの要素に対する演算
44. b %>% purrr::map(function(x){x * 3}) f <- function(x){x * 3} b %>% purrr::map(f) # b %>% map(f())はエラー b %>% purrr::map(~(.x * 3)) b %>% purrr::map(~(. * 3)) b %>% purrr::map(∖(x){x * 3}) 表記⽅は⾊々（結果は同じ） ↑これが今⾵なんだけどPowerPointでは バックスラッシュが表⽰できないので却下 (Macだけ？)
45. dat <- tibble::tibble( chr = letters[1:3], num = 1:3 ) dat %>% dplyr::mutate(x = num * 3) # A tibble: 3 × 3 chr num x <chr> <int> <dbl> 1 a 1 3 2 b 2 6 3 c 3 9 普通のテーブルデータの場合 ベクトルの演算と⼀緒
46. dat <- tibble::tibble( chr = letters[1:3] , num = list(1:2, 2:3, 3:4) ) dat %>% dplyr::mutate(x = num * 3) Error in `dplyr::mutate()`: ℹ In argument: `x = num * 3`. Caused by error in `num * 3`: ! non-numeric argument to binary operator Run `rlang::last_trace()` to see where the error occurred. 畳み込みデータの場合
47. dat <- tibble::tibble( chr = letters[1:3], num = list(1:2, 2:3, 3:4) ) dat %>% dplyr::mutate(x = map(num, ~(. * 3))) # A tibble: 3 × 3 chr num x <chr> <list> <list> 1 a <int [2]> <dbl [2]> 2 b <int [2]> <dbl [2]> 3 c <int [2]> <dbl [2]> 畳み込みデータの場合
48. dat <- tibble::tibble( chr = letters[1:3], num = list(1:2, 2:3, 3:4) ) dat %>% dplyr::mutate(x = map(num, mean)) # A tibble: 3 × 3 chr num x <chr> <list> <list> 1 a <int [2]> <dbl [1]> 2 b <int [2]> <dbl [1]> 3 c <int [2]> <dbl [1]> 畳み込みデータの場合
49. dat <- tibble::tibble( chr = letters[1:3], num = list(1:2, 2:3, 3:4) ) dat %>% dplyr::mutate(x = map(num, mean)) %>% dplyr::mutate(x = unlist(x)) # A tibble: 3 × 3 chr num x <chr> <list> <dbl> 1 a <int [2]> 1.5 2 b <int [2]> 2.5 3 c <int [2]> 3.5 畳み込みデータの場合
50. dat <- tibble::tibble( chr = letters[1:3], num = list(1:2, 2:3, 3:4) ) dat %>% dplyr::mutate(x = map_dbl(num, mean)) # A tibble: 3 × 3 chr num x <chr> <list> <dbl> 1 a <int [2]> 1.5 2 b <int [2]> 2.5 3 c <int [2]> 3.5 畳み込みデータの場合
51. dat <- tibble::tibble( chr = list("abc", "cdf", "ghr"), num = 1:3 ) dat %>% dplyr::mutate(x = map_chr( chr, ~ stringr::str_sub(., 1, 2))) # A tibble: 3 × 3 chr num x <list> <int> <chr> 1 <chr [1]> 1 ab 2 <chr [1]> 2 de 3 <chr [1]> 3 gh 畳み込みデータの場合
52. 実践例1
53. dat_nest <- palmerpenguins::penguins %>% na.omit() %>% group_nest(island) # A tibble: 3 × 2 island data <fct> <list<tibble[,7]>> 1 Biscoe [163 × 7] 2 Dream [123 × 7] 3 Torgersen [47 × 7] 実践例1
54. dat_g <- dat_nest$data[[1]] dat_g %>% ggplot(data = .) + aes(x = bill_length_mm, y = body_mass_g, color = species) + geom_point() 実践例1
55. gg_pen <- function(data){ data %>% ggplot(data = .) + aes(x = bill_length_mm, y = body_mass_g, color = species) + geom_point() } 実践例1
56. dat_nest # A tibble: 3 × 2 island data <fct> <list<tibble[,7]>> 1 Biscoe [163 × 7] 2 Dream [123 × 7] 3 Torgersen [47 × 7] 実践例1 dat_nest_g <- dat_nest %>% mutate(g = map(data, gg_pen)) # A tibble: 3 × 3 island data g <fct> <list<tibble[,7]>> <list> 1 Biscoe [163 × 7] <gg> 2 Dream [123 × 7] <gg> 3 Torgersen [47 × 7] <gg>
57. dat_nest_g$g 実践例1 dat_nest_g # A tibble: 3 × 3 island data g <fct> <list<tibble[,7]>> <list> 1 Biscoe [163 × 7] <gg> 2 Dream [123 × 7] <gg> 3 Torgersen [47 × 7] <gg> [[1]] [[2]] [[3]]
58. dat_nest_g %$% g %>% patchwork::wrap_plots(nrow = 1) 実践例1 dat_nest_g # A tibble: 3 × 3 island data g <fct> <list<tibble[,7]>> <list> 1 Biscoe [163 × 7] <gg> 2 Dream [123 × 7] <gg> 3 Torgersen [47 × 7] <gg>
59. dat_nest_g %>% mutate(g = map2( g, island, ~ .x + ggtitle(.y)) ) %$% g %>% patchwork::wrap_plots(nrow = 1) 実践例1 dat_nest_g # A tibble: 3 × 3 island data g <fct> <list<tibble[,7]>> <list> 1 Biscoe [163 × 7] <gg> 2 Dream [123 × 7] <gg> 3 Torgersen [47 × 7] <gg>
60. dat_nest_g %>% mutate(g = map2( g, island, ~ .x + ggtitle(.y)) ) %$% g %>% patchwork::wrap_plots(nrow = 1) 実践例1
61. dat_nest_g %>% mutate(g = map2( g, island, ∖(x, y){x + ggtitle(y)} ) %$% g %>% patchwork::wrap_plots(nrow = 1) 実践例1 ナウい書き⽅
62. dat_nest_g %>% dplyr::rowwise() %>% mutate(g = list(g + ggtitle(island))) %$% g %>% patchwork::wrap_plots(nrow = 1) 別解
63. 寄り道 dat %>% dplyr::group_nest(island) # A tibble: 3 × 2 island data <fct> <list<tibble[,7]>> 1 Biscoe [163 × 7] 2 Dream [123 × 7] 3 Torgersen [47 × 7] dat %>% dplyr::nest_by(island) # A tibble: 3 × 2 # Rowwise: island island data <fct> <list<tibble[,7]>> 1 Biscoe [163 × 7] 2 Dream [123 × 7] 3 Torgersen [47 × 7]
64. 寄り道：結果は⼀緒 dat %>% dplyr::group_nest(island) %>% mutate(g = purrr::map(data, gg_pen)) dat %>% dplyr::nest_by(island) %>% mutate(g = list(gg_pen(data)) dat %>% dplyr::nest_nest(island) %>% dplyr::rowwise() %>% mutate(g = list(gg_pen(data))
65. dplyr::rowwise()について https://notchained.hatenablog.com/entry/2020/07/04/211806
66. 実践例2
67. 実践例2 dat2 <- palmerpenguins::penguins %>% na.omit() %>% filter(island %in% c("Biscoe", "Dream")) %>% mutate(x = bill_length_mm, y = body_mass_g)
68. 実践例2 dat2 %>% gg_pen() + facet_wrap(~island)
69. 実践例2 dat2_nest <- dat2 %>% group_nest(island) # A tibble: 2 × 2 island data <fct> <list<tibble[,9]>> 1 Biscoe [163 × 9] 2 Dream [123 × 9]
70. 実践例2 models <- list( function(df){lm(y ~ 1, data = df)}, function(df){lm(y ~ x, data = df)}, function(df){lme4::lmer(y ~ x + (x|species), data = df)}, function(df){lme4::lmer(y ~ x + (1|species), data = df)}, function(df){lme4::lmer(y ~ x + (0 + x|species), data = df)} ) 回帰モデルの関数をlistにまとめる。 dat2_nest_model <- dat2_nest %>% nest() %>% # tibble: 1x1になる mutate(model = list(models)) %>% unnest(model) %>% # modelについて展開 tibble::rowid_to_column(“id”) %>% # model番号を振る unnest(data) # dataについて展開
71. 実践例2 dat2_nest_model # A tibble: 10 × 4 id island data model <int> <fct> <list<tibble[,9]>> <list> 1 1 Biscoe [163 × 9] <fn> 2 1 Dream [123 × 9] <fn> 3 2 Biscoe [163 × 9] <fn> 4 2 Dream [123 × 9] <fn> 5 3 Biscoe [163 × 9] <fn> 6 3 Dream [123 × 9] <fn> 7 4 Biscoe [163 × 9] <fn> 8 4 Dream [123 × 9] <fn> 9 5 Biscoe [163 × 9] <fn> 10 5 Dream [123 × 9] <fn> > dat2_nest_model$model[[5]] function(data){lme4::lmer(y ~ x + (x|species), data = data)} <bytecode: 0x7fad606a1fc8>
72. dat2_nest_model_fit <- dat2_nest_model %>% mutate(fit = map2(model, data, ~ .x(.y))) %>% mutate(AIC = map_dbl(fit, AIC)) # A tibble: 10 × 6 id island data model fit AIC <int> <fct> <list<tibble[,9]>> <list> <list> <dbl> 1 1 Biscoe [163 × 9] <fn> <lm> 2641. 2 1 Dream [123 × 9] <fn> <lm> 1834. 3 2 Biscoe [163 × 9] <fn> <lm> 2413. 4 2 Dream [123 × 9] <fn> <lm> 1824. 5 3 Biscoe [163 × 9] <fn> <lmerMod> 2393. 6 3 Dream [123 × 9] <fn> <lmerMod> 1787. 7 4 Biscoe [163 × 9] <fn> <lmerMod> 2389. 8 4 Dream [123 × 9] <fn> <lmerMod> 1787. 9 5 Biscoe [163 × 9] <fn> <lmerMod> 2390. 10 5 Dream [123 × 9] <fn> <lmerMod> 1785. 実践例2 cAICを使う⼿もある
73. dat2_nest_model_fit <- dat2_nest_model %>% mutate(fit = map2(model, data, ~ .x(.y))) %>% mutate(AIC = map_dbl(fit, AIC)) 実践例2 dat2_nest_model_fit <- dat2_nest_model %>% dplyr::rowwise() %>% mutate(fit = list(model(data))) %>% mutate(AIC = AIC(fit)) 別解
74. dat2_nest_model_minAIC <- dat2_nest_model_fit %>% group_by(island) %>% filter(AIC == min(AIC)) # A tibble: 2 × 6 # Groups: island [2] id island data model fit AIC <int> <fct> <list<tibble[,9]>> <list> <list> <dbl> 1 4 Biscoe [163 × 9] <fn> <lmerMod> 2389. 2 5 Dream [123 × 9] <fn> <lmerMod> 1785. 実践例2
75. dat2_nest_model_minAIC %$% rlang::set_names(fit, island) $Biscoe Linear mixed model fit by REML ['lmerMod'] Formula: y ~ x + (1 | species) Data: data ... $Dream Linear mixed model fit by REML ['lmerMod'] Formula: y ~ x + (0 + x | species) Data: data ... 実践例2 切⽚の混合効果 傾きの混合効果
76. 実践例2 dat2 %>% gg_pen() + facet_wrap(~island) 切⽚の混合効果 傾きの混合効果
77. dat2_model_minAIC_pred <- dat2_nest_model_minAIC %>% mutate(pred = map(fit, predict)) %>% select(island, data, pred) %>% unnest(everything()) # A tibble: 286 × 11 # Groups: island [2] island species bill_l…¹ bill_…² flipp…³ body_…⁴ sex year <fct> <fct> <dbl> <dbl> <int> <int> <fct> <int> 1 Biscoe Adelie 37.8 18.3 174 3400 fema… 2007 2 Biscoe Adelie 37.7 18.7 180 3600 male 2007 3 Biscoe Adelie 35.9 19.2 189 3800 fema… 2007 4 Biscoe Adelie 38.2 18.1 185 3950 male 2007 5 Biscoe Adelie 38.8 17.2 180 3800 male 2007 6 Biscoe Adelie 35.3 18.9 187 3800 fema… 2007 7 Biscoe Adelie 40.6 18.6 183 3550 male 2007 8 Biscoe Adelie 40.5 17.9 187 3200 fema… 2007 9 Biscoe Adelie 37.9 18.6 172 3150 fema… 2007 10 Biscoe Adelie 40.5 18.9 180 3950 male 2007 # … with 276 more rows, 3 more variables: x <dbl>, y <int>, # pred <dbl>, and abbreviated variable names # ¹bill_length_mm, ²bill_depth_mm, ³flipper_length_mm, # ⁴body_mass_g # ℹ Use `print(n = ...)` to see more rows, and `colnames()` to see all variable nam 実践例2
78. dat2_model_minAIC_pred %>% gg_pen() + geom_path(aes(y = pred)) + facet_wrap(~island) 実践例2 切⽚の混合効果 傾きの混合効果
79. まとめ
80. 表データの加⼯と可視化の概観 Long Wide Nested plot Figures Data table read_csv write_csv pivot_longer pivot_wider group_nest unnest ggplot ggsave wrap_plots map rowwise
81. Enjoy!!