Lock in $30 Savings on PRO—Offer Ends Soon! ⏳

TokyoR#108_NestedDataHandling

kilometer
September 02, 2023

 TokyoR#108_NestedDataHandling

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

kilometer

September 02, 2023
Tweet

More Decks by kilometer

Other Decks in Programming

Transcript

  1. 表データの加⼯と可視化の概観 Long Wide Nested plot Figures Data table read_csv write_csv

    pivot_longer pivot_wider group_nest unnest ggplot ggsave wrap_plots map rowwise
  2. 1JQFBMHFCSB 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
  3. ?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
  4. ?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
  5. ?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
  6. 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 データの準備
  7. 「 tibble?ああ, あれは美味しいよね.」 data.frameに⽐べて ・⾊々厳密になっている → 再利⽤規則, データ型, 変数参照, etc.

    ・遅延評価に対応 → tibble::tibble()で作成するときなど ・list型オブジェクトをカラムに取れる ・⾏名は指定できない(数字表記のみ)
  8. 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)が畳み込まれている
  9. > 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]> データの畳み込み
  10. 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
  11. 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パッケージ) リストになっていることに注意
  12. 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パッケージ)
  13. 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]> 畳み込みたい⽔準で 事前にグループ化しておく
  14. 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]> 畳み込みたい⽔準で 事前にグループ化しておく
  15. dat %>% dplyr::group_by(island) %>% tidyr::nest() 畳み込みたい⽔準で 事前にグループ化しておく dat %>% tidyr::nest(.by

    = island) dat %>% dplyr::group_nest(island) グループ化と畳み込みを ⼀括でやってくれる
  16. > 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)
  17. 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()関数でも同じ結果になる。 畳み込み⽔準を指定 畳み込み先のカラム名を⽂字列で指定
  18. 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で指定 (推奨)
  19. 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]
  20. 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"
  21. 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] 複数の⽔準を指定できる
  22. 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 ⽂字列)
  23. 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は複製される
  24. 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]>
  25. 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]>
  26. 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]>
  27. 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]> ⼀度に展開される列同⼠では対応関係が 保持される(要素数が等しくないとエラー)
  28. 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ヘルプ関数が使える
  29. 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ヘルプ関数が使える
  30. 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 ベクトルの要素に対する演算 リストの要素に対する演算
  31. 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 ベクトルの要素に対する演算 リストの要素に対する演算
  32. 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だけ?)
  33. 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 普通のテーブルデータの場合 ベクトルの演算と⼀緒
  34. 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. 畳み込みデータの場合
  35. 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]> 畳み込みデータの場合
  36. 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]> 畳み込みデータの場合
  37. 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 畳み込みデータの場合
  38. 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 畳み込みデータの場合
  39. 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 畳み込みデータの場合
  40. 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
  41. dat_g <- dat_nest$data[[1]] dat_g %>% ggplot(data = .) + aes(x

    = bill_length_mm, y = body_mass_g, color = species) + geom_point() 実践例1
  42. gg_pen <- function(data){ data %>% ggplot(data = .) + aes(x

    = bill_length_mm, y = body_mass_g, color = species) + geom_point() } 実践例1
  43. 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>
  44. 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]]
  45. 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>
  46. 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>
  47. dat_nest_g %>% mutate(g = map2( g, island, ~ .x +

    ggtitle(.y)) ) %$% g %>% patchwork::wrap_plots(nrow = 1) 実践例1
  48. dat_nest_g %>% mutate(g = map2( g, island, ∖(x, y){x +

    ggtitle(y)} ) %$% g %>% patchwork::wrap_plots(nrow = 1) 実践例1 ナウい書き⽅
  49. 寄り道 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]
  50. 寄り道:結果は⼀緒 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))
  51. 実践例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]
  52. 実践例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について展開
  53. 実践例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>
  54. 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を使う⼿もある
  55. 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)) 別解
  56. 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
  57. 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 切⽚の混合効果 傾きの混合効果
  58. 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
  59. 表データの加⼯と可視化の概観 Long Wide Nested plot Figures Data table read_csv write_csv

    pivot_longer pivot_wider group_nest unnest ggplot ggsave wrap_plots map rowwise