从查找表中更新向量的某些值的规范 tidyverse 方法

Question

我经常需要根据查找表重新编码数据框列中的一些（不是全部！）值。我对我所知道的解决问题的方法并不满意。我希望能够以一种清晰、稳定和高效的方式做到这一点。在我编写自己的函数之前，我想确保我没有复制已经存在的标准。

## Toy example
data = data.frame(
  id = 1:7,
  x = c("A", "A", "B", "C", "D", "AA", ".")
)

lookup = data.frame(
  old = c("A", "D", "."),
  new = c("a", "d", "!")
)

## desired result
#   id  x
# 1  1  a
# 2  2  a
# 3  3  B
# 4  4  C
# 5  5  d
# 6  6 AA
# 7  7  !

我可以通过加入、合并、取消选择来做到这一点，如下所示，但这并不像我想要的那么清楚- 步骤太多。

## This works, but is more steps than I want
library(dplyr)
data %>%
  left_join(lookup, by = c("x" = "old")) %>%
  mutate(x = coalesce(new, x)) %>%
  select(-new)

也可以使用 来完成dplyr::recode，如下所示，将查找表转换为命名查找向量。我更喜欢lookup作为数据框，但我对命名向量解决方案没问题。我担心的是这recode是Questioning生命周期阶段，所以我担心这种方法不稳定。

lookup_v = pull(lookup, new) %>% setNames(lookup$old)
data %>%
  mutate(x = recode(x, !!!lookup_v))

也可以使用，例如，来完成stringr::str_replace，但使用正则表达式进行全字符串匹配效率不高。我想有forcats::fct_recode一个稳定版本的recode，但我不想要factor输出（尽管mutate(x = as.character(fct_recode(x, !!!lookup_v)))到目前为止可能是我最喜欢的选项......）。

我曾希望新十岁上下rows_update()的家庭dplyr职能的工作，但它是严密的关于列名的，我不认为它可以更新它的加入对列。（而且它是实验性的，所以还不能满足我的稳定性要求。）

我的要求总结：

• 基于查找数据框（最好）或命名向量（允许）更新单个数据列
• 并非数据中的所有值都包含在查找中——不存在的值不会被修改
• 必须处理character类输入。更普遍地工作是一件好事。
• 除了基本 R 和tidyverse包之外没有依赖项（尽管我也有兴趣看到data.table解决方案）
• 没有使用生命周期阶段的函数，如被取代或质疑。请注意任何实验性生命周期函数，因为它们具有未来潜力。
• 简洁明了的代码
• 我不需要极端的优化，但没有什么非常低效的（比如不需要时的正则表达式）

Answer 1

一个直接的data.table解决方案，没有%in%.
根据查找/数据表的长度，添加键可以显着提高性能，但在这个简单示例中并非如此。

library(data.table)

setDT(data)
setDT(lookup)

## If needed
# setkey(data,x)
# setkey(lookup,old)

data[lookup, x:=new, on=.(x=old)]
data 

   id  x
1:  1  a
2:  2  a
3:  3  B
4:  4  C
5:  5  d
6:  6 AA
7:  7  !

Answer 2

基准测试

将原始数据集扩展到 10M 行，使用 microbenchmark 运行 15 次，在我的计算机上得到以下结果：

请注意，OP 提到的forcats::fct_recode和dplyr::recode解决方案也已包括在内。两者都不适用于更新后的数据，因为解析为的命名向量. = !将引发错误，这就是为什么在原始数据集上测试结果的原因。

data = data.frame(
  id = 1:5,
  x = c("A", "A", "B", "C", "D")
)

lookup = data.frame(
  old = c("A", "D"),
  new = c("a", "d")
)

set.seed(1)
data <- data[sample(1:5, 1E7, replace = T),]

dt_lookup <- data.table::copy(lookup)

dplyr_coalesce <- function(){
  library(dplyr)
  lookupV <- setNames(lookup$new, lookup$old)
  data %>% 
    dplyr::mutate(x = coalesce(lookupV[ x ], x))
}

datatable_in <- function(){
  library(data.table)
  lookupV <- setNames(lookup$new, lookup$old)
  setDT(dt_data)
  dt_data[ x %in% names(lookupV), x := lookupV[ x ] ]
}

datatable <- function(){
  library(data.table)
  
  setDT(dt_data)
  setDT(dt_lookup)
  
  ## If needed
  # setkey(data,x)
  # setkey(lookup,old)
  
  dt_data[dt_lookup, x:=new, on =.(x=old)]
}

purrr_modify_if <- function(){
  library(dplyr)
  library(purrr)
  lookupV <- setNames(lookup$new, lookup$old)
  data %>% 
    dplyr::mutate(x = modify_if(x, x %in% lookup$old, ~ lookupV[.x]))
}

stringr_str_replace_all_update <- function(){
  library(dplyr)
  library(stringr)
  lookupV <- setNames(lookup$new, do.call(sprintf, list("^\\Q%s\\E$", lookup$old)))
  
  data %>% 
    dplyr::mutate(x = str_replace_all(x, lookupV))
}

base_named_vector <- function(){
  lookupV <- c(with(lookup, setNames(new, old)), rlang::set_names(setdiff(unique(data$x), lookup$old)))
  lookupV[data$x]
}

base_ifelse <- function(){
  lookupV <- setNames(lookup$new, lookup$old)
  with(data, ifelse(x %in% lookup$old, lookup$new, x))
}

plyr_mapvalues <- function(){
  library(plyr)
  data %>% 
    dplyr::mutate(x = plyr::mapvalues(x, lookup$old, lookup$new, warn_missing = F))
}

base_match <- function(){
  tochange <- match(data$x, lookup$old, nomatch = 0)
  data$x[tochange > 0] <- lookup$new[tochange]
}

base_local_safe_lookup <- function(){
  lv <- structure(lookup$new, names = lookup$old)
  
  safe_lookup <- function(val) {
    new_val <- lv[val]
    unname(ifelse(is.na(new_val), val, new_val))
  }
  
  safe_lookup(data$x)
}

dplyr_recode <- function(){
  library(dplyr)
  lookupV <- setNames(lookup$new, lookup$old)
  
  data %>%
    dplyr::mutate(x = recode(x, !!!lookupV))
}

base_for <- function(){
  for (i in seq_len(nrow(lookup))) {
    data$x[data$x == lookup$old[i]] = lookup$new[i]
  }
}

datatable_for <- function(){
  library(data.table)
  setDT(dt_data)
  
  for (i in seq_len(nrow(lookup))) {
    dt_data[x == lookup$old[i], x := lookup$new[i]]
  }
}

forcats_fct_recode <- function(){
  library(dplyr)
  library(forcats)
  lookupV <- setNames(lookup$new, lookup$old)
  
  data %>% 
    dplyr::mutate(x = as.character(fct_recode(x, !!!lookupV)))
  
}

datatable_set <- function(){
  library(data.table)
  setDT(dt_data)
  
  tochange <- dt_data[, chmatch(x, lookup$old, nomatch = 0)]
  set(dt_data, i = which(tochange > 0), j = "x", value = lookup$new[tochange])
}

library(microbenchmark)
bench <- microbenchmark(dplyr_coalesce(),
                        datatable(),
                        datatable_in(),
                        datatable_for(),
                        base_for(),
                        purrr_modify_if(),
                        stringr_str_replace_all_update(),
                        base_named_vector(),
                        base_ifelse(),
                        plyr_mapvalues(),
                        base_match(),
                        base_local_safe_lookup(),
                        dplyr_recode(),
                        forcats_fct_recode(),
                        datatable_set(),
                        times = 15L,
                        setup = dt_data <- data.table::copy(data))

bench$expr <- forcats::fct_rev(forcats::fct_reorder(bench$expr, bench$time, mean))
ggplot2::autoplot(bench)

感谢@Waldi 和@nicola 提供data.table在基准测试中实施解决方案的建议。

Answer 3

命名向量和合并的组合：

# make lookup vector
lookupV <- setNames(lookup$new, lookup$old)

data %>% 
  mutate(x = coalesce(lookupV[ x ], x))
#   id x
# 1  1 a
# 2  2 a
# 3  3 B
# 4  4 C
# 5  5 d

或data.table：

library(data.table)

setDT(data)
data[ x %in% names(lookupV), x := lookupV[ x ] ]

这篇文章可能对 data.table 有更好的解决方案——“合并更新”：

• R 数据表：更新连接

Answer 4

一个base R选项使用%in% 和 match - 感谢@LMc 和@nicola

tochange <- match(data$x, lookup$old, nomatch = 0)
data$x[tochange > 0] <- lookup$new[tochange]

data.table使用set()和的另一种选择chmatch

library(data.table)
setDT(data)

tochange <- data[, chmatch(x, lookup$old, nomatch = 0)]
set(data, i = which(tochange > 0), j = "x", value = lookup$new[tochange])

结果

data
#  id  x
#1  1  a
#2  2  a
#3  3  B
#4  4  C
#5  5  d
#6  6 AA
#7  7  !

Answer 5

修改_如果

您可以使用purrr::modify_if仅将命名向量应用于其中存在的值。虽然不是指定的要求，但它具有.else参数的好处，它允许您将不同的函数应用于不在查找中的值。

我还想包括使用tibble::deframehere 来创建命名向量。不过，它比 慢setNames。

lookupV <- deframe(lookup)

data %>% 
  mutate(x = modify_if(x, x %in% lookup$old, ~ lookupV[.x]))

str_replace_all

或者，您可以使用stringr::str_replace_all，它可以为replacement参数采用命名向量。

data %>% 
  mutate(x = str_replace_all(x, lookupV))

更新

为了适应您编辑的示例的更改，str_replace_all需要修改 中使用的命名向量。通过这种方式，需要匹配整个文字字符串，以便“A”不会被替换为“AA”或“.”。不会取代一切：

lookupV <- setNames(lookup$new, do.call(sprintf, list("^\\Q%s\\E$", lookup$old)))

data %>% 
  mutate(x = str_replace_all(x, lookupV))

left_join

使用dplyr::left_jointhis 与 OP 解决方案非常相似，但使用了.keep参数，mutate因此步骤较少。此参数目前处于实验生命周期中，因此未包含在基准测试中（尽管它位于已发布解决方案的中间）。

left_join(data, lookup, by = c("x" = "old")) %>% 
    mutate(x = coalesce(new, x) , .keep = "unused")

根据 R

命名向量

为数据框中的每个唯一值创建一个替换值。

lookupV <- c(with(lookup, setNames(new, old)), setNames(nm = setdiff(unique(data$x), lookup$old)))

data$x <- lookupV[data$x]

如果别的

with(data, ifelse(x %in% lookup$old, lookupV[x], x))

Answer 6

另一个明确的选项是使用for带有子集的-loop 来循环遍历lookup表的行。data.table由于自动索引，或者如果您?data.table::setkey()提前设置键（即 ），这几乎总是更快。此外，随着查找表变长，它当然会变慢。如果有一个很长的查找表，我想更新连接将是首选。

基础 R：

for (i in seq_len(nrow(lookup))) {
  data$x[data$x == lookup$old[i]] <- lookup$new[i]
}

data$x
# [1] "a"  "a"  "B"  "C"  "d"  "AA" "!" 

或相同的逻辑data.table：

library(data.table)
setDT(data)

for (i in seq_len(nrow(lookup))) {
  data[x == lookup$old[i], x := lookup$new[i]]
}

data$x
# [1] "a"  "a"  "B"  "C"  "d"  "AA" "!" 

数据：

data = data.frame(
  id = 1:7,
  x = c("A", "A", "B", "C", "D", "AA", ".")
)

lookup = data.frame(
  old = c("A", "D", "."),
  new = c("a", "d", "!")
)