在函數中傳播多列

Question

通常我需要spread多個值列，如this問題所示。但我經常這樣做，我希望能夠編寫一個這樣的函數。

例如，給出的數據：

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

我們將回到問題中提供的答案，但現在讓我們從更幼稚的方法開始。

一個想法是spread每個值列獨立，然後加入的結果，即

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 

（我只是在情況下使用的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 

這裏的關鍵思想是，以解除引用使用!!操作，並使用sep論點spread控制所得到的值列名的參數key_col和value_cols[i]。

如果我們希望這個函數轉換爲接受的鍵和值列不帶引號的參數，我們可以修改它，如下所示：

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的字符。

回到在使用的gather，unite和spread序列中的鏈接的問題解決方案，我們可以利用我們的經驗，使這樣的功能：

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 

這依賴於相同來自最後一個例子的rlang的技術。我們使用一些不尋常的名稱，例如..var..作爲我們的中間變量，以減少與我們數據框中現有列名稱衝突的機會。

同時，我們也使用unite的sep參數來控制所產生的列名，所以在這種情況下，當我們spread我們強迫sep = NULL。