R中的最短路径:igraph

时间:2015-08-14 05:48:20

标签: r igraph shortest-path

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

我的数据集为my.graph,内容为igraph

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 个答案:

答案 0 :(得分:2)

我知道这要晚2年了,但是希望这对需要在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)

答案 1 :(得分:0)

我有同样的问题然后我注意到代码中有错误。功能相同的函数contains.path没有返回正确的值。我只是将相同的代码(x $ variant $ vert,variant)更改为相同的(unlist(x $ variant $ vert),unlist(variant))。现在,代码报告了所有路由,并且没有重复项。

相关问题