使用 purrr 通过多个映射跨多个列重新编码

Question

我有一个带有问卷回复标签的数据框。我总是喜欢用 item-answer 定义做一个 tibble，然后使用

dplyr::recode()

将所有 item 标签替换为它们相应的定义。为了易于使用，定义 tibble

recode_df

将这些对应关系存储为字符串，并且在

dplyr::recode()

中它们可以用 bangbangbang

!!!

解包并进行评估。在下面的玩具示例中，有 4 个项目，两个用于

qa

，两个用于

qb

，它们共享相同的答案定义。

library(tidyverse)
set.seed(42)

# columns starting with `qa` and `qb` share the same answer structure 
data_df <- tibble(
  qa_1 = sample(c(0, 1), 5, replace = TRUE),
  qa_2 = sample(c(0, 1), 5, replace = TRUE),
  qb_1 = sample(1:5, 5, replace = TRUE),
  qb_3 = sample(1:5, 5, replace = TRUE)
)

# `answer` column stores string definitions for use with `dplyr::recode()`
recode_df <- tibble(
  question = c("qa", "qb"),
  answer = c(
    'c("0" = "foo0", "1" = "foo1")',
    'c("1" = "bar1", "2" = "bar2", "3" = "bar3", "4" = "bar5", "5" = "bar5")'
  )
)  

# Desired result
data_df %>%
  mutate(
    across(
      .cols = starts_with("qa"),
      .fns = ~recode(., !!!eval(parse(text = recode_df$answer[str_detect(recode_df$question, "qa")])))
    ),
    across(
      .cols = starts_with("qb"),
      .fns = ~recode(., !!!eval(parse(text = recode_df$answer[str_detect(recode_df$question, "qb")])))
    )
  )
#> # A tibble: 5 x 4
#>   qa_1  qa_2  qb_1  qb_3 
#>   <chr> <chr> <chr> <chr>
#> 1 foo0  foo1  bar5  bar2 
#> 2 foo0  foo1  bar1  bar3 
#> 3 foo0  foo1  bar5  bar1 
#> 4 foo0  foo0  bar5  bar1 
#> 5 foo1  foo1  bar2  bar3

^{创建于 2023-02-26 与 reprex v2.0.2}

我可以通过对

mutate()

的每一行使用一个

across

和

recode_df

来达到我想要的结果，但我确信有一个优雅的

purrr

解决方案可以迭代和重新编码而不重复代码。谢谢。

Answer 1

有许多备选方案可供考虑，特别是如果以不同的形式存储您的答案键。但是，鉴于目前的 data.frames，您可以尝试以下操作。使用

map_dfc

对最终结果进行列绑定。您可以将重新编码函数应用于字符值向量的每个元素，例如“qa”和“qb”。让我知道这是否有帮助。

library(tidyverse)

map_dfc(
  recode_df$question,
  \(x) {
    map(
      data_df %>%
        select(contains(x)),
      \(y) recode(y, !!!eval(parse(text = recode_df$answer[str_detect(recode_df$question, x)])))
    )
  }
)

输出

  qa_1  qa_2  qb_1  qb_3 
  <chr> <chr> <chr> <chr>
1 foo0  foo1  bar5  bar2 
2 foo0  foo1  bar1  bar3 
3 foo0  foo1  bar5  bar1 
4 foo0  foo0  bar5  bar1 
5 foo1  foo1  bar2  bar3 

Answer 2

你可以买到更便宜的。

data_df[] <- lapply(names(data_df), \(x) if (grepl('qa', x)) paste0('foo', data_df[[x]]) else paste0('bar', data_df[[x]]))

如果有更多的列，您可以使用一个简单的字典

dc

，它由一个命名向量组成，数据前缀作为元素，列前缀作为名称。

dc <- c(qa='foo', qb='bar')
## alternatively using `grep` to identify columns
# dc <- setNames(c('foo', 'bar'), unique(gsub('_\\d+$', '', names(data_df))))

我们现在可以为

startsWith

提供名称列名称和

dc

-名称，以识别

dc

中的正确条目。

data_df[] <- lapply(names(data_df), \(x) paste0(dc[startsWith(x, names(dc))], data_df[[x]]))

data_df
#   qa_1 qa_2 qb_1 qb_3
# 1 foo0 foo1 bar4 bar2
# 2 foo0 foo1 bar1 bar3
# 3 foo0 foo1 bar5 bar1
# 4 foo0 foo0 bar4 bar1
# 5 foo1 foo1 bar2 bar3

这也适用于数百列。可能很难避免定义一次翻译。