Найти конечную точку пути для всех узлов вдоль этого пути в R - PullRequest
Новая
       17

Найти конечную точку пути для всех узлов вдоль этого пути в R

0 голосов
/ 14 января 2020

У меня есть набор данных, который кодирует переходы между единицами, как эта, где Единица А - это единица, которая заменяет Единицу В в конкретную дату. После того, как блок A заменяет блок B, он становится активным. 

Unit A | Transition Date | Unit B
---------------------------------
xxx04  | 1/1/2020        | xxx03
xxx03  | 15/7/2019       | xxx02
xxx02  | 12/6/2005       | xxx01
aaa02  | 19/6/2015       | aaa01
bbb03  | 23/5/2010       | bbb02
bbb02  | 1/4/2009        | bbb01

Фактический набор данных содержит около 30 000 переходов, которые варьируются между 1 переходом и 30.

Что я хочу знать для каждой единицы в наборе данных (как единиц A, так и B), если она является частью цепочки единиц, то какая конечная единица в цепочке. Поэтому я думаю, что окончательный набор данных должен выглядеть следующим образом: 

Unit  | Final Unit
------------------
xxx01 | xxx04
xxx02 | xxx04
xxx03 | xxx04
xxx04 | xxx04
aaa01 | aaa02
aaa02 | aaa02
bbb01 | bbb03
bbb02 | bbb03
bbb03 | bbb03

Исходя из моего поиска в Google, я думаю, что это проблема с графом, когда мне нужно кодировать путь между узлами и найти конечный узел на тропинка. Но я не уверен, как на самом деле написать код на R, чтобы сделать это. Я думаю, что это будет включать в себя рекурсивную функцию, которая зацикливается на элементах.

В идеале мне бы хотелось получить ответ в базовой R / tidyverse, а не использовать некоторую библиотеку графов, такую ​​как igraph, чтобы я мог действительно понять, что происходит механическим способом.

1 Ответ

0 голосов
/ 15 января 2020

Вот предложение, которое может работать: 

library(tidyverse)

df <- tibble(unit_a = c("x4", "x3", "x2", "a2", "b3", "b2"), 
             unit_b = c("x3", "x2", "x1", "a1", "b2", "b1"))


# get all units and identify non final units:
all_units <- unique(c(df$unit_a, df$unit_b))
non_final_units <- all_units[all_units %in% df$unit_b] ## assumption: none of the final units appear in df$unit_b

# initial result mapping
mapping <- tibble(unit = all_units, final_unit = all_units)

#get the indices of non-final units in mapping$final_units, i.e. those which need replacement
repl <- which(mapping$final_unit %in% non_final_units)

while (length(repl) > 0) # as long as there are still non-final elements in mapping$final_unit
{ 
    # build vector with elements to be replaced:
    repl_v <- sapply(repl, function(x) df$unit_a[df$unit_b == mapping$final_unit[x]])

    # replace non-final elements
    mapping$final_unit[repl] <- repl_v

    # get the indices of still non-final units:
    repl <- which(mapping$final_unit %in% non_final_units)
}
...