如何根据R中小标题中另一列指示的列的值添加列

Question

在下面的示例中，我想根据“变量”列的值（即 1 和 20）添加“值”列。

toy_data <-
  tibble::tribble(
    ~x, ~y, ~variable,
    1,  2,  "x",
    10, 20, "y"
  )

像这样：

x	y	variable	value
1	2	x	1
10	20	y	20

但是，以下都不起作用：

toy_data %>%
  dplyr::mutate(
    value = get(variable)
  )

toy_data %>%
  dplyr::mutate(
    value = mget(variable)
  )

toy_data %>%
  dplyr::mutate(
    value = mget(variable, inherits = TRUE)
  )

toy_data %>%
  dplyr::mutate(
    value = !!variable
  )

我该怎么做？

Answer 1

如果您事先知道数据框中有哪些变量：使用ifelse() 或dplyr::case_when() 等简单逻辑在它们之间进行选择。

如果不是：使用函数式编程。下面是一个例子：

library(dplyr)

f <- function(data, variable_col) {
  
  data[[variable_col]] %>% 
    purrr::imap_dbl(~ data[[.y, .x]])
  
}

toy_data$value <- f(toy_data, "variable")

Answer 2

这里有一些可以很好扩展的选项。

First 是一个基本选项，适用于 variable 列及其索引。 （我制作了一个数据框的副本，这样我就可以保留原件以进行更多编程。）

library(dplyr)

toy2 <- toy_data
toy2$value <- mapply(function(v, i) toy_data[[v]][i], toy_data$variable, seq_along(toy_data$variable))
toy2
#> # A tibble: 2 × 4
#>       x     y variable value
#>   <dbl> <dbl> <chr>    <dbl>
#> 1     1     2 x            1
#> 2    10    20 y           20

第二次使用purrr::imap_dbl 遍历变量及其索引并返回一个双精度值。

toy_data %>%
  mutate(value = purrr::imap_dbl(variable, function(v, i) toy_data[[v]][i]))
#> # A tibble: 2 × 4
#>       x     y variable value
#>   <dbl> <dbl> <chr>    <dbl>
#> 1     1     2 x            1
#> 2    10    20 y           20

第三个最不直接，但我个人最有可能使用它，也许只是因为它是一个适合我的许多工作流程的过程。透视生成数据的长版本，让您看到variable 的值以及x 和y 的对应值，然后您可以过滤这两列的匹配位置。然后自连接回数据框。

inner_join(
  toy_data,
  toy_data %>%
    tidyr::pivot_longer(cols = -variable, values_to = "value") %>%
    filter(variable == name),
  by = "variable"
) %>%
  select(-name)
#> # A tibble: 2 × 4
#>       x     y variable value
#>   <dbl> <dbl> <chr>    <dbl>
#> 1     1     2 x            1
#> 2    10    20 y           20

编辑： @jpiversen 正确地指出，如果 variable 有重复项，则自联接将不起作用——在这种情况下，将行号添加到数据中并将其用作附加加入列。这里我先添加一个额外的观察来说明。

toy3 <- toy_data %>%
  add_row(x = 5, y = 4, variable = "x") %>%
  tibble::rowid_to_column()
inner_join(
  toy3,
  toy3 %>%
    pivot_longer(cols = c(-rowid, -variable), values_to = "value") %>%
    filter(variable == name),
  by = c("rowid", "variable")
) %>%
  select(-name, -rowid)