基于条件清洗DataFrame：匹配正负交易并补全NA值

测试数据1 (temp) #

temp <- structure(list(Date = c("24/06/2002", "24/06/2002", "25/06/2002","25/06/2002", "26/06/2002", 
                               "02/07/2002","03/07/2002","24/07/2002", "08/07/2002",
                               "08/07/2002", "15/07/2002", "17/07/2002", 
                               "22/07/2002", "22/07/2002", "28/07/2002", "29/07/2002"), 
                      payment = c(200, 1000,-1000, -1000, 1000,
                                  -1000,-1000,-1000, 1200,
                                  -1200, 1200, 1200,
                                  200, 56700, -56700, -200), 
                      Code = c("ABC", "M567", "M567","M567", "XYZ", "M567", "ABX" ,
                               "M567","M567", "M567", 
                               "M567", "M567", "M300", 
                               "M678", "M678", "ABC"), 
                      ID = c(NA, "98","187","187","12ee","M11","M13",
                             NA,"K999", 
                             "K999", "111", "111", "11",
                             "12345", NA, NA)), row.names = c(NA, -16L), class = "data.frame")

数据预览：

Date payment Code    ID
1  24/06/2002     200  ABC  <NA>
2  24/06/2002    1000 M567    98
3  25/06/2002   -1000 M567   187
4  25/06/2002   -1000 M567   187
5  26/06/2002    1000  XYZ  12ee
6  02/07/2002   -1000 M567   M11
7  03/07/2002   -1000  ABX   M13
8  24/07/2002   -1000 M567  <NA>
9  08/07/2002    1200 M567  K999
10 08/07/2002   -1200 M567  K999
11 15/07/2002    1200 M567   111
12 17/07/2002    1200 M567   111
13 22/07/2002     200 M300    11
14 22/07/2002   56700 M678 12345
15 28/07/2002  -56700 M678  <NA>
16 29/07/2002    -200  ABC  <NA>

需求说明 #

数据中正负金额交易需按规则处理：

• 正负金额绝对值相同、Code一致的交易为可抵消对（负金额为错误添加或退款）
• 若某行ID为NA，需先补全对应正负交易的ID（同一Code+同一金额绝对值的交易共享有效ID）
• 移除所有可完全抵消的正负对，保留无法配对的剩余行

原代码问题 #

此前编写的代码因fill(.direction='downup')仅在分组内相邻行补全ID，无法处理跨多行的匹配（如行8的-1000 M567 NA应匹配行2的ID=98，但因行间距远未生效）：

library(dplyr)
library(data.table)
library(tidyr)
Final_df <- df1 %>% 
  group_by(Code) %>%
  mutate(ind = rowid(payment)) %>%
  group_by(ind, .add = TRUE) %>% 
  fill(ID, .direction = 'downup') %>% 
  ungroup %>%
  mutate(absPayment = abs(payment)) %>% 
  arrange(ID, Code, absPayment) %>%
  group_by(Code, ID, absPayment) %>%
  mutate(grp = rowid(sign(payment))) %>% 
  group_by(grp, .add = TRUE) %>%
  filter(n() == 1) %>% 
  ungroup %>%   
  select(names(df1)) 

期望输出（temp处理后） #

Date payment Code    ID
1  25/06/2002   -1000 M567   187
2  25/06/2002   -1000 M567   187
3  26/06/2002    1000  XYZ  12ee
4  02/07/2002   -1000 M567   M11
5  03/07/2002   -1000  ABX   M13
6  15/07/2002    1200 M567   111
7  17/07/2002    1200 M567   111
8  22/07/2002     200 M300    11

测试数据2 (temp_2) #

temp_2 <-  structure(list(Date = c("22/06/2002", "23/06/2002","24/06/2002", "25/06/2002","25/06/2002", "26/06/2002", 
                               "02/07/2002","03/07/2002","24/07/2002", "08/07/2002",
                               "08/07/2002", "15/07/2002", "17/07/2002", 
                               "22/07/2002", "22/07/2002", "28/07/2002", "29/07/2002"), 
                      payment = c(200,-1000, 1000,-1000, -1000, 1000,
                                  -1000,-1000,-1000, 1200,
                                  -1200, 1200, 1200,
                                  200, 56700, -56700, -200), 
                      Code = c("ABC", "M567","M567", "M567","M567", "XYZ", "M567", "ABX" ,
                               "M567","M567", "M567", 
                               "M567", "M567", "M300", 
                               "M678", "M678", "ABC"), 
                      ID = c(NA,"187", "98","187","187","12ee",NA,NA,
                             NA,"K999", 
                             "K999", "111", "111", "11",
                             "12345", NA, NA)), row.names = c(NA, -17L), class = "data.frame")

期望输出（temp_2处理后） #

Date payment Code    ID
1  23/06/2002   -1000 M567   187
2  25/06/2002   -1000 M567   187
3  25/06/2002   -1000 M567   187
4  26/06/2002    1000  XYZ  12ee
5  03/07/2002   -1000  ABX  <NA>
6  24/07/2002   -1000 M567   98
7  15/07/2002    1200 M567   111
8  17/07/2002    1200 M567   111
9  22/07/2002     200 M300    11

解决方案代码 #

library(dplyr)
library(tidyr)

clean_transactions <- function(df) {
  df %>%
    # 1. 按Code和金额绝对值分组，补全组内所有NA的ID（取组内非NA的唯一值）
    group_by(Code, abs_payment = abs(payment)) %>%
    mutate(ID = ifelse(all(is.na(ID)), ID, na.omit(ID)[1])) %>%
    ungroup() %>%
    # 2. 标记每笔交易的正负符号
    mutate(sign_payment = sign(payment)) %>%
    # 3. 按Code、ID、abs_payment分组，给正负交易分别编号，用于配对
    group_by(Code, ID, abs_payment) %>%
    mutate(pair_id = row_number(), .by = sign_payment) %>%
    ungroup() %>%
    # 4. 按Code、ID、abs_payment、pair_id分组，筛选出无法配对的行（组内只有1行）
    group_by(Code, ID, abs_payment, pair_id) %>%
    filter(n() == 1) %>%
    ungroup() %>%
    # 5. 保留原始列，移除辅助列
    select(Date, payment, Code, ID) %>%
    # 按Date排序，和期望输出一致
    arrange(Date)
}

# 测试temp
clean_transactions(temp)

# 测试temp_2
clean_transactions(temp_2)

代码说明 #

1. 补全ID：按Code和金额绝对值分组，取组内第一个非NA的ID填充所有NA（确保同一Code+同金额的交易共享正确ID）
2. 配对标记：给每组内的正负交易分别编号，同一编号的正负交易为一对
3. 筛选剩余行：保留那些没有对应正负配对的行（即分组内只有1行的记录）
4. 最终输出按Date排序，和期望输出格式一致

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