In[]:=
findCausalSequence[rules_,init_,t_,final_]:=Module[{source=If[Length[init]===1,First[init],init]},With[{path=FindShortestPath[MultiwayTuringMachine[rules,source,t,"StatesGraphStructure"],ToString[source],final]},CanonicalGraph[Subgraph[MultiwayTuringMachine[rules,source,t,"CausalGraphStructure"],Catenate[FindShortestPath[MultiwayTuringMachine[rules,source,t,"EvolutionCausalGraphStructure"],path[[#]],path[[#+1]]]&/@(Range[Length[path]-1])]]]]]
In[]:=
findBranchPairs[rules_,init_,t_]:=Module[{gr,events,pairs},gr=CausalMultiwayTuringMachine[rules,init,t,"StatesGraphStructure"];events=VertexList[gr][[Position[VertexOutDegree[gr],_?(#≥2&)][[All,1]]]];pairs=Sort/@DeleteDuplicates[Subsets[Rest[VertexOutComponent[gr,{#},1]],{2}]&/@events]]
In[]:=
MTMCausalInvariantQ[rules_,init_,t_]/;t>0:=Module[{branchPairsList,newBranchPairsList,combinedBranchPairsList,gr,terminalEvents,pairs},branchPairsList=findBranchPairs[rules,init,t-1];newBranchPairsList=Complement[findBranchPairs[rules,init,t],findBranchPairs[rules,init,t-1]];combinedBranchPairsList=Union[branchPairsList,newBranchPairsList];gr=CausalMultiwayTuringMachine[rules,init,t,"StatesGraphStructure"];terminalEvents=VertexList[gr][[Position[VertexOutDegree[gr],0][[All,1]]]];With[{terminalEvent=#},(branchPairsList=Select[branchPairsList,!SubsetQ[VertexOutComponent[ReverseGraph[gr],terminalEvent],#]&])]&/@terminalEvents;pairs=<|"Resolved"Complement[combinedBranchPairsList,Union[branchPairsList,newBranchPairsList]],"Unresolved"Union[branchPairsList,newBranchPairsList]|>;Length[pairs["Unresolved"]]0]
In[]:=
Clear[CausalMultiwayTuringMachine]
In[]:=
CausalMultiwayTuringMachine[rules_List,initialConditions_List,stepCount_Integer,rest___]:=Module[{prop,rulespecs,opts,original,merging},{rulespecs,prop}=With[{restlist=DeleteCases[List@rest,_Rule]},Switch[Length[restlist],0,{calculateRuleSpecs[First[rules]],"AllStatesList"},1,Switch[Head[restlist[[1]]],List,{restlist[[1]],"AllStatesList"},String,{calculateRuleSpecs[First[rules]],restlist[[1]]}],2,restlist]];opts=Select[List@rest,Head[#]===Rule&];original=ResourceFunction["MultiwaySystem"][Association["StateEvolutionFunction"->(getTuringMachineStateEvolutionFunction[#1,rules]&),"StateEquivalenceFunction"->(IsomorphicGraphQ[findCausalSequence[rules,initialConditions,stepCount,#1],findCausalSequence[rules,initialConditions,stepCount,#2]]&),"StateEventFunction"->(getTuringMachineStateEventFunction[#1,rules]&),"EventDecompositionFunction"->getTuringMachineEventDecompositionFunction,"EventApplicationFunction"->getTuringMachineEventApplicationFunction,"SystemType"->"TuringMachine","EventSelectionFunction"->Identity],ToString/@initialConditions,stepCount,prop,opts,"StateRenderingFunction"getTuringMachineStateRenderingFunction[rulespecs],"EventRenderingFunction"->getTuringMachineEventRenderingFunction[rulespecs]]/;Depth[initialConditions]>3;merging=GroupBy[VertexList[MultiwayTuringMachine[rules,initialConditions,stepCount,"StatesGraphStructure"]],findCausalSequence[rules,initialConditions,stepCount,#]&];Which[prop"StatesGraph"||prop"StatesGraphStructure",SimpleGraph[DirectedEdge[First[Flatten[Position[Values[merging],First[#]]]],First[Flatten[Position[Values[merging],Last[#]]]]]&/@EdgeList[MultiwayTuringMachine[rules,initialConditions,stepCount,"StatesGraphStructure"]],VertexShapeFunctionIf[prop==="StatesGraph",(Style[Inset[Show[Keys[merging][[#2]]],#1,Center,#3],ImageSizeMultipliers{1,1}]&),Automatic],VertexSize0.75,GraphLayout{"LayeredDigraphEmbedding","RootVertex"1}],prop"CausalInvariantQ",MTMCausalInvariantQ[rules,initialConditions,stepCount],True,original]]
In[]:=
CausalMultiwayTuringMachine[List/@{{1,0}{1,1,-1},{1,0}{1,0,-1}},{First[TMAllStates[1,2,4]]},4,"StatesGraph"]
Out[]=
In[]:=
CausalMultiwayTuringMachine[List/@{{1,0}{1,1,-1},{1,0}{1,0,-1}},{First[TMAllStates[1,2,4]]},4,"StatesGraphStructure"]
Out[]=
[[ State merging vs. what is causal connection? ]]
[[ State merging vs. what is causal connection? ]]