6
$\begingroup$

I am interested in finding the positions of "chains" (sequences of vertex degree 2 vertices) in a graph. I plan on collapsing these chains later to vertices with labels indicating that they are collapsed chains.

For example, I would like the following input-output.

Input:

Graph[{1 \[DirectedEdge] 2, 2 \[DirectedEdge] 3,   
3 \[DirectedEdge] 4, 4 \[DirectedEdge] 5, 6 \[DirectedEdge] 7, 
7 \[DirectedEdge] 8, 5 \[DirectedEdge] 8, 8 \[DirectedEdge] 9}]

graph

Output:

{"Chain1" -> Graph[{1 \[DirectedEdge] 2, 2 \[DirectedEdge] 3, 
3 \[DirectedEdge] 4, 4 \[DirectedEdge] 5, 5 \[DirectedEdge] 
6}], 
"Chain2" -> Graph[{1 \[DirectedEdge] 2, 2 \[DirectedEdge] 3}], 
HighlightGraph[
Graph[{Labeled[1, "Chain1"], Labeled[3, "Chain2"]}, {1 -> 2, 3 
-> 2,
2 -> 4}], {1, 3}]}

list_result

Why do you want to do that ?

I want to make a code that creates a symbolic expression for the output of an artificial neural network (I am interested if anyone has a code that already does that).

I already made a code that works with simple feedforward networks (NetChain) that contain only ElementwiseLayer and LinearLayer.

I would like to use my code for NetChains to replace any chain subgraph in NetGraph with its symbolic functional equivalent and then use these intermediate expressions to compute the full symbolic expression of a network. A typical example would be to replace a network that adds the results of two NetChains by first finding the expressions for the NetChains and then simply adding them.

Edit 1

In the output example given I would like the two first elements in Chain1 and Chain2 to retain the names of the vertices. The length of the chain is not enough for my purpose.

Edit 2

Procedure incorporating the methods below

Note: There are 2 conventions, the last one using @Szabolcs's answer is currently incomplete for the problem at hand but still provides a solution for many cases.

The answers from @Szabolcs and @lericr offer different solutions on how to collapse a chain within a graph. Should the chain be collapsed to a vertex or an edge? Which vertex should we collapse the chain to? The first, the last? To clarify what I mean we may look at the following input-output examples.

Input:

Graph[{1 -> 2, 2 -> 3, 3 -> 4, 5 -> 4, 4 -> 8, 8 -> 9, 9 -> 10, 
10 -> 11, 11 -> 12, 12 -> 13, 13 -> 14, 11 -> 15, 15 -> 16, 
15 -> 17}, ImageSize -> Small, VertexLabels -> Automatic]

input

Output using the method from @lericr:

graph

Output using the method from @Szabolcs:

output2

/////////////////

Discussion on the differences between the outputs:

Notice that in the first output vertex 8 represents the collapsed chain whereas in the second output the collapsed chain is represented by the edge 4->11. Notice as well that in the first output, the vertex that represents a chain is always the first element in the chain (with respect to the graph arrow flow). This might be natural for a directed graph but might be difficult to work with when using undirected graphs. Indeed, in the first output graph, vertex 1 is far from vertex 4 in the original graph whereas vertex 12 is close to vertex 11. This could lead to inconsistencies in some applications while being useful when working with directed graphs in others. The second output graph is perhaps easier to work with in general. Moreover, @Szabolcs one function solution might be easier to use in most graph-chain related problems which is why I accepted that user's solution.

//////////////////

In the following, I will use the answers below to provide a solution for both conventions. First, however, I provide below the code for obtaining the chains which is used in both cases.

Following the suggestion of @Szabolcs, the list of collapsed chains can be obtained using**(see footnote):

chains=WeaklyConnectedGraphComponents[Subgraph[inputgraph, _? 
(VertexDegree[testGraph2, #] < 3 &)] // EdgeList]

Output:

list

The slightly longer method used by @lericr might require less computer time since it does not use patterns but I have not checked.

///////////////

** footnote : The list chains is equivalent to @lericr's chainSubgraphs I believe. Also, EdgeList was used to remove any lone wolf vertices from the disconnected graphs. Equivalently one could also use VertexDelete as in @lericr's answer:

WeaklyConnectedGraphComponents[
VertexDelete[inputgraph, _?(VertexDegree[inputgraph, #] > 2 &)] 
// EdgeList]

This VertexDelete code has about the same speed as the Subgraph one when using the input examples above.


Vertex collapsed-chain convention

I would like to mention that @lericr's answer is fairly simple and uses only Mathematica built-in functions whereas the @Szabolcs method requires installing a package (the page provided in @Szabolcs answer makes the installation a very easy copy-paste-enter using Mathematica).

In the vertex convention, the collapsed chains in the output graph are identified by the first vertex in each chain. These may be extracted using:

chainNodes=TreeData /@ GraphTree /@ chains

Or the method used by @Ben Izd:

chainNodes=Last /@ (VertexInComponent[#, Last@VertexList[#]] &) 
/@ chains

which is a bit longer to write and more difficult to understand and remember but it was about 200 times faster in my tests involving chains containing over a hundred vertices. Of course, this remark is important only for graphs containing many long chains.

The outputgraph is obtained easily using

VertexContract[inputgraph,chains]

Then we may use @Ben Izd's answer where I included the option to highlight the collapsed chains:

labels = Array["Chain" ~~ ToString[#] &, Length @ chainNodes];

AnnotationValue[{outputgraph, chainNodes}, VertexLabels] = labels;

Append[MapThread[Rule, {labels, chains}], HighlightGraph[Outputgraph, chainNodes]]

which leads to the desired result:

res


Edge collapsed-chain convention

Note: currently incomplete but provides a solution for many cases.

The method provided by @Szabolcs requires installing a package but the page provided in @Szabolcs answer makes the installation a very easy copy-paste-enter using Mathematica.

The output graph does not require computing the chains and is thus a much quicker solution when full knowledge of the chain content is not required.

If IGraph/M is not installed, please check @Szabolcs's answer.

The output graph is obtained using :

outputgraph=IGSmoothen[inputgraph]

If one only wishes to identify which edges correspond to collapsed chains, independently of which collapsed edge corresponds to which edge, then it is sufficient to use

outputgraph=IGSmoothen[inputgraph,EdgeLabels -> "EdgeWeight"]

where the edge weight of a collapsed chain is equal to the total number of edges**(see footnote). If the user wishes to have a more visual representation where the edges corresponding to collapsed chains are highlighted then one may use:

HighlightGraph[outputgraph, 
GraphDifference[outputgraph,inputgraph] //EdgeList]

If the user needs to identify which edge corresponds to which chain then further work is needed.

////////////////

Discussion on the convention for identifying collapsed chain edges with their chains

One may identify collapsed-chain edges with the original chains by looking at the last, or outflowing, vertex of a collapsed chain (for example vertex 11 in the above output example). These vertices are not vertices of the chains but correspond to the next, or outflowing, a vertex that comes right after the last vertex of a chain in the original input graph (for example 11 in the collapsed chain comes after 10 which is the last vertex in the chain 8->9->10). The last vertex rather than the first vertex is needed due to problems at the boundary of a graph (see for example the chain 1->2->3). Hence a natural identification, or association, can be made between the outflowing vertex of a collapsed chain and the chain it represents. This should be straightforward to implement but I do not have much time currently.

/////////////////////

////////////////////

**footnote: See @Szabolcs's answer for an image showing that the weights are also numerical (like 4. instead of 4)).

$\endgroup$
8
  • $\begingroup$ Please post your code in text form. $\endgroup$
    – cvgmt
    May 23 at 0:01
  • $\begingroup$ Hello, thank you for your help. $\endgroup$ May 23 at 1:34
  • $\begingroup$ The IGraph/M package has a function called IGSmoothen which does exactly this: it contracts degree-2 vertices. $\endgroup$
    – Szabolcs
    May 23 at 9:12
  • $\begingroup$ You did a great job merging different solutions to suit your needs. Well done. With regard to your footnote 2, the method I used is VertexInComponent which is applied directly on the graph without converting to other types. $\endgroup$
    – Ben Izd
    May 24 at 18:04
  • $\begingroup$ @Ben Izd thank you. You also use First when you use VertexInComponent. Does your method depend on whether the edges in the list are sorted in the same way as in the flow of the graph? It seems to me that Mathematica does not always sort the edges in this way (I might be wrong) so I am reluctant to use any method that depends on the ordering of the edges. $\endgroup$ May 24 at 18:29

3 Answers 3

7
$\begingroup$

Take a look at IGSmoothen from the IGraph/M package. It contracts degree-2 vertices while retaining information about how long the "chain" was though the EdgeWeight attribute.

g = Graph[{1 \[DirectedEdge] 2, 2 \[DirectedEdge] 3, 
    3 \[DirectedEdge] 4, 4 \[DirectedEdge] 5, 6 \[DirectedEdge] 7, 
    7 \[DirectedEdge] 8, 5 \[DirectedEdge] 8, 8 \[DirectedEdge] 9}];


IGSmoothen[g, EdgeLabels -> "EdgeWeight", VertexLabels -> Automatic]

enter image description here

$\endgroup$
5
  • $\begingroup$ Thank you very much for your help. I am sorry for the lack of precision in my question. In the output example given I would like the two first elements in Chain1 and Chain2 to retain the names of the vertices. The length of the chain is not enough for my purpose. I have added an edit at the end of my question to remove this ambiguity. That said @Ben Izd does answer the question and I shall consider lericr's answer to see if I can simplify the former's answer. $\endgroup$ May 23 at 16:23
  • 1
    $\begingroup$ @userrandrand the documentation says it retains the names of the first and last vertices which you should able to see with VertexLabels->"Name". If this does what you want this might be the best answer because built-in functions should be fast $\endgroup$ May 23 at 17:02
  • $\begingroup$ I need the chains as well and although it should be possible, I failed to find a way to retrieve the chains using the collapsed chain output graph and the original input graph. I tried using GraphDifference[inputgraph,outputgraph]] but this does not work. Note that in the original problem the vertex labels will be names rather than ordered numbers and so it is not possible to deduce the chain solely from the starting and endpoint of the collapsed chains. One possibility might be to include a preprocessing step adding an Association between vertex names and vertex positions $\endgroup$ May 24 at 3:37
  • $\begingroup$ @userrandrand IGSmoothen operates with general vertex names. To take the "chains", you could get the subgraphs induced by degree-2 vertices and break it into connected components. $\endgroup$
    – Szabolcs
    May 24 at 7:28
  • $\begingroup$ Thank you for the suggestion of using Subgraphs. I suppose you are referring to the pattern option of SubGraph. This SubGraph method indeed seems a lot quicker than the methods of lericr and Ben Izd (at least in terms of user time not sure about computer time due to the usage of patterns). Once the chains are obtained, one may simply use VertexContract as in the method of lericr. The output differs however from that of IGSmoothen but could be equally useful depending on the semantics choice. I will edit my question to include both answers with the full implementation. $\endgroup$ May 24 at 16:59
6
$\begingroup$

Let's say that a vertext is a member of a chain if its out-degree and in-degree are both less than 2. Then one approach would be to remove all non-chain vertices and then manipulate the resulting (perhaps disconnected) graph in various ways. Let's start by finding the non-chain vertices (I'm calling your original graph testGraph:

nonChainVertices = 
  Pick[
    VertexList[testGraph],
    Or@@@
      Map[
        GreaterThan[1],
        Transpose[{VertexInDegree[testGraph],VertexOutDegree[testGraph]}],
        {-1}]]
(* {8} *)

Now we delete them:

chainGraph = VertexDelete[testGraph, nonChainVertices]

Now let's keep track of vertices in chains:

chains = WeaklyConnectedComponents[chainGraph]
(* {{2,1,3,4,5},{6,7},{9}} *)

We can get the chains as their own graphs:

chainSubgraphs = Subgraph[testGraph, #] & /@ chains

You may want to discard the single vertex chain.

You can create a new graph from the original with the chains collapsed:

VertexContract[testGraph, chains]

You provided some labeling conventions in your post, but it's not clear to me that those were actual requirements--it seemed like you had other ideas for further processing, so I'll leave that up to you. At this point you have vertices grouped into chains, subgraphs representing the chains, and a collapsed graph.

$\endgroup$
5
  • $\begingroup$ Thank you very much for your help. This seems to work. Concerning the labels: Short Version: I need the labels to retain all of the information from the original graph but I can manage with your method. Thank you again. Long Version: To retain the information from the input, I need to add labels to the contracted vertices of the output and a dictionary that associates each labeled vertex of the output to the collapsed chain that it represents. As your method keeps the name of at least one of the original vertices of the collapsed chain, chain identification is possible. $\endgroup$ May 23 at 15:23
  • $\begingroup$ I should point out that my implementation might differ from what you expect. In your example, Chain1 and Chain2 are each one edge longer than the corresponding chains in my implementation. But your collapsed graph is the same as mine. I wasn't sure what your semantics were, and I biased toward the collapsed graph. $\endgroup$
    – lericr
    May 23 at 17:09
  • $\begingroup$ I am actually not sure what my semantics should be either. The only thing that matters to me is whether the output list containing the collapsed graph and the deleted chains represent sufficient information to reproduce the input exactly. It seemed to me that your method retains enough information to reproduce the input. That said, I realized my example was also too simple. I am going to edit my question to give an example of a more general graph and to try to clarify what I want. As I am new here I am not sure if I should post a new question instead or modify the current one. $\endgroup$ May 23 at 20:04
  • $\begingroup$ If it invalidates the answers here, then it might be better to post a new one. $\endgroup$
    – lericr
    May 23 at 20:37
  • $\begingroup$ Thank you for your help $\endgroup$ May 23 at 20:45
5
$\begingroup$

I'm sure you'll find better approaches, here is a simple one:

Assuming we have our graph in variable g:

g = Graph[{1 \[DirectedEdge] 2, 2 \[DirectedEdge] 3, 
    3 \[DirectedEdge] 4, 4 \[DirectedEdge] 5, 6 \[DirectedEdge] 7, 
    7 \[DirectedEdge] 8, 5 \[DirectedEdge] 8, 8 \[DirectedEdge] 9}];

You can find vertices that have VertexOutDegree == 1 and are connected to VertexOutDegree == 1 && VertexInDegree == 1 with EdgeList:

allEdges = 
  EdgeList[g, _?(VertexOutDegree[g, #] == 
        1 &) \[DirectedEdge] _?(VertexOutDegree[g, #] == 1 && 
        VertexInDegree[g, #] == 1 &)]

(* Out (simplified): {1 - 2, 2 - 3, 3 - 4, 4 - 5, 6 - 7} *)

Now we group them by their root using VertexInComponent:

groupedEdges = GatherBy[allEdges, Last @ VertexInComponent[g, First @ #] &]

(* Out (simplified): {{1 - 2, 2 - 3, 3 - 4, 4 - 5}, {6 - 7}} *)

Then you can trace down to find the last node in the chain:

targetNodes = 
  TakeSmallestBy[#, Length@VertexOutComponent[g, Last @ #] &, 1][[1, 
      2]] & /@ groupedEdges

(* Out: {5, 7} *)

Delete vertices (while keeping the last nodes), create labels, and assign them:

g2 = VertexDelete[g, Complement[VertexList @ Catenate @ groupedEdges, targetNodes]];

labels = Array["Chain" ~~ ToString[#] &, Length @ targetNodes];

AnnotationValue[{g2, targetNodes}, VertexLabels] = labels;

Append[MapThread[Rule, {labels, Graph /@ groupedEdges}], g2]

Output:

enter image description here

$\endgroup$
1
  • $\begingroup$ Thank you very much for your help. This answers the question. I will wait a few days for everyone to reply to their comments and if no one provides a simpler answer I will accept this one. Thank you again. $\endgroup$ May 23 at 15:58

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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