简体   繁体   English

R:igraph中的K最短路径

[英]K Shortest Path in R: igraph

I have to find the K Shortest Path,However the below code i tried gives the same path when i choose different K Values and the distance computed is not correct. 我必须找到K最短路径,但是当我选择不同的K值并且计算的距离不正确时,我尝试的下面的代码给出了相同的路径。

My dataset is my.graph with class igraph 我的数据集是带有类igraph my.graph

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 Shortest Path logic 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} ) ) ) )
}

The results are below with Same Path and and the distance computed is also not correct.I am not sure about where i am making the mistake 结果在下面与相同路径和计算的距离也不正确。我不知道我在哪里犯了错误

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

I know this is like 2 years late but hopefully this will be useful for other people who needs an implementation of yen's algorithm in R. 我知道这已经晚了两年,但希望这对其他需要在R中实现日元算法的人有用。

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)

I had the same problem and then i noticed that there are a error in the code. 我有同样的问题然后我注意到代码中有错误。 The function identical in function contains.path were not returning the correct value. 功能相同的函数contains.path没有返回正确的值。 I simply changed the code of identical(x$variant$vert,variant) to identical(unlist(x$variant$vert),unlist(variant)). 我只是将相同的代码(x $ variant $ vert,variant)更改为相同的(unlist(x $ variant $ vert),unlist(variant))。 And now the code is reporting all routings and no duplicates are present. 现在,代码报告所有路由,并且不存在重复项。

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM