如何向量化dplyr::case_when右侧表达式？解决ID生成异常问题

现有数据框：

> data <- data.frame(x = c(1,1,2,2,3,4,5,6), y = c(1,2,3,4,5,6,7,8))
> data
  x y
1 1 1
2 1 2
3 2 3
4 2 4
5 3 5
6 4 6
7 5 7
8 6 8

需求：使用mutate和case_when创建新的id变量，要求：

• 相同x值的行对应相同id
• 缺失x的行各拥有唯一id

自定义生成id的函数：

id_function <- function(x, n){
  set.seed(x)
  res <- character(n)
  for(i in seq(n)){
    res[i] <- paste0(sample(c(letters, LETTERS, 0:9), 32), collapse="")
  }
  res
}

id_function(1, 1)
[1] "4dMaHwQnrYGu0PTjgioXKOyW75NRZtcf"

尝试代码：

data %>%
  mutate(my_id = id_function(1234, nrow(.)),
         my_id = dplyr::case_when(!is.na(x) ~ id_function(x, 1),
                                  TRUE ~ my_id))

得到错误结果（非缺失x的行id全部相同）：

x y                            my_id
1  1 1 4dMaHwQnrYGu0PTjgioXKOyW75NRZtcf
2  1 2 4dMaHwQnrYGu0PTjgioXKOyW75NRZtcf
3  2 3 4dMaHwQnrYGu0PTjgioXKOyW75NRZtcf
4  2 4 4dMaHwQnrYGu0PTjgioXKOyW75NRZtcf
5 NA 5 0vnws5giVNIzp86BHKuOZ9ch4dtL3Fqy
6 NA 6 IbKU6DjvW9ypitl7qc25Lr4sOwEfghdk
7 NA 7 8oqQMPx6IrkGhXv4KlUtYfcJ5Z1RCaDy
8 NA 8 BRsjumlCEGS6v4ANrw1bxLynOKkF90ao

case_when的右侧表达式若不是向量化函数，只会执行一次而非逐行执行。你的id_function并非向量化函数：当传入向量形式的x（比如c(1,1,2,2,...)）时，set.seed(x)只会用向量的第一个元素设置种子，后续生成的id都基于这个种子，最终导致所有非缺失x的行得到相同id。

方法1：向量化自定义函数 #

重写函数使其能处理向量输入，为每个唯一x值生成对应id后映射回原数据：

id_function_vec <- function(x) {
  # 提取非缺失的唯一x值
  unique_x <- unique(na.omit(x))
  # 为每个唯一x生成对应id
  id_map <- sapply(unique_x, function(val) {
    set.seed(val)
    paste0(sample(c(letters, LETTERS, 0:9), 32), collapse="")
  })
  # 将id映射到原x向量，NA位置暂留空
  res <- unname(id_map[as.character(x)])
  # 为NA行生成唯一id
  na_indices <- is.na(res)
  if(any(na_indices)) {
    set.seed(1234) # 可选：设置种子保证结果可复现
    res[na_indices] <- replicate(sum(na_indices), 
                                 paste0(sample(c(letters, LETTERS, 0:9), 32), collapse=""))
  }
  res
}

# 使用函数生成id
data %>% mutate(my_id = id_function_vec(x))

方法2：结合分组操作 #

利用group_by按x分组，每组内生成同一个id，NA行单独处理：

data %>%
  group_by(x) %>%
  mutate(my_id = ifelse(is.na(x), 
                        paste0(sample(c(letters, LETTERS, 0:9), 32), collapse=""),
                        {set.seed(x); paste0(sample(c(letters, LETTERS, 0:9), 32), collapse="")})) %>%
  ungroup()

分组后每个x组内仅执行一次id生成逻辑，同x行的id自然相同；NA行每组仅一行，因此生成唯一id。

方法3：用purrr::map优化case_when写法 #

若坚持使用case_when，可结合purrr::map_chr实现逐行调用函数：

library(purrr)

data %>%
  mutate(my_id = id_function(1234, nrow(.)),
         my_id = case_when(
           !is.na(x) ~ map_chr(x, ~id_function(.x, 1)),
           TRUE ~ my_id
         ))

map_chr会遍历x的每个元素，单独调用id_function，确保每个x值生成对应的唯一id。

内容的提问来源于stack exchange，提问作者James Martherus