SSL mealy.gi   Interaktion und
Portierbarkeitunbekannt

#############################################################################
##
#W mealy.gi                                                 Laurent Bartholdi
##
#Y Copyright (C) 2006-2013, Laurent Bartholdi
##
#############################################################################
##
##  This file implements the category of Mealy machines and elements.
##
#############################################################################

#############################################################################
##
#O InitialState(<MealyMachine>)
##
InstallMethod(InitialState, "(FR) for a Mealy machine",
        [IsMealyElement],
        M->M!.initial);
############################################################################

############################################################################
##
#O Output(<MealyMachine>, <State>)
#O Transition(<MealyMachine>, <State>, <Input>)
#O Activity(<MealyElement>[, <Level>])
#O WreathRecursion(<MealyElement>)
##
BindGlobal("DOMALPHABET@", function(M)
    local a;
    a := AlphabetOfFRObject(M);
    if IsDomain(a) then return a; else return Domain(a); fi;
end);

InstallMethod(Output, "(FR) for a Mealy machine",
        [IsMealyMachine and IsMealyMachineIntRep],
        function(M)
    return M!.output;
end);

InstallMethod(Output, "(FR) for a Mealy machine and a state",
        [IsMealyMachine and IsMealyMachineIntRep, IsInt],
        function(M, s)
    return M!.output[s];
end);

InstallMethod(Output, "(FR) for a Mealy machine, a state and a letter",
        [IsMealyMachine and IsMealyMachineIntRep, IsInt, IsInt],
        function(M, s, a)
    return M!.output[s][a];
end);

InstallMethod(Output, "(FR) for a Mealy machine",
        [IsMealyMachine and IsMealyMachineDomainRep], 20,
        function(M)
    return s->MappingByFunction(DOMALPHABET@(M), DOMALPHABET@(M),
                   a->M!.output(s,a));
end);

InstallMethod(Output, "(FR) for a Mealy machine and a state",
        [IsMealyMachine and IsMealyMachineDomainRep, IsObject], 20,
        function(M, s)
    return MappingByFunction(DOMALPHABET@(M), DOMALPHABET@(M),
                   a->M!.output(s,a));
end);

InstallMethod(Output, "(FR) for a Mealy machine, a state and a letter",
        [IsMealyMachine and IsMealyMachineDomainRep, IsObject, IsObject],
        function(M, s, a)
    return M!.output(s,a);
end);

InstallMethod(Output, "(FR) for a Mealy element",
        [IsMealyElement and IsMealyMachineIntRep],
        E->E!.output[E!.initial]);

InstallMethod(Output, "(FR) for a Mealy element and input",
        [IsMealyElement and IsMealyMachineIntRep, IsInt],
        function(E, i)
    return E!.output[E!.initial][i];
end);

InstallMethod(Output, "(FR) for a Mealy machine, a state and a letter",
        [IsMealyElement and IsMealyMachineIntRep, IsInt, IsInt],
        function(E, s, a)
    return E!.output[s][a];
end);

InstallMethod(Output, "(FR) for a Mealy element",
        [IsMealyElement and IsMealyMachineDomainRep],
        function(E)
    return MappingByFunction(DOMALPHABET@(E), DOMALPHABET@(E),
                   a->E!.output(E!.initial,a));
end);

InstallMethod(Output, "(FR) for a Mealy element and object",
        [IsMealyElement and IsMealyMachineDomainRep,IsObject],
        function(E,a)
    return E!.output(E!.initial,a);
end);

InstallMethod(Output, "(FR) for a Mealy element, a state and a letter",
        [IsMealyElement and IsMealyMachineDomainRep, IsObject, IsObject],
        function(E, s, a)
    return E!.output(s,a);
end);

InstallMethod(Transition, "(FR) for a Mealy machine, state, and input",
        [IsMealyMachine and IsMealyMachineIntRep, IsInt, IsInt],
        function(M, s, i)
    return M!.transitions[s][i];
end);

InstallMethod(Transition, "(FR) for a Mealy machine, state, and input",
        [IsMealyMachine and IsMealyMachineDomainRep, IsObject, IsObject], 40,
        function(M, s, i)
    return M!.transitions(s,i);
end);

InstallMethod(Transition, "(FR) for a Mealy element, state, and input",
        [IsMealyElement and IsMealyMachineIntRep, IsInt, IsInt],
        function(M, s, i)
    return M!.transitions[s][i];
end);

InstallMethod(Transition, "(FR) for a Mealy element, state, and input",
        [IsMealyElement and IsMealyMachineDomainRep, IsObject, IsObject], 40,
        function(M, s, i)
    return M!.transitions(s,i);
end);

InstallMethod(Transition, "(FR) for a Mealy element and input",
        [IsMealyElement and IsMealyMachineIntRep, IsInt],
        function(M, i)
    return M!.transitions[M!.initial][i];
end);

InstallMethod(Transition, "(FR) for a Mealy element and input",
        [IsMealyElement and IsMealyMachineDomainRep, IsObject], 20,
        function(M, i)
    return M!.transitions(M!.initial,i);
end);

InstallMethod(Transitions, "(FR) for a Mealy machine and state",
        [IsMealyMachine and IsMealyMachineIntRep, IsInt],
        function(M, s)
    return M!.transitions[s];
end);

InstallMethod(Transitions, "(FR) for a Mealy machine and state",
        [IsMealyMachine and IsMealyMachineDomainRep, IsObject], 40,
        function(M, s)
    return i->M!.transitions(s,i);
end);

InstallMethod(Transitions, "(FR) for a Mealy element and state",
        [IsMealyElement and IsMealyMachineIntRep, IsInt],
        function(M, s)
    return M!.transitions[s];
end);

InstallMethod(Transitions, "(FR) for a Mealy element and state",
        [IsMealyElement and IsMealyMachineDomainRep, IsObject], 40,
        function(M, s)
    return i->M!.transitions(s,i);
end);

InstallMethod(Transitions, "(FR) for a Mealy element",
        [IsMealyElement and IsMealyMachineIntRep],
        function(M)
    return M!.transitions[M!.initial];
end);

InstallMethod(Transitions, "(FR) for a Mealy element",
        [IsMealyElement and IsMealyMachineDomainRep], 20,
        function(M)
    return i->M!.transitions(M!.initial,i);
end);

BindGlobal("MMACTIVITY@", function(E,l)
    local d, i, r, s;
    d := Size(AlphabetOfFRObject(E));
    r := List([1..E!.nrstates], i->[1]);
    for i in [1..l] do
        r := List([1..E!.nrstates], s->Concatenation(List(AlphabetOfFRObject(E),
                     x->r[E!.transitions[s][x]]+d^(i-1)*(E!.output[s][x]-1))));
    od;
    return r;
end);

InstallMethod(Activity, "(FR) for a Mealy element and a level",
        [IsMealyElement, IsInt],
        function(E,l)
    return PERMORTRANSFORMATION@(Transformation(MMACTIVITY@(E,l)[E!.initial]));
end);

InstallMethod(ActivityTransformation, "(FR) for a Mealy element and a level",
        [IsMealyElement, IsInt],
        function(E,l)
    return Transformation(MMACTIVITY@(E,l)[E!.initial]);
end);

InstallMethod(ActivityPerm, "(FR) for a Mealy element and a level",
        [IsMealyElement, IsInt],
        function(E,l)
    return PermList(MMACTIVITY@(E,l)[E!.initial]);
end);

InstallMethod(\^, "(FR) for an integer and a Mealy element",
        [IsPosInt, IsMealyElement and IsMealyMachineIntRep],
        function(p,E)
    return E!.output[E!.initial][p];
end);

InstallOtherMethod(\^, "(FR) for an integer and a Mealy element",
        [IsObject, IsMealyElement and IsMealyMachineDomainRep],
        function(p,E)
    return E!.output(E!.initial,p);
end);

InstallMethod(DecompositionOfFRElement, "(FR) for a Mealy element",
        [IsMealyElement],
        function(E)
    return [List(AlphabetOfFRObject(E),a->FRElement(E,E!.transitions[E!.initial][a])),Output(E)];
end);

InstallMethod(WreathRecursion, "(FR) for a Mealy machine",
        [IsMealyMachine],
        M->(i->[M!.transitions[i],M!.output[i]]));
############################################################################

############################################################################
##
#O States(MealyMachine[, Initial])
#O States(MealyElement)
##

InstallMethod(StateSet, "(FR) for a Mealy machine",
        [IsMealyMachine and IsMealyMachineIntRep],
        M->[1..M!.nrstates]);

InstallMethod(StateSet, "(FR) for a Mealy machine",
        [IsMealyMachine and IsMealyMachineDomainRep],
        M->M!.states);

InstallMethod(StateSet, "(FR) for a Mealy element",
        [IsMealyElement and IsMealyMachineIntRep],
        E->[1..E!.nrstates]);

InstallMethod(StateSet, "(FR) for a Mealy element",
        [IsMealyElement and IsMealyMachineDomainRep],
        function(E)
    local r, oldr, i;
    oldr := [];
    r := [E!.initial];
    repeat
        i := Difference(r,oldr);
        oldr := r;
        for i in i do
            r := Union(r,List(AlphabetOfFRObject(E),a->E!.transitions(i,a)));
        od;
    until oldr = r;
    return r;
end);

InstallMethod(GeneratorsOfFRMachine, "(FR) for a Mealy machine",
        [IsMealyMachine], StateSet);

BindGlobal("MEALYLIMITSTATES@", function(M)
    local R, oldR, i, a;
    R := BlistList([1..M!.nrstates],[1..M!.nrstates]);
    repeat
        oldR := R;
        R := BlistList([1..M!.nrstates],[]);
        for i in [1..M!.nrstates] do if oldR[i] then
            for a in AlphabetOfFRObject(M) do R[M!.transitions[i][a]] := true; od;
        fi; od;
    until oldR=R;
    return ListBlist([1..M!.nrstates],R);
end);

InstallMethod(LimitStatesOfFRMachine, "(FR) for a Mealy machine",
        [IsMealyMachine and IsMealyMachineIntRep],
        M->List(MEALYLIMITSTATES@(M),i->FRElement(M,i)));
InstallMethod(LimitStates,  "(FR) for a Mealy machine",
        [IsMealyMachine and IsMealyMachineIntRep],
        LimitStatesOfFRMachine);

InstallMethod(LimitStatesOfFRElement, "(FR) for a Mealy element",
        [IsMealyElement and IsMealyMachineIntRep],
        E->List(MEALYLIMITSTATES@(E),i->FRElement(E,i)));

InstallOtherMethod(State, "(FR) for a Mealy element and an integer",
        [IsMealyElement, IsInt],
        function(E,a)
    return FRElement(E,Transition(E,a));
end);

InstallOtherMethod(State, "(FR) for a Mealy element and a list",
        [IsMealyElement, IsList],
        function(E,a)
    local s;
    s := InitialState(E);
    for a in a do
        s := Transition(E,s,a);
    od;
    return FRElement(E,s);
end);

InstallMethod(States, "(FR) for a Mealy element",
        [IsMealyElement],
        E->List(StateSet(E),s->FRElement(E,s)));

InstallMethod(FixedRay, "(FR) for a Mealy element",
        [IsMealyElement and IsMealyMachineIntRep],
        function(e)
    local f, recur, state, ray;
    f := List([1..e!.nrstates],s->Reversed(Filtered(AlphabetOfFRObject(e),a->e!.output[s][a]=a)));
    state := [];
    ray := [];
    recur := function(s,e,state,ray)
        local i;
        i := Position(state,s);
        if i<>fail then
            return CompressedPeriodicList(ray,i);
        fi;
        Add(state,s);
        while f[s]<>[] do
            i := Remove(f[s]);
            Add(ray,i);
            i := recur(e!.transitions[s][i],e,state,ray);
            if i<>fail then return i; fi;
            Remove(ray);
        od;
        Remove(state);
        return fail;
    end;
    return recur(e!.initial,e,state,ray);
end);
############################################################################

############################################################################
##
#M  Minimized . . . . . . . . . . . . . . . . . . . . minimize Mealy machine
##
# mode=0 means normal
# mode=1 means all states are known to be accessible
# mode=2 means all states are known to be distinct and accessible
BindGlobal("MMMINIMIZE@", function(fam,alphabet,nrstates,transitions,output,initial,mode)
    local a, sn, snart, part, trap, i, j, x, y, p, ci, todo, states;

    if initial<>fail and mode=0 then
        todo := [initial];
        states := BlistList([1..nrstates],todo);
        for i in todo do
            for a in alphabet do
                x := transitions[i][a];
                if not states[x] then states[x] := true; Add(todo,x); fi;
            od;
        od;
        states := ListBlist([1..nrstates],states);
    else
        states := [1..nrstates];
    fi;

    if mode<=1 then
        a := NewDictionary(output[1],true);
        part := [];
        for i in states do
            x := output[i];
            y := LookupDictionary(a,x);
            if y=fail then
                Add(part,[i]);
                AddDictionary(a,x,Length(part));
            else
                Add(part[y],i);
            fi;
        od;
        Sort(part,function(a,b) return Length(a)<Length(b); end);

        trap := [];
        for i in [1..Length(part)] do for j in part[i] do trap[j] := i; od; od;
        # inverse lookup in part

        snart := [];
        for a in alphabet do
            sn := [];
            for i in states do
                j := transitions[i][a];
                if IsBound(sn[j]) then
                    Add(sn[j],i);
                else
                    sn[j] := [i];
                fi;
            od;
            for i in states do
                if IsBound(sn[i]) then Sort(sn[i]); fi;
            od;
            Add(snart, sn);
        od;
        # reverse lookup in trans, with indices swapped:
        # snart[letter][state] = { i: trans[i][letter] = state }

        todo := [1..Length(part)-1];
        i := 1;
        while i <= Length(todo) do
            for a in alphabet do
                ci := [];
                for j in part[todo[i]] do
                    if IsBound(snart[a][j]) then Append(ci,snart[a][j]); fi;
                od;
                if Length(ci) = 0 or Length(ci) = Length(states) then continue; fi;
                ci := AsSortedList(ci);
                for j in Set(trap{ci}) do
                    p := part[j];
                    if Length(part[j]) > 1 then
                        x := Intersection(p,ci);
                        if Length(x) <> 0 and Length(x) <> Length(p) then
                            y := Difference(p,x);
                            if Length(y) > Length(x) then
                                part[j] := y;
                                Add(part,x);
                                for y in x do trap[y] := Length(part); od;
                            else
                                part[j] := x;
                                Add(part,y);
                                for x in y do trap[x] := Length(part); od;
                            fi;
                            Add(todo,Length(part));
                        fi;
                    fi;
                od;
            od;
            i := i+1;
        od;
    else
        trap := states;
    fi;

    if initial<>fail then
        x := []; y := [];
        todo := [initial];
        for i in todo do
            if not IsBound(x[trap[i]]) then
                Add(y,i);
                x[trap[i]] := Length(y);
                Append(todo,transitions[i]);
            fi;
        od;
        a := MealyElementNC(fam,
                     List(transitions{y},row->List(row,i->x[trap[i]])),
                     output{y},1);
        y := ListWithIdenticalEntries(Maximum(states)+1,Maximum(states)+1);
        for i in states do
            if IsBound(x[trap[i]]) then y[i] := x[trap[i]]; fi;
        od;
        SetCorrespondence(a,Transformation(y));
    else
        y := List(part,i->i[1]);
        a := MealyMachineNC(fam,
                     List(transitions{y},row->List(row,i->trap[i])),
                     output{y});
        SetCorrespondence(a,Transformation(trap));
    fi;
    return a;
end);

InstallMethod(Minimized, "(FR) for a Mealy machine in int rep",
        [IsMealyMachine and IsMealyMachineIntRep],
        function(M)
    if M!.output=[] then
        return M;
    else
        return MMMINIMIZE@(FamilyObj(M),AlphabetOfFRObject(M),
                       M!.nrstates,M!.transitions,M!.output,fail,0);
    fi;
end);

InstallMethod(Minimized, "(FR) for a Mealy element in int rep",
        [IsMealyElement and IsMealyMachineIntRep],
        E->MMMINIMIZE@(FamilyObj(E),AlphabetOfFRObject(E),
                E!.nrstates,E!.transitions,E!.output,E!.initial,0));

InstallMethod(Minimized, "(FR) for a Mealy machine in domain rep",
        [IsMealyMachine and IsMealyMachineDomainRep],
        M->Error("Cannot minimize Mealy machine on domain"));

InstallMethod(Minimized, "(FR) for a Mealy element in domain rep",
        [IsMealyElement and IsMealyMachineDomainRep],
        M->Error("Cannot minimize Mealy element on domain"));

InstallMethod(SubFRMachine, "(FR) for two Mealy machines",
        [IsMealyMachine and IsMealyMachineIntRep,
         IsMealyMachine and IsMealyMachineIntRep],
        function(M,N)
    local s, c;
    if AlphabetOfFRObject(N)<>AlphabetOfFRObject(M) then
        return fail;
    fi;
    s := M+N;
    c := Minimized(s);
    c := ListTransformation(Correspondence(c),s!.nrstates);
    s := [ListTransformation(Correspondence(s)[1],M!.nrstates),
          ListTransformation(Correspondence(s)[2],N!.nrstates)];
    if IsSubset(c{s[1]},c{s[2]}) then
        return Transformation(StateSet(N),i->First(StateSet(M),j->c[s[1][j]]=c[s[2][i]]));
    else
        return fail;
    fi;
end);
############################################################################

############################################################################
##
#O  MealyMachine(<Transitions>, <Output> [,<Initial>])
#O  MealyMachine(<Alphabet>, <Transitions>, <Output> [,<Initial])
#O  MealyMachine(<Stateset>, <Alphabet>, <Transitions>, <Output> [,<Initial>])
##
InstallMethod(MealyMachineNC, "(FR) for a family and two matrices",
        [IsFamily, IsMatrix, IsMatrix],
        function(f, transitions, output)
    return Objectify(NewType(f, IsMealyMachine and IsMealyMachineIntRep),
                   rec(nrstates := Length(transitions),
                       transitions := transitions,
                       output := output));
end);

InstallMethod(MealyElementNC, "(FR) for a family, two matrices and an initial state",
        [IsFamily, IsMatrix, IsMatrix, IsInt],
        function(f, transitions, output, initial)
    return Objectify(NewType(f, IsMealyElement and IsMealyMachineIntRep),
                   rec(nrstates := Length(transitions),
                       transitions := transitions,
                       output := output,
                       initial := initial));
end);

BindGlobal("MEALYMACHINEINT@", function(transitions, output, initial)
    local F, nrstates, i, out, inv;
    if Length(transitions)<>Length(output) then
        Error("<Transitions> and <Output> must have the same length\n");
    fi;
    nrstates := Length(transitions);
    if not ForAll(transitions, IsList) or
       ForAny(transitions, r->Length(r)<>Length(transitions[1])) then
        Error("All rows of <Transitions> must be lists of the same length\n");
    fi;
    if initial<>fail then
        F := FREFamily([1..Length(transitions[1])]);
    else
        F := FRMFamily([1..Length(transitions[1])]);
    fi;
    if ForAny(transitions, x->ForAny(x, i->not i in [1..nrstates])) then
        Error("An entry of <Transitions> is not in the state set\n");
    fi;
    out := List(output,x->ANY2OUT@(x,Size(F!.alphabet)));
    inv := ForAll(out,ISINVERTIBLE@);
    if ForAny(out, x->not IsSubset(F!.alphabet, x)) then
        Error("An entry of <Output> is not in the alphabet\n");
    fi;
    ConvertToRangeRep(F!.alphabet);
    #!!! a bug in GAP, range rep is destroyed by IsSubset

    i := rec(nrstates := nrstates,
             transitions := transitions,
             output := out);

    if initial<>fail then
        i.initial := initial;
        i := Objectify(NewType(F, IsMealyElement and IsMealyMachineIntRep), i);
        i := Minimized(i);
    else
        i := Objectify(NewType(F, IsMealyMachine and IsMealyMachineIntRep), i);
    fi;
    SetIsInvertible(i, inv);

    return i;
end);

InstallMethod(MealyMachine, "(FR) for a matrix and a list",
        [IsMatrix, IsList],
        function(t, o) return MEALYMACHINEINT@(t, o, fail); end);

InstallMethod(MealyElement, "(FR) for a matrix, a list and a state",
        [IsMatrix, IsList, IsInt],
        function(t, o, s) return MEALYMACHINEINT@(t, o, s); end);

BindGlobal("MEALYMACHINEDOM@", function(alphabet, transitions, output, has_init, initial)
    local F, out, trans, i, t;
    if has_init then
        F := FREFamily(alphabet);
    else
        F := FRMFamily(alphabet);
    fi;
    if Length(transitions)<>Length(output) then
        Error("<Transitions> and <Output> must have the same length\n");
    fi;
    if ForAny(output,IsList) and
       HasSize(alphabet) and Size(alphabet)<>Length(First(output,IsList)) then
        Error("<Domain> and <Output> must have the same size\n");
    fi;
    if F!.standard then
        trans := [];
        for i in transitions do
            if IsFunction(i) then
                Add(trans, List(alphabet, i));
            elif IsList(i) then
                Add(trans, i);
            else
                Add(trans, List(alphabet, y->y^i));
            fi;
        od;
        out := [];
        for i in output do
            if IsFunction(i) then
                Add(out, MappingByFunction(alphabet, alphabet, i));
            else
                Add(out, ANY2OUT@(i,Size(alphabet)));
            fi;
        od;
        t := IsMealyMachineIntRep;
        i := rec(nrstates := Length(transitions),
                 transitions := trans,
                 output := out);
    else
        trans := function(s,a)
            local newa;
            newa := F!.a2n(a);
            if IsFunction(transitions[s]) then
                return transitions[s](newa);
            elif IsList(transitions[s]) then
                return transitions[s][newa];
            else
                return newa^transitions[s];
            fi;
        end;
        out := function(s,a)
            local newa;
            newa := F!.a2n(a);
            if IsFunction(output[s]) then
                newa := output[s](newa);
            else
                newa := output[s][newa];
            fi;
            return F!.n2a(newa);
        end;
        t := IsMealyMachineDomainRep;
        i := rec(states := [1..Length(transitions)],
                 transitions := trans,
                 output := out);
    fi;
    if has_init then
        i!.initial := initial;
        i := Objectify(NewType(F, IsMealyElement and t), i);
        if t = IsMealyMachineIntRep then
            i := Minimized(i);
        fi;
    else
        i := Objectify(NewType(F, IsMealyMachine and t), i);
    fi;
    return i;
end);

InstallMethod(MealyMachine, "(FR) for an alphabet and two lists",
        [IsDomain, IsList, IsList],
        function(a, t, o) return MEALYMACHINEDOM@(a, t, o, false, 0); end);

InstallMethod(MealyElement, "(FR) for an alphabet, two lists and a state",
        [IsDomain, IsList, IsList, IsInt],
        function(a, t, o, s) return MEALYMACHINEDOM@(a, t, o, true, s); end);

InstallMethod(MealyMachine, "(FR) for alphabet, stateset and two functions",
        [IsDomain, IsDomain, IsFunction, IsFunction],
        function(stateset, alphabet, transitions, output)
    local F;
    F := FRMFamily(alphabet);
    return Objectify(NewType(F, IsMealyMachine and IsMealyMachineDomainRep),
                   rec(states := stateset,
                       transitions := transitions,
                       output := output));
end);

InstallMethod(MealyElement, "(FR) for alphabet, stateset, two functions and a state",
        [IsDomain, IsDomain, IsFunction, IsFunction, IsObject], 20,
        function(stateset, alphabet, transitions, output, s)
    local F;
    F := FREFamily(alphabet);

    return Objectify(NewType(F, IsMealyElement and IsMealyMachineDomainRep),
                   rec(states := stateset,
                       transitions := transitions,
                       output := output,
                       initial := s));
end);

InstallMethod(FRElement, "(FR) for a Mealy machine and a state",
        [IsMealyMachine and IsMealyMachineIntRep, IsInt],
        function(M,s)
    return MMMINIMIZE@(FREFamily(M),AlphabetOfFRObject(M),
                   M!.nrstates,M!.transitions,M!.output,s,0);
end);

InstallMethod(FRElement, "(FR) for a Mealy element and a state",
        [IsMealyElement and IsMealyMachineIntRep, IsInt],
        function(E,s)
    return MMMINIMIZE@(FamilyObj(E),AlphabetOfFRObject(E),
                   E!.nrstates,E!.transitions,E!.output,s,2);
end);

InstallMethod(FRElement, "(FR) for a Mealy machine and a list of states",
        [IsMealyMachine and IsMealyMachineIntRep, IsList],
        function(M,l)
    return Product(List(l,i->FRElement(M,i)));
end);

InstallMethod(FRElement, "(FR) for a Mealy element and a list of states",
        [IsMealyElement and IsMealyMachineIntRep, IsList],
        function(E,l)
    return Product(List(l,i->FRElement(E,i)));
end);

InstallMethod(FRElement, "(FR) for a Mealy machine and a state",
        [IsMealyMachine and IsMealyMachineDomainRep, IsObject],
        function(M,s)
    return Objectify(NewType(FREFamily(M), IsMealyElement and
                       IsMealyMachineDomainRep),
                       rec(states := M!.states,
                           transitions := M!.transitions,
                           output := M!.output,
                           initial := s));
end);

InstallMethod(FRElement, "(FR) for a Mealy element and a state",
        [IsMealyElement and IsMealyMachineDomainRep, IsObject],
        function(E,s)
    return Objectify(NewType(FamilyObj(E), IsMealyElement and
                   IsMealyMachineDomainRep),
                   rec(states := E!.states,
                       transitions := E!.transitions,
                       output := E!.output,
                       initial := s));
end);

BindGlobal("COMPOSEELEMENT@", function(l,p)
    local m, i, init;
    if ForAll(l,IsMealyElement) then
        m := MealyMachineNC(FRMFamily(l[1]),[List(l,x->1)],[p]);
        init := 1;
        for i in [1..Length(l)] do
            m := m+UnderlyingFRMachine(l[i]);
            init := init^Correspondence(m)[1];
            m!.transitions[init][i] := InitialState(l[i])^Correspondence(m)[2];
        od;
        return FRElement(m,init);
    else
        return FRElement([List(l,x->[x])],[p],[1]);
    fi;
end);

InstallMethod(ComposeElement, "(FR) for a list of elements and a permutation",
        [IsFRElementCollection, IsObject],
        function(l,p)
    return COMPOSEELEMENT@(l,ANY2OUT@(p,Size(AlphabetOfFRObject(l[1]))));
end);

InstallMethod(ComposeElement, "(FR) for a list of elements and a list",
        [IsFRElementCollection, IsList],
        COMPOSEELEMENT@);

InstallMethod(VertexElement, "(FR) for a vertex index and a Mealy element",
        [IsPosInt, IsMealyElement],
        function(v,E)
    local m;
    m := MealyMachineNC(FRMFamily(E),[List(AlphabetOfFRObject(E),x->2),List(AlphabetOfFRObject(E),x->2)],[AlphabetOfFRObject(E),AlphabetOfFRObject(E)])+UnderlyingFRMachine(E);
    m!.transitions[1^Correspondence(m)[1]][v] := InitialState(E)^Correspondence(m)[2];
    return FRElement(m,1^Correspondence(m)[1]);
end);

InstallMethod(DiagonalElement, "(FR) for a power and a Mealy element",
        [IsInt, IsMealyElement],
        function(n,E)
    return ComposeElement(List([0..Size(AlphabetOfFRObject(E))-1],i->E^((-1)^i*Binomial(n,i))),AlphabetOfFRObject(E));
end);

InstallMethod(UnderlyingFRMachine, "(FR) for a Mealy element",
        [IsMealyElement and IsMealyMachineIntRep],
        E->MealyMachineNC(FRMFamily(E), E!.transitions, E!.output));
#############################################################################

#############################################################################
##
#M ViewObj
##
InstallMethod(ViewString, "(FR) displays a Mealy machine in compact form",
        [IsMealyMachine and IsMealyMachineIntRep],
        function(M)
    local s;
    s := "<Mealy machine on alphabet ";
    APPEND@(s, AlphabetOfFRObject(M), " with ", M!.nrstates, " state");
    if M!.nrstates<>1 then Append(s,"s"); fi;
    Append(s,">");
    return s;
end);

InstallMethod(ViewString, "(FR) displays a Mealy machine in compact form",
        [IsMealyMachine and IsMealyMachineDomainRep],
        M->CONCAT@("<Mealy machine on alphabet ", AlphabetOfFRObject(M), " with states ", M!.states,">"));

InstallMethod(ViewString, "(FR) displays a Mealy element in compact form",
        [IsMealyElement and IsMealyMachineIntRep],
        function(E)
    local s;
    if IsOne(E) then
        s := CONCAT@("<Trivial Mealy element on alphabet ", AlphabetOfFRObject(E), ">");
    else
        s := CONCAT@("<Mealy element on alphabet ", AlphabetOfFRObject(E),
            " with ", E!.nrstates, " state");
        if E!.nrstates<>1 then Append(s,"s"); fi;
        if E!.initial<>1 then APPEND@(s,", initial state ",E!.initial); fi;
        Append(s,">");
    fi;
    return s;
end);

InstallMethod(ViewString, "(FR) displays a Mealy element in compact form",
        [IsMealyElement and IsMealyMachineDomainRep],
        E->CONCAT@("<Mealy element on alphabet ", AlphabetOfFRObject(E),
        " with states ", E!.states, ", initial state ", InitialState(E), ">"));
#############################################################################

#############################################################################
##
#M  String
##
InstallMethod(String, "(FR) Mealy machine to string",
        [IsMealyMachine and IsMealyMachineIntRep],
        M->CONCAT@("MealyMachine(",M!.transitions,", ", M!.output,")"));

InstallMethod(String, "(FR) Mealy element to string",
        [IsMealyElement and IsMealyMachineIntRep],
        E->CONCAT@("MealyElement(",E!.transitions,", ",
                   E!.output,", ",InitialState(E),")"));

InstallMethod(String, "(FR) Mealy machine to string",
        [IsMealyMachine and IsMealyMachineDomainRep],
        M->CONCAT@("MealyMachine(",M!.states,", ", AlphabetOfFRObject(M),
                ", ",M!.transitions, ", ",M!.output,")"));

InstallMethod(String, "(FR) Mealy element to string",
        [IsMealyElement and IsMealyMachineDomainRep],
        E->CONCAT@("MealyElement(",E!.states,", ", AlphabetOfFRObject(E),
                ", ",E!.transitions,", ",E!.output,", ",InitialState(E),")"));
#############################################################################

#############################################################################
##
#M  Display . . . . . . . . . . . . . . . . . . . .pretty-print Mealy machine
##
BindGlobal("MEALYDISPLAY@", function(M)
    local a, i, j, states, slen, alen, sprint, aprint, sblank, ablank, srule, arule, s;
    a := AlphabetOfFRObject(M);
    states := StateSet(M);
    if IsSubset(Integers,states) then
        slen := LogInt(Maximum(Elements(states)),8)+2;
        sprint := i->String(WordAlp("abcdefgh",i),slen);
    else
        slen := Maximum(List(states,t->Length(String(t))))+1;
        sprint := i->String(i,slen);
    fi;
    sblank := ListWithIdenticalEntries(slen,' ');
    srule := ListWithIdenticalEntries(slen,'-');
    if IsSubset(Integers,a) then
        alen := LogInt(Maximum(Elements(a)),10)+3;
        aprint := i->String(i,-alen);
    else
        alen := Maximum(List(a,t->Length(String(t))))+2;
        aprint := i->String(i,-alen);
    fi;
    ablank := ListWithIdenticalEntries(alen,' ');
    arule := ListWithIdenticalEntries(alen,'-');

    s := Concatenation(sblank," |");
    for i in a do APPEND@(s,sblank,aprint(i)," "); od;
    APPEND@(s,"\n");
    APPEND@(s,srule,"-+"); for i in a do APPEND@(s,srule,arule,"+"); od; APPEND@(s,"\n");
    for i in states do
        APPEND@(s,sprint(i)," |");
        for j in a do
            APPEND@(s,sprint(Transition(M,i,j)),",",aprint(Output(M,i,j)));
        od;
        APPEND@(s,"\n");
    od;
    APPEND@(s,srule,"-+"); for i in a do APPEND@(s,srule,arule,"+"); od; APPEND@(s,"\n");
    if IsMealyElement(M) then
        APPEND@(s,"Initial state:",sprint(InitialState(M)),"\n");
    fi;
    return s;
end);

InstallMethod(DisplayString, "(FR) for a Mealy machine",
        [IsMealyMachine], MEALYDISPLAY@);

InstallMethod(DisplayString, "(FR) for a Mealy element",
        [IsMealyElement], MEALYDISPLAY@);
#############################################################################

############################################################################
##
#M  AsMealyMachine
#M  AsGroupFRMachine
#M  AsMonoidFRMachine
#M  AsSemigroupFRMachine
#M  AsMealyElement
#M  AsGroupFRElement
#M  AsMonoidFRElement
#M  AsSemigroupFRElement
##
BindGlobal("DOMAINTOPERMTRANS@", function(X)
    local a, s, i, t, out, trans;
    a := AsSortedList(AlphabetOfFRObject(X));
    s := AsSortedList(X!.states);
    trans := List(s,x->List(a,y->Position(s,X!.transitions(x,y))));
    out := [];
    for i in s do
        Add(out,List(a,y->Position(a,X!.output(i,y))));
    od;
    i := rec(nrstates := Length(s), transitions := trans, output := out);
    if IsMealyElement(X) then
        i.initial := Position(s,X!.initial);
        i := Objectify(NewType(FREFamily([1..Length(a)]),
                     IsMealyElement and IsMealyMachineIntRep),i);
        i := Minimized(i);
    else
        i := Objectify(NewType(FRMFamily([1..Length(a)]),
                     IsMealyMachine and IsMealyMachineIntRep),i);
    fi;
    return i;
end);

BindGlobal("MAKEMEALYMACHINE@", function(f,l,init)
    local M, d;
    d := List(l,DecompositionOfFRElement);
    M := List(d,x->List(x[1],y->Position(l,y)));
    if ForAny(M,x->fail in x) then
        return fail;
    elif init<>fail then
        return MealyElementNC(f,M,List(d,x->x[2]),Position(l,init));
    else
        return MealyMachineNC(f,M,List(d,x->x[2]));
    fi;
end);

BindGlobal("ASINTREP@", function(M)
    if IsMealyMachineIntRep(M) then
        return M;
    elif IsMealyMachineDomainRep(M) then
        return DOMAINTOPERMTRANS@(M);
    elif IsFRMachine(M) then
        return MAKEMEALYMACHINE@(FamilyObj(M),
            States(List(GeneratorsOfFRMachine(M),x->FRElement(M,x))),fail);
    else
        return MAKEMEALYMACHINE@(FamilyObj(M),States(M),M);
    fi;
end);

InstallMethod(AsMealyMachine, "(FR) for a list of FR elements",
        [IsFRElementCollection],
        function(l)
    local M, d;
    M := MAKEMEALYMACHINE@(FamilyObj(UnderlyingFRMachine(l[1])),l,fail);
    SetCorrespondence(M,l);
    return M;
end);

InstallMethod(AsMealyMachine, "(FR) for a FR machine",
        [IsFRMachine],
        function(M)
    local gens, states, N;
    gens := List(GeneratorsOfFRMachine(M),x->FRElement(M,x));
    states := States(gens);
    N := MAKEMEALYMACHINE@(FamilyObj(M),states,fail);
    SetCorrespondence(N,MappingByFunction(StateSet(M),Integers,g->Position(states,g)));
    return N;
end);

InstallMethod(AsMealyMachine, "(FR) for a Mealy machine",
        [IsMealyMachine],
        function(M)
    SetCorrespondence(M,StateSet(M));
    return M;
end);

InstallMethod(AsMealyElement, "(FR) for a FR element",
        [IsFRElement],
        E->MAKEMEALYMACHINE@(FamilyObj(E),States(E),E));

InstallMethod(AsMealyElement, "(FR) for a Mealy element",
        [IsMealyElement], E->E);

InstallMethod(AsGroupFRMachine, "(FR) for a Mealy machine",
        [IsMealyMachine],
        function(M)
    local G, gen, gens, realm, ntrealm, corr, i, e;
    M := ASINTREP@(M);
    if not IsInvertible(M) then return fail; fi;
    realm := StateSet(M);
    corr := []; ntrealm := []; gens := [];
    for i in realm do
        e := FRElement(M,i);
        if IsOne(e) then
            corr[i] := 0;
        elif IsInvertible(M) and Position(gens,Inverse(e))<>fail then
            corr[i] := -corr[Position(gens,Inverse(e))];
        else
            Add(ntrealm,i);
            corr[i] := Length(ntrealm);
        fi;
        Add(gens,e);
    od;
    G := FreeGroup(Length(ntrealm));
    gens := GeneratorsOfGroup(G);
    gen := function(s) if corr[s]=0 then return One(G); elif corr[s]>0 then return gens[corr[s]]; else return gens[-corr[s]]^-1; fi; end;
    i := FRMachineNC(FamilyObj(M),G,
                 List(ntrealm,i->List(AlphabetOfFRObject(M),j->gen(Transition(M,i,j)))),
                 List(ntrealm,i->Output(M,i)));
    SetCorrespondence(i,MappingByFunction(Domain([1..Length(corr)]),G,gen));
    return i;
end);

InstallMethod(AsMonoidFRMachine, "(FR) for a Mealy machine",
        [IsMealyMachine],
        function(M)
    local G, gen, gens, realm, ntrealm, corr, i, e;
    M := ASINTREP@(M);
    realm := StateSet(M);
    corr := []; ntrealm := []; gens := [];
    for i in realm do
        e := FRElement(M,i);
        if IsOne(e) then
            corr[i] := 0;
        else
            Add(ntrealm,i);
            corr[i] := Length(ntrealm);
        fi;
        Add(gens,e);
    od;
    G := FreeMonoid(Length(ntrealm));
    gens := GeneratorsOfMonoid(G);
    gen := function(s) if corr[s]=0 then return One(G); else return gens[corr[s]]; fi; end;
    i := FRMachineNC(FamilyObj(M),G,
                 List(ntrealm,i->List(AlphabetOfFRObject(M),j->gen(Transition(M,i,j)))),
                 List(ntrealm,i->Output(M,i)));
    SetCorrespondence(i,MappingByFunction(Domain([1..Length(corr)]),G,gen));
    return i;
end);

InstallMethod(AsSemigroupFRMachine, "(FR) for a Mealy machine",
        [IsMealyMachine],
        function(M)
    local G, gen, gens, realm, ntrealm, corr, i, e;
    M := ASINTREP@(M);
    realm := StateSet(M);
    corr := []; ntrealm := []; gens := [];
    for i in realm do
        e := FRElement(M,i);
        Add(ntrealm,i);
        corr[i] := Length(ntrealm);
        Add(gens,e);
    od;
    G := FreeSemigroup(Length(ntrealm));
    gens := GeneratorsOfSemigroup(G);
    gen := function(s) return gens[corr[s]]; end;
    i := FRMachineNC(FamilyObj(M),G,
                 List(ntrealm,i->List(AlphabetOfFRObject(M),j->gen(Transition(M,i,j)))),
                 List(ntrealm,i->Output(M,i)));
    SetCorrespondence(i,MappingByFunction(Domain([1..Length(corr)]),G,gen));
    return i;
end);

InstallMethod(AsGroupFRElement, "(FR) for a Mealy element",
        [IsMealyElement],
        function(E)
    local m;
    m := AsGroupFRMachine(UnderlyingFRMachine(E));
    return FRElement(m,InitialState(E)^Correspondence(m));
end);

InstallMethod(AsMonoidFRElement, "(FR) for a Mealy element",
        [IsMealyElement],
        function(E)
    local m;
    m := AsMonoidFRMachine(UnderlyingFRMachine(E));
    return FRElement(m,InitialState(E)^Correspondence(m));
end);

InstallMethod(AsSemigroupFRElement, "(FR) for a Mealy element",
        [IsMealyElement],
        function(E)
    local m;
    m := AsSemigroupFRMachine(UnderlyingFRMachine(E));
    return FRElement(m,InitialState(E)^Correspondence(m));
end);

InstallMethod(AsIntMealyMachine, "(FR) for a Mealy machine",
        [IsMealyMachine and IsMealyMachineIntRep], AsMealyMachine);
InstallMethod(AsIntMealyMachine, "(FR) for a Mealy machine",
        [IsMealyMachine], DOMAINTOPERMTRANS@);

InstallMethod(AsIntMealyElement, "(FR) for a Mealy machine",
        [IsMealyElement and IsMealyMachineIntRep], AsMealyElement);
InstallMethod(AsIntMealyElement, "(FR) for a Mealy machine",
        [IsMealyElement], DOMAINTOPERMTRANS@);

BindGlobal("TOPELEMENTPERM@", function(l)
    local n;
    n := Length(l);
    if l=[1..n] then
        return MealyElementNC(FREFamily([1..n]),
                       [ListWithIdenticalEntries(n,1)],[[1..n]],1);
    fi;
    return MealyElementNC(FREFamily([1..n]),
                   List([1..2],i->ListWithIdenticalEntries(n,2)),
                   [l,[1..n]],1);
end);
InstallMethod(TopElement, "(FR) for a permutation",
        [IsPerm],
        p->TOPELEMENTPERM@(ListPerm(p)));
InstallMethod(TopElement, "(FR) for a permutation and a degree",
        [IsPerm,IsInt],
        function(p,n)
    return TOPELEMENTPERM@(ListPerm(p,n));
end);
InstallMethod(TopElement, "(FR) for a transformation",
        [IsTransformation],
        t->TOPELEMENTPERM@(ListTransformation(t)));
InstallMethod(TopElement, "(FR) for a transformation and a degree",
        [IsTransformation,IsInt],
        function(t,n)
    return TOPELEMENTPERM@(ListTransformation(t,n));
end);
#############################################################################

#############################################################################
##
#M  Draw . . . . . . . . . . . . . . . . . .draw Mealy machine using graphviz
##
BindGlobal("MM2DOT@", function(M)
    local names, i, j, S, stateset, alphabet;

    S := "digraph ";
    if HasName(M) and ForAll(Name(M),IsAlphaChar) then
        Append(S, "\""); Append(S, Name(M)); Append(S, "\"");
    else
        Append(S,"MealyMachine");
    fi;
    Append(S," {\n");
    if IsMealyMachineIntRep(M) then
        stateset := [1..M!.nrstates];
    else
        stateset := AsSortedList(M!.states);
    fi;
    alphabet := AsSortedList(AlphabetOfFRObject(M));
    if IsSubset(Integers, alphabet) and IsSubset(Integers, stateset) then
        names := List([1..Length(stateset)], i->WordAlp("abcdefgh", i));
    else
        names := List(stateset, String);
    fi;

    for i in [1..Length(names)] do
        Append(S, names[i]);
        Append(S," [shape=");
        if IsBound(M!.initial) and M!.initial = stateset[i] then
            Append(S,"double");
        fi;
        Append(S,"circle]\n");
    od;
    for i in [1..Length(names)] do
        for j in alphabet do
            Append(S,"  ");
            Append(S,names[i]);
            Append(S," -> ");
            Append(S,names[Position(stateset,Transition(M,stateset[i],j))]);
            Append(S," [label=\"");
            Append(S,String(j));
            Append(S,"/");
            Append(S,String(Output(M,stateset[i],j)));
            Append(S,"\",color=");
            Append(S,COLOURS@(Position(alphabet,j)));
            Append(S,"];\n");
        od;
    od;
    Append(S,"}\n");
    return S;
end);

BindGlobal("DRAWMEALY@", function(M)
     # more a hack than a clean implementation...
    if IsBoundGlobal("JupyterRenderable") then
        return ValueGlobal("JupyterRenderable")(rec(("image/svg+xml") :=IO_PipeThrough("dot",["-Tsvg"],MM2DOT@(M))),rec());
    else
        DOT2DISPLAY@(MM2DOT@(M),"dot");
    fi;
end);

InstallMethod(Draw, "(FR) draws a Mealy machine using graphviz",
        [IsMealyMachine],
        DRAWMEALY@);

InstallMethod(Draw, "(FR) draws a Mealy machine using graphviz",
        [IsMealyMachine, IsString],
        function(M,str)
    AppendTo(str,MM2DOT@(M));
end);

InstallMethod(Draw, "(FR) draws a Mealy element using graphviz",
        [IsMealyElement],
        DRAWMEALY@);

InstallMethod(Draw, "(FR) draws a Mealy element using graphviz",
        [IsMealyElement, IsString],
        function(M,str)
    AppendTo(str,MM2DOT@(M));
end);

BindGlobal("INSTALLMMHANDLER@", function(name,rv)
    InstallOtherMethod(name, "(FR) for a generic Mealy machine",
            [IsFRMachine],
            function(M)
        Info(InfoFR, 2, name, ": converting to Mealy machine");
        if rv then
            return name(ASINTREP@(M));
        else
            name(ASINTREP@(M));
        fi;
    end);
end);
BindGlobal("INSTALLMEHANDLER@", function(name,rv)
    InstallOtherMethod(name, "(FR) for a generic Mealy element",
            [IsFRElement],
            function(E)
        Info(InfoFR, 2, name, ": converting to Mealy element");
        if rv then
            return name(ASINTREP@(E));
        else
            name(ASINTREP@(E));
        fi;
    end);
end);

INSTALLMEHANDLER@(Draw,false);
INSTALLMMHANDLER@(Draw,false);

InstallOtherMethod(Draw, "(FR) for a FR machine and a filename",
        [IsFRMachine,IsString],
        function(M,S)
    Info(InfoFR, 1, "Draw: converting to Mealy machine");
    Draw(ASINTREP@(M),S);
end);

InstallOtherMethod(Draw, "(FR) for a FR element and a filename",
        [IsFRElement,IsString],
        function(E,S)
    Info(InfoFR, 1, "Draw: converting to Mealy element");
    Draw(ASINTREP@(E),S);
end);
############################################################################

############################################################################
##
#M Methods for the comparison operations for Mealy machines
##
InstallMethod(IsOne, "(FR) for a Mealy element",
        [IsMealyElement and IsMealyMachineIntRep],
        function(E)
    return E!.output = [AlphabetOfFRObject(E)];
end);
INSTALLMEHANDLER@(IsOne,true);

InstallMethod(\=, "(FR) for two Mealy elements", IsIdenticalObj,
        [IsMealyElement and IsMealyMachineIntRep, IsMealyElement and IsMealyMachineIntRep],
        function(x,y)
    return x!.output = y!.output and x!.transitions = y!.transitions;
end);

InstallMethod(\<, "(FR) for two Mealy elements", IsIdenticalObj,
        [IsMealyElement and IsMealyMachineIntRep, IsMealyElement and IsMealyMachineIntRep],
        function(x,y)
    local z, ix, iy, i, j, todo;

    if x=y then return false; fi;

    z := UnderlyingFRMachine(x)+UnderlyingFRMachine(y);
    ix := InitialState(x)^Correspondence(z)[1];
    iy := InitialState(y)^Correspondence(z)[2];
    z := Minimized(z);
    ix := ix^Correspondence(z);
    iy := iy^Correspondence(z);
    todo := NewFIFO([[ix,iy]]);
    for i in todo do
        if Output(z,i[1])<>Output(z,i[2]) then
            return Output(z,i[1])<Output(z,i[2]);
        fi;
        for j in AlphabetOfFRObject(z) do
            ix := Transition(z,i[1],j);
            iy := Transition(z,i[2],j);
            if ix<>iy then
                Add(todo,[ix,iy]);
            fi;
        od;
    od;
end);

InstallMethod(IsOne, "(FR) for a Mealy machine",
        [IsMealyMachine],
        function(x)
    local ix;
    if IsFinite(AlphabetOfFRObject(x)) then
        ix := ASINTREP@(x);
        return ix!.output=[AlphabetOfFRObject(x)];
    else
        TryNextMethod();
    fi;
end);

InstallMethod(\=, "(FR) for two Mealy machines in int rep", IsIdenticalObj,
        [IsMealyMachine and IsMealyMachineIntRep, IsMealyMachine and IsMealyMachineIntRep],
        function(x,y)
    return x!.nrstates = y!.nrstates and
               x!.transitions = y!.transitions and
           x!.output = y!.output;
end);

InstallMethod(\=, "(FR) for two Mealy machines in domain rep", IsIdenticalObj,
        [IsMealyMachine and IsMealyMachineDomainRep, IsMealyMachine and IsMealyMachineDomainRep],
        function(x,y)
    if IsFinite(AlphabetOfFRObject(x)) then
        return ASINTREP@(x)=ASINTREP@(y);
    else
        return x!.nrstates = y!.nrstates and
               x!.transitions = y!.transitions and
               x!.output = y!.output;
    fi;
end);

InstallMethod(\=, "(FR) for two Mealy elements", IsIdenticalObj,
        [IsMealyElement, IsMealyElement],
        function(x,y)
    if not IsFinite(AlphabetOfFRObject(x)) then
        Error("Don't know how to compare machines in domain representation");
    fi;
    if IsMealyMachineDomainRep(x) then
        x := ASINTREP@(x);
    fi;
    if IsMealyMachineDomainRep(y) then
        y := ASINTREP@(y);
    fi;
    return x=y;
end);

InstallMethod(\<, "(FR) for two Mealy machines", IsIdenticalObj,
        [IsMealyMachine and IsMealyMachineIntRep, IsMealyMachine and IsMealyMachineDomainRep],
        ReturnTrue);

InstallMethod(\<, "(FR) for two Mealy machines", IsIdenticalObj,
        [IsMealyMachine and IsMealyMachineDomainRep, IsMealyMachine and IsMealyMachineIntRep],
        ReturnFalse);

BindGlobal("MMLTINTREP@", function(x,y)
    local a, s;
    if x!.nrstates <> y!.nrstates then
        return x!.nrstates < y!.nrstates;
    elif x!.transitions <> y!.transitions then
        return x!.transitions < y!.transitions;
    else
        return x!.output < y!.output;
    fi;
end);

InstallMethod(\<, "(FR) for two Mealy machines", IsIdenticalObj,
        [IsMealyMachine and IsMealyMachineIntRep, IsMealyMachine and IsMealyMachineIntRep],
        MMLTINTREP@);

InstallMethod(\<, "(FR) for two Mealy machines", IsIdenticalObj,
        [IsMealyMachine and IsMealyMachineDomainRep, IsMealyMachine and IsMealyMachineDomainRep],
        function(x,y)
    if IsFinite(AlphabetOfFRObject(x)) then
        return MMLTINTREP@(ASINTREP@(x), ASINTREP@(y));
    else
        if x!.nrstates <> y!.nrstates then
            return x!.nrstates < y!.nrstates;
        elif x!.transitions <> y!.transitions then
            return x!.transitions < y!.transitions;
        elif x!.output <> y!.output then
            return x!.output < y!.output;
        fi;
        return false; # they're equal
    fi;
end);

InstallMethod(\<, "(FR) for two Mealy elements", IsIdenticalObj,
        [IsMealyElement, IsMealyElement],
        function(x,y)
    if not IsFinite(AlphabetOfFRObject(x)) then
        Error("Don't know how to compare machines in domain representation");
    fi;
    if IsMealyMachineDomainRep(x) then
        x := ASINTREP@(x);
    fi;
    if IsMealyMachineDomainRep(y) then
        y := ASINTREP@(y);
    fi;
    return x<y;
end);
############################################################################

############################################################################
##
#M Products of Mealy machines
##
############################################################################
InstallMethod(\+, "(FR) for two Mealy machines", IsIdenticalObj,
        [IsMealyMachine and IsMealyMachineDomainRep,
         IsMealyMachine and IsMealyMachineDomainRep], function(arg)
    local q, a, trans, out;
    q := Domain(Cartesian([1..Length(arg)],Union(List(arg,M->M!.states))));
    trans := function(s,a)
        return [s[1],arg[s[1]]!.transitions(s[2],a)];
    end;
    out := function(s,a)
        return arg[s[1]]!.output(s[2],a);
    end;
    a := MealyMachine(q,AlphabetOfFRObject(arg[1]),trans,out);
    if ForAll(arg,HasIsInvertible) then
        SetIsInvertible(a,ForAll(arg,IsInvertible));
    fi;
    SetCorrespondence(a,i->MappingByFunction(arg[i]!.states,q,s->[i,s]));
    SET_NAME@(arg,"+",a);
    return a;
end);

InstallMethod(\+, "(FR) for two Mealy machines", IsIdenticalObj,
        [IsMealyMachine and IsMealyMachineIntRep,
         IsMealyMachine and IsMealyMachineIntRep],
        function(M,N)
    local a;
    a := MealyMachineNC(FamilyObj(M),
                 Concatenation(M!.transitions,N!.transitions+M!.nrstates),
                 Concatenation(M!.output,N!.output));
    if HasIsInvertible(M) and HasIsInvertible(N) then
        SetIsInvertible(a,IsInvertible(M) and IsInvertible(N));
    fi;
    SetCorrespondence(a,[IdentityTransformation,TransformationListList([1..N!.nrstates],M!.nrstates+[1..N!.nrstates])]);
    SET_NAME@([M,N],"+",a);
    return a;
end);

InstallMethod(\+, "(FR) for generic FR machines", IsIdenticalObj,
        [IsFRMachine,IsFRMachine],
        function(x,y)
    return ASINTREP@(x)+ASINTREP@(y);
end);

InstallMethod(\*, "(FR) for two Mealy machines", IsIdenticalObj,
        [IsMealyMachine and IsMealyMachineDomainRep,
         IsMealyMachine and IsMealyMachineDomainRep],
        function(M,N)
    local q, a, trans, out;
    q := Domain(Cartesian(M!.states,N!.states));
    trans := function(s,a)
        return [M!.transition(s[1],a),N!.transition(s[2],M!.output(s[1],a))];
    end;
    out := function(s,a)
        return N!.output(s[2],M!.output(s[1],a));
    end;
    a := MealyMachine(q,AlphabetOfFRObject(M),trans,out);
    if HasIsInvertible(M) and HasIsInvertible(N) then
        SetIsInvertible(a,IsInvertible(M) and IsInvertible(N));
    fi;
    SET_NAME@([M,N],"*",a);
    return a;
end);

InstallMethod(\*, "(FR) for two Mealy machines", IsIdenticalObj,
        [IsMealyMachine and IsMealyMachineIntRep,
         IsMealyMachine and IsMealyMachineIntRep],
        function(M,N)
    local trans, out, i, j, a, t, o;

    trans := [];
    out := [];
    for i in [1..M!.nrstates] do
        o := M!.output[i];
        t := (M!.transitions[i]-1)*N!.nrstates;
        for j in [1..N!.nrstates] do
            Add(trans,t+N!.transitions[j]{o});
            Add(out,N!.output[j]{o});
        od;
    od;
    a := MealyMachineNC(FamilyObj(M),trans,out);
    if HasIsInvertible(M) and HasIsInvertible(N) then
        SetIsInvertible(a,IsInvertible(M) and IsInvertible(N));
    fi;
    SET_NAME@([M,N],"*",a);
    return a;
end);

InstallMethod(\*, "(FR) for generic FR machines", IsIdenticalObj,
        [IsFRMachine,IsFRMachine],
        function(x,y)
    return ASINTREP@(x)*ASINTREP@(y);
end);

InstallMethod(TensorProductOp, "(FR) for Mealy machines",
        [IsList,IsMealyMachine and IsMealyMachineDomainRep],
        function(M,N)
    local a, d, trans, out;
    while ForAny(M,x->x!.states<>N!.states) do
        Error("All machines should have same stateset");
    od;
    d := Length(M);
    a := Domain(Cartesian(List(M,AlphabetOfFRObject)));
    trans := function(s,a)
        local i;
        for i in [1..d] do s := M[i]!.transitions(s,a[i]); od;
        return s;
    end;
    out := function(s,a)
        local i, b;
        b := [];
        for i in [1..d] do
            Add(b,M[i]!.output(s,a[i]));
            s := M[i]!.transitions(s,a[i]);
        od;
        return b;
    end;
    a := MealyMachine(N!.states,a,trans,out);
    if ForAll(M,HasIsInvertible) then
        SetIsInvertible(a,ForAll(M,IsInvertible));
    fi;
    SET_NAME@(M,"(*)",a);
    return a;
end);

InstallMethod(TensorProductOp, "(FR) for two integer Mealy machines",
        [IsList,IsMealyMachine and IsMealyMachineIntRep],
        function(M,N)
    local a, b, trans, out, t, o, d, i, j, alphabet, s;

    while ForAny(M,x->x!.nrstates<>N!.nrstates) do
        Error("All machines should have same stateset");
    od;

    alphabet := Cartesian(List(M,AlphabetOfFRObject));

    trans := [];
    out := [];
    for i in [1..N!.nrstates] do
        t := [];
        o := [];
        for a in alphabet do
            b := [];
            s := i;
            for j in [1..Length(M)] do
                Add(b,M[j]!.output[s][a[j]]);
                s := M[j]!.transitions[s][a[j]];
            od;
            Add(o,Position(alphabet,b));
            Add(t,s);
        od;
        Add(trans,t);
        Add(out,o);
    od;
    a := MealyMachineNC(FRMFamily([1..Size(alphabet)]),trans,out);
    if ForAll(M,HasIsInvertible) then
        SetIsInvertible(a,ForAll(M,IsInvertible));
    fi;
    SET_NAME@(M,"(*)",a);
    return a;
end);

InstallMethod(TensorProductOp, "(FR) for generic FR machines",
        [IsList,IsFRMachine],
        function(M,N)
    M := List(M,ASINTREP@);
    return TensorProductOp(M,M[1]);
end);

InstallMethod(TensorSumOp, "(FR) for two Mealy machines",
        [IsList,IsMealyMachine and IsMealyMachineDomainRep],
        function(M,N)
    local a, d, trans, out;

    while ForAny(M,x->x!.states<>N!.states) do
        Error("All machines should have same stateset");
    od;
    d := Length(M);
    a := Domain(Union(List([1..d],i->Cartesian(AlphabetOfFRObject(M[i]),[i]))));
    trans := function(s,a)
        return M[a[2]]!.transitions(s,a[1]);
    end;
    out := function(s,a)
        return [M[a[2]]!.output(s,a[1]),a[2]];
    end;
    a := MealyMachine(N!.states,a,trans,out);
    if ForAll(M,HasIsInvertible) then
        SetIsInvertible(a,ForAll(M,IsInvertible));
    fi;
    SET_NAME@(M,"(+)",a);
    return a;
end);

InstallMethod(TensorSumOp, "(FR) for two integer Mealy machines",
        [IsList,IsMealyMachine and IsMealyMachineIntRep],
        function(M,N)
    local trans, out, t, o, a, d, i, j;

    while ForAny(M,x->x!.nrstates<>N!.nrstates) do
        Error("All machines should have same stateset");
    od;

    trans := [];
    out := [];
    for i in [1..N!.nrstates] do
        t := [];
        o := [];
        d := 0;
        for j in [1..Length(M)] do
            Append(t,M[j]!.transitions[i]);
            Append(o,M[j]!.output[i]+d);
            d := d+Size(AlphabetOfFRObject(M[j]));
        od;
        Add(trans,t);
        Add(out,o);
    od;
    a := MealyMachineNC(FRMFamily([1..d]),trans,out);
    if ForAll(M,HasIsInvertible) then
        SetIsInvertible(a,ForAll(M,IsInvertible));
    fi;
    SET_NAME@(M,"(+)",a);
    return a;
end);

InstallMethod(TensorSumOp, "(FR) for generic FR machines",
        [IsList,IsFRMachine],
        function(M,N)
    M := List(M,ASINTREP@);
    return TensorSumOp(M,M[1]);
end);

InstallMethod(DirectSumOp, "(FR) for two Mealy machines",
        [IsList,IsMealyMachine and IsMealyMachineDomainRep],
        function(M,N)
    local a, s, d, trans, out;

    d := Length(M);
    a := Domain(Union(List([1..d],i->Cartesian(AlphabetOfFRObject(M[i]),[i]))));
    s := Domain(Union(List([1..d],i->Cartesian(M[i]!.states,[i]))));
    trans := function(s,a)
        if s[2]=a[2] then
            return [M[s[2]]!.transitions(s[1],a[1]),s[2]];
        else
            return s;
        fi;
    end;
    out := function(s,a)
        if s[2]=a[2] then
            return [M[s[2]]!.output(s[1],a[1]),s[2]];
        else
            return a;
        fi;
    end;
    a := MealyMachine(s,a,trans,out);
    if ForAll(M,HasIsInvertible) then
        SetIsInvertible(a,ForAll(M,IsInvertible));
    fi;
    SET_NAME@(M,"(+)",a);
    return a;
end);

InstallMethod(DirectSumOp, "(FR) for two integer Mealy machines",
        [IsList,IsMealyMachine and IsMealyMachineIntRep],
        function(M,N)
    local trans, out, t, o, a, d, i, j, ashift, sshift, alphabet;

    d := 0;
    ashift := [];
    alphabet := [];
    for i in [1..Length(M)] do
        j := Length(AlphabetOfFRObject(M[i]));
        Add(ashift,[d+1..d+j]);
        d := d + j;
    od;

    trans := [];
    out := [];
    for i in [1..Length(M)] do
        sshift := Length(trans);
        for j in [1..M[i]!.nrstates] do
            t := ListWithIdenticalEntries(d,sshift+j);
            t{ashift[i]} := sshift+M[i]!.transitions[j];
            o := [1..d];
            o{ashift[i]} := ashift[i]{M[i]!.output[j]};
            Add(trans,t);
            Add(out,o);
        od;
    od;
    a := MealyMachineNC(FRMFamily([1..d]),trans,out);
    if ForAll(M,HasIsInvertible) then
        SetIsInvertible(a,ForAll(M,IsInvertible));
    fi;
    SET_NAME@(M,"#",a);
    return a;
end);

InstallMethod(DirectSumOp, "(FR) for generic FR machines",
        [IsList,IsFRMachine],
        function(M,N)
    M := List(M,ASINTREP@);
    return DirectSumOp(M,M[1]);
end);

InstallMethod(DirectProductOp, "(FR) for two Mealy machines",
        [IsList,IsMealyMachine and IsMealyMachineDomainRep],
        function(M,N)
    local a, s, d, trans, out;

    d := Length(M);
    a := Domain(Cartesian(List(M,AlphabetOfFRObject)));
    s := Domain(Cartesian(List(M,StateSet)));
    trans := function(s,a)
        return List([1..d],i->M[i]!.transitions(s[i],a[i]));
    end;
    out := function(s,a)
        return List([1..d],i->M[i]!.output(s[i],a[i]));
    end;
    a := MealyMachine(s,a,trans,out);
    if ForAll(M,HasIsInvertible) then
        SetIsInvertible(a,ForAll(M,IsInvertible));
    fi;
    SET_NAME@(M,"@",a);
    return a;
end);

InstallMethod(DirectProductOp, "(FR) for two integer Mealy machines",
        [IsList,IsMealyMachine and IsMealyMachineIntRep],
        function(M,N)
    local states, alphabet, trans, out, t, o, i, j, a, b, s;

    states := Cartesian(List(M,StateSet));
    alphabet := Cartesian(List(M,AlphabetOfFRObject));

    trans := [];
    out := [];
    for i in states do
        t := [];
        o := [];
        for a in alphabet do
            s := [];
            b := [];
            for j in [1..Length(i)] do
                Add(s,M[j]!.transitions[i[j]][a[j]]);
                Add(b,M[j]!.output[i[j]][a[j]]);
            od;
            Add(t,Position(states,s));
            Add(o,Position(alphabet,b));
        od;
        Add(trans,t);
        Add(out,o);
    od;
    a := MealyMachineNC(FRMFamily([1..Length(alphabet)]),trans,out);
    if ForAll(M,HasIsInvertible) then
        SetIsInvertible(a,ForAll(M,IsInvertible));
    fi;
    SET_NAME@(M,"@",a);
    return a;
end);

InstallMethod(DirectProductOp, "(FR) for generic FR machines",
        [IsList,IsFRMachine],
        function(M,N)
    M := List(M,ASINTREP@);
    return DirectProductOp(M,M[1]);
end);

InstallMethod(TreeWreathProduct, "(FR) for two domain Mealy machines",
        [IsMealyMachine and IsMealyMachineDomainRep,
         IsMealyMachine and IsMealyMachineDomainRep, IsObject, IsObject],
        function(g,h,x0,y0)
    local alphabet, states, trans, out, m;

    alphabet := Domain(Cartesian(AlphabetOfFRObject(g),AlphabetOfFRObject(h)));
    while not [x0,y0] in alphabet do
        Error("(x0,y0) must be in the product of the machines' alphabets");
    od;
    states := Domain(Union(Cartesian(StateSet(g),[1,3]),Cartesian(StateSet(h),[2]),[true]));

    trans := function(s,a)
        if s[2]=1 and a=[x0,y0] then
            return s;
        elif s[2]=1 and a[2]=y0 then
            return [s[1],3];
        elif s[2]=2 and a[1]=x0 then
            return [Transition(h,s[1],a[2]),2];
        elif s[2]=3 and a[2]=y0 then
            return [Transition(g,s[1],a[1]),3];
        else
            return true;
        fi;
    end;
    out := function(s,a)
        if s[2]=2 then
            return [a[1],Output(h,s[1],a[2])];
        elif s[2]=3 and a[2]=y0 then
            return [Output(g,s[1],a[1]),a[2]];
        else
            return a;
        fi;
    end;
    m := MealyMachine(states,alphabet,trans,out);
    if HasIsInvertible(g) and HasIsInvertible(h) then
        SetIsInvertible(m,IsInvertible(g) and IsInvertible(h));
    fi;
    SET_NAME@([g,h],"~",m);
    return m;
end);

InstallMethod(TreeWreathProduct, "(FR) for two integer Mealy machines",
        [IsMealyMachine and IsMealyMachineIntRep,
         IsMealyMachine and IsMealyMachineIntRep, IsPosInt, IsPosInt],
        function(g,h,x0,y0)
    local alphabet, one, trans, out, t, o, i, j, m;

    alphabet := Cartesian(AlphabetOfFRObject(g),AlphabetOfFRObject(h));
    while not [x0,y0] in alphabet do
        Error("(x0,y0) must be in the product of the machines' alphabets");
    od;
    one := 2*g!.nrstates+h!.nrstates+1;

    trans := [];
    out := [];
    for i in [1..g!.nrstates] do
        t := [];
        o := [];
        for j in alphabet do
            if j=[x0,y0] then
                Add(t,i);
            elif j[2]=y0 then
                Add(t,i+g!.nrstates+h!.nrstates);
            else
                Add(t,one);
            fi;
            Add(o,Position(alphabet,j));
        od;
        Add(trans,t);
        Add(out,o);
    od;
    for i in [1..h!.nrstates] do
        t := [];
        o := [];
        for j in alphabet do
            if j[1]=x0 then
                Add(t,Transition(h,i,j[2])+g!.nrstates);
            else
                Add(t,one);
            fi;
            Add(o,Position(alphabet,[j[1],Output(h,i,j[2])]));
        od;
        Add(trans,t);
        Add(out,o);
    od;
    for i in [1..g!.nrstates] do
        t := [];
        o := [];
        for j in alphabet do
            if j[2]=y0 then
                Add(t,Transition(g,i,j[1])+g!.nrstates+h!.nrstates);
                Add(o,Position(alphabet,[Output(g,i,j[1]),y0]));
            else
                Add(t,one);
                Add(o,Position(alphabet,j));
            fi;
        od;
        Add(trans,t);
        Add(out,o);
    od;
    Add(trans,ListWithIdenticalEntries(Length(alphabet),one));
    Add(out,[1..Length(alphabet)]);

    m := Minimized(MealyMachineNC(FRMFamily([1..Length(alphabet)]),trans,out));
    m!.Correspondence := [TransformationListList([1..g!.nrstates],List([1..g!.nrstates],i->i^Correspondence(m))),
                          TransformationListList([1..h!.nrstates]+g!.nrstates,List([1..h!.nrstates],i->i^Correspondence(m)))];
    if HasIsInvertible(g) and HasIsInvertible(h) then
        SetIsInvertible(m,IsInvertible(g) and IsInvertible(h));
    fi;
    SET_NAME@([g,h],"~",m);
    return m;
end);

InstallMethod(TreeWreathProduct, "for two generic FR machines",
        [IsFRMachine, IsFRMachine, IsObject, IsObject],
        function(g,h,x0,y0)
    return TreeWreathProduct(ASINTREP@(g),ASINTREP@(h),x0,y0);
    # !!! probably x0, y0 should be changed to their int counterparts?
end);
############################################################################

############################################################################
##
#M Products of Mealy elements
##
InstallMethod(\*, "(FR) for two Mealy elements", IsIdenticalObj,
        [IsMealyElement and IsMealyMachineDomainRep,
         IsMealyElement and IsMealyMachineDomainRep],
        function(M,N)
    local q, a, trans, out;
    q := Domain(Cartesian(M!.states,N!.states));
    trans := function(s,a)
        return [M!.transition(s[1],a),N!.transition(s[2],M!.output(s[1],a))];
    end;
    out := function(s,a)
        return N!.output(s[2],M!.output(s[1],a));
    end;
    a := MealyElement(q,AlphabetOfFRObject(M),trans,out,[M!.initial,N!.initial]);
    if HasIsInvertible(M) and HasIsInvertible(N) then
        SetIsInvertible(a,IsInvertible(M) and IsInvertible(N));
    fi;
    SET_NAME@([M,N],"*",a);
    return a;
end);

InstallMethod(\*, "(FR) for two Mealy elements", IsIdenticalObj,
        [IsMealyElement and IsMealyMachineIntRep,
         IsMealyElement and IsMealyMachineIntRep],
        function(M,N)
    local sdict, todo, a, i, x, t, tr, trans, out;

    if IsOne(M) then return N; elif IsOne(N) then return M; fi;

    sdict := NewDictionary([1,1],true);
    todo := [[M!.initial,N!.initial]];
    AddDictionary(sdict,[M!.initial,N!.initial],1);

    trans := [];
    out := [];
    for i in todo do
        tr := [];
        for a in AlphabetOfFRObject(M) do
            t := [M!.transitions[i[1]][a],N!.transitions[i[2]][M!.output[i[1]][a]]];
            x := LookupDictionary(sdict,t);
            if x=fail then
--> --------------------

--> maximum size reached

--> --------------------

[ Verzeichnis aufwärts0.52unsichere Verbindung  Übersetzung europäischer Sprachen durch Browser  ]