<< Utilities`BinaryFiles`

makeAutomaton[
          sizeQ_, sizeΣ_] := 
        List[Table[i, {i, sizeQ}], 
          Table[FromCharacterCode[i], {i, 97, 97 + sizeΣ - 1}], 
          Flatten[Table[{i, FromCharacterCode[j], 0}, {i, sizeQ}, {j, 97, 
                97 + sizeΣ - 1}], 1], {}, {}];

getQ[
          a_] := a[[1]];
getΣ[a_] := 
        a[[2]];
getδ[a_] := 
        a[[3]];
getI[a_] := 
        a[[4]];
getF[a_] := 
        a[[5]];
getQ[a_, i_] := 
        a[[1, 
          i]];
getΣ[a_, i_] := 
        a[[2, 
          i]];
getI[a_, i_] := 
        a[[4, 
          i]];
getF[a_, i_] := 
        a[[5, i]];

(* 
      these functions return a new automaton *) 

putQ[a_, Q_] := 
        ReplacePart[a, Q, 1];
putΣ[a_, Σ_] := 
        ReplacePart[a, Σ, 2];
putδ[a_, δ_] := 
        ReplacePart[a, δ, 3];
putI[a_, I_] := ReplacePart[a, I, 4];
putF[a_, F_] := ReplacePart[a, F, 5];

\(\(\( (*\ 
      Returns\ True\ iff\ transitions\ are\ of\ the\ form\ {i, "a", 
          j}\ *) \)\(
\)\(
\)\(areTransitionsSingleLetter[a_] := 
        Apply[And, 
          Map[StringLength[Part[#, 2]] == 1 &, 
            getδ[a]]];\)\)\)

isThereAUniqueI[
          a_] := Length[getI[a]] == 1;

\( (*\ counting1[a_, 
          q_, σ_]\ counts\ the\ number\ of\ transitions\ of\ the\ form\ {q, σ,  . }\ in\ the\ automaton\ a\ *) 
 (*\ 
      countingMatrix[
          a_]\ returns\ the\ "counting matrix"\ of\ a\ *) 

\(counting1[a_, q_, σ_] := 
        Count[getδ[a], {q, σ, _}];\)\)
countingMatrix[a_] := 
        Table[counting1[a, getQ[a, i], getΣ[a, j]], {i, 
            Length[getQ[a]]}, {j, 1, 
            Length[getΣ[a]]}];

(* 
      Returns True iff the automaton is deterministic *) 

isDeterministic[
          a_] := isDeterministic[a] = 
          areTransitionsSingleLetter[a] && 
            isThereAUniqueI[
              a] && 
Apply[Times, 
                Flatten[countingMatrix[a]]] == 1;

isElementary[a_] := 
        Apply[And, 
          Map[StringLength[Part[#, 2]] ≤ 1 &, 
            getδ[a]]];

(* 
      Returns an equivalent elementary automaton *) 

elementary[a_] := 
      Module[{newQ = getQ[a], temp, 
          newδ = getδ[a]}, 
If[
          Not[isElementary[a]], 
temp = 
            Select[getδ[a], 
              StringLength[Part[#1, 2]] > 1 &]; 
For[i = 1, 
            i ≤ Length[temp], 
For[j = 1, 
              j < StringLength[
                  temp[[i, 
                    2]]], 
AppendTo[
                newQ, Max[newQ] + 1];  
If[j == 1, 
                AppendTo[
                  newδ, {temp[[i, 
                      1]], Characters[
                        temp[[i, 
                          2]]][[
                      j]], 
                    Last[newQ]}], 
AppendTo[
                  newδ, {First[
                      Take[newQ, -2]], Characters[
                        temp[[i, 
                          2]]][[
                      j]], 
                    Last[newQ]}]]; j++;]; 
AppendTo[
              newδ, {Last[newQ], 
                Last[Characters[
                    temp[[i, 2]]]], 
                temp[[i, 
                  3]]}]; i++;]; 
newδ = Complement[newδ, temp]; 
List[newQ, 
            getΣ[a], newδ, getI[a], 
            getF[a]], 
a
]]

\(\(\( (*\ 
      Returns\ the\ "mirror"\ of\ the\ automaton\ a\ *) \)\(
\)\(
\)\(mirror[a_] := 
        List[getQ[a], getΣ[a], Map[Reverse, getδ[a]], 
          getF[a], getI[a]];\)\)\)

(* counting2[a_, q_, 
          r_] counts the number of transitions of the form {q, .,r} in the automaton a *) 
 (* 
      transMatrix[
          a_] returns the transition matrix of a *) 

counting2[a_, q_, r_] := 
        Count[getδ[a], {q, _, r}];
transMatrix[a_] := 
        Table[counting2[a, getQ[a, i], getQ[a, j]], {i, Length[getQ[a]]}, {j, 
            Length[getQ[a]]}];

\(\(\( (*\ 
      this\ function\ returns\ the\ states\ reached\ from\ q\ without\ reading\ any\ letters\ in\ a*) \)\(
\)\(
\)\(ϵreached[a_, q_] := 
      Module[{temp1 = {}, temp2 = {q}, temp3 = {q}, 
          testϵ}, 
 (*\ auxiliary\ function, \ 
          returns\ True\ if\ t\ is\ an\ ϵ - 
            transition\ having\ its\ first\ component\ in\ the\ list\ x\ *) 
testϵ[x_, t_] := 
          MemberQ[x, Part[t, 1]] && \ 
            Part[t, 2] == ""\ ; \ 

While[
          Length[temp3] > 0, 
temp1 = 
            temp2; 
temp2 = 
            Union[Join[temp2, 
                Union[Map[Last, 
                    Select[getδ[a], 
                      testϵ[
                          temp3, #1] &]]]]]; 
temp3 = 
            Complement[temp2, 
              temp1];]; 
temp2]\)\)\)

reached[a_, 
          q_, σ_] := 
        Map[Last, Cases[getδ[a], {q, σ, _}]];

(* 
      this function returns the determinized version of an automaton (notice that the states obtained are the ones from the subset - 
            construction) *) 

determinize[a_] := 
      Module[{initialState, states, trans, i, j, temp, 
          b}, 
If[isDeterministic[a], 
          a, 
initialState = 
            Union[Apply[Join, 
                Map[ϵreached[a, #] &, 
                  getI[a]]]]; 
states = {initialState}; 
i = 1; 
          trans = {}; 
If[
            Not[isElementary[a]], b = elementary[a];, 
            b = a]; 
While[
            i ≤ Length[states], 
For[j = 1, 
              j ≤ 
                Length[getΣ[b]], 
temp = 
                Union[Apply[Join, 
                    Map[reached[b, #, getΣ[b, j]]  &, 
                      states[[
                        i]]]]]; 
temp = 
                Union[Apply[Join, 
                    Map[ϵreached[b, #] &, 
                      temp]]]; 
AppendTo[
                trans, {states[[i]], 
                  getΣ[b, j], temp}]; 
If[
                Not[MemberQ[states, temp]], 
                AppendTo[states, 
                  temp]]; 
j++;]; 
i++;]; 
List[states, 
            getΣ[b], trans, {initialState}, 
            Select[states, 
              Length[Intersection[getF[b], #1]] > 0 &]]]]

(* Since we have subsets as states,  
      the following function replaces subsets with integers *) 

renameQoffset[a_, 
          x_] := 
ReplaceAll[a, 
          Table[getQ[a, 
                i] -> Position[getQ[a], getQ[a, i], 
                    1][[1, 1]] + 
                x, {i, 1, Length[getQ[a]]}]];

    
renameQ[a_] := renameQoffset[a, 0];

minimal[
        a_] := minimal[a] = 
        Module[{t = a}, 
If[
            Not[isDeterministic[t]], t = 
                renameQ[determinize[t]];]; 
t = 
            renameQ[determinize[mirror[t]]]; 
t = 
            renameQ[determinize[
                mirror[t]]]; 
t]

(* 
      this function returns True if the state is not final and no states can be reached from it *) 

isSink[a_, q_] := 
        Not[MemberQ[getF[a], q]] && 
Select[getδ[a], 
              Part[#, 1] == q && 
                  Part[#, 3] ≠ q &] == {};

\( (*\ 
      Testing\ if\ a\ List\ has\ the\ right\ data\ structure\ for\ coding\ an\ automaton\ *) 

\(\(goodΣ[
          a_] := Module[{answer1 = False, answer2, 
            answer = False}, 
If[
            Apply[And, 
              Table[Head[getΣ[a, i]] === String, {i, 
                  Length[getΣ[
                      a]]}]], 
answer1 = 
              Apply[And, 
                Map[StringLength[#] == 1 &, 
                  getΣ[a]]]; 
If[
              Not[answer1], \(Print["EAT error : some of the elements in the alphabet are strings of length <>1 !"];\)]; 
answer2 = Length[getΣ[a]] == 
                Length[Union[getΣ[a]]]; 
If[
              Not[answer2], 
\(Print["EAT error : at least two elements in the alphabet are the same !"];\)]; 
answer = 
              answer1 && 
                answer2;, 
\(Print["EAT error : some of the elements in the alphabet are not strings !"];\)]; 
answer];\)\(
\)
    \)\)
\(\(\(goodδ[a_] := 
        Module[{answer1 = False, answer2 = False, answer3 = False, 
            answer4 = False, answer5 = False, 
            answer = False}, 
If[
            Map[Length, getδ[a]] == 
              Table[3, {i, 
                  Length[getδ[a]]}], 
answer1 = 
              Apply[And, 
                Map[MemberQ[getQ[a], Part[#, 1]] &, getδ[a]]]; 
            If[Not[answer1], \(Print["EAT error : at least one origin does not belong to the set of states !"];\)]; 
answer2 = 
              Apply[And, 
                Map[MemberQ[getQ[a], Part[#, 3]] &, 
                  getδ[a]]]; 
If[
              Not[answer2], \(Print["EAT error : at least one destination does not belong to the set of states !"];\)]; 
answer3 = 
              Length[getδ[a]] == 
                Length[Union[getδ[a]]]; 
If[
              Not[answer3], \(Print["EAT error : at least two elements in the transitions are the same !"];\)]; 
answer4 = 
              Apply[And, 
                Map[Head[Part[#, 2]] === String &, 
                  getδ[a]]]; 
If[
              Not[answer4], \(Print["EAT error : the second component of at least one of the transitions is not a string !"];\)]; 
If[
              answer4, 
answer5 = 
                Apply[And, 
                  Map[Complement[Union[Characters[Part[#, 2]]], 
                          getΣ[a]] == {} &, 
                    getδ[a]]]; 
              If[Not[answer5], \(Print["EAT error : the second component of at least one of the transitions is not a string over the alphabet !"];\)];]; 
answer = 
              answer1 && answer2 && answer3 && answer4 && 
                answer5;, 
\(Print["EAT error : set of transitions is not of the right form !"];\)
]; 
answer];\)\(
\)
    \)\)
goodI[a_] := 
        Apply[And, Map[MemberQ[getQ[a], #] &, getI[a]]] && 
          Length[getI[a]] ≥ 1;
goodF[a_] := 
        Apply[And, Map[MemberQ[getQ[a], #] &, getF[a]]] && 
          Length[getF[a]] ≥ 1;

    
goodAutomaton[a_] := 
        Module[{answer1, answer2}, 
If[
            Not[Length[a] == 5], 
            Print["EAT error : the automaton is not a list of five elements \
!"]; False, 
If[
              Not[Apply[And, Map[Head[#] === List &, a]]], 
              Print["EAT error : at least one of the components is not a \
list !"]; False, 
answer1 = 
                goodI[a]; 
answer2 = 
                goodF[a]; 
If[
                Not[answer1], Print["EAT error : the set of initial \
states is not of the right form !"];]; 
If[
                Not[answer2], Print["EAT error : the set of final states \
is not of the right form !"];]; 
answer1 && answer2 && 
                goodΣ[a] && goodδ[a]]]];

\(\(\( (*\ 
      this\ function\ returns\ an\ automaton\ without\ sink\ *) \)\(
\)\(
\)\(trim[a_] := 
        Module[{sink}, 

          sink = Select[getQ[a], isSink[a, #] &]; 
List[
            Select[getQ[a], Not[MemberQ[sink, #]] &], getΣ[a], 
            Select[getδ[a], 
              Not[MemberQ[sink, Part[#, 1]]] && 
                  Not[MemberQ[sink, Part[#, 3]]] &], getI[a], 
            getF[a]]];\)\)\)

reached[a_, q_] := 
      Module[{temp1 = {}, temp2 = {q}, temp3 = {q}}, 
While[
          Length[temp3] > 0, 
temp1 = 
            temp2; 
temp2 = 
            Union[Join[temp2, 
                Union[Map[Last, 
                    Select[getδ[a], 
                      MemberQ[temp3, 
                          Part[#, 1]] &]]]]]; 
temp3 = 
            Complement[temp2, 
              temp1];]; 
temp2]

(* 
      test if a is accessible *) 

isAccessible[a_] := 
      Union[Apply[Join, Map[reached[a, #] &, getI[a]]]] == 
        Sort[getQ[a]]

accessible[a_] := 
        Module[{temp}, 
temp = 
            Union[Apply[Join, Map[reached[a, #] &, getI[a]]]]; 
          List[Select[getQ[a], MemberQ[temp, #] &], getΣ[a], 
            Select[getδ[a], 
              MemberQ[temp, Part[#, 1]] && MemberQ[temp, Part[#, 3]] &], 
            getI[a], Select[getF[a], MemberQ[temp, #] &]]];

\( (*\ if\ a\ is\ a\ deterministic\ automaton, \ 
      transitionDet[a, i, 
          w]\ returns\ the\ states\ reached\ from\ i\ when\ reading\ w\ *) 

\(\(transitionDet[a_, i_, w_] := 
      Module[{auxTransDet}, 
auxTransDet[b_, {j_, x_}] := 
          If[StringLength[x] > 
              0, {Last[\(Cases[
                    getδ[b], {j, 
                      StringTake[
                        x, {1}], _}]\)[[1]]], StringDrop[x, 1]}, {j, 
              x}]; 

If[
          Complement[Union[Characters[w]], 
              getΣ[a]] == {}, 
If[
            isDeterministic[a], 
            First[Nest[auxTransDet[a, #] &, {i, w}, 
                StringLength[
                  w]]], 
Print["EAT error : transitionDet needs a DFA !"]], 
Print["EAT error : the word is not over the alphabet of the automaton !"]]
]\)\(
\)\(
\)\( (*\ 
      for\ an\ elementary\ \((possibly\ non\ deterministic)\)\ automaton, \ 
      transitionElem[b, lj, 
          x]\ returns\ the\ list\ of\ states\ reached\ from\ the\ list\ of\ states\ lj\ when\ reading\ x\ *) \)\(
\)
    \)\)
\(\(\(transitionElem[b_, lj_, x_] := 
      Module[{auxTransElementary}, 
auxTransElementary[
            a_, {li_, w_}] := 
          Module[{temp, answer = {li, w}}, 
If[
              StringLength[w] > 0, 
temp = 
                Map[Last, 
                  Select[getδ[a], 
                    MemberQ[li, Part[#, 1]] && 
                        Part[#, 2] == 
                          StringTake[w, {1}] &]]; 
temp = 
                Union[Apply[Join, 
                    Map[ϵreached[a, #] &, 
                      temp]]]; 
answer = {temp, 
                  StringDrop[w, 
                    1]};]; 
answer]; 

If[
          Complement[Union[Characters[x]], 
              getΣ[b]] == {}, 
If[
            isElementary[b], 
First[
              Nest[auxTransElementary[b, #] &, {Union[
                    Apply[Join, Map[ϵreached[b, #] &, lj]]], x}, 
                StringLength[
                  x]]], 
Print["EAT error : this function needs an elementary automaton !"]], 
Print["EAT error : the word is not over the alphabet of the automaton !"]]
]\)\(
\)\(
\)\( (*\ 
      The\ following\ function\ returns\ the\ list\ of\ the\ reached\ states\ from\ q\ when\ reading\ w\ *) \)\(
\)
    \)\)
transition[a_, q_, w_] := 
        If[isDeterministic[
            a], {transitionDet[a, q, w]}, 
If[
            isElementary[a], transitionElem[a, {q}, w], 
            transitionElem[elementary[a], {q}, w]]];

testDet[a_, w_] := 
      If[isDeterministic[a], 
        MemberQ[getF[a], transitionDet[a, First[getI[a]], w]], 
        Print["EAT error : this function needs a DFA !"]]

test[a_, w_] := 
        If[isDeterministic[a], 
          testDet[a, w], 
If[isElementary[a], 
            Length[Intersection[getF[a], transitionElem[a, getI[a], w]]] > 0, 
            Length[Intersection[getF[a], 
                  transitionElem[elementary[a], getI[a], w]]] > 
              0]];

unionA[
        a_, b_] := 
      Module[{at, bt, newQ, newδ}, 
at = 
          renameQ[a]; 
bt = 
          renameQoffset[b, Length[getQ[a]]]; 
newQ = 
          Union[getQ[at], getQ[bt]]; 
AppendTo[newQ, 
          Length[newQ] + 1]; 
newδ = 
          Union[getδ[at], 
            getδ[bt]]; 
newδ = 
          Union[newδ, 
            Join[Table[{Max[newQ], "", getI[at, i]}, {i, 
                  Length[getI[a]]}], 
              Table[{Max[newQ], "", getI[bt, i]}, {i, 
                  Length[getI[b]]}]]]; 
List[newQ, 
          Union[getΣ[at], getΣ[bt]], 
          newδ, {Max[newQ]}, 
          Union[getF[at], getF[bt]]]]

concatA[a_, b_] := 
      Module[{at, bt, newQ, newδ}, 
at = 
          renameQ[a]; 
bt = 
          renameQoffset[b, Length[getQ[a]]]; 
newQ = 
          Union[getQ[at], getQ[bt]]; 
newδ = 
          Union[getδ[at], 
            getδ[bt]]; 
newδ = 
          Union[newδ, 
            Flatten[Table[{getF[at, i], "", getI[bt, j]}, {i, 
                  Length[getF[at]]}, {j, Length[getI[bt]]}], 
              1]]; 
List[newQ, 
          Union[getΣ[at], getΣ[bt]], newδ, 
          getI[at], getF[bt]]]

starA[
        a_] := Module[{at, newQ, newδ}, 
at = 
          renameQ[a]; 
newQ = 
          getQ[at]; 
AppendTo[newQ, 
          Length[newQ] + 1]; 
newδ = 
          getδ[at]; 
        newδ = 
          Union[newδ, 
            Join[Table[{getF[at, i], "", Max[newQ]}, {i, 
                  Length[getF[at]]}], 
              Table[{Max[newQ], "", getI[at, i]}, {i, 
                  Length[getI[at]]}]]]; 
List[newQ, 
          getΣ[at], newδ, {Max[newQ]}, 
          Union[getF[at], {Max[newQ]}]]]

plusA[
        a_] := Module[{at, newQ, newδ}, 
at = 
          renameQ[a]; 
newQ = 
          getQ[at]; 
AppendTo[newQ, 
          Length[newQ] + 1]; 
newδ = 
          getδ[at]; 
        newδ = 
          Union[newδ, 
            Join[Table[{getF[at, i], "", Max[newQ]}, {i, 
                  Length[getF[at]]}], 
              Table[{Max[newQ], "", getI[at, i]}, {i, 
                  Length[getI[at]]}]]]; 
List[newQ, 
          getΣ[at], newδ, {Max[newQ]}, 
          getF[at]]]

interA[a_, b_] := 
      Module[{newΣ, newQ, newδ, newF, at, bt, 
          auxInterA}, 
  

auxInterA[
            at_, bt_, s_] := 
          Module[{f, x, 
              y}, 
f[x_, y_] := {{Part[x, 1], Part[y, 1]}, 
                Part[x, 2], {Part[x, 3], Part[y, 3]}}; 
            x = Cases[getδ[at], {_, s, _}]; 
y = 
              Cases[getδ[bt], {_, s, _}]; 
Flatten[
              Table[f[x[[i]], 
                  y[[j]]], {i, 
                  Length[x]}, {j, Length[y]}], 
              1]]; 

newΣ = 
          Union[getΣ[a], 
            getΣ[b]]; 
at = 
          putΣ[a, newΣ]; 
bt = 
          putΣ[b, newΣ]; 
If[
          Not[isDeterministic[at]], 
          at = renameQ[determinize[at]]]; 
If[
          Not[isDeterministic[bt]], 
          bt = renameQ[determinize[bt]]]; 
newQ = 
          Flatten[Table[{getQ[at, i], getQ[bt, j]}, {i, 
                Length[getQ[at]]}, {j, Length[getQ[bt]]}], 
            1]; 
newδ = 
          Flatten[Map[auxInterA[at, bt, #] &, newΣ], 
            1]; 
newF = 
          Flatten[Table[{getF[at, i], getF[bt, j]}, {i, 
                Length[getF[at]]}, {j, Length[getF[bt]]}], 
            1]; 
List[newQ, newΣ, 
          newδ, {{First[getI[at]], First[getI[bt]]}}, 
          newF]]

(* 
      returns an automaton with accept the shuffle of the two languages accepted by at and bt *) 

shuffleA[at_, bt_] := 
      Module[{newQ, newΣ, newδ, newI, newF, rules1, 
          rules2, rules3, rules4, rules, a = at, b = bt, auxShuffle1, 
          auxShuffle2}, 

 (* 
          this auxiliary function takes all transitions {q, s, 
              q . s} in a and all states r in b to give a list of transitions of the form {{q, r}, 
              s, {q . s, 
                r}} *) 

auxShuffle1[a_, 
            b_, s_] := 
          Table[Map[ReplacePart[#, {Part[#, 3], getQ[b, j]}, 3] &, 
              Map[ReplacePart[#, {Part[#, 1], getQ[b, j]}, 1] &, 
                Cases[getδ[a], {_, s, _}]]], {j, 
              Length[getQ[b]]}]; 

 (* 
          this auxiliary function takes all transitions {q, s, 
              q . s} in b and all states r in a to give a list of transitions of the form {{r, q}, 
              s, {r, q . 
                  s}} *) 

auxShuffle2[
            a_, b_, s_] := 
          Table[Map[ReplacePart[#, {getQ[a, j], Part[#, 3]}, 3] &, 
              Map[ReplacePart[#, {getQ[a, j], Part[#, 1]}, 1] &, 
                Cases[getδ[b], {_, s, _}]]], {j, 
              Length[getQ[a]]}]; 

If[
          Not[isDeterministic[a]], 
          a = renameQ[determinize[a]]]; 
If[
          Not[isDeterministic[b]], 
          b = renameQ[determinize[b]]]; 
 (* first,  
          use different alphabets for the 2 automata*) 
rules1 = 
          getΣ[a]; 
rules2 = 
          Table[FromCharacterCode[96 + i], {i, 
              Length[getΣ[a]]}]; 
rules = 
          Table[rules1[[i]] -> 
              rules2[[i]], {i, 
              Length[rules1]}]; 
a = 
          ReplaceAll[a, rules]; 
rules3 = 
          getΣ[b]; 
rules4 = 
          Table[FromCharacterCode[
              96 + i + Length[getΣ[a]]], {i, 
              Length[getΣ[b]]}]; 
rules = 
          Table[rules3[[i]] -> 
              rules4[[i]], {i, 
              Length[rules3]}]; 
b = 
          ReplaceAll[b, rules]; 
 (* 
          some kind of product automaton *) 
newΣ = 
          Union[getΣ[a], 
            getΣ[b]]; 
newQ = 
          Flatten[Table[{getQ[a, i], getQ[b, j]}, {i, Length[getQ[a]]}, {j, 
                Length[getQ[b]]}], 
            1]; 
newI = {{First[getI[a]], 
              First[getI[b]]}}; 
newF = 
          Flatten[Table[{getF[a, i], getF[b, j]}, {i, Length[getF[a]]}, {j, 
                Length[getF[b]]}], 1]; 
newδ = 
          Join[Flatten[Map[auxShuffle1[a, b, #] &, getΣ[a]], 
              2], Flatten[Map[auxShuffle2[a, b, #] &, getΣ[b]], 
              2]]; 
 (* 
          go back to the initial alphabets *) 
rules = Join[Table[rules2[[i]] -> 
                rules1[[i]], {i, 
                Length[rules1]}], 
            Table[rules4[[i]] -> 
                rules3[[i]], {i, 
                Length[rules3]}]]; 
a = 
          ReplaceAll[List[newQ, newΣ, newδ, newI, newF], 
            rules]; 
a = 
          putΣ[a, 
            Union[getΣ[a]]]; 
a = 
          putδ[a, 
            Union[getδ[a]]]; 
a]

complementA[a_] := 
      Module[{at = a}, 
If[Not[isDeterministic[at]], 
          at = renameQ[determinize[at]]]; 
List[getQ[at], 
          getΣ[at], getδ[at], getI[at], 
          Complement[getQ[a], getF[a]]]]

(* 
      returns a DFA accepting words in a and not in b *) 

differenceA[a_, b_] := 
      interA[a, complementA[b]]

(* 
      produces an elementary automaton accepting exactly w *) 

wordA[w_] := 
      Module[{}, 
List[Table[i, {i, StringLength[w] + 1}], 
          Union[Characters[w]], 
          Table[{i, StringTake[w, {i}], i + 1}, {i, 1, 
              StringLength[w]}], {1}, {StringLength[w] + 1}]]

\(\(\( (*\ 
      considering\ the\ list\ li\ of\ the\ images\ of\ the\ letters\ of\ an\ homomorphism\ h, \ 
      this\ function\ returns\ a\ NFA\ accepting\ h \((a)\)\ *) \)\(
\)\(
\)\(homomA[a_, li_] := 
      Module[{at}, 
If[
          Length[li] ≠ Length[getΣ[a]] || 
            Not[Apply[And, Map[Head[#] === String &, li]]], 
          Print["EAT error : the transformation rules are not of the right kind !"], 
If[Not[isElementary[a]], at = elementary[a], 
            at = a]; 
at = 
            ReplaceAll[at, 
              Table[getΣ[at, i] -> 
                  li[[i]], {i, 
                  Length[li]}]]; 
putΣ[at, 
            Union[Flatten[
                Characters[getΣ[at]]]]]]]\)\)\)

\( (*\ 
      Returns\ the\ number\ of\ words\ of\ length\ n\ accepted\ from\ state\ q\ in\ a, \ this\ function\ remembers\ the\ values\ already\ computed, \ 
      a\ is\ assumed\ to\ be\ a\ DFA\ *) 

\(\(vectorFinal[a_] := \(vectorFinal[a] = 
          Map[If[MemberQ[getF[a], #], 1, 0] &, getQ[a]]\);\)\(
\)
    \)\)
\(\(\(fU[a_, n_] := \(fU[a, n] = 
          MatrixPower[transMatrix[a], n] . vectorFinal[a]\);\)\(
\)
    \)\)
fU[a_, q_, 
          n_] := fU[a, q, 
            n] = Take[
              fU[a, n], Position[getQ[a], 
                  q][[1]]][[1]];

(* 
      Returns the number of words of length  ≤ 
        n accepted from state q in a,  
      this function remembers the values already computed,  
      a is assumed to be a DFA *) 

fV[a_, q_, n_] := fV[a, q, n] = 
          Sum[fU[a, q, i], {i, 0, n}];

\(\(\( (*\ 
      Returns\ the\ list\ of\ the\ letters\  < \ σ\ \ in\ the\ alphabet\ of\ a\ *) \)\(
\)\(
\)\(lessThan[a_, σ_] := 
        If[MemberQ[getΣ[a], σ], 
          Drop[getΣ[a], 
            Append[\(Position[
                  getΣ[
                    a], σ]\)[[1]], Length[getΣ[a]]]], 
          Print["EAT error : not in the alphabet !"]];\)\)\)

(* computing β (q, σ) for the state p,  
      i . e,  the number of letters τ  <  σ such that p . τ = q in the automaton a,  
      a is assumed to be a DFA *) 

β[a_, q_, p_, σ_] := 
        Module[{temp = If[MemberQ[getI[a], q], 1, 0]}, 
If[
            Length[lessThan[a, σ]] == 0, temp, 
            Length[Select[getδ[a], 
                  Part[#, 1] == p && 
                      MemberQ[lessThan[a, σ], Part[#, 2]] && 
                      Part[#, 3] == q &]] + temp]];

\(\(\( (*\ Returns\ a\ transducer\ without\ final\ states, \ 
      used\ to\ compute\ the\ βq' s\ related\ to\ the\ automaton\ a, \ 
      a\ is\ assumed\ to\ be\ a\ DFA\ *) \)\(
\)\(
\)\(transducerβ[a_, 
          q_] := \(transducerβ[a, q] = 
          If[Not[isDeterministic[a]], 
            Print["EAT error : the automaton has to be deterministic !"], 
If[Not[MemberQ[getQ[a], q]], 
              Print["EAT error : the state is not a state of the automaton !"], 
transducerβ[a, q] = 
                List[getQ[a], getΣ[a], 
                  Map[{Part[#, 
                          1], {Part[#, 2], β[a, q, Part[#, 1], 
                            Part[#, 2]]}, Part[#, 3]} &, getδ[a]], 
                  getI[a], {}]]]\);\)\)\)

\(\(\( (*\ considering\ an\ automaton\ a, \ 
      it\ returns\ the\ output\ of\ the\ transducer\ computing\ the\ corresponding\ βq' 
        s\ for\ an\ input\ word\ w\ *) \)\(
\)\(
\)\(outputTransducerβ[a_, q_, w_] := 
      Module[{t = transducerβ[a, q], 
          auxOutputTransducerβ}, 

 (*\ considering\ the\ transducer\ t, \ if\ p\ is\ a\ state\ of\ t, \ 
          z\ is\ a\ word\ of\ the\ form\ σv\ and\ t\ has\ a\ transition\ {p, {σ, x}, q}\ then\ the\ function\ takes\ {p, 
              z, { ... }}\ and\ it\ returns\ {q, 
              v, {\(...\) \(x\)}}\ *) 

auxOutputTransducerβ[
            t_, {p_, z_, l_}] := 
          If[StringLength[z] > 
              0, {Last[\(Cases[
                    getδ[
                      t], {p, {StringTake[
                          z, {1}], _}, _}]\)[[1]]], StringDrop[z, 1], 
              Append[l, \(Cases[
                    getδ[
                      t], {p, {StringTake[
                          z, {1}], _}, _}]\)[[1, 2, 
                  2]]]}, {p, z, 
              l}]; 

If[
          Not[isDeterministic[a]], 
          Print["EAT error : the automaton is not deterministic"], 
          Last[Nest[auxOutputTransducerβ[t, #] &, {getI[t, 1], w, {}}, 
              StringLength[w]]]]]\)\)\)

val[a_, w_] := 
        If[Not[isDeterministic[a]], 
          Print["EAT error : the automaton is not deterministic"], 
          Apply[Plus, 
            Map[outputTransducerβ[a, #, w] . 
                  Reverse[Table[fU[a, #, i], {i, 0, StringLength[w] - 1}]] &, 
              getQ[a]]]];

(* 
      the syntactic monoid is identified with the set of functions from Q to Q,  this function returns the corresponding automaton,  
      this function remembers the values computed .  
          Notice that it has to compute the minimal automaton of a. *) 

synAutomaton[
        at_] := synAutomaton[at] = 
        Module[{a, initialState, states, trans, i, j, 
            temp}, 
a = 
            minimal[at]; 
initialState = 
            getQ[a]; 
states = {initialState}; 
i = 1; 
          trans = {}; 
While[
            i ≤ Length[states], 
For[j = 1, 
              j ≤ 
                Length[getΣ[a]], 
temp = 
                Map[transitionDet[a, #, getΣ[a, j]] &, 
                  states[[
                    i]]]; 
AppendTo[
                trans, {states[[i]], 
                  getΣ[a, j], temp}]; 
If[
                Not[MemberQ[states, temp]], 
                AppendTo[states, 
                  temp]]; 
j++;]; 
i++;]; 
List[states, 
            getΣ[a], 
            trans, {initialState}, {}]
]

\(\(\( (*\ 
      considering\ an\ accessible\ automaton\ having\ a\ unique\ initial\ state, \ it\ gives\ a\ list\ of\ couples\ {q, w}\ such\ that\ i . w = 
        q\ if\ i\ is\ the\ initial\ state\ of\ a . \ 
            It\ also\ gives\ a\ member\ of\ each\ class\ of\ the\ syntactic\ \(\(monoid\)\(.\)\)\ *) \)\(
\)\(
\)\(pathFromInit[
        at_] := \(pathFromInit[at] = 
        Module[{select, unselect, result, temp, 
            reachQ}, 
If[Length[getI[at]] > 1, 
            Print["EAT error : more than one initial state"], 
If[Not[isAccessible[at]], 
              Print["EAT error : the automaton is not accessible"], 
reachQ = 
                reached[at, getI[at, 1]]; 
select = 
                getI[at]; 
unselect = 
                Complement[reachQ, 
                  select]; 
result = {Append[
                    select, ""]}; 
While[
                Length[unselect] > 0, 
temp = 
                  First[Select[getδ[at], 
                      MemberQ[select, Part[#, 1]] && 
                          MemberQ[unselect, 
                            Part[#, 3]] &]]; 
AppendTo[
                  select, Part[temp, 3]]; 
unselect = 
                  Complement[reachQ, select]; 
AppendTo[
                  result, {Part[temp, 3], 
                    StringJoin[\(Cases[
                          result, {Part[temp, 1], _}]\)[[1, 
                        2]], 
                      Part[temp, 
                        2]]}];]; 
result]]]\)\)\)\)

(* 
      Returns a matrix being the multiplication table of the syntactic monoid of the language accepted by a *) 

synMultiplicationTable[a_] := 
      Module[{at, temp}, 
at = 
          renameQ[synAutomaton[a]]; 
temp = 
          pathFromInit[at]; 
Table[
          transitionDet[at, getI[at, 1], 
            StringJoin[temp[[i, 2]], 
              temp[[j, 2]]]], {i, 
            Length[getQ[at]]}, {j, Length[getQ[at]]}]]

(* 
      Return the indice n such that v (n - 1)  ≤  
        x  <  v (n) if it exists or  - 1,  
      auxiliary function for rep[a, 
          x] *) 

tryRep[a_, 
          x_] := Module[{n, l, test}, 
n = 
            0; 
l = 
            Length[transMatrix[a]]; 
test = 
            False; 
While[
            x ≥ fV[a, getI[a, 1], n] && 
              Not[test], 
test = 
              Table[fV[a, getI[a, 1], i], {i, n, n + l}] - 
                  fV[a, getI[a, 1], n] == 
                Table[0, {i, n, 
                    n + l}]; 
n++]; 
If[test, -1, n]];

\(\(\( (*\ 
      This\ function\ returns\ the\ xth\ word\ in\ the\ language\ accepted\ by\ a\ or\ an\ error\ string\ "not in the domain"\ if\ there\ is\ less\ than\ x\ words\ in\ the\ language\ *) \)\(
\)\(
\)\(rep[a_, x_] := 
      Module[{n, p, r, w, i, j}, 

If[
          Not[isDeterministic[a]], 
          Print["EAT error : need a deterministic automaton"], 
n = tryRep[a, x]; 
If[
            n ≥ 0, 
p = 
              getI[a, 1]; 
r = 
              x - fV[a, getI[a, 1], 
                  n - 1]; 
w = ""; 
For[i = 1, 
              i ≤ n, 
j = 
                1; 
While[
                r ≥ 
                  fU[a, transitionDet[a, p, getΣ[a, j]], 
                    n - i], 
r = 
                  r - fU[a, transitionDet[a, p, getΣ[a, j]], 
                      n - i]; 
\(j++\);]; 
p = 
                transitionDet[a, p, 
                  getΣ[a, j]]; 
w = 
                StringJoin[w, 
                  getΣ[a, j]]; 
\(i++\);]; 

            w, "not in the domain"]]]\)\)\)

(* 
      algorithm to find equivalent states T . A .  Sudkamp P .  
          186,  it gives a list of list of equivalent states, 
works with deterministic automaton,  
      so first a determinization is made if necessary,  
      remember its value *) 

equivalentStates[at_] := equivalentStates[at] = 
        Module[{mD, mS, mI, Dist, i, j, temp, flag, a}, 
If[
            Not[isDeterministic[at]], a = renameQ[determinize[at]], 
            a = renameQ[at]]; 
mI = 
            Flatten[Table[{j, i}, {i, Length[getQ[a]]}, {j, i - 1}], 
              1]; 
mD = 
            Flatten[Table[(MemberQ[getF[a], getQ[a, i]] && 
                      Not[MemberQ[getF[a], getQ[a, j]]]) || (MemberQ[
                        getF[a], getQ[a, j]] && 
                      Not[MemberQ[getF[a], getQ[a, i]]]), {i, 
                  Length[getQ[a]]}, {j, i - 1}], 1]; 
mS = 
            Flatten[Table[{}, {i, Length[getQ[a]]}, {j, i - 1}], 
              1]; 

Dist[x_] := 
            Module[{p = Position[mI, x][[1, 
                    1]], temp}, 
mD = 
                ReplacePart[mD, True, p]; 
While[
                Length[mS[[p]]] > 
                  0, 
temp = 
                  First[mS[[
                      p]]]; 
mS[[p]] = Drop[mS[[p]], 
                    1]; 
Dist[
                  temp];
];
]; 

For[i = 1, 
            i ≤ Length[mI], 
If[
              mD[[i]] == 
                False, 
flag = 
                False; 
For[j = 1, 
                j ≤ 
                  Length[getΣ[a]], 
temp = 
                  Position[mI, 
                    Sort[{transitionDet[a, 
                          mI[[i, 1]], 
                          getΣ[a, j]], 
                        transitionDet[a, 
                          mI[[i, 2]], 
                          getΣ[a, j]]}]]; 
If[
                  Length[temp] > 0, 
                  If[mD[[temp[[1, 
                        1]]]], 
                    flag = True; 
                    Dist[mI[[i]]];]]; 
j++;]; 
If[
                Not[flag], 
For[j = 1, 
                    j ≤ Length[getΣ[a]], 
                    temp = Position[mI, 
                        Sort[{transitionDet[a, 
                              mI[[i, 
                                1]], 
                              getΣ[a, j]], 
                            transitionDet[a, 
                              mI[[i, 
                                2]], 
                              getΣ[a, 
                                j]]}]]; 
If[
                      Length[temp] > 0 && 
                        Sort[{transitionDet[a, 
                                mI[[i, 
                                  1]], 
                                getΣ[a, j]], 
                              transitionDet[a, 
                                mI[[i, 
                                  2]], 
                                getΣ[a, j]]}] ≠ 
                          mI[[i]], mS[[temp[[1, 
                              1]]]] = 
                          Union[Append[
                              mS[[temp[[1, 1]]]], 
                              mI[[i]]]];]; 
j++;];
];
]; 
i++;]; 
mD = 
            Map[Part[#, 1] &, Position[mD, False]]; 
If[
            Length[mD] > 0, 
mD = 
              Map[Part[mI, #] &, mD]; 
mD = 
              Union[Map[Union[Apply[Join, #]] &, 
                  Map[Function[x, 
                      Select[mD, 
                        Part[#, 1] == x || Part[#, 2] == x &]], 
                    Union[Flatten[mD]]]]];
, 
            mD = {}]; 
Join[mD, 
            Map[{#} &, 
              Complement[getQ[a], 
                Flatten[mD]]]]
]

isReduced[a] := 
        Length[equivalentStates[a]] == Length[getQ[a]];

(* returns a minimal auton,  
      using the equivalent states procedure *) 

minimal2[at_] := 
      Module[{a = at, eqs}, 
If[Not[isDeterministic[at]], 
          a = renameQ[determinize[at]]]; 
If[
          Not[isAccessible[a]], a = accessible[a]]; 
a = 
          renameQ[a]; 
eqs = 
          equivalentStates[a]; 
List[eqs, 
          getΣ[a], 
          Flatten[Table[{eqs[[i]], 
                getΣ[a, 
                  j], Select[eqs, 
                    MemberQ[#, 
                        transitionDet[a, 
                          getQ[a, 
                            eqs[[i, 
                              1]]], 
                          getΣ[a, 
                            j]]] &][[1]]}, {i, Length[eqs]}, {j, 
                Length[getΣ[a]]}], 1], 
          Select[eqs, 
            Intersection[#, 
                  Map[Position[getQ[a], #][[1, 
                        1]] &, 
                    getI[a]]] ≠ {} &], 
          Select[eqs, 
            Intersection[#, 
                  Map[Position[getQ[a], #][[1, 
                        1]] &, 
                    getF[a]]] ≠ {} &]]
]

(* ============================================================================== *) 
 (* 
      Solving systems *) 
 (* ============================================================================== *)

concat[x_, y_] := 
        Which[x == 0 || y == 0, 0, x == "ϵ", y, 
          y == "ϵ", x, True, x <> y];
plus[x_, y_] := 
        Which[x == 0, y, y == 0, x, 
          True, "(" <> x <> "+" <> y <> ")"];

\(\(\( (*\ 
      1. \ The\ general\ \(case\  : 
consider\ equation\ x_i\)\  = \ \(\(\(\(α_  1\ x_  
                    1\)\(\ \)\(+\)\)\  ... \)\  + \ α_i\ x_i\  + \  ... \)\  + \ α_n\ x_n, 
the\ substitution\ is\ x_i\  = \ \(\(α_i\)\(^\)\)*\ \((\ \(\(\(\(α_  1\ x_  
                        1\)\(\ \)\(+\)\)\  ... \)\  + \ α_ {i - 
                        1}\ x_ {i - 1}\  + \ α_ {i + 1}\ x_ {i + 
                        1}\  + \  ... \)\  + \ α_n\ x_n\ )\), 
this\ function\ produces\ a\ rule\ to\ be\ able\ to\ produce\ this\ substitution\ in\ the\ other\ equations\ *) \)\(
\)\(
\)\(substituteRule[eq_, i_] := 
      Module[{prefix}, 
prefix = "(" <> \(Cases[
                eq, {i, _}]\)[[1, 
              2]] <> ")^*"; 
Prepend[
          Union[Append[
              Map[{Part[#, 1], concat[prefix, Part[#, 2]]} &, 
                Select[eq, Part[#, 1] ≠ i &]], {i, 0}]], 
          i]]\)\)\)

\(\(\( (*\ with\ the\ previous\ explanation, \ 
      this\ produce\ x_i\  = \ \(\(α_i\)\(^\)\)*\ \((\ \(\(\(\(α_  1\ x_  1\)\(\ \)\(+\)\)\  ... \)\  + \ α_ {i - 
                        1}\ x_ {i - 1}\  + \ α_ {i + 1}\ x_ {i + 
                        1}\  + \  ... \)\  + \ α_n\ x_n\ )\)\ *) \)\(
\)\(
\)\(solutionSubstEq[eq_, i_] := 
      Module[{prefix}, 
prefix = "(" <> \(Cases[
                eq, {i, _}]\)[[1, 
              2]] <> ")^*"; 
Prepend[
          Union[Map[{Part[#, 1], concat[prefix, Part[#, 2]]} &, 
              Select[eq, Part[#, 1] ≠ i &]], {{i, 0}}], 
          i]
]\)\)\)

(* 
      this function do the substitution given by a rule in an equation,  
      for instance it can be used to replace x_i with α_i^* ( α_  1 x_  
                      1 +  ...   +  α_ {i - 
                      1} x_ {i - 1}  +  α_ {i + 1} x_ {i + 
                      1}  +   ...   +  α_n x_n ) in the jth equation *) 

substitute[eq_, 
        rule_] := 
Module[{prefix, 
          temp}, 
prefix = Cases[
              eq, {rule[[1]], _}][[1, 2]]; 
temp = 
          Drop[rule, 1]; 
temp = 
          Map[{Part[#, 1], concat[prefix, Part[#, 2]]} &, 
            temp]; 
temp = 
          Table[{eq[[i, 1]], 
              plus[temp[[i, 2]], 
                eq[[i, 2]]]}, {i, 
              Length[eq]}]; 
ReplaceAll[
          temp, {rule[[1]], _} -> {rule[[1]], 
              0}]
]

(* 2.  A particular case,  
      do we have an equation x_i =  α_  1 x_  
                      1 +  ...   +  α_ {i - 
                      1} x_ {i - 1}  +  α_ {i + 1} x_ {i + 
                      1}  +   ...   +  α_n x_n with at least one α  ≠  0 ? *) 

canSubstituteInOther[eq_, i_] := 
      Part[eq, i + 1] == {i, 0} && 
        Drop[eq, 1] ≠ 
          Table[{j, 0}, {j, Length[eq] - 1}]

substituteInOtherRule[
        eq_, i_] := Prepend[eq, i]

canSolve[
        eq_, i_] := 
      Map[Part[#, 2] &, 
            Select[eq, 
              Part[#, 1] ≠ 0 && 
                  Part[#, 1] ≠ i &]] == 
          Table[0, {Length[eq] - 2}] && 
        eq[[i + 1, 2]] ≠ 
          0

\(\(\( (*\ in\ this\ case, \ 
      the\ solution\ is\ x_i = \(\(α\)\(^\)\)*\ β\ *) \)\(
\)\(
\)\(solve[eq_, i_] := 
      If[eq[[1, 2]] == 0, 
        0, 
concat["(" <> \(Cases[
                eq, {i, _}]\)[[1, 
              2]] <> ")^*", 
          eq[[1, 2]]]]\)\)\)

\(solveEq[equation_] := 
      Module[{eq = equation, solution, temporarySubstituted, temp, i, rule, 
          sol, prefix, index, 
          j}, 
solution = {}; 
temporarySubstituted = {}; 
temp = 
          Length[temporarySubstituted] + 
            Length[solution]; 
While[
          temp < Length[eq], 

 (*\ 
            Do\ we\ have\ some\ situation\ \(\(2\)\(\ \)\(?\)\)\ *) 
temp = 
            Table[canSubstituteInOther[
                eq[[i]], i], {i, 
                Length[eq]}]; 
While[
            Apply[Or, temp], 
index = 
              First[Flatten[Position[temp, True]]]; 
temp = 
              First[Take[eq, {index}]]; 
rule = 
              substituteInOtherRule[
                eq[[index]], 
                index]; 
AppendTo[temporarySubstituted, 
              Prepend[eq[[index]], 
                index]]; 
eq = 
              Table[substitute[eq[[i]], 
                  rule], {i, Length[eq]}]; 
eq = 
              ReplacePart[eq, Table[{j, 0}, {j, 0, Length[eq]}], 
                index]; 
temp = 
              Table[canSubstituteInOther[
                  eq[[i]], i], {i, 
                  Length[eq]}];
]; 

 (*\ 
            Do\ we\ have\ some\ situation\ \(\(1\)\(\ \)\(?\)\)\ *) 
temp = 
            Table[canSolve[eq[[i]], 
                i], {i, Length[eq]}]; 
While[
            Apply[Or, temp], 
index = 
              First[Flatten[Position[temp, True]]]; 
temp = 
              First[Take[eq, {index}]]; 
AppendTo[
              solution, {index, 
                solve[temp, index]}]; 
rule = 
              Prepend[Table[{i, 0}, {i, 0, Length[eq]}], 
                index]; 
rule = 
              ReplacePart[
                rule, {0, \(Last[
                      solution]\)[[2]]}, 
                2]; 
eq[[
                index]] = 
              Prepend[Table[{i, 0}, {i, 
                    Length[temp] - 1}], {0, \(Last[
                      solution]\)[\([2]\)]}]; 
eq = 
              Table[substitute[eq[[i]], 
                  rule], {i, Length[eq]}]; 
temp = 
              Table[canSolve[eq[[i]], 
                  i], {i, 
                  Length[eq]}];
]; 

 (*\ 
            So\ we\ have\ the\ general\ situation\ 1\ and\ we\ make\ one\ substitution\ *) 
temp = 
            Complement[Table[j, {j, Length[eq]}], 
              Union[Map[Part[#, 1] &, solution], 
                Map[Part[#, 1] &, 
                  temporarySubstituted]]]; 
If[
            Length[temp] > 0, 
index = 
              First[temp]; 
rule = 
              substituteRule[
                eq[[index]], 
                index]; 
AppendTo[temporarySubstituted, 
              solutionSubstEq[
                eq[[index]], 
                index]]; 
eq = 
              Table[substitute[eq[[i]], 
                  rule], {i, Length[eq]}]; 
eq = 
              ReplacePart[eq, Table[{j, 0}, {j, 0, Length[eq]}], 
                index];
]; 
temp = 
            Length[temporarySubstituted] + 
              Length[solution];
]; 

 (*\ 
          we\ have\ found\ solutions\ but\ also\ languages\ expressed\ in\ terms\ of\ other\ one, \ 
          so\ we\ made\ the\ last\ replacements\ *) 
While[
          Length[temporarySubstituted] > 0, 
temp = 
            Last[temporarySubstituted]; 
index = 
            temp[[1]]; 
temp = 
            Select[Drop[temp, 1], 
              Part[#, 2] ≠ 0 &]; 
prefix = 
            Select[temp, Part[#, 1] == 0 &]; 
If[
            Length[prefix] > 0, sol = prefix[\([1, 2]\)]; 
            temp = Drop[temp, 1];, 
            sol = "ϵ"]; 
While[
            Length[temp] > 0, 
            sol = plus[sol, 
                concat[\(First[
                      temp]\)[[2]], \(Select[solution, Part[#, 1] == \(First[
                              temp]\)[[1]] &]\)[[1, 2]]]]; 
            temp = Drop[temp, 1];]; 
AppendTo[
            solution, {index, 
              sol}]; 
temporarySubstituted = 
            Drop[temporarySubstituted, \(-1\)];
]; 

Union[
          solution]
]\)

\(\(\( (*\ 
      This\ function\ produces\ a\ set\ of\ equations\ for\ a\ given\ automaton\ *) \)\(
\)\(
\)\(buildEq[at_] := 
      Module[{a = renameQ[at], 
          auxBuildEq}, 

auxBuildEq[a_, 
            k_, i_] := 
          Module[{temp}, 
            temp = Cases[getδ[a], {k, _, i}]; 
Which[
              Length[temp] == 0, 0, Length[temp] == 1, 
              ReplaceAll[
                temp[[1, 
                  2]], "" -> "ϵ"], True, 
              ReplaceAll[
                StringJoin[
                    Map[Part[#, 2] <> "+" &, 
                      Drop[temp, \(-1\)]]] <> \(Last[
                      temp]\)[[2]], "" -> "ϵ"]]]; 

Table[
          Union[Table[{i, auxBuildEq[a, k, i]}, {i, Length[getQ[a]]}], {{0, 
                If[MemberQ[getF[a], k], "ϵ", 0]}}], {k, 
            Length[getQ[a]]}]]\)\)\)

(* =================================================================================== *) 
 (* ====    XFig  -  module  :  xgrid and xfdraw[a, 
                      filename]                        ====  *) 
 (* =================================================================================== *)

makeGrid[n_] := 
        Module[{grid = 
              Table[0, {i, n}, {j, n}]}, 
MatrixForm[
            grid]];

xfWritePreamble[strm_] := 
        Module[{}, 
Write[
            strm, "#FIG 3.2"]; 
Write[
            strm, "Landscape"]; 
Write[
            strm, "Center"]; 
Write[
            strm, "Metric"]; 
Write[
            strm, "Letter"]; 
Write[
            strm, "100.00"]; 
Write[
            strm, "Single"]; 
Write[
            strm, "-2"]; 
Write[
            strm, "1200 2"];
];

\(\(\( (*\ In\ a\ XFig\ file, \ define\ a\ circle\ of\ center\ cx, \ 
      cy\ and\ radius\ r\ *) \)\(
\)\(
\)\(xfWriteCircle[strm_, cx_, cy_, r_] := 
        Module[{mot}, 
          mot = "1 3 0 1 0 7 50 0 -1 0.000 1 0.0000 " <> 
              ToString[cx] <> " " <> ToString[cy] <> " " <> 
              ToString[r] <> " " <> ToString[r] <> " " <> 
              ToString[cx] <> " " <> ToString[cy] <> " " <> 
              ToString[cx - r] <> " " <> 
              ToString[cy]; 
Write[strm, 
            mot];
];\)\)\)

xfWriteText[
          strm_, x_, y_, t_] := 
        Module[{mot}, 
mot = "4 0 0 50 0 0 12 0.0000 4 \
135 90 " <> ToString[x - 39 - 40 (StringLength[t] - 1)] <> " "  <> 
              ToString[y + 49]  <> " " <> 
              t <> "\\001"; 
Write[strm, 
            mot];
];

\(\(\( (*\ 
      Returns\ a\ word\ for\ the\ loop\ having\ multiple\ labels\ *) \)\(
\)\(
\)\(auxloop[a_, i_] := 
      Module[{mot, temp1, temp2, j}, 
temp1 = 
          Map[Part[#, 2] &, 
            Cases[getδ[a], {i, _, i}]]; 
temp1 = 
          ReplaceAll[temp1, "" -> "-"]; 
temp2 = 
          Table[",", {j, Length[temp1] - 1}]; 
mot = 
          StringJoin[
            Append[Flatten[
                Table[{temp1[\([j]\)], temp2[\([j]\)]}, {j, Length[temp2]}]], 
              Last[temp1]]]; 
mot]\)\)\)

\(\(\( (*\ 
      Returns\ a\ word\ for\ the\ edges\ having\ multiple\ labels\ *) \)\(
\)\(
\)\(auxedge[a_, i_, j_] := 
      Module[{mot, temp1, temp2, k}, 
temp1 = 
          Map[Part[#, 2] &, 
            Cases[getδ[a], {i, _, j}]]; 
temp1 = 
          ReplaceAll[temp1, "" -> "-"]; 
temp2 = 
          Table[",", {k, Length[temp1] - 1}]; 
mot = 
          StringJoin[
            Append[Flatten[
                Table[{temp1[\([k]\)], temp2[\([k]\)]}, {k, Length[temp2]}]], 
              Last[temp1]]]; 
mot]\)\)\)

\( (*\ In\ a\ XFig\ file, \ 
      define\ a\ loop\ with\ an\ arrow\ for\ a\ circle\ of\ center\ x, 
      y\ and\ radius\ r\ *) \ 
 (*\ 
      loop\ on\ the\ right\ *) 
\(xfWriteLoop0[strm_, x_, 
          y_, r_] := 
        Module[{mot, width = r - 30}, 

          Write[strm, "3 0 0 1 0 7 50 0 -1 0.000 0 1 0 5"]; 

          Write[strm, "	 1 1 1.00 60.00 120.00"]; 
mot = "	 " <> ToString[x + r] <> " "\  <> ToString[y] <> " " <> 
              ToString[x + 2\ r] <> " " <> 
              ToString[y - width] <> " " <> 
              ToString[x + 3  r] <> " " <> ToString[y] <> " " <> 
              ToString[x + 2  r] <> " " <> 
              ToString[y + width] <> " " <> ToString[x + r] <> " "\  <> 
              ToString[y]; 
Write[strm, mot]; 

          Write[strm, "	 0.000 1.000 1.000 1.000 0.000"];
];\)

 (*\ 
      loop\ on\ the\ top\ *) \)
\(\(xfWriteLoop90[strm_, x_, y_, r_] := 
        Module[{mot, width = r - 30}, 

          Write[strm, "3 0 0 1 0 7 50 0 -1 0.000 0 1 0 5"]; 

          Write[strm, "	 1 1 1.00 60.00 120.00"]; 
mot = "	 " <> ToString[x] <> " "\  <> ToString[y - r] <> " " <> 
              ToString[x - width] <> " " <> 
              ToString[y - 2\ r] <> " " <> ToString[x] <> " " <> 
              ToString[y - 3\ r] <> " " <> 
              ToString[x + width] <> " " <> 
              ToString[y - 2\ r] <> " " <> ToString[x] <> " "\  <> 
              ToString[y - r]; 
Write[strm, mot]; 

          Write[strm, "	 0.000 1.000 1.000 1.000 0.000"];
];\)

 (*\ 
      loop\ on\ the\ left\ *) \)
\(\(xfWriteLoop180[strm_, x_, y_, r_] := 
        Module[{mot, width = r - 30}, 

          Write[strm, "3 0 0 1 0 7 50 0 -1 0.000 0 1 0 5"]; 

          Write[strm, "	 1 1 1.00 60.00 120.00"]; 
mot = "	 " <> ToString[x - r] <> " "\  <> ToString[y] <> " " <> 
              ToString[x - 2  r] <> " " <> 
              ToString[y - width] <> " " <> 
              ToString[x - 3  r] <> " " <> ToString[y] <> " " <> 
              ToString[x - 2  r] <> " " <> 
              ToString[y + width] <> " " <> ToString[x - r] <> " "\  <> 
              ToString[y]; 
Write[strm, mot]; 

          Write[strm, "	 0.000 1.000 1.000 1.000 0.000"];
];\)

 (*\ 
      loop\ at\ the\ bottom\ *) \)
\(\(xfWriteLoop270[strm_, x_, y_, r_] := 
        Module[{mot, width = r - 30}, 

          Write[strm, "3 0 0 1 0 7 50 0 -1 0.000 0 1 0 5"]; 

          Write[strm, "	 1 1 1.00 60.00 120.00"]; 
mot = "	 " <> ToString[x] <> " "\  <> ToString[y + r] <> " " <> 
              ToString[x - width] <> " " <> 
              ToString[y + 2\ r] <> " " <> ToString[x] <> " " <> 
              ToString[y + 3\ r] <> " " <> 
              ToString[x + width] <> " " <> 
              ToString[y + 2\ r] <> " " <> ToString[x] <> " "\  <> 
              ToString[y + r]; 
Write[strm, mot]; 

          Write[strm, "	 0.000 1.000 1.000 1.000 0.000"];
];\)\)

\(\(\( (*\ In\ a\ XFig\ file, \ define\ a\ line\ from\ x1, y1\ to\ x2, 
      y2\ *) \)\(
\)\(
\)\(xfWriteLine[
          strm_, x1_, y1_, x2_, y2_] := 
        Module[{mot}, 

          Write[strm, "2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 1 0 2"]; 

          Write[strm, "	 1 1 1.00 60.00 120.00"]; 
mot = "	 " <> ToString[x1] <> " "\  <> ToString[y1] <> " "\  <> 
              ToString[x2] <> " "\  <> 
              ToString[y2]; 
Write[strm, 
            mot];];\)\)\)

\(\(\( (*\ In\ a\ XFig\ file, \ define\ arc\ from\ x1, y1\ to\ x2, 
      y2\ *) \)\(
\)\(
\)\(xfWriteArc[
          strm_, x1_, y1_, x2_, y2_] := 
        Module[{mot}, 
mot = "5 1 0 1 0 7 50 0 -1 0.000 0 1 1 0 "; 
mot = 
            mot <> ToString[Floor[\((x1 + x2)\)/2 + y2 - y1]] <> ".000 " <> 
              ToString[
                Floor[\((y1 + y2)\)/
                      2 - \((x2 - 
                        x1)\)]] <> ".000 "; 
mot = 
            mot <> ToString[x1] <> " " <> ToString[y1] <> " " <> 
              ToString[Floor[\((x1 + x2)\)/2]] <> " " <> 
              ToString[Floor[\((y1 + y2)\)/2 + 300]] <> " " <> 
              ToString[x2] <> " " <> 
              ToString[y2]; 
Write[strm, mot]; 

          Write[strm, "	 1 1 1.00 60.00 120.00"];];\)\)\)

goodGrid[a_, xfgrid_] := 
        Sort[Select[Flatten[xfgrid], # > 0 &]] == 
          Table[i, {i, Length[getQ[a]]}];

\(\(\( (*\ 
      main\ function\ for\ outputing\ a\ file\ "filename"\ for\ the\ automaton\ a\ *) \)\(
\)\( (*\ 
      it\ uses\ the\ variable\ xfgrid\ for\ the\ position\ of\ the\ states\ *) \)\(
\)\(
\)\(xfdraw[b_, xfgrid_, 
        filename_, autoRun_] := 
      Module[{i, j, strm, unit = 500, radius = 180, smallradius = 150, 
          step = 900, mot, x1, x2, y1, y2, offsettext = 90, tempf, flag, 
          a}, 
\(Which[Not[goodAutomaton[b]], 
            Print["EAT error : the automaton is not of the right form !"], 
Not[goodGrid[b, xfgrid]], 
            Print["EAT error : the matrix is not of the right form !"], 
Not[Head[xfgrid[\([1]\)]] === List], 
            Print["EAT error : the matrix is not of the right form !"], 
Not[Head[filename] === String], 
            Print["EAT error : the filename is not a string !"], 
Not[autoRun ∈ Booleans], 
            Print["EAT error : autoRun must be a boolean !"], 
True, 
a = 
              renameQ[b]; 
mot = 
              filename <> ".fig"; 
strm = 
              OpenWriteBinary[mot]; 
xfWritePreamble[
              strm]; 
For[i = 1, 
              i ≤ Length[getQ[a]], 
 (*\ 
                states\ positionned\ with\ respect\ to\ the\ xfgrid\ *) 

xfWriteCircle[strm, 
                unit + step*\(Position[xfgrid, i]\)[\([1, 2]\)], 
                unit + step*\(Position[xfgrid, i]\)[\([1, 1]\)], 
                radius]; 
If[
                MemberQ[getF[a], 
                  i], \(xfWriteCircle[strm, 
                    unit + step*\(Position[xfgrid, i]\)[\([1, 2]\)], 
                    unit + step*\(Position[xfgrid, i]\)[\([1, 1]\)], 
                    smallradius];\)]; 
xfWriteText[strm, 
                unit + step*\(Position[xfgrid, i]\)[\([1, 2]\)], 
                unit + step*\(Position[xfgrid, i]\)[\([1, 1]\)], 
                ToString[i\ ]]; 

 (*\ 
                loops\ *) 

If[
                counting2[a, i, i] > 0, 
If[
                  counting2[a, i, i] > 
                    1, \(mot = 
                      auxloop[a, 
                        i];\), \(mot = \(Map[Part[#, 2] &, 
                            Cases[getδ[a], {i, _, 
                                i}]]\)[\([1]\)] /. "" -> "-";\)]; 
tempf = xfWriteLoop90; 
                flag = 0; 

Which[
\((\(Position[xfgrid, i]\)[\([1, 1]\)] == 
                      1)\), \  (*state\ on\ the\ first\ line\ in\ xfgrid\ *) 
tempf = xfWriteLoop90; 
                  flag = 1; 
xfWriteText[strm, 
                    unit + step*\(Position[xfgrid, i]\)[\([1, 2]\)] + 
                      radius\  + 40 \((StringLength[mot] - 1)\), 
                    unit + step*\(Position[xfgrid, i]\)[\([1, 1]\)] - 
                      2\ radius, 
                    mot];, 
\((\(Position[xfgrid, 
                          i]\)[\([1, 1]\)] == 
                      Length[xfgrid])\),  (*state\ on\ the\ last\ line\ *) 
tempf = xfWriteLoop270; 
                  flag = 1; 
xfWriteText[strm, 
                    unit + step*\(Position[xfgrid, i]\)[\([1, 2]\)] + 
                      radius + 40 \((StringLength[mot] - 1)\), 
                    unit + step*\(Position[xfgrid, i]\)[\([1, 1]\)] + 
                      2\ radius, 
                    mot];, 
\((\(Position[xfgrid, 
                          i]\)[\([1, 2]\)] == 
                      1)\),  (*state\ on\ the\ left\ *) 
tempf = xfWriteLoop180; 
                  flag = 1; 
xfWriteText[strm, 
                    unit + step*\(Position[xfgrid, i]\)[\([1, 2]\)] - 
                      2  radius, 
                    unit + step*\(Position[xfgrid, i]\)[\([1, 1]\)] - \ 
                      radius, 
                    mot];, 
\((\(Position[xfgrid, 
                          i]\)[\([1, 2]\)] == 
                      Length[xfgrid])\),  (*state\ on\ the\ right\ *) 
tempf = xfWriteLoop0; 
                  flag = 1; 
xfWriteText[strm, 
                    unit + step*\(Position[xfgrid, i]\)[\([1, 2]\)] + 
                      2  radius, 
                    unit + step*\(Position[xfgrid, i]\)[\([1, 1]\)] - \ 
                      radius, 
                    mot];
]; 

If[\((flag == 0 && 
                      xfgrid[\([\(Position[xfgrid, i]\)[\([1, 1]\)] - 
                              1, \(Position[xfgrid, i]\)[\([1, 
                                2]\)]]\)] == 
                        0)\), 
tempf = xfWriteLoop90; 
                  flag = 1; 
xfWriteText[strm, 
                    unit + step*\(Position[xfgrid, i]\)[\([1, 2]\)] + 
                      radius + 40 \((StringLength[mot] - 1)\), 
                    unit + step*\(Position[xfgrid, i]\)[\([1, 1]\)] - 
                      2\ radius, 
                    mot];]; 

If[\((flag == 0 && xfgrid[\([\(Position[xfgrid, i]\)[\([1, 1]\)] + 
                              1, \(Position[xfgrid, i]\)[\([1, 
                                2]\)]]\)] == 
                        0)\), 
tempf = xfWriteLoop270; 
                  flag = 1; 
xfWriteText[strm, 
                    unit + step*\(Position[xfgrid, i]\)[\([1, 2]\)] + 
                      radius + 40 \((StringLength[mot] - 1)\), 
                    unit + step*\(Position[xfgrid, i]\)[\([1, 1]\)] + 
                      2\ radius, 
                    mot];]; 

If[\((flag == 0 && xfgrid[\([\(Position[xfgrid, i]\)[\([1, 
                                1]\)], \(Position[xfgrid, i]\)[\([1, 2]\)] - 
                              1]\)] == 0)\), 
tempf = 
                    xfWriteLoop180; 
                  flag = 1; 
xfWriteText[strm, 
                    unit + step*\(Position[xfgrid, i]\)[\([1, 2]\)] - 
                      2  radius, 
                    unit + step*\(Position[xfgrid, i]\)[\([1, 1]\)] + \ 
                      radius, 
                    mot];]; 

If[\((flag == 0 && xfgrid[\([\(Position[xfgrid, i]\)[\([1, 
                                1]\)], \(Position[xfgrid, i]\)[\([1, 2]\)] + 
                              1]\)] == 0)\), 
tempf = 
                    xfWriteLoop0; 
                  flag = 1; 
xfWriteText[strm, 
                    unit + step*\(Position[xfgrid, i]\)[\([1, 2]\)] + 
                      2  radius, 
                    unit + step*\(Position[xfgrid, i]\)[\([1, 1]\)] + \ 
                      radius, 
                    mot];]; 

tempf[strm, 
                  unit + step*\(Position[xfgrid, i]\)[\([1, 2]\)], 
                  unit + step*\(Position[xfgrid, i]\)[\([1, 1]\)], 
                  radius]; 
If[\((flag == 
                      0)\), 
\(xfWriteText[strm, 
                      unit + step*\(Position[xfgrid, i]\)[\([1, 2]\)] + 
                        radius + 40 \((StringLength[mot] - 1)\), 
                      unit + step*\(Position[xfgrid, i]\)[\([1, 1]\)] - 
                        2\ radius, 
                      
                      mot];\)];
]; 

 (*\ transitions\ *) 
For[j = 1, 
                j ≤ Length[getQ[a]], 
If[
                  i ≠ j && 
                    counting2[a, i, j] > 0, 
x1 = 
                    unit + step*\(Position[xfgrid, i]\)[\([1, 
                            2]\)]; 
y1 = 
                    unit + step*\(Position[xfgrid, i]\)[\([1, 
                            1]\)]; 
x2 = 
                    unit + step*\(Position[xfgrid, j]\)[\([1, 
                            2]\)]; 
y2 = 
                    unit + step*\(Position[xfgrid, j]\)[\([1, 
                            1]\)]; 
If[
                    counting2[a, i, j] > 
                      1, \(mot = 
                        auxedge[a, i, 
                          j];\), \(mot = \(Cases[
                              getδ[a], {i, _, j}]\)[\([1, 
                              2]\)] /. "" -> "-";\)]; 
Which[
\((x1 == x2 && y1 < y2 && 
                        counting2[a, j, i] == 0)\), \  (*\ 
                      arrow\ from\ top\ to\ bottom\ *) 
\(If[
                        Sum[xfgrid[\([k, \(Position[xfgrid, i]\)[\([1, 
                                    2]\)]]\)], {k, \(Position[xfgrid, 
                                    i]\)[\([1, 1]\)] + 
                                1, \(Position[xfgrid, j]\)[\([1, 1]\)] - 
                                1}] == 
                          0, 
xfWriteLine[strm, x1, 
                          y1 + radius, x2, y2 - radius]; 
                        xfWriteText[strm, x1 + offsettext, 
                          Floor[\((y1 + y2)\)/2], 
                          mot];, 
xfWriteArc[strm, x1, 
                          y1 + radius, x2, y2 - radius]; 
                        xfWriteText[strm, x1 + Floor[\((y1 - y2)\)/5], 
                          Floor[\((y1 + y2)\)/2], 
                          mot];
];\), 
\((x1 == x2 && y1 > y2 && 
                        counting2[a, j, i] == 0)\), \  (*\ 
                      arrow\ from\ bottom\ to\ top\ *) 
\(If[
                        Sum[xfgrid[\([k, \(Position[xfgrid, i]\)[\([1, 
                                    2]\)]]\)], {k, \(Position[xfgrid, 
                                    j]\)[\([1, 1]\)] + 
                                1, \(Position[xfgrid, i]\)[\([1, 1]\)] - 
                                1}] == 
                          0, 
xfWriteLine[strm, x1, 
                          y1 - radius, x2, y2 + radius]; 
                        xfWriteText[strm, x1 + offsettext, 
                          Floor[\((y1 + y2)\)/2], 
                          mot];, 
xfWriteArc[strm, x1, 
                          y1 - radius, x2, y2 + radius]; 
                        xfWriteText[strm, x1 + Floor[\((y1 - y2)\)/5], 
                          Floor[\((y1 + y2)\)/2], 
                          mot];
];\), 
\((x1 < x2 && y1 == y2 && 
                        counting2[a, j, i] == 0)\),  (*\ 
                      arrow\ from\ left\ to\ right\ *) 
\(If[
                        Apply[Plus, 
                            Take[xfgrid[\([\(Position[xfgrid, i]\)[\([1, 
                                      1]\)]]\)], {\(Position[xfgrid, 
                                      i]\)[\([1, 2]\)] + 
                                  1, \(Position[xfgrid, j]\)[\([1, 2]\)] - 
                                  1}]] == 
                          0, 
xfWriteLine[strm, 
                          x1 + radius, y1, x2 - radius, y2]; 
                        xfWriteText[strm, Floor[\((x1 + x2)\)/2], 
                          y1 - offsettext, 
                          mot];, 
xfWriteArc[strm, 
                          x1 + radius, y1, x2 - radius, y2]; 
                        xfWriteText[strm, Floor[\((x1 + x2)\)/2], 
                          y1 - Floor[\((x1 - x2)\)/6], 
                          mot];
];\), 
\((x1 > x2 && y1 == y2 && 
                        counting2[a, j, i] == 0)\),  (*\ 
                      arrow\ from\ right\ to\ left\ *) 
\(If[
                        Apply[Plus, 
                            Take[xfgrid[\([\(Position[xfgrid, i]\)[\([1, 
                                      1]\)]]\)], {\(Position[xfgrid, 
                                      j]\)[\([1, 2]\)] + 
                                  1, \(Position[xfgrid, i]\)[\([1, 2]\)] - 
                                  1}]] == 0, 
                        xfWriteLine[strm, x1 - radius, y1, x2 + radius, y2]; 
                        xfWriteText[strm, Floor[\((x1 + x2)\)/2], 
                          y1 - offsettext, mot];, 
                        xfWriteArc[strm, x1 - radius, y1, x2 + radius, y2]; 
                        xfWriteText[strm, Floor[\((x1 + x2)\)/2], 
                          y1 - \ Floor[\((x1 - x2)\)/6], 
                          mot];
];\), 

\((x1 == x2 && y1 < y2 && 
                        counting2[a, j, i] > 0)\),  (*\ 
                      arc\ from\ top\ to\ bottom\ *) 
xfWriteArc[strm, x1, y1 + radius, x2, y2 - radius]; 
                    xfWriteText[strm, x1 + Floor[\((y1 - y2)\)/5], 
                      Floor[\((y1 + y2)\)/2], 
                      mot];, 
\((x1 == x2 && y1 > y2 && 
                        counting2[a, j, i] > 0)\), \  (*\ 
                      arc\ from\ bottom\ to\ top\ *) 
xfWriteArc[strm, x1, y1 - radius, x2, y2 + radius]; 
                    xfWriteText[strm, x1 + Floor[\((y1 - y2)\)/5], 
                      Floor[\((y1 + y2)\)/2], 
                      mot];, 
\((x1 < x2 && 
                        y1 == y2)\),  (*\ 
                      
                      arc\ from\ left\ to\ right\ *) 
xfWriteArc[strm, x1 + radius, y1, x2 - radius, y2]; 
                    xfWriteText[strm, Floor[\((x1 + x2)\)/2], 
                      y1 - Floor[\((x1 - x2)\)/6], 
                      mot];, 
\((x1 > x2 && y1 == y2 && 
                        counting2[a, j, i] > 0)\),  (*\ 
                      arc\ from\ right\ to\ left\ *) 
xfWriteArc[strm, x1 - radius, y1, x2 + radius, y2]; 
                    xfWriteText[strm, Floor[\((x1 + x2)\)/2], 
                      y1 - \ Floor[\((x1 - x2)\)/6], 
                      mot];, 

\((x1 < 
                          x2 && y1 < \ y2)\),  (*\ 
                      top - left\ to\ bottom - 
                        right\ *) 
xfWriteArc[strm, x1, 
                      y1 + radius, x2 - radius, 
                      y2]; 
xfWriteText[strm, 
                      Floor[\((x1 + x2)\)/2 + \((y1 - y2)\)/6], \ 
                      Floor[\((y1 + y2)\)/2 + \((x2 - x1)\)/3], 
                      mot];, 
\((x1 < x2 && 
                        y1 > \ y2)\),  (*\ 
                      bottom - left\ to\ top - 
                        right\ *) 
xfWriteArc[strm, 
                      x1 + radius, y1, x2, 
                      y2 + radius]; 
xfWriteText[strm, 
                      Floor[\((x1 + x2)\)/2 + \((y1 - y2)\)/6], \ 
                      Floor[\((y1 + y2)\)/2 + \((x2 - x1)\)/3], 
                      mot];, 
\((x1 > x2 && 
                        y1 < \ y2)\),  (*\ 
                      top - right\ to\ bottom - 
                        left\ *) 
xfWriteArc[strm, x1, 
                      y1 + radius, x2 + radius, 
                      y2]; 
xfWriteText[strm, 
                      Floor[\((x1 + x2)\)/2 + \((y1 - y2)\)/9], \ 
                      Floor[\((y1 + y2)\)/2 + \((x2 - x1)\)/9], 
                      mot];, 
\((x1 > x2 && 
                        y1 > \ y2)\),  (*\ 
                      bottom - right\ to\ top - 
                        left\ *) 
xfWriteArc[strm, 
                      x1 - radius, y1, x2, 
                      y2 + radius]; 
xfWriteText[strm, 
                      Floor[\((x1 + x2)\)/2 + \((y1 - y2)\)/9], \ 
                      Floor[\((y1 + y2)\)/2 + \((x2 - x1)\)/9], 
                      mot];
];
]; 
\(j++\);]; 
\(i++\);]; 
 (*\ initial\ states\ *) 
For[i = 1, 
              i ≤ Length[getI[a]], 
x1 = 
                unit + step*\(Position[xfgrid, \(getI[a]\)[\([i]\)]]\)[\([1, 
                        2]\)]; 
y1 = 
                unit + step*\(Position[xfgrid, \(getI[a]\)[\([i]\)]]\)[\([1, 
                        1]\)]; 
xfWriteLine[strm, 
                x1 - Floor[\ Sqrt[2]\ radius/0.7], 
                y1 + Floor[Sqrt[2]\ radius/0.7], 
                x1 - Floor[Sqrt[2]\ radius/2], 
                y1 + Floor[
                    Sqrt[2]\ radius/
                        2]]; 
\(i++\);]; 
Close[strm]; 
If[
              autoRun, 
mot = "fig2dev -L eps " <> 
                  filename <> ".fig > " <> 
                  filename <> ".eps"; 
Print[
                mot]; 
Run[
                mot]];
];\)
]\)\)\)

\(\(\( (*\ 
      it\ uses\ xfdraw\ to\ output\ an\ xfig\ filename . 
          fig\ file\ for\ a\ transducer\ *) \)\(
\)\(
\)\(xfdrawTransducer[t_, xfgrid_, filename_, autoRun_] := 
      Module[{newδ, 
          auxTransducer}, 

 (*\ 
          Considering\ a\ list\ {a, b,  ... }, \ 
          it\ returns\ a\ word\ "(a,b,...)", \ 
          this\ is\ an\ auxiliary\ function\ for\ xfdrawTransducer\ *) 

auxTransducer[x_] := 
          Module[{temp1, temp2, mot}, 
temp1 = 
              Map[ToString[#] &, x]; 
temp2 = 
              Table[",", {j, 
                  Length[temp1] - 1}]; 
mot = "(" <> 
                StringJoin[
                  Append[Flatten[
                      Table[{temp1[\([j]\)], temp2[\([j]\)]}, {j, 
                          Length[temp2]}]], 
                    Last[temp1]]] <> ")"; 
mot]; 

newδ = 
          Map[{Part[#, 1], auxTransducer[Part[#, 2]], Part[#, 3]} &, 
            getδ[t]]; 
xfdraw[
          List[getQ[t], getΣ[t], newδ, getI[t], 
            getF[t]], xfgrid, filename, autoRun];]\)\)\)

(* =================================================================================== *) 
 (* ========= = ================== =  TeX  module                        ===  ===  ===  = =========*)  (* =================================================================================== *)

\(\(\(TeXPreamble[strm_] := 
        Module[{}, 
Write[
            strm, "% EAT automatic generated TeX file"]; 
Write[
            strm, "\documentclass[10pt,a4paper]{article}"]; 
Write[
            strm, "\usepackage{amsfonts}"]; 
Write[
            strm, "\usepackage{graphics}"]; 
Write[
            strm, "\begin{document}"];
];\)\(
\)
    \)\)
TeXPreambleEnd[strm_] := 
        Module[{}, 
Write[strm]; 
Write[
            strm, "\\end{document}"];
];

\(\(TeXAutom[strm_, filename_] := 
        Module[{mot}, 
Write[
            strm]; 
Write[
            strm, "\begin{figure}[htbp]"]; 
Write[
            strm, "	\begin{center}"]; 
mot = "		\scalebox{1}{\includegraphics{" <> 
              ToString[
                filename] <> "-autom.eps}}"; 
Write[
            strm, mot]; 
Write[
            strm, "%		\caption{The automaton }\label{fig:}"]; 
Write[
            strm, "	\end{center}"]; 
Write[
            strm, "\end{figure}"];
];\)\)

TeXTabular[strm_, mat_, 
          left_, up_] := 
        Module[{i = Length[left], j = Length[up], 
            mot}, 
Write[
            strm]; 
mot = "\\begin{tabular}{c|" <> 
              StringJoin[
                Table["c", {j}]] <> "}"; 
Write[
            strm, mot]; 
mot = " " <> 
              Table["& $" <> ToString[up[[k]]] <> "$ ", {k, 
                  j}] <> "\\\\"; 
Write[strm, 
            mot]; 
Write[
            strm, "\\hline"]; 
For[k = 1, 
            k ≤ 
              i, 
mot = " $" <> 
                ToString[left[[k]]] <> "$ " <> 
                Table["& $" <> ToString[mat[[k, l]]] <> "$ ", {l, 
                    j}] <> " \\\\"; 
Write[strm, 
              mot]; k++;
]; 
Write[
            strm, "\\end{tabular}"];
];

\(\(TeXTabular2[strm_, mat_] := 
        Module[{i = Length[mat], j = Length[mat[\([1]\)]], 
            mot}, 
Write[
            strm]; 
mot = "\begin{tabular}{" <> 
              StringJoin[
                Table["l", {j}]] <> "}"; 
Write[
            strm, mot]; 
Write[
            strm, "\hline"]; 
For[k = 1, 
            k ≤ i, 
mot = 
              Table["$" <> ToString[mat[\([k, l]\)]] <> "$ & ", {l, 
                    j - 1}] <> "$" <> 
                ToString[
                  mat[\([k, j]\)]] <> "$ \cr"; 
Write[
              strm, mot]; \(k++\);
]; 
Write[strm, "\hline"]; 
Write[
            strm, "\end{tabular}"];
];\)\)

\(TeXTrans[strm_, a_] := 
      Module[{}, 
\(If[
            isDeterministic[a], 
Write[
              strm, "\begin{center}"]; 
Write[
              strm, "\medskip"]; 
TeXTabular[strm, 
              Table[transitionDet[
                  a, \(getQ[a]\)[\([i]\)], \(getΣ[
                      a]\)[\([j]\)]], {j, Length[getΣ[a]]}, {i, 
                  Length[getQ[a]]}], getΣ[a], 
              Table[i, {i, Length[getQ[a]]}]]; 
Write[
              strm, "\end{center}"];
];\)
]\)

\(\(TeXsynMon[strm_, a_] := 
        Module[{mot, 
            temp = pathFromInit[
                renameQ[synAutomaton[a]]]}, 
temp = 
            ReplaceAll[
              temp, "" -> "\varepsilon"]; 
Write[
            strm]; 
Write[
            strm, "\medskip"]; 
Write[
            strm, "\begin{center}"]; 
Write[
            strm, "Transition table of the syntactic automaton of $L$"]; 
TeXTrans[strm, 
            renameQ[synAutomaton[a]]]; 
Write[
            strm, "\medskip"]; 
Write[
            strm, "The multiplication table of $Syn(L)$"]; 
Write[
            strm, "\medskip"]; 
TeXTabular[strm, 
            synMultiplicationTable[a], Map[Part[#, 1] &, temp], 
            Map[Part[#, 1] &, temp]]; 
Write[
            strm]; 
Write[
            strm, "\medskip"]; 
mot = 
            Table[StringJoin[{"$", 
                  ToString[temp[\([i, 1]\)]]\ , "=[", 
                  ToString[temp[\([i, 2]\)]], "]$\ "}], {i, 
                Length[temp]}]; 
Write[strm, 
            mot]; 
Write[
            strm, "\end{center}"];
];\)\)

\(\(TeXMatrix[strm_, mat_] := 
        Module[{i = Length[mat], 
            mot}, 
mot = "\left(\begin{array}{" <> 
              StringJoin[
                Table["c", {i}]] <> "}"; 
Write[
            strm, mot]; 
For[k = 1, 
            k ≤ i, 
mot = 
              Table[ToString[mat[\([k, l]\)]] <> "& ", {l, i - 1}] <> 
                ToString[
                  mat[\([k, i]\)]] <> " \cr"; 
Write[
              strm, mot]; \(k++\);
]; 
Write[
            strm, "\end{array}\right)"];
];\)\)

\(\(TeXAdj[strm_, a_] := 
        Module[{mot, z}, 
Write[
            strm]; 
Write[
            strm, "\begin{center} Adjacency matrix \end{center}"]; 
Write[strm, "$$A="]; 
TeXMatrix[
            strm, transMatrix[a]]; 
For[z = 1, 
            z ≤ 
              Length[getΣ[
                  a]], 
mot = "\quad A_{" <> \(getΣ[a]\)[\([z]\)] <> "}="; 
Write[strm, 
              mot]; 
TeXMatrix[strm, 
              Table[Length[
                  Cases[getδ[
                      a], {\(getQ[a]\)[\([i]\)], \(getΣ[
                          a]\)[\([z]\)], \(getQ[a]\)[\([j]\)]}]], {i, 
                  Length[getQ[a]]}, {j, 
                  Length[getQ[a]]}]]; \(z++\);]; 
Write[
            strm, "$$"];
];\)\)

\(\(TeXWords[strm_, a_] := 
        Module[{nli = 6, ncol = 4, at, temp, k}, 
Write[
            strm]; 
Write[
            strm, "\begin{center} Language accepted by the automaton"]; 
Write[strm, "\medskip"]; 
tab = 
            Table[Flatten[
                Table[{i + nli*j, rep[a, i + nli*j]}, {j, 0, ncol - 1}]], {i, 
                0, nli - 1}]; 
tab = 
            ReplaceAll[
              tab, {"" -> "\varepsilon", "not in the domain" -> "---"}]; 
TeXTabular2[strm, 
            tab]; 
temp = 
            Complement[getQ[trim[a]], getI[a]]; 
If[
            Length[temp] > 
              0, 
\(For[k = 1, 
                k ≤ Length[temp], 
at = 
                  putI[a, {temp[\([k]\)]}]; 
Write[
                  strm]; 
Write[
                  strm, "\medskip"]; 
Write[
                  strm, "Language accepted from state " <> 
                    ToString[temp[\([k]\)]]]; 
Write[
                  strm, "\medskip"]; 
tab = 
                  Table[Flatten[
                      Table[{i + nli*j, rep[at, i + nli*j]}, {j, 0, 
                          ncol - 1}]], {i, 0, 
                      nli - 1}]; 
tab = 
                  ReplaceAll[
                    tab, {"" -> "\varepsilon", "not in the domain" -> "-"}]; 
TeXTabular2[strm, 
                  tab]; 
\(k++\);
];\)
]; 
Write[
            strm, "\end{center}"];
];\)\)

coeffRec[a_] := 
      Module[{mat, charpol, temp}, 
        mat = transMatrix[a]; 
charpol = 
          Det[mat - λ IdentityMatrix[
                  Length[mat]]]; 
  
temp = 
          CoefficientList[charpol, λ]; 
Reverse[
          Drop[-Last[temp] temp, -1]]]

\(\(\( (*\ 
      output\ a\ string\ giving\ a\ recurrence\ sequence\ corresponding\ to\ a\ list\ of\ coefficients\ li, \ 
      name\ is\ a\ string\ for\ the\ "variable"\ in\ the\ recurrence\ *) \)\(
\)\(
\)\(coeff2String[li_, 
        name_] := Module[{mot, temp = li}, 
If[
          temp ≠ 
            Table[0, {Length[
                  temp]}], 
mot = "\mathbf{" <> 
              name <> "}_{n+" <> 
              ToString[Length[temp]] <> "}="; 
While[
            First[temp] == 0, 
            temp = Drop[temp, 1]]; 
Which[
            First[temp] == 1, mot = mot <> "", 
            First[temp] == \(-1\), mot = mot <> "-", True, 
            mot = mot <> ToString[First[temp]]]; 
If[
            Length[temp] > 1, 
            mot = mot <> " \mathbf{" <> name <> "}_{n+" <> 
                ToString[Length[temp] - 1] <> "}", 
            mot = mot <> " \mathbf{" <> 
                name <> "}_n"]; 
temp = 
            Drop[temp, 1]; 
While[
            Length[temp] > 0, 
If[
              First[temp] ≠ 0, 
Which[
                First[temp] < \(-1\), mot = mot <> ToString[First[temp]], 
                First[temp] == \(-1\), mot = mot <> "-", 
                First[temp] == 1, mot = mot <> "+", True, 
                mot = mot <> "+" <> 
                    ToString[First[temp]]]; 
If[
                Length[temp] > 1, 
                mot = mot <> " \mathbf{" <> name <> "}_{n+" <> 
                    ToString[Length[temp] - 1] <> "}", 
                mot = mot <> " \mathbf{" <> 
                    name <> "}_n"];
]; 
temp = 
              Drop[temp, 
                1];
]; 
mot <> ", \quad \forall n\in\mathbb{N}"
]]\)\)\)

\(TeXRecSeq[strm_, a_] := 
      Module[{temp}, 
Write[strm]; 
Write[
          strm, "\medskip"]; 
Write[
          strm, "$$\begin{array}{l}"]; 
Write[strm, 
          coeff2String[
              coeffRec[a], "u"] <> " \cr"]; 
Write[
          strm, coeff2String[
              Append[coeffRec[a], 0] - 
                Prepend[
                  coeffRec[
                    a], \(-1\)], "v"] <> " \cr"]; 
Write[
          strm, "\end{array}$$"]; 
temp = 
          trim[a]; 
If[
          temp ≠ a, 
Write[
            strm]; 
Write[
            strm, "\medskip"]; 
Write[
            strm, "\noindent"]; 
Write[
            strm, "Using the trim automaton, we obtain the following relations"]; 
Write[
            strm, "$$\begin{array}{l}"]; 
temp = 
            coeffRec[temp]; 
Write[strm, 
            coeff2String[
                temp, "u"] <> " \cr"]; 
Write[strm, 
            coeff2String[
                Append[temp, 0] - 
                  Prepend[
                    temp, \(-1\)], "v"] <> " \cr"]; 
Write[
            strm, "\end{array}$$"];
]
]\)

\(TeXFirstTerms[strm_, a_] := 
      Module[{temp, size = 15}, 
temp = 
          Select[getQ[a], Not[isSink[a, #]] &]; 
Write[
          strm]; 
Write[
          strm, "\begin{center}"]; 
Write[
          strm, "First terms in the sequences $\mathbf{u}_q$'s"]; 
Write[
          strm, "\medskip"]; 
TeXTabular[strm, 
          Table[fU[a, temp[\([i]\)], n], {i, Length[temp]}, {n, 0, size}], 
          Table[temp[\([i]\)], {i, Length[temp]}], 
          Table[i, {i, size}]]; 
Write[
          strm]; 
Write[
          strm, "\medskip"]; 
Write[
          strm, "First terms in the sequences $\mathbf{v}_q$'s"]; 
Write[
          strm, "\medskip"]; 
TeXTabular[strm, 
          Table[fV[a, temp[\([i]\)], n], {i, Length[temp]}, {n, 0, size}], 
          Table[temp[\([i]\)], {i, Length[temp]}], Table[i, {i, size}]]; 
        Write[strm, "\end{center}"];
]\)

\(TeXLanguages[strm_, a_] := 
      Module[{t = solveEq[buildEq[a]]}, 
Write[
          strm]; 
Write[
          strm, "$$\left\{\begin{array}{lc}"]; 
For[
          i = 1, i ≤ Length[t], 
If[
            t[\([i, 2]\)] == 0, 
            Write[strm, "L_{" <> 
                ToString[
                  t[\([i, 
                      1]\)]] <> "}=& \emptyset \cr"], 
Write[
              strm, "L_{" <> ToString[t[\([i, 1]\)]] <> "}=& " <> 
                StringReplace[
                  t[\([i, 
                      2]\)], "ϵ" -> "\varepsilon"] <> "\cr"]]; 
\(i++\);]; 
Write[
          strm, "\end{array}\right.$$"];
]\)

\(\(TeXFile[a_, xfgrid_, filename_, autoRun_] := 
        Module[
{preamble = 
              True, 
autom = 
              True, 
trimAutom = 
              True, 
adjMat = 
              True, 
recSeq = 
              True, 
firstTerms = 
              True, 
words = 
              True, 
regexp = 
              True, 
synMon = 
              True, 

mot, at, 
            xfgridcopy = xfgrid, temp1, 
            temp2}, 
\(Which[Not[goodAutomaton[a]], 
              Print["EAT error : the automaton is not of the right form !"], 
Not[goodGrid[a, xfgrid]], 
              Print["EAT error : the matrix is not of the right form !"], 
Not[Head[xfgrid[\([1]\)]] === List], 
              Print["EAT error : the matrix is not of the right form !"], 
Not[Head[filename] === String], 
              Print["EAT error : the filename is not a string !"], 
Not[autoRun ∈ Booleans], 
              Print["EAT error : autoRun must be a boolean !"], 
Not[isDeterministic[a]], 
              Print["EAT error : this function works with deterministic automata !"], 
True, 
strm = 
                OpenWriteBinary[
                  StringJoin[filename, ".tex"]]; 
If[
                preamble, TeXPreamble[strm]]; 
TeXTrans[
                strm, a]; 
If[autom, 
                TeXAutom[strm, filename]; 
                xfdraw[a, xfgrid, StringJoin[filename, "-autom"], 
                  autoRun];]; 

If[
                trimAutom, 
at = 
                  trim[a]; 
If[a == at, 
                  Write[strm, "Notice that the automaton is trim."], 
xfgridcopy = 
                    ReplacePart[xfgridcopy, 0, 
                      Position[
                        xfgridcopy, \(Complement[getQ[a], 
                            getQ[at]]\)[\([1]\)]]]; 
TeXAutom[strm, 
                    StringJoin[
                      filename, "-trim"]]; 
temp1 = 
                    getQ[trim[a]]; 
temp2 = 
                    getQ[renameQ[trim[a]]]; 
xfgridcopy = 
                    ReplaceAll[xfgridcopy, 
                      Table[temp1[\([i]\)] -> temp2[\([i]\)], {i, 
                          Length[temp1]}]]; 
xfdraw[at, 
                    xfgridcopy, StringJoin[filename, "-trim-autom"], 
                    autoRun];];
]; 

If[adjMat, TeXAdj[strm, a]]; 
If[recSeq, 
                TeXRecSeq[strm, a]]; 
If[firstTerms, 
                TeXFirstTerms[strm, a]]; 
If[words, 
                TeXWords[strm, a]]; 
IF[regexp, 
                TeXLanguages[strm, 
                  a]]; 

If[synMon, 
                TeXsynMon[strm, a]]; 

If[
                preamble, TeXPreambleEnd[strm]]; 
Close[
                strm]; 
If[
                autoRun && 
                  preamble, 
mot = "latex " <> 
                    filename <> ".tex 1>" <> 
                    filename <> "-log"; 
Print[
                  mot]; 
Run[
                  mot]; 
mot = "dvips " <> 
                      filename <> ".dvi -o " 
                    filename <> ".ps 2>>" <> 
                      filename <> "-log"; 
Print[
                  mot]; 
Run[
                  mot];
];
];\)
];\)\)