Spread mehrere Spalten in einer Funktion

Question

Oft muss ich spread mehrere Wert Spalten, wie in this Frage. Aber ich mache es oft genug, dass ich gerne eine Funktion schreiben könnte, die das tut.

Zum Beispiel angesichts der Daten:

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 

Ich möchte eine Funktion erstellen, die wie etwas zurückgibt:

# 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 

Wie kann ich das tun?

Answer 1

Wir werden auf die Antwort in der verknüpften Frage zurückkommen, aber im Moment beginnen wir mit einem naiveren Ansatz.

Eine Idee wäre, spread jeder Spalte Wert einzeln, und dann die Ergebnisse kommen, dh

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 

(ich full_join nur für den Fall haben wir in Situationen führen, wo nicht alle Kombinationen der Join-Spalten erscheinen . in allen von ihnen)

beginnen wir mit einer Start-Funktion, die wie spread funktioniert, aber können Sie die key und value Spalten als Zeichen weitergeben müssen:

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 

Die wichtigsten Ideen, die hier sind die Argumente unquote key_col und value_cols[i] den !!-Operator, und mit Hilfe des sep Arguments in spread die resultierenden Wert Spaltennamen zu steuern.

Wenn wir diese Funktion zu übernehmen unquoted Argumente für den Schlüssel und Wert Spalten konvertieren wollten, könnten wir es wie so ändern:

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 

Die hier Änderung ist, dass wir die nicht notierten Argumente mit rlang::quos erfassen und rlang::enquo und wandeln Sie sie dann einfach unter Verwendung von tidyselect::vars_select in Zeichen zurück.

Rückkehr in die Lösung in der verknüpften Frage, die eine Folge von gather, unite verwendet und spread, können wir nutzen, was wir haben eine Funktion wie diese machen gelernt:

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 

Diese auf dem gleichen stützt Techniken von rlang aus dem letzten Beispiel. Wir verwenden einige ungewöhnliche Namen wie ..var.. für unsere Zwischenvariablen, um die Wahrscheinlichkeit von Namenskollisionen mit bestehenden Spalten in unserem Datenrahmen zu reduzieren.

Auch verwenden wir das sep Argument in unite die resultierenden Spaltennamen zu steuern, so dass in diesem Fall, wenn wir spread wir sep = NULL zwingen.