Foliations Constructor

Given a partial foliation, we need to determine how that partial foliation can be continued. Once we have that, a simple NestGraph can generate the whole thing.

First, we start with a graph:

In[]:=

causalGraph=Graph[{1->2,3->2,2->4,5->3,3->6},VertexLabels->Automatic]

Out[]=

The starting point is an empty foliation:

In[]:=

init={};

To continue a foliation, we remove existing vertices from a graph, and then select all sources.

From GeneralUtilities`:

In[]:=

If[!MemberQ[$ContextPath, "GeneralUtilities`"], GraphSources[graph_] := Pick[VertexList @ graph, VertexInDegree @ graph, 0]; GraphSinks[graph_] := Pick[VertexList @ graph, VertexOutDegree @ graph, 0];];

In[]:=

ClearAll[Foliation];Foliation::usage = "Foliation[v$1, v$2, $$] represents a foliation where vertex groups v$1, v$2, $$ lies between the lines.";

In[]:=

ClearAll[nextFoliationLinePossibleVertices];nextFoliationLinePossibleVertices[graph_][partialFoliation_Foliation] := GraphSources @ VertexDelete[graph, Catenate[List @@ partialFoliation]];

In[]:=

ClearAll[nextFoliationVertexSets];nextFoliationVertexSets[graph_][partialFoliation_] := Subsets[nextFoliationLinePossibleVertices[graph][partialFoliation], {1, Infinity}];

In[]:=

ClearAll[foliationContinuations];foliationContinuations[graph_][partialFoliation_] := Append[partialFoliation, #] & /@ nextFoliationVertexSets[graph][partialFoliation];

In[]:=

ClearAll[FoliationsGraph];Options[FoliationsGraph] = Options[Graph];SyntaxInformation[FoliationsGraph] = {"ArgumentsPattern" -> {graph_, opts___}, "OptionNames" -> First /@ Options[Graph]};FoliationsGraph[graph_, options : OptionsPattern[]] := NestGraph[foliationContinuations[graph], Foliation[], VertexCount[graph], options, VertexLabelStyle -> Directive["StandardForm"]];

In[]:=

ClearAll[FoliationsList];SyntaxInformation[FoliationsList] = {"ArgumentsPattern" -> {graph_}};FoliationsList[graph_] := List @@@ GraphSinks @ FoliationsGraph[graph];

In[]:=

ClearAll[FoliatedGraph];SyntaxInformation[FoliatedGraph] = {"ArgumentsPattern" -> {graph_, foliation_, opts___}};Options[FoliatedGraph] = Options[Graph];FoliatedGraph[graph_, foliation_List, options : OptionsPattern[]] := Graph[graph, options, VertexSize -> 0.2, VertexStyle -> Flatten[MapIndexed[# -> Lighter[ColorData[24][First[#2]], 0.2] &, foliation, {2}]], VertexLabels -> Flatten[MapIndexed[# -> Placed[First[#2], Center] &, foliation, {2}]]];

In[]:=

FoliatedGraph

,#&/@FoliationsList[causalGraph]

Out[]=



,



In[]:=

FoliationsGraph[causalGraph,VertexLabels->Placed[Automatic,Tooltip],GraphLayout->"LayeredDigraphEmbedding"]