基于Piece_ID与Colour分组，按Length_mm生成玩具零件配对编号

我有一个玩具零件的多维度测量数据集，其中Piece_ID代表唯一玩具套装，Colour是套装内单个零件的颜色（以乐高零件为例）。需要基于Length_mm测量值，按Piece_ID和Colour的唯一分组生成新列Pair，规则如下：

• 同一套装、同色且长度差≤2mm的零件可组成一对（仅成对）；
• Colour为"Unknown"的零件不参与配对，每个单独编号；
• 配对编号在每个套装内按顺序生成，未配对的零件也需单独编号。

示例输入数据集 #

table <- "Piece_ID Width_mm   Length_mm  Colour
1  A     1.68 3.19 Unknown
2  A     1.47 2.88 Blue
3  A     1.64 2.90 Blue
4  A     1.80 3.20 Unknown
5  B     1.76 3.12 Red
6  B     1.61 3.11 Red
7  B     1.57 3.51 Blue
8  B     1.48 3.54 Blue
9  A     1.46 4.05 Green
10 A     1.83 4.03 Green
11 A     1.83 4.11 Green
12 A     1.83 4.51 Green
13 A     1.83 4.12 Green
14 A     1.83 3.55 Blue
15 A     1.83 3.57 Blue
16 A     1.83 3.55 Blue"

# 创建数据框
df <- read.table(text=table, header = TRUE)
df

期望输出 #

table2 <- "Piece_ID Width_mm   Length_mm  Colour Pair
1  A     1.68 3.19 Unknown 1
2  A     1.47 2.88 Blue 2
3  A     1.64 2.90 Blue 2
4  A     1.80 3.20 Unknown 3
5  B     1.76 3.12 Red 1
6  B     1.61 3.11 Red 1
7  B     1.57 3.51 Blue 2
8  B     1.48 3.54 Blue 3
9  A     1.46 4.05 Green 4
10 A     1.83 4.03 Green 4
11 A     1.83 4.11 Green 5
12 A     1.83 4.51 Green 6
13 A     1.83 4.12 Green 5
14 A     1.83 3.55 Blue 6
15 A     1.83 3.57 Blue 7
16 A     1.83 3.55 Blue 6"

# 创建结果数据框
pairs <- read.table(text=table2, header = TRUE)
pairs

我之前考虑过用ifelse语句，但不确定如何排除"Unknown"颜色，也不知道怎么给所有零件（包括未配对的）生成连续的配对编号。

推荐用dplyr结合聚类工具实现，逻辑清晰且效率较高，以下是两种可行方案：

方案一：基于聚类的高效实现（推荐） #

利用pam聚类算法快速将同色零件按长度差分组，再统一生成连续编号：

library(dplyr)
library(cluster)

# 处理数据
result <- df %>%
  group_by(Piece_ID) %>%
  # 给Unknown零件分配独立临时组号
  mutate(temp_group = ifelse(Colour == "Unknown", row_number(), NA_integer_)) %>%
  # 按套装+颜色分组，对非Unknown零件按长度聚类
  group_by(Piece_ID, Colour, .add = TRUE) %>%
  mutate(
    temp_group = case_when(
      !is.na(temp_group) ~ temp_group,
      TRUE ~ as.integer(pam(Length_mm, k = ceiling(n()/2), diss = TRUE, metric = "manhattan")$clustering)
    )
  ) %>%
  # 将临时组号转换为套装内连续的Pair编号
  group_by(Piece_ID) %>%
  mutate(Pair = dense_rank(temp_group)) %>%
  ungroup()

# 查看结果
result

代码说明 #

• Unknown零件处理：直接用row_number()给每个Unknown零件分配唯一临时组，确保单独编号；
• 聚类分组：pam算法以曼哈顿距离（对应长度差绝对值）为依据，k=ceiling(n()/2)保证最多两两配对，符合"仅成对"要求；
• 连续编号生成：dense_rank()将临时组号映射为套装内连续的Pair值，确保编号顺序生成。

方案二：纯基础循环实现（适合小数据集） #

如果不想引入额外包，可通过循环手动配对：

library(dplyr)

# 处理数据
result <- df %>%
  group_by(Piece_ID) %>%
  mutate(Pair = 0) %>%
  group_by(Piece_ID, Colour, .add = TRUE) %>%
  do({
    df_sub <- .
    if (df_sub$Colour[1] == "Unknown") {
      # Unknown零件单独编号
      df_sub$Pair <- seq(nrow(df_sub))
    } else {
      df_sub <- df_sub %>% arrange(Length_mm)
      pair_num <- 1
      used <- rep(FALSE, nrow(df_sub))
      
      # 循环配对同色零件
      for (i in seq(nrow(df_sub))) {
        if (!used[i]) {
          # 查找未使用且长度差≤2mm的零件
          match_idx <- which(!used & abs(df_sub$Length_mm - df_sub$Length_mm[i]) <= 2)
          if (length(match_idx) >= 2) {
            # 配对两个零件
            df_sub$Pair[c(i, match_idx[2])] <- pair_num
            used[c(i, match_idx[2])] <- TRUE
          } else {
            # 单个零件单独编号
            df_sub$Pair[i] <- pair_num
            used[i] <- TRUE
          }
          pair_num <- pair_num + 1
        }
      }
    }
    df_sub
  }) %>%
  # 转换为套装内连续编号
  group_by(Piece_ID) %>%
  mutate(Pair = dense_rank(Pair)) %>%
  ungroup() %>%
  arrange(row_number()) # 恢复原数据顺序

# 查看结果
result

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