Search code examples
rroutesigraphdijkstratraveling-salesman

tidying igraph plot and routing or TSP question


I have less experience in R and I need help tidying my plot as it looks messy. Also, my project is to find the best minimal route from Seoul to every city and back to Seoul. It is almost like Traveling Salesman Problem (TSP) but there are some cities needed to be visited more than once as it is the only way to reach certain cities. I don't know how to do and what packages to use.

This is my code for igraph plot

library(igraph)

g1 <- graph( c("Seoul","Incheon","Seoul","Goyang","Seoul","Seongnam","Seoul",
              "Bucheon","Seoul","Uijeongbu","Seoul","Gimpo",
              "Seoul","Gwangmyeong", "Seoul", "Hanam","Seoul", "Guri",
              "Seoul","Gwacheon","Busan","Changwon","Busan","Gimhae",
              "Busan","Jeju","Busan","Yangsan","Busan","Geoje",
              "Incheon","Goyang","Incheon","Bucheon","Incheon","Siheung",
              "Incheon","Jeju","Incheon","Gimpo","Daegu","Gumi",
              "Daegu","Gyeongsan","Daegu","Yeongcheon","Daejeon",
              "Cheongju","Daejeon","Nonsan","Daejeon","Gongju",
              "Daejeon","Gyeryong","Gwangju","Naju","Suwon","Yongin",
              "Suwon","Seongnam","Suwon","Hwaseong","Suwon","Ansan",
              "Suwon","Gunpo","Suwon","Osan","Suwon","Uiwang",
              "Ulsan","Yangsan","Ulsan","Gyeongju","Ulsan","Miryang",
              "Yongin","Seongnam","Yongin","Hwaseong","Yongin","Pyeongtaek",
              "Yongin","Gwangju-si","Yongin","Icheon","Yongin","Anseong",
              "Yongin","Uiwang","Goyang","Gimpo","Goyang","Paju","Goyang",
              "Yangju","Changwon","Gimhae","Changwon","Jinju","Changwon",
              "Miryang","Seongnam","Gwangju-si","Seongnam","Hanam","Seongnam",
              "Uiwang","Seongnam","Gwacheon","Hwaseong","Ansan","Hwaseong",
              "Pyeongtaek","Hwaseong","Gunpo","Hwaseong","Osan","Cheongju",
              "Cheonan","Cheongju","Sejong","Bucheon","Siheung","Bucheon",
              "Gwangmyeong","Ansan","Anyang","Ansan","Siheung","Ansan",
              "Gunpo","Namyangju","Uijeongbu","Namyangju","Chuncheon",
              "Namyangju","Hanam","Namyangju","Guri","Cheonan","Pyeongtaek",
              "Cheonan","Sejong","Cheonan","Asan","Cheonan","Anseong",
              "Jeonju","Gimje","Gimhae","Yangsan","Gimhae","Miryang",
              "Pyeongtaek","Asan","Pyeongtaek","Osan","Pyeongtaek","Anseong",
              "Pyeongtaek","Dangjin","Anyang","Siheung","Anyang","Gwangmyeong",
              "Anyang","Gunpo","Anyang","Gwacheon","Siheung","Gwangmyeong",
              "Siheung","Gunpo","Pohang","Yeongcheon","Pohang","Gyeongju",
              "Jeju","Gimpo","Jeju","Mokpo","Jeju","Seogwipo","Uijeongbu",
              "Yangju","Uijeongbu","Pocheon","Paju","Yangju","Gumi","Gimcheon",
              "Gumi","Sangju","Gwangju-si","Hanam","Gwangju-si","Icheon",
              "Gwangju-si","Yeoju","Sejong","Gongju","Wonju","Chungju",
              "Wonju","Jecheon","Wonju","Yeoju","Jinju","Sacheon", "Yangsan",
              "Miryang","Asan","Gongju","Iksan","Gunsan","Iksan","Nonsan",
              "Iksan","Gimje","Chuncheon","Pocheon","Gyeongsan","Yeongcheon",
              "Gunpo","Uiwang","Suncheon","Yeosu","Suncheon","Gwangyang",
              "Gunsan","Gimje","Gyeongju","Yeongcheon","Geoje","Tongyeong",
              "Osan","Anseong","Yangju","Pocheon","Yangju","Dongducheon",
              "Icheon","Anseong","Icheon","Yeoju","Mokpo","Naju","Chungju",
              "Jecheon","Chungju","Yeoju","Chungju","Mungyeong","Gangneung",
              "Donghae","Gangneung","Sokcho","Seosan","Dangjin","Andong",
              "Yeongju","Pocheon","Dongducheon","Gimcheon","Sangju","Tongyeong",
              "Sacheon","Nonsan","Gongju","Nonsan","Boryeong","Nonsan",
              "Gyeryong","Gongju","Boryeong","Gongju","Gyeryong","Jeongeup",
              "Gimje","Yeongju","Mungyeong","Yeongju","Taebaek","Sangju",
              "Mungyeong","Sokcho","Samcheok","Samcheok","Taebaek",
              "Suncheon","Gwangju"), directed=F)

E(g1)$distance <- c(27, 16, 20, 19, 20, 24, 14, 20, 15, 15, 36, 18, 299, 18, 53,
                    25, 8, 12, 440, 18, 36, 13, 33, 33, 31, 26, 15, 20, 13, 20,
                    19, 18, 13, 16, 10, 33, 36, 51, 24, 31, 28, 21, 23, 27, 22,
                    11, 12, 24, 18, 52, 27, 11, 13, 19, 13, 14, 34, 20, 23, 38,
                    18, 12, 9, 12, 7, 10, 19, 53, 11, 8, 20, 27, 11, 26, 24, 18,
                    33, 25, 18, 15, 44, 14, 12, 4, 5, 12, 12, 37, 21, 458, 146,
                    27, 10, 23, 24, 21, 36, 14, 23, 36, 21, 39, 33, 26, 20, 32, 
                    40, 20, 29, 18, 47, 24, 4, 27, 19, 22, 29, 17, 24, 18, 13, 
                    32, 18, 37, 28, 43, 51, 33, 56, 20, 28, 12, 30, 38, 29, 47,
                    17, 47, 22, 26, 46, 51, 20, 10, 36,63)

plot(g1, edge.label=E(g1)$distance, 
     vertex.label.cex=0.6, vertex.size=4)

igraph plot


Solution

  • Using trick from https://or.stackexchange.com/questions/5555/tsp-with-repeated-city-visits

    library(data.table)
    library(purrr)
    library(TSP)
    library(igraph)
    

    We need to create distance matrix based on shortest paths for each pair of vertices:

    vertex_names <- names(V(g1))
    N <- length(vertex_names)
    
    dt <- map(
      head(seq_along(vertex_names), -1), 
      ~data.table(
        from = vertex_names[[.x]],
        to = vertex_names[(.x+1):N],
        path = map(
          shortest_paths(g1, vertex_names[[.x]], vertex_names[(.x+1):N])[["vpath"]], 
          names
        )
      ),
    ) %>%
      rbindlist()
    

    then we calculate distances of shortest paths:

    m <- as_adjacency_matrix(g1, type = "both", attr = "distance", sparse = FALSE)
    dt[, weight := map_dbl(path, ~sum(m[embed(.x, 2)[, 2:1, drop=FALSE]]))]
    

    now we assemble new matrix:

    dt <- rbind(
      dt, dt[, .(from = to, to = from, path = map(path, rev), weight = weight)]
    )
    
    new_m <- matrix(0, N, N)
    rownames(new_m) <- colnames(new_m) <- vertex_names
    new_m[as.matrix(dt[, .(from,to)])] <- dt[["weight"]]
    

    on this new matrix we use some heuristic to solve TSP (for exact solution you should use method="concorde"):

    res <- new_m %>%
      TSP() %>%
      solve_TSP(repetitions = 1000, two_opt = TRUE) 
    

    now we exchange each pair of consecutive cities with shortest path:

    start_city <- "Seoul"
    
    path_dt <- c(start_city, labels(cut_tour(res, start_city)), start_city) %>%
      embed(2) %>%
      .[,2:1,drop = FALSE] %>%
      "colnames<-"(c("from", "to")) %>%
      as.data.table()
    path_dt <- dt[path_dt, on = .(from ,to)]
    
    my_path <- c(unlist(map(path_dt[["path"]], head, -1)), start_city)
    

    my_path is heuristic solution with distance tour_length(res)