使用 tidyverse 迭代 R

Question

我试图避免使用 for 循环，而是使用 tidyverse 进行迭代。 具体来说，我有一个值向量，我想循环遍历数据框中的单个变量，以创建带有前缀的新变量。 我试过使用 dplyr::across 但当向量长度 >1 时我不成功

示例代码：

library(tidyverse)
library(glue)

data <- data.frame(id = 1:10, 
                   y = letters[1:10], 
                   z = LETTERS[1:10])
letter_list <- letters[1:10]

var_naming <- function(dat, list){
  dat %>%
    mutate(!!glue("hx_{list}") := ifelse(y == {list}, 1, 0))
}

我试过的代码：

**the correct dimensions of the data frame should be 13 variables and 10 observations**

# data_b outputs the correct number of observations but has 40 variables
data_b <- map(letter_list, 
             ~var_naming(data, .x)) %>%
  as.data.frame()

# data_c gives me the correct number of variables but has 100 observations
data_c <- map_df(letter_list,
                 ~var_naming(data, .x))

# error message from data_d when using dplyr::across:
>> Error in `mutate()`:
>> ! Problem while computing `..1 =
  >> across(...)`.
>> Caused by error in `across()`:
>> ! All unnamed arguments must be length 1
>> Run `rlang::last_error()` to see where the error occurred.

data_d <- data %>%
  mutate(
    across(
      .cols  = y, 
      .fns   = ~ifelse(y == {letter_list}, 1, 0),
      .names = glue("hx_{letter_list}")
  ))

Desired output:
id y     z      hx_a  hx_b  hx_c  hx_d  hx_e  hx_f  hx_g  hx_h  hx_i  hx_j

1  a     A         1     0     0     0     0     0     0     0     0     0
2  b     B         0     1     0     0     0     0     0     0     0     0
3  c     C         0     0     1     0     0     0     0     0     0     0
4  d     D         0     0     0     1     0     0     0     0     0     0
5  e     E         0     0     0     0     1     0     0     0     0     0
6  f     F         0     0     0     0     0     1     0     0     0     0
7  g     G         0     0     0     0     0     0     1     0     0     0
8  h     H         0     0     0     0     0     0     0     1     0     0
9  i     I         0     0     0     0     0     0     0     0     1     0
10 j     J         0     0     0     0     0     0     0     0     0     1

Answer 1

代码可以修改

1. 删除:=右侧list周围的{}
2. 使用transmute而不是mutate可能更好，因为mutate默认返回整个数据。
3. 一旦我们从bind_cols获得列绑定 ( _dfc ) 数据，使用map绑定原始数据

library(dplyr)
library(purrr)
var_naming <- function(dat, list){
  dat %>%
    transmute(!!glue::glue('hx_{list}') := ifelse(y == list, 1, 0))
}

注意： list是以base R构造list数据结构。 最好创建参数名称不同于保留字或 function 名称的函数。 -测试

map_dfc(letter_list, var_naming, dat = data) %>% 
   bind_cols(data, .)

-输出

   id y z hx_a hx_b hx_c hx_d hx_e hx_f hx_g hx_h hx_i hx_j
1   1 a A    1    0    0    0    0    0    0    0    0    0
2   2 b B    0    1    0    0    0    0    0    0    0    0
3   3 c C    0    0    1    0    0    0    0    0    0    0
4   4 d D    0    0    0    1    0    0    0    0    0    0
5   5 e E    0    0    0    0    1    0    0    0    0    0
6   6 f F    0    0    0    0    0    1    0    0    0    0
7   7 g G    0    0    0    0    0    0    1    0    0    0
8   8 h H    0    0    0    0    0    0    0    1    0    0
9   9 i I    0    0    0    0    0    0    0    0    1    0
10 10 j J    0    0    0    0    0    0    0    0    0    1

Answer 2

获得相同结果的另一种方法：

data %>%
  cbind(model.matrix(~y + 0, .)) %>%
  rename_with(~str_replace(., 'y\\B', 'hx_'))

   id y z hx_a hx_b hx_c hx_d hx_e hx_f hx_g hx_h hx_i hx_j
1   1 a A    1    0    0    0    0    0    0    0    0    0
2   2 b B    0    1    0    0    0    0    0    0    0    0
3   3 c C    0    0    1    0    0    0    0    0    0    0
4   4 d D    0    0    0    1    0    0    0    0    0    0
5   5 e E    0    0    0    0    1    0    0    0    0    0
6   6 f F    0    0    0    0    0    1    0    0    0    0
7   7 g G    0    0    0    0    0    0    1    0    0    0
8   8 h H    0    0    0    0    0    0    0    1    0    0
9   9 i I    0    0    0    0    0    0    0    0    1    0
10 10 j J    0    0    0    0    0    0    0    0    0    1

如果您只考虑letters_list中的那些：

data %>%
  mutate( y =factor(y, letter_list)) %>%
  cbind(model.matrix(~y + 0, .) %>%
  as_tibble() %>%
  select(paste0('y', letter_list)) %>%
  rename_with(~str_replace(., 'y', 'hx_')))

Answer 3

您已经接近 mutate 调用，但您最终想要的是要传递给.fns的函数列表（一个函数对应letter_list中的每个字母）。 由于它们是匿名函数，因此将它们命名为与letter_list相同以帮助across命名列

myFxs <- map(letter_list, ~function(y) ifelse(y == .x, 1, 0)) %>% 
  setNames(letter_list)

无论出于何种原因， .names似乎在胶水字符向量方面存在问题（无论如何对我而言）。 由于函数是根据它们匹配的字母命名across ，因此您可以使用.fn代词来代替将模板传递给

data %>%
  mutate(
    across(
      .cols  = y, 
      .fns   = myFxs,
      .names = "hx_{.fn}"
    )
  )