まずは蝋の翼から。

学んだことを書きながら確認・整理するためのメモブログ。こういうことなのかな?といったことをふわっと書いたりしていますが、理解が浅いゆえに的はずれなことも多々あると思うのでツッコミ歓迎

Rのrowwriseでmap関数を使わずに行ごと関数適応をおこなう

今まではsapplypurrr::mapを用いて行ごとの処理をおこなっていたが、rowwiseを用いて同様の処理を簡潔におこなえるようになった模様。

dplyr.tidyverse.org

いったん、簡単な例として、集約関数で試す。 なお、2020/04/12時点ではdplyrの開発版から可能。

devtools::install_github("tidyverse/dplyr") # 2020/04/12時点

library(tidyverse)

df <- tibble(
  student_id = 1:4, 
  test1 = 10:13, 
  test2 = 20:23, 
  test3 = 30:33, 
  test4 = 40:43
)

# rowwise処理
rf <- rowwise(df, student_id)


rf %>% mutate(avg = mean(c(test1, test2, test3, test4)))
#> # A tibble: 4 x 6
#> # Rowwise:  student_id
#>   student_id test1 test2 test3 test4   avg
#>        <int> <int> <int> <int> <int> <dbl>
#> 1          1    10    20    30    40    25
#> 2          2    11    21    31    41    26
#> 3          3    12    22    32    42    27
#> 4          4    13    23    33    43    28

また、across版のc()としてc_acrossを用いることもできる。

knknkn.hatenablog.com

rf %>% mutate(avg = mean(c_across(starts_with("test"))))
#> # A tibble: 4 x 6
#> # Rowwise:  student_id
#>   student_id test1 test2 test3 test4   avg
#>        <int> <int> <int> <int> <int> <dbl>
#> 1          1    10    20    30    40    25
#> 2          2    11    21    31    41    26
#> 3          3    12    22    32    42    27
#> 4          4    13    23    33    43    28

なお、上述の場合は既存の方法でも可能だし、そっちのほうが処理が早い。

df %>% mutate(avg = (test1 + test2 + test3 + test4) / 4,
              min = pmin(test1, test2, test3, test4), 
              max = pmax(test1, test2, test3, test4), 
              string = paste(test1, test2, test3, test4, sep = "-"))

# # A tibble: 4 x 9
# student_id test1 test2 test3 test4   avg   min   max string     
# <int> <int> <int> <int> <int> <dbl> <int> <int> <chr>      
# 1          1    10    20    30    40    25    10    40 10-20-30-40
# 2          2    11    21    31    41    26    11    41 11-21-31-41
# 3          3    12    22    32    42    27    12    42 12-22-32-42
# 4          4    13    23    33    43    28    13    43 13-23-33-43

rowwiseの利便性はlistデータを扱うときに発揮される。例えば、行ごとに関数を適用したい場合、今まではsapplypurrr::map系を使う必要があった。

# そのまま適用すると全体の数になる

df %>% mutate(l = length(x))
#> # A tibble: 3 x 2
#>   x             l
#>   <list>    <int>
#> 1 <dbl [1]>     3
#> 2 <int [2]>     3
#> 3 <int [3]>     3

# sapply
df %>% mutate(l = sapply(x, length))
#> # A tibble: 3 x 2
#>   x             l
#>   <list>    <int>
#> 1 <dbl [1]>     1
#> 2 <int [2]>     2
#> 3 <int [3]>     3

# map系
df %>% mutate(l = purrr::map_int(x, length))
#> # A tibble: 3 x 2
#>   x             l
#>   <list>    <int>
#> 1 <dbl [1]>     1
#> 2 <int [2]>     2
#> 3 <int [3]>     3

rowwiseを用いると関数がそのまま適用できる。

# rowwiseで行ごと処理 
df %>%
  rowwise() %>%
  mutate(l = length(x))
#> # A tibble: 3 x 2
#> # Rowwise: 
#>   x             l
#>   <list>    <int>
#> 1 <dbl [1]>     1
#> 2 <int [2]>     2
#> 3 <int [3]>     3

また、モデル構築も簡潔に書くことができる。

# mtcarsを使用
head(mtcars)
# mpg cyl disp  hp drat    wt  qsec vs am gear carb
# Mazda RX4         21.0   6  160 110 3.90 2.620 16.46  0  1    4    4
# Mazda RX4 Wag     21.0   6  160 110 3.90 2.875 17.02  0  1    4    4
# Datsun 710        22.8   4  108  93 3.85 2.320 18.61  1  1    4    1
# Hornet 4 Drive    21.4   6  258 110 3.08 3.215 19.44  1  0    3    1
# Hornet Sportabout 18.7   8  360 175 3.15 3.440 17.02  0  0    3    2
# Valiant           18.1   6  225 105 2.76 3.460 20.22  1  0    3    1

# nest化して行ごとにdataのlistを持つ
by_cyl <- mtcars %>% 
  nest_by(cyl)
# # A tibble: 3 x 2
# # Rowwise:  cyl
# cyl            data
# <dbl> <list<df[,10]>>
# 1     4       [11 × 10]
# 2     6        [7 × 10]
# 3     8       [14 × 10]

# 行毎にモデルを構築して予測結果も出す。その際はlistとして格納
mods <- by_cyl %>%
  mutate(mod = list(lm(mpg ~ wt, data = data)),
         pred = list(predict(mod, data)))
# # A tibble: 3 x 3
# # Rowwise:  cyl
# cyl            data mod   
# <dbl> <list<df[,10]>> <list>
#   1     4       [11 × 10] <lm>  
#   2     6        [7 × 10] <lm>  
#   3     8       [14 × 10] <lm>  

# modelの性能
mods %>% summarise(broom::glance(mod))
#> # A tibble: 3 x 12
#> # Rowwise:  cyl
#>     cyl r.squared adj.r.squared sigma statistic p.value    df logLik   AIC   BIC
#>   <dbl>     <dbl>         <dbl> <dbl>     <dbl>   <dbl> <int>  <dbl> <dbl> <dbl>
#> 1     4     0.509         0.454  3.33      9.32  0.0137     2 -27.7   61.5  62.7
#> 2     6     0.465         0.357  1.17      4.34  0.0918     2  -9.83  25.7  25.5
#> 3     8     0.423         0.375  2.02      8.80  0.0118     2 -28.7   63.3  65.2
#> # … with 2 more variables: deviance <dbl>, df.residual <int>

# RMSE
mods %>% summarise(rmse = sqrt(mean((pred - data$mpg) ^ 2)))
#> # A tibble: 3 x 2
#> # Rowwise:  cyl
#>     cyl  rmse
#>   <dbl> <dbl>
#> 1     4 3.01 
#> 2     6 0.985
#> 3     8 1.87


# model係数
mods %>% summarise(broom::tidy(mod))
#> # A tibble: 6 x 6
#> # Rowwise:  cyl
#>     cyl term        estimate std.error statistic    p.value
#>   <dbl> <chr>          <dbl>     <dbl>     <dbl>      <dbl>
#> 1     4 (Intercept)    39.6       4.35      9.10 0.00000777
#> 2     4 wt             -5.65      1.85     -3.05 0.0137    
#> 3     6 (Intercept)    28.4       4.18      6.79 0.00105   
#> 4     6 wt             -2.78      1.33     -2.08 0.0918    
#> # … with 2 more rows