dplyr mutate and purrr map：对 map 的 select 列使用数据屏蔽

Question

在 dplyr 突变上下文中，我想通过 purrr:map 使用另一列的值将 function 应用于 select 列。

让我们来一个测试数据框

test <- data.frame(a = c(1,2), b = c(3,4), selector = c("a","b"))

我要申请以下function

calc <- function(col)
{res <- col ^ 2
return(res)
}

我正在尝试这样的事情：

test_2 <- test %>% mutate(quad = map(.data[[selector]], ~ calc(.x)))

我的预期结果是：

  a b selector quad
1 1 3        a    1
2 2 4        b   16

但我明白了

Error in local_error_context(dots = dots, .index = i, mask = mask) : 
  promise already under evaluation: recursive default argument reference or earlier problems?

我知道.data[[var]]应该只在 function 编程的特殊上下文中使用，但如果我将其包装在函数或类似函数中，我也无法完成它。 尝试使用 tidy-selection 会给出一个错误，即 selecting helpers 只能用于特殊的 dplyr 动词，而不是像 purrr:map 这样的函数。

how to use dynamic variable in purrr map within dplyr提示我使用get()和匿名函数，但这在这种情况下也不起作用。

Answer 1

这是一种方法：

test %>% 
  mutate(quad = map(seq_along(selector), ~ calc(test[[selector[.x]]])[.x]))

#   a b selector quad
# 1 1 3        a    1
# 2 2 4        b   16

除了.data ，您还可以cur_data （用于分组）：

test %>% 
  mutate(quad = map(seq(selector), ~ calc(cur_data()[[selector[.x]]])[.x]))

---

或者，使用diag ：

test %>% 
  mutate(quad = diag(as.matrix(calc(cur_data()[selector]))))

#  a b selector quad
#1 1 3        a    1
#2 2 4        b   16

Answer 2

您可以使用rowwise()和get()选择器变量：

library(dplyr)

test %>%
  rowwise() %>%
  mutate(quad = calc(get(selector))) %>%
  ungroup()

# A tibble: 2 × 4
      a     b selector  quad
  <dbl> <dbl> <chr>    <dbl>
1     1     3 a            1
2     2     4 b           16

或者如果选择器重复， group_by()会更有效：

test <- data.frame(a = c(1,2,5), b = c(3,4,6), selector = c("a","b","a"))

test %>%
  group_by(selector) %>%
  mutate(quad = calc(get(selector[1]))) %>%
  ungroup()

# A tibble: 3 × 4
      a     b selector  quad
  <dbl> <dbl> <chr>    <dbl>
1     1     3 a            1
2     2     4 b           16
3     5     6 a           25

Answer 3

您还可以更改 function 以返回单个数字并使用purrr ：

calc <- function(col, id) {test[[col]][[id]]^2}

test %>% 
    mutate(
        quad = purrr::map2_dbl(selector, row_number(), calc)
    )
  a b selector quad
1 1 3        a    1
2 2 4        b   16

Answer 4

使用基数 R：

test$quad <- calc(test[,test$selector][cbind(seq_len(nrow(test)), test$selector)])

（R 版本 3.5.3，其中字符串转换为data.frame中的因子）

Answer 5

不完全是你要求的，但另一种方法可能是重组数据，以便计算更容易：

test %>% 
   pivot_longer(
       cols = c(a, b)
   ) %>% 
   filter(name == selector) %>% 
   mutate(quad = value**2)

# A tibble: 2 × 4
  selector name  value  quad
  <chr>    <chr> <dbl> <dbl>
1 a        a         1     1
2 b        b         4    16

您可以使用 id 列将结果连接回原始数据。