Automata Demo

Initialization

Author: Klaus Sutner, sutner@cs.cmu.edu.
This notebook is available under a  Creative Commons BY-NC-SA license.
You can download and install the current version of the Automata paclet from the paclet repository by executing
PacletInstall[ResourceObject[“KlausSutner/Automata”]]
A slightly more recent version may be at  automata. 
Current paclet version:  1.0.1

Pick the appropriate version of the paclet to load.

Needs["KlausSutner`Automata"]

Needs["Automata`"]

MakeAbbrevs[]
SetImageSize[]

Turn on formatting. This is optional, but finite state machines and semigroups are often too large to be reasonably displayed in full.

FormatFA[True]
FormatSemigroup[True]
FormatEps[True]

Constructing FSMs

Basics

The expressions representing finite state machines tend to be fairly large, even for relatively small machines.  It is usually best to turn on formatting and hide details.

There are a few constructors for simple finite state machines. For finite languages the minimal automaton can be built using either a trie or the quotient construction.

{EmptyFA[Alpha[2]],UniversalFA[Alpha[2]]}

For finite languages the minimal automaton can be built using a quotient construction.
Abbreviate standard alphabet.

A2 = Alpha[2];
A2 // AlphabetList

M = FiniteLanguageFA[{"aaa","bbb","aabb"},A2,Type->"Quotient"]

LanguageFA[ M,12, SizeOnly->True ]
LanguageFA[ M,6]

By default, PlotFA prints the trim part of an automaton.

{PlotFA[M],PlotFA[ M, "Trim"->False]} // GraphicsRow

State labels are optional:

PlotFA[  M,VertexLabels->"Name",VertexSize->Medium,ImagePadding->40]

Alternatively one can build a trie. This is faster but the resulting machine is usually not minimal.

M = FiniteLanguageFA[{"aaa","bbb","aabb"},A2,Type->"Trie"]

M // PlotFA

Several commands test membership of various parameters in a semilinear set  {t,p,A,B}   where t ≥ 0 is the transient, p≥ 1 the period and A ⊆ {0,…,t-1} , B ⊆ {0,…,p-1} are subsets defining the semilinear set  A  ⋃   (t + B + p ℕ ). 
This includes in particular simple counts and modular counts. 
	- length of word
	- number of occurrences of words
	- number of occurrences of scattered subwords
Here are typical examples:

dfa = SemilinearDFA[  {3,1,{2},{}}, Alpha[2] ];
LanguageFA[ dfa, 5 ]

dfa

SemilinearDFA[ "aba", {3,1,{2},{}},Alpha[2], Type->"Factor" ];
LanguageFA[ %,6 ]

SemilinearDFA[ "aba", {3,1,{2},{}},Alpha[2], Type->"FactorNoOverlap" ];
LanguageFA[ %,6 ]

SemilinearDFA[ "aba", {3,1,{2},{}},Alpha[2], Type->"Subsequence" ];
LanguageFA[ %,6 ]

A one-letter lasso automaton.

M= SemilinearDFA[ {7,11,{2,5},{1,3}}, Alpha[1] ]

gr = PlotFA[M,VertexSize->Medium]

Another subword count, this time for scattered subsequences: 3 occurrences of aab.

M = SemilinearDFA[  "abb", {4,1,{3},{}} ,Alpha[2], Type->"Subsequence" ];

PlotFA[M ]

Verify that the subword counts are correct.

L = Flatten@LanguageFA[M, 10];
Length[L]
WordBinomial[#,"abb"]& /@ L // Union

MM = MinimizeFA[M];
MM  // PlotFA

0 mod 5 occurrences of scattered subword aab

M = SemilinearDFA[  "aab", {0,5,{},{0}}, Type->"Subsequence" ]

PlotFA[M, Type->"MultiColor"]

The machine works as advertised for words of length 6:

L = LanguageFA[ M,{6} ]
WordBinomial[#,"aab"]& /@ L
WordBinomial[#,"aab"]& /@ Complement[ Words[{6}],L ]

0 mod 3 occurrences of abb

M = SemilinearDFA[  "abb", {0,3,{},{0}}, Type->"Factor" ];

gr= PlotFA[M, Type->"MultiColor"]

For simple counts there are abbreviations:

SemilinearDFA[ "a", 3, Type->"Factor" ]
LanguageFA[ %, 6 ]

SemilinearDFA[ "a", 1,3, Type->"Factor"  ]
LanguageFA[ %, 4 ]

Fixing the letters in certain positions.

M = PositionFA[ {1,3}, {2,4}, Alpha[3] ]

M// PlotFA

LanguageFA[ M, 5 ]

We can unfold any DFA into a frontier automaton where all back transitions point to a previous location in the current branch.  Here is a mod-counter.

sl1 = SemilinearDFA[ "a",{0,3,{},{0}}, Type->"Factor" ]
sl2 = SemilinearDFA[ "b",{0,2,{},{0}}, Type->"Factor" ]

M=MinimizeFA[IntersectionFA[sl1,sl2]]
PlotFA[M,Type->"MultiColor",EdgeStyle->Thick]

And here is the periodic frontier automaton: forward transitions, backward transitions, and witnesses labeled by states.

frw = FrontierFromDFA[ M,Method->"Periodic" ];

frw = FrontierFromDFA[ M  ]

MM = FrontierToDFA[frw,FinalStateList[M]]

Table[ GatherTransitions[{(DirectedEdge[1, 1, 1]),(DirectedEdge[1, 1, 2]),(DirectedEdge[1, 3, 1]),(DirectedEdge[1, 4, 2]),(DirectedEdge[2, 5, 1]),(DirectedEdge[2, 5, 2]),(DirectedEdge[2, 6, 2]),(DirectedEdge[2, 6, 3])},EdgeLabels->opt],{opt,{None,"Single","Multi"}}]

IsomorphicQDFA[M,MM]

PlotFA[MM,Type->"MultiColor",EdgeStyle->Thick, "Trim"->False,VertexSize->Small,AspectRatio->.6]

The conversion fails when the level is not high enough.

frw = FrontierFromDFA[M,Method->"Level", Type->{3,First}]

frw = FrontierFromDFA[M,Method->"Level", Type->{4,First}]

MM = FrontierToDFA[frw,FinalStateList[M]];

G = PlotFA[MM,Type->"MultiColor","Trim"->False,EdgeStyle->Thick,
VertexCoordinates->GraphEmbedding[KaryTree[StateCount[MM],AlphabetCount[MM]]]]

Products

A simple counter automaton.

m1=SemilinearDFA[ "a", 2, Alpha[2], Type->"Factor" ]
m2=SemilinearDFA[ "b", 3, Alpha[2], Type->"Factor" ]

LanguageFA[m1,6]
LanguageFA[m2,6]

The (trim part of the) product automaton and for the minimal automaton.

m=IntersectionFA[m1,m2];
PlotFA /@ {m, MinimizeFA[m]} // GraphicsRow

The construction guarantees an accessible automaton, but co-accessibility may well fail.

m1=PositionFA["a",-3, Alpha[2]];
m2=PositionFA["b",-5, Alpha[2]];
m=IntersectionFA[m1,m2];

LanguageFA[m,6]

Two mod-counter automata.  The algorithm used for automata associated with semilinear sets produces a non-minimal machine.

m1=SemilinearDFA["a",0, 5, Alpha[2],Type->"Factor" ];
m2=SemilinearDFA["b",0, 12, Alpha[2],Type->"Factor" ];
m1 // PlotFA

And we get a larger-than-needed product automaton.

m=IntersectionFA[m1,m2];
PlotFA[m,Type->"MultiColor" ]

Minimization produces the expected torus.

PlotFA[MinimizeFA[m],Type->"MultiColor" ]

Which we can also obtain by minimizing the component automata first.

mm=IntersectionFA[MinimizeFA[m1],MinimizeFA[m2]];
PlotFA[mm,Type->"MultiColor" ]

Full Subsequence Counter

Suppose we wish to have p  occurrences of a subsequence w. Letting n = |w|, there is a natural construction using the full Cartesian product Q = (([0,p+1])^n) as state set. The transition function is  given by the recursion for word binomials.

Clear[fullSubsequenceCounterDFA]
Options[fullSubsequenceCounterDFA]={StateType->"Shallow"};
fullSubsequenceCounterDFA[ w_?WordQ,cnt_Integer,K_Alpha:$alphabet,opts:OptionsPattern[] ]:=
Module[{n,k,wi, nn, Q, mask, delta,G,fin},
k= AlphabetCount[K];
wi=ToIndex[w,K];
n=Length[wi];
Q=Tuples[Range[0,cnt+1],n];mask[i_]:=mask[i]=ToBitVector[Flatten[Position[wi,i]],Range[n]];delta[pv_,a_]:=(Min[#1,cnt+1]&)/@(pv+Most[Prepend[pv,1] Append[mask[a],0]]);
G = Graph[Q,Flatten@Table[ DirectedEdge[ pv,delta[pv,a],a], {pv,Q},{a,k} ]];
fin=PositionList[ Q, Cases[Q,{___,cnt}] ];
FA[ TSys[ (cnt+2)^n, k, G, K, <|"TransType"->"DFA"|>], 
		<|"AccCond"->Existential[{1},fin]|> ]
];

M = fullSubsequenceCounterDFA[ "abb",3, Alpha[2] ];

PlotFA[ M,  VertexLabels->Thread[StateList[M]->(StringifyList[#,"Fill"->":"]&/@StateList[M])]]

LanguageFA[ M, 12, SizeOnly->True ]

LanguageFA[ M,6  ]
WordBinomial[#,"abb"]& /@ Flatten[%]

Permutation Alphabets

A symmetric group acting on itself: the alphabet is the whole group.

K = GroupElements@SymmetricGroup[3]

Clear[del]
del[s_Integer][ p_Cycles] := PermutationProduct[ p, K[[s]] ]

m = GenerateFA[ Cycles[{}], Table[ Evaluate[del[s]], {s,6} ],Alpha[6,Type->"Digit"],#===Cycles[{}]&, Type->"DFA" ]

PlotFA[ m,Type->"MultiColor", EdgeStyle->Thick ]

Using 2 generators.

K = {Cycles[{{1,2}}],Cycles[{{2,3}}]}

Clear[del]
del[s_Integer][ p_Cycles] := PermutationProduct[ p, K[[s]] ]

m = GenerateFA[ Cycles[{}], Table[ Evaluate[del[s]], {s,2} ],Alpha[2,Type->"Digit"],#===Cycles[{}]&, Type->"DFA" ]

PlotFA[ m,Type->"MultiColor", EdgeStyle->Thick ]

K = {Cycles[{{1,2}}],Cycles[{{1,2,3}}]}

Clear[del]
del[s_Integer][ p_Cycles] := PermutationProduct[ p, K[[s]] ]

m = GenerateFA[ Cycles[{}], Table[ Evaluate[del[s]], {s,2} ],Alpha[2,Type->"Digit"],#===Cycles[{}]&, Type->"DFA" ]

PlotFA[ m,Type->"MultiColor", EdgeStyle->Thick ]

Group Languages

Consider all elements of a permutation group as words, try to understand the growth rate of the state complexity of the associated finite languages. 

The full symmetric group is easy.

Table[  With[ {L = PermutationList[#,k]& /@  GroupElements@SymmetricGroup[k]},
StateCount@MinimizeFA@FiniteLanguageFA[ ToWord[L,Alpha[k]], Alpha[k] , Type->"Quotient" ]] , {k,7} ]
FindSequenceFunction[%,x]

But the alternating group is a bit strange.

Table[  With[ {L = PermutationList[#,k]& /@  GroupElements@AlternatingGroup[k]},
StateCount@MinimizeFA@FiniteLanguageFA[ ToWord[L,Alpha[k]], Alpha[k] , Type->"Quotient" ]] , {k,7} ]
sf = FindSequenceFunction[%,x]

Dihedral groups:

Table[  With[ {L = PermutationList[#,k]& /@  GroupElements@DihedralGroup[k]},
		StateCount@FiniteLanguageFA[ ToWord[L,Alpha[k]], Alpha[k] , Type->"Quotient" ]] , {k,3,10} ]
FindSequenceFunction[%,x]

M= With[ {L = PermutationList[#,6]& /@  GroupElements@DihedralGroup[6]},
		FiniteLanguageFA[ ToWord[L,Alpha[6]], Alpha[6] , Type->"Quotient" ]];

PlotFA[ M,Type->"MultiColor", EdgeStyle->Thick  ]

And some Abelian groups.

Table[  With[ {L = PermutationList[#,8+k]& /@  GroupElements@AbelianGroup[{3,5,k}]},
		StateCount@FiniteLanguageFA[ ToWord[L,Alpha[8+k]], Alpha[8+k] , Type->"Quotient" ]] , {k,3,10} ]
FindSequenceFunction[%,x]

Apropos nothing, a pretty picture.

tab = PermutationList[#,14]& /@ GroupElements@AbelianGroup[{5,4,3,2}] // Thread;
ListPlot[ tab, Joined->True,Mesh->All,MeshStyle->Directive[GrayLevel[0.6],Large], Axes-> False, Frame->True, FrameTicks->None, PlotStyle->Thick ]

(n,k)-DFAs

Tally Automata

Construct all minimal (n,1) automata. 
Finals states on limit cycle are primitive, predecessor of base point must be xor final.

Code

Primitive bitvectors of length n.

prims[n_Integer?Positive] := 
With[ {tups = Tupeln[2,{n}]-1},
Select[tups,  
With[ {per= Length[FindRepeat[#,2]]},!(per >0  && Mod[n,per]==0) ]& ] ];

Convert parameters t,p,F to a DFA.

finToDFA[t_Integer?NonNegative,p_Integer?Positive,fin_List ] := 
FA[ TSys[ t+p,1,
Graph[Table[ DirectedEdge[s,TransientMod[s+1,t,p],1], 
{s,0,t+p-1}] ], Alpha[1], <|"TransType"->"DFA"|>], 
<|"AccCond"->Existential[{1},fin+1]|>]

Construct all possible DFAs for given n; wrapper for version depending on t and p.

construct[n_Integer?Positive]:= 
Table[ construct[ t, n-t], {t,0,n-1} ]

construct[t_Integer?NonNegative,p_Integer?Positive]:= 
Module[ {tp,prm,trans0,trans1,prm0,prm1},
tp = t + p;
prm= Pick[ Range[t,tp-1],#,1]& /@ prims[p];

(* t=0 use all primitive finals state sets *)
If[ t==0, 
Return[ finToDFA[t,p,#]& /@ prm]];

(* separate on membership  t-1 versus T-1  in transient/periodic part *)
trans0 = DeleteCases[ PowerSet[Range[0,t-1]], {___,t-1} ];
trans1 = Cases[ PowerSet[Range[0,t-1]], {___,t-1} ];
prm0 = DeleteCases[ prm, {___,tp-1}];
prm1 = Cases[ prm, {___,tp-1}];
Join[ finToDFA[t,p,#]& /@ (Flatten/@CartesianProduct[trans1,prm0]),
finToDFA[t,p,#]& /@ (Flatten/@CartesianProduct[trans0,prm1])
]
];

Small n

aut= construct[5]; 
aut // LengthLength
aut = Flatten[aut];
mm = Length[aut]

A = LanguageFA[ #, mm, SizeOnly->True ]& /@ aut;

AA = SortBy[ A, Length@Last@FindTransientRepeat[ #,2]& ];

PlotMatrix[AA]

Check by direct counting.

Clear[primCount,minCount]
primCount[1]= 2;
primCount[n_Integer?Positive] := 
Sum[   MoebiusMu[n/d]2^d, {d,Divisors[n]} ];
minCount[n_Integer?Positive] := 
primCount[n] +  Sum[ 2^(t-1) primCount[n-t], {t,n-1}];

minCount/@Range[20]

(3,2)-DFAs

For larger alphabets we need to keep the number of states small.  Here are all (3,2) transition matrices.  This is brute-force, we make no attempt to filter out isomorphic machines.

mats = Partition[#,2]& /@CartesianProduct[3,3,3,3,3,3];
mats // Length

To avoid trivial cases, only allow proper final state sets.  This time there are 4374 machines.

fins = Most@Rest@PowerSet[Range[3]]

dfas = Flatten@Table[ 
FA[TSys[3,2,Graph[Range[3],MatrixToTransitions[A]],Alpha[2],
<|"TransType"->"DFA"|>], <|"AccCond"->Existential[{1},F]|> ], {A,mats}, {F,fins} ];
dfas // Length
dfas // ByteCount

We minimize all the automata. This should take some 10 seconds.

class = GatherBy[ dfas, MinimizeFA ]; // AbsoluteTiming

class // Length
Length /@ class // Frequencies

For the small equivalence classes one can verify equivalence by visual inspection.

c44 = Select[ class,Length[#]==6& ][[1]];

PlotFA[#,VertexSize->Medium]& /@ c44 // Partition[#,3]& //GraphicsGrid

ToClasses[ c44, EquivalentQFA, Type->"Relation" ] // LengthLength

The machines in this class are all non-isomorphic.

ToClasses[ c44, IsomorphicQDFA, Type->"Relation" ]
% // Length

There are 2056 machines that require 3 states.

sc3 = Select[ dfas, StateCount[MinimizeFA[#]]==3&  ]; // AbsoluteTiming
sc3 // Length

RandomChoice[sc3]

Determinization

kth Symbol

An NFA checking for symbols from the end:

M = PositionFA[ "a", -4, A2 ];
M // PlotFA

The corresponding DFA is based on a de Bruijn graph.

MM = DeterminizeFA[ M ]
G = PlotFA[ MM, Type->"MultiColor" ]

dB= Annotate[ DeBruijnGraph[2,4], GraphLayout->"SpringElectricalEmbedding"]

Remove labels for isomorphism test.

H = IndexGraph@Graph[ Most /@ EdgeList[TransitionSystemGraph[MM]]];
FindGraphIsomorphism[dB,H]

Checking the language and the growth function.

LanguageFA[MM,5]
LanguageFA[MM,16, SizeOnly->True ]
GrowthFunctionDFA[MM,x]

Of course, the machines are equivalent.

EquivalentQFA[ M, MM ]

All subsets of [5] that contain 1 appear in the accessible part of the power automaton.

DeterminizeFA[ M, StateType->"Shallow" ];
StateList[%]

This suggests a blow-up from n to (2^(n-1)).

Table[  With[ {M= PositionFA["a",-k, A2 ]},
	StateCount [{ M, DeterminizeFA[M]}]], {k,10} ] // TableForm

Follow Languages

Double sling automata of type:   (SuperStar[Σ]) a  (Σ^( n)) b  (SuperStar[Σ]) ⋃ (SuperStar[Σ]) b  (Σ^( n)) a  (SuperStar[Σ]).
Here is n=3.  
Some abbreviations to help with the construction of the regular expressions.

ab = REP["a","b"];
Clear[REPower]
REPower[exp_,0]=Eps;
REPower[exp_,nn_Integer]:=RET@@Table[exp,{nn}];

With[ {n=3},
	exp1=RET[RES[ab],"a",REPower[ab,n],"b",RES[ab]];
	exp2=RET[RES[ab],"b",REPower[ab,n],"a",RES[ab]] 
];
m=RegexToFA[REP[exp1,exp2],Alpha[2]]

The NFAE clearly grows linearly with n.

PlotFA[ m,  Type->"MultiColor", EdgeStyle->Thick ]

But the deterministic machines blow up.

m // DeterminizeFA 
mm= % // MinimizeFA

PlotFA[ %,  Type->"MultiColor" ]

Brzozowski Universal

A DFA based on a circulant automaton that demonstrates maximal blow-up under reversal. We could perform surgery on a circulant, but it is also straightforward to construct the machine from scratch.

ClearAll[BrzozowskiUniveralDFA]
BrzozowskiUniveralDFA[n_Integer]:=With[{tr =Join[ Table[ DirectedEdge[p,Mod[p+1,n,1],1], {p,n} ],
 { DirectedEdge[1,2,2], DirectedEdge[2,1,2]},Table[ DirectedEdge[p,p,2], {p,3,n} ],
Table[ DirectedEdge[p,p,3], {p,n-1} ], {DirectedEdge[n,1,3]}]},
FA[TSys[n,3, Graph[Range[n],tr],Alpha[3],<|"TransType"->"DFA"|>],
<|"AccCond"->Existential[{1},{n}]|> ]]

m=BrzozowskiUniveralDFA[6];
PlotFA[m, VertexSize->Small]

The language is slightly complicated:

LanguageFA[m,6]

LanguageFA[m,14,SizeOnly->True]

The machine as constructed is minimal.

m // MinimizeFA // StateCount

And the reversal blows up …

mm=DeterminizeFA[ReverseFA[m]]

PlotFA[mm, Type->"MultiColor"]

The power automaton produced by determinization is already minimal.

mm // MinimizeFA // StateCount

A few examples:

Table[  With[ {M= BrzozowskiUniveralDFA[k]},
	StateCount [{ M, DeterminizeFA[ReverseFA[M]]}]], {k,2,10} ] // TableForm

Zigzags

Code

Constructions of minimal NFAs that demonstrate exponential blow-up during conversion to the minimal DFA. 

A permutation semiautomaton produces no blow-up whatsoever during determinization: there is only one super state. However, small changes to a permutation automaton often produce large deterministic machines.

It is easy to construct all possible permutation automata on a given directed graph G, disregarding isomorphism.   We require G to be  (2,2)-regular. Standard examples are circulants and de Bruijn graphs.  In a permutation labeling, a single label on some edge e determines the labels in the whole zigzag containing e.  A zigzag here is a cycle with alternating forward and backward edges. It is easy to see that G can be uniquely  decomposed into edge-disjoint zigzag components.

Switching Labels

A little helper function that switches the label of a transition.
For auto-switch assumes alphabet size 2.

ClearAll[switchTransition]
switchTransition::badtrn = "No such transition, returning input.";
 switchTransition[ tr_List, {p_,q_} ] := switchTransition[tr,p,q];
 switchTransition[ tr_List, p_,q_,a_,b_ ] := 
With[ {pos = Position[tr, DirectedEdge[p,q,a]]},
	If[ pos==={}, 
	Message[switchTransition::badtrn];
	Return[tr]];
	ReplacePart[ tr, pos[[1,1]]-> DirectedEdge[p,q,b] ] ] ;
 switchTransition[ tr_List, p_,q_ ] := 
With[ {pos = Position[tr, DirectedEdge[p,q,_]]},
	If[ pos==={}, 
	Message[switchTransition::badtrn];
	Return[tr]];
	With[ {a = tr[[pos[[1,1]],-1]]},
	ReplacePart[ tr, pos[[1,1]]-> DirectedEdge[p,q,3-a] ] ] ] ;
switchTransition[ M_?FSMQ, args__ ] := 
Module[ {tr,typ,MM},
tr = switchTransition[TransitionList[M],args ];
typ = TransitionType[ StateCount[M], AlphabetCount[M], Graph[tr] ];
MM = ReplacePart[ M, {1,3}->Graph[StateList[M],tr] ];
SetTraits[ MM, "TransType"->typ]
 ];

Zigzag Decomposition

Decompose a (2,2)-regular graph into zigzags; edges can be labeled. 
Repeatedly construct the unique zigzag starting at u (remove edges along the way).

ClearAll[zigzagDecomposition]
zigzagDecomposition[M_?FSMQ] := zigzagDecomposition[TransitionSystemGraph[M]];
zigzagDecomposition[G_?GraphQ] := 
Module[{alleds,zigzag},
If[ Union[Join[VertexInDegree[G],VertexOutDegree[G]]]=!={2}, 
Return[$Failed]];
(* construct zigzag starting at u *)
zigzag[uu_]:=  
Block[{src,trg,fe,be,eds,zz,cnt},
zz = {};
src= uu;  cnt=0;
While[ (eds = Select[alleds,First[#]==src& ])=!={} && cnt++<500,
fe =First[eds];        (* forward edge with source src *)
alleds = DeleteCases[alleds,fe];
trg = fe[[2]];
be =First@Select[alleds,#[[2]]==trg& ]; (* backward edge with target trg *)
alleds = DeleteCases[alleds,be];
zz = Join[zz,{fe,be}];
src= First[be]             (* update src *)
];
zz
];
alleds = EdgeList[G];
Reap[  While[ alleds =!= {},
	Sow[ zigzag[alleds[[1,1]]] ] ] ][[-1,-1]] 
];

ClearAll[labelZigzags]
labelZigzags[ Z:{__List}, lab_List ] := 
With[{ZZ = Map[ Take[#,2]&, Z, {2} ]},
TransitionsSort@Flatten[auxLabelZigzag@@@Pairs[ZZ,lab]] ];
labelZigzags[  Z:{__List}, b_Integer ] := labelZigzags[ Z, IntegerDigits[b,2,Length[Z]] ];
auxLabelZigzag[zz_List,b_Integer] := 
Append@@@Pairs[zz,Mod[ b+Range[0,Length[zz]-1],2]+1];

buildsa[G_?GraphQ] := 
With[ {n = VertexCount[G]},
FA[ TSys[ n,2,G,Alpha[2],<|"TransType"->TransitionType[n,2,G]|>],
<|"AccCond"->Existential[All,All]|>] ]

Examples

Circulants

Different numbers of zigzags  ( gcd(n,(Subscript[d, 1])-(Subscript[d, 2])) in general).

n = 12;
M = CirculantFA[ n, {0,1}, Labels->{Table[1,{n}],Table[2,{n}]} ];
zigzagDecomposition[M]
% // LengthLength

n = 12;
M= CirculantFA[ n, {-1,1}, Labels->{Table[1,{n}],Table[2,{n}]} ];
zigzagDecomposition[M]
% // LengthLength

n = 12;
M = CirculantFA[ n, {1,5}, Labels->{Table[1,{n}],Table[2,{n}]} ];
zigzagDecomposition[M]
% // LengthLength

De Bruijn

G = DeBruijnGraph[2,3];
Annotate[ G, VertexLabels->Automatic]

Random

Construct a random (2,2)-regular graph and its zigzag decomposition.

nn=12;
V = Range[nn];
ed= Join[ Thread[DirectedEdge[ V, RandomSample[V],ConstantArray[1,nn]]],
Thread[DirectedEdge[ V, RandomSample[V],ConstantArray[2,nn]]] ];
H = Graph[V,ed];
ZZ = zigzagDecomposition[H]
HighlightGraph[ Annotate[ H, {VertexLabels->Automatic,EdgeStyle->Thick} ],ZZ ]

edg = Most@RandomChoice[EdgeList[H]]

G= Graph[ Range[12], switchTransition[labelZigzags[ ZZ,0 ],Sequence@@edg]];
buildsa[G] // DeterminizeFA // StateCount

Search through possible permutation labelings only up to isomorphism.
This will take a bit.

edprs = List@@@(Most/@EdgeList[G]);
res = Table[ Frequencies@Table[ StateCount[DeterminizeFA[ buildsa[ Graph[ Range[12], switchTransition[labelZigzags[ ZZ,b ],e]]]]], {e,edprs} ],
{b,0,2^(Length[ZZ]-1)-1} ]; // AbsoluteTiming
res // TF2

Function[c,{c[[1,1]],Total[Last/@c]}]/@GatherBy[ FlattenOne[res], First ] // Sort // TF2

Minimal NFAs and Blow-Up

Constructions of minimal NFAs that demonstrate exponential blow-up during determinization and minimization.

plotfa = PlotFA[#, Type->"MultiColor",EdgeStyle->Thick, VertexSize->Medium ]&;

Iwama, Matsuura, Paterson

Construction of minimal NFAs that demonstrate exponential blow-up during determinization and minimization.

NFA:   n	DFA:  (2^( n))-α

The following requires 7 <= n and 5 <= α <= 2n - 2.  The other parameters are just for notational convenience.

n=11;
α=8;
k=α-1;
m=n-k;
5≤α<2n-2&&GCD[n,k]==1

Construct a set of taps at which non-deterministic transitions occur.

A=With[{r=Ceiling[(k/4)]},If[EvenQ[k],Join[Range[3,2 r,2],Range[2 r,k-4,2]],Range[3,k-4,2]]]

The state set is based on two kinds of states: 
	(Subscript[t,  i])->  { 0,i }	and		(Subscript[s,  i])-> { 1,i }.

ClearAll[next0,next1]
next0[{0,i_}]:={{0,Mod[i+1,k]}};
next0[{1,i_}]:={{1,Mod[i+1,m]}};
next1[{0,2}]:={{1,0}};
next1[{0,i_}]:=If[MemberQ[A,i],{{0,i},{0,0}},{{0,i}}]/;i≠2;
next1[{1,0}]:={{1,1}};
next1[{1,1}]:={{0,0},{0,2}};
next1[{1,i_}]:={{1,i}}/;i≥2;

Build the corresponding transition system by a closure operation.

{Q,tr}=Closure[{{0,0},{1,0}},{next0,next1},Cayley->True,InitialSet->True,SetClosure->True]
Length[Q]

GatherBy[ Q, First ] // TF2

The corresponding nondeterministic machine.

m=FA[ TSys[ Length[Q],2,Graph[Q,tr],Alpha[2] ,<|"TransType"->"NFA"|>],<|"AccCond"->Existential[{1},{1}]|> ]

PlotFA[ m, Type->"MultiColor" ]

Determinization produces nearly full blow-up.

mm = DeterminizeFA[m];
mm // StateCount
StateCount[mm]==(2^n)-α

The missing states in the power automaton.

Complement[ PowerSet[Range[n]], StateList[mm] ]

Annotate[ TransitionSystemGraph[m], VertexLabels->Automatic]

The DFA is already minimal.

mm // MinimizeFA // StateCount

Moore

NFA:   n	DFA: (2^( n))
A classical example by Moore.  Note that full exponential blow-up of the minimal DFA automatically guarantees minimality of the NFA:  the number of distinct behaviors in any smaller NFA would be insufficient.

First the deterministic version of the transitions.

n = 8;
tr = TransitionsSort[ DirectedEdge@@@Join[ Pairs[Range[n],Join[{1},RotateLeft[Range[2,n]]] ,Table[1,{n}]], 
 Pairs[Range[n],RotateLeft[Range[n]],Table[2,{n}]] ] ]

G = Graph[ Range[n], tr ];
ZZ = zigzagDecomposition[G]
HighlightGraph[G,ZZ]

Then switch the label of one transition and build the corresponding NFA.

tr = switchTransition[tr,8,1]

M= FA[ TSys[ n,2, Graph[Range[n],tr],Alpha[2],<|"TransType"->"NFA"|>],<|"AccCond"->Existential[ {1},{n}]|> ];
Annotate[ M// plotfa, VertexLabels->Automatic ]

DeterminizeFA[m];
% // StateCount
%% // MinimizeFA // StateCount

It is easy to see that the corresponding semiautomaton also works.

sa= SetInitialFinal[M,All,All]

MinimizeFA[sa] // StateCount

Jiraskova

NFA:   n	DFA:   (2^( n))
A machine with a much higher degree on nondeterminism.

Clear[JiraskovaFA]
JiraskovaFA[n_]:=
Module[{next0,next1,Q,tr},
next0[n]={};next1[n]={};next0[i_]:={1,i+1}/;i<n;next1[i_]:={i+1}/;i<n;{Q,tr}=Closure[ 1,{next0,next1},Cayley->True,SetClosure->True ];
FA[ TSys[ Length[Q],2,Graph[tr],Alpha[2],<|"TransType"->"NFA"|>],<|"AccCond"->Existential[ {1},{n}]|> ]
];

All states except the last are nondeterministic.
The NFA has full blow-up and produces a reduced DFA.

MinimizeFA[JiraskovaFA[6]] // StateCount

But the corresponding semiautomaton fails miserably: the DFA is still large, but minimization collapses the machine.

M =  JiraskovaFA[8];
M =  SetInitialFinal[ M, All, All ];
M // DeterminizeFA // StateCount
M // MinimizeFA // StateCount

Note the diagram of the minimal automaton.

M // MinimizeFA // plotfa

Circulants

NFA:   n	DFA: (2^( n))
Moore's example generalizes to 1-permutation automata:  start with a transitive permutation automaton and change the label at a self-loop. 

An example starting with a circulant graph  C(n;0,1):  label the offset 0 edges by a, and the offset 1 edges by b, producing a permutation automaton.  Then switch the label of the self-loop at state 1.

n = 8;
m = CirculantFA[ n, {0,1}, Labels->{Table[1,{n}],Table[2,{n}]} ];
PlotFA[ m,Type->"MultiColor", EdgeStyle->Thick]

Switching a self-loop.

mm = switchTransition[m,8,8]
mm // MinimizeFA // StateCount

mmm = DeterminizeFA[mm];

gr = plotfa[mmm]

Changing the label at a stride-1 edge produces less blow-up.

mm = switchTransition[m,1,2];
mm // MinimizeFA // StateCount

A similar class of examples: we use a circulant graph  C(n;1,d)  where 1 < d < n.  Label as before, then switch the label of the transition (1,a,2).

n = 8;
m = CirculantFA[ n, {1,2}, Labels->{Table[1,{n}],Table[2,{n}]} ];
PlotFA[ m,Type->"MultiColor", EdgeStyle->Thick]

mm=switchTransition[m,1,2];
mm//MinimizeFA//StateCount

There is a slight dependency on the parity of n.

Table[  With[ {m = CirculantFA[ n, {1,2}, Labels->{Table[1,{n}],Table[2,{n}]} ]},StateCount[ DeterminizeFA[switchTransition[ m, 1,2 ] ] ] ], {n,2,10} ]

Incidentally, all the power automata are already reduced.

Table[  With[ {m = CirculantFA[ n, {1,2}, Labels->{Table[1,{n}],Table[2,{n}]} ]},StateCount[ MinimizeFA[switchTransition[ m, 1,2 ]  ] ] ], {n,2,10} ]

Another example with strides 1 and 3:

Table[  With[ {M= CirculantFA[n,{1,3},Labels -> {Table[1,{n}],Table[2,{n}]}]},
With[ {MM =  DeterminizeFA[switchTransition[M,1,2]]}, {StateCount [M],StateCount[MM],2^StateCount[M]-StateCount[MM]} ]] , {n,3,12} ] // TableForm

There is a clear modulo-3 pattern, but it is difficult to prove that the state complexity behaves as observed in these examples.  Here are the missing subsets for n= 9.

With[ {M= CirculantFA[9,{1,3},Labels -> {Table[1,{9}],Table[2,{9}]}]},
MM = DeterminizeFA[switchTransition[M,1,2],StateType-> "Shallow"] ;
Complement[ PowerSet[Range[9]], StateList[MM] ] ] // Column

Minimization

De Bruijn

Constructing a de Bruijn automaton from scratch: state set is Q = ((Σ )^( <= k)).

ClearAll[deb]
deb[a_String,k_Integer?Positive][s_String] := If[StringLength[s]<k, StringJoin[s,a],StringJoin[StringDrop[s,1],a]];

M = GenerateFA[ "",  {deb["a",4],deb["b",4]}, Alpha[2],StringLength[#]==4&& StringTake[#,1]=="b"&, Type->"DFA", StateType->"Shallow" ]

The automaton is a tree grafted on top of a de Bruijn graph.

gr = PlotFA[M,Type->"MultiColor"];
Annotate[ gr, GraphLayout->"HighDimensionalEmbedding" ]

Incidentally, the same machine can be obtained via the transformation automaton of the de Bruijn automaton.

PositionFA["a",-4,Alpha[2]] // DeterminizeFA 
% // TransformationDFA 
PlotFA[ %, Type->"MultiColor"];
Annotate[ %, GraphLayout->"HighDimensionalEmbedding" ]

The machine behaves properly: it accepts all strings x such that (Subscript[x, -4])= b.

LanguageFA[ M, 5  ]
LanguageFA[ M, 12, SizeOnly->True ]

But minimization smashes the tree part down into the de Bruijn automaton; we only need 16 states.

MM = MinimizeDFA[ M, StateType->"Indexed" ];
MM // StateCount

This can also be seen from the cover map from M to M M.

CoverQDFA[ M, MM , DoTrace->True ]

Here is the same de Bruijn automaton generated by a regex.

MMM = MinimizeFA@RegexToFA[  RET[RES[REP["a","b"]],"b",REP["a","b"],REP["a","b"],REP["a","b"] ], Alpha[2] ];

PlotFA[ MMM,  Type->"MultiColor" ]

Again, the cover map.

CoverQDFA[ M, MMM , DoTrace->True ]

GatherBy[  Last[%], Last ] // TF2

All the machines are duly equivalent.

LanguageFA[ M,8 ]===LanguageFA[MM,8 ]===LanguageFA[MMM,8 ]

LanguageFA[ M,12, SizeOnly->True ]===LanguageFA[MM,12, SizeOnly->True ]===LanguageFA[MMM,12, SizeOnly->True ]

EquivalentQFA[ M, MMM ]

The machine M from above has a structured state set:

M = GenerateFA[ "",  {deb["a",4],deb["b",4]}, Alpha[2],StringLength[#]==4&& StringTake[#,1]=="b"&, Type->"DFA", StateType->"Shallow" ];
M // StateList

The structure can be preserved under minimization.  This can be helpful to understand the structure of a machine.

Table[ StateList@MinimizeFA[M,StateType->tp], {tp,{"Indexed","Shallow","Deep"}} ] // Column

A Slow Case

Here is an example where Moore’s standard minimization algorithm performs poorly (no, not the usual simple path).

m1=DeterminizeFA[RegexToFA[ RET[RES[REP["a","b"]],"aabaabaab"],Alpha[2]]]

PlotFA[ m1, VertexSize-> Medium ]

{m2,{t2}}=MinimizeDFA[m1,DoTrace->True] // Reap

Grid[t2,Spacings->2,Background->LightYellow, Frame-> All, FrameStyle->GrayLevel[0.8]  ]

Brzozowski Minimization

Somewhat surprisingly, minimization can be accomplished by reversing and determinizing twice.

m0 = PositionFA[ "a", -5, Alpha[2] ];
m1 = ReverseFA[m0];
m2 = DeterminizeFA[m1];
m3 = ReverseFA[m2];
m4 = DeterminizeFA[m3];
StateCount[{m0, m1, m2, m3, m4}]

mm=MinimizeFA[m0];
IsomorphicQDFA[mm,m4]

Random

Generating a random DFA, brute force and ignoring all finer points.

nn = 20;
{Q,tr} = Closure[  1, Table[RandomInteger[{1,nn}]&,{2}], Cayley->True ];
q = Max@VertexOutComponent[Graph[tr],1];
M = FA[  TSys[ nn, 2,Graph[Range[nn],tr], Alpha[2],<|"TransType"->"PDFA" |>], <|"AccCond"->Existential[{1}, {q}] |> ]

With high probability, the machine is not far from being minimal.

GraphicsRow[ PlotFA[  #,  Type->"MultiColor" ]& /@{M, MinimizeFA[M]} ]

checkMinimal[n_Integer] := 
Module[{Q,tr,q,M},
{Q,tr} = Closure[  1, Table[RandomInteger[{1,n}]&,{2}], Cayley->True ];
q = Max@VertexOutComponent[Graph[tr],1];
M = FA[  TSys[ n, 2,Graph[Range[n],tr], Alpha[2],<|"TransType"->"PDFA" |>], <|"AccCond"->Existential[{1}, {q}] |> ];
StateCount[{M,MinimizeFA[M]}]
];

tab = Sort@Table[  checkMinimal[100] , {50} ]; // AbsoluteTiming

ListPlot[ Thread@tab, PlotStyle->PointSize[Large]]

Sample Languages

Forbidden Factors

Let L be the the language of all words not containing any of the factors   aaa, aba, bab, bbb  over the two-letter alphabet Σ = {a,b}.   We construct the minimal DFA for L  using  ConcatenateFA.

A2=Alpha[2];
all=UniversalFA[A2]

With[{m0=FiniteLanguageFA[{"aaa","bbb","aba","bab"},A2,Type->"Quotient"]},m=MinimizeFA[ComplementFA[ConcatenateFA[all,m0,all]]]]

Table[  {p,PropertyQFA[ m,p ]}, {p,PropertyQFA[]} ]  // TableForm

SetProperty[ PlotFA[m],GraphLayout->"TutteEmbedding"]

The growth function appears to be eventually constant.

LanguageFA[m,20,SizeOnly->True]

Which fact we can verify via the generating function and some simplification of infinite series.

Clear[x]
gs=GrowthFunctionDFA[m,x]

Series[gs,{x,0,10}]

A complete proof (assuming we trust Simplify and GrowthFunctionDFA).

Simplify[gs==1+2 x+4 (∑_(i=2)^∞)(x^i)]

The complement  (SuperStar[Σ])- L  clearly is an ideal.

all = UniversalFA[ A2 ] ;
mc = ComplementFA[m];
ConcatenateFA[all,mc,all]
EquivalentQFA[ %, mc ]

We compute a DFA accepting a base for this ideal. Clearly, the DFA has a finite language.

LanguageFactorFA[ mc, Type->"MinimalFactor" ]

% //PlotFA

The whole cover language consists of all factors of the infinite word  (((aabb))^( ω)).

EnumFormZero[LanguageFA[m,12]]

Even Unequal

Consider the language of words of length 2n containing an a b or b a in an even position: 
	(Subscript[L,  n]) =  { u  s t v |  |u| even ∧  s≠t  ∈ {a,b}  } ⊆ (({a,b})^(2n)).

Claim:  The minimal DFA for  (Subscript[L,  n])  has  5n  states.

Note that the languages (Subscript[L, n]) are quite large, so a brute force construction of the automata will fail for relatively small n.

ue = {"ab","ba"};buildLn[n_Integer?Positive] := Union@Flatten@Table[ Concatenate@@@CartesianProduct[  Words[{2i}], ue, Words[{2n-2i-2}] ], {i,0,n-1} ];

buildLn[3]

Table[ Length[buildLn[n]], {n,6} ]

unequal2[ n_Integer]:=
FiniteLanguageFA[ buildLn[n],Alpha[2],Type->"Quotient"];

M = unequal2[4];
M // PlotFA

Table[ StateCount[unequal2[n]], {n,6} ]

UnEqual

Consider the language (Subscript[L, n]) of unequal strings of length 2n:

	(Subscript[L,  n]) =  { u v |  |u|=|v| = n  ∧  u≠v  } ⊆ (SuperStar[{a,b}]).
	
Claim:  The state complexity of  (Subscript[L,  n])  is  3·(2^n)+ n - 2. 

First a brute-force construction of the minimal DFA via the quotient automaton, see QuotientDFA.  Note that the cardinality of (Subscript[L,  n]) is (2^( 2n)) - (2^( n)), so we have to constrain our experiments to reasonably small values of n.

A2 = Alpha[2];
unequal[n_Integer]:=With[{L=Words[{n}]},FiniteLanguageFA[ StringJoin/@DeleteCases[CartesianProduct[L,L],{x_,x_}],A2, Type->"Quotient"]];

We verify that the claim holds for n ≤ 6 (we have removed the sink from the automata).

Table[StateCount[unequal[n]],{n,6}]
% === Table[3 (2^n)+n-2,{n,6}]

Here is a closer look at n = 3.   It is convenient to remove the sink.

m=unequal[3];
m // PlotFA

The structured state set here consists of quotients of the original unpalindrome language.

Q = StateList[m]
Q // Length

Here are some simple tests.

ClearAll[killfirst]
killfirst[a_String][_?EpsQ] := Nothing;
killfirst[a_String][w_String] := 
If[ StringTake[w,1]===a, StringDrop[w,1], Nothing ];
killfirst[a_String][L_List] := killfirst[a] /@ L;

killfirst["a"][Q[[1]]]
Position[Q,%]

killfirst["b"][Q[[1]]]
Position[Q,%]

Closure[  Q[[1]], {killfirst["a"],killfirst["b"]} ]  // Length

Clearly, the states in the quotient automaton for (Subscript[L, n]) are organized in layers where states at layer k are of the form P ⊆ (Σ^( 2n-k)) and transitions lead from layer k to layer k+1 (except for the sink).  In fact,  the first n layers form full binary tree since the behaviors of these states are necessarily distinct.  
In general, there is a leaf x  corresponding to (Σ^n)-{x} for each word x ∈ (Σ^( n)).   So the first tree accounts for (2^(n+1))-1 states.  The remainder of the machine has two kinds of states: those where a witness for inequality of u and v has already been found, and those where we are still waiting for such a witness.

AssignTransitionFunction[δ,m]

Table[ {ToWord[w,A2],LanguageFA[ SetInitial[m,{δ[1,w]}], {2} ]},{w, Tuples[{1,2},4]} ]   // GatherBy[#,Last]&  // TF2

More precisely, the first type is of the form  δ((Subscript[q, 0]),u x)  where x is not a prefix of u ∈ (Σ^( n)) has behavior (Σ^(2n-|u x|)) and the second type is of the form  δ((Subscript[q, 0]),u x)  where x is a prefix of u ∈ (Σ^( n)) and has behavior (Σ^(2n-|u x|))-{y}  where u = x y. But then there are n states of the first type, and (2^n)-1 states of the second type (these form another tree which is upside-down compared to the first, and has as root the sink of the DFA).

UnPalindrome

Consider the language (Subscript[L, n]) of non-palindromes of length 2n:

	(Subscript[L,  n]) =  { u v |  |u|=|v| = n  ∧  u≠(v^op)  } ⊆ (SuperStar[{a,b}]).
	
Claim:  The state complexity of  (Subscript[L,  n])  is  3·(2^n)+ n - 2. 

This is the same as the UnEqual language from above.

A2 = Alpha[2];
unpalindrome[n_Integer]:=With[{L=Words[{n}]},FiniteLanguageFA[ StringJoin/@Select[CartesianProduct[L,L],#[[1]]=!= StringReverse[#[[2]]]&],A2, Type->"Quotient"]];

We verify that the claim holds for n ≤ 6 (we have removed the sink from the automata).

Table[StateCount[unpalindrome[n]],{n,6}]
% === Table[3 (2^n)+n-2,{n,6}]

Here is a closer look at n = 3.   It is convenient to remove the sink.

m=unpalindrome[3];
m // PlotFA

The structured state here consists of quotients of the original unpalindrome language.

Q = StateList[m]
Q // Length

Here are some simple tests.

ClearAll[killfirst]
killfirst[a_String][_?EpsQ] := Nothing;
killfirst[a_String][w_String] := 
If[ StringTake[w,1]===a, StringDrop[w,1], Nothing ];
killfirst[a_String][L_List] := killfirst[a] /@ L;

killfirst["a"][Q[[1]]]
Position[Q,%]

killfirst["b"][Q[[1]]]
Position[Q,%]

Closure[  Q[[1]], {killfirst["a"],killfirst["b"]} ]  // Length

The rest of the analysis is similar to the UnEqual language.

Inverse Transition Matrix

For a finite language, we can extract its cardinality from the inverse of the transition matrix of the canonical DFA.

L = Union@Table[ WordRandom[ {5},Alpha[3]], {10}]

L = StringJoin@@@FlattenOne@Table[   Table[ RandomChoice[{"a","b","c"},k], {k,2,5}], {5}]

m = FiniteLanguageFA[ L, Alpha[3], Type->"Quotient" ]

m // PlotFA

Remove the sink and extract the transition matrix A.

mm = TrimFA[m];
A = Total@BooleanTransitionMatrix[mm];
PlotMatrix[A,Mesh-> All, MeshStyle-> {{GrayLevel[0.8],Thin},{GrayLevel[0.8],Thin}}]

Note that  (I-A) (A^( * ))= I.  Thus I - A  is invertible and we can read off the size of the language from the inverse.

n = StateCount[mm];
Det[IdentityMatrix[n]-A]

B= Inverse[IdentityMatrix[n]-A];
ToBitVector[InitialStateList[mm],Range[n]].B.ToBitVector[FinalStateList[mm],Range[n]]
Length[L]

PlotMatrix[B,Mesh->All, MeshStyle-> {{GrayLevel[0.8],Thin},{GrayLevel[0.8],Thin}}]

Regular Expressions

A convenient plotting function.

plotfa = PlotFA[#, Type->"MultiColor",EdgeStyle->Thick, VertexSize->Medium ]&;

Example Even-even

An expression using the headers REP, RET, RES corresponding to the operators in the Kleene algebra.

e0=REP["aa","bb"];
e1=REP["ab","ba"];
e00=RES[REP[e0,RET[e1,RES[e0],e1]]]

Build a regular expression for the language over {a,b}  consisting of all strings with an even number of a’s and even number of b’s. Using the standard Thompson conversion (begin/exit automata with ϵ-moves).

m1=RegexToFA[e00,Alpha[2] ]
% // plotfa

m2=EpsilonEliminationFA[m1]
gr= % // plotfa

m2 // DeterminizeFA

m3=MinimizeFA[m2]
% // plotfa

We can trace the conversion process and show all the intermediate begin/exit-automata.

TableForm[Union[Flatten[Trace[RegexToFA[e00,Alpha[2]],BEFA[_Integer,_]]]]]

Using a different conversion algorithm due to McNaughton-Yamada we get a different non-deterministic machine.

m4 = RegexToFA[ e00, Alpha[2], Type->"NNFA"];
m4 //plotfa

EquivalentQFA[m3,m4]

RE for odd-odd

From the last section, we have a regular expression e00 for even/even parity strings over Σ = {a,b} .

e00

An expression e11 for odd/odd parity is a bit larger: there has to a be an a adjacent to a b, and we can split the string into two even/even parts at that point. Since letters do not commute, we need two expressions of this type.

e11=REP[RET[e00,"ab",e00],RET[e00,"ba",e00]]

MinimizeFA[RegexToFA[e11,Alpha[2]]]
% // plotfa

So how about odd/even?  Unfortunately a simple split at an occurrence of a does not work.

e10=RET[e00,"a",e00];
mm=MinimizeFA[RegexToFA[e10,Alpha[2]]];
% // plotfa

The problem lies with splits such as  bab.  We construct a machine for odd/even by hand and check that our expression so far misses these words.

m10=IntersectionFA[SemilinearDFA["a",1,2,Alpha[2],Type-> "Factor"],SemilinearDFA["b",0,2,Alpha[2],Type-> "Factor"]];
LanguageFA[ComplementFA[m10,mm],8 ]

So we use two splits:  even b-count on both sides or odd b-count on both sides.

e10=REP[RET[e00,"a",e00],RET[e00,"b",e00,"a",e00,"b",e00]]

We obtain large intermediate machines, but the final automaton only has 4 states.

mre = RegexToFA[e10,Alpha[2]];
mre // StateCount
mred = DeterminizeFA[mre];
mred // StateCount
mrem = MinimizeFA[mred]

mrem // plotfa

EquivalentQFA[mrem,m10]

The cover relation from m10 to

EquivalentQFA[m10,mrem,DoTrace->True] // Last // TF

Works.
Here is another solution obtained by taking the derivative of the even/even expression.

E10=RET[REP["a",RET["b",RES[REP["aa","bb"]],REP["ab","ba"]]],e00]

M = MinimizeFA@RegexToFA[E10,Alpha[2]];
EquivalentQFA[M,m10]

Example "no factor a a a a".

Complements are a bit problematic to express with regular expressions.

exp=RET[REP[Eps,"a","aa","aaa"],RES[REP["b","ba","baa","baaa"]]]

m0 = EpsilonEliminationFA@RegexToFA[exp,Alpha[2]];
m1=DeterminizeFA[m0];
m2=MinimizeFA[m1];
gr = plotfa /@ {m0,m1,m2} // GraphicsRow

Verify that m1 works properly, first empirically and then by constructing the minimal automaton in a different way. The two machines turn out to be identical.

LanguageFA[  ComplementFA[m1],6]

MinimizeFA[ComplementFA[SemilinearDFA["aaaa",{1,1,{},{0}},Type->"Factor"]]]
EquivalentQFA[%,m1]

Divisible by 3

Numbers divisible by 3 in binary, MSD first, with leading zeros.

AutomataDefaults["REGEXalpha",Alpha[2,<|"AlphabetType"->"Digit"|>]]

reg = RES[ REP[ "0",RES[ RET[ "1",  RES[ RET["0",RES["1"] ,"0" ] ],"1" ] ] ] ]

fa = RegexToFA[reg]

Our presentation allows for leading zeros.

L =LanguageFA[  fa, 5 ]

FromDigits[#,2]& /@ Rest@Flatten[L] // Union

machs ={ fa,  EpsilonEliminationFA[fa],DeterminizeFA[fa], M = MinimizeFA[fa]};

PlotFA[ #, VertexSize->Medium,  Type->"MultiColor",VertexSize->Small ]& /@ machs// GraphicsColumn

The growth function is easy to find in this case.

LanguageFA[ M, 14, SizeOnly->True ]
% // FindSequenceFunction[#,z]&

Conway's (Subscript[R, n])

The following regular expressions are equivalent to (((a+b))^( * )), for all n.
However, this equivalence cannot be proven from Conway’s axioms (Subscript[C,  1])-(Subscript[C, 14]) .

Clear[REPower]
$defRegexAlphabet = Alpha[2];
REPower[ee_,0]:=Eps;
REPower[ee_,1]:=ee;
REPower[ee_,n_Integer?NonNegative]:=RET@@Table[ee,{n}];
Rn[n_Integer]:=With[{e=RET["a",RES["b"]]},REP[RES["b"],RET[RES["b"],RES[REPower[e,n]],REPower[RET[REP[Eps,"a"],RES["b"]],n]]]];

Check equivalence for n = 10.

reg = Rn[10];
fa = RegexToFA[reg,Alpha[2]];
fa // StateCount
fa // DeterminizeFA
% // MinimizeFA

Transformation Semigroups

De Bruijn Automaton

Here is an example: the standard de Bruijn automaton for “third symbol from the end is a”.

m = DeterminizeFA@PositionFA[ 1, -3, Alpha[2] ];
PlotFA[m,GraphLayout->"TutteEmbedding",Type->"MultiColor",EdgeStyle->Thick]

We generate the corresponding semigroup.

S =SemigroupGenerate[m]

SemigroupCayleyTable[S] // PlotMatrix[#, ColorFunction->"Rainbow"]&

The resulting data structure also maintains information about witnesses and equations.

S // SemigroupDegree
S // SemigroupOrder
S // SemigroupGenerators
S // SemigroupElements
S // SemigroupWitnesses
S // SemigroupEquations

Witnesses are length-lex minimal. 
There are 8 idempotents in S, which happen to be constants and thus right nulls.  They are the only regular elements in S.

SemigroupElements[S,"Idempotent"] // Sort

SemigroupElements[S,"Regular"] // Sort

A table of semigroup elements with various special properties.

Table[ {type,SemigroupElements[S, type ]}, {type,{"Idempotent","LeftNull","RightNull","Null","LeftUnit","RightUnit","Unit","Regular"}}] // Grid[#,Alignment->Left]&

It is often convenient to set up a witness map S ⟶(SuperStar[Σ]), in particular when dealing with D-classes.

AssignFunction[ wit, SemigroupElements[S]-> SemigroupWitnesses[S],"FunctionAttributes"->Listable ]
wit @ SemigroupElements[S]

Generate the semigroup again, this time with Green’s relations. Below, grn is a list of the L, R and D classes of S, respectively.
There are 6 trivial D-classes and one additional regular D-class of size 8, consisting of the idempotents.

{S,grn} = SemigroupGenerate[ m, "GreensRelations"->True];

The L-classes are all trivial in this case.

grn[[1]]
Length /@ %

There is one non-trivial R-class, consisting of the right Anulls. The same holds for the H-classes.

Length /@ grn[[2]]
Length /@ grn[[3]]

The witnesses for the right nulls are all words of length 3.

wit@grn[[3,-1]]

Conversion to D-classes only works for regular classes. In this case, there is only one, the right nulls, a D-class of dimension (1,8,1).

DCLGreenToGrid[S,grn]
DCLDimension@%

The equations remove the first letter of all length 4 words, so this is consistent.

SemigroupEquations[S]

Full Transformation Semigroup (Subscript[𝕋, 3])

Here is the standard set of generators for the full transformation semigroup of degree 3.

gen ={SGT[{2,1,3}],SGT[{2,3,1}],SGT[{1,1,3}]};

(*gen ={SGT[{2,1,3,4}],SGT[{2,3,4,1}],SGT[{1,1,3,4}]};*)

The semigroup elements are all transformations [3]->[3].

S = SemigroupGenerate[  gen  ]

SemigroupCayleyTable[S] // PlotMatrix[#, ColorFunction->"Rainbow"]&

The equations here are in raw form and can be simplified.

Through[{SemigroupOrder,SemigroupDegree,SemigroupElements,SemigroupWitnesses,SemigroupEquations}[S]] // Column

Assorted elements of the semigroup. All elements are regular.

Table[ {type,SemigroupElements[S, type ]}, {type,{"Idempotent","LeftNull","RightNull","Null","LeftUnit","RightUnit","Unit","Regular"}}] // Grid[#,Alignment->Left]&

Again, but this time keeping track of discovery process. Labeling the nodes by transformations is best handled by some pretty printing.

ClearAll[prnSGT]
Attributes[prnSGT]={Listable};
prnSGT[SGT[x_List]] := StringifyList[x,Fill->""];

{S,ef,eb} = SemigroupGenerate[  gen,Alignment->Right,Full->True ];

Gf = Graph[eb];
Annotate[ Gf,VertexLabels->Thread[VertexList[Gf]->prnSGT@VertexList[Gf]]]

Forward and backward edges combined.

Glr = GraphUnion[ Graph[ef],Graph[eb] , 
EdgeStyle->Flatten@{Thread[ef->Table[Darker@Red,{Length[ef]}]],Thread[eb->Table[Lighter@Blue,{Length[eb]}]]}]

Computing Green’s relations.

{S,green}=SemigroupGenerate[  gen, "GreensRelations"->Automatic ];

green // prnSGT // Column

The D-classes in terms of left/right multipliers and the H block. We rearrange the classes by rank.

dcl = DCLGreenToGrid[S,green];
dcl = SortBy[ dcl, RankSGT[#[[1,1]]]&];
dcl // Column

The classes in the familiar grid layout. The underlying groups are the trivial group, the two-element group, and  the symmetric group on 3 letters.

DCLDimension[dcl]
MatrixForm[prnSGT[DCLUnpack[#]]]& /@ dcl // Column

The equations produced by the generating algorithm can be simplified quite a bit.

rw = RewriteRulesSimplify[ SemigroupEquations[S] ]

The equations not involving c describe the symmetric group of order 6.

Select[ rw, !StringMatchQ[#[[1]],"*c*"]& ]

Lastly, the assorted Cayley graphs obtained during the generation process.

Table[ SemigroupCayleyGraph[gen,Alignment->dir,Full->bl ],
	{dir,{Left,Right}}, {bl,{True,False}} ]

Universal Squares of Languages

Two Letters

We construct a simple example of a regular language L ≠ (SuperStar[Σ]) such that L · L = (SuperStar[Σ])  over the alphabet  Σ = {a,b}.  Note that necessarily ϵ, a, b ∈ L for any solution. 
A little experimentation produces  L = ϵ + a (SuperStar[Σ])+ (SuperStar[Σ])b.

all=RES[REP["a","b"]];
exp=REP[Eps,RET["a",all],RET[all,"b"]]

A2 = Alpha[2];
m=MinimizeFA[RegexToFA[exp,A2]]
PlotFA[ m, Type->"MultiColor", EdgeStyle->Thick]

We check the growth function.

LanguageFA[m,16,SizeOnly->True]
GrowthFunctionDFA[m,z]

It is easier to inspect a few words in the complement of L.

LanguageFA[ComplementFA[m],{5}]

It seems the complement of L has the form  b (SuperStar[Σ]) a, a claim easily verified by constructing the corresponding machines.

expc=RET["b",all,"a"];
EquivalentQFA[ComplementFA[m],RegexToFA[expc,A2]]

Next we compute a machine for L·L, and check that indeed  L · L = (SuperStar[Σ]).

mm=ConcatenateFA[m,m];
mm // PlotFA
PropertyQFA[mm,"Universal"]

Only the relative order of a and b matters: both correspond to idempotent elements in the syntactic semigroup.

S = SemigroupGenerate[m]

SemigroupCayleyTable[S] // PlotMatrix[#, ColorFunction->"Rainbow",Mesh->All]&

The 4 elements are all idempotent.

Length@SemigroupElements[S,"Idempotent"]

Pairs[ SemigroupWitnesses[S],SemigroupElements[S]] // Grid

RewriteRulesSimplify@SemigroupEquations[S] // Column

Only state 4 fails to be accepting, so the only “bad” word is of the form b a, but admits a factorization b:a, as claimed.

Three Letters

A slightly more ambitious example over a three-letter alphabet: 	L = (c^( * ))(ϵ + a  (SuperStar[Σ])+ (SuperStar[Σ])b) (SuperStar[c]).
Note the asymmetry between c and the other letters.

all=RES[REP["a","b","c"]];
exp=RET[RES["c"],REP[Eps,RET["a",all],RET[all,"b"]],RES["c"]]

m=MinimizeFA[RegexToFA[exp,Alpha[3]]]
PlotFA[ m, Type->"MultiColor", EdgeStyle->Thick]

The complement of L is a bit more complicated in this case and has the form (SuperStar[c])b (SuperStar[Σ]) a (SuperStar[c]).

LanguageFA[ComplementFA[m],{5}]

LanguageFA[ComplementFA[m],12,SizeOnly->True]
FindSequenceFunction[%,z]

expc=RET[RES["c"],"b",all,"a",RES["c"]];
EquivalentQFA[RegexToFA[expc,Alpha[3]],ComplementFA[m]]

It may help to construct the syntactic semigroup of L to understand what is going on here.

S = SemigroupGenerate[m]

SemigroupCayleyTable[S] // PlotMatrix[#, ColorFunction->"Rainbow",Mesh->All]&

This time the semigroup is already a monoid, there are 5 elements, all idempotents. (Subscript[δ, c]) is the identity, so we are essentially back in the two-letter case.

Pairs[ SemigroupWitnesses[S],SemigroupElements[S,"Idempotent"]] // Grid

RewriteRulesSimplify@SemigroupEquations[S] // Column

In hindsight, this is clear from the DFA (see the blue self-loops), but it certainly is not obvious from the regular expression.  For the suspicious, a check that (L^( 2))= (Σ^( * )).

ConcatenateFA[m,m] // PropertyQFA[#,"Universal"]&

Shuffle

We construct a machine for   K = { x |  x || u  ⋂ L  ≠ ∅  }  where u is fixed, L regular given by a FSM M.

The new machine uses a state set of  Q × [m+1]  where  m  is the length of u.  First,  a walk through the construction. We generate a suitable sample machine M for the language  L = (SuperStar[a])b (SuperStar[a])b (SuperPlus[c])(SuperStar[a]).

A3 = Alpha[3];
M=MinimizeFA[RegexToFA[RET[RES["a"],"b",RES["a"],"b",RES["c"],"c",RES["a"]],A3]]

Extract the transition function and the initial state.

AssignTransitionFunction[delta,M]
q0=InitialState[M];

Let’s use u = b c.  Unpack u into a list of characters (in index notation) and record its length.

u = "bc";
uchar=ToIndex[u,A3]
ulen=Length[uchar]

The transition functions used to generate the new machine. next[0] handles ϵ-transitions (though we currently pretend these are ordinary transitions associated with a letter to fit into the framework of Closure)
	(p,i) -> (p · (Subscript[u, i+1]), i+1)
and next[s] takes care of transitions
	(p,i) -> (p·s,i).

ClearAll[next,BOT]
next[0][{p_,i_}]:=With[{ii=i+1},If[ii≤ulen,{delta[p,uchar[[ii]]],ii},BOT]];
next[s_][{p_,i_}]:={delta[p,s],i};
next[_][BOT]:= BOT;

Closure builds the state set and the transition relation.

{Q,tr}=Closure[{{q0},0},Table[ Evaluate[next[s]],{s,0,3}],
	Cayley->True,Bound->500 ];

It remains to select the final states.

fin = PositionList[ Q,Select[Q,#=!=BOT && SubsetQ[FinalStateList[M],First[#1]]&&Last[#1]==ulen&]]

We also need to fix the symbol index in the transitions (ϵ is supposed to be indexed by 0).

G =Graph[ TransitionsMap[ tr, Identity,#-1& ]];

fa=FA[ TSys[Length[Q],3, G, A3, <|"TransType"->"FAE"|> ], 
<| "AccCond"->Existential[{1},fin] |> ]

PlotFA[fa]

Recall that u = b c. Here are the first few words in L and K:

LanguageFA[M, 5 ]
LanguageFA[fa,5 ]

Sanity check:

K5 = LanguageFA[M,{5}] ;
Select[ Words[ {3},Alpha[3]], Intersection[WordShuffle[#,u],K5]=!={}& ] 
LanguageFA[fa,{3}]

Mu = MinimizeFA[fa];
PlotFA /@ {M,Mu}  // GraphicsColumn

The whole operation can be packaged into a single function thus. This is for a 3-letter alphabet only.

ClearAll[shuffleWordFA]
shuffleWordFA[M_?FSMQ,u_String ]:=
Module[{delta,q0,uchar,ulen,next,Q,tr,fin,BOT,G},
uchar=ToIndex[u,A3];
ulen=Length[uchar];
AssignTransitionFunction[delta,M];
q0=InitialState[M];
next[0][{p_,i_}]:=With[{ii=i+1},If[ii≤ulen,{delta[p,uchar[[ii]]],ii},BOT]];
next[s_][{p_,i_}]:={delta[p,s],i};
next[_][BOT]:= BOT;
{Q,tr}=Closure[{{q0},0},Table[ Evaluate[next[s]],{s,0,3}],
	Cayley->True,Bound->500 ];
fin = PositionList[ Q,Select[Q,#=!=BOT && SubsetQ[FinalStateList[M],First[#1]]&&Last[#1]==ulen&]];
G =Graph[ TransitionsMap[ tr, Identity,#-1& ]];
FA[ TSys[Length[Q],3, G, A3, <|"TransType"->"FAE"|> ], 
	<| "AccCond"->Existential[{1},fin] |> ]
];

Some more examples.

Mu = MinimizeFA[shuffleWordFA[M,"bb"]];
PlotFA /@ {M,Mu}  // GraphicsColumn

Mu = MinimizeFA[shuffleWordFA[M,"bbca"]];
PlotFA /@ {M,Mu}  // GraphicsColumn

Magmas

Show that the sequences in a finite magma that evaluate to the same result under left/right associative multiplication for a regular language.

Left/Right Multiplication

First, we implement dyadic multiplication, and left and right polyadic multiplication according to the given table. It will be useful to augment the carrier set [n]  by a “neutral” element 0 (we are working in a magma with neutral element).

Uses global CT for Cayley table.

Clear[λ,ρ,μ,nn,CT,K]
SetAttributes[{ρ,λ,μ},Listable]
nn = 3;
K = Alpha[nn];
μ[0,x_]:= x;
μ[x_,0]:= x;
μ[i_Integer,j_Integer] := CT[[i,j]];
λ[i_Integer]:=i;
λ[i_Integer,j_Integer]:=μ[i,j];
λ[i_Integer,j_Integer,k___Integer]:=λ[λ[i,j],k];
ρ[i_Integer]:=i;
ρ[i_Integer,j_Integer]:=μ[i,j];
ρ[k___Integer,i_Integer,j_Integer]:=ρ[k,μ[i,j]];
λ[x_?WordQ]:=ToWord[{λ@@ToIndex[x,K]},K];
ρ[x_?WordQ]:=ToWord[{ρ@@ToIndex[x,K]},K];

Generate a Cayley table at random. For sequences of length 2 there should be no difference, but for longer sequences we may get different answers depending on grouping.

CT = ArrayReshape[ RandomInteger[{1,nn},nn^2 ], {nn,nn}];

The rock/paper/scissors magma.

CT = {{1,2,1},{2,2,3},{1,3,3}};

TableForm[ CT, TableHeadings->{Automatic,Automatic}]

AllTrue[ Tuples[Range[nn],2],λ@@#==ρ@@#& ]
Select[ Tuples[Range[nn],3],λ@@#==ρ@@#& ]
% // Length

The Component Machines

To construct the maine automaton we first build machines Mleft[s] that accept all strings in  (Σ^( +)) that evaluate to s under λ.   The appropriate state set is Σ  augmented by a "neutral" element 0 (we are working in a monoid rather than a semigroup). These automata are naturally DFAs: the right action of the transition function of a DFA automatically translates into left-associative multiplication in this context.

ClearAll[Mleft]
Mleft[s_] := GenerateFA[ 0,  Table[ Evaluate[μ[#,a]]&,{a,nn}],K, #==s& ]

Some useful plotting parameters.

plotfa =PlotFA[ #, Type->"MultiColor",VertexSize->Medium,EdgeStyle->Thick ]&;
rplotfa =RoundVerticesGraph@PlotFA[ #, Type->"MultiColor",VertexSize->Medium,EdgeStyle->Thick ]&;

Mleft[1];
% // rplotfa

Here are all n machines; clearly, they differ only in their final states.

rplotfa[ Mleft[#]]& /@ Range[nn] // GraphicsRow

Some sanity checks.

Select[Words[{4},K],λ[#1]=="b"&]
% === LanguageFA[Mleft[2],{4}]

We can check that the union of the 3 automata accepts all non-empty words.

UnionFA@@Table[ Mleft[i], {i,nn} ]//MinimizeFA // plotfa

The machines for right-associative multiplication are a bit harder to come by.  Here we need transitions  p (Subscript[⟶, a]) q  whenever  p = a · q.  The initial state is then s ∈ Σ  and the final state ϵ (we use the same state set as for the other machines).  First, the transitions: part 1 is a translation of the Cayley matrix, part 2 is a (Subscript[⟶, a]) ϵ.

tr1 = TransitionsMap[  FlattenOne[ MapIndexed[DirectedEdge@@Reverse[Append[#2,#1]]&,CT,{-1}]], #+1& ];
tr2 = Table[DirectedEdge[i+1,1,i],{i,nn}];
G = Graph[ Range[nn+1],Sort[ Join[tr1,tr2] ] ];

Annotate[ G, {VertexLabels->Automatic,VertexSize->Small,EdgeLabels->"EdgeTag"}]

The full machines.

Clear[Mright]
Mright[s_]:= FA[ TSys[nn+1,nn,G,K,<|"TransType"->"NFA"|>], 
<| "AccCond"->Existential[{s+1}, {1}] |> ];

rplotfa[ Mright[#]]& /@ Range[nn] // GraphicsRow

Again some modest sanity checking.

Select[Words[ {4},K],ρ[#]=="a"&]
% === LanguageFA[Mright[1],{4}]

MinimizeFA[UnionFA@@Table[Mright[i],{i,3}]] 
LanguageFA[%,10,SizeOnly->True]

Looks good.

The Principal Machine

Now we construct the main machine, a sum of products of the component machines from above.

mlr = IntersectionFA[ Mleft[1], Mright[1] ]

LanguageFA[ mlr, {4} ]
λ /@ % 
 ρ /@ %%

This machine is generated by disjoint union.

M = UnionFA@@Table[ IntersectionFA[ Mleft[i], Mright[i] ], {i,3} ];
M // plotfa

The minimal DFA and its diagram.

MM=MinimizeFA[M];
MM // StateCount
MM // plotfa

We can test that the machine works as advertised.

L=LanguageFA[MM,{5}];
λ[L]===ρ[L]

The growth function of  L.

LanguageFA[MM,12,SizeOnly->True]

GrowthFunctionDFA[MM,z]

One can now investigate other properties of the magma. For example, if there is no sink in the minimal DFA for L, then every word u has an extension u v ∈ L.

TrapStateList[MM]

CA Surjectivity

ECA 45

Consider the elementary CA number 45. Here is the evolution of a one-point seed and a random configuration.

Unprotect[C];
C=CA[3,2,45]

OrbitCA[C,SeedConfiguration[{1},80],50]  // PlotMatrix

OrbitCA[C,SeedConfiguration[80,"RandomDigits"->2],50]  // PlotMatrix

ECA 45 is surjective on infinite configurations and hence must be surjective on infinitely many finite grids by a compactness argument (using cyclic boundary conditions).   The corresponding de Bruijn automaton is unambiguous.

ClassifyCA[C]

sa=ToSemiautomatonCA[C];
PropertyQFA[ sa, "Ambiguous" ]

To determine the grid sizes n for which ECA 45 acts like a bijection on  (Subscript[𝒞, n])=(({0,1})^n), we construct the automaton 
	𝒜 = (Subscript[Σ , p∈ Q]) (Subscript[ℬ, p,p])  
where ℬ = ⟨Q,{0,1},δ ⟩ is the de Bruijn automaton for the CA and (Subscript[ℬ, p,p]) indicates the automaton obtained by selecting p as initial and final state.

sa // PlotFA

m=UnionFA@@(SetInitialFinal[sa,{#1},{#1}]&)/@Range[StateCount[sa]];
mm=MinimizeFA[m]

The growth function of the language of 𝒜 suggests that C will be surjective exactly for all odd n.

LanguageFA[mm,16,SizeOnly->True]
2^Range[0,16]
%-%%

It looks like  (Subscript[a, n])= (2^n) for odd n, and (Subscript[a, n])= (2^n)-(2^(n/2)) for even n.  For a proof, note that there is a reasonable description of the growth function in terms of a recurrence equation.

LanguageFA[mm,16,SizeOnly->True] // FindSequenceFunction

The claim follows easily by induction. 

With more effort, on can extract the same information from the generating function for the growth function of 𝒜.

GrowthFunctionDFA[mm,x]
Series[ gf, {x,0,10}]

For grid size n=6  we should expect only (2^( 6))-(2^( 3 ))= 56 first generation configurations. We determine the transients and periods of all configurations on a small grid and print a frequency table.

nn = 6;
GlobalMapCA[ glob,C]
trper=AnalyzeOrbit[glob,#]&/@Tuples[{0,1},nn];
trper // Frequencies // TableForm[#,TableDepth->2]&

So there is one limit cycle of length 18, one of length 3, one of length 2 and three fixed points.
Phasespace:

Graph[ Table[DirectedEdge[X,glob[X]], {X,Tuples[{0,1},nn]} ] ]

CA Multiplicity Semigroups

Unprotect[C]
D2 = Alpha[2,\[LeftAssociation]"AlphabetType"->"Digit","AlphabetOffset"->0\[RightAssociation]];

Surjective Global Map

A binary cellular automaton of width 4.The global map is surjective, but fails to be injective or even open.

C=CA[4,2,7770];
ClassifyCA[C]

OrbitCA[C,SeedConfiguration[{1},100],80] // PlotMatrix

OrbitCA[C,SeedConfiguration[100,"RandomDigits"->2],80] // PlotMatrix

Since C is surjective, all words must have the same multiplicity in the de Bruijn semiautomaton associated with C.

sa=ToSemiautomatonCA[C];
PlotFA[ sa, Type->"MultiColor"]

LanguageFA[sa,{5},Multiplicity->True]

We construct the multiplicity semigroup of the automaton, the image of the canonical homomorphism  (Σ^( * ))-> (2^( Q × Q)).  The semigroup has size 754.  Note that this semigroup would be infinite if our CA were non-surjective.

bmat = BooleanTransitionMatrix[sa];
PlotMatrix /@ bmat // GraphicsRow

ClearAll[f1,f2]
f1[M_?MatrixQ] :=M.bmat[[1]];
f2[M_?MatrixQ] := M.bmat[[2]];
{mats,tr,wit} = Closure[  IdentityMatrix[8], {f1,f2} , Cayley->True,Witnesses->True ];
mats // Length

The matrices are duly binary. The identity matrix is the only matrix of rank 8, so the underlying semigroup has only 754 elements.

mats // Flatten // Union
MatrixRank /@ mats // Frequencies

We extract the 24 matrices of minimal rank, which turns out to be 1 in this case.

minmat = Select[ mats, MatrixRank[#]==1& ];
Partition[ PlotMatrix[#,Mesh->True,MeshStyle->{{,Thickness[Tiny]},{,Thickness[Tiny]}}]& /@ Sort@minmat , 6 ] // GraphicsGrid

There are 6 classes of matrices according to non-zero rows and 4 according to columns; all 24 combinations appear.

Union[(Union[First/@Position[#1,1]]&)/@minmat]
Union[(Union[First/@Position[Thread[#1],1]]&)/@minmat]

W=ToWord[wit[[PositionList[ mats, minmat ]]],D2 ]

A random example.

ComputationGraphFA[ sa,RandomChoice[W],VertexLabels->None,DoTrace->"Trim"]

All the witnesses associated with min-rank matrices.

Partition[ Table[ ComputationGraphFA[sa,x,VertexLabels->None,DoTrace->"Trim", PlotLabel->x],
{x,W} ],4] // GraphicsGrid[#,Frame->All]&

Pick one of these witnesses at random.

w=ToIndex[ RandomChoice[W], D2 ]

Computing   δ(Q,w)  and    (δ^( r))(Q,(w^( r)))    shows that associated row/column pattern.

AssignTransitionFunction[del,sa]
AssignTransitionFunction[delr,ReverseFA[sa]]
del[Range[8],w]
delr[Range[8],Reverse[w]]

The computations of the semiautomaton on this witness.  Notice the bottleneck.

ComputationGraphFA[sa,w,DoTrace->"Trim"]

To check that the global map is not open, we use a product machine construction (this is the method used in ClassifyCA).  We can trace a path from the diagonal in the product (which forms a strongly connected component since the CA is surjective) to some other component.

s2=ProductFA[sa,sa,StateType->"Shallow" ];
PlotFA[ s2, Type->"MultiColor" ]

There are 2 non-trivial SCCs, the second one being the diagonal.

{H, scc, ntscc,lvs } = CondensationGraph[ TransitionSystemGraph[s2], Full->True ];

PositionList[ scc, ntscc ]
Length /@ scc[[%]]

There is a path of length 2 from the diagonal to the other non-trivial SCC.

GraphDistance[H,8,3]

HighlightGraph[ H, {{3},{8}},VertexSize->Large ]

The subautomaton induced by the second SCC accepts all words up to length 6. Hence all these words support vertex-disjoint computations.

s3 = SubAutomatonFA[s2,scc[[3]] ]

PlotFA[ s3, Type->"MultiColor" ]

LanguageFA[ ComplementFA@s3, 12, SizeOnly->True ]

The 2 missing words of length 7 produce bottlenecks.

Complement[ Words[{7},D2],LanguageFA[s3,{7}] ] 
ComputationGraphFA[sa,#,VertexLabels->None, DoTrace->"Trim"]& /@ % // GraphicsRow

Open Global Map

The next cellular automaton has a global map that is open (and hence surjective), but fails to be injective.

C=CA[4,2,15555];
ClassifyCA[C]

OrbitCA[C,SeedConfiguration[{1},100], 80 ] // PlotMatrix

OrbitCA[C,SeedConfiguration[100,"RandomDigits"->2], 80 ] // PlotMatrix

The de Bruijn automaton associated with C and checking multiplicity.

sa=ToSemiautomatonCA[C];
PlotFA[ sa,Type->"MultiColor" ]

LanguageFA[sa,{5},Multiplicity->True]

Again we construct the multiplicity semigroup of the automaton, the image of the canonical homomorphism  (Σ^( * ))-> (ℕ^( Q × Q)).  The semigroup has size 24.

bmat = BooleanTransitionMatrix[sa];
PlotMatrix /@ bmat // GraphicsRow

ClearAll[f1,f2]
f1[M_?MatrixQ] := M.bmat[[1]];
f2[M_?MatrixQ] := M.bmat[[2]];
{mats,tr,wit} = Closure[  IdentityMatrix[8], {f1,f2} , Cayley->True,Witnesses->True ];
mats // Length

Removing the identity matrix leaves  24 matrices of rank 4, the actual semigroup.

mats = DeleteCases[ mats, IdentityMatrix[8] ];
MatrixRank /@ mats

Partition[ PlotMatrix[#,Mesh->True,MeshStyle->{{,Thickness[Tiny]},{,Thickness[Tiny]}}]& /@ Sort@mats , 6 ] // GraphicsGrid

There are 2 types of matrices according to non-zero rows; all columns have exactly one non-zero entry.

Union[(Union[First/@Position[#1,1]]&)/@mats]
Union[(Union[First/@Position[Thread[#1],1]]&)/@mats]

The product machine used in the classification algorithm.

s2=ProductFA[sa,sa,StateType->"Shallow" ];
PlotFA[ s2, Type->"MultiColor" ]

Again there are 2 non-trivial SCCs, but there are no paths between them.

{H, scc, ntscc,lvs } = CondensationGraph[ TransitionSystemGraph[s2], Full->True, Type->"Indexed" ];

H

PositionList[ scc, ntscc ]
Length /@ scc[[%]]
GraphDistance[UndirectedGraph@H,9, 34]

HighlightGraph[ H, {{9},{34}},VertexSize->Large ]

Injective Global Map

Lastly, a reversible binary cellular automaton of width 4.

C=CA[4,2,21845];
ClassifyCA[C]

OrbitCA[C,SeedConfiguration[100,"RandomDigits"->2],80] // PlotMatrix

Since C is surjective, all words must have the same multiplicity in the de Bruijn semiautomaton associated with C.

sa=ToSemiautomatonCA[C];
PlotFA[ sa, Type->"MultiColor" ]

LanguageFA[sa,{5},Multiplicity->True]

We construct the multiplicity semigroup of the automaton, the image of the canonical homomorphism  (Σ^( * ))-> (2^( Q × Q)).  The semigroup has size 754, so this will take some 15 seconds.  Note that this semigroup will be infinite if you start with a non-surjective CA.

bmat = BooleanTransitionMatrix[sa];
PlotMatrix /@ bmat // GraphicsRow

ClearAll[f1,f2]
f1[M_?MatrixQ] := M.bmat[[1]];
f2[M_?MatrixQ] := M.bmat[[2]];
{mats,tr,wit} = Closure[  IdentityMatrix[8], {f1,f2} , Cayley->True,Witnesses->True ];
mats // Length

There are 8 matrices of minimal rank 1, which turn out to be all-ones columns.

MatrixRank /@ mats // Frequencies

minmat = Select[ mats, MatrixRank[#]==1& ];
Partition[ PlotMatrix[#,Mesh->True,MeshStyle->{{,Thickness[Tiny]},{,Thickness[Tiny]}}]& /@ minmat ,4 ] // GraphicsGrid

The witnesses for the minimal-rank matrices are all words of length 3: each words synchronizes the semiautomaton to a different state.

W=ToWord[wit[[PositionList[ mats, minmat ]]],D2 ]

Partition[ Table[ ComputationGraphFA[sa,x,VertexLabels->None,DoTrace->"Trim", PlotLabel->x],
{x,W} ],4 ] // GraphicsGrid[#,Frame->All]&

The bottlenecks all occur on the right.

In the product automaton all transitions lead towards the only non-trivial SCC in the middle, the diagonal.

s2=ProductFA[sa,sa];
PlotFA[ s2, Type->"MultiColor" ]

CondensationGraph[ TransitionSystemGraph[s2]]

CA Fischer Automata

Constructing the Minimal Fischer Automaton

Consider a one-dimensional cellular automaton ρ as a transducer on bi-infinite words, so ρ : (Σ^( ∞)) ⟶ (Σ^( ∞)).  The finite factors of ρ(X) where X∈ (Σ^( ∞))  form a regular language accepted by the de Bruijn automaton associated with ρ.  For example, for ECA 73 we get:

sa=ToSemiautomatonCA[CA[3,2,73]]

The minimal DFA here has maximal size 16.

m=MinimizeFA[sa]

All the ECAs whose minimal DFA have maximum size are based on one-permutation automata. By symmetry, we consider only the first 128 machines.

blowup=Select[Range[0,127],StateCount[MinimizeFA[ToSemiautomatonCA[CA[3,2,#]]]]==16&]

Partition[PlotFA[ToSemiautomatonCA[CA[3,2,#]],Type->"MultiColor"]&/@blowup,4] // GraphicsGrid

Back to ECA 73. The growth function is rather complicated:

GrowthFunctionDFA[m,x]
Series[%,{x,0,14}]

mc = ComplementFA[m];
mc //PlotFA

The complement forms an ideal, but this ideal fails to have a finite base.

ConcatenateFA[ UniversalFA[D2],mc,UniversalFA[D2]]
EquivalentQFA[ mc,%]

idbase = MinimizeFA@LanguageFactorFA[ mc, Type->"MinimalFactor" ]

LanguageFA[ idbase, 16, SizeOnly->True ]

PropertyQFA[ idbase, "Finite" ]

A deterministic reduced semiautomaton for the cover language can be determined by finding a terminal strongly connected component in the minimal DFA for the language (which component is uniquely determined).

Options[MinimalFischerFA] = {Full->False};
MinimalFischerFA[M_FA,opts:OptionsPattern[] ] := 
Module[{dfa,G,H,scc,ntscc,lvs,Q},
dfa = IndexFA@TrimFA[ MinimizeFA[M] ];
G = TransitionSystemGraph[ dfa ];
{H,scc,ntscc,lvs}=CondensationGraph[G,Full->True];
Assert[Length[lvs]==1];
Q = lvs[[1]];
tr = TransitionsSort@Select[ TransitionList[dfa],
 MemberQ[Q,TransitionSource[#]] && MemberQ[Q,TransitionTarget[#]]& ];
res = FA[ TSys[ Length[Q], 2,Graph[ Q,tr], Alpha[2,\[LeftAssociation]"AlphabetType"->"Digit","AlphabetOffset"->0\[RightAssociation]], 
<|"TransType"->"DFA"|> ], 
<|"AccCond"->Existential[All, All],"Special"->"MultiEntry"|>];
If[ OptionValue[Full],
{res, dfa,H},
res
]
];

sa = ToSemiautomatonCA[ECA[73]]
mf = MinimalFischerFA[sa]
EquivalentQFA[ mf, sa ]

sa = ToSemiautomatonCA[ECA[39]]
mf = MinimalFischerFA[sa]
EquivalentQFA[ mf, sa ]

Here is a more interesting example, a binary width-4 automaton.   There are several non-trivial components.

sa = ToSemiautomatonCA[CA[4,2,15042]]
mf = MinimalFischerFA[sa]
EquivalentQFA[ mf, sa ]

PlotFA[ mf,Type->"MultiColor" ]

Growth

Another example, the additive ECA 90.  On biinfinite configurations rule 90 is surjective (and even open).

ClassifyCA[ECA[90]]

How about surjectivity on finite grids of length n, say, with cyclic boundary conditions?  It is easy to construct a machine from the de Bruijn automaton that accepts only words associated with the behavior of ρ on finite grids.

sa=ToSemiautomatonCA[ECA[90]];
m=MinimizeFA[UnionFA@@Table[SetInitialFinal[sa,{p},{p}],{p,4}]]

LanguageFA[m, 12,SizeOnly->True]

A sanity check by computing all configurations at time 1 of length up to 10.

GlobalMapCA[f,ECA[90]]
Table[Length[Union[f/@Tuples[{0,1},k]]],{k,12}]

The growth function is rather simple in this case and shows that ECA 90 is not surjective on any finite grid.

GrowthFunctionDFA[m,x]
Series[%,{x,0,12}]

A closely related linear ECA is rule number 150.

sa=ToSemiautomatonCA[ECA[150]];
m=MinimizeFA[UnionFA@@Table[SetInitialFinal[sa,{p},{p}],{p,4}]]

LanguageFA[m,12,SizeOnly->True]

It seems that rule 150 is surjective on a grid of length n whenever n is not divisible by 3. 
The growth function is slightly more complicated for rule 150, but we can still do a sanity check by computer algebra.

GrowthFunctionDFA[m,x]
Series[%,{x,0,12}]

Together[1+Sum[(2^i) ((x^i)+2 (x^(i+1))+(x^(i+2))),{i,1,∞,3}]]

Of course, in general we obtain rather more complicated rational functions and it is difficult to solve the corresponding recurrences.

sa=ToSemiautomatonCA[ECA[30]];
m=MinimizeFA[UnionFA@@Table[SetInitialFinal[sa,{p},{p}],{p,4}]]

LanguageFA[m,12,SizeOnly->True]

GrowthFunctionDFA[m,x]

A Counterexample

The minimal Fischer automaton for any factorial, extensible and transitive language L is uniquely determined. Here is an example due to A. Jonoska that shows that transitivity is essential here: two equivalent, deterministic minimal semiautomata that fail to be isomorphic, over a 3-letter alphabet.

D3 = Alpha[3,<|"AlphabetType"->"Digit","AlphabetOffset"->0|>];

s1=FA[ TSys[ 4,3,Graph[Range[4],{(DirectedEdge[1, 2, 1]),(DirectedEdge[1, 3, 2]),(DirectedEdge[2, 1, 1]),(DirectedEdge[2, 4, 2]),(DirectedEdge[3, 3, 3]),(DirectedEdge[3, 4, 2]),(DirectedEdge[4, 3, 1])}],D3,<|"TransType"->"PDFA"|>],
<|"AccCond"->Existential[All, All],"Special"->"MultiEntry"|>];
s2=FA[ TSys[ 4,3,Graph[Range[4],{(DirectedEdge[1, 4, 2]),(DirectedEdge[1, 3, 1]),(DirectedEdge[1, 3, 3]),(DirectedEdge[2, 2, 1]),(DirectedEdge[2, 1, 2]),(DirectedEdge[3, 3, 3]),(DirectedEdge[3, 4, 2]),(DirectedEdge[4, 3, 1])}],D3,<|"TransType"->"PDFA"|>],
<|"AccCond"->Existential[All, All],"Special"->"MultiEntry"|>];

The automata are transition deterministic but multi-entry.

PropertyQFA[s1,"Deterministic"]
PropertyQFA[s2,"Deterministic"]
EquivalentQFA[s1,s2]

PlotFA /@ {s1,s2} // GraphicsRow

The underlying digraphs fail to be isomorphic.

The machines are reduced, but note that unlike with Fischer automata this does not suffice to establish minimality here (it is not hard to see, though, that no deterministic machine of size 3 or less can produce L).

ToClasses[Range[4],MinimizeFA[SetInitial[s1,{#1}]]&,Type->"Function"]
ToClasses[Range[4],MinimizeFA[SetInitial[s2,{#1}]]&,Type->"Function"]

Note that the second semiautomaton is a subautomaton of the minimal DFA for L.

MinimizeFA[s1] // PlotFA

s1fac = LanguageFactorFA[s1] ;
SetTraits[ s1fac, "Special"->"MultiEntry" ]  (* should be automatic *)

EquivalentQFA[s1,s1fac]

Incidentally, the ideal of forbidden blocks has a finite base.

all = UniversalFA[ D3];
sc = ComplementFA[s1]
EquivalentQFA[ sc, ConcatenateFA[  all, sc, all ] ]

idbase = LanguageFactorFA[ sc, Type->"MinimalFactor" ] // MinimizeFA;
PropertyQFA[  idbase, "Finite" ]

idbase // PlotFA