In[]:=
ClearAll[fib]fib[n_]:=fib[n-1]+fib[n-2]fib[0|1]=1;cg=TraceCausalGraph[fib[3],"ShowExpressions"->False]
Out[]=
In[]:=
TraceCausalGraph[fib[3],"PathEventsGraph","ShowExpressions"->False]
Out[]=
In[]:=
foliations=ResourceFunction["GraphFoliations"][cg,"IncludePermutations"->True];
In[]:=
embedding=Thread[VertexList[cg]->GraphEmbedding[cg]];
In[]:=
Grid[Partition[Show[cg,Graphics[{Arrowheads[0.1],Thick,Red,If[Length[#]>1,{RegionBoundary@RegionDilation[Line[#],.3]}&,Circle[#,.3]&]@Lookup[embedding,#]&/@#}],ImageSize->Medium]&/@foliations,5]]
Out[]=
In[]:=
eventToDiff[DirectedEdge[_,_->to_,_->pos_]]:=Prepend[pos,1]:>Evaluate@Extract[to,Prepend[pos,1],Unevaluated]
In[]:=
Grid[Partition[PathGraph[MapThread[ReplaceAt[#1,subExpr_:>RuleCondition@Style[HoldForm[subExpr],Red],#2]&,{FoldList[ReplacePart,Extract[#1,{1,1,2},HoldForm],#[[2;;]]],Append[#[[2;;,All,1]],{}]}],DirectedEdges->True,ImageSize->256,AspectRatio->2,GraphLayout->"SpiralEmbedding",FormatType->StandardForm,VertexShapeFunction->(Inset[Framed[Style[#2,Hue[0.62,1,0.48]],Background->Directive[Opacity[0.2],Hue[0.62,0.45,0.87]],FrameMargins->{{2,2},{0,0}},FrameStyle->Directive[Opacity[0.5],Hue[0.62,0.52,0.82]],RoundingRadius->0],#1,#3]&),PerformanceGoal->"Quality"]&/@Map[eventToDiff,foliations,{3}],5]]
Out[]=
In[]:=
Grid[Partition[Show[cg,Graphics[{Arrowheads[0.1],Thick,Red,Arrow/@Partition[Lookup[embedding,Catenate@#],2,1]}],ImageSize->Medium]&/@foliations,5]]
Out[]=
