Conway’s Factor Matrix

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”]]

Current paclet version:  1.0.2
A slightly more recent version may be at  automata.

Needs["KlausSutner`Automata`"]

Some convenient settings.

MakeAbbrevs[]
SetImageSize[]
FormatFA[True]
colplot = PlotFA[#,Type->"MultiColor",VertexSize->Medium]&;

Conway’s Problem

Fix some alphabet Σ and a regular language L over Σ. A subfactorization of L is a pair X and Y of languages such that X Y⊆ L, for emphasis written as X:Y.  A factorization is a subfactorization where both parts are maximal with respect to set inclusion. Similarly one defines factorizations with 3 or more terms. A factor is a language that occurs in any factorization of L.

Problem:   Find all factors of L. 

The method proposed by Conway in his famous and idiosyncratic  1971 book Regular Algebra and Finite Machines roughly looks like so. 

Write 𝒜(I,F) for the automaton obtained from 𝒜 by setting the initial states to I and the final states to F. The language recognized by 𝒜 is ℒ(𝒜).  The behavior  [[P]]  of a set of states P is the language recognized when the initial states are replaced by P,  [[P]] = ℒ(𝒜(P,fin)). Similarly, the cobehavior of P is  (Subscript[[[P]], co]) = ℒ(𝒜(ini,P)).

Now consider the minimal automaton 𝒜 for L, write Q for its state set. Call  P ⊆ Q  critical if it is maximal such that Y = (⋂_( p ∈ P)) [[p]]. Then the left/right factor pairs are of the form X:Y with X = ℒ( 𝒜(ini,P))  the cobehavior of P.
To obtain all factors, we use middle languages  ℒ( 𝒜((Subscript[P, i]),(Subscript[(OverBar[P]), j]))).

We show in a few examples below how this construction can be carried out in Automata.

(SuperPlus[a])(SuperPlus[b]) (SuperPlus[c])

A star-free language over a 3-letter alphabet:  L = (SuperPlus[a])(SuperPlus[b]) (SuperPlus[c]).

Minimal Automaton

Build the minimal DFA from a regex.

reg = RET@@(RET[RES[#],#]& /@ {"a","b","c"});
(*reg = RET@@(RES /@ {"a","b","c"});*)
A = MinimizeFA[ RegexToFA[ reg, Alpha[3] ],StateType->"Indexed"]
sc= StateCount[A];

Check that the growth function is quadratic.

LanguageFA[A,12,SizeOnly->True]
GrowthFunctionDFA[A,z]

PlotFA[A,Type->"MultiColor",VertexSize->Medium]

For amusement value, verify that the language is star-free (the syntactic semigroup is aperiodic).

{S,grn}=SemigroupGenerate[A,GreensRelations->True];
S
DCLDimension@DCLGreenToGrid[S,grn]

Left/Right Factors

First we determine the left/right factors of  L = (a^(+ ))(SuperPlus[b])(SuperPlus[c]). 
We use brute-force to determine the intersection-behaviors of all subsets  P ⊆ Q, Q the state set of 𝒜.
In this case, there are 4 left/right factors.

aut ={#, MinimizeFA[BehaviorFA[A,#,"Intersection"->True]]}& /@ PowerSet[Range[sc]];
aut// Length

cls = ToClasses[aut,EquivalentQFA[Last@#1,Last@#2]&,Type->"Relation"]; 
cls // LengthLength

The large class is comprised of  empty machines.

AllTrue[Last /@ cls[[4]], PropertyQFA[#,"Empty"]& ]

Order the classes by state count, select one machine in each class, compute the critical sets, right and left factors.
We rotate the list of equivalence classes to get a reasonable layout for the factor matrix.

cls = RotateLeft@SortBy[cls,StateCount[#[[1,2]]]&];
ccnt = Length[cls];
crit = Union@@(First /@ #)& /@ cls;
right = #[[1,2]]& /@ cls;
left = MinimizeFA@BehaviorFA[A,#,"Cobehavior"->True]& /@ crit;

cls = RotateLeft[SortBy[cls,StateCount[#[[1,2]]]&]];
crit = Union@@(First /@ #)& /@ cls;
right = #[[1,2]]& /@ cls;

Note the position of the empty and universal automata in both lists.

crit 
right
left

Except for the first and the last pair, concatenating the two machines produces an machine that recognizes all of L.

Table[ MinimizeFA[ConcatenateFA[left[[i]],right[[i]]]],{i,2,7}]
% // EquivalentQFA

Factor Matrix

Compute the factor matrix. We rearrange the critical sets to be a better layout for the factor matrix.

ccrit = Permute[ crit, InversePermutation@Cycles[{{3,4},{5,6}}]];
factab = Table[ MinimizeFA[ComplementFA[SetInitialFinal[A,ccrit[[i]],Complement[Range[sc],ccrit[[j]]]]]], {i,8},{j,8}];

To visualize the factor matrix we need to filter out duplicates. First, we can decrease the number of machines by taking a union.

facts = Union[Flatten[factab]];
facnt = facts  // Length

Verify that the machines are all inequivalent.

cls = ToClasses[facts,EquivalentQFA[#1,#2]&, Type->"Relation"];
cls // LengthLength

AssignFunction[ rank,RotateLeft@facts->Range[20], Association->True ]

Et voila, the Conway factor matrix.

Map[ rank, factab, {2} ] // MatrixForm

PlotMatrix[ Map[ rank, factab, {2} ], Mesh->Automatic, ColorFunction->"TemperatureMap" ]

And here is the legend with the  corresponding machines.

ArrayReshape[ Table[ {Graphics[{EdgeForm[Directive[Gray,Thin]],
ColorData["TemperatureMap"][i/facnt],Rectangle[{0,0}]}, 
ImageSize->Scaled[.15]],
PlotFA[facts[[i]],Type->"MultiColor",VertexSize->Medium,
ImageSize->Scaled[.5]]},{i,facnt}],{5,8}] //GraphicsGrid

Correz Automaton

The Correz automaton 𝒰 for L (also known as universal NFA) is based on the left or right factors. We use the left factors, so for the transition relation we have to check inclusion of languages K s, K a left factor, s a letter.

We use the factor automata as states of the universal automaton.

Compute the concatenation machines and check language inclusion to obtain the transition list for 𝒰.

Q = left;
alph = AlphabetList[Alpha[3]];
appLetter[ m_?FSMQ, i_Integer ] := 
MinimizeFA@ConcatenateFA[ m, FiniteLanguageFA[alph[[i]],Alpha[3]] ];

tr =Flatten@Table[ 
If[ InclusionQFA[ appLetter[m1,i], m2], 
DirectedEdge[ m1,m2,i], Nothing ],
{i,3},{m1, Q}, {m2,Q} ] ;

A random transition.

RandomChoice[tr]

To build the Correz automaton we set the initial states to be the left factors that contain ϵ.  Final states are the factors contained in L.

ini =Select[ Q, Intersection[InitialStateList[#],FinalStateList[#]]=!={}& ];
fin =Select[ Q, InclusionQFA[ #,A]& ];
UA  =GraphToFA[ Graph[Q,tr], Alpha[3], ini, fin, StateType->{"Shallow", "Indexed"}]

The full universal automaton 𝒰 contains two useless states, corresponding to the trivial left factors  ∅ and (SuperStar[Σ]) (the two center states).

PlotFA[ UA, Trim->False, Type->"MultiColor",VertexSize->Medium  ]

The Correz automaton and the minimal DFA for L.

PlotFA[ #, Type->"MultiColor", VertexSize->Medium  ]& /@ {UA,A}  // GraphicsRow

(SuperStar[Σ])a b b (SuperStar[Σ])

A star-free language:  L = (SuperStar[Σ])a b b (SuperStar[Σ]).

Minimal Automaton

Build the minimal DFA from a regex.

reg = With[{all = RES[REP["a","b"]]},RET[all,"abb",all] ];
A = IndexFA@MinimizeFA[ RegexToFA[ reg, Alpha[2] ]];
sc= StateCount[A];
A // colplot

Left/Right Factors

Compute to intersection-behaviors of all subsets of the state set.

aut ={#, MinimizeFA[BehaviorFA[A,#,"Intersection"->True]]}& /@ PowerSet[Range[sc]];
aut// Length

Determine the equivalence classes.

cls = ToClasses[aut,EquivalentQFA[Last@#1,Last@#2]&,Type->"Relation"]; 
cls // LengthLength

Order by state count, select one machine in each class, compute the critical sets, right and left factors.

cls = SortBy[cls,StateCount[#[[1,2]]]&];
ccnt = Length[cls];
crit = Union@@(First /@ #)& /@ cls;
right = #[[1,2]]& /@ cls;
left = MinimizeFA@BehaviorFA[A,#,"Cobehavior"->True]& /@ crit;

crit 
right
left

The languages happen to be linearly ordered by inclusion.

InclusionQFA[Reverse[right]]
InclusionQFA[left]

For all the left/right pairs, concatenation produces an machine that recognizes all of L.

AllTrue[ Table[ MinimizeFA[ConcatenateFA[left[[i]],right[[i]]]],{i,ccnt}],EquivalentQFA[A,#]&]

Factor Matrix

Compute the factor matrix.

ccrit = crit;

crit =ccrit

factab = Table[ MinimizeFA[ComplementFA[SetInitialFinal[A,crit[[i]],Complement[Range[sc],crit[[j]]]]]], {i,ccnt},{j,ccnt}];

Filter out duplicates and verify that the 8 machines are all inequivalent.

midfac = RotateLeft@Union[Flatten[factab]];
fcnt = Length[midfac]
cls = ToClasses[midfac,EquivalentQFA[#1,#2]&, Type->"Relation"];
cls // LengthLength

AssignFunction[ rank,midfac->Range[8], Association->True ]

Plot the Conway factor matrix.

Map[ rank, factab, {2} ] // MatrixForm

PlotMatrix[ Map[ rank, factab, {2} ], Mesh->Automatic, ColorFunction->"TemperatureMap" ]

And here is the legend with the  corresponding machines.

ArrayReshape[ Table[ {Graphics[{EdgeForm[Directive[Gray,Thin]],
ColorData["TemperatureMap"][i/fcnt],Rectangle[{0,0}]}, 
ImageSize->Scaled[.15]],
PlotFA[midfac[[i]],Type->"MultiColor",VertexSize->Medium,
ImageSize->Scaled[.5]]},{i,fcnt}],{4,4}] //GraphicsGrid

Correz Automaton

Compute the concatenation machines and check inclusion to obtain the transition list for 𝒰.

Q = left;
alph = AlphabetList[Alpha[2]];
appLetter[ m_?FSMQ, i_Integer ] := 
CanonicalFA@MinimizeFA@ConcatenateFA[ m, FiniteLanguageFA[alph[[i]],Alpha[2]] ];

tr =Flatten@Table[ 
If[ InclusionQFA[appLetter[m1,i],m2], DirectedEdge[ m1,m2,i], Nothing ],
{i,2},{m1, Q}, {m2,Q} ] ;

RandomChoice[tr]

Select initial states (contains ϵ), and final states (is contained in L).

ini =Select[ Q, Intersection[InitialStateList[#],FinalStateList[#]]=!={}& ];
fin =Select[ Q, InclusionQFA[#,A]& ];
UA  =GraphToFA[ Graph[Q,tr], Alpha[3], ini, fin, StateType->{"Shallow", "Indexed"}]

The  universal automaton and the minimal automaton.

PlotFA[ #, Type->"MultiColor", VertexSize->Medium  ]& /@ {UA,A}  // GraphicsRow

Conway’s Example

A monoidal language:  L = (SuperStar[((SuperStar[a])b + (SuperPlus[b])a)])

reg = RES[REP[RET[RES["a"],"b"],RET[RES["b"],"ba"]]];
A = IndexFA@MinimizeFA[ RegexToFA[ reg, Alpha[2] ]];
sc= StateCount[A];
A // colplot

Check that the growth function is exponential.

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

Minimal Automaton

Build the minimal DFA from a regex.

reg = RES[REP[RET[RES["a"],"b"],RET[RES["b"],"ba"]]];
A = IndexFA@MinimizeFA[ RegexToFA[ reg, Alpha[2] ]];
sc= StateCount[A];
A // colplot

Check that the growth function is exponential.

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

Left/Right Factors

Compute to intersection-behaviors of all subsets of the state set.

aut ={#, MinimizeFA[BehaviorFA[A,#,"Intersection"->True]]}& /@ PowerSet[Range[sc]];
aut// Length

Determine the equivalence classes.

cls = ToClasses[aut,EquivalentQFA[Last@#1,Last@#2]&,Type->"Relation"]; 
cls // LengthLength

Order by state count, select one machine in each class, compute the critical sets, right and left factors.

cls = SortBy[cls,StateCount[#[[1,2]]]&];
ccnt = Length[cls];
crit = Union@@(First /@ #)& /@ cls;
right = #[[1,2]]& /@ cls;
left = MinimizeFA@BehaviorFA[A,#,"Cobehavior"->True]& /@ crit;

crit 
right
left

The languages happen to be linearly ordered by inclusion.

InclusionQFA[Reverse[right]]
InclusionQFA[left]

There is one left/right pair that produces  L.

Select[ Table[ MinimizeFA[ConcatenateFA[left[[i]],right[[i]]]],{i,ccnt}],EquivalentQFA[A,#]&]

Factor Matrix

crit = RotateLeft[crit]

factab = Table[ MinimizeFA[ComplementFA[SetInitialFinal[A,crit[[i]],Complement[Range[sc],crit[[j]]]]]], {i,ccnt},{j,ccnt}];

Filter out duplicates and verify that the 8 machines are all inequivalent.

midfac = RotateLeft@Union[Flatten[factab]];
fcnt = Length[midfac]
cls = ToClasses[midfac,EquivalentQFA[#1,#2]&, Type->"Relation"];
cls // LengthLength

AssignFunction[ rank,midfac->Range[8], Association->True ]

Plot the Conway factor matrix.

Map[ rank, factab, {2} ] // MatrixForm

PlotMatrix[ Map[ rank, factab, {2} ], Mesh->Automatic, ColorFunction->"TemperatureMap" ]

And here is the legend with the  corresponding machines.

ArrayReshape[ Table[ {Graphics[{EdgeForm[Directive[Gray,Thin]],
ColorData["TemperatureMap"][i/fcnt],Rectangle[{0,0}]}, 
ImageSize->Scaled[.15]],
PlotFA[midfac[[i]],Type->"MultiColor",VertexSize->Medium,
ImageSize->Scaled[.5]]},{i,fcnt}],{4,4}] //GraphicsGrid

Correz Automaton

Compute the concatenation machines and check inclusion to obtain the transition list for 𝒰.

Q = left;
alph = AlphabetList[Alpha[2]];
appLetter[ m_?FSMQ, i_Integer ] := 
CanonicalFA@MinimizeFA@ConcatenateFA[ m, FiniteLanguageFA[alph[[i]],Alpha[2]] ];

tr =Flatten@Table[ 
If[ InclusionQFA[appLetter[m1,i],m2], DirectedEdge[ m1,m2,i], Nothing ],
{i,2},{m1, Q}, {m2,Q} ] ;

RandomChoice[tr]

Select initial states (contains ϵ), and final states (is contained in L).

ini =Select[ Q, Intersection[InitialStateList[#],FinalStateList[#]]=!={}& ];
fin =Select[ Q, EquivalentQFA[#,A]& ];
UA  =GraphToFA[ Graph[Q,tr], Alpha[3], ini, fin, StateType->{"Shallow", "Indexed"}]

The  universal NFA and the minimal DFA.

PlotFA[ #, Type->"MultiColor", VertexSize->Medium  ]& /@ {UA,A}  // GraphicsRow