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[]:=
{Resolved0,Unresolved1,Resolved0,Unresolved4,Resolved3,Unresolved9,Resolved9,Unresolved24,Resolved28,Unresolved53}
Out[]=
MultiwaySystem[{"A""AB","B""A"},"A",5,"CriticalPairsList"]
In[]:=
Out[]=
Map[Length,%,{2}]
In[]:=
{Resolved0,Unresolved0,Resolved0,Unresolved1,Resolved1,Unresolved3,Resolved4,Unresolved9,Resolved13,Unresolved23}
Out[]=
#Unresolved/#Resolved&/@Map[Length,#,{2}]&[MultiwaySystem[{"A""AB","B""A"},"A",7,"CriticalPairsList"]]
In[]:=
Power
:Infinite expression
1
0
encountered.
Infinity
:Indeterminate expression 0 ComplexInfinity encountered.
Power
:Infinite expression
1
0
encountered.
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[]:=
Power
:Infinite expression
1
0
encountered.
Power
:Infinite expression
1
0
encountered.
{ComplexInfinity,ComplexInfinity,3.,2.66667,1.89286,1.58904,1.36994}
Out[]=
Map[Length,#,{2}]&[MultiwaySystem[{"A""AA","A""B"},"A",6,"CriticalPairsList"]]
In[]:=
{Resolved0,Unresolved1,Resolved0,Unresolved4,Resolved3,Unresolved9,Resolved9,Unresolved24,Resolved28,Unresolved53,Resolved73,Unresolved116}
Out[]=
Map[Length,#,{2}]&[MultiwaySystem[{"A""AB","B""A"},"A",6,"CriticalPairsList"]]
In[]:=
{Resolved0,Unresolved0,Resolved0,Unresolved1,Resolved1,Unresolved3,Resolved4,Unresolved9,Resolved13,Unresolved23,Resolved36,Unresolved55}
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[]=