##############################################################################
##
#W  automata.gi                  Kan Package                     Chris Wensley
#W                                                             & Anne Heyworth
##
##  This file contains a function supplied by Jose Joao Morais 
##  (Automata dev version)
##
#H  @(#)$Id: automata.gi,v 0.92 2006/02/28 gap Exp $
##
#Y  Copyright (C) 1999,2001 University of St. Andrews, North Haugh,
#Y                          St. Andrews, Fife KY16 9SS, Scotland
##
Revision.("kan/gap/automata_gi") := 
   "@(#)$Id: automata.gd,v 0.92 2006/02/28 gap Exp $";

SFAtoRatExp := function(A)
    local T,             # Transition function of the GTG
          WT,            # Weighted transition function of the GTG
          Nout,          # Number of edges going out to distinct vertices
          Nin,           # Number of edges coming in from distinct vertices
          Invertices,    # Numbers of vertices that have a transition into i
          Outvertices,   # Numbers of vertices that have a transition from i
          Inv,
          Outv,
          Q,             # number states of the GTG without counting q0 and qf
          q0, qf,        # The two extra states of the GTG
          WL,
          V,
          computeGTG,
          destroyLoop,
          destroyState,
          computeWeight,
          computeBest,   # Returns the state whose removal augments less 
                         # the wheight of WT
          flag,
          i, q, r, l,
          ratExpCopy;
    
    
    ratExpCopy := function ( r )
        local  r1, l, r2;
        l := [  ];
        if r!.op = [  ]  then
            l := ShallowCopy( r!.list_exp );
        elif not r!.op = "star"  then
            for r2  in r!.list_exp  do
                Add( l, ratExpCopy( r2 ) );
            od;
        else
            l := ratExpCopy( r!.list_exp );
        fi;
        r1 := RatExpOnnLetters( FamilyObj( r )!.alphabet2, 
                                ShallowCopy( r!.op ), l );
        return r1;
    end;
    ##  End of ratExpCopy()  --
    
    
    if not IsAutomatonObj(A) then
        Error("The argument to FAtoRatExp must be an automaton");
    fi;
    T  := [];  # Transition function of the GTG
    WT := [];
    WL := [];
    Nout := [];
    Nin := [];
    Q  := A!.states;
    q0 := A!.states + 1;
    qf := A!.states + 2;
    for i in [1 .. qf] do
        Nin[i] := 0;
    od;
    Nout[q0] := 0;  # Value not used but saves tests
    Nout[qf] := 0;  # Value not used but saves tests
    Invertices  := [];
    Outvertices := [];
    for i in [1 .. Q+2] do
        Invertices[i]  := [];
        Outvertices[i] := [];
    od;
            
    ##  Function that computes the GTG (generalized transition graph)
    ##  associated with the given FA.
    computeGTG := function()
        local list,  # List of alphabet symbols
              list2,
              x,
              a,     # Alphabet symbol
              c,     # Counter
              p, q;  # States
        
        if A!.type = "nondet" then
            for p in [1 .. A!.states] do
                T[p] := [];
                WT[p] := [];
                Nout[p] := 0;
                for q in [1 .. A!.states] do
                    list := [];
                    c := 0;
                    for a in [1 .. A!.alphabet] do
                        if q in A!.transitions[a][p] then
                            Add(list, a);
                            c := c + 1;
                            if not q = p then
                                AddSet(Invertices[q], p);
                                AddSet(Outvertices[p], q);
                            fi;
                        fi;
                    od;
                    if list = [] then
                        T[p][q] := 0;  # 0 means the empty_set
                        WT[p][q] := -1;
                    elif IsBound(list[2]) then
                        T[p][q] := RatExpOnnLetters(ShallowCopy(FamilyObj(A)!.alphabet), "union", List(list, a -> RatExpOnnLetters(ShallowCopy(FamilyObj(A)!.alphabet), [], [a])));
                        WT[p][q] := c;
                        if not p = q then
                            Nout[p] := Nout[p] + 1;
                            Nin[q] := Nin[q] + 1;
                        fi;
                    else
                        T[p][q] := RatExpOnnLetters(ShallowCopy(FamilyObj(A)!.alphabet), [], list);
                        WT[p][q] := c;
                        if not p = q then
                            Nout[p] := Nout[p] + 1;
                            Nin[q] := Nin[q] + 1;
                        fi;
                    fi;
                od;
            od;
        elif A!.type = "epsilon" then
            if IsString(FamilyObj(A)!.alphabet) then
                l := ShallowCopy(FamilyObj(A)!.alphabet);
                Unbind(l[Length(l)]);
            fi;
            for p in [1 .. A!.states] do
                T[p] := [];
                WT[p] := [];
                Nout[p] := 0;
                for q in [1 .. A!.states] do
                    list := [];
                    c := 0;
                    for a in [1 .. A!.alphabet-1] do
                        if q in A!.transitions[a][p] then
                            Add(list, a);
                            c := c + 1;
                            if not q = p then
                                AddSet(Invertices[q], p);
                                AddSet(Outvertices[p], q);
                            fi;
                        fi;
                    od;
                    a := A!.alphabet;
                    if q in A!.transitions[a][p] then
                        Add(list, 0);
                        if not q = p then
                            AddSet(Invertices[q], p);
                            AddSet(Outvertices[p], q);
                        fi;
                    fi;
                    if list = [] then
                        T[p][q] := 0;  # 0 means the empty_set
                        WT[p][q] := -1;
                    elif IsBound(list[2]) then
                        list2 := [];
                        for x in list do
                            if x = 0 then
                                if IsString(FamilyObj(A)!.alphabet) then
                                    Add(list2, RatExpOnnLetters(l, [], []));
                                else
                                    Add(list2, RatExpOnnLetters(FamilyObj(A)!.alphabet-1, [], []));
                                fi;
                            else
                                if IsString(FamilyObj(A)!.alphabet) then
                                    Add(list2, RatExpOnnLetters(l, [], [x]));
                                else
                                    Add(list2, RatExpOnnLetters(FamilyObj(A)!.alphabet-1, [], [x]));
                                fi;
                            fi;
                        od;
                        if IsString(FamilyObj(A)!.alphabet) then
                            T[p][q] := RatExpOnnLetters(l, "union", list2);
                        else
                            T[p][q] := RatExpOnnLetters(FamilyObj(A)!.alphabet-1, "union", list2);
                        fi;
                        WT[p][q] := c;
                        if not p = q then
                            Nout[p] := Nout[p] + 1;
                            Nin[q] := Nin[q] + 1;
                        fi;
                    else
                        if list = [0] then
                            if IsString(FamilyObj(A)!.alphabet) then
                                T[p][q] := RatExpOnnLetters(l, [], []);
                            else
                                T[p][q] := RatExpOnnLetters(FamilyObj(A)!.alphabet-1, [], []);
                            fi;
                        else
                            if IsString(FamilyObj(A)!.alphabet) then
                                T[p][q] := RatExpOnnLetters(l, [], list);
                            else
                                T[p][q] := RatExpOnnLetters(FamilyObj(A)!.alphabet-1, [], list);
                            fi;
                        fi;
                        WT[p][q] := c;
                        if not p = q then
                            Nout[p] := Nout[p] + 1;
                            Nin[q] := Nin[q] + 1;
                        fi;
                    fi;
                od;
            od;
        else
            for p in [1 .. A!.states] do
                T[p] := [];
                WT[p] := [];
                Nout[p] := 0;
                for q in [1 .. A!.states] do
                    list := [];
                    c := 0;
                    for a in [1 .. A!.alphabet] do
                        if q = A!.transitions[a][p] then  
                        # The only difference to the nondeterministic case
                            Add(list, a);
                            c := c + 1;
                            if not q = p then
                                AddSet(Invertices[q], p);
                                AddSet(Outvertices[p], q);
                            fi;
                        fi;
                    od;
                    if list = [] then
                        T[p][q] := 0;  # 0 means the empty_set
                        WT[p][q] := -1;
                    elif IsBound(list[2]) then
                        T[p][q] := RatExpOnnLetters(ShallowCopy(FamilyObj(A)!.alphabet), "union", List(list, a -> RatExpOnnLetters(ShallowCopy(FamilyObj(A)!.alphabet), [], [a])));
                        WT[p][q] := c;
                        if not p = q then
                            Nout[p] := Nout[p] + 1;
                            Nin[q] := Nin[q] + 1;
                        fi;
                    else
                        T[p][q] := RatExpOnnLetters(ShallowCopy(FamilyObj(A)!.alphabet), [], list);
                        WT[p][q] := c;
                        if not p = q then
                            Nout[p] := Nout[p] + 1;
                            Nin[q] := Nin[q] + 1;
                        fi;
                    fi;
                od;
            od;
        fi;
        T[q0] := []; T[qf] := [];
        WT[q0] := []; WT[qf] := [];
        for p in [1 .. A!.states] do
            T[p][q0] := 0;
            WT[p][q0] := -1;
            if p in A!.accepting then
                if A!.type = "epsilon" then
                    if IsString(FamilyObj(A)!.alphabet) then
                        T[p][qf] := RatExpOnnLetters(l, [], []);
                    else
                        T[p][qf] := RatExpOnnLetters(FamilyObj(A)!.alphabet-1, [], []);
                    fi;
                else
                    T[p][qf] := RatExpOnnLetters(ShallowCopy(FamilyObj(A)!.alphabet), [], []);
                fi;
                WT[p][qf] := 0;
                Nout[p] := Nout[p] + 1;
                AddSet(Invertices[qf], p);
                AddSet(Outvertices[p], qf);
            else
                T[p][qf] := 0;
                WT[p][qf] := -1;
            fi;
        od;
        for q in [1 .. A!.states] do
            if q in A!.initial then
                if A!.type = "epsilon" then
                    if IsString(FamilyObj(A)!.alphabet) then
                        T[q0][q] := RatExpOnnLetters(l, [], []);
                    else
                        T[q0][q] := RatExpOnnLetters(FamilyObj(A)!.alphabet-1, [], []);
                    fi;
                else
                    T[q0][q] := RatExpOnnLetters(ShallowCopy(FamilyObj(A)!.alphabet), [], []);
                fi;
                WT[q0][q] := 0;
                Nin[q] := Nin[q] + 1;
                AddSet(Invertices[q], q0);
                AddSet(Outvertices[q0], q);
            else
                T[q0][q] := 0;
                WT[q0][q] := -1;
            fi;
            T[qf][q] := 0;
            WT[qf][q] := -1;
        od;
        T[q0][q0] := 0; T[q0][qf] := 0; T[qf][q0] := 0; T[qf][qf] := 0;
        WT[q0][q0] := -1; WT[q0][qf] := -1; WT[qf][q0] := -1; WT[qf][qf] := -1;
    end;
    ##  End of computeGTG()  --
    
    ##  Function that deletes a loop in the GTG
    destroyLoop := function(n)
        local q;
        
        if not T[n][n] = 0 then
            for q in [1 .. n-1] do
                if T[n][q] = 0 then
                elif T[n][q]!.list_exp = [] then
                    T[n][q] := StarRatExp(T[n][n]);
                    WT[n][q] := WT[n][n];
                else
                    T[n][q] := ProductRatExp(StarRatExp(T[n][n]), T[n][q]);
                    WT[n][q] := WT[n][n] + WT[n][q];
                fi;
            od;
            for q in [n+1 .. Q+2] do
                if T[n][q] = 0 then
                elif T[n][q]!.list_exp = [] then
                    T[n][q] := StarRatExp(T[n][n]);
                    WT[n][q] := WT[n][n];
                else
                    T[n][q] := ProductRatExp(StarRatExp(T[n][n]), T[n][q]);
                    WT[n][q] := WT[n][n] + WT[n][q];
                fi;
            od;
            T[n][n] := 0;
            WT[n][n] := -1;
        fi;
    end;
    ##  End of destroyLoop()  --
    
    
    ##  Function that deletes a state in the GTG
    destroyState := function(n)
        local p, q;
        
        for p in Invertices[n] do
            for q in Outvertices[n] do
                if T[p][q] = 0 then
                    T[p][q] := ProductRatExp(T[p][n], T[n][q]);
                    WT[p][q] := WT[p][n] + WT[n][q];
                else
                    if T[p][q]!.op = [] and T[p][q]!.list_exp = [] and
                       T[n][q]!.op = "star" and T[n][q]!.list_exp = T[p][n] then
                        T[p][q] := ratExpCopy(T[n][q]);
                    elif T[p][q]!.op = [] and T[p][q]!.list_exp = [] and
                      T[p][n]!.op = "star" and T[p][n]!.list_exp = T[n][q] then
                        T[p][q] := ratExpCopy(T[p][n]);
                    else
                        T[p][q] := UnionRatExp(ProductRatExp(T[p][n], T[n][q]), T[p][q]);
                    fi;
                    if WT[p][q] = 0 then
                        WT[p][q] := WT[p][n] + WT[n][q] + 1;
                    else
                        WT[p][q] := WT[p][n] + WT[n][q] + WT[p][q];
                    fi;
                fi;
            od;
        od;
        for p in [1 .. n-1] do
            for q in [n .. Q+1] do
                T[p][q] := T[p][q+1];
                WT[p][q] := WT[p][q+1];
            od;
        od;
        for p in [n .. Q+1] do
            T[p] := T[p+1];
            WT[p] := WT[p+1];
            for q in [n .. Q+1] do
                T[p][q] := T[p][q+1];
                WT[p][q] := WT[p][q+1];
            od;
        od;
        Q := Q - 1;
        for p in [1 .. Q+2] do
            Nout[p] := 0;  Nin[p] := 0;
            Invertices[p] := [];  Outvertices[p] := [];
        od;
        for p in [1 .. Q+2] do
            for q in [1 .. p-1] do
                if WT[p][q] >= 0 then
                    Nout[p] := Nout[p] + 1;
                    Nin[q] := Nin[q] + 1;
                    AddSet(Invertices[q], p);
                    AddSet(Outvertices[p], q);
                fi;
            od;
            for q in [p+1 .. Q+2] do
                if WT[p][q] >= 0 then
                    Nout[p] := Nout[p] + 1;
                    Nin[q] := Nin[q] + 1;
                    AddSet(Invertices[q], p);
                    AddSet(Outvertices[p], q);
                fi;
            od;
        od;
    end;
    ##  End of destroyState()  --
    
    computeWeight := function(i)
        local w, p, q;
        

        w := 0;
        for p in Invertices[i] do
            w := w + WT[p][i] * (Nout[i] - 1);
        od;
        if WT[i][i] = -1 then  # Do nothing, there is no loop
        else
            w := w + WT[i][i] * (Nout[i] * Nin[i] - 1);
        fi;
        for q in Outvertices[i] do
            w := w + WT[i][q] * (Nin[i] - 1);
        od;
        return(w);
    end;
    ##  End of computeWeight()  --
    
    computeBest := function()
        local p, q, i, w;
        
        if WL = [] then
            for i in [1 .. Q] do
                AddSet(WL, [computeWeight(i),i]);
            od;
        else
            for i in Inv do
                AddSet(WL, [computeWeight(i),i]);
            od;
            for i in Outv do
                AddSet(WL, [computeWeight(i),i]);
            od;
        fi;
        return(WL[1][2]);
    end;
    ##  End of computeBest()  --
    
    computeGTG();
    flag := true;
    while flag do
        flag := false;
        for i in [1 .. Q] do
            if Nout[i] = 0 then
                destroyLoop(i);
                destroyState(i);
                flag := true;
                break;
            fi;
        od;
    od;
    flag := true;
    while flag do
        flag := false;
        for i in [1 .. Q] do
            if Nin[i] = 0 then
                destroyLoop(i);
                destroyState(i);
                flag := true;
                break;
            fi;
        od;
    od;
    while Q > 0 do
        V := computeBest();
        i := 1;
        while IsBound(WL[i]) do
            if WL[i][2] = V then
                Unbind(WL[i]);
            elif WL[i][2] > V then
               if WL[i][2] in Invertices[V] or WL[i][2] in Outvertices[V] then
                    Unbind(WL[i]);
               else
                    WL[i][2] := WL[i][2] - 1;
               fi;
            else
               if WL[i][2] in Invertices[V] or WL[i][2] in Outvertices[V] then
                    Unbind(WL[i]);
               fi;
            fi;
            i := i + 1;
        od;
        WL := Compacted(WL);
        Inv := Difference(Invertices[V], [Q+1,Q+2]);
        Outv := Difference(Outvertices[V], [Q+1,Q+2]);
        i := 1;
        while IsBound(Inv[i]) do
            if Inv[i] > V then
                Inv[i] := Inv[i] - 1;
            fi;
            i := i + 1;
        od;
        i := 1;
        while IsBound(Outv[i]) do
            if Outv[i] > V then
                Outv[i] := Outv[i] - 1;
            fi;
            i := i + 1;
        od;
        destroyLoop(V);
        destroyState(V);
    od;
    
    if T[1][2] = 0 then
        if A!.type = "epsilon" then
            r := RatExpOnnLetters(l, [], "empty_set");
        else
            r := RatExpOnnLetters(ShallowCopy(FamilyObj(A)!.alphabet), [], "empty_set");
        fi;
        Setter(SizeRatExp)(r,0);
        return(r);
    else
        r := T[1][2];
        if WT[1][2] = 0 then
            Setter(SizeRatExp)(r,1);
        else
            Setter(SizeRatExp)(r,WT[1][2]);
        fi;
        return(r);
    fi;
end;

############################################################################
## 
#E  automata.gi  . . . . . . . . . . . . . . . . . . . . . . . . . ends here 
## 
