1
|
12919 Views
|
5 Replies
|
9 Total Likes
View groups...
Share
Share this post:
GROUPS:

# Minimum spanning tree from weighted adjacency graph

Posted 11 years ago
 NOTE: this is a cross-post from: http://mathematica.stackexchange.com/questions/33857 where some relevant code can be found that is referred to in the answers below. ~ Moderation Team I have a big graph (40x40) and i want to create a minimum spanning tree. This is the code for the graph g = WeightedAdjacencyGraph[{{\[Infinity], \[Infinity], \[Infinity], 427, 668, 495, 377, 678, \[Infinity], 177, \[Infinity], \[Infinity], 870, \[Infinity], 869, 624, 300, 609, 131, \[Infinity], 251, \[Infinity], \[Infinity], \[Infinity], 856, 221, 514, \[Infinity], 591, 762, 182, 56, \[Infinity], 884, 412, 273, 636, \[Infinity], \[Infinity], 774}, {\[Infinity], \[Infinity], 262, \[Infinity], \[Infinity], 508, 472, 799, \[Infinity], 956, 578, 363, 940, 143, \[Infinity], 162, 122, 910, \[Infinity], 729, 802, 941, 922, 573, 531, 539, 667, 607, \[Infinity], 920, \[Infinity], \[Infinity], 315, 649, 937, \[Infinity], 185, 102, 636, 289}, {\[Infinity], 262, \[Infinity], \[Infinity], 926, \[Infinity], 958, 158, 647, 47, 621, 264, 81, \[Infinity], 402, 813, 649, 386, 252, 391, 264, 637, 349, \[Infinity], \[Infinity], \[Infinity], 108, \[Infinity], 727, 225, 578, 699, \[Infinity], 898, 294, \[Infinity], 575, 168, 432, 833}, {427, \[Infinity], \[Infinity], \[Infinity], 366, \[Infinity], \[Infinity], 635, \[Infinity], 32, 962, 468, 893, 854, 718, 427, 448, 916, 258, \[Infinity], 760, 909, 529, 311, 404, \[Infinity], \[Infinity], 588, 680, 875, \[Infinity], 615, \[Infinity], 409, 758, 221, \[Infinity], \[Infinity], 76, 257}, {668, \[Infinity], 926, 366, \[Infinity], \[Infinity], \[Infinity], 250, 268, \[Infinity], 503, 944, \[Infinity], 677, \[Infinity], 727, 793, 457, 981, 191, \[Infinity], \[Infinity], \[Infinity], 351, 969, 925, 987, 328, 282, 589, \[Infinity], 873, 477, \[Infinity], \[Infinity], 19, 450, \[Infinity], \[Infinity], \[Infinity]}, {495, 508, \[Infinity], \[Infinity], \[Infinity], \[Infinity], \ \[Infinity], 765, 711, 819, 305, 302, 926, \[Infinity], \[Infinity], 582, \[Infinity], 861, \[Infinity], 683, 293, \[Infinity], \[Infinity], 66, \[Infinity], 27, \[Infinity], \[Infinity], 290, \[Infinity], 786, \[Infinity], 554, 817, 33, \[Infinity], 54, 506, 386, 381}, {377, 472, 958, \[Infinity], \[Infinity], \[Infinity], \[Infinity], \ \[Infinity], \[Infinity], 120, 42, \[Infinity], 134, 219, 457, 639, 538, 374, \[Infinity], \[Infinity], \[Infinity], 966, \[Infinity], \[Infinity], \[Infinity], \[Infinity], \ \[Infinity], 449, 120, 797, 358, 232, 550, \[Infinity], 305, 997, 662, 744, 686, 239}, {678, 799, 158, 635, 250, 765, \[Infinity], \[Infinity], \[Infinity], 35, \[Infinity], 106, 385, 652, 160, \[Infinity], 890, 812, 605, 953, \[Infinity], \[Infinity], \[Infinity], 79, \[Infinity], 712, 613, 312, 452, \[Infinity], 978, 900, \[Infinity], 901, \[Infinity], \[Infinity], 225, 533, 770, 722}, {\[Infinity], \[Infinity], 647, \[Infinity], 268, 711, \[Infinity], \[Infinity], \[Infinity], 283, \[Infinity], 172, \[Infinity], 663, 236, 36, 403, 286, 986, \[Infinity], \[Infinity], 810, 761, 574, 53, 793, \[Infinity], \[Infinity], 777, 330, 936, 883, 286, \[Infinity], 174, \[Infinity], \[Infinity], \[Infinity], 828, 711}, {177, 956, 47, 32, \[Infinity], 819, 120, 35, 283, \[Infinity], 50, \[Infinity], 565, 36, 767, 684, 344, 489, 565, \[Infinity], \[Infinity], 103, 810, 463, 733, 665, 494, 644, 863, 25, 385, \[Infinity], 342, 470, \[Infinity], \[Infinity], \[Infinity], 730, 582, 468}, {\[Infinity], 578, 621, 962, 503, 305, 42, \[Infinity], \[Infinity], 50, \[Infinity], 155, 519, \[Infinity], \[Infinity], 256, 990, 801, 154, 53, 474, 650, 402, \[Infinity], \[Infinity], \[Infinity], 966, \[Infinity], \[Infinity], 406, 989, 772, 932, 7, \[Infinity], 823, 391, \[Infinity], \[Infinity], 933}, {\[Infinity], 363, 264, 468, 944, 302, \[Infinity], 106, 172, \[Infinity], 155, \[Infinity], \[Infinity], \[Infinity], 380, 438, \[Infinity], 41, 266, \[Infinity], \[Infinity], 104, 867, 609, \[Infinity], 270, 861, \[Infinity], \[Infinity], 165, \[Infinity], 675, 250, 686, 995, 366, 191, \[Infinity], 433, \[Infinity]}, {870, 940, 81, 893, \[Infinity], 926, 134, 385, \[Infinity], 565, 519, \[Infinity], \[Infinity], 313, 851, \[Infinity], \[Infinity], \[Infinity], 248, 220, \[Infinity], 826, 359, 829, \[Infinity], 234, 198, 145, 409, 68, 359, \[Infinity], 814, 218, 186, \[Infinity], \[Infinity], 929, 203, \[Infinity]}, {\[Infinity], 143, \[Infinity], 854, 677, \[Infinity], 219, 652, 663, 36, \[Infinity], \[Infinity], 313, \[Infinity], 132, \[Infinity], 433, 598, \[Infinity], \[Infinity], 168, 870, \[Infinity], \[Infinity], \[Infinity], 128, 437, \[Infinity], 383, 364, 966, 227, \[Infinity], \[Infinity], 807, 993, \[Infinity], \[Infinity], 526, 17}, {869, \[Infinity], 402, 718, \[Infinity], \[Infinity], 457, 160, 236, 767, \[Infinity], 380, 851, 132, \[Infinity], \[Infinity], 596, 903, 613, 730, \[Infinity], 261, \[Infinity], 142, 379, 885, 89, \[Infinity], 848, 258, 112, \[Infinity], 900, \[Infinity], \[Infinity], 818, 639, 268, 600, \[Infinity]}, {624, 162, 813, 427, 727, 582, 639, \[Infinity], 36, 684, 256, 438, \[Infinity], \[Infinity], \[Infinity], \[Infinity], 539, 379, 664, 561, 542, \[Infinity], 999, 585, \[Infinity], \[Infinity], 321, 398, \[Infinity], \[Infinity], 950, 68, 193, \[Infinity], 697, \[Infinity], 390, 588, 848, \[Infinity]}, {300, 122, 649, 448, 793, \[Infinity], 538, 890, 403, 344, 990, \[Infinity], \[Infinity], 433, 596, 539, \[Infinity], \[Infinity], 73, \[Infinity], 318, \[Infinity], \[Infinity], 500, \[Infinity], 968, \[Infinity], 291, \[Infinity], \[Infinity], 765, 196, 504, 757, \[Infinity], 542, \[Infinity], 395, 227, 148}, {609, 910, 386, 916, 457, 861, 374, 812, 286, 489, 801, 41, \[Infinity], 598, 903, 379, \[Infinity], \[Infinity], \[Infinity], 946, 136, 399, \[Infinity], 941, 707, 156, 757, 258, 251, \[Infinity], 807, \[Infinity], \[Infinity], \[Infinity], 461, 501, \[Infinity], \[Infinity], 616, \[Infinity]}, {131, \[Infinity], 252, 258, 981, \[Infinity], \[Infinity], 605, 986, 565, 154, 266, 248, \[Infinity], 613, 664, 73, \[Infinity], \[Infinity], 686, \[Infinity], \[Infinity], 575, 627, 817, 282, \[Infinity], 698, 398, 222, \[Infinity], 649, \[Infinity], \[Infinity], \[Infinity], \[Infinity], \ \[Infinity], 654, \[Infinity], \[Infinity]}, {\[Infinity], 729, 391, \[Infinity], 191, 683, \[Infinity], 953, \[Infinity], \[Infinity], 53, \[Infinity], 220, \[Infinity], 730, 561, \[Infinity], 946, 686, \[Infinity], \[Infinity], 389, 729, 553, 304, 703, 455, 857, 260, \[Infinity], 991, 182, 351, 477, 867, \[Infinity], \[Infinity], 889, 217, 853}, {251, 802, 264, 760, \[Infinity], 293, \[Infinity], \[Infinity], \[Infinity], \[Infinity], 474, \[Infinity], \[Infinity], 168, \[Infinity], 542, 318, 136, \[Infinity], \[Infinity], \[Infinity], \[Infinity], 392, \[Infinity], \[Infinity], \[Infinity], 267, 407, 27, 651, 80, 927, \[Infinity], 974, 977, \[Infinity], \[Infinity], 457, 117, \[Infinity]}, {\[Infinity], 941, 637, 909, \[Infinity], \[Infinity], 966, \[Infinity], 810, 103, 650, 104, 826, 870, 261, \[Infinity], \[Infinity], 399, \[Infinity], 389, \[Infinity], \[Infinity], \[Infinity], 202, \[Infinity], \[Infinity], \[Infinity], \[Infinity], 867, 140, 403, 962, 785, \[Infinity], 511, \[Infinity], 1, \[Infinity], 707, \[Infinity]}, {\[Infinity], 922, 349, 529, \[Infinity], \[Infinity], \[Infinity], \[Infinity], 761, 810, 402, 867, 359, \[Infinity], \[Infinity], 999, \[Infinity], \[Infinity], 575, 729, 392, \[Infinity], \[Infinity], 388, 939, \[Infinity], 959, \[Infinity], 83, 463, 361, \[Infinity], \[Infinity], 512, 931, \[Infinity], 224, 690, 369, \[Infinity]}, {\[Infinity], 573, \[Infinity], 311, 351, 66, \[Infinity], 79, 574, 463, \[Infinity], 609, 829, \[Infinity], 142, 585, 500, 941, 627, 553, \[Infinity], 202, 388, \[Infinity], 164, 829, \[Infinity], 620, 523, 639, 936, \[Infinity], \[Infinity], 490, \[Infinity], 695, \[Infinity], 505, 109, \[Infinity]}, {856, 531, \[Infinity], 404, 969, \[Infinity], \[Infinity], \[Infinity], 53, 733, \[Infinity], \[Infinity], \[Infinity], \[Infinity], 379, \[Infinity], \[Infinity], 707, 817, 304, \[Infinity], \[Infinity], 939, 164, \[Infinity], \[Infinity], 616, 716, 728, \[Infinity], 889, 349, \[Infinity], 963, 150, 447, \[Infinity], 292, 586, 264}, {221, 539, \[Infinity], \[Infinity], 925, 27, \[Infinity], 712, 793, 665, \[Infinity], 270, 234, 128, 885, \[Infinity], 968, 156, 282, 703, \[Infinity], \[Infinity], \[Infinity], 829, \[Infinity], \[Infinity], \[Infinity], 822, \[Infinity], \[Infinity], \[Infinity], 736, 576, \[Infinity], 697, 946, 443, \[Infinity], 205, 194}, {514, 667, 108, \[Infinity], 987, \[Infinity], \[Infinity], 613, \[Infinity], 494, 966, 861, 198, 437, 89, 321, \[Infinity], 757, \[Infinity], 455, 267, \[Infinity], 959, \[Infinity], 616, \[Infinity], \[Infinity], \[Infinity], 349, 156, 339, \[Infinity], 102, 790, 359, \[Infinity], 439, 938, 809, 260}, {\[Infinity], 607, \[Infinity], 588, 328, \[Infinity], 449, 312, \[Infinity], 644, \[Infinity], \[Infinity], 145, \[Infinity], \[Infinity], 398, 291, 258, 698, 857, 407, \[Infinity], \[Infinity], 620, 716, 822, \[Infinity], \[Infinity], 293, 486, 943, \[Infinity], 779, \[Infinity], 6, 880, 116, 775, \[Infinity], 947}, {591, \[Infinity], 727, 680, 282, 290, 120, 452, 777, 863, \[Infinity], \[Infinity], 409, 383, 848, \[Infinity], \[Infinity], 251, 398, 260, 27, 867, 83, 523, 728, \[Infinity], 349, 293, \[Infinity], 212, 684, 505, 341, 384, 9, 992, 507, 48, \[Infinity], \[Infinity]}, {762, 920, 225, 875, 589, \[Infinity], 797, \[Infinity], 330, 25, 406, 165, 68, 364, 258, \[Infinity], \[Infinity], \[Infinity], 222, \[Infinity], 651, 140, 463, 639, \[Infinity], \[Infinity], 156, 486, 212, \[Infinity], \[Infinity], 349, 723, \[Infinity], \[Infinity], 186, \[Infinity], 36, 240, 752}, {182, \[Infinity], 578, \[Infinity], \[Infinity], 786, 358, 978, 936, 385, 989, \[Infinity], 359, 966, 112, 950, 765, 807, \[Infinity], 991, 80, 403, 361, 936, 889, \[Infinity], 339, 943, 684, \[Infinity], \[Infinity], 965, 302, 676, 725, \[Infinity], 327, 134, \[Infinity], 147}, {56, \[Infinity], 699, 615, 873, \[Infinity], 232, 900, 883, \[Infinity], 772, 675, \[Infinity], 227, \[Infinity], 68, 196, \[Infinity], 649, 182, 927, 962, \[Infinity], \[Infinity], 349, 736, \[Infinity], \[Infinity], 505, 349, 965, \[Infinity], 474, 178, 833, \[Infinity], \[Infinity], 555, 853, \[Infinity]}, {\[Infinity], 315, \[Infinity], \[Infinity], 477, 554, 550, \[Infinity], 286, 342, 932, 250, 814, \[Infinity], 900, 193, 504, \[Infinity], \[Infinity], 351, \[Infinity], 785, \[Infinity], \[Infinity], \[Infinity], 576, 102, 779, 341, 723, 302, 474, \[Infinity], 689, \[Infinity], \[Infinity], \[Infinity], 451, \[Infinity], \[Infinity]}, {884, 649, 898, 409, \[Infinity], 817, \[Infinity], 901, \[Infinity], 470, 7, 686, 218, \[Infinity], \[Infinity], \[Infinity], 757, \[Infinity], \[Infinity], 477, 974, \[Infinity], 512, 490, 963, \[Infinity], 790, \[Infinity], 384, \[Infinity], 676, 178, 689, \[Infinity], 245, 596, 445, \[Infinity], \[Infinity], 343}, {412, 937, 294, 758, \[Infinity], 33, 305, \[Infinity], 174, \[Infinity], \[Infinity], 995, 186, 807, \[Infinity], 697, \[Infinity], 461, \[Infinity], 867, 977, 511, 931, \[Infinity], 150, 697, 359, 6, 9, \[Infinity], 725, 833, \[Infinity], 245, \[Infinity], 949, \[Infinity], 270, \[Infinity], 112}, {273, \[Infinity], \[Infinity], 221, 19, \[Infinity], 997, \[Infinity], \[Infinity], \[Infinity], 823, 366, \[Infinity], 993, 818, \[Infinity], 542, 501, \[Infinity], \[Infinity], \[Infinity], \[Infinity], \ \[Infinity], 695, 447, 946, \[Infinity], 880, 992, 186, \[Infinity], \[Infinity], \[Infinity], 596, 949, \[Infinity], 91, \[Infinity], 768, 273}, {636, 185, 575, \[Infinity], 450, 54, 662, 225, \[Infinity], \[Infinity], 391, 191, \[Infinity], \[Infinity], 639, 390, \[Infinity], \[Infinity], \[Infinity], \[Infinity], \ \[Infinity], 1, 224, \[Infinity], \[Infinity], 443, 439, 116, 507, \[Infinity], 327, \[Infinity], \[Infinity], 445, \[Infinity], 91, \[Infinity], 248, \[Infinity], 344}, {\[Infinity], 102, 168, \[Infinity], \[Infinity], 506, 744, 533, \[Infinity], 730, \[Infinity], \[Infinity], 929, \[Infinity], 268, 588, 395, \[Infinity], 654, 889, 457, \[Infinity], 690, 505, 292, \[Infinity], 938, 775, 48, 36, 134, 555, 451, \[Infinity], 270, \[Infinity], 248, \[Infinity], 371, 680}, {\[Infinity], 636, 432, 76, \[Infinity], 386, 686, 770, 828, 582, \[Infinity], 433, 203, 526, 600, 848, 227, 616, \[Infinity], 217, 117, 707, 369, 109, 586, 205, 809, \[Infinity], \[Infinity], 240, \[Infinity], 853, \[Infinity], \[Infinity], \[Infinity], 768, \[Infinity], 371, \[Infinity], 540}, {774, 289, 833, 257, \[Infinity], 381, 239, 722, 711, 468, 933, \[Infinity], \[Infinity], 17, \[Infinity], \[Infinity], 148, \[Infinity], \[Infinity], 853, \[Infinity], \[Infinity], \[Infinity], \[Infinity], 264, 194, 260, 947, \[Infinity], 752, 147, \[Infinity], \[Infinity], 343, 112, 273, 344, 680, 540, \[Infinity]}}, VertexLabels -> {1 -> "1", 2 -> "2", 3 -> "3", 4 -> "4", 5 -> "5", 6 -> "6", 7 -> "7", 8 -> "8", 9 -> "9", 10 -> "10", 11 -> "11", 12 -> "12", 13 -> "13", 14 -> "14", 15 -> "15", 16 -> "16", 17 -> "17", 18 -> "18", 19 -> "19", 20 -> "20", 21 -> "21", 22 -> "22", 23 -> "23", 24 -> "24", 25 -> "25", 26 -> "26", 27 -> "27", 28 -> "28", 29 -> "29", 30 -> "30", 31 -> "31", 32 -> "32", 33 -> "33", 34 -> "34", 35 -> "35", 36 -> "36", 37 -> "37", 38 -> "38", 39 -> "39", 40 -> "40"}, VertexStyle -> {RGBColor[1, 0.7, 0]}, VertexShapeFunction -> {"Square"}]I am trying MinimumSpanningTree[g}but of course its not working. I do load the Combinatorica package but  I found somewhere on the internet that the WeightedAdjacencyGraph is not compatible with Combinatorica and i will have to create the graph differently. Can anyone help me with this?
5 Replies
Sort By:
Posted 11 years ago
 Great answer, Mark, thanks for posting. I think something is a bit off with variables. You use line:mat=WeightedAdjacencyGraph[mat]but then use mat again inside:grp = WeightedAdjacencyGraph[mat, GraphLayout -> "RadialEmbedding", VertexSize -> 1, VertexLabels -> Placed["Name", Center]]which will not owrk. I think you meant to use g in the first line of code. Well anyway nice solution. Your reputation questions are off topic for this discussion. Would you mind posting them as a separate question?
Posted 11 years ago
 Thank you Vitaliy. I have corrected.  It should have beeng=WeightedAdjacencyGraph[mat]; Just a system graph object (not for visualization) to generate the adjacency matirx that Combinatorica is 'happy' to work with. grp was for visualization hence the options.The off topic questions: I was just curious and did not think it was worthy of question. I love Mathematica and have been learning a lot from MSE. Wolfram Community seems also a wonderful resource and I assume there will be a large intersection.  I thought this would be a matter of discussion of high level, expert users/moderators.  I appreciate there may also be sensitivities that ,may be incorrectly interpreted as an "upstart" question. It was just curiosity.
Posted 11 years ago
 EDITThere was an error in my code pointed out by Vitality (self referential), I have corrected.I post this merely to show that the Combinatorica function can be used but it is tricky to negotiate contexts. The post by Vitaliy Kaurov is beautiful and revelatory and the code by Daniel Lichtblau may be preferred to stay in system. mat is the weight matrix for the graph.g=WeightedAdjacencyGraph[mat]adj = AdjacencyMatrix[g] // Normal;Needs["Combinatorica"];comgo = FromAdjacencyMatrix[adj];minspant = MinimumSpanningTree[comgo];sysgo = UndirectedEdge @@@ Flatten[minspant[[1]], 1];The above just puts graph object in Combinatorica form and the returns to graph object recognized by system. The following (not as beautiful) is just to illustrate:grp = WeightedAdjacencyGraph[mat, GraphLayout -> "RadialEmbedding", VertexSize -> 1, VertexLabels -> Placed["Name", Center]]HighlightGraph[grp, sysgo, GraphHighlightStyle -> "Thick"]As there are compatibility issues, if you just want to plot the system graph after having called the Combinatorica package you can useSystemGraph[sysgo, GraphLayout -> "RadialEmbedding", VertexSize -> 1, VertexLabels -> Placed["Name", Center], ImagePadding -> 20]Post script (off topic):1. Does or will MSE reputation transfer to Wolfram Community (and vice versa)?2. Will votes for common posts transfer for users using both (assuming they can be identified as same or linked)?
Posted 11 years ago
 Very nice. I see stuff like this and wonder why I'm even allowed to use graphics.
Posted 11 years ago
 I have little to add to the answers from the cross-post mentioned above. My only concern is the presentation. If we are looking for a "minimum spanning tree" I would prefer to layout the final graph in a tree like structure highlighting it in the original graph - and the original graph to have edges highlighted according to weight - so we have a complete visual information. Build the graph - I assume your original data are given by matrix:mat = (* YOUR MATRIX *);g = WeightedAdjacencyGraph[mat,    VertexLabels -> Placed["Name", Center], VertexSize -> Scaled[.03],    VertexStyle -> Directive[Orange, Opacity[.2]]];Now get the edge weights:gEdWe = AbsoluteOptions[g, EdgeWeight][[All, 2]][[1]];Rebuild graph so its edges are styled accordingly to their weights:g = SetProperty[g, EdgeStyle -> Thread[Rule[EdgeList[g],       Directive[Opacity[#], Thickness[#/1000]] & /@ Rescale[gEdWe]]]];The graph is very messy, so the only improvement I can suggest before we find minimum spanning tree is community layout:CommunityGraphPlot[g, CommunityRegionStyle -> {Hue[0, .1], Hue[.5, .1]}, CommunityBoundaryStyle -> Directive[Red, Dashed, Thick]]I will use now Dannys Kruskal algorithm from the mentioned cross-post: Kruskal[gr_Graph] :=   Module[{adjmat = Normal[WeightedAdjacencyMatrix[g]], n, vpairs,     jj = 0, hh, pair, dist, c1, c2, c1c2},    adjmat = adjmat /. 0 -> Infinity;   n = Length[adjmat];   Do[hh[k] = {k}, {k, n}];   vpairs =     Sort[Flatten[      Table[{adjmat[[k, l]], {k, l}}, {k, 1, n - 1}, {l, k + 1, n}],      1]];  First[Last[Reap[While[jj < Length[vpairs], jj++;      {dist, pair} = vpairs[[jj]];      {c1, c2} = {hh[pair[[1]]], hh[pair[[2]]]};      If[c1 =!= c2, Sow[Apply[Rule, vpairs[[jj, 2]]]];       c1c2 = Union[c1, c2];       Do[hh[c1c2[[k]]] = c1c2, {k, Length[c1c2]}];       If[Length[hh[pair[[1]]]] == n, Break[]];];]]]]]Now we will find a circular tree layout only for the spanning tree and highlight the structure in the original graph:KrEd = Kruskal[g];KrGr = Graph[KrEd, GraphLayout -> "RadialEmbedding"];HighlightGraph[ SetProperty[g,   VertexCoordinates ->    Sort[Thread[{VertexList[#], GraphEmbedding[#]}] &@KrGr][[All,      2]]], KrEd, GraphHighlightStyle -> "Thick", AspectRatio -> 1]
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments