関数内に複数の列を広げる

Question

質問のように、しばしばspread複数の値の列が必要です。しかし、私は頻繁にこれを行う関数を書くことができれば十分です。

たとえば、データを与えられた：

set.seed(42) 
dat <- data_frame(id = rep(1:2,each = 2), 
        grp = rep(letters[1:2],times = 2), 
        avg = rnorm(4), 
        sd = runif(4)) 
> dat 
# A tibble: 4 x 4 
    id grp  avg  sd 
    <int> <chr>  <dbl>  <dbl> 
1  1  a 1.3709584 0.6569923 
2  1  b -0.5646982 0.7050648 
3  2  a 0.3631284 0.4577418 
4  2  b 0.6328626 0.7191123 

私のようなものを返す関数を作成したいと思います：

# A tibble: 2 x 5 
    id  a_avg  b_avg  a_sd  b_sd 
    <int>  <dbl>  <dbl>  <dbl>  <dbl> 
1  1 1.3709584 -0.5646982 0.6569923 0.7050648 
2  2 0.3631284 0.6328626 0.4577418 0.7191123 

はどのように私はそれを行うことができますか？

Answer 1

リンク先の質問に記載されている回答に戻りますが、今はもっと素朴なアプローチから始めましょう。

ひとつのアイデアは、すなわち

library(dplyr) 
library(tidyr) 
library(tibble) 

dat_avg <- dat %>% 
    select(-sd) %>% 
    spread(key = grp,value = avg) %>% 
    rename(a_avg = a, 
      b_avg = b) 

dat_sd <- dat %>% 
    select(-avg) %>% 
    spread(key = grp,value = sd) %>% 
    rename(a_sd = a, 
      b_sd = b) 

> full_join(dat_avg, 
      dat_sd, 
      by = 'id') 

# A tibble: 2 x 5 
    id  a_avg  b_avg  a_sd  b_sd 
    <int>  <dbl>  <dbl>  <dbl>  <dbl> 
1  1 1.3709584 -0.5646982 0.6569923 0.7050648 
2  2 0.3631284 0.6328626 0.4577418 0.7191123 

、個別spreadに各値の列で、その後、結果を結合するだろう（私たちは結合列の組み合わせの全てが表示されるような状況に遭遇するだけの場合にfull_joinを使用。それらのすべてで）

のはspreadのように動作しますが、あなたは文字としてkeyとvalue列を渡すことができる機能を見てみましょう：

ここ

spread_chr <- function(data, key_col, value_cols, fill = NA, 
         convert = FALSE,drop = TRUE,sep = NULL){ 
    n_val <- length(value_cols) 
    result <- vector(mode = "list", length = n_val) 
    id_cols <- setdiff(names(data), c(key_col,value_cols)) 

    for (i in seq_along(result)){ 
     result[[i]] <- spread(data = data[,c(id_cols,key_col,value_cols[i]),drop = FALSE], 
           key = !!key_col, 
           value = !!value_cols[i], 
           fill = fill, 
           convert = convert, 
           drop = drop, 
           sep = paste0(sep,value_cols[i],sep)) 
    } 

    result %>% 
     purrr::reduce(.f = full_join, by = id_cols) 
} 

> dat %>% 
    spread_chr(key_col = "grp", 
      value_cols = c("avg","sd"), 
      sep = "_") 

# A tibble: 2 x 5 
    id grp_avg_a grp_avg_b grp_sd_a grp_sd_b 
    <int>  <dbl>  <dbl>  <dbl>  <dbl> 
1  1 1.3709584 -0.5646982 0.6569923 0.7050648 
2  2 0.3631284 0.6328626 0.4577418 0.7191123 

キーアイデアは!!演算子を使用し、そして得られた値の列名を制御するためにspreadでsep引数を使用して、引数key_colとvalue_cols[i]をUNQUOTEになっています。

我々はキーと値の列の引用符で囲まれていない引数を受け入れるように、この機能を変換したい場合は、私たちが同じようにそれを修正することができます：

spread_nq <- function(data, key_col,..., fill = NA, 
         convert = FALSE, drop = TRUE, sep = NULL){ 
    val_quos <- rlang::quos(...) 
    key_quo <- rlang::enquo(key_col) 
    value_cols <- unname(tidyselect::vars_select(names(data),!!!val_quos)) 
    key_col <- unname(tidyselect::vars_select(names(data),!!key_quo)) 

    n_val <- length(value_cols) 
    result <- vector(mode = "list",length = n_val) 
    id_cols <- setdiff(names(data),c(key_col,value_cols)) 

    for (i in seq_along(result)){ 
     result[[i]] <- spread(data = data[,c(id_cols,key_col,value_cols[i]),drop = FALSE], 
           key = !!key_col, 
           value = !!value_cols[i], 
           fill = fill, 
           convert = convert, 
           drop = drop, 
           sep = paste0(sep,value_cols[i],sep)) 
    } 

    result %>% 
     purrr::reduce(.f = full_join,by = id_cols) 
} 

> dat %>% 
    spread_nq(key_col = grp,avg,sd,sep = "_") 

# A tibble: 2 x 5 
    id grp_avg_a grp_avg_b grp_sd_a grp_sd_b 
    <int>  <dbl>  <dbl>  <dbl>  <dbl> 
1  1 1.3709584 -0.5646982 0.6569923 0.7050648 
2  2 0.3631284 0.6328626 0.4577418 0.7191123 

ここでの変更は、私たちがrlang::quosとrlang::enquoで引用符で囲まれていない引数を取り込むことですtidyselect::vars_selectを使用して文字に戻します。

spread_nt <- function(data,key_col,...,fill = NA, 
         convert = TRUE,drop = TRUE,sep = "_"){ 
    key_quo <- rlang::enquo(key_col) 
    val_quos <- rlang::quos(...) 
    value_cols <- unname(tidyselect::vars_select(names(data),!!!val_quos)) 
    key_col <- unname(tidyselect::vars_select(names(data),!!key_quo)) 

    data %>% 
    gather(key = ..var..,value = ..val..,!!!val_quos) %>% 
    unite(col = ..grp..,c(key_col,"..var.."),sep = sep) %>% 
    spread(key = ..grp..,value = ..val..,fill = fill, 
      convert = convert,drop = drop,sep = NULL) 
} 

> dat %>% 
    spread_nt(key_col = grp,avg,sd,sep = "_") 

# A tibble: 2 x 5 
    id  a_avg  a_sd  b_avg  b_sd 
* <int>  <dbl>  <dbl>  <dbl>  <dbl> 
1  1 1.3709584 0.6569923 -0.5646982 0.7050648 
2  2 0.3631284 0.4577418 0.6328626 0.7191123 

これは同じに依存している：gather、uniteとspreadのシーケンスを使用するリンク問題の解決に戻って

、我々はこのような関数を作るために学んだことを使用することができます最後の例からのrlangのテクニック。私たちはデータフレーム内の既存の列との名前の衝突の可能性を減らすために、中間変数に..var..のような珍しい名前を使用しています。

また、我々は我々spreadたちがsep = NULLを強制するときに、この場合のように結果のカラム名を制御するためにuniteでsep引数を使用しています。