如何在R中重排行内值以避免列间重复？

需求概述 #

现有一个含分类值的R数据框，需对每行的列值进行重排，满足核心规则的同时，保留原数据中各列的非缺失值数量（空字符串或NA视为缺失）。

核心规则 #

• 各时间列（t1、t2、t3、t4）的分类值出现次数尽可能均匀
• 同一行内的列值无重复（顺序不做强制要求）
• t1、t2列所有行必须有值；t3、t4列仅保留指定比例的行有值（示例为40%，比例需可通过代码调整）

示例输入数据 #

df <- data.frame(
  t1 = c("A", "B", "C", "D", "A", "B", "C", "D", "A", "B"),
  t2 = c("A", "B", "C", "D", "A", "B", "C", "D", "A", "B"),
  t3 = c("A", "B", "C", "D", "", "", "", "", "", ""),
  t4 = c("A", "B", "C", "D", "", "", "", "", "", "")
)

期望输出示例（行内值顺序可调整） #

# Example of expected rearrangement (order may vary):
df_rearranged <- data.frame(
  t1 = c("A", "B", "C", "D", "A", "B", "C", "D", "A", "B"),
  t2 = c("D", "A", "B", "C", "D", "A", "B", "C", "D", "A"),
  t3 = c("B", "", "A", "", "C", "", "D", "", "", ""),
  t4 = c("", "", "", "A", "", "C", "", "", "", "D")
)

解决方案代码 #

library(dplyr)
library(purrr)

# 定义参数：t3/t4的非缺失行比例（可根据需求调整）
non_missing_ratio <- 0.4

# 预处理：将空字符串转为NA，统一缺失值格式
df_clean <- df %>% mutate(across(everything(), ~ifelse(. == "", NA, .)))

# 获取所有唯一编码员列表
coders <- unique(unlist(df_clean, use.names = FALSE)) %>% na.omit()
n_coders <- length(coders)

# 处理t1和t2：保证每行无重复，且各列编码员分布均匀
rearrange_t1t2 <- function(row) {
  current <- na.omit(row)
  if (length(current) == 0) return(c(NA, NA))
  # 生成所有无重复的编码员组合
  candidates <- expand.grid(coders, coders) %>% filter(Var1 != Var2)
  # 按全局出现次数排序，优先选择出现次数少的组合
  global_counts <- table(c(df_clean$t1, df_clean$t2))
  candidates <- candidates %>% 
    mutate(score = global_counts[Var1] + global_counts[Var2]) %>%
    arrange(score)
  # 筛选不与当前行已有值重复的组合
  valid_candidates <- candidates %>% filter(!Var1 %in% current | !Var2 %in% current)
  if (nrow(valid_candidates) == 0) {
    # 极端情况：所有组合都有重复，选出现次数最少的组合
    valid_candidates <- candidates %>% slice_min(score)
  }
  sample_n(valid_candidates, 1) %>% unlist()
}

# 应用到每行，生成新的t1和t2
t1t2_new <- df_clean %>% 
  rowwise() %>% 
  mutate(new_t1t2 = list(rearrange_t1t2(c(t1, t2)))) %>% 
  ungroup() %>% 
  mutate(t1_new = map_chr(new_t1t2, ~.[1]),
         t2_new = map_chr(new_t1t2, ~.[2]))

# 处理t3和t4：保留原数据的非缺失行数，且每行值不与t1/t2重复
n_rows <- nrow(df_clean)
n_fill_t3 <- sum(!is.na(df_clean$t3))
n_fill_t4 <- sum(!is.na(df_clean$t4))

# 填充t3
t3_new <- rep(NA, n_rows)
fill_rows_t3 <- sample(1:n_rows, n_fill_t3)
for (i in fill_rows_t3) {
  used <- c(t1t2_new$t1_new[i], t1t2_new$t2_new[i])
  available <- setdiff(coders, used)
  if (length(available) == 0) available <- coders # 极端情况 fallback
  # 选当前列出现次数最少的编码员
  t3_counts <- table(t3_new)
  available_counts <- t3_counts[names(t3_counts) %in% available]
  selected <- if (length(available_counts) == 0) {
    sample(available, 1)
  } else {
    names(available_counts)[which.min(available_counts)]
  }
  t3_new[i] <- selected
}

# 填充t4
t4_new <- rep(NA, n_rows)
fill_rows_t4 <- sample(1:n_rows, n_fill_t4)
for (i in fill_rows_t4) {
  used <- c(t1t2_new$t1_new[i], t1t2_new$t2_new[i], t3_new[i])
  available <- setdiff(coders, used)
  if (length(available) == 0) available <- coders
  t4_counts <- table(t4_new)
  available_counts <- t4_counts[names(t4_counts) %in% available]
  selected <- if (length(available_counts) == 0) {
    sample(available, 1)
  } else {
    names(available_counts)[which.min(available_counts)]
  }
  t4_new[i] <- selected
}

# 合并结果，将NA转回空字符串匹配原数据格式
df_rearranged <- t1t2_new %>% 
  select(t1_new, t2_new) %>% 
  mutate(t3 = ifelse(is.na(t3_new), "", t3_new),
         t4 = ifelse(is.na(t4_new), "", t4_new)) %>% 
  rename(t1 = t1_new, t2 = t2_new)

# 查看最终结果
print(df_rearranged)

代码说明 #

1. 预处理：统一空字符串与NA的缺失值格式，简化后续逻辑
2. t1/t2重排：针对每行生成无重复的编码员组合，通过全局计数优先选择出现次数较少的组合，保证各列分布均匀
3. t3/t4处理：按照原数据的非缺失行数对应指定比例选择填充行，每次选择时排除当前行已使用的编码员，同时优先选当前列出现次数最少的编码员，兼顾无重复和分布均匀要求
4. 结果转换：将NA转回空字符串，匹配原数据的缺失值展示格式

内容的提问来源于stack exchange，提问作者Ruam Pimentel