3
$\begingroup$

Let assume that i have a list of connections between nodes like this:

input = {1 <-> 10, 2 <-> 3, 4 <-> 5, 6 <-> 7, 8 <-> 9};

The order of elements in a list and in a pair is not important. So the input above should be treat the same as {3 <-> 2, 1 <-> 10, 4 <-> 5, 6 <-> 7, 8 <-> 9}.

I'm trying to build a function myfunc[input_, remove_] which generates the new list depending the list remove as follows.
I'll try to give some example:
If remove == {1 <-> 2} then the return output is {3 <-> 10, 4 <-> 5, 6 <-> 7, 8 <-> 9} as now nodes {1, 2} are shorten and removed.

And remove could have more then one element, for example:
If remove == {1 <-> 2, 5 <-> 6} then nodes {1, 2}, {5, 6} are shorten and removed so the output is {3 <-> 10, 4 <-> 7, 8 <-> 9}.
It's boring to do this manually so I'm looking for some quick way to accomplish this.

Here is an image to make it easier to understand:

enter image description here

$\endgroup$
3
  • $\begingroup$ Have you looked at Complement? $\endgroup$
    – Syed
    Commented Oct 25, 2022 at 7:18
  • $\begingroup$ @Syed I know this function but not sure how it is used here. $\endgroup$
    – hana
    Commented Oct 25, 2022 at 7:29
  • 1
    $\begingroup$ Please ignore my comment. It was due to lack of understanding of the problem that you have now clarified. $\endgroup$
    – Syed
    Commented Oct 25, 2022 at 7:33

2 Answers 2

5
$\begingroup$

With some work, you can use the Graph functionality: First, converting & visualizing your input:

input = {1 <-> 10, 2 <-> 3, 4 <-> 5, 6 <-> 7, 8 <-> 9};

g = Graph[input, VertexLabels -> Placed[Automatic, Above], 
  VertexLabelStyle -> Red, 
  VertexStyle -> Directive[Red, EdgeForm@None], EdgeStyle -> Black]

enter image description here

(note that Graph[input] would be enough, the rest is just styling)

The function to do the removal:

remove[g_, edges_List] := Fold[remove, g, edges]
remove[g_, edge_] := SimpleGraph@VertexReplace[
   EdgeAdd[g, edge],
   # -> First@VertexList[NeighborhoodGraph[g, #], Except[#]] & /@ 
    Flatten[List @@ edge]
   ]

remove[g, {1 <-> 2}]

enter image description here

remove[g, {1 <-> 2, 5 <-> 6}]

enter image description here

The idea of the function is:

  • Add the additional edges, so it's easier to tell what will be connected afterwards using EdgeAdd
  • Get the neighbors of the vertices to be removed using NeighborhoodGraph.
  • Finally, remove the vertices by replacing them with the first neighboor using VertexReplace
  • The resulting graph will have self-loops, which we can clean using SimpleGraph
$\endgroup$
2
  • $\begingroup$ Nice but it doesn't work for this case. input1 = {1 <-> 10, 2 <-> 3, 4 <-> 5, 6 <-> 7, 8 <-> 9}; g = Graph[input1, VertexLabels -> Placed[Automatic, Above], VertexLabelStyle -> Red, VertexStyle -> Directive[Red, EdgeForm[None]], EdgeStyle -> Black]; remove[g, {1 <-> 2, 3 <-> 4}] I expect the output to be {5 <-> 10, 9 <-> 8, 7 <-> 6} rather than the output above. $\endgroup$
    – hana
    Commented Oct 26, 2022 at 8:16
  • 1
    $\begingroup$ @hana Please see the updated answwr dor a fixed version $\endgroup$
    – Lukas Lang
    Commented Oct 26, 2022 at 10:45
2
$\begingroup$
Clear[showGraph, ellipseLayout, remVertices];
showGraph[g_List] := Graph[Graph[Union @@ g, UndirectedEdge @@@ g]
  , VertexLabels -> "Name"
  , VertexCoordinates -> ellipseLayout[Length@(Union @@ g), {2, 1}]
  , VertexStyle -> Red
  , EdgeStyle -> Black
  ]

From one of the pages I visited in the docs:

ellipseLayout[n_, {a_, b_}] := 
 Table[{a Cos[2 Pi/n u], -b Sin[2 Pi/n u]}, {u, 1, n}]

remVertices[g_List, v_List] := 
 FlattenAt[#, 2] &@({Catenate@First@#, Last@#} &@
    Sort[GatherBy[g /. Thread[Rule[v, Nothing]], Length[#] < 2 &]])

To start with:

g0 = Partition[Range[10], 2, 1, {1, 1}][[{2, 4, 6, 8, 10}]]

{{2, 3}, {4, 5}, {6, 7}, {8, 9}, {10, 1}}

For removing one vertex:

g1 = remVertices[g0, {1, 2}]

{{3, 10}, {4, 5}, {6, 7}, {8, 9}}

For removing more vertices contained in v:

v = {{1, 2}, {5, 6}};
g2 = Fold[remVertices[#1, #2] &, g0, v]

enter image description here

$\endgroup$
4
  • $\begingroup$ This is good that it generates correct result for input = {{1, 10}, {2, 3}, {4, 5}, {6, 7}, {8, 9}} and remove = {{1, 2}, {3, 4}} but the code looks quite complicated. $\endgroup$
    – hana
    Commented Oct 26, 2022 at 9:43
  • 1
    $\begingroup$ When I get around to learning about built-in graph functionality, I will appreciate it even more. $\endgroup$
    – Syed
    Commented Oct 26, 2022 at 11:04
  • $\begingroup$ What does the GatherBy do there? Sublists are also lists with 2 elements (2 nodes) so it doesn't seem to do anything? $\endgroup$
    – hana
    Commented Oct 26, 2022 at 11:16
  • $\begingroup$ Once the vertex is cut, it leaves a {_} list amongst other {_,_} lists . So I GatherBy the length. $\endgroup$
    – Syed
    Commented Oct 26, 2022 at 11:57

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.