3
$\begingroup$

I have 3 directed branches and I want to create all possible graphs that can be created from these branches with the condition that each branch is used once.

Q1: How can I do create and graph them?

enter image description here

Here are some example graphs: enter image description here

Q2: Same as Q1 but now add one more condition that the branch a and branch b are connected as in the image below.

enter image description here

$\endgroup$
7
  • $\begingroup$ What exactly is a branch here, and how is it implemented? $\endgroup$
    – thorimur
    Jun 20 at 22:05
  • $\begingroup$ @thorimur it's something like this Graph[{1 \[DirectedEdge] 2, 2 \[DirectedEdge] 3, 3 \[DirectedEdge] 1}] $\endgroup$
    – emnha
    Jun 20 at 22:10
  • $\begingroup$ hmm ok, so are you asking for all possible graphs with 3 directed edges? if so do you have any constraint on the number of vertices? also are the edges and vertices labeled? $\endgroup$
    – thorimur
    Jun 20 at 22:10
  • $\begingroup$ @thorimur yes, all possible graphs with 3 directed edges. I don't have any constraint in the number of vertices but from 3 branches there is a maximum of 6 vertices. I labeled edges to make it clear that they're different. I think you could also label the vertices if an edge. $\endgroup$
    – emnha
    Jun 20 at 22:15
  • 1
    $\begingroup$ @thorimur for example 1 and 2 are two vertices of a then the edge a is always from 1 to 2. I edited and added some examples. $\endgroup$
    – emnha
    Jun 20 at 22:40
1
$\begingroup$
edges = {"A" -> "B", "C" -> "D", "E" -> "F"};

styledlabelededges = MapThread[Labeled[Style[#, #2], #3] &, 
   {edges, 
   {Red, Green, Blue}, 
   Style[#, 16, Background -> White] & /@ {"a", "b", "c"}}];

g0 = Graph[styledlabelededges, 
  ImageSize -> 400, 
  VertexLabelStyle -> Medium, 
  VertexLabels -> "Name", 
  GraphLayout -> "CircularEmbedding"]

enter image description here

ClearAll[vContract]
vContract[g_] := Graph @@ 
  ({EdgeList[g], Options[g]} /. #[[2]] -> #[[1]] /. #[[1]] -> #) &

vreplacements = {{"B", "E"}, {"B", "F"}, {"B", "C"}, {"A", "D"}};

Grid[Partition[vContract[g0] /@ vreplacements, 2], Dividers -> All]

enter image description here

$\endgroup$
5
  • $\begingroup$ When B, E are contracted, the branch a could be disconnected as in your plot but it can also connect to any other node. How can I do that? How can I plot all cases also when 3 branches are connected? I think you mean to apply contract in series? $\endgroup$
    – emnha
    Jun 20 at 23:34
  • $\begingroup$ @anhnha, corrected the labels and styles. $\endgroup$
    – kglr
    Jun 20 at 23:45
  • $\begingroup$ your image shows the contracted nodes with two letters like {B, E} but it doesn't appear when I run it. $\endgroup$
    – emnha
    Jun 20 at 23:53
  • $\begingroup$ @anhnha, please try the current version. $\endgroup$
    – kglr
    Jun 20 at 23:57
  • $\begingroup$ nice, the code is complex but I'll try to reprocedure it. $\endgroup$
    – emnha
    Jun 21 at 0:02
1
$\begingroup$

The following is a brute force solution, but it is easy to understand:

This is the starting graph:

g0 = Graph[{"a" -> "b", "c" -> "d", "e" -> "f"}];

You want to contract vertices in all possible ways. For simplicity, we will use IGVertexContract from IGraph/M, as it can handle multiple contractions simultaneously.

Needs["IGraphM`"]

Contracting the two endpoints of an existing edge (such as a -> b) is not allowed:

vertices = VertexList[g0]

disallowed = Partition[vertices, 2]
(* {{"a", "b"}, {"c", "d"}, {"e", "f"}} *)

These are the allowed contractions:

possibleContractions = Complement[Subsets[vertices, {2}], disallowed]
(* {{"a", "c"}, {"a", "d"}, {"a", "e"}, {"a", "f"}, {"b", "c"}, 
    {"b", "d"}, {"b", "e"}, {"b", "f"}, {"c", "e"}, {"c", "f"}, 
    {"d", "e"}, {"d", "f"}} *)

We can get all combinations with Subsets[possibleContractions]. However, given a vertex, we may only contract it with one other vertex, not multiple one. Thus, we need a helper function to detect multiple contractions:

disjointQ[list_] := Length[Union @@ list] == Length[Join @@ list]

These are the allowed contractions: Select[Subsets[possibleContractions], disjointQ].

IGVertexContract[g0, #, GraphStyle -> "VintageDiagram"] & /@ 
 Select[Subsets[possibleContractions], disjointQ]

Here's a screenshot of the first few results:

enter image description here

Note that graphs with reciprocal edges are also generated. You did not make it clear if you need them. If not, just filter them out.

$\endgroup$

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.