gpt4 book ai didi

r - R : igraph 中的 K 最短路径

转载 作者:行者123 更新时间:2023-12-02 01:34:32 25 4
gpt4 key购买 nike

我必须找到 K 条最短路径,但是当我选择不同的 K 值并且计算的距离不正确时,我尝试的下面的代码给出了相同的路径。

我的数据集是 my.graphigraph

dput(my.graph)
structure(list(169, FALSE, c(22, 1, 2, 1, 2, 3, 114, 3, 4, 5,
4, 5, 6, 6, 7, 7, 8, 9, 8, 110, 78, 159, 9, 159, 30, 11, 13,
160, 11, 66, 160, 138, 14, 13, 14, 15, 81, 16, 15, 17, 16, 17,
18, 18, 19, 130, 19, 62, 62, 23, 42, 22, 22, 22, 23, 24, 161,
24, 25, 25, 26, 64, 26, 28, 161, 29, 28, 29, 47, 48, 53, 142,
31, 30, 32, 31, 32, 33, 33, 34, 35, 118, 34, 36, 35, 37, 36,
37, 38, 39, 38, 162, 40, 39, 40, 41, 41, 42, 43, 44, 43, 44,
45, 45, 46, 47, 46, 47, 47, 49, 48, 49, 50, 51, 50, 52, 51, 52,
53, 60, 53, 54, 53, 55, 54, 56, 55, 57, 56, 57, 58, 58, 59, 59,
60, 60, 60, 63, 162, 62, 62, 63, 64, 65, 65, 66, 166, 68, 163,
164, 69, 165, 68, 70, 69, 71, 70, 71, 72, 72, 73, 112, 73, 74,
75, 74, 76, 75, 76, 77, 78, 77, 78, 110, 78, 79, 80, 79, 146,
80, 81, 82, 81, 81, 82, 137, 164, 84, 85, 84, 86, 85, 86, 87,
87, 164, 165, 89, 89, 90, 90, 91, 92, 91, 93, 92, 93, 94, 95,
94, 165, 95, 163, 97, 97, 98, 99, 98, 99, 100, 101, 100, 101,
102, 102, 163, 104, 166, 105, 104, 106, 105, 106, 107, 108, 107,
109, 108, 109, 166, 110, 110, 125, 116, 112, 113, 112, 112, 114,
113, 114, 115, 114, 126, 115, 116, 117, 118, 117, 119, 118, 118,
120, 119, 120, 121, 121, 122, 123, 122, 124, 168, 141, 123, 124,
125, 125, 125, 126, 140, 140, 128, 128, 129, 130, 129, 130, 130,
131, 131, 132, 133, 132, 134, 133, 134, 135, 135, 136, 137, 136,
137, 137, 139, 138, 139, 168, 143, 140, 140, 141, 142, 158, 167,
143, 167, 144, 145, 144, 145, 146, 146, 146, 148, 148, 149, 149,
150, 151, 150, 152, 151, 153, 152, 153, 154, 154, 155, 156, 155,
156, 157, 157, 158, 158, 158, 159, 160, 159, 160, 160, 160, 161,
161, 162, 162, 163, 163, 163, 164, 164, 164, 165, 165, 165, 166,
166, 166, 167, 167, 168, 168), c(0, 0, 1, 0, 1, 2, 2, 2, 3, 4,
3, 4, 5, 5, 6, 6, 7, 8, 7, 9, 9, 9, 8, 10, 10, 10, 11, 11, 10,
12, 12, 12, 13, 11, 13, 14, 14, 15, 14, 16, 15, 16, 17, 17, 18,
19, 18, 19, 20, 20, 21, 21, 0, 21, 20, 23, 23, 23, 24, 24, 25,
26, 25, 27, 27, 28, 27, 28, 29, 29, 29, 30, 30, 10, 31, 30, 31,
32, 32, 33, 34, 34, 33, 35, 34, 36, 35, 36, 37, 38, 37, 38, 39,
38, 39, 40, 40, 21, 42, 43, 42, 43, 44, 44, 45, 46, 45, 29, 46,
48, 29, 48, 49, 50, 49, 51, 50, 51, 52, 53, 52, 53, 29, 54, 53,
55, 54, 56, 55, 56, 57, 57, 58, 58, 59, 53, 59, 61, 61, 20, 19,
61, 26, 64, 64, 12, 67, 67, 67, 68, 68, 68, 67, 69, 68, 70, 69,
70, 71, 71, 72, 72, 72, 73, 74, 73, 75, 74, 75, 76, 77, 76, 77,
78, 9, 78, 79, 78, 80, 79, 80, 81, 80, 14, 81, 82, 83, 83, 84,
83, 85, 84, 85, 86, 86, 87, 88, 88, 88, 89, 89, 90, 91, 90, 92,
91, 92, 93, 94, 93, 95, 94, 96, 96, 96, 97, 98, 97, 98, 99, 100,
99, 100, 101, 101, 102, 103, 103, 104, 103, 105, 104, 105, 106,
107, 106, 108, 107, 108, 109, 9, 78, 110, 111, 111, 112, 72,
111, 113, 112, 113, 114, 2, 115, 114, 111, 116, 117, 116, 118,
117, 34, 119, 118, 119, 120, 120, 121, 122, 121, 123, 123, 123,
122, 123, 124, 124, 110, 115, 126, 127, 127, 127, 128, 129, 128,
129, 19, 130, 130, 131, 132, 131, 133, 132, 133, 134, 134, 135,
136, 135, 136, 82, 138, 12, 138, 139, 139, 127, 126, 123, 30,
142, 142, 139, 143, 143, 144, 143, 144, 145, 80, 145, 147, 147,
148, 148, 149, 150, 149, 151, 150, 152, 151, 152, 153, 153, 154,
155, 154, 155, 156, 156, 157, 142, 157, 9, 159, 10, 12, 11, 159,
23, 27, 61, 38, 96, 67, 102, 68, 83, 87, 95, 88, 68, 67, 109,
103, 142, 143, 123, 139), c(3, 1, 4, 2, 7, 5, 10, 8, 11, 9, 13,
12, 15, 14, 18, 16, 22, 17, 28, 25, 33, 26, 34, 32, 38, 35, 40,
37, 41, 39, 43, 42, 46, 44, 52, 0, 53, 51, 54, 49, 57, 55, 59,
58, 62, 60, 66, 63, 67, 65, 73, 24, 75, 72, 76, 74, 78, 77, 82,
79, 84, 80, 86, 83, 87, 85, 90, 88, 93, 89, 94, 92, 96, 95, 97,
50, 100, 98, 101, 99, 103, 102, 106, 104, 107, 68, 108, 105,
110, 69, 111, 109, 114, 112, 116, 113, 117, 115, 122, 70, 120,
118, 124, 121, 126, 123, 128, 125, 129, 127, 131, 130, 133, 132,
135, 119, 136, 134, 140, 47, 139, 48, 141, 137, 142, 61, 144,
143, 145, 29, 152, 147, 154, 150, 156, 153, 157, 155, 159, 158,
162, 160, 165, 163, 167, 164, 168, 166, 171, 169, 174, 20, 172,
170, 177, 175, 179, 176, 183, 36, 182, 180, 184, 181, 189, 187,
191, 188, 192, 190, 194, 193, 198, 197, 200, 199, 203, 201, 205,
202, 206, 204, 209, 207, 211, 208, 214, 213, 217, 215, 218, 216,
221, 219, 222, 220, 224, 223, 229, 226, 231, 228, 232, 230, 235,
233, 237, 234, 238, 236, 240, 19, 241, 173, 246, 161, 247, 244,
249, 245, 252, 6, 250, 248, 254, 251, 255, 243, 258, 256, 261,
81, 260, 257, 263, 259, 264, 262, 266, 265, 269, 267, 273, 268,
274, 270, 277, 242, 276, 275, 278, 253, 282, 281, 285, 283, 287,
45, 286, 284, 289, 288, 292, 290, 294, 291, 295, 293, 297, 296,
300, 298, 302, 185, 301, 299, 304, 31, 305, 303, 309, 279, 308,
280, 310, 272, 311, 71, 314, 307, 318, 316, 319, 317, 321, 178,
322, 320, 324, 323, 326, 325, 329, 327, 331, 328, 333, 330, 334,
332, 336, 335, 339, 337, 340, 338, 342, 341, 344, 312, 345, 343,
346, 21, 348, 23, 350, 27, 349, 30, 351, 347, 352, 56, 353, 64,
355, 91, 354, 138, 357, 148, 356, 212, 358, 225, 359, 149, 360,
186, 361, 195, 364, 151, 363, 196, 362, 210, 365, 146, 367, 227,
366, 239, 368, 313, 369, 315, 370, 271, 371, 306), c(3, 1, 52,
0, 4, 2, 7, 5, 252, 6, 10, 8, 11, 9, 13, 12, 15, 14, 18, 16,
22, 17, 174, 20, 240, 19, 346, 21, 28, 25, 73, 24, 348, 23, 33,
26, 350, 27, 145, 29, 304, 31, 349, 30, 34, 32, 38, 35, 183,
36, 40, 37, 41, 39, 43, 42, 46, 44, 140, 47, 287, 45, 54, 49,
139, 48, 53, 51, 97, 50, 57, 55, 352, 56, 59, 58, 62, 60, 142,
61, 66, 63, 353, 64, 67, 65, 107, 68, 110, 69, 122, 70, 75, 72,
311, 71, 76, 74, 78, 77, 82, 79, 84, 80, 261, 81, 86, 83, 87,
85, 90, 88, 93, 89, 355, 91, 94, 92, 96, 95, 100, 98, 101, 99,
103, 102, 106, 104, 108, 105, 111, 109, 114, 112, 116, 113, 117,
115, 120, 118, 124, 121, 135, 119, 126, 123, 128, 125, 129, 127,
131, 130, 133, 132, 136, 134, 141, 137, 354, 138, 144, 143, 152,
147, 357, 148, 365, 146, 154, 150, 359, 149, 364, 151, 156, 153,
157, 155, 159, 158, 162, 160, 246, 161, 165, 163, 167, 164, 168,
166, 171, 169, 172, 170, 177, 175, 241, 173, 179, 176, 182, 180,
321, 178, 184, 181, 302, 185, 189, 187, 360, 186, 191, 188, 192,
190, 194, 193, 361, 195, 198, 197, 363, 196, 200, 199, 203, 201,
205, 202, 206, 204, 209, 207, 211, 208, 362, 210, 214, 213, 356,
212, 217, 215, 218, 216, 221, 219, 222, 220, 224, 223, 358, 225,
229, 226, 367, 227, 231, 228, 232, 230, 235, 233, 237, 234, 238,
236, 366, 239, 277, 242, 247, 244, 255, 243, 249, 245, 250, 248,
254, 251, 278, 253, 258, 256, 260, 257, 263, 259, 264, 262, 266,
265, 269, 267, 273, 268, 274, 270, 310, 272, 370, 271, 276, 275,
309, 279, 282, 281, 308, 280, 285, 283, 286, 284, 289, 288, 292,
290, 294, 291, 295, 293, 297, 296, 300, 298, 301, 299, 305, 303,
314, 307, 371, 306, 344, 312, 368, 313, 318, 316, 369, 315, 319,
317, 322, 320, 324, 323, 326, 325, 329, 327, 331, 328, 333, 330,
334, 332, 336, 335, 339, 337, 340, 338, 342, 341, 345, 343, 351,
347), c(0, 0, 2, 4, 6, 8, 10, 12, 14, 16, 18, 18, 20, 20, 22,
24, 26, 28, 30, 32, 34, 34, 34, 38, 40, 42, 44, 46, 46, 48, 50,
52, 54, 56, 58, 60, 62, 64, 66, 68, 70, 72, 74, 76, 78, 80, 82,
84, 88, 90, 92, 94, 96, 98, 102, 104, 106, 108, 110, 112, 114,
118, 118, 122, 124, 126, 128, 130, 130, 132, 134, 136, 138, 140,
142, 144, 146, 148, 150, 154, 156, 158, 162, 164, 164, 166, 168,
170, 172, 172, 174, 176, 178, 180, 182, 184, 186, 186, 188, 190,
192, 194, 196, 198, 198, 200, 202, 204, 206, 208, 210, 214, 214,
218, 220, 224, 226, 228, 230, 234, 236, 238, 240, 242, 244, 246,
250, 252, 252, 254, 256, 260, 262, 264, 266, 268, 270, 272, 276,
278, 280, 284, 286, 288, 290, 292, 294, 298, 298, 300, 302, 304,
306, 308, 310, 312, 314, 316, 318, 322, 326, 332, 336, 340, 346,
352, 358, 364, 368, 372), c(0, 4, 6, 10, 12, 14, 16, 18, 20,
22, 28, 34, 38, 44, 46, 50, 52, 54, 56, 58, 62, 66, 70, 70, 74,
76, 78, 80, 84, 86, 92, 96, 98, 100, 102, 106, 108, 110, 112,
116, 118, 120, 120, 122, 124, 126, 128, 130, 130, 132, 134, 136,
138, 140, 144, 146, 148, 150, 152, 154, 156, 156, 160, 160, 160,
162, 162, 162, 168, 174, 176, 178, 180, 184, 186, 188, 190, 192,
194, 198, 200, 204, 206, 208, 212, 214, 216, 218, 220, 224, 226,
228, 230, 232, 234, 236, 238, 242, 244, 246, 248, 250, 252, 254,
258, 260, 262, 264, 266, 268, 270, 272, 276, 278, 280, 282, 284,
286, 288, 290, 292, 294, 296, 298, 304, 306, 306, 308, 312, 314,
316, 318, 320, 322, 324, 326, 328, 330, 330, 332, 336, 336, 336,
340, 344, 346, 348, 348, 350, 352, 354, 356, 358, 360, 362, 364,
366, 368, 370, 370, 372, 372, 372, 372, 372, 372, 372, 372, 372,
372), list(c(1, 0, 1), structure(list(), .Names = character(0)),
structure(list(name = c("1", "2", "3", "4", "5", "6", "7",
"8", "9", "10", "11", "12", "13", "14", "15", "16", "17",
"18", "19", "20", "21", "22", "23", "24", "25", "26", "27",
"28", "29", "30", "31", "32", "33", "34", "35", "36", "37",
"38", "39", "40", "41", "42", "43", "44", "45", "46", "47",
"48", "49", "50", "51", "52", "53", "54", "55", "56", "57",
"58", "59", "60", "61", "62", "63", "64", "65", "66", "67",
"68", "69", "70", "71", "72", "73", "74", "75", "76", "77",
"78", "79", "80", "81", "82", "83", "84", "85", "86", "87",
"88", "89", "90", "91", "92", "93", "94", "95", "96", "97",
"98", "99", "100", "101", "102", "103", "104", "105", "106",
"107", "108", "109", "110", "111", "112", "113", "114", "115",
"116", "117", "118", "119", "120", "121", "122", "123", "124",
"125", "126", "127", "128", "129", "130", "131", "132", "133",
"134", "135", "136", "137", "138", "139", "140", "141", "142",
"143", "144", "145", "146", "147", "148", "149", "150", "151",
"152", "153", "154", "155", "156", "157", "158", "159", "160",
"161", "162", "163", "164", "165", "166", "167", "168", "169"
)), .Names = "name"), structure(list(DIST_KM_CNT = c(4.89,
1.45, 2.36, 1.45, 2.36, 1.18, 0, 1.18, 0.89, 1.47, 0.89,
1.47, 1.16, 1.16, 1.2, 1.2, 1.02, 0.79, 1.02, 0, 0, 1, 0.79,
0, 0.98, 1.03, 1.15, 0, 1.03, 1.35, 0.95, 0, 0.99, 1.15,
0.99, 1.53, 0, 1.22, 1.53, 1.37, 1.22, 1.37, 1.23, 1.23,
1.1, 0, 1.1, 1.38, 1.69, 3.49, 3.16, 1.38, 4.89, 1.38, 3.49,
1.51, 0, 1.51, 1.39, 1.39, 1.78, 0.947, 1.78, 1.17, 2.12,
3.26, 1.17, 3.26, 1.43, 0, 0, 15.58, 1.11, 0.98, 1.09, 1.11,
1.09, 1.43, 1.43, 1.15, 1.11, 0, 1.15, 1.13, 1.11, 1.96,
1.13, 1.96, 1.86, 2.48, 1.86, 0, 1.44, 2.48, 1.44, 2.38,
2.38, 3.16, 2.41, 1.691, 2.41, 1.691, 1.54, 1.54, 1.65, 4.14,
1.65, 1.43, 4.14, 0.572, 0, 0.572, 0.455, 0.558, 0.455, 0.54,
0.558, 0.54, 0.682, 0.638, 0.682, 0.42, 0, 0.624, 0.42, 0.47,
0.624, 0.895, 0.47, 0.895, 0.493, 0.493, 0.703, 0.703, 0.553,
0.638, 0.553, 4.52, 1.94, 1.69, 1.38, 4.52, 0.947, 2.647,
2.647, 1.35, 0, 1.66, 0, 0, 1.05, 0, 1.66, 1.31, 1.05, 1.54,
1.31, 1.54, 1.72, 1.72, 1.24, 0, 1.24, 0.94, 1.57, 0.94,
1.15, 1.57, 1.15, 0.77, 0.95, 0.77, 0.95, 0, 0, 1.38, 0.6,
1.38, 11.42, 0.6, 0.72, 2.64, 0.72, 0, 2.64, 0, 0.82, 0.708,
0.467, 0.708, 0.59, 0.467, 0.59, 0.828, 0.828, 1.047, 0.77,
0.517, 0.517, 0.897, 0.897, 0.727, 0.602, 0.727, 0.481, 0.602,
0.481, 0.726, 0.602, 0.726, 0.92, 0.602, 0.986, 0.44, 0.44,
0.513, 0.548, 0.513, 0.548, 0.721, 0.513, 0.721, 0.513, 0.564,
0.564, 0.937, 0.412, 0.576, 0.542, 0.412, 0.567, 0.542, 0.567,
0.497, 0.426, 0.497, 0.379, 0.426, 0.379, 0.987, 0, 0, 0.614,
1.321, 1.327, 0.912, 0, 1.327, 1.735, 0.912, 1.735, 1.577,
0, 1.188, 1.577, 1.321, 1.017, 1.057, 1.017, 1.239, 1.057,
0, 0.732, 1.239, 0.732, 0.877, 0.877, 1.548, 0.816, 1.548,
0.806, 0, 11.5, 0.816, 0.806, 0.689, 0.689, 0.614, 1.188,
1.357, 2.496, 1.028, 1.028, 1.432, 0.93, 1.432, 0.93, 0,
0.794, 0.794, 0.811, 1.395, 0.811, 1.323, 1.395, 1.323, 1.385,
1.385, 0.774, 1.53, 0.774, 1.53, 0, 0.841, 0, 0.841, 1.317,
7.75, 2.496, 1.357, 11.5, 15.58, 0.75, 0.905, 7.75, 1.317,
0.89, 0.593, 0.89, 0.593, 0.555, 11.42, 0.555, 1.18, 1.18,
0.87, 0.87, 2.63, 1.21, 2.63, 1.6, 1.21, 1.26, 1.6, 1.26,
1.09, 1.09, 1.12, 1.58, 1.12, 1.58, 1.42, 1.42, 0.54, 0.75,
0.54, 1, 1.03, 0, 0.95, 0, 1.03, 0, 2.12, 1.94, 0, 0.986,
0, 0.937, 0, 0.82, 1.047, 0.92, 0.77, 0, 0, 0.987, 0.576,
0.905, 1.317, 0, 1.317)), .Names = "DIST_KM_CNT")), <environment>), class = "igraph")

K最短路径逻辑

# find k shortest paths
k.shortest.paths <- function(graph, from, to, k){
# first shortest path
k0 <- get.shortest.paths(graph,from,to, output='both')

# number of currently found shortest paths
kk <- 1

# list of alternatives
variants <- list()

# shortest variants
shortest.variants <- list(list(g=graph, path=k0$epath, vert=k0$vpath, dist=shortest.paths(graph,from,to)))

# until k shortest paths are found
while(kk<k){
# take last found shortest path
last.variant <- shortest.variants[[length(shortest.variants)]]

# calculate all alternatives
variants <- calculate.variants(variants, last.variant, from, to)

# find shortest alternative
sp <- select.shortest.path(variants)

# add to list, increase kk, remove shortest path from list of alternatives
shortest.variants[[length(shortest.variants)+1]] <- list(g=variants[[sp]]$g, path=variants[[sp]]$variants$path, vert=variants[[sp]]$variants$vert, dist=variants[[sp]]$variants$dist)
kk <- kk+1
variants <- variants[-sp]
}

return(shortest.variants)
}

# found all alternative routes
calculate.variants <- function(variants, variant, from, to){
# take graph from current path
g <- variant$g

# iterate through edges, removing one each iterations
for (j in unlist(variant$path)){
newgraph <- delete.edges(g, j) # remove adge
sp <- get.shortest.paths(newgraph,from,to, output='both') # calculate shortest path
spd <- shortest.paths(newgraph,from,to) # calculate length
if (spd != Inf){ # the the path is found
if (!contains.path(variants, sp$vpath)) # add to list, unless it already contains the same path
{
variants[[length(variants)+1]] <- list(g=newgraph, variants=list(path=sp$epath, vert=sp$vpath, dist=spd))
}
}
}

return(variants)
}

# does a list contain this path?
contains.path <- function(variants, variant){
return( any( unlist( lapply( variants, function(x){ identical(x$variant$vert,variant) } ) ) ) )
}

# which path from the list is the shortest?
select.shortest.path <- function(variants){
return( which.min( unlist( lapply( variants, function(x){x$variants$dist} ) ) ) )
}

下面的结果是相同的路径,并且计算的距离也不正确。我不确定我在哪里犯了错误

library(igraph)
k.shortest.paths(my.graph, from = 37, to = 8, k = 2)

[[1]]
[[1]]$g
IGRAPH UN-- 169 372 --
+ attr: name (v/c), DIST_KM_CNT (e/n)
+ edges (vertex names):
[1] 1 --23 1 --2 2 --3 1 --2 2 --3 3 --4 3 --115 3 --4 4 --5
[10] 5 --6 4 --5 5 --6 6 --7 6 --7 7 --8 7 --8 8 --9 9 --10
[19] 8 --9 10--111 10--79 10--160 9 --10 11--160 11--31 11--12 12--14
[28] 12--161 11--12 13--67 13--161 13--139 14--15 12--14 14--15 15--16
[37] 15--82 16--17 15--16 17--18 16--17 17--18 18--19 18--19 19--20
[46] 20--131 19--20 20--63 21--63 21--24 22--43 22--23 1 --23 22--23
[55] 21--24 24--25 24--162 24--25 25--26 25--26 26--27 27--65 26--27
[64] 28--29 28--162 29--30 28--29 29--30 30--48 30--49 30--54 31--143
+ ... omitted several edges

[[1]]$path
[[1]]$path[[1]]
+ 11/372 edges (vertex names):
[1] 36--37 35--36 34--35 33--34 32--33 31--32 11--31 11--160 10--160
[10] 9 --10 8 --9


[[1]]$vert
[[1]]$vert[[1]]
+ 12/169 vertices, named:
[1] 37 36 35 34 33 32 31 11 160 10 9 8


[[1]]$dist
8
37 11


[[2]]
[[2]]$g
IGRAPH UN-- 169 371 --
+ attr: name (v/c), DIST_KM_CNT (e/n)
+ edges (vertex names):
[1] 1 --23 1 --2 2 --3 1 --2 2 --3 3 --4 3 --115 3 --4 4 --5
[10] 5 --6 4 --5 5 --6 6 --7 6 --7 7 --8 7 --8 8 --9 9 --10
[19] 8 --9 10--111 10--79 10--160 9 --10 11--160 11--31 11--12 12--14
[28] 12--161 11--12 13--67 13--161 13--139 14--15 12--14 14--15 15--16
[37] 15--82 16--17 15--16 17--18 16--17 17--18 18--19 18--19 19--20
[46] 20--131 19--20 20--63 21--63 21--24 22--43 22--23 1 --23 22--23
[55] 21--24 24--25 24--162 24--25 25--26 25--26 26--27 27--65 26--27
[64] 28--29 28--162 29--30 28--29 29--30 30--48 30--49 30--54 31--143
+ ... omitted several edges

[[2]]$path
[[2]]$path[[1]]
+ 11/371 edges (vertex names):
[1] 36--37 35--36 34--35 33--34 32--33 31--32 11--31 11--160 10--160
[10] 9 --10 8 --9


[[2]]$vert
[[2]]$vert[[1]]
+ 12/169 vertices, named:
[1] 37 36 35 34 33 32 31 11 160 10 9 8


[[2]]$dist
8
37 11

最佳答案

我知道这已经晚了 2 年,但希望这对需要在 R 中实现 yen 算法的其他人有用。

library(igraph)
library(tidyverse)

#'@return the shortest path as a list of vertices or NULL if there is no path between src and dest
shortest_path <- function(graph, src, dest){
path <- suppressWarnings(get.shortest.paths(graph, src, dest))
path <- names(path$vpath[[1]])
if (length(path)==1) NULL else path
}

#'@return the sum of the weights of all the edges in the given path
path_weight <- function(path, graph) sum(E(graph, path=path)$weight)

#'@description sorts a list of paths based on the weight of the path
sort_paths <- function(graph, paths) paths[paths %>% sapply(path_weight, graph) %>% order]

#'@description creates a list of edges that should be deleted
find_edges_to_delete <- function(A,i,rootPath){
edgesToDelete <- NULL
for (p in A){
rootPath_p <- p[1:i]
if (all(rootPath_p == rootPath)){
edge <- paste(p[i], ifelse(is.na(p[i+1]),p[i],p[i+1]), sep = '|')
edgesToDelete[length(edgesToDelete)+1] <- edge
}
}
unique(edgesToDelete)
}

#returns the k shortest path from src to dest
#sometimes it will return less than k shortest paths. This occurs when the max possible number of paths are less than k
k_shortest_yen <- function(graph, src, dest, k){
if (src == dest) stop('src and dest can not be the same (currently)')

#accepted paths
A <- list(shortest_path(graph, src, dest))
if (k == 1) return (A)
#potential paths
B <- list()

for (k_i in 2:k){
prev_path <- A[[k_i-1]]
num_nodes_to_loop <- length(prev_path)-1
for(i in 1:num_nodes_to_loop){
spurNode <- prev_path[i]
rootPath <- prev_path[1:i]

edgesToDelete <- find_edges_to_delete(A, i,rootPath)
t_g <- delete.edges(graph, edgesToDelete)
#for (edge in edgesToDelete) t_g <- delete.edges(t_g, edge)

spurPath <- shortest_path(t_g,spurNode, dest)

if (!is.null(spurPath)){
total_path <- list(c(rootPath[-i], spurPath))
if (!total_path %in% B) B[length(B)+1] <- total_path
}
}
if (length(B) == 0) break
B <- sort_paths(graph, B)
A[k_i] <- B[1]
B <- B[-1]
}
A
}

#===================Test==========================#
edgeList <- tibble(from=character(), to=character(), weight = numeric())

edgeList[nrow(edgeList)+1,] <-list('c','d',3)
edgeList[nrow(edgeList)+1,] <-list('d','f',4)
edgeList[nrow(edgeList)+1,] <-list('f','h',1)
edgeList[nrow(edgeList)+1,] <-list('c','e',2)
edgeList[nrow(edgeList)+1,] <-list('e','d',1)
edgeList[nrow(edgeList)+1,] <-list('e','f',2)
edgeList[nrow(edgeList)+1,] <-list('e','g',3)
edgeList[nrow(edgeList)+1,] <-list('g','h',2)
edgeList[nrow(edgeList)+1,] <-list('f','g',2)

graph <- graph.data.frame(edgeList)

#k_shortest.yen(graph, 'c','c',7) #expect error
#expect all 7 paths
k_shortest_yen(graph,'c','h',7)

关于r - R : igraph 中的 K 最短路径,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/32003087/

25 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com