# Define a pregroup by giving a list of generator names and
# a (partial) multiplication table
InstallGlobalFunction(PregroupByTableNC,
function(enams, inv, table)
    local r,e;

    r := rec( PregroupElementNames := enams
            , inv := inv
            , table := table );
    r.fam := NewFamily( "PregroupElementsFamily", IsElementOfPregroup );
    r.elt_t := NewType( r!.fam, IsElementOfPregroupRep );
    r.wfam := NewFamily( "PregroupWordFamily", IsPregroupWord );
    r.word_t := NewType( r!.wfam, IsPregroupWordListRep );
    r.elts := List( [1..Length(table)], i -> Objectify(r.elt_t, rec(parent := r, elt := i)));
    r.invs := [];
    for e in [1..Length(r.elts)] do
        r.elts[e]!.inv := r.elts[inv(e)];
    od;
    Objectify(PregroupByTableType, r);
    SetPregroupElementNames(r, enams);
    return r;
end);

InstallGlobalFunction(PregroupInversesFromTable,
function(table)
    local i,j,inv;

    inv := [];
    for i in [1..Length(table)] do
        for j in [1..Length(table[i])] do
            if table[i][j] = 1 then
                if IsBound(inv[i]) then
                    if inv[i] <> j then
                        Error("inverses not well-defined");
                    fi;
                else
                    inv[i] := j;
                fi;
            fi;
        od;
    od;
    inv := PermList(inv);
    if inv = fail then
        Error("inverses not well-defined");
    fi;
    return x -> x^inv;
end);

InstallGlobalFunction(PregroupByTable,
function(enams, table)
    local nels, inv, row, e, f, g, h;

    # We assume that the length of the list of
    # element names is the number of elements
    nels := Length(enams);

    if Length(table) <> nels then
        Error("PregroupByTable: Length of enams does not match number of rows in table");
    fi;
    for row in table do
        if Length(row) <> nels then
            Error("PregroupByTable: Multiplication table is not square");
        fi;
        for e in row do
            if (not IsInt(e)) or (e < 0) or (e > nels) then
                Error("PregroupByTable: Table entry ", e, " is invalid, needs to be an integer between 0 and ", nels);
            fi;
        od;
    od;

    inv := PregroupInversesFromTable(table);
    for e in [1..nels] do
        if inv(inv(e)) <> e then
            Error("PregroupByTable: inv needs to be an involution");
        fi;
    od;
    for e in [1..nels] do
        if (table[1][e] <> e) or (table[e][1] <> e) then
            Error("PregroupByTable: ",e,"*1 = ", e, " or 1*", e, " = ", e, " not satisfied");
        fi;
        if (table[e][inv(e)] <> 1) or (table[inv(e)][e] <> 1) then
            Error("PregroupByTable: inverses");
        fi;
    od;

    for e in [1..nels] do
        for f in [1..nels] do
            for g in [1..nels] do
                if table[e][f] > 0 and table[f][g] > 0 then
                    if (table[table[e][f]][g] = 0 and table[e][table[f][g]] > 0) or
                       (table[table[e][f]][g] > 0 and table[e][table[f][g]] = 0) then
                        Error("PregroupByTable: associativity");
                    fi;
                fi;
            od;
        od;
    od;

    for e in [1..nels] do
        for f in [1..nels] do
            if table[e][f] > 0 then
                for g in [1..nels] do
                    if table[f][g] > 0 then
                        for h in [1..nels] do
                            if table[g][h] > 0 then
                                if table[table[e][f]][g] = 0 and table[table[f][g]][h] = 0 then
                                    Error("PregroupByTable: P5 violated");
                                fi;
                            fi;
                        od;
                    fi;
                od;
            fi;
        od;
    od;
    return PregroupByTableNC(enams, inv, table);
end);

InstallMethod(\[\]
             , "for a pregroup in table rep"
             , [IsPregroupTableRep, IsInt],
function(f,a)
    return f!.elts[a];
end);

InstallMethod(Iterator
             , "for a pregroup"
             , [IsPregroupTableRep],
function(pgp)
    local r;

    r := rec( pgp := pgp
            , pos := 0
            , length := Size(pgp)
            , NextIterator := function(iter)
                if iter!.pos < iter!.length then
                    iter!.pos := iter!.pos + 1;
                    return iter!.pgp[iter!.pos];
                else
                    return fail;
                fi;
            end
            , IsDoneIterator := iter -> iter!.pos = iter!.length
            , ShallowCopy := iter -> rec( pgp := iter!.pgp, pos := iter!.pos )
            );

    return IteratorByFunctions(r);
end);

InstallMethod(PregroupElementNames
             , "for a pregroup"
             , [IsPregroupTableRep]
             , p -> p!.elementnames );

InstallMethod(SetPregroupElementNames
             , "for a pregroup"
             , [IsPregroupTableRep, IsList]
             , function(p, n)
                 p!.elementnames := n;
             end );

InstallMethod(ViewString
             , "for a pregroup in table rep"
             , [IsPregroupTableRep],
function(pg)
    return STRINGIFY("<pregroup with ", Size(pg), " elements in table rep>");
end);

InstallMethod(Size
             , "for a pregroup in table rep"
             , [IsPregroup and IsPregroupTableRep],
function(pg)
    return Length(pg!.elts);
end);

#XXX at the moment [1,x] and [x,1] intermult, but I don't think
#    this is really needed?
#XXX Intermult is only defined for elements other than 1
InstallMethod(IntermultPairs
             , "for a pregroup in table rep"
             , [IsPregroupTableRep],
function(pg)
    local i, j, k, pairs;

    pairs := [];
    for i in [2..Size(pg)] do
        for j in [2..Size(pg)] do
            if (i <> pg!.inv(j)) then
                if (pg!.table[i][j] > 0) then
                    Add(pairs, [pg[i],pg[j]]);
                else
                    for k in [2..Size(pg)] do
                        if (pg!.table[i][k] > 0) and
                           (pg!.table[pg!.inv(k)][j] > 0) then
                            Add(pairs, [pg[i],pg[j]]);
                            break;
                        fi;
                    od;
                fi;
            fi;
        od;
    od;
    return pairs;
end);

InstallMethod(IntermultPairsIDs
             , "for a pregroup in table rep"
             , [IsPregroupTableRep],
function(pg)
    local i, j, k, pairs;

    pairs := [];
    for i in [2..Size(pg)] do
        for j in [2..Size(pg)] do
            if (i <> pg!.inv(j)) then
                if (pg!.table[i][j] > 0) then
                    Add(pairs, [i,j]);
                else
                    for k in [2..Size(pg)] do
                        if (pg!.table[i][k] > 0) and
                           (pg!.table[pg!.inv(k)][j] > 0) then
                            Add(pairs, [i,j]);
                            break;
                        fi;
                    od;
                fi;
            fi;
        od;
    od;
    return pairs;
end);

InstallMethod(IntermultMapIDs
             , "for a pregroup in table rep"
             , [IsPregroupTableRep],
function(pg)
    local i, j, k, map;

    map := [];
    for i in [1..Size(pg)] do
        map[i] := [];
    od;

    for i in [2..Size(pg)] do
        for j in [2..Size(pg)] do
            if (i <> pg!.inv(j)) then
                if (pg!.table[i][j] > 0) then
                    Add(map[i], j);
                else
                    for k in [2..Size(pg)] do
                        if (pg!.table[i][k] > 0) and
                           (pg!.table[pg!.inv(k)][j] > 0) then
                            Add(map[i],j);
                            break;
                        fi;
                    od;
                fi;
            fi;
        od;
    od;
    return map;
end);

InstallMethod(IntermultMap
             , "for a pregroup in table rep"
             , [IsPregroupTableRep],
function(pg)
    return List(IntermultMapIDs(pg), x -> List(x, i -> pg[i]));
end);

InstallMethod(IntermultTable
             , "for a pregroup in table rep"
             , [IsPregroupTableRep],
function(pg)
    local i, j, k, map;

    map := [];
    for i in [1..Size(pg)] do
        map[i] := [false];
    od;

    for i in [2..Size(pg)] do
        for j in [2..Size(pg)] do
            map[i][j] := false;
            if (i <> pg!.inv(j)) then
                if (pg!.table[i][j] > 0) then
                    map[i][j] := true;
                else
                    for k in [2..Size(pg)] do
                        if (pg!.table[i][k] > 0) and
                          (pg!.table[pg!.inv(k)][j] > 0) then
                            map[i][j] := true;
                            break;
                        fi;
                    od;
                fi;
            fi;
        od;
    od;
    return map;
end);

InstallMethod(One, "for a pregroup",
              [IsPregroup],
              pg -> pg!.elts[1]);

# This is very inefficient, but I don't care at the moment
InstallMethod(MultiplicationTableIDs,
              "for a pregroup",
              [IsPregroup],
function(pg)
    local i, j, table;

    table := [];
    for i in [1..Size(pg)] do
        table[i] := [];
        for j in [1..Size(pg)] do
            table[i][j] := pg[i] * pg[j];
            if table[i][j] = fail then
                table[i][j] := 0;
            else
                table[i][j] := __ID(table[i][j]);
            fi;
        od;
    od;
    return table;
end);

InstallMethod(MultiplicationTable,
              "for a pregroup",
              [IsPregroup],
function(pg)
    local i, j, table;

    table := [];
    for i in [1..Size(pg)] do
        table[i] := [];
        for j in [1..Size(pg)] do
            table[i][j] := pg[i] * pg[j];
        od;
    od;
    return table;
end);

#
# Pregroup elements
#
InstallMethod(IntermultMap
             , "for a pregroup element"
             , [IsElementOfPregroupRep],
function(pge)
    return IntermultMap(pge!.parent)[__ID(pge)];
end);

InstallMethod(ViewString
             , "for a pregroup element"
             , [IsElementOfPregroupRep],
function(pge)
    if pge!.elt > 0 then
        return PregroupElementNames(pge!.parent)[pge!.elt];
    else
        return "undefined";
    fi;
end);

InstallMethod(String
             , "for a pregroup element"
             , [IsElementOfPregroupRep],
function(pge)
    if pge!.elt > 0 then
        return PregroupElementNames(pge!.parent)[pge!.elt];
    else
        return "undefined";
    fi;
end);

InstallMethod(InverseOp
             , "for a pregroup element"
             , [IsElementOfPregroupRep]
             , 0,
function(x)
    return PregroupInverse(x);
end);

#XXX Is fail as a result for multiplication acceptable?
InstallMethod(\*
             , "for pregroup elements"
             , IsIdenticalObj
             , [IsElementOfPregroupRep, IsElementOfPregroupRep]
             , 0,
function(x,y)
    local pg, r;

    pg := x!.parent;

    r := pg!.table[x!.elt][y!.elt];

    if r > 0 then
        return pg!.elts[r];
    else
        return fail;
    fi;
end);

InstallMethod(\=
             , "for pregroup elements"
             , IsIdenticalObj
             , [IsElementOfPregroupRep, IsElementOfPregroupRep]
             , 0,
function(x,y)
    return x!.elt = y!.elt;
end);

# Artificial ordering on pregroup to make sets work
InstallMethod(\<
             , "for pregroup elements"
             , IsIdenticalObj
             , [ IsElementOfPregroupRep, IsElementOfPregroupRep]
             , 0,
function(x,y)
    return x!.elt < y!.elt;
end);

InstallMethod(PregroupOf
             , "for pregroup elements"
             , [ IsElementOfPregroupRep ]
             , 0,
function(a)
    return a!.parent;
end);

InstallMethod(PregroupInverse
             , "for pregroup elements"
             , [ IsElementOfPregroupRep ]
             , 0,
             a -> a!.inv);

InstallMethod(PregroupElementId
             , "for pregroup elements"
             , [ IsElementOfPregroupRep]
             , 0,
             a -> a!.elt);

InstallMethod(__ID
             , "for pregroup elements"
             , [IsElementOfPregroup]
             , 0,
             x -> x!.elt);

InstallMethod(IsDefinedMultiplication
             , "for pregroup elements"
             , IsIdenticalObj
             , [IsElementOfPregroup, IsElementOfPregroup]
             , 0,
function(a,b)
    local pg;

    pg := PregroupOf(a);

    return pg!.table[a!.elt][b!.elt] > 0;
end);

# We could cache intermult pairs,
# or predetermine them, depending
# on the number of intermult lookups
# that could benefit runtime
InstallMethod(IsIntermultPair
             , "for pregroup elements"
             , IsIdenticalObj
             , [IsElementOfPregroup, IsElementOfPregroup]
             , 0,
function(a,b)
    local x, nontriv;

    return IntermultTable(a!.parent)[__ID(a)][__ID(b)];

    if a = PregroupInverse(b) then
        return false;
    elif IsDefinedMultiplication(a, b) then
        return true;
    else
        nontriv := List(PregroupOf(a), x -> x);
        Remove(nontriv, 1);
        for x in nontriv do
            if IsDefinedMultiplication(a,x)
               and IsDefinedMultiplication(PregroupInverse(x), b) then
                return true;
            fi;
        od;
        return false;
    fi;
    # Should not be reached
    Error("This shouldn't happen.");
end);


# Copyright (c) 2018-2020, Carnegie Mellon University
# See LICENSE for details
#
# n-qubit Y transforms
#

#F qYT( n ) - Y Gate non-terminal
#F Definition: (2^n x 2^n)-matrix  that applies an n-point Y Transform to the target qubits
#F Note:       qYT(1) denotes the matrix[[0, -i], [i, 0]],
#F             qYT(_) is not symmetric.
#F
#F qYT( n ) -> an n-qubit Y transform
Class(qYT, TaggedNonTerminal, rec(
  abbrevs   := [ n -> Checked(IsPosInt(n), [n]) ],
  dims      := self >> let(size := 2^self.params[1], [size, size]),
  terminate := self >> Tensor(Replicate(self.params[1], qX())),
  isReal    := self >> true,
  groups    := self >> [Replicate(self.params[1], 1)],
  rChildren := self >> self.params,
  from_rChildren := (self, rch) >> self.__bases__[1](rch[1]),
  recursive_def := (self, arch) >> self.__bases__[1](self.params[1]),
  connected := self >> true,
  SmallRandom := () -> Random([2..5]),
  LargeRandom := () -> Random([6..15]),
  normalizedArithCost := self >> Error("ArithCost not implemented"),
  TType := T_Complex(64),
));

NewRulesFor(qYT, rec(

    # qYT_BinSplit rule
    # qYT_BinSplit qYT_(k) -> (qYT_(k1) tensor I) (I tensor qYT_(k2))
    # k1 + k2 = k
    qYT_BinSplit := rec (
        forTransposition := false,
        minSize          := 2,
        applicable       := (self, nt) >> nt.params[1] > 1,
        children         := nt -> List( [1..nt.params[1] - 1],  i -> [ Tensor(qYT(i), qYT(nt.params[1]-i)).withTags(nt.getTags()) ]  ),
        apply            := (nt, c, cnt) -> c[1],
        switch := true,
    ),

    #F qYT_Base: qYT(1) = qY() SPL object
    #F Directly represent as an implementable gate
    qYT_Base := rec(
        info             := "qYT_(1) -> qY()",
        forTransposition := false,
        applicable       := (self, nt) >> nt.params[1]=1,
        apply            := (nt, c, cnt) -> qY(),
    )

));


#!/usr/bin/gap

# https://cp4space.wordpress.com/2020/05/10/minimalistic-quantum-computation/

Print("running universal.gap\n");;

r2 := Sqrt(2);;
ir2 := 1/r2;;

i := [[1, 0], [0, 1]];;
w := [[E(4), 0], [0, E(4)]];;
x := [[0, 1], [1, 0]];;
z := [[1, 0], [0, -1]];;
s := [[1, 0], [0, E(4)]];;
h := [[ir2, ir2], [ir2, -ir2]];;

Cliff1 := Group(w, s, h);; # Order 192
Pauli1 := Group(w, x, z);; # Order 32

xi := KroneckerProduct(x, i);;
ix := KroneckerProduct(i, x);;
zi := KroneckerProduct(z, i);;
iz := KroneckerProduct(i, z);;
si := KroneckerProduct(s, i);;
is := KroneckerProduct(i, s);;
hi := KroneckerProduct(h, i);;
ih := KroneckerProduct(i, h);;
wi := KroneckerProduct(w, i);;

cz := [
    [1, 0, 0, 0],
    [0, 1, 0, 0],
    [0, 0, 1, 0],
    [0, 0, 0, -1]];;

Cliff2 := Group(si, is, hi, ih, wi, cz);; # Order 92160
#for g in Cliff2 do Print(g, "\n"); od;
Pauli2 := Group(wi, xi, ix, zi, iz);;

xii := KroneckerProduct(xi, i);;
ixi := KroneckerProduct(i, xi);;
iix := KroneckerProduct(i, ix);;

zii := KroneckerProduct(zi, i);;
izi := KroneckerProduct(i, zi);;
iiz := KroneckerProduct(i, iz);;

sii := KroneckerProduct(si, i);;
isi := KroneckerProduct(i, si);;
iis := KroneckerProduct(i, is);;

hii := KroneckerProduct(hi, i);;
ihi := KroneckerProduct(i, hi);;
iih := KroneckerProduct(i, ih);;

wii := KroneckerProduct(wi, i);;

icz := KroneckerProduct(i, cz);;
czi := KroneckerProduct(cz, i);;

Tofolli := [
    [1, 0, 0, 0, 0, 0, 0, 0],
    [0, 1, 0, 0, 0, 0, 0, 0],
    [0, 0, 1, 0, 0, 0, 0, 0],
    [0, 0, 0, 1, 0, 0, 0, 0],
    [0, 0, 0, 0, 1, 0, 0, 0],
    [0, 0, 0, 0, 0, 1, 0, 0],
    [0, 0, 0, 0, 0, 0, 0, 1],
    [0, 0, 0, 0, 0, 0, 1, 0]];;

zhh := zii*ihi*iih;
hzh := izi*hii*iih;
hhz := iiz*hii*ihi;

xhh := xii*ihi*iih;
hxh := ixi*hii*iih;
hhx := iix*hii*ihi;

Gx := Group(Tofolli, xhh, hxh, hhx);
Gz := Group(Tofolli, zhh, hzh, hhz);

Print("Order(Gz) = ", Order(Gz), "\n");
Print("Order(Gx) = ", Order(Gx), "\n");

L7:= SimpleLieAlgebra("E", 7, Rationals);;
R7:= RootSystem(L7);;
W7:= WeylGroup(R7);
Print("Order(W7) = ", Order(W7), "\n");

f := IsomorphismGroups(Gz, W7);
Print("IsomorphismGroups(Gz, E7) = ", f, "\n");

L8:= SimpleLieAlgebra("E", 8, Rationals);;
R8:= RootSystem(L8);;
W8:= WeylGroup(R8);
Print("Order(W8) = ", Order(W8), "\n");

f := IsomorphismGroups(Gx, W8);
Print("IsomorphismGroups(Gx, E8) = ", f, "\n");


local reps,tori,labels,I,II,ords,blocks;

reps:=[[[1,1],[2,1]],
       [[2,1],[5,1]],
       [[1,1]],
       [[2,1]]];

I:=[[],[1],[],[]];

#
# The parabolic where the representative is distinguished
#
II:=[[1,2],
     [1,2],
     [1],
     [2]];

labels:=["G_2","G_2(a_1)","\\tilde A_1","A_1"];

tori:=[
    [2,2],
    [0,2],
    [2,-3],
    [-1,2]
    ];

blocks:=[[[8, 1], [6, 1]], [[4, 2], [3, 2]], [[2, 6], [1, 2]], [[2, 6], [1, 2]]];

#ords:=[];
ords:=[8,4,2,2];

return [reps,tori,labels,I,II,ords,blocks];


#############################################################################
##
#W  automfam.gi              automgrp package                  Yevgen Muntyan
#W                                                             Dmytro Savchuk
##
#Y  Copyright (C) 2003 - 2018 Yevgen Muntyan, Dmytro Savchuk
##

###############################################################################
##
#R  IsAutomFamilyRep
##
##  Any object from category AutomFamily which is created here, lies in a
##  category IsAutomFamilyRep.
##  Family of Autom object <a> contains all essential information about
##  (mathematical) automaton which generates group containing <a>:
##  it contains automaton, properties of automaton and group generated by it,
##  etc.
##  Also family contains group generated by states of underlying automaton.
##
DeclareRepresentation("IsAutomFamilyRep",
                      IsComponentObjectRep and IsAttributeStoringRep,
                      [ "freegroup",      # IsAutom objects store words from this group
                        "freegens",       # list [f1, f2, ..., fn, f1^-1, ..., fn^-1, 1]
                                          # where f1..fn are generators of freegroup,
                                          # n is numstates; 1 is stored if and only if
                                          # trivstate is not zero.
                                          # Some fi^-1 may be missing if corresponding
                                          # generator is not invertible (but the list still
                                          # has the length of 2n+1).
                        "automgens",      # Generators of the group, list of length n.
                        "numstates",      # number of non-trivial generating states
                        "deg",
                        "trivstate",      # 0 or 2*numstates+1
                        "isgroup",        # whether all generators are invertible
                        "names",          # list of non-trivial generating states
                        "automatonlist",  # the automaton table, states correspond to freegens
                        "oldstates",      # mapping from states in the original table used to
                                          # define the group to the states in automatonlist:
                                          # Autom(fam!.freegens[oldtstates[k]], fam) is the element
                                          # which corresponds to k-th state in the original automaton
                        "rws",            # rewriting system
                        "use_rws",        # whether to use rewriting system in multiplication
                        "use_contraction" # whether to use contraction in IsOne
                      ]);

BindGlobal("AG_FixAutomList",
function(list, oldstates, names)
  local i, j, deg, isgroup, numstates, perm, trivstate;

  deg := Length(list[1]) - 1;
  isgroup := true;
  trivstate := 0;
  numstates := Length(list);

  for i in [1..Length(list)] do
    if AG_IsTrivialStateInList(i, list) then
      trivstate := i;
      numstates := numstates - 1;
      break;
    fi;
  od;

  # make sure trivial state in oldstates is right
  if trivstate <> 0 then
    for i in [1..Length(oldstates)] do
      if oldstates[i] = trivstate then
        oldstates[i] := 2*numstates + 1;
      elif oldstates[i] > trivstate then
        oldstates[i] := oldstates[i] - 1;
      fi;
    od;

    Remove(names, trivstate);
  fi;

  # move trivial state to the end
  if trivstate <> 0 then
    for i in [1..Length(list)] do
      for j in [1..deg] do
        if list[i][j] = trivstate then
          list[i][j] := 2*numstates + 1;
        elif list[i][j] > trivstate then
          list[i][j] := list[i][j] - 1;
        fi;
      od;
    od;

    list := Concatenation(list{[1..(trivstate-1)]},
                          list{[(trivstate+1)..Length(list)]});
    trivstate := 2*numstates + 1;
    list[trivstate] := List([1..deg], k -> trivstate);
    list[trivstate][deg+1] := ();
  fi;

  # add inverses of states
  for i in [1..numstates] do
    if AG_IsInvertibleStateInList(i, list) then
      list[i+numstates] := [];

      list[i][deg+1] := AG_PermFromTransformation(list[i][deg+1]);

      perm := list[i][deg+1];
      list[i+numstates][deg+1] := perm^-1;
      for j in [1..deg] do
        list[i+numstates][j] := list[i][j^(perm^-1)];
        if list[i+numstates][j] <> trivstate then
          list[i+numstates][j] := list[i+numstates][j] + numstates;
        fi;
      od;
    else
      isgroup := false;
      if list[i][deg+1]^-1<>fail then
        list[i][deg+1] := AG_PermFromTransformation(list[i][deg+1]);
      fi;
    fi;
  od;

  return [list, numstates, trivstate, isgroup];
end);

###############################################################################
##
#M  AutomFamily(<list>, <names>, <bind_vars>)
##
InstallMethod(AutomFamily, "for [IsList, IsList, IsBool]",
              [IsList, IsList, IsBool],
function (list, names, bind_global)
  local deg, tmp, trivstate, numstates, i,
        freegroup, freegens, a, family, oldstates,
        isgroup;

  if not AG_IsCorrectAutomatonList(list, false) then
    Error("in AutomFamily(IsList, IsList, IsString):\n",
          "  given list is not a correct list representing automaton\n");
  fi;

# 1. make a local copy of arguments, since they will be modified and put into the result

  list := StructuralCopy(list);
  names := StructuralCopy(names);
  deg := Length(list[1]) - 1;

# 2. Reduce automaton, find trivial state, permute states

  tmp := AG_ReducedAutomatonInList(list);
  list := tmp[1];
  oldstates := tmp[3];
  names := List(tmp[2], x -> names[x]);

  tmp := AG_FixAutomList(list, oldstates, names);
  list := tmp[1];
  numstates := tmp[2];
  trivstate := tmp[3];
  isgroup := tmp[4];

# 3. Create FreeGroup and FreeGens

  freegroup := FreeGroup(names);
  freegens := ShallowCopy(FreeGeneratorsOfFpGroup(freegroup));
  for i in [1..numstates] do
    if IsBound(list[i+numstates]) then
      freegens[i+numstates] := freegens[i]^-1;
    fi;
  od;
  if trivstate <> 0 then
    freegens[trivstate] := One(freegroup);
  fi;

# 4. Create family

  if isgroup then
    family := NewFamily("AutomFamily",
                        IsInvertibleAutom,
                        IsInvertibleAutom,
                        IsAutomFamily and IsAutomFamilyRep);
  else
    family := NewFamily("AutomFamily",
                        IsAutom,
                        IsAutom,
                        IsAutomFamily and IsAutomFamilyRep);
  fi;

  family!.isgroup := isgroup;
  family!.deg := deg;
  family!.numstates := numstates;
  family!.trivstate := trivstate;
  family!.names := names;
  family!.freegroup := freegroup;
  family!.freegens := freegens;
  family!.automatonlist := list;
  family!.oldstates := oldstates;
  family!.use_rws := false;
  family!.rws := fail;
  family!.use_contraction := false;

  SetIsActingOnBinaryTree(family, deg = 2);
  SetDegreeOfTree(family, deg);
  SetTopDegreeOfTree(family, deg);

  family!.automgens := [];
  for i in [1..Length(list)] do
    if IsBound(list[i]) then
      family!.automgens[i] :=
        __AG_CreateAutom(family, freegens[i],
                        List([1..deg], j -> freegens[list[i][j]]),
                        list[i][deg+1],
                        i > numstates or IsBound(list[i+numstates]));
    fi;
  od;

  # XXX It's evil to bind global names, consider AssignGeneratorVariables
  # XXX Check whether names are actually valid names for variables
  if bind_global then
    for i in [1..family!.numstates] do
      if IsBoundGlobal(family!.names[i]) then
        UnbindGlobal(family!.names[i]);
      fi;
      BindGlobal(family!.names[i], family!.automgens[i]);
      MakeReadWriteGlobal(family!.names[i]);
    od;
    #BindGlobal(AG_Globals.identity_symbol, One(family));
    #MakeReadWriteGlobal(AG_Globals.identity_symbol);
  fi;

  return family;
end);

###############################################################################
##
#M  AutomFamily(<list>)
##
InstallMethod(AutomFamily, "for [IsList]", [IsList],
function(list)
  return AutomFamily(list, false);
end);

###############################################################################
##
#M  AutomFamily(<list>, <bind_vars>)
##
InstallMethod(AutomFamily, "for [IsList, IsBool]", [IsList, IsBool],
function(list, bind_vars)
  if not AG_IsCorrectAutomatonList(list, false) then
    Error("in AutomFamily(IsList):\n",
          "  given list is not a correct list representing automaton\n");
  fi;

  return AutomFamily(list,
                     List([1..Length(list)],
                          i -> Concatenation(AG_Globals.state_symbol, String(i))),
                     bind_vars);
end);

###############################################################################
##
#M  AutomFamily(<list>, <names>)
##
InstallMethod(AutomFamily, [IsList, IsList],
function(list, names)
  if not AG_IsCorrectAutomatonList(list, false) then
    Error("in AutomFamily(IsList, IsList):\n",
          "  given list is not a correct list representing automaton\n");
  fi;

  return AutomFamily(list, names, AG_Globals.bind_vars_autom_family);
end);

###############################################################################
##
#M  DualAutomFamily(<fam>)
##
InstallMethod(DualAutomFamily, "for [IsAutomFamily]",
              [IsAutomFamily],
function(fam)
  local list, dual;
  list := [1..fam!.numstates];
  if fam!.trivstate <> 0 then
    Add(list, fam!.trivstate);
  fi;
  list := AG_MinimalSubAutomatonInlist(list, fam!.automatonlist)[1];
  if not AG_HasDualInList(list) then
    return 0;
  fi;
  dual := AutomFamily(AG_DualAutomatonList(list),
                      List([1..DegreeOfTree(fam)],
                           i -> Concatenation(AG_Globals.state_symbol_dual, String(i))));
  SetDualAutomFamily(dual, fam);
  return dual;
end);

###############################################################################
##
#M  One(<fam>)
##
InstallMethod(One, "for [IsAutomFamily]", [IsAutomFamily],
function(fam)
  return __AG_CreateAutom(fam, One(fam!.freegroup),
                         List([1..fam!.deg], i -> One(fam!.freegroup)),
                         (), true);
end);

###############################################################################
##
#M  GroupOfAutomFamily(<fam>)
##
InstallMethod(GroupOfAutomFamily, "for [IsAutomFamily]",
              [IsAutomFamily],
function(fam)
  local g;

  if not fam!.isgroup then
    return fail;
  fi;

  if fam!.numstates > 0 then
    g := GroupWithGenerators(fam!.automgens{[1..fam!.numstates]});
  else
    g := Group(One(fam));
  fi;

  SetUnderlyingAutomFamily(g, fam);
  SetIsGroupOfAutomFamily(g, true);
  # XXX
  SetGeneratingAutomatonList(g, fam!.automatonlist);
  SetAutomatonList(g, fam!.automatonlist);
  SetDegreeOfTree(g, fam!.deg);
  SetTopDegreeOfTree(g, fam!.deg);
  SetIsActingOnBinaryTree(g, fam!.deg = 2);
  SetIsAutomatonGroup(g, true);

  return g;
end);

###############################################################################
##
#M  SemigroupOfAutomFamily( <fam> )
##
InstallMethod(SemigroupOfAutomFamily, "for [IsAutomFamily]",
              [IsAutomFamily],
function(fam)
  local g;

  if fam!.trivstate <> 0 then
    if fam!.numstates = 0 then
      g := Group(One(fam!.automgens[fam!.trivstate]));
    else
      g := MonoidByGenerators(fam!.automgens{[1..fam!.numstates]});
    fi;
  else
    g := SemigroupByGenerators(fam!.automgens{[1..fam!.numstates]});
  fi;

  SetUnderlyingAutomFamily(g, fam);

  # XXX
  SetGeneratingAutomatonList(g, fam!.automatonlist);
  SetAutomatonList(g, fam!.automatonlist);

  SetDegreeOfTree(g, fam!.deg);
  SetTopDegreeOfTree(g, fam!.deg);
  SetIsActingOnBinaryTree(g, fam!.deg = 2);
  SetIsAutomatonSemigroup(g, true);

  return g;
end);

###############################################################################
##
#M  UnderlyingFreeMonoid( <G> )
##
InstallMethod(UnderlyingFreeMonoid, "for [IsAutomFamily]",
              [IsAutomFamily],
function(fam)
  local monoid;

  if fam!.numstates <> 0 then
    monoid := MonoidByGenerators(GeneratorsOfGroup(fam!.freegroup));
    SetSize(monoid, infinity);
  else
    monoid := MonoidByGenerators(fam!.freegens[1]);
    SetSize(monoid, 1);
  fi;

  return monoid;
end);

###############################################################################
##
#M  UnderlyingFreeGroup( <G> )
##
InstallMethod(UnderlyingFreeGroup, "for [IsAutomFamily]",
              [IsAutomFamily],
function(fam)
  return fam!.freegroup;
end);

###############################################################################
##
##  AG_AbelImagesGenerators(<fam>)
##
InstallMethod(AG_AbelImagesGenerators, "for [IsAutomFamily]",
              [IsAutomFamily],
function(fam)
  if not fam!.isgroup then
    Error("the group is not generated by an invertible automaton");
  fi;
  return AG_AbelImageAutomatonInList(fam!.automatonlist);
end);

###############################################################################
##
#M  DiagonalPowerOp(<fam>, <n>)
##
InstallMethod(DiagonalPowerOp, "for [IsAutomFamily, IsPosInt]",
              [IsAutomFamily, IsPosInt],
function(fam, n)
  local names, list, states, dlist;

  if not fam!.isgroup then
    Error("the group is not generated by an invertible automaton");
  fi;

  list := fam!.automatonlist;
  states := [1..fam!.numstates];
  names := fam!.names;
  if fam!.trivstate <> 0 then
    Add(states, fam!.trivstate);
    Add(names, AG_Globals!.identity_symbol);
  fi;
  dlist := AG_MinimalSubAutomatonInlist(states, list)[1];
  return AutomatonGroup(AG_DiagonalPowerInList(dlist, n, names)[1],
                    AG_DiagonalPowerInList(dlist, n, names)[2]);
end);

###############################################################################
##
#M  DiagonalPower(<obj>)
##
InstallOtherMethod(DiagonalPower, "for [IsObject]", [IsObject],
function(obj)
  return DiagonalPower(obj, 2);
end);

###############################################################################
##
#M  MultAutomAlphabet(<fam>, <n>)
##
InstallMethod(MultAutomAlphabetOp, "for [IsAutomFamily, IsPosInt]",
              [IsAutomFamily, IsPosInt],
function(fam, n)
  local list, states, dlist;
  list := fam!.automatonlist;
  states := [1..fam!.numstates];
  if fam!.trivstate <> 0 then Add(states, fam!.trivstate); fi;
  dlist := AG_MinimalSubAutomatonInlist(states, list)[1];
  return AutomatonGroup(AG_MultAlphabetInList(dlist, n));
end);

###############################################################################
##
#M  MultAutomAlphabet(<obj>)
##
InstallOtherMethod(MultAutomAlphabet, "for [IsObject]", [IsObject],
function(obj)
  return MultAutomAlphabet(obj, 2);
end);

#############################################################################
##
#M  GeneratorsOfOrderTwo(<fam>)
##
InstallMethod(GeneratorsOfOrderTwo, "for [IsAutomFamily]", [IsAutomFamily],
function(fam)
  if not fam!.isgroup then
    Error("the group is not generated by an invertible automaton");
  fi;
  return Filtered(GeneratorsOfGroup(GroupOfAutomFamily(fam)), g -> IsOne(g^2));
end);

#E