如何在R中从DataFrame的转运步骤生成产品完整运输路线？

问题 #

现有记录产品转运信息的DataFrame，包含transfersite（转运站点）、product_code（产品编码）和site（目标站点）：

site <- c("DC_Frankfurt","F6_DC_Bordeaux","B3_Paris","BEAG_Toronto","DC_Frankfurt","Final_dest1","Final2","Final3")
product_code <- c("000001","000001","000001","000001","000002","000001","000001","000001")
transfersite <- c("Plant1","DC_Frankfurt","DC_Frankfurt","DC_Frankfurt","Plant2","B3_Paris","BEAG_Toronto","F6_DC_Bordeaux")

df <- data.frame(transfersite, product_code,site)

每个产品编码对应不同运输路径，可能从Plant直达最终目的地，也可能经过多个中转步骤。需要将这些步骤转换为宽格式DataFrame，每行对应一条完整路径，预期结果如下：

product_code <- c("000001","000001","000001","000002")
step1 <- c("Plant1","Plant1","Plant1","Plant2")
step2 <- c("DC_Frankfurt","DC_Frankfurt","DC_Frankfurt","DC_Frankfurt")
step3 <- c("F6_DC_Bordeaux","B3_Paris","BEAG_Toronto",NA)
step4 <- c("Final3","Final_dest1","Final2",NA)

result_expected <- data.frame(product_code,step1,step2,step3,step4)

尝试手动拼接步骤的方法，无法适配步骤数量变化的场景，也无法正确合并同路径到同一行，无法得到预期结果：

my_test <- df %>% 
  filter(str_detect(transfersite,"Plant" )) %>%
  mutate(step1 = transfersite,
         step2 = site) %>%
  full_join(df)

my_test <- my_test %>%
  semi_join(my_test, by = c("product_code" = "product_code", "transfersite" = "step2")) %>%
  mutate(step3 = site) %>%
  full_join(my_test)

my_test <- my_test %>%
  semi_join(my_test, by = c("product_code" = "product_code", "transfersite" = "step3")) %>%
  mutate(step4 = site) %>%
  full_join(my_test)

寻求通用实现方案解决上述问题。

通用解决方案 #

以下提供两种通用方法，均能自动适配不同长度的转运路径，无需手动拼接步骤：

方法一：使用igraph构建路径（适合复杂路径场景） #

通过图结构识别所有起点到终点的完整路径，再转换为宽格式：

library(dplyr)
library(tidyr)
library(igraph)

# 按产品分组处理，提取每条完整路径
path_list <- df %>%
  group_split(product_code) %>%
  lapply(function(sub_df) {
    # 创建有向图，节点为站点，边为转运关系
    g <- graph_from_data_frame(sub_df[, c("transfersite", "site")], directed = TRUE)
    # 筛选起点（无入边的Plant节点）和终点（无出边的Final节点）
    start_nodes <- V(g)[degree(g, mode = "in") == 0]$name
    end_nodes <- V(g)[degree(g, mode = "out") == 0]$name
    
    # 提取所有起点到终点的路径并整理为长格式
    lapply(start_nodes, function(start) {
      lapply(end_nodes, function(end) {
        all_shortest_paths(g, from = start, to = end)$vpath %>%
          lapply(function(path) {
            data.frame(
              product_code = unique(sub_df$product_code),
              step = paste0("step", seq_along(path)),
              value = names(path),
              stringsAsFactors = FALSE
            )
          }) %>%
          bind_rows()
      }) %>%
        bind_rows()
    }) %>%
      bind_rows()
  }) %>%
  bind_rows()

# 转换为宽格式
result <- path_list %>%
  pivot_wider(names_from = step, values_from = value) %>%
  arrange(product_code)

# 查看结果
print(result)

方法二：使用dplyr+purrr递归扩展路径（无需额外安装igraph） #

通过递归方式逐步扩展路径，直到无法继续中转：

library(dplyr)
library(tidyr)
library(purrr)

# 递归构建路径的函数
build_paths <- function(df) {
  # 初始化路径：从Plant起点开始的第一步
  paths <- df %>%
    filter(grepl("^Plant", transfersite)) %>%
    mutate(path = map2(transfersite, site, ~c(.x, .y))) %>%
    select(product_code, path)
  
  # 循环扩展路径，直到没有后续中转站点
  repeat {
    # 找到当前路径最后一个节点对应的后续站点
    next_steps <- paths %>%
      mutate(last_node = map_chr(path, ~tail(.x, 1))) %>%
      left_join(df, by = c("product_code", "last_node" = "transfersite")) %>%
      filter(!is.na(site))
    
    if (nrow(next_steps) == 0) break
    
    # 更新路径，添加后续站点
    paths <- next_steps %>%
      mutate(path = map2(path, site, ~c(.x, .y))) %>%
      select(product_code, path) %>%
      bind_rows(paths %>% filter(!product_code %in% next_steps$product_code))
  }
  
  # 将路径转换为宽格式
  paths %>%
    mutate(step_df = map(path, ~tibble(step = paste0("step", seq_along(.x)), value = .x))) %>%
    unnest(step_df) %>%
    pivot_wider(names_from = step, values_from = value)
}

# 运行函数并整理结果
result <- build_paths(df) %>%
  arrange(product_code)

# 查看结果
print(result)

两种方法运行后均能得到与预期一致的宽格式路径数据，且自动适配不同产品的路径长度差异。

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