R create routes from steps in a dataframe

Question

Here is a dataframe I have

I made a simple example, but the logic is here : for a given product_code I can have various final destinations and various steps (can be Plant to final_destination or Plant to step1 to step_x... to final_destination)

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)

This is what I expect :

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)

I tried this so far, works well but if there are more than 4 steps I am dead, and if there are not, the code starts to loop on the final steps... Plus, with that, I don't know how to merge on the same row, it does not match what I expect yet.

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)

Thank you everyone.

Answer 1

Something like this, perhaps?

i <- 2; var <- paste0("step", i)
dfnew <- rename(df, step1 = transfersite, step2 = site)
while (i < 22 && any(!is.na(dfnew[[ var ]]))) {
  prevvar <- var
  i <- i + 1; var <- paste0("step", i)
  dfnew <- left_join(dfnew, rename(df, !!prevvar := transfersite, !!var := site),
                     by = c("product_code", prevvar))
}
dfnew %>%
  mutate(NAs = rowSums(is.na(cur_data()))) %>%
  group_by(product_code) %>%
  filter(NAs == min(NAs)) %>%
  ungroup() %>%
  select(product_code, everything(), -!!var, -NAs)
# # A tibble: 4 × 5
#   product_code step1  step2        step3          step4      
#   <chr>        <chr>  <chr>        <chr>          <chr>      
# 1 000001       Plant1 DC_Frankfurt F6_DC_Bordeaux Final3     
# 2 000001       Plant1 DC_Frankfurt B3_Paris       Final_dest1
# 3 000001       Plant1 DC_Frankfurt BEAG_Toronto   Final2     
# 4 000002       Plant2 DC_Frankfurt NA             NA         

I added i < 22 just as a guard against infinite loops. These can occur when there are circular paths in the graph. "22" is arbitrary, if you expect all of your real paths will be fewer than (say) 10, that's also a good number.

Answer 2

Here's a recursive function that will add steps until no more steps are possible:

library(dplyr)   # >= v1.1.0
library(stringr)

route_steps <- function(data, step = 1, max_steps = Inf) {
  step_name <- paste0("step", step)
  if (step == 1) {
    out <- data %>% 
      filter(str_detect(transfersite, "Plant")) %>%
      rename(!!step_name := transfersite)
  } else {
    keys <- c("product_code", "transfersite")
    names(keys) <- c("product_code", step_name)
    out <- data %>% 
      rename(!!step_name := site) %>%
      left_join(df, by = keys, multiple = "all")
  }
  if (all(is.na(out$site)) | step == max_steps) mutate(out, site = NULL)
  else route_steps(out, step = step + 1, max_steps = max_steps)
}

route_steps(df)

result
#    step1 product_code        step2          step3       step4
# 1 Plant1       000001 DC_Frankfurt F6_DC_Bordeaux      Final3
# 2 Plant1       000001 DC_Frankfurt       B3_Paris Final_dest1
# 3 Plant1       000001 DC_Frankfurt   BEAG_Toronto      Final2
# 4 Plant2       000002 DC_Frankfurt           <NA>        <NA>

Things could get wonky, e.g., if circular routes are possible. As a fallback, you can try setting the max_steps argument, which may or may not help -- I haven't tested with circular routes.