R语言：基于PROJ_ID层级键累加PROJ_NAME值的实现问题

原始DataFrame结构：

PROJ_ID     PROJ_NAME
1                    KA0034       A JST#3
2                 KA0034.10 A JST#3-Dares
3          KA0034.10.110201 A JST#3-Dares
4      KA0034.10.110201.LOV           VOM
5  KA0034.10.110201.LOV.MAX A JST#3-Dares
6                 KA0034.FN   Some Invent
7          KA0034.FN.010XYZ   Some Invent
8      KA0034.FN.010XYZ.LEX   Some Invent
9  KA0034.FN.010XYZ.LEX.NAT       A JST#3

需求：根据PROJ_ID的点分隔层级，把对应层级的PROJ_NAME按顺序拼接成新的PROJ_NAME列，即使值重复也要保留。例如KA0034.10.110201.LOV对应的结果应为A JST#3.A JST#3-Dares.A JST#3-Dares.VOM。

此前使用的代码 #

input <- data.frame(
  
  PROJ_ID = c("KA0034",
              "KA0034.10",
              "KA0034.10.110201",
              "KA0034.10.110201.LOV",
              "KA0034.10.110201.LOV.MAX",
              "KA0034.FN",
              "KA0034.FN.010XYZ",
              "KA0034.FN.010XYZ.LEX",
              "KA0034.FN.010XYZ.LEX.NAT"),
  
  PROJ_NAME = c("A JST#3",
                "A JST#3-Dares",
                "A JST#3-Dares",
                "VOM",
                "A JST#3-Dares",
                "Some Invent",
                "Some Invent",
                "Some Invent",
                "A JST#3")
)


fun <- function(st) strcapture("(.*)[.][^.]+$", st, list(L=""))$L



input <- input %>%
  mutate(K = fun(PROJ_ID))



while (TRUE) {
  input <- left_join(input, select(input, PROJ_ID, iss = PROJ_NAME), by = c("K" = "PROJ_ID")) %>%
    mutate(
      PROJ_NAME = if_else(is.na(iss), PROJ_NAME,
                          if_else(PROJ_ID == K, PROJ_NAME, paste(iss, PROJ_NAME, sep = "."))),
      K = fun(K)) %>%
    select(-iss)
  if (all(is.na(input$K))) break
}



input$K <- NULL



# Update the PROJ_NAME column to include repeated parts for each unique PROJ_NAME
input$PROJ_NAME <- sapply(strsplit(as.character(input$PROJ_NAME), "\\."), function(x) {
  unique_parts <- unique(x)
  paste(unique_parts, collapse = ".")
})



# Print the updated dataframe
print(input)

当前代码输出：

PROJ_ID                 PROJ_NAME
1                    KA0034                   A JST#3
2                 KA0034.10     A JST#3.A JST#3-Dares
3          KA0034.10.110201     A JST#3.A JST#3-Dares
4      KA0034.10.110201.LOV A JST#3.A JST#3-Dares.VOM
5  KA0034.10.110201.LOV.MAX A JST#3.A JST#3-Dares.VOM
6                 KA0034.FN       A JST#3.Some Invent
7          KA0034.FN.010XYZ       A JST#3.Some Invent
8      KA0034.FN.010XYZ.LEX       A JST#3.Some Invent
9  KA0034.FN.010XYZ.LEX.NAT       A JST#3.Some Invent

预期输出：

PROJ_ID                                             PROJ_NAME
1                    KA0034                                               A JST#3
2                 KA0034.10                                 A JST#3.A JST#3-Dares
3          KA0034.10.110201                   A JST#3.A JST#3-Dares.A JST#3-Dares
4      KA0034.10.110201.LOV               A JST#3.A JST#3-Dares.A JST#3-Dares.VOM
5  KA0034.10.110201.LOV.MAX A JST#3.A JST#3-Dares.A JST#3-Dares.VOM.A JST#3-Dares
6                 KA0034.FN                                   A JST#3.Some Invent
7          KA0034.FN.010XYZ                       A JST#3.Some Invent.Some Invent
8      KA0034.FN.010XYZ.LEX           A JST#3.Some Invent.Some Invent.Some Invent
9  KA0034.FN.010XYZ.LEX.NAT   A JST#3.Some Invent.Some Invent.Some Invent.A JST#3

修改后的解决方案代码 #

input <- data.frame(
  
  PROJ_ID = c("KA0034",
              "KA0034.10",
              "KA0034.10.110201",
              "KA0034.10.110201.LOV",
              "KA0034.10.110201.LOV.MAX",
              "KA0034.FN",
              "KA0034.FN.010XYZ",
              "KA0034.FN.010XYZ.LEX",
              "KA0034.FN.010XYZ.LEX.NAT"),
  
  PROJ_NAME = c("A JST#3",
                "A JST#3-Dares",
                "A JST#3-Dares",
                "VOM",
                "A JST#3-Dares",
                "Some Invent",
                "Some Invent",
                "Some Invent",
                "A JST#3")
)

# 提取父级PROJ_ID
get_parent <- function(id) {
  if (!grepl("\\.", id)) return(NA_character_)
  sub("\\.[^.]+$", "", id)
}

# 为每个行生成从根到当前节点的完整层级ID链
input <- input %>%
  mutate(
    all_levels = map(PROJ_ID, function(id) {
      levels <- character()
      current <- id
      while(!is.na(current)) {
        levels <- c(current, levels)
        current <- get_parent(current)
      }
      levels
    })
  )

# 匹配层级ID对应的PROJ_NAME并拼接（保留所有重复项）
input <- input %>%
  mutate(
    PROJ_NAME = map_chr(all_levels, function(ids) {
      names <- input$PROJ_NAME[match(ids, input$PROJ_ID)]
      paste(names, collapse = ".")
    })
  ) %>%
  select(-all_levels)

# 打印结果
print(input)

修改说明 #

1. 移除了原代码中最后一段对PROJ_NAME拆分去重的逻辑，这是导致重复项丢失的核心原因
2. 改用map生成每个PROJ_ID的完整层级链（从根节点到当前节点），确保每个层级都被覆盖
3. 通过匹配层级链中的ID，提取对应的PROJ_NAME并直接拼接，完整保留所有重复值

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