メモ: multi-gatherをpurrrでやってみる

昨日の記事のコメント欄でmap()を使うやり方を教えてもらったので、触発されて自分でもやってみる。

library(tibble)
library(purrr)

d <- tribble(
  ~testA_score, ~testA_type, ~testB_score, ~testB_type,
           100,         "x",           90,          "y",
            80,         "y",           10,          "z",
            44,         "z",           19,          "z",
            44,         "x",           77,          "x"
)

案1

とりあえず、test = <testAかtestBか>と<キー名> = <値>というのを要素にもつリストをつくる。

d_list <- imap(d, function(value, name) {
  name_pair <- strsplit(name, "_")[[1]]
  test <- name_pair[1]
  key <- name_pair[2]
  lst(test = !! test, !! key := value)
})

str(d_list)
#> List of 4
#>  $ testA_score:List of 2
#>   ..$ test : chr "testA"
#>   ..$ score: num [1:4] 100 80 44 44
#>  $ testA_type :List of 2
#>   ..$ test: chr "testA"
#>   ..$ type: chr [1:4] "x" "y" "z" "x"
#>  $ testB_score:List of 2
#>   ..$ test : chr "testB"
#>   ..$ score: num [1:4] 90 10 19 77
#>  $ testB_type :List of 2
#>   ..$ test: chr "testB"
#>   ..$ type: chr [1:4] "y" "z" "z" "x"

で、これを testA/testB ごとに data.frame にまとめて bind_rows() するだけの簡単なお仕事だと思ったら...

d_list %>%
  split(map_chr(., "test")) %>%
  map(flatten) %>%
  # as_tibble() は重複したカラム（ここではtest）を受け付けないので省いておく
  map(~ .[!duplicated(names(.))]) %>%
  map_dfr(as_tibble, .id = "test")
#> # A tibble: 8 x 4
#>    test  test score  type
#>   <chr> <chr> <dbl> <chr>
#> 1 testA testA   100     x
#> 2 testA testA    80     y
#> 3 testA testA    44     z
#> 4 testA testA    44     x
#> 5 testB testB    90     y
#> 6 testB testB    10     z
#> 7 testB testB    19     z
#> 8 testB testB    77     x

なんか手元のパッケージはバグってるっぽい。。

追記(2017/12/06)：

Twitterで指摘をもらいましたが、testはすでに要素の中身に含まれているので.idで要素名を含める必要はないんでした...

d_list %>%
  split(map_chr(., "test")) %>%
  map(flatten) %>%
  map(~ .[!duplicated(names(.))]) %>%
  map_dfr(as_tibble)
#> # A tibble: 8 x 3
#>    test score  type
#>   <chr> <dbl> <chr>
#> 1 testA   100     x
#> 2 testA    80     y
#> 3 testA    44     z
#> 4 testA    44     x
#> 5 testB    90     y
#> 6 testB    10     z
#> 7 testB    19     z
#> 8 testB    77     x

案2

walk()しつつ、<<-を使ってグローバル環境にあるオブジェクトに入れていくパターン。

library(zeallot)

result <- list()

iwalk(d, function(x, y) {
  c(test, key) %<-% strsplit(y, "_")[[1]]
  result[[test]] <<- list_modify(result[[test]] %||% list(), !! key := x)
})

dplyr::bind_rows(result, .id = "test")
#> # A tibble: 8 x 3
#>    test score  type
#>   <chr> <dbl> <chr>
#> 1 testA   100     x
#> 2 testA    80     y
#> 3 testA    44     z
#> 4 testA    44     x
#> 5 testB    90     y
#> 6 testB    10     z
#> 7 testB    19     z
#> 8 testB    77     x

案3

melt()を使うとできる、とkohskeさんから教えてもらいました。reshape2まったくわからないので手が出ません。。