두 점 사이의 경로 찾기 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'사이의 경로를 찾을 수 있습니다.

특히 많이 개선 될 수 있다고 확신합니다. 특히 이러한 for 루프 등은 모두 적용 기능을 사용하여 제거 할 수 있습니다. 그러한 기능을 가진 패키지는 사용 가능하지만 기본 R에서 어떻게 수행 될 수 있는지 알고 있습니까? 답변/의견을 보내 주시면 감사하겠습니다.

Answer 1

다음이 훨씬 짧고 쉽게 이해할 수있다, 재귀 함수 : 실제로 배의 완전 수를 반복하는 무서운 보이는 while 루프 만약 당신이 좋아하면 tryCatch를 추가하거나 다른 방향으로 이동하고 리팩토링 R. (보내지는 data.frame의 시작 및 끝 열이 이미 문자이고 factor가 아닌 경우 첫 번째 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를 사용하여,하지만 당신이 원하는대로 번역) 확신 동안 : df 요인이다

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))을 추가하면 시작되며 더 이상 실행되지 않습니다. 열 이름은 약간 추합니다. 원한다면 left_join의 suffix 매개 변수 또는 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을 저장 했으므로 오류가 실제로 매우 편리하므로 오류로 인해 추가 작업이 중단됩니다. 베이스를 사용하여

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>