Sélection de colonne vectorisée

Question

Comment utiliser la valeur d'une colonne (par exemple, x ci-dessous) pour sélectionner des valeurs parmi des colonnes possibles, lorsque la sélection est spécifique à chaque ligne?

La variable x détermine si la variable a, b ou c doit être sélectionnée pour une ligne donnée. Voici un exemple simplifié; les cellules réelles ne sont pas une concaténation du nom de colonne et du numéro de ligne.

library(magrittr); requireNamespace("tibble"); requireNamespace("dplyr") 

ds <- tibble::tibble(
    x = c( 1 , 1 , 2 , 3 , 1), 
    a = c("a1", "a2", "a3", "a4", "a5"), 
    b = c("b1", "b2", "b3", "b4", "b5"), 
    c = c("c1", "c2", "c3", "c4", "c5") 
) 

Les colonnes souhaitées sont des valeurs sont:

# ds$y_desired  <- c("a1", "a2", "b3", "c4", "a5") 
# ds$column_desired <- c("a" , "a" , "b" , "c" , "a") 

Bien sûr, ce qui suit ne produit pas une seule colonne, mais colonnes fives.

ds[, ds$column_desired] 

Et ce qui suit produit l'erreur: Error in mutate_impl(.data, dots) : basic_string::_M_replace_aux.

ds %>% 
    dplyr::rowwise() %>% 
    dplyr::mutate(
    y = .[[column_desired]] 
) %>% 
    dplyr::ungroup() 

Si mon vrai scénario avait seulement deux ou trois choix, je serais probablement utiliser emboîtés-ifs, mais je voudrais une approche cartographique généralisée pour accueillir un plus grand nombre de conditions.

ds %>% 
    dplyr::mutate(
    y_if_chain = ifelse(x==1, a, ifelse(x==2, b, c)) 
) 

Idéalement, l'approche pourrait être dirigé par une table de consultation, ou un autre objet de métadonnées comme:

ds_lookup <- tibble::tribble(
    ~x, ~desired_column, 
    1L,    "a", 
    2L,    "b", 
    3L,    "c" 
) 

Je suis sûr que cette question de commutation de colonne a été posée, mais je ne en trouver un qui s'applique.

Je préférerais une solution tidyverse (c'est ce que mon équipe préfère), mais je suis ouvert à tous les outils. Je ne pouvais pas comprendre comment utiliser une combinaison de apply et kimisc::vswitch.

Answer 1

Essayez ceci:

ds$y_desired = apply(ds, 1, function(r) r[as.integer(r[1])+1]) 

Answer 2

Je pense que le problème est que vos données sont dans le mauvais format pour ce que vous avez besoin. Tout d'abord, je voudrais convertir en temps de grand format avec tidyr::gather():

library("tidyr") 
ds %>% 
    gather(y, col, a:c) 

# A tibble: 15 × 3 
#  x  y col 
# <dbl> <chr> <chr> 
# 1  1  a a1 
# 2  1  a a2 
# 3  2  a a3 
# 4  3  a a4 
# 5  1  a a5 
# 6  1  b b1 
# 7  1  b b2 
# 8  2  b b3 
# 9  3  b b4 
# 10  1  b b5 
# 11  1  c c1 
# 12  1  c c2 
# 13  2  c c3 
# 14  3  c c4 
# 15  1  c c5 

Ensuite, la tâche devient aussi trivial que filter ING vos conditions requises (par exemple x == 1, y == a, etc.)

Answer 3

Merci @sirallen et @ Phil pour m'avoir montré un meilleur moyen. Voici ce que j'ai fini par utiliser, si cela aide quelqu'un dans le futur. Elle est généralisée à accueillir

• positions arbitraires des colonnes,
• valeurs arbitraires de x et
• une table de métadonnées mappe la valeur x à la colonne désirée (c.-à-a, b, & c) .

L'ensemble de données observées donné et l'ensemble de données de recherche:

ds <- tibble::tibble(
    x = c(10 , 10 , 20 , 30 , 10), 
    a = c("a1", "a2", "a3", "a4", "a5"), 
    b = c("b1", "b2", "b3", "b4", "b5"), 
    c = c("c1", "c2", "c3", "c4", "c5") 
) 

ds_lookup <- tibble::tribble(
    ~x , ~desired_column, 
    10L,    "a", 
    20L,    "b", 
    30L,    "c" 
) 

encapsulant le mappage entre le vecteur de caractères r et la table de consultation.

determine_y <- function(r) { 
    # browser() 
    lookup_row_index <- match(r['x'], ds_lookup$x) 
    column_name  <- ds_lookup$desired_column[lookup_row_index] 
    r[column_name] 
} 

ds$y <- apply(ds, 1, function(r) determine_y(r)) 

Answer 4

Je relis Hadley de chapter on functionals après avoir appris de la réponse de @ sirallen. Voici des solutions qui utilisent switch avec d'autres membres de la famille apply, y compris le style de chaînage Tidyverse.

library(magrittr); requireNamespace("purrr"); requireNamespace("tibble"); requireNamespace("dplyr") 

ds <- tibble::tibble(
    x = c(10 , 10 , 20 , 30 , 10), 
    a = c("a1", "a2", "a3", "a4", "a5"), 
    b = c("b1", "b2", "b3", "b4", "b5"), 
    c = c("c1", "c2", "c3", "c4", "c5") 
) 
determine_2 <- function(ss, a, b, c) { 
    switch(
    as.character(ss), 
    "10" = a, 
    "20" = b, 
    "30" = c 
) 
} 

# Each of these calls returns a vector. 
unlist(Map(  determine_2, ds$x, ds$a, ds$b, ds$c)) 
mapply(   determine_2, ds$x, ds$a, ds$b, ds$c) 
parallel::mcmapply(determine_2, ds$x, ds$a, ds$b, ds$c)     # For Linux 
unlist(purrr::pmap(list(  ds$x, ds$a, ds$b, ds$c), determine_2)) 

# Returns a dataset with the new variable. 
ds %>% 
    dplyr::mutate(
    y = unlist(purrr::pmap(list(x, a, b, c), determine_2)) 
)