5
$\begingroup$

Consider the graph:

kk={4612<->4613,4613<->4614,4642<->4612,4614<->4522,4798<->4642,4522<->4376,4536<->4798,4798<->4996,4376<->4201,4338<->4536,4813<->4996,4201<->4043,4074<->4338,4813<->4735,4043<->3813,3796<->4074,4646<->4735,3711<->3813,3665<->3796,4646<->4585,3711<->3450,3509<->3665,4584<->4585,3119<->3450,3177<->3509,4662<->4584,3119<->2911,2890<->3177,4729<->4662,2911<->2714,2642<->2890,4729<->4753,2551<->2714,2641<->2642,4875<->4753,2518<->2551,4972<->4875,2481<->2518,5081<->4972,2365<->2481,4967<->5081,2320<->2365,4938<->4967,2310<->2320,4937<->4938,2215<->2310,2310<->2317,4942<->4937,2053<->2215,2315<->2317,4923<->4942,1943<->2053,2315<->2316,4922<->4923,1942<->1943,2329<->2316,4880<->4922,2329<->2248,4721<->4880,2248<->2249,4673<->4721,4683<->4721,2249<->2246,4672<->4673,4508<->4683,2246<->2191,4831<->4672,4507<->4508,2191<->2093,4779<->4831,2093<->2052,4551<->4779,4717<->4779,2052<->2000,4551<->4409,4489<->4717,2000<->1961,4274<->4409,4323<->4489,1961<->1950,4224<->4274,4084<->4323,1950<->1951,4223<->4224,3876<->4084,1951<->1957,4336<->4223,3769<->3876,1957<->1948,4336<->4069,4232<->4336,3704<->3769,1948<->1949,3767<->4069,4103<->4232,3545<->3704,2054<->1949,3561<->3767,4055<->4103,3409<->3545,2054<->1996,3415<->3561,3899<->4055,3408<->3409,1996<->1997,3415<->3377,3898<->3899,3425<->3408,2043<->1997,3345<->3377,3905<->3898,3461<->3425,2043<->2128,3277<->3345,3689<->3905,3410<->3461,2091<->2128,3277<->3105,3459<->3689,3360<->3410,2091<->1946,2923<->3105,3458<->3459,3254<->3360,1946<->1838,2822<->2923,2923<->2894,3458<->3460,3239<->3254,1725<->1838,2772<->2822,2894<->2788,3407<->3460,3238<->3239,1725<->1531,2771<->2772,2788<->2598,3406<->3407,1531<->1342,2480<->2598,3514<->3406,1342<->1276,2480<->2402,3321<->3514,3514<->3504,1219<->1276,2402<->2400,3153<->3321,3504<->3272,1219<->1090,2400<->2401,3042<->3153,3023<->3272,1090<->1035,2793<->3042,3084<->3042,2850<->3023,997<->1035,2424<->2793,3008<->3084,2739<->2850,997<->960,2134<->2424,3007<->3008,2578<->2739,2739<->2645,960<->961,1914<->2134,2488<->2578,2645<->2356,1656<->1914,2278<->2488,2195<->2356,1655<->1656,2277<->2278,2195<->2023,1896<->2023,1895<->1896,2772<->1,1<->2,2<->3,2<->4,3277<->100,4<->5,5<->6,5<->7,5<->8,5<->9};

g1=Graph[kk]; 

gl1 = VertexList[g1]; 

gl2 = Table[VertexDegree[g1, gl1[[i]]], {i, 1, Length[gl1]}]; 

gl3 = Flatten[Position[gl2, _?(# != 2 &)]]; gl4 = Table[gl1[[gl3[[i]]]], {i, 1, Length[gl3]}]; 

g2=HighlightGraph[g1, Flatten[gl4], VertexSize -> 2, ImageSize -> 1200]

The graph g2 is a graph g1 with the designation of nodes with degree !=2. How to reduce the graph g2 to the weighted graph i.e. without nodes degree 2 where the weights are the number of removed nodes of degree 2. It looks like this: enter image description here

I started like that:

gp = GraphPeriphery[g1, Method -> "PseudoDiameter"];

pu1 = Select[Subsets[gp, 2], Length[#] >= 2 &];

pu2 = Sort[Table[{Length[FindShortestPath[g1, pu1[[i, 1]], pu1[[i, 2]]]], pu1[[i]]}, {i, 1, Length[pu1]}], #1[[1]] > #2[[1]] &];

pu3 = pu2[[1, 2]];

gl1 = FindShortestPath[g1, pu3[[1]], pu3[[2]]];

gl2 = Table[VertexDegree[g1, gl1[[i]]], {i, 1, Length[gl1]}];

gl3 = Flatten[Position[gl2, _?(# != 2 &)]];

gl4 = Table[gl1[[gl3[[i]]]], {i, 1, Length[gl3]}];

gl5 = Partition[gl4, 2, 1];

gl6 = Flatten[Table[{Length[FindShortestPath[g1, gl5[[i, 1]], gl5[[i, 2]]]] - 1}, {i, 1, Length[gl5]}]];

gl7 = Table[{gl5[[i, 1]] <-> gl5[[i, 2]], gl6[[i]]}, {i, 1,Length[gl5]}]

I will make calculations for large graphs, e.g. as here: https://drive.google.com/drive/folders/1EUaH6x8mZ-QYq3PKQNNzKdLN_7eQ-Sa2?usp=sharing

Does anyone have any idea?

$\endgroup$
0

1 Answer 1

7
$\begingroup$

IGSmoothen from IGraph/M does basically this: it smoothens degree-2 vertices.

It removes degree-2 vertices, i.e. in 1 - 2 - 3 it merges the edges 1 - 2 and 2 - 3 into a single edge 1 - 3. The weights of the original edges are added up. IGSmoothen considers all edges in an unweighted graph to have weight 1, thus it will effectively count how many edges were merged.

Demo on your graph:

IGSmoothen[g1, EdgeLabels -> "EdgeWeight", 
 VertexShapeFunction -> "Name", PerformanceGoal -> "Quality"]

enter image description here

IGSmoothen is partially implemented in C++ and will be much faster than any alternative written in pure WL.

Should you want to round edge weights to integers (IGSmoothen creates reals by default), just apply the function IGEdgeMap[Round, EdgeWeight] to the resulting graph. It is an operator that applies Round to every value of the EdgeWeight edge property.

$\endgroup$
1
  • $\begingroup$ Thank you a lot! $\endgroup$
    – ralph
    Commented Mar 29, 2019 at 14:52

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.