StringOverlaps[strings_List]:=ResourceFunction["StringOverlaps"][{First[strings],First[strings]}]/;Length[strings]1
In[]:=
StringOverlaps[strings_List]:=ResourceFunction["StringOverlaps"][strings]/;Length[strings]2
In[]:=
StringOverlaps[strings_List]:=DeleteDuplicates[Catenate[ResourceFunction["StringOverlaps"][#]&/@Tuples[strings,2]]]/;Length[strings]>2
In[]:=
findCanonicalCriticalPairs[rules_List]:=Module[{leftHandSides,overlaps,criticalPairs},leftHandSides=First[#]&/@rules;overlaps=StringOverlaps[leftHandSides];criticalPairs=Union[Sort[#]&/@Catenate[(Tuples[StringReplaceList[#,rules],2]&/@overlaps)]];criticalPairs]
In[]:=
criticalPairConvergesQ[rules_List,criticalPair_List,stepCount_Integer]:=Module[{undirectedStatesGraph},undirectedStatesGraph=UndirectedGraph[MultiwaySystem[rules,criticalPair,stepCount,"StatesGraph"]];ConnectedGraphQ[Graph[Union[VertexList[undirectedStatesGraph],criticalPair],EdgeList[undirectedStatesGraph]]]]
In[]:=
TotalCausalInvariantQ[rules_List,stepCount_Integer]:=Module[{canonicalCriticalPairs},canonicalCriticalPairs=findCanonicalCriticalPairs[rules];AllTrue[canonicalCriticalPairs,criticalPairConvergesQ[rules,#,stepCount]&]]
In[]:=
TotalCausalInvariantQ[{"AB""AA","BA""A"},6]
In[]:=
False
Out[]=
TotalCausalInvariantQ[{"A""AA","A""A"},5]
In[]:=
True
Out[]=
TotalCausalInvariantQ[{"A""AB","B""A"},5]
In[]:=
True
Out[]=
TotalCausalInvariantQ[{"A""AB","B""A"},7]
In[]:=
True
Out[]=
TotalCausalInvariantQ[{"A""AA","A""B"},5]
In[]:=
False
Out[]=
findCanonicalCriticalPairs[{"A""AA","A""B"}]
In[]:=
{{AA,AA},{AA,B},{B,B}}
Out[]=
criticalPairConvergesQ[{"A""AA","A""B"},#,3]&/@%
In[]:=
{True,False,True}
Out[]=
MultiwaySystem[{"A""AA","A""B"},"A",5,"CriticalPairsList"]
In[]:=
Out[]=
Map[Length,%,{2}]
In[]:=
{Resolved0,Unresolved1,Resolved0,Unresolved4,Resolved3,Unresolved9,Resolved9,Unresolved24,Resolved28,Unresolved53}
Out[]=
MultiwaySystem[{"A""AB","B""A"},"A",5,"CriticalPairsList"]
In[]:=
Out[]=
Map[Length,%,{2}]
In[]:=
{Resolved0,Unresolved0,Resolved0,Unresolved1,Resolved1,Unresolved3,Resolved4,Unresolved9,Resolved13,Unresolved23}
Out[]=
#Unresolved/#Resolved&/@Map[Length,#,{2}]&[MultiwaySystem[{"A""AB","B""A"},"A",7,"CriticalPairsList"]]
In[]:=
1
0
1
0
Indeterminate,ComplexInfinity,3,,,,
9
4
23
13
55
36
124
91
Out[]=
N[%]
In[]:=
{Indeterminate,ComplexInfinity,3.,2.25,1.76923,1.52778,1.36264}
Out[]=
#Unresolved/#Resolved&/@Map[Length,#,{2}]&[MultiwaySystem[{"A""AA","A""B"},"A",7,"CriticalPairsList"]]//N
In[]:=
1
0
1
0
{ComplexInfinity,ComplexInfinity,3.,2.66667,1.89286,1.58904,1.36994}
Out[]=
Map[Length,#,{2}]&[MultiwaySystem[{"A""AA","A""B"},"A",6,"CriticalPairsList"]]
In[]:=
{Resolved0,Unresolved1,Resolved0,Unresolved4,Resolved3,Unresolved9,Resolved9,Unresolved24,Resolved28,Unresolved53,Resolved73,Unresolved116}
Out[]=
Map[Length,#,{2}]&[MultiwaySystem[{"A""AB","B""A"},"A",6,"CriticalPairsList"]]
In[]:=
{Resolved0,Unresolved0,Resolved0,Unresolved1,Resolved1,Unresolved3,Resolved4,Unresolved9,Resolved13,Unresolved23,Resolved36,Unresolved55}
Out[]=
MultiwaySystem[{"AB""AA","AB""BA"},"ABAB",4,"CriticalPairsList"]
In[]:=
Out[]=
MultiwaySystem[{"AB""AA","BA""AB"},"ABA",5,"CriticalPairsList"]
In[]:=
{Resolved{},Unresolved{{AAA,AAB}},Resolved{{AAA,AAB}},Unresolved{},Resolved{{AAA,AAB}},Unresolved{},Resolved{{AAA,AAB}},Unresolved{},Resolved{{AAA,AAB}},Unresolved{}}
Out[]=
MultiwaySystem[{"A""BB","B""A"},"A",5,"CriticalPairsList"]
In[]:=
Out[]=
TotalCausalInvariantQ[{"A""AB","AA""B"},4]
In[]:=
False
Out[]=