使用recode函数在多个列之间进行转换，可以使用具有命名向量的命名列表。

Question

使用recode函数在多个列之间进行转换，可以使用具有命名向量的命名列表。

13

我在这里找不到与我提出的问题类似的问题。我有一个非常大的命名向量列表，这些向量的名称与数据帧中的列名匹配。我想使用命名向量列表来替换与每个列表元素名称相匹配的数据帧列中的值。也就是说，列表中向量的名称与数据帧列的名称匹配，并且每个向量元素中的键-值对将用于重新编码该列。

以下是示例：

library(tidyverse)

# Starting tibble
test <- tibble(Names = c("Alice","Bob","Cindy"),
               A = c(3,"q",7),
               B = c(1,2,"b"),
               C = c("a","g",9))

# Named vector
A <- c("5" = "alpha", "7" = "bravo", "3" = "charlie", "q" = "delta")
B <- c("1" = "yes", "2" = "no", "b" = "bad", "c" = "missing")
C <- c("9" = "beta", "8" = "gamma", "a" = "delta", "g" = "epsilon")

# Named list of named vectors
dicts <- list("A" = A, "B" = B, "C" = C) # Same names as columns

我能够使用mutate并手动指定列和列表项。

# Works when replacement vector is specified
test %>% 
  mutate(across(c("A"), 
                ~recode(., !!!dicts$A)))
#> # A tibble: 3 x 4
#>   Names A       B     C    
#>   <chr> <chr>   <chr> <chr>
#> 1 Alice charlie 1     a    
#> 2 Bob   delta   2     g    
#> 3 Cindy bravo   b     9

然而，以下内容无法正常工作:

# Does not work when replacement vector using column names
test %>% 
  mutate(across(c("A", "B", "C"), 
                ~recode(., !!!dicts$.)))

错误：对于 mutate() 的输入 ..1 存在问题。 x 没有提供替换项。 i 输入 ..1 是 (function (.cols = everything(), .fns = NULL, ..., .names = NULL) ...。

此外，我发现只有当指定了所有未重新编码的列时，map2_dfr 才能正常工作：

# map2_dfr Sort of works, but requires dropping some columns
map2_dfr(test %>% select(names(dicts)), 
         dicts, 
         ~recode(.x, !!!.y))
#> # A tibble: 3 x 3
#>   A       B     C      
#>   <chr>   <chr> <chr>  
#> 1 charlie yes   delta  
#> 2 delta   no    epsilon
#> 3 bravo   bad   beta

我想使用列表中的名称重新编码列，而不删除列。

- Hersh Gupta

9个回答

5

以下是三种方法：

首先，我们可以使用 dplyr::cur_column() 和自定义函数在 dplyr::across 中使其工作。

library(tidyverse)

myfun <- function(x) {
  mycol <- cur_column()
  dplyr::recode(x, !!! dicts[[mycol]])
}

test %>% 
  mutate(across(c("A", "B", "C"), myfun))

#> # A tibble: 3 x 4
#>   Names A       B     C      
#>   <chr> <chr>   <chr> <chr>  
#> 1 Alice charlie yes   delta  
#> 2 Bob   delta   no    epsilon
#> 3 Cindy bravo   bad   beta

第二个选项是将dicts转换为表达式列表，然后使用!!!运算符将其拼接到mutate中：

expr_ls <-  imap(dicts, ~ quo(recode(!!sym(.y), !!!.x)))

test %>% 
  mutate(!!! expr_ls)

#> # A tibble: 3 x 4
#>   Names A       B     C      
#>   <chr> <chr>   <chr> <chr>  
#> 1 Alice charlie yes   delta  
#> 2 Bob   delta   no    epsilon
#> 3 Cindy bravo   bad   beta

最后，在更大的tidyverse中，我们可以使用purrr::lmap_at，但这会使底层功能比它需要的更加复杂。

myfun2 <- function(x) {
  x_nm <- names(x)
  mutate(x, !! x_nm := recode(!! sym(x_nm), !!! dicts[[x_nm]]))
}

lmap_at(test, 
        names(dicts),
        myfun2)
#> # A tibble: 3 x 4
#>   Names A       B     C      
#>   <chr> <chr>   <chr> <chr>  
#> 1 Alice charlie yes   delta  
#> 2 Bob   delta   no    epsilon
#> 3 Cindy bravo   bad   beta

原始数据

# Starting tibble
test <- tibble(Names = c("Alice","Bob","Cindy"),
               A = c(3,"q",7),
               B = c(1,2,"b"),
               C = c("a","g",9))

# Named vector
A <- c("5" = "alpha", "7" = "bravo", "3" = "charlie", "q" = "delta")
B <- c("1" = "yes", "2" = "no", "b" = "bad", "c" = "missing")
C <- c("9" = "beta", "8" = "gamma", "a" = "delta", "g" = "epsilon")

# Named list of named vectors
dicts <- list("A" = A, "B" = B, "C" = C) # Same names as columns

^{此示例创建于2021-12-15，使用了 reprex package (v2.0.1)}

- TimTeaFan

dplyr::across()与dplyr::cur_column()的组合效果最佳。谢谢！ - Hersh Gupta

我还要指出，我对它进行了一些修改，通过在单独的一行中命名列，像这样 matching_vars <- na.omit(names(dicts[names(test)]))，然后将其传递给 across() 中的第一个参数。 - Hersh Gupta

3

基础 R（应该很容易翻译成 dplyr）

# Helper function
look_dict <- function(col, values) dicts[[col]][values]

# lapply
test[names(dicts)] <- lapply(names(dicts), \(col) look_dict(col, test[[col]]))

# magrittr and for loop to avoid repeating code
library(magrittr)
for (col in names(dicts)) test[[col]] %<>% look_dict(col, .)

# # A tibble: 3 x 4
#   Names A       B     C      
#   <chr> <chr>   <chr> <chr>  
# 1 Alice charlie yes   delta  
# 2 Bob   delta   no    epsilon
# 3 Cindy bravo   bad   beta

- s_baldur

2

一种解决方法是使用您的map2_dfr代码，但然后将需要的列绑定到map2_dfr输出。尽管您仍需要删除名称列。

library(tidyverse)

map2_dfr(test %>% select(names(dicts)),
         dicts,
         ~ recode(.x,!!!.y)) %>%
  dplyr::bind_cols(., Names = test$Names) %>%
  dplyr::select(4, 1:3)

输出

# A tibble: 3 × 4
  Names A       B     C      
  <chr> <chr>   <chr> <chr>  
1 Alice charlie yes   delta  
2 Bob   delta   no    epsilon
3 Cindy bravo   bad   beta

- AndrewGB

1

谢谢，不过我的实际数据有很多列，所以我正在寻找一种解决方案，不必删除未被重新编码的列。 - Hersh Gupta

2

使用基础R和recode：

for (x in names(dicts)) { test[[x]] <- do.call(recode, c(list(test[[x]]), dicts[[x]])) }

> test
# A tibble: 3 × 4
  Names A       B     C      
  <chr> <chr>   <chr> <chr>  
1 Alice charlie yes   delta  
2 Bob   delta   no    epsilon
3 Cindy bravo   bad   beta

还要注意，基于Map（）或str_replace_all（）的其他解决方案之所以有效，仅因为测试示例仅使用简单的替换。如果使用.default或.missing，它们很可能会失败。

- Karl Forner

2

不是完整的答案，但我想一个（在写作时）现有解决方案的基准可能会有所帮助。与每个基准一样，结果可能因人而异：

正如我们所看到的，sindri_baldur的基本R版本实际上是最快的。

（以下是代码）

bench::mark(
  karl_base_r(data, dicts),
  tim_across(data, dicts),
  tim_lmap(data, dicts),
  sotos_pivot(data, dicts),
  thomas_base_r(data, dicts),
  sindri_base_r(data, dicts),
  check = FALSE
)
#> # A tibble: 6 x 6
#>   expression                      min   median `itr/sec` mem_alloc `gc/sec`
#>   <bch:expr>                 <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl>
#> 1 karl_base_r(data, dicts)    825.9us  968.9us     814.   428.17KB     6.25
#> 2 tim_across(data, dicts)      5.04ms   6.44ms     147.      2.4MB     4.15
#> 3 tim_lmap(data, dicts)        7.34ms   8.49ms     108.   106.06KB     4.17
#> 4 sotos_pivot(data, dicts)    12.79ms  14.58ms      60.6    1.26MB     4.18
#> 5 thomas_base_r(data, dicts)    392us  438.6us    1891.         0B     4.07
#> 6 sindir_base_r(data, dicts)  116.8us  136.7us    5793.         0B     4.11

更大的数据集

对于更大的数据集，ThomasIsCoding 的基本 R 版本比 Sindir 的解决方案稍微快一些。

set.seed(15)
data_large <- data %>% sample_n(1e6, replace = TRUE)

bench::mark(
  karl_base_r(data_large, dicts),
  tim_across(data_large, dicts),
  tim_lmap(data_large, dicts),
  thomas_base_r(data_large, dicts),
  sindir_base_r(data_large, dicts),
  check = FALSE
)
#> Warning: Some expressions had a GC in every iteration; so filtering is disabled.
#> # A tibble: 5 x 6
#>   expression                            min  median `itr/sec` mem_alloc `gc/sec`
#>   <bch:expr>                       <bch:tm> <bch:t>     <dbl> <bch:byt>    <dbl>
#> 1 karl_base_r(data_large, dicts)      856ms   856ms      1.17   503.9MB     9.35
#> 2 tim_across(data_large, dicts)       647ms   647ms      1.55   504.9MB    10.8 
#> 3 tim_lmap(data_large, dicts)         809ms   809ms      1.24   503.6MB    11.1 
#> 4 thomas_base_r(data_large, dicts)    131ms   148ms      6.53    80.1MB     3.27
#> 5 sindir_base_r(data_large, dicts)    150ms   180ms      5.08    80.1MB     5.08

代码

library(tidyverse)
library(magrittr)

# Starting tibble
data <- tibble(Names = c("Alice","Bob","Cindy"),
               A = c(3,"q",7),
               B = c(1,2,"b"),
               C = c("a","g",9))

# Named vector
A <- c("5" = "alpha", "7" = "bravo", "3" = "charlie", "q" = "delta")
B <- c("1" = "yes", "2" = "no", "b" = "bad", "c" = "missing")
C <- c("9" = "beta", "8" = "gamma", "a" = "delta", "g" = "epsilon")

# Named list of named vectors
dicts <- list("A" = A, "B" = B, "C" = C) # Same names as columns


# function definitions 

karl_base_r <- function(data, dicts) {
  for (x in names(dicts)) 
    {data[[x]] <- do.call(recode, c(list(data[[x]]), dicts[[x]])) }
  
  data
}

tim_across <- function(data, dicts) {
  
  myfun <- function(x) {
    mycol <- cur_column()
    dplyr::recode(x, !!! dicts[[mycol]])
  }
  
  data %>% 
    mutate(across(c("A", "B", "C"), myfun))
}

tim_lmap <- function(data, dicts) {
  myfun2 <- function(x) {
    x_nm <- names(x)
    mutate(x, !! x_nm := recode(!! sym(x_nm), !!! dicts[[x_nm]]))
  }
  
  lmap_at(data, 
          names(dicts),
          myfun2)
}

sotos_pivot <- function(data, dicts) {
  data %>% 
    pivot_longer(-1) %>% 
    left_join(stack(dicts) %>% 
                rownames_to_column('value'),
              by = c('value',  'name' = 'ind')) %>% 
    pivot_wider(id_cols = -value, names_from = name, values_from = values)
}

thomas_base_r <- function(data, dicts) {
  idx <- match(names(dicts), names(data))
  data[idx] <- Map(`[`, dicts, data[idx])
  data
}

sindri_base_r <- function(data, dicts) {
  look_dict <- function(col, values) dicts[[col]][values]
  
  data[names(dicts)] <- lapply(names(dicts), \(col) look_dict(col, data[[col]]))
  data
}

^{由reprex包（v2.0.0）于2021年12月15日创建}

- David

1

感谢基准测试。我很惊讶lmap比我预期的要快得多，而且接近across。 - TimTeaFan

说实话，我还没有使用过 lmap()，但是它似乎对许多用例非常有用。 - David

在处理列表时，它绝对是有用的。当它被引入时，一个可能的使用案例是 data.frame 操作（也在文档中提到），但我认为随着 dplyr::across 的出现，这个使用案例变得多余了，因为 across 更加强大。 - TimTeaFan

1

一个将两者合并的解决方案可以是：

library(dplyr)
library(tidyr)

test %>% 
 pivot_longer(-1) %>% 
 left_join(stack(dicts) %>% 
             rownames_to_column('value'),
           by = c('value',  'name' = 'ind')) %>% 
 pivot_wider(id_cols = -value, names_from = name, values_from = values)

# A tibble: 3 x 4
#  Names A       B     C      
#  <chr> <chr>   <chr> <chr>  
#1 Alice charlie yes   delta  
#2 Bob   delta   no    epsilon
#3 Cindy bravo   bad   beta

- Sotos

1

使用purrr的另一种选项，而不必涉及复杂的tidyeval操作。

library(purrr)
library(tibble)

test %>% 
  lmap_at(c("A", "B", "C"), 
          ~ as_tibble_col(dicts[[names(.x)]][unlist(.x)], names(.x)))

# # A tibble: 3 x 4
#   Names A       B     C      
#   <chr> <chr>   <chr> <chr>  
# 1 Alice charlie yes   delta  
# 2 Bob   delta   no    epsilon
# 3 Cindy bravo   bad   beta

如果有modify2_at()或imodify_at()函数之类的东西，那就太容易了，但是这里我们使用lmap_at()作为解决方法。

- user10917479

0

这里提供了一个使用qdap::mgsub的管道友好解决方案。恐怕stringr::str_replace_all和stringi::stri_replace_first_fixed()都无法正常工作。请查看注释以获取更多信息。

test %>% 
  mutate(across(
    c("A", "B", "C"),
    ~qdap::mgsub( names(dicts[[cur_column()]]), dicts[[cur_column()]], .x)
    ))

- Jakub.Novotny

这似乎大多数情况下都能给出正确的输出，除了在 C 的第三行。它返回的不是 "beta" 而是 "betdelta"。 - AndrewGB

@AndrewGillreath-Brown 我错过了那个。我想使用stringr::str_replace可能会行。 - Jakub.Novotny

我检查了str_replace，但恐怕它似乎没有起作用。 - Jakub.Novotny

你可能需要使用 paste0("^", pattern, "$") 来完全匹配。 - David

@David，感谢您的建议。已编辑答案以提供可行的解决方案。很遗憾，stringi::stri_replace_first_fixed() 似乎也无法正常工作。 - Jakub.Novotny

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- ThomasIsCoding · Accepted Answer

您可以尝试以下基本的R代码。

idx <- match(names(dicts), names(test))
test[idx] <- Map(`[`, dicts, test[idx])

这提供了

> test
# A tibble: 3 x 4
  Names A       B     C
  <chr> <chr>   <chr> <chr>
1 Alice charlie yes   delta
2 Bob   delta   no    epsilon
3 Cindy bravo   bad   beta