Найти маршруты между двумя точками в R

Question

Со следующими данными начальных и конечных точек, как мы можем получить маршруты между 2 точками.

> ddf 
    start end 
1  a b 
2  a c 
3  b e 
4  b f 
5  b c 
6  a d 
7  e f 
8  f g 

> dput(ddf) 
structure(list(start = structure(c(1L, 1L, 2L, 2L, 2L, 1L, 3L, 
4L), .Label = c("a", "b", "e", "f"), class = "factor"), end = structure(c(1L, 
2L, 4L, 5L, 2L, 3L, 5L, 6L), .Label = c("b", "c", "d", "e", "f", 
"g"), class = "factor")), .Names = c("start", "end"), class = "data.frame", row.names = c(NA, 
-8L)) 
> 

Эта страница (http://www.anselm.edu/homepage/mmalita/culpro/graf1.html) показывает только 2 решения строки в Прологе! Следующий код работает, но не дает правильного выходного списка. Его можно запустить с помощью mainpath (ddf, 'a', 'f'), чтобы найти путь между 'a' и 'f'.

Уверен, что это может быть значительно улучшено, особенно все это для циклов и т. Д. Можно удалить, используя функции приложения и т. Д. Я знаю, что пакеты с такими функциями доступны, но как это можно сделать в базе R? Ваши ответы/комментарии будут оценены.

Answer 1

После намного короче и легко понять, рекурсивная функцию, используя базу R. (Первые 2 строки не нужны, если начальные и конечные столбцы передаваемых данных являются рамками уже символа, а не фактора).

mainpath2 = function(ddf, startpt, endpt, route=c()){ 
    ddf$start = as.character(ddf$start) 
    ddf$end = as.character(ddf$end) 
    if(startpt == endpt) return("Error: Same Start and End points.\n") 
    for(i in 1:nrow(ddf)){ 
     if(ddf$start[i] == startpt){ 
      route = append(route, startpt) 
      if(ddf$end[i] == endpt){ 
       # PATH FOUND: 
       route = append(route, endpt) 
       print(route) 
      } 
      else mainpath2(ddf[-i, ], ddf$end[i], endpt, route) 
      route = route[-length(route)] 
     } 
    } 
} 

> mainpath2(ddf, 'a', 'g') 
[1] "a" "b" "e" "f" "g" 
[1] "a" "b" "f" "g" 

Answer 2

Хотя я уверен, что есть прекрасные способы сделать это с помощью линейной алгебры, вот относительно интуитивный метод (с использованием dplyr здесь, но перевести, как вам нравится):

library(dplyr) 

# convert factors to characters, filter down to possible starting points 
df %>% mutate_each(funs(as.character)) %>% filter(start == 'a') %>% 
    # join to add possible next steps, indexing endpoints to startpoints 
    left_join(df, by = c('end' = 'start')) %>% 
    # iterate for successive steps 
    left_join(df, by = c('end.y' = 'start')) %>% 
    left_join(df, by = c('end.y.y' = 'start')) %>% 
    # chop out rows that didn't end at 'g' (omit if you're curious) 
    filter(apply(., 1, function(x){x[length(na.omit(x))]}) == 'g') 

# start end.x end.y end.y.y end 
# 1  a  b  e  f g 
# 2  a  b  f  g <NA> 

Если df это факторы, вы я получу предупреждения о принуждении, хотя он будет работать нормально (принуждение начать или добавить %>% mutate_each(funs(as.character)) на каждый вызов df, и они исчезнут). Названия столбцов немного уродливы; установите их с параметром left_joinsuffix или select или rename, если хотите.

Очевидно, что итерация присоединяется предлагает цикл, который может выглядеть так:

df2 <- df %>% mutate_each(funs(as.character)) %>% filter(start == 'a') 

for(i in 0:2){ 
    endcol <- paste0('end', paste(rep('.y', i), collapse = '')) 
    df2 <- df2 %>% left_join(df, by = setNames('start', endcol)) 
} 

df2 %>% filter(apply(., 1, function(x){x[length(na.omit(x))]}) == 'g') 

# start end.x end.y end.y.y end 
# 1  a  b  e  f g 
# 2  a  b  f  g <NA> 

Если вы установите число итераций слишком высокой, это будет ошибка, потому что нет ни одной строки, чтобы присоединиться, но ошибка на самом деле довольно удобна, так как цикл уже сохранил нужный df2, поэтому ошибка просто прекращает выполнение дополнительной работы. Добавить tryCatch, если вам нравится, или перейти в другой стороне и реорганизовать его в страшный виде while цикла, который будет на самом деле итерацией совершенного числа раз:

df2 <- df %>% mutate_each(funs(as.character)) %>% filter(start == 'a') 
endcol <- 'end' # initialize iterating variable 

while(TRUE){ 
    df2 <- df2 %>% left_join(df, by = setNames('start', endcol)) 
    endcol <- paste0(endcol, '.y') 
} 

df2 %>% filter(apply(., 1, function(x){x[length(na.omit(x))]}) == 'g') 

# start end.x end.y end.y.y end 
# 1  a  b  e  f g 
# 2  a  b  f  g <NA>