Vectorized column selection

Question

How can I use one column's value (eg, x below) to select among values among possible columns, when the selection is specific to each row?

The x variable determines whether variable a, b, or c should be selected for a given row. Here's a simplified example; the real cells aren't a concatenation of the column name and row number.

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")
)

The desired columns are values are:

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

Of course the following doesn't produce a single column, but fives columns.

ds[, ds$column_desired]

And the following produces the error: Error in mutate_impl(.data, dots) : basic_string::_M_replace_aux.

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

If my real scenario had only two or three choices, I'd probably use nested-ifs, but I'd like a generalized mapping approach to accommodate a larger number of conditions.

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

Ideally the approach could be directed by a lookup table, or some other metadata object like:

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

I'm sure this column switching question has been asked before, but I didn't find one that applied.

I'd prefer a tidyverse solution (b/c that's what my team is most comfortable with), but I'm open to any tool. I couldn't figure out how to use a combination of apply and kimisc::vswitch.

Answer 1

Try this:

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

Answer 2

I reread Hadley's chapter on functionals after learning from @sirallen's answer. Here are solutions that use switch with other members of the apply family, including the Tidyverse-style of chaining.

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))
  )

Answer 3

I think the problem is your data is in the wrong format for what you need. First, I would convert to long from wide format with 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

Then the task becomes as trivial as filtering on your required conditions (e.g. x == 1, y == a, etc.)

Answer 4

Thank you @sirallen and @Phil for showing me a better way. Here is what I've ended up using, if it helps anyone in the future. It's generalized to accommodate

• arbitrary positions of the columns,
• arbitrary values of x, and
• a metadata table maps the x value to the desired column (ie, a, b, & c).

The given observed dataset and the lookup dataset:

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"
)

Encapsulating the mapping between the character vector r and the lookup table.

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))