House-graphs and other embeddings

examples.md

Example 1: House Graph

HouseGraph = Graph[{
    1 -> 2,
    1 -> 3,
    2 -> 3,
    2 -> 4,
    3 -> 5,
    4 -> 5
    }];

Besides the house drawing, here there is another picture of it.

ClearAll[allMaps];
allMaps[graph_] := With[{emb = getInitialEmb[graph]},
   Map[
    Function[comb,
     Association[
      Table[
       i -> comb[[i]], {i, 1, Length@VertexList@graph}]]] ,
    Distribute[
     Table[ 
      #[[1, 1]] & /@ Union@Map[
         Cycles[{#}] &,
         Permutations@emb[v]],
       {v, VertexList@graph}], List] ]
   ];

We can then list all the combinatorial maps the formula is: $$\Pi_{x: Node{G}} (\mathsf{valency}(x)-1)!.$$

allMaps[HouseGraph]

{ <|1 -> {2, 3}, 2 -> {1, 3, 4}, 3 -> {1, 2, 5}, 4 -> {2, 5},  5 -> {3, 4}|>,   (* (a) *)

 <|1 -> {2, 3}, 2 -> {1, 3, 4}, 3 -> {1, 5, 2},  4 -> {2, 5}, 5 -> {3, 4}|>,    (* (b) *)
  
 <|1 -> {2, 3}, 2 -> {1, 4, 3}, 3 -> {1, 2, 5}, 4 -> {2, 5}, 5 -> {3, 4}|>,     (* (c) *)
  
 <|1 -> {2, 3}, 2 -> {1, 4, 3}, 3 -> {1, 5, 2}, 4 -> {2, 5}, 5 -> {3, 4}|>      (* (d) *)
 }

In the case of the house graph the total number is: (2!/2) * (3!/3) (3!/3)(2!/2) = 4

Without forgeting the direction of the edges for a moment, We have here the four embeddings: two planar y two non-planar.

Filter out the planar maps:

In[348]:= Select[allMaps[HouseGraph], IGPlanarQ]
Out[348]= {
<|1 -> {2, 3}, 2 -> {1, 3, 4}, 3 -> {1, 5, 2}, 4 -> {2, 5}, 
  5 -> {3, 4}|>, 
  
<|1 -> {2, 3}, 2 -> {1, 4, 3}, 3 -> {1, 2, 5}, 
  4 -> {2, 5}, 5 -> {3, 4}|>
  }

To plot nice graphs:

In[357]:= Clear[plotPlanarEmbeddings];
plotPlanarEmbeddings[g_] :=
  Dataset@
   Map[Function[embedding, {embedding, 
      draw[g, embedding]}], 
    Select[ allMaps[g], IGPlanarQ]
    ];
In[359]:= plotPlanarEmbeddings@HouseGraph

example2: Grid graph

outergraph2Squares = Graph[{
    1 -> 2,
    2 -> 3,
    1 -> 4,
    4 -> 3,
    4 -> 5,
    5 -> 6,
    3 -> 6
    }
   ]; 
allMaps[outergraph2Squares] // TableForm

All the possible combinatorial maps:

{<|1 -> {2, 4}, 2 -> {1, 3}, 3 -> {2, 4, 6}, 4 -> {1, 3, 5}, 
  5 -> {4, 6}, 6 -> {3, 5}|>, 
  
<|1 -> {2, 4}, 2 -> {1, 3}, 
  3 -> {2, 4, 6}, 4 -> {1, 5, 3}, 5 -> {4, 6}, 
  6 -> {3, 5}|>, 

<|1 -> {2, 4}, 2 -> {1, 3}, 3 -> {2, 6, 4}, 
  4 -> {1, 3, 5}, 5 -> {4, 6}, 6 -> {3, 5}|>, 
  
<|1 -> {2, 4}, 
  2 -> {1, 3}, 3 -> {2, 6, 4}, 4 -> {1, 5, 3}, 5 -> {4, 6}, 
  6 -> {3, 5}|>}

Example 3: 2-Bouquet

For the directed bouquet with two loops, as in the PDF, let us refer to the edges at the star (xin, xout, yin, yout) as 1,2,3,4 for simplicity.

name[1] = xin;
name[2] = xout;
name[3] = yin;
name[4] = yout;

We can then generate all the different cyclic permutations on this 4-element set (the only star of B2).

CP = Union[Cycles[{#}] & /@ Permutations@Range[4]];
CP /. x_Integer :> name[x]

And the result is:

{
    Cycles[{{xin, xout, yin, yout}}],  (* (a) *)
    Cycles[{{xin, xout, yout, yin}}],  (* (b) *)
    Cycles[{{xin, yin, xout, yout}}],  (* (c) *)
    Cycles[{{xin, yin, yout, xout}}],  (* (d) *)
    Cycles[{{xin, yout, xout, yin}}],  (* (e) *)
    Cycles[{{xin, yout, yin, xout}}]   (* (f) *)
 }

The number of embeddings is then six in total, the correct pictures:

One thing to notice is that if I apply the Lemma which states the charactherisation of the identity type of cyclic sets, I get that all are embeddings are equal, proving by brute forcing, if there is an isomor of the star that makes the diagram commuting.

To replace in the lemma: (A,B := Star(B2, x)) and $f$, and $g$ are the embeddings, the cyclic orderings we found above.

isoStar = Permutations@Range[4]; 
testEquality[f_, g_] := AnyTrue[ 
   isoStar
   , Function[e, 
    PermutationProduct[f, e] == PermutationProduct[e, g]]];
Union[CP, SameTest -> testEquality]  /. x_Integer -> name[x]

The result is:

{Cycles[{{xin, xout, yin, yout}}]}

Same embedding different outer face: