R语言修正价格仅单数字差异时替换为组众数的dplyr代码问题

原有问题说明 #

• 需求规则：按PPCODE分组后，若组内某价格仅和组内众数价格存在单个数字的差异，就将该价格替换为组内众数价格，支持任意位置的单数字差异校验（如众数为1.45时，1.55、2.45、1.42均符合替换条件）
• 原有代码缺陷：
  1. 分组逻辑错误，额外增加了保留1位小数的分组字段，导致不满足条件的价格被错误替换
  2. 仅校验第二位小数的差异，不支持其他位置的单数字差异判断
  3. 演示数据中PPCODE=4111分组下的5.03本不该被替换，原有代码错误将其替换为众数5.45

原有代码 #

library("dplyr")

Mode <- function(x) {
  ux <- unique(x)
  ux[which.max(tabulate(match(x, ux)))]
}

pp %>% 
  group_by(PPCODE, grp = sprintf('%.1f', PRICE)) %>%
  mutate(PRICE = Mode(PRICE)) %>%
  ungroup 

演示数据集 #

pp <- structure(list(OUTLETID = c("11N", "12B", "17C",                            
"44Oo", "1NN", "5CC", "AA1", "11A"), PPCODE = c(4623,                                                                             
4623, 4623, 4111, 4111, 4623, 4111, 4111), 
PRICE = c(1.45, 1.45, 1.45, 5.45, 5.45, 1.42, 5.03, 5.45)), 
row.names = c(NA, -8L), class = c("tbl_df", "tbl", "data.frame"))

修正后代码 #

library(dplyr)

# 众数计算函数
Mode <- function(x) {
  ux <- unique(x)
  ux[which.max(tabulate(match(x, ux)))]
}

# 单数字差异判断函数：统一转为2位小数后逐位比较，不同位数为1则返回TRUE
is_single_digit_diff <- function(price, mode_price) {
  # 统一转为对应小数位数的字符串，去掉小数点
  p_str <- gsub("\\.", "", sprintf("%.2f", price))
  m_str <- gsub("\\.", "", sprintf("%.2f", mode_price))
  # 逐位比较统计不同位数
  sum(strsplit(p_str, "")[[1]] != strsplit(m_str, "")[[1]]) == 1
}

# 主逻辑
pp_new <- pp %>%
  group_by(PPCODE) %>%
  mutate(
    group_mode = Mode(PRICE),
    PRICE = ifelse(mapply(is_single_digit_diff, PRICE, group_mode), group_mode, PRICE)
  ) %>%
  select(-group_mode) %>%
  ungroup()

注意：上述判断函数默认适配两位小数的价格场景，若你的业务中价格小数位数不同，可调整sprintf("%.2f", price)中的小数位数参数即可。

运行结果说明 #

• PPCODE=4623分组下，1.42和众数1.45仅第二位小数差异，被替换为1.45，符合预期
• PPCODE=4111分组下，5.03和众数5.45有两位数字差异，保留原值5.03，解决原有代码的错误替换问题
• 支持任意位置单数字差异判断：如众数1.45对应的1.55（十分位差异）、2.45（个位差异）都会被正确识别替换

内容的提问来源于stack exchange，提问作者Adolf Miszka