# Copyright (c) 2018-2021, Carnegie Mellon University
# See LICENSE for details

Latex := x -> Cond(IsRec(x) and IsBound(x.latex), x.latex(),
                   IsRec(x) and IsBound(x.cprint), x.cprint(),
                   Print(x));
Cprint := x -> When(IsRec(x) and IsBound(x.cprint), x.cprint(), Print(x));

_infix_print := function ( lst, sep, prfunc )
    local  first, c;
    first := true;
    for c  in lst  do
        if first  then  first := false;
        else            Print(sep);  fi;
        prfunc(c);
    od;
    return "";
end;

Gath.latex := self >> Print("\\Gath{", self.func.latex(), "}");
Scat.latex := self >> Print("\\Scat{", self.func.latex(), "}");
Diag.latex := self >> Print("\\Diag{", self.element.latex(), "}");
Prm.latex := self >> Print("\\Prm{", self.func.latex(), "}");

FuncClass.latex := self >> Print("\\f", self.name,
    DoForAll(self.params, p -> Print("{",Cprint(p),"}")));

FDataOfs.latex := self >> Print("\\f", self.name,
    DoForAll(self.rChildren(), p -> Print("{",Cprint(p),"}")));

HH.latex := self >> PrintEvalF("\\f$1{$2}{$3}{$4}{$5}",
    self.name, ()->Latex(self.params[1]), ()->Latex(self.params[2]), ()->Latex(self.params[3]),
    ()->_infix_print(self.params[4],", ",Latex));
BHH.latex := self >> PrintEvalF("\\f$1{$2}{$3}{$4}{$5}",
    self.name, ()->Cprint(self.params[1]), ()->Cprint(self.params[2]), ()->Cprint(self.params[3]),
    ()->_infix_print(self.params[4],", ",Cprint));
HHZ.latex := self >> PrintEvalF("\\f$1{$2}{$3}{$4}{$5}",
    self.name, ()->Cprint(self.params[1]), ()->Cprint(self.params[2]), ()->Cprint(self.params[3]), ()->_infix_print(self.params[4],", ", Cprint));

NonTerminal.latex := self >> Print("\\n", self.name,
    DoForAll(self.params, p -> Print("{",Latex(p),"}")));

Sym.latex := FuncClass.latex;

ISum.latex := self >> PrintEvalF("\\ISum{$1 0}{$2}{$3}",
   () -> When(IsBound(self.var), Print(self.var, "=")),
   () -> Latex(self.domain-1),
   () -> self.child(1).latex());

Compose.latex := self >> DoForAll(self.children(), c->c.latex());

BaseContainer.latex := self >> PrintEvalF("\\$1{$2}", self.name, ()->self.child(1).latex());

BaseOperation.latex := self >> Print("\\", self.name, DoForAll(self.children(), c->Print("{",c.latex(),"}")));

SUM.latex := self >> Chain(
    DoForAllButLast(self.children(), c->Print(c.latex(), "+")),
    Last(self.children()).latex());

gammaTensor.latex := self >> InfixPrint(self.children(), "\\boxtimes", c->c.latex());
fTensor.latex := self >> InfixPrint(self.children(), "\\otimes", c->c.latex());
fDirsum.latex := self >> InfixPrint(self.children(), "\\oplus", c->c.latex());
fCompose.latex := self >> InfixPrint(self.children(), "\\circ", c->c.latex());

Blk.latex := self >> self.print(0,0);


# Copyright (c) 2018-2021, Carnegie Mellon University
# See LICENSE for details

# ==========================================================================
# Mat
# ==========================================================================
Class(Mat, BaseMat, rec(
    new := (self, M) >> Checked(IsMat(M),
	SPL(WithBases(self,
		rec( element    := M,
		     dimensions := DimensionsMat(M) )))),
    #-----------------------------------------------------------------------
    dims := self >> DimensionsMat(self.element),
    #-----------------------------------------------------------------------
    isPermutation := False,
    #-----------------------------------------------------------------------
    isReal := self >> ForAll(self.element, r -> ForAll(r, x -> IsRealNumber(x))),
    #-----------------------------------------------------------------------
    toAMat := self >> AMatMat(List(self.element, r -> List(r, EvalScalar))),
    #-----------------------------------------------------------------------
    transpose := self >>  # we use CopyFields to copy all fields of self
        CopyFields(self, rec(element := TransposedMat(self.element),
		          dimensions := Reversed(self.dimensions))),
    transpose := self >>  # we use CopyFields to copy all fields of self
        CopyFields(self, rec(element := self.element ^ -1,
		          dimensions := Reversed(self.dimensions))),
    conjTranspose := self >>  # we use CopyFields to copy all fields of self
        CopyFields(self, rec(element := MapMat(TransposedMat(self.element), conj),
		          dimensions := Reversed(self.dimensions))),

    #-----------------------------------------------------------------------
    arithmeticCost := meth(self, costMul, costAddMul)
        local cost, row, nz;
	cost := costMul(0) - costMul(0); # will work even when costMul(0) <> 0
	for row in self.element do
	    nz := Filtered(row, x -> x<>0);
	    if Length(nz) > 0 then
		cost := cost + costMul(nz[1])
		             + Sum(nz{[2..Length(nz)]}, x -> costAddMul(x));
	    fi;
	od;
	return cost;
    end,
));


# Constants
BindGlobal("Graph6ByteInteger", 62);
BindGlobal("Graph6WordInteger", 258047);
BindGlobal("Graph6DwordInteger", 68719476735);
BindGlobal("Graph6MaxInteger", Graph6DwordInteger);
BindGlobal("Graph6BitVector", List([0..5], i -> 2^(5-i)));
BindGlobal("Graph6IntVector", List([0..5], i -> 64^(5-i)));

# graph6 integer encoding
BindGlobal("Graph6EncodeInteger", function(x)
    if not IsInt(x) or x < 0 or x >= Graph6MaxInteger then
        Error("not an integer in allowed range");
        return fail;
    fi;
    if x <= Graph6ByteInteger then
        return [x+63];
    elif x <= Graph6WordInteger then
        return [63, Int(x/4096), Int(x/64), x] mod 64 + 63;
    else
        return Concatenation([126, 126],
                List(Graph6IntVector, y -> Int(x/y) mod 64 + 63));
    fi;
end);

# graph6 integer decoding
BindGlobal("Graph6DecodeInteger", function(i, s)
    if s[i] <> 126 then
        return [i+1, s[i] - 63];
    elif s[i+1] <> 126 then
        return [i+4, (s{[i+1..i+3]} - 63)*Graph6IntVector{[4..6]}];
    else
        return [i+8, (s{[i+2..i+7]} - 63)*Graph6IntVector];
    fi;
end);

# Convert an integer to a bitstring of length w
BindGlobal("IntToBits", function(x, w)
    return List([1..w], i -> Int(x / 2^(w-i)) mod 2);
end);

# Convert a bitstring to a list of integers given the width w
BindGlobal("BitsToInt", function(b, w)
    local out, i;
    out := [];
    i := 0;
    while i+w <= Length(b) do
        Add(out, b{[i+1..i+w]} * List([1..w], j -> 2^(w-j)));
        i := i+w;
    od;
    return out;
end);

# Convert a bitstring to a graph6 string with padding p
BindGlobal("BitsToString", function(b, p)
    local c;
    c := Concatenation(b, ListWithIdenticalEntries(-Length(b) mod 6, p));
    return List([0,6..Length(c)-6], i -> c{[i+1..i+6]}*Graph6BitVector + 63);
end);

# Convert a graph6 string to a bitstring
BindGlobal("StringToBits", function(s)
    return Concatenation(List(s, x -> List(Graph6BitVector, y -> Int((x-63)/y) mod 2)));
end);

# graph6 string
BindGlobal("Graph6String", function(G)
    local A, s;
    A := CollapsedAdjacencyMat(Group(()), G);
    s := Concatenation(Graph6EncodeInteger(G.order),
        BitsToString(Concatenation(List([1..G.order], i -> A[i]{[1..i-1]})), 0));
    return List(s, CharInt);
end);

# Read graph from graph6 string
BindGlobal("GraphFromGraph6String", function(s)
    local A, b, n, i, j, t;
    s := List(s, IntChar);
    t := Graph6DecodeInteger(1, s);
    i := t[1];
    n := t[2];
    b := StringToBits(s{[i..Length(s)]});
    A := NullMat(n, n);
    i := 1;
    for j in [2..n] do
        A[j]{[1..j-1]} := b{[i..i+j-2]};
        A{[1..j-1]}[j] := b{[i..i+j-2]};
        i := i+j-1;
    od;
    return AdjFunGraph([1..n], MatrixAdjacency(A));
end);

# sparse6 string
BindGlobal("Sparse6String", function(G)
    local i, j, b, c, v, w;
    w := Log2Int(G.order-1)+1;
    b := [];
    v := 1;
    for i in [1..G.order] do
        for j in [1..i] do
            if IsVertexPairEdge(G, i, j) then
                if i = v+1 then
                    c := 1;
                else
                    if i > v then
                        Add(b, 1);
                        Append(b, IntToBits(i-1, w));
                    fi;
                    c := 0;
                fi;
                Add(b, c);
                Append(b, IntToBits(j-1, w));
                v := i;
            fi;
        od;
    od;
    if G.order in [2,4,8,16] and (-Length(b)) mod 6 > w
            and Length(Adjacency(G, G.order-1)) > 0
            and Length(Adjacency(G, G.order)) = 0 then
        Add(b, 0);
    fi;
    return List(Concatenation([58], Graph6EncodeInteger(G.order),
                                BitsToString(b, 1)), CharInt);
end);

# Read graph from sparse6 string
BindGlobal("GraphFromSparse6String", function(s)
    local A, b, t, i, m, n, v, w, c, x, y, z;
    if s[1] = ':' then
        s := s{[2..Length(s)]};
    fi;
    s := List(s, IntChar);
    t := Graph6DecodeInteger(1, s);
    i := t[1];
    n := t[2];
    w := Log2Int(n-1)+1;
    b := StringToBits(s{[i..Length(s)]});
    A := List([1..n], j -> []);
    i := 1;
    v := 1;
    z := BitsToInt(b, w+1);
    m := 2^w;
    for y in z do
        c := Int(y/m);
        x := y mod m + 1;
        if c = 1 then
            v := v+1;
        fi;
        if v > n or x > n then
            break;
        fi;
        if x > v then
            v := x;
        else
            Add(A[x], v);
            Add(A[v], x);
        fi;
    od;
    return AdjFunGraph([1..n], ListAdjacency(A));
end);

# sparse6 string
BindGlobal("IncrementalSparse6String", function(G, H)
    local i, j, b, c, v, w;
    if G.order <> H.order then
        Error("graphs have different orders");
        return fail;
    fi;
    w := Log2Int(G.order-1)+1;
    b := [];
    v := 1;
    for i in [1..G.order] do
        for j in [1..i] do
            if IsVertexPairEdge(G, i, j) <> IsVertexPairEdge(H, i, j) then
                if i = v+1 then
                    c := 1;
                else
                    if i > v then
                        Add(b, 1);
                        Append(b, IntToBits(i-1, w));
                    fi;
                    c := 0;
                fi;
                Add(b, c);
                Append(b, IntToBits(j-1, w));
                v := i;
            fi;
        od;
    od;
    if G.order in [2,4,8,16] and (-Length(b)) mod 6 > w
            and Adjacency(G, G.order-1) = Adjacency(H, G.order-1)
            and Adjacency(G, G.order) = Adjacency(H, G.order) then
        Add(b, 0);
    fi;
    return List(Concatenation([59], BitsToString(b, 1)), CharInt);
end);

# Read graph from incremental sparse6 string
BindGlobal("GraphFromIncrementalSparse6String", function(s, H)
    local A, B, b, i, m, v, w, c, x, y, z;
    if s[1] = ';' then
        s := s{[2..Length(s)]};
    fi;
    B := List([1..H.order], j -> Adjacency(H, j));
    A := List(B, ShallowCopy);
    s := List(s, IntChar);
    w := Log2Int(H.order-1)+1;
    b := StringToBits(s);
    i := 1;
    v := 1;
    z := BitsToInt(b, w+1);
    m := 2^w;
    for y in z do
        c := Int(y/m);
        x := y mod m + 1;
        if c = 1 then
            v := v+1;
        fi;
        if v > H.order or x > H.order then
            break;
        fi;
        if x > v then
            v := x;
        elif x in A[v] then
            Remove(A[x], Position(A[x], v));
            if x <> v then
                Remove(A[v], Position(A[v], x));
            fi;
        else
            Add(A[x], v);
            Add(A[v], x);
        fi;
    od;
    return AdjFunGraph([1..H.order], ListAdjacency(A));
end);

# auto6 string
BindGlobal("Auto6String", function(G)
    local b, g, h, i, l, p, r, s, w, x, sch;
    g := GeneratorsOfGroup(G.group);
    l := [1..Length(g)];
    i := 0;
    for p in [1..Length(g)] do
        if g[p] = () then
            i := i+1;
        else
            l[p] := l[p] - i;
        fi;
    od;
    sch := List(G.schreierVector, function(y)
                                    if y < 0 then
                                        return y;
                                    else
                                        return l[y];
                                    fi;
                                  end);
    g := Filtered(g, y -> y <> ());
    w := Log2Int(G.order-1)+1;
    r := Length(G.representatives);
    b := IntToBits(r, w);
    for i in [1..r] do
        Append(b, IntToBits(G.representatives[i]-1, w));
        Append(b, IntToBits(Length(G.adjacencies[i]), w));
        for x in G.adjacencies[i] do
            Append(b, IntToBits(x-1, w));
        od;
    od;
    for h in g do
        for i in [1..G.order] do
            Append(b, IntToBits(i^h - 1, w));
        od;
    od;
    if Length(g) > 1 then
        s := Log2Int(Length(g)) + 1;
        for i in [1..G.order] do
            if sch[i] < 0 then
                Append(b, IntToBits(0, s));
            else
                Append(b, IntToBits(sch[i], s));
            fi;
        od;
    fi;
    return List(Concatenation([33], Graph6EncodeInteger(G.order),
                Graph6EncodeInteger(Length(g)), BitsToString(b, 0)), CharInt);
end);

# Read graph from auto6 string
BindGlobal("GraphFromAuto6String", function(s)
    local G, A, R, S, a, b, d, r, t, g, i, j, k, n, v, w;
    if s[1] = '!' then
        s := s{[2..Length(s)]};
    fi;
    s := List(s, IntChar);
    t := Graph6DecodeInteger(1, s);
    i := t[1];
    n := t[2];
    w := Log2Int(n-1)+1;
    t := Graph6DecodeInteger(i, s);
    i := t[1];
    g := t[2];
    b := StringToBits(s{[i..Length(s)]});
    d := BitsToInt(b, w);
    r := d[1];
    if r = 0 then
        r := n;
    fi;
    i := 2;
    R := [];
    A := [];
    for j in [1..r] do
        Add(R, d[i]+1);
        Add(A, d{[i+2..i+d[i+1]+1]}+1);
        i := i + d[i+1] + 2;
    od;
    if g = 0 then
        G := ();
        v := List([1..n], x -> -Position(R, x));
    else
        G := [];
        for j in [1..g] do
            Add(G, PermList(d{[i..i+n-1]}+1));
            i := i+n;
        od;
        if g = 1 then
            v := List([1..n], function(x)
                local y;
                y := Position(R, x);
                if y = fail then
                    return 1;
                else
                    return -y;
                fi;
            end);
        else
            k := w*(i-1);
            t := Log2Int(g)+1;
            v := BitsToInt(b{[k+1..k+n*t]}, t);
            for j in [1..r] do
                v[R[j]] := -j;
            od;
        fi;
    fi;
    return rec(
        isGraph := true,
        order := n,
        names := [1..n],
        representatives := Immutable(R),
        adjacencies := A,
        group := Group(G),
        schreierVector := Immutable(v)
    );
end);


# The vector product of two vectors with 3 elements.
BindGlobal("VectorProduct", function(u, v)
    return [u[2]*v[3]-u[3]*v[2], u[3]*v[1]-u[1]*v[3], u[1]*v[2]-u[2]*v[1]];
end);

# Multiplication in Hall algebras
BindGlobal("HallMultiplication", function(p)
    local r;
    r := CoefficientsOfUnivariatePolynomial(p)[2];
    return function(x, y)
        if IsZero(y[2]) then
            return x*y[1];
        else
            return [x[1]*y[1] - x[2]/y[2]*Value(p, y[1]),
                    x[1]*y[2] - x[2]*(y[1] + r)];
        fi;
    end;
end);

# Multiplication in Dickson near-fields
BindGlobal("DicksonMultiplication",
    q -> function(x, y)
            if IsZero(y) then
                return 0*Z(q);
            else
                return x^(q^LogFFE(y, Z(q^2))) * y;
            fi;
        end);

# Right division in Dickson near-fields
BindGlobal("DicksonRightDivision",
    q -> function(x, y)
            if IsZero(x) then
                return 0*Z(q);
            else
                return (x / y)^(q^LogFFE(y, Z(q^2)));
            fi;
        end);

# Multiplication in exceptional near-fields
BindGlobal("ExceptionalMultiplication", function(q, F, B)
    local mat;
    mat := ToExceptionalMatrix(q, F, B);
    return function(x, y)
        local M;
        M := mat(x) * mat(y);
        return M[1]*B;
    end;
end);

# Right division in exceptional near-fields
BindGlobal("ExceptionalRightDivision", function(q, F, B)
    local mat;
    mat := ToExceptionalMatrix(q, F, B);
    return function(x, y)
        local M;
        M := mat(x) * mat(y)^-1;
        return M[1]*B;
    end;
end);

# Normalize a vector over a semifield given the semifield right division.
BindGlobal("NormalizeSemifieldVector",
    div -> function(v)
        local n;
        n := First(v, x -> not IsZero(x));
        return List(v, x -> div(x, n));
    end);


InsertionSort := function(L)
  local n, i, j, x;
  n := Length(L);
  for i in [ 2 .. n ] do
    x := L[i];
    j := i - 1;
    while j >= 1 and L[j] > x do
      L[j + 1] := L[j];
      j := j - 1;
    od;
    L[j + 1] := x;
  od;
end;

s := "BFKRIMPOQACNESWUTXDGLVZHYJ";
InsertionSort(s);
s;
# "ABCDEFGHIJKLMNOPQRSTUVWXYZ"


# Copyright (c) 2018-2021, Carnegie Mellon University
# See LICENSE for details

vtransposelo := (l1,l2,n) -> Flat(List([1..n/2], i-> [l1[2*i-1],l2[2*i-1]]
));

vtransposehi := (l1,l2,n) -> Flat(List([1..n/2], i-> [l1[2*i],l2[2*i]]
));

vrev64 := (l1,n) -> Flat(List([1..n/2], i-> [l1[2*i],l1[2*i-1]]
));


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

###############################################################################
##
#R  IsMealyAutomatonRep
##
DeclareRepresentation("IsMealyAutomatonRep",
                      IsComponentObjectRep and IsAttributeStoringRep,
                      ["table",     # transitions: table[i][j] is the state automaton goes to after processing letter j
                                    # if it was in state i
                       "perms",     # output: perms[i] is the output function at state i. It is either IsPerm or IsTransformation
                       "trans",     # images of elements of perms: i^perms[j] = trans[j][i]
                       "alphabet",  # by default it's [1..degree]; may be something different e.g. after taking "cross product"
                                    # it's used for pretty printing, internally only [1..degree] is used
                       "degree",    # Length(alphabet)
                       "states",    # names of the states
                       "n_states",  # Length(states), Length(table)
                       ]);
BindGlobal("AG_AutomatonFamily", NewFamily("AutomatonFamily", IsMealyAutomaton, IsMealyAutomaton, IsMealyAutomatonFamily));

BindGlobal("AG_IsInvertible",
function(t)
  return RankOfTransformation(t) = DegreeOfTransformation(t);
end);

BindGlobal("_AG_CreateAutomaton",
function(table, states, alphabet)
  local a, s, i, n_states, invertible, degree, perms;

  if not AG_IsCorrectAutomatonList(table, false) then
    Error("'", table, "' is not a correct table representing a finite automaton");
  fi;

  if states = fail then
    states := List([1..Length(table)], i -> Concatenation(AG_Globals.state_symbol, String(i)));
  else
    if Length(states) <> Length(table) then
      Error("number of state names is not equal to the number of states");
    fi;
    if Length(Set(states)) <> Length(states) then
      Error("duplicated states names");
    fi;
    states := List(states, s -> String(s));
  fi;

  if alphabet = fail then
    alphabet := [1 .. Length(table[1])-1];
  else
    if Length(alphabet) <> Length(table[1]) - 1 then
      Error("number of letters in alphabet does not agree with the automaton table");
    fi;
    alphabet := StructuralCopy(alphabet);
  fi;

  n_states := Length(table);
  degree := Length(alphabet);
  perms := List(table, s -> s[degree+1]);
  table := List(table, s -> s{[1..degree]});
  invertible := true;

  for i in [1..n_states] do
    if not IsPerm(perms[i]) and not AG_IsInvertible(perms[i]) then
      invertible := false;
      break;
    fi;
  od;

  if not invertible then
    for i in [1..n_states] do
      if IsPerm(perms[i]) then
        perms[i] := Transformation(List([1..degree], j -> j^perms[i]));
      fi;
    od;
  else
    for i in [1..n_states] do
      if not IsPerm(perms[i]) then
        perms[i] := PermList(ImageListOfTransformation(perms[i]));
      fi;
    od;
  fi;

  a := Objectify(NewType(AG_AutomatonFamily, IsMealyAutomaton and IsMealyAutomatonRep),
                 rec(table := table,
                     perms := perms,
                     trans := List([1..n_states], i -> List([1..degree], j -> j^perms[i])),
                     states := states,
                     n_states := n_states,
                     alphabet := alphabet,
                     degree := degree));

  SetIsInvertible(a, invertible);

  return a;
end);

BindGlobal("__AG_PrintPerm",
function(p)
  if IsPerm(p) then
    Print(p);
  else
    Print(ImageListOfTransformation(p));
  fi;
end);

BindGlobal("__AG_PermString",
function(p)
  if IsPerm(p) then
    return String(p);
  else
    return String(ImageListOfTransformation(p));
  fi;
end);

InstallMethod(MealyAutomaton, [IsList, IsList, IsList],
function(table, states, alphabet)
  return _AG_CreateAutomaton(table, states, alphabet);
end);

InstallMethod(MealyAutomaton, [IsList, IsList],
function(table, states)
  return _AG_CreateAutomaton(table, states, fail);
end);

InstallMethod(MealyAutomaton, [IsList],
function(table)
  return _AG_CreateAutomaton(table, fail, fail);
end);

InstallMethod(MealyAutomaton, [IsString],
function(string)
  local ret;
  ret := AG_ParseAutomatonString(string);
  return MealyAutomaton(ret[2], ret[1]);
end);

InstallMethod(MealyAutomaton, [IsTreeHomomorphism],
function(a)
  return MealyAutomaton([a]);
end);

InstallMethod(MealyAutomaton, [IsList and IsTreeHomomorphismCollection],
function(tree_hom_list)
  return MealyAutomaton(tree_hom_list, false);
end);

###############################################################################
##
##
##
InstallMethod(MealyAutomaton, [IsList, IsObject],
function(tree_hom_list, name_func)
  local a, states, names, MealyAutomatonLocal, aut_list;

  MealyAutomatonLocal := function(g)
    local cur_state;
    if g in states then return Position(states, g); fi;
    Add(states, g);
    if IsFunction(name_func) then
      Add(names, name_func(g));
    elif name_func = true then
      Add(names, Concatenation("<", String(g), ">"));
    fi;
    cur_state := Length(states);
    aut_list[cur_state] := List([1..g!.deg], x -> MealyAutomatonLocal(Section(g, x)));
    Add(aut_list[cur_state], g!.perm);
    return cur_state;
  end;

  names := [];
  states := [];
  aut_list := [];
  for a in tree_hom_list do
    MealyAutomatonLocal(a);
  od;

  if not IsEmpty(names) then
    return MealyAutomaton(aut_list, names);
  else
    return MealyAutomaton(aut_list);
  fi;
end);

InstallMethod(MealyAutomaton, [IsSelfSim],
function(a)
  local states, MealyAutomatonLocal, aut_list;

  MealyAutomatonLocal := function(g)
    local cur_state;
    if g!.word in states then return Position(states, g!.word); fi;
    Add(states, g!.word);
    cur_state := Length(states);
    aut_list[cur_state] := List([1..g!.deg], x -> MealyAutomatonLocal(Section(g, x)));
    Add(aut_list[cur_state], g!.perm);
    return cur_state;
  end;

  states := [];
  aut_list := [];
  MealyAutomatonLocal(a);
  return MealyAutomaton(aut_list);
end);

InstallMethod(SetStateName, [IsMealyAutomaton, IsInt, IsString],
function(aut, k, name)
  local new_names;
  if k < 1 or k > aut!.n_states then
    Error("wrong state number ", k);
  fi;
  new_names := List(aut!.states);
  new_names[k] := name;
  SetStateNames(aut, new_names);
end);

InstallMethod(SetStateNames, [IsMealyAutomaton, IsList],
function(aut, names)
  if not IsDenseList(names) or Length(names) <> aut!.n_states or
     not ForAll(names, IsString) or Length(AsSet(names)) <> aut!.n_states
  then
    Error("invalid state names list, it must be a dense list of strings of length ",
          aut!.n_states, " without duplicates");
  fi;
  aut!.states := MakeImmutable(List(names));
end);

InstallMethod(Display, [IsMealyAutomaton and IsMealyAutomatonRep],
function(a)
  local i, j;

  for i in [1..a!.n_states] do
    Print(a!.states[i], " = (");
    for j in [1..a!.degree] do
      Print(a!.states[a!.table[i][j]]);
      if j <> a!.degree then
        Print(", ");
      fi;
    od;
    Print(")");
    if not IsOne(a!.perms[i]) then
      __AG_PrintPerm(a!.perms[i]);
    fi;
    if i <> a!.n_states then
      Print(", ");
    fi;
  od;
end);

InstallMethod(String, [IsMealyAutomaton and IsMealyAutomatonRep],
function(a)
  local i, j, str;
  str := "";
  for i in [1..a!.n_states] do
    Append(str,Concatenation(String(a!.states[i]), " = ("));
    for j in [1..a!.degree] do
      Append(str,String(a!.states[a!.table[i][j]]));
      if j <> a!.degree then
        Append(str,", ");
      fi;
    od;
    Append(str, ")");
    if not IsOne(a!.perms[i]) then
      Append(str,__AG_PermString(a!.perms[i]));
    fi;
    if i <> a!.n_states then
      Append(str,", ");
    fi;
  od;
  return str;
end);

InstallMethod(ViewObj, [IsMealyAutomaton],
function(a)
  Print("<automaton>");
end);

InstallMethod(PrintObj, [IsMealyAutomaton],
function(a)
  Print("MealyAutomaton(\"",String(a),"\")");
end);

BindGlobal("AG_AutomatonTransform",
function(a, q, x)
  local i, j, nq, nx, t;

  nq := Length(q);
  nx := Length(x);

  for i in [1..nq] do
    for j in [1..nx] do
      t := x[j];
      x[j] := a!.trans[q[i]][t];
      q[i] := a!.table[q[i]][t];
    od;
  od;
end);

# InstallMethod(TransitionFunction, [IsMealyAutomaton and IsMealyAutomatonRep],
# function(a)
#   local func, table;
#
#   table := a!.table;
#
#   func := function(Q, X)
#
#   end;
#
#   return func;
# end);

InstallMethod(AutomatonList, [IsMealyAutomaton],
function(a)
  return List([1..a!.n_states], i -> Concatenation(a!.table[i], [a!.perms[i]]));
end);

InstallMethod(NumberOfStates, [IsMealyAutomaton],
function(A)
  return A!.n_states;
end);

InstallMethod(SizeOfAlphabet, [IsMealyAutomaton],
function(A)
  return A!.degree;
end);

InstallMethod(AG_MinimizedAutomatonList, "for [IsMealyAutomaton]", [IsMealyAutomaton],
function(A)
  return AG_AddInversesList(List(AutomatonList(A), x -> List(x)));
end);

InstallGlobalFunction(MinimizationOfAutomatonTrack,
function(a)
  local min_aut;
  min_aut := AG_MinimizationOfAutomatonListTrack(List(AutomatonList(a), x -> List(x)));
  return [MealyAutomaton(min_aut[1], a!.states{min_aut[2]}), min_aut[2], min_aut[3]];
end);

InstallGlobalFunction(MinimizationOfAutomaton,
function(a)
  local min_aut;
  min_aut := AG_MinimizationOfAutomatonListTrack(List(AutomatonList(a), x -> List(x)));
  return MealyAutomaton(min_aut[1], a!.states{min_aut[2]});
end);

# this is the method which uses PolynomialDegreeOfGrowthOfUnderlyingAutomaton
#InstallMethod(IsOfPolynomialGrowth, "for [IsMealyAutomaton]", true,
#              [IsMealyAutomaton],
#function(A)
#  local G, res;
#  G := AutomatonGroup(A);
#  res := IsGeneratedByAutomatonOfPolynomialGrowth(G);
#  if res then
#    SetPolynomialDegreeOfGrowth(A, PolynomialDegreeOfGrowthOfUnderlyingAutomaton(G));
#  fi;
#  SetIsBounded(A, IsGeneratedByBoundedAutomaton(G));
#  return res;
#end);

InstallMethod(IsOfPolynomialGrowth, "for [IsMealyAutomaton]", true,
              [IsMealyAutomaton],
function(A)
  local i, d, ver, nstates, cycles, cycle_of_vertex,
        IsNewCycle, known_vertices, aut_list, HasPolyGrowth,
        cycle_order, next_cycles, cur_cycles, cur_path, cycles_of_level,
        lev, ContainsTrivState, s;

  IsNewCycle := function(C)
    local i, l, cur_cycle, long_cycle;

    l := [2..Length(C)];
    Add(l, 1);
    long_cycle := PermList(l);

    for cur_cycle in cycles do
      if Intersection(cur_cycle, C) <> [] then
#        if Length(C)<>Length(cur_cycle) then return fail; fi;
#        for i in [0..Length(C)-1] do
#          if cur_cycle=Permuted(C, long_cycle^i) then return false; fi;
#        od;
        Info(InfoAutomGrp, 5, "cycle1=", cur_cycle, "cycle2=", C);
        return fail;
      fi;
    od;

    return true;
  end;

#  Example:
#  cycles = [[1, 2, 4], [3, 5, 6], [7]]
#  cur_cycles = [1, 3] (the first and the third cycles)
#  cycle_order = [[2, 3], [3], []] (means 1 -> 2 -> 3,  1 -> 3)

  HasPolyGrowth := function(v)
    local i, v_next, is_new, C, ver;
#    Print("v=", v, "\n");
    Add(cur_path, v);
    for i in [1..d] do
      v_next := aut_list[v][i];
      if not (v_next in known_vertices or v_next = nstates+1) then
        if v_next in cur_path then
          C := cur_path{[Position(cur_path, v_next)..Length(cur_path)]};
          is_new := IsNewCycle(C);
          if is_new = fail then
            return false;
          fi;

          Add(cycles, C);
          Add(cycle_order, []);
          for ver in C do
#              Print("next_cycles = ", next_cycles);
            UniteSet(cycle_order[Length(cycles)], next_cycles[ver]);
            cycle_of_vertex[ver] := Length(cycles);
            next_cycles[ver] := [Length(cycles)];
          od;
        else
          if not HasPolyGrowth(v_next) then
            return false;
          fi;
          if cycle_of_vertex[v] = 0 then
            UniteSet(next_cycles[v], next_cycles[v_next]);
          elif cycle_of_vertex[v] <> cycle_of_vertex[v_next] then
            UniteSet(cycle_order[cycle_of_vertex[v]], next_cycles[v_next]);
            Info(InfoAutomGrp, 5, "v=", v, "; v_next=", v_next);
            Info(InfoAutomGrp, 5, "cycle_order (local) = ", cycle_order);
          fi;
        fi;
      elif v_next in known_vertices then
        if cycle_of_vertex[v]=0 then
          UniteSet(next_cycles[v], next_cycles[v_next]);
        elif cycle_of_vertex[v] = cycle_of_vertex[v_next] then
          return false;
        else
          UniteSet(cycle_order[cycle_of_vertex[v]], next_cycles[v_next]);
        fi;

      fi;
    od;

    Remove(cur_path);
    Add(known_vertices, v);
    return true;
  end;

  aut_list := AG_MinimizationOfAutomatonList(List(AutomatonList(A), x -> List(x)));

# below we put the trivial state to the last position in the aut_list
  ContainsTrivState := false;

  for s in [1..Length(aut_list)] do
    if AG_IsTrivialStateInList(s, aut_list) then
      ContainsTrivState := true;
      if s < Length(aut_list) then
        aut_list := AG_PermuteStatesInList(aut_list, (s, Length(aut_list)));
      fi;
      break;
    fi;
  od;

  if not ContainsTrivState then
    SetIsBounded(A, false);
    return false;
  fi;

  nstates := Length(aut_list) - 1;
  d := A!.degree;
  cycles := [];
  cycle_of_vertex := List([1..nstates], x -> 0);  #if vertex i is in cycle j, then cycle_of_vertex[i]=j
  next_cycles := List([1..nstates], x -> []); #if vertex i is not in a cycle, next_cycles[i] stores the list of cycles, that can be reached immediately (with no cycles in between) from this vertex
  known_vertices := [];
  cur_path := [];
  cycle_order := [];

  while Length(known_vertices) < nstates do
    ver := Difference([1..nstates], known_vertices)[1];
    if not HasPolyGrowth(ver) then
      SetIsBounded(A, false);
      return false;
    fi;
  od;

# Now we find the longest chain in the poset of cycles
  cycles_of_level := [[]];
  for i in [1..Length(cycles)] do
    if cycle_order[i] = [] then
      Add(cycles_of_level[1], i);
    fi;
  od;

  lev := 1;

  while cycles_of_level[Length(cycles_of_level)] <> [] do
    Add(cycles_of_level, []);
    for i in [1..Length(cycles)] do
      if Intersection(cycles_of_level[lev], cycle_order[i]) <> [] then
        Add(cycles_of_level[lev+1], i);
      fi;
    od;
    lev := lev+1;
  od;

  if lev<=2 then
    SetIsBounded(A, true);
  else
    SetIsBounded(A, false);
  fi;
  SetPolynomialDegreeOfGrowth(A, lev-2);
  Info(InfoAutomGrp, 5, "Cycles = ", cycles);
  Info(InfoAutomGrp, 5, "cycle_order = ", cycle_order);
  Info(InfoAutomGrp, 5, "next_cycles = ", next_cycles);
  return true;
end);

InstallMethod(IsBounded, "for [IsMealyAutomaton]", true,
              [IsMealyAutomaton],
function(A)
  IsOfPolynomialGrowth(A);
  return IsBounded(A);
end);

InstallMethod(PolynomialDegreeOfGrowth, "for [IsMealyAutomaton]", true,
              [IsMealyAutomaton],
function(A)
  local res;

  res := IsOfPolynomialGrowth(A);

  if not res then
    Info(InfoAutomGrp, 1, "Error: the automaton <A> has exponential growth");
    return fail;
  fi;

  return PolynomialDegreeOfGrowth(A);
end);

InstallMethod(DualAutomaton, "for [IsMealyAutomaton]", true,
              [IsMealyAutomaton],
function(A)
  local list, dual_list, states, d, n;

  list := AutomatonList(A);
  d := Length(list[1]) - 1;
  n := Length(list);
  dual_list := List([1..d], i -> Concatenation(List([1..n], j -> i^list[j][d+1]),
                                               [Transformation(List([1..n], j -> list[j][i]))]));
  states := List([1..d], i -> Concatenation(AG_Globals.state_symbol_dual, String(i)));

  return MealyAutomaton(dual_list, states);
end);

InstallMethod(InverseAutomaton, "for [IsMealyAutomaton]", true,
              [IsMealyAutomaton],
function(A)
  local list, inv_list, states, n;

  if not IsInvertible(A) then
    Error("MealyAutomaton <A> is not invertible");
  fi;

  list := AutomatonList(A);
  n := Length(list);
  inv_list := AG_InverseAutomatonList(list);
  states := List([1..n], i -> Concatenation(AG_Globals.state_symbol, String(i)));

  return MealyAutomaton(inv_list, states);
end);

InstallMethod(Inverse, "for [IsMealyAutomaton]", true,
              [IsMealyAutomaton],
function(A)
  return InverseAutomaton(A);
end);

###############################################################################
##
#M  \^
##
##  Constructs the power <power> of an automaton, where <power> can be negative as well
##

InstallMethod(\^, "for [IsMealyAutomaton, IsCyclotomic]", [IsMealyAutomaton, IsCyclotomic],
function(A, power)
  if power>0 then
    TryNextMethod();
  elif power=0 then
    return MealyAutomaton([Concatenation(List([1..A!.degree],x->1),[()])]);
  else
    return InverseAutomaton(A)^-power;
  fi;
end);

###############################################################################
##
#M  \/
##
##  Constructs the power <power> of an automaton, where <power> can be negative as well
##

InstallMethod(\/, "for [IsMealyAutomaton, IsMealyAutomaton]", [IsMealyAutomaton, IsMealyAutomaton],
function(A1, A2)
  return A1*A2^-1;
end);

InstallMethod(IsBireversible, "for [IsMealyAutomaton]", true,
              [IsMealyAutomaton],
function(A)
  return IsInvertible(A) and IsInvertible(DualAutomaton(A)) and
         IsInvertible(DualAutomaton(InverseAutomaton(A)));
end);

InstallMethod(IsReversible, "for [IsMealyAutomaton]", true,
              [IsMealyAutomaton],
function(A)
  return IsInvertible(DualAutomaton(A));
end);

InstallMethod(IsIRAutomaton, "for [IsMealyAutomaton]", true,
              [IsMealyAutomaton],
function(A)
  return IsInvertible(A) and IsInvertible(DualAutomaton(A));
end);

InstallMethod(MDReduction, "for [IsMealyAutomaton]",
              [IsMealyAutomaton],
function(A)
  local B, DB, MDB;
  B:=MinimizationOfAutomaton(A);
  DB:=DualAutomaton(B);
  MDB:=MinimizationOfAutomaton(DB);
  while NumberOfStates(MDB)<NumberOfStates(DB) do
    B:=MDB;
    DB:=DualAutomaton(B);
    MDB:=MinimizationOfAutomaton(DB);
  od;
  return [B,MDB];
end);

InstallMethod(IsMDTrivial, "for [IsMealyAutomaton]", true,
              [IsMealyAutomaton],
function(A)
  local MDT;
  MDT:=MDReduction(A);
  if NumberOfStates(MDT[1])=1 then
    return true;
  fi;
  return false;
end);

InstallMethod(IsMDReduced, "for [IsMealyAutomaton]", true,
              [IsMealyAutomaton],
function(A)
  local B, DB, MDB;
  B:=MinimizationOfAutomaton(A);
  if NumberOfStates(B)<NumberOfStates(A) then
    return false;
  else
    DB:=DualAutomaton(B);
    MDB:=MinimizationOfAutomaton(DB);
    if NumberOfStates(MDB)<NumberOfStates(DB) then
      return false;
    fi;
  fi;
  return true;
end);

###############################################################################
##
#M  \*
##
##  Constructs a product of two noninitial automata
##
InstallMethod(\*, "for [IsMealyAutomaton, IsMealyAutomaton]", [IsMealyAutomaton, IsMealyAutomaton],
function(A1, A2)
  local n, m, d, i, j, aut_list, states;

  d := A1!.degree;
  if d <> A2!.degree then
    Error("The cardinalities of alphabets in <A1> and <A2> do not coincide");
  fi;

  n := A1!.n_states;
  m := A2!.n_states;
  aut_list := [];
  for i in [1..n] do
    for j in [1..m] do
#     (i, j)                                < ->     m*(i-1)+j
#     (Int((x-1)/m)+1, ((x-1) mod m) + 1 ) < ->     x
      Add(aut_list, Concatenation(List([1..d], x -> m*(A1!.table[i][x]-1) + A2!.table[j][x^A1!.perms[i]]), [A1!.perms[i]*A2!.perms[j]]));
    od;
  od;
  states := List([1..n*m], i -> Concatenation(AG_Globals.state_symbol, String(i)));
  return MealyAutomaton(aut_list, states);
end);

InstallMethod(IsTrivial, "for [IsMealyAutomaton]", [IsMealyAutomaton],
function(A)
  # XXX trivial transformation
  return AutomatonList(MinimizationOfAutomaton(A)) = [Concatenation(List([1..A!.degree], x -> 1), [()])];
end);

InstallMethod(DisjointUnion, "for [IsMealyAutomaton, IsMealyAutomaton]", [IsMealyAutomaton, IsMealyAutomaton],
function(A, B)
  local n, m, aut_list, states, perms, tableA, tableB;

  if A!.degree <> B!.degree then
    Error("The cardinalities of alphabets in <A> and <B> do not coincide");
  fi;

  n := A!.n_states;
  m := B!.n_states;
  tableA := List(A!.table, x -> List(x));
  tableB := List(B!.table, x -> List(x));
  Append(tableA, List(tableB, x -> List(x, y -> y+n)));
  perms := Concatenation(A!.perms, B!.perms);

  aut_list := List([1..n+m], i -> Concatenation(tableA[i], [perms[i]]));

  states := List([1..n+m], i -> Concatenation(AG_Globals.state_symbol, String(i)));

  return MealyAutomaton(aut_list, states);
end);

InstallMethod(AreEquivalentAutomata, "for [IsMealyAutomaton, IsMealyAutomaton]", [IsMealyAutomaton, IsMealyAutomaton],
function(A, B)
  local n, m, i, j, aut_list, found, Am, Bm, C, equiv_statesB;

  if A!.degree <> B!.degree then
    return false;
  fi;

  Am := MinimizationOfAutomaton(A);
  Bm := MinimizationOfAutomaton(B);
  n := Am!.n_states;
  m := Bm!.n_states;
  if m <> n then
    return false;
  fi;

  C := DisjointUnion(Am, Bm);
  aut_list := AutomatonList(C);

  equiv_statesB := [];

  for i in [1..n] do
    found := false;
    for j in [n+1..n+m] do
      if (not j in equiv_statesB) and AG_AreEquivalentStatesInList(i, j, aut_list) then
        found := true;
        Add(equiv_statesB, j);
        break;
      fi;
    od;
    if not found then
      return false;
    fi;
  od;

  return true;
end);

InstallMethod(SubautomatonWithStates, "for [IsMealyAutomaton, IsList]", [IsMealyAutomaton, IsList],
function(A, states)
  local G, d, i, g, perm, subautom_list, newsubautom_list;

  G := AutomatonList(A);
  d := A!.degree;

# first we add all states of <states> in the list
  for g in states do
    for i in [1..d] do
      if not (G[g][i] in states) then
        Add(states, G[g][i]);
      fi;
    od;
  od;

  Sort(states);
  subautom_list := G{states};
  newsubautom_list := [];

  for g in subautom_list do
    perm := g[d+1];
    g := List(g{[1..d]}, x -> Position(states, x));
    Add(g, perm);
    Add(newsubautom_list, g);
  od;

  return MealyAutomaton(newsubautom_list, A!.states{states});
end);

InstallMethod(AutomatonNucleus, "for [IsMealyAutomaton]", [IsMealyAutomaton],
function(A)
  local IsElemInNucleus, G, tmp, d, Nucl, i;

  IsElemInNucleus := function(g)
    local i, res;
    if g in tmp then
      for i in [Position(tmp, g)..Length(tmp)] do
        if not (tmp[i] in Nucl) then Add(Nucl, tmp[i]); fi;
      od;
      return g=tmp[1];
    fi;
    Add(tmp, g);
    res := false; i := 1;
    while (not res) and i<=d do
      res := IsElemInNucleus(G[g][i]);
      i := i+1;
    od;
    Remove(tmp);
    return res;
  end;

  G := AutomatonList(A);
  d := A!.degree;

  Nucl := [];
# first add elements of cycles
  for i in [1..Length(G)] do
    tmp := [];
    if not (i in Nucl) then IsElemInNucleus(i); fi;
  od;

  return SubautomatonWithStates(A, Nucl);
end);

InstallMethod(AdjacencyMatrix, "for [IsMealyAutomaton]", [IsMealyAutomaton],
function(A)
  local i, s, d, M, aut_list;
  aut_list := AutomatonList(A);
  M:=List([1..A!.n_states],x->List([1..A!.n_states],x->0));
  d := A!.degree;
  for s in [1..A!.n_states] do
    for i in [1..d] do
      M[s][aut_list[s][i]]:=M[s][aut_list[s][i]]+1;
    od;
  od;
  return M;
end);

InstallMethod(IsAcyclic, "for [IsMealyAutomaton]", [IsMealyAutomaton],
function(A)
  local i, j, M, N;
  M:=AdjacencyMatrix(A);
  N:=StructuralCopy(M);
  for i in [1..(A!.n_states-1)] do
    N:=N*M;
    for j in [1..A!.n_states] do
      if N[j][j]<>M[j][j]^(i+1) then return false; fi;
    od;
  od;
  return true;
end);

#E


# Copyright (c) 2018-2021, Carnegie Mellon University
# See LICENSE for details

# alpha is a function of P (divisor of N)
# m = N/P

# Frequency domain, u in [0, N)
# Per processor, total pts=2*m, total useful pts=m
# We start to see aliasing at 3*m/2, m=N/P.
W := (alpha, u) -> exp(-alpha * u^2);

# Time domain, t in [0, 1]
w := (alpha, t) -> sqrt(d_PI / alpha) * exp(-d_PI^2 * t^2 / alpha);

# digits - eg. 17, number of exact (unaffected by aliasing) decimal digits
gauss_alpha := (N, p, digits) -> let(m := N/p, 4/9 * digits * d_log(10) / m^2);

# how many samples of the filter to keep in the time domain, assuming gauss_alpha(N, p, digits)
# was used.
edge := digits -> IntDouble(d_ceil(2/(3*d_PI) * d_log(10) * digits));

Class(fPerExt, FuncClass, rec(
    def := (N, l, r) -> rec(N:=N, n:=N+l+r),
    lambda := self >> let(N := self.params[1], l:=self.params[2], r:=self.params[3],
 	j := Ind(self.n),
	Lambda(j, imod(j-l, N)))
));

# below we should not use HZ, since HZ assumes that n * stride = N, and if used as below
# assumption will be violated
#RewriteRules(RulesFuncSimp, rec(
#    fPerExt_H := ARule(fCompose, [@(1,fPerExt), @(2,H)], e ->
#	let(base := @(2).val.params[3], stride := @(2).val.params[4],
#	[ HZ(@(1).val.N, @(2).val.n, base - @(1).val.params[2], stride) ]))
#));

NewRulesFor(DFT, rec(

   DFT_Gauss := rec(
	forTransposition := true,
	minSize     := 4,
	maxSize     := false,
	p      := 4,
	digits := 15,

	applicable  := (self, t) >> (self.minSize<>false and Rows(t) > self.minSize) and
	                            not IsPrime(Rows(t)) and t.params[2] in [1,-1 mod Rows(t)],

        libApplicable := (self, t) >> eq(imod(t.params[1], self.p), 0),
	freedoms := (self, t) >> [],

	child := (self, t, freedoms) >> let(N := Rows(t), p := self.p,
	    [ DFT(2*N/p, t.params[2]), DFT(p, t.params[2]) ]),

	apply := meth(self, t,C,Nonterms)
	    local N, m, n, rot, k, p, alpha, time_filter, freq_filter, j;
	    N := Rows(t);
	    n := Rows(C[2]);
	    k := edge(self.digits);
	    p := self.p;
	    m := N/p;
	    alpha := gauss_alpha(N, p, self.digits);

	    time_filter := let(i:=Ind(2*k*p), Lambda(i, w(alpha, (i-k*p)/N)).setRange(TDouble));
	    freq_filter := let(i:=Ind(m),     Lambda(i, p/(2*N*W(alpha, i-m/2))).setRange(TDouble));

	    j := Ind(p);
	    return
	    Grp(
		IterDirectSum(j, j.range,
		    Diag(freq_filter) *
		    Gath(H(2*m, m, m*imod(j,2), 1)).toloop(4) * C[1]
		) *
		(Tr(2*N/p, p))
	    ) *
	    RowTensor(2*N/p, 2*k*p-p/2,
		C[2] *
		let(i:=Ind(p), Diag(Lambda(i, omega(2*p, i)).setRange(TComplex))) *
		Tensor(RowVec(List([0..2*k-1], x->(-1)^x)), I(p)) *
		Diag(time_filter)
	    ) *
	    Gath(fPerExt(N, k*p, k*p-p/2));
	end

   )
));

# scaling by p/(2*N) belongs to the time_filter, but freq_filter is shorter
#	    time_filter := List([-k*p .. k*p-1], i-> w(alpha, i/N));
#	    freq_filter := List([-m/2..m/2-1], i-> p/(2*N*W(alpha, i)));

#	    return
#	    Z(N, m/2) *
#	    Tensor(I(p/2),
#		   DirectSum(
#		       Diag(freq_filter) * Gath(fStack(H(2*m, m/2, 3*m/2, 1), H(2*m, m/2, 0, 1))) * C[1],
#		       Diag(freq_filter) * Gath(H(2*m, m, m/2, 1)) * C[1])
#	    ) *

testGauss := function(N, p, k)
    local s, me, them;
    DFT_Gauss.p := p;
    SwitchRulesByNameQuiet(DFT, [DFT_Gauss]);
    s := SPLRuleTree(ExpandSPL(DFT(N,k))[1]);
    me := MatSPL(s);
    them := MatSPL(DFT(N,k));
    VisualizeMat(me-them, " ");
    return [s, me, them];
end;

splGauss := function(N, p, k)
    local s, me, them;
    DFT_Gauss.p := p;
    SwitchRulesByNameQuiet(DFT, [DFT_Gauss]);
    s := SPLRuleTree(ExpandSPL(DFT(N,k))[1]);
    return s;
end;

sums := function(s, opts)
    local real;
    real := s.isReal();
    s := SumsSPL(s);
    s := SubstBottomUp(s, @.cond(IsNonTerminal), x->RecursStep(0,0,x));
    s := ApplyStrategy(s, opts.formulaStrategies.sigmaSpl, UntilDone);
    if not opts.generateComplexCode and not real then
        s := ApplyStrategy(RC(s), opts.formulaStrategies.rc, UntilDone); fi;
    return ApplyStrategy(s, opts.formulaStrategies.postProcess, UntilDone);
end;

# opts := CopyFields(SpiralDefaults, rec(generateComplexCode := true));
# opts := CopyFields(opts, rec(unparser := CMacroUnparser));

# N := 128;
# k := edge(17);
# p := 4;
# alpha := alpha(N, p, 17);

NewRulesFor(DFT, rec(

   DFT_PrunedGauss := rec(
	forTransposition := true,
	minSize     := 4,
	maxSize     := false,
	p := 2,
	digits := 15,

	applicable  := (self, t) >> (self.minSize<>false and Rows(t) > self.minSize) and
	                            not IsPrime(Rows(t)) and t.params[2] in [1,-1 mod Rows(t)],

	children := (self, t) >> let(N := Rows(t), p := self.p,
	    [[ DFT(2*N/p, t.params[2]), DFT3(p, t.params[2]) ]]), #DFT3

	apply := meth(self, t,C,Nonterms)
	    local N, m, n, mat, rot, k, p, alpha, time_filter, freq_filter, freq_filter2;
	    N := Rows(t);
	    n := Rows(C[2]);
            mat := MatSPL(C[2]);
	    k := edge(self.digits);
	    p := self.p;
	    m := N/p;
	    alpha := gauss_alpha(N, p, self.digits);
	    time_filter := List([-k*p .. k*p-1], i-> w(alpha, i/N).eval());
	    freq_filter := List([-m/2..m/2-1], i-> p/(2*N*W(alpha, i).eval()));

	    return
	    Diag(freq_filter) * Gath(H(2*m, m, 0, 1)) * C[1] *
	    RowTensor(2*N/p, 2*k*p-p/2,
		RowVec(mat[1]) *
		Tensor(RowVec(List([0..2*k-1], x->(-1)^x)), I(p)) *
		Diag(time_filter)) *
	    transforms.filtering.Ext(N, transforms.filtering.per(k * p),
		                        transforms.filtering.per(k * p - p/2));
	end
   )
));

#2N/p  * 2kp
#4Nk complex fmas overhead for filter (one stripe out), k=edge(digits)


# return a list of two lists :
# first is the list of months with five weekends between years y1 and y2 (included)
# second is the list of years without such months, in the same interval
FiveWeekends := function(y1, y2)
  local L, yL, badL, d, m, y;
  L := [ ];
  badL := [ ];
  for y in [y1 .. y2] do
    yL := [ ];
    for m in [1, 3, 5, 7, 8, 10, 12] do
      if WeekDay([1, m, y]) = "Fri" then
        d := StringDate([1, m, y]);
        Add(yL, d{[4 .. 11]});
      fi;
    od;
    if Length(yL) = 0 then
      Add(badL, y);
    else
      Append(L, yL);
    fi;
  od;
  return [ L, badL ];
end;

r := FiveWeekends(1900, 2100);;
n := Length(r[1]);
# 201
Length(r[2]);
# 29
r[1]{[1 .. 5]};
# [ "Mar-1901", "Aug-1902", "May-1903", "Jan-1904", "Jul-1904" ]
r[1]{[n-4 .. n]};
# [ "Mar-2097", "Aug-2098", "May-2099", "Jan-2100", "Oct-2100" ]


# Copyright (c) 2018-2021, Carnegie Mellon University
# See LICENSE for details

benchAVX := function()
    if LocalConfig.cpuinfo.SIMD().hasAVX() then
        return rec(
            4x64f := rec(
                wht := _defaultSizes(s->doSimdWht(s, AVX_4x64f, rec(verify := true, oddSizes := false, svct := true)), List([4..8], i->2^i)),
                1d := rec(
                    dft_ic := rec(
                        small := rec(
                            real := _defaultSizes(s->doSimdDft(s, AVX_4x64f, rec(verify := true, globalUnrolling := 10000, tsplBluestein:=true,
                              PRDFT:=true, URDFT:= true, CT := true, minCost := true, tsplPFA := true, tsplCT := true, oddSizes := true, PD := true, PFA := true,
                              RealRader := true, Rader := true, realVect := true, cplxVect := false, stdTTensor := false, interleavedComplex := true)), [2..64]),
                            cmplx := _defaultSizes(s->doSimdDft(s, AVX_4x64f, rec(verify := true, globalUnrolling := 10000, tsplBluestein:=true,
                              PRDFT:=false, URDFT:= true, CT := true, minCost := true, tsplPFA := true, tsplCT := true, oddSizes := true, PD := true, PFA := true,
                              RealRader := true, Rader := true, realVect := false, cplxVect := true, stdTTensor := false, interleavedComplex := true)), [2..64])
                        ),
                        medium := _defaultSizes(s->doSimdDft(s, AVX_4x64f, rec(globalUnrolling := 128, tsplRader:=false, tsplBluestein:=false, tsplPFA:=false, oddSizes:=false,
                                interleavedComplex := true, cplxVect := false, realVect := true)),
                              List([4..16], i->2^i)),
                        medium_cx := _defaultSizes(s->doSimdDft(s, AVX_4x64f, rec(
                                globalUnrolling := 128,
                                tsplRader       := false,
                                tsplBluestein   := false,
                                tsplPFA         := false,
                                URDFT           := true,
                                PRDFT           := false,
                                oddSizes        := false,
                                cplxVect        := true,
                                realVect        := false,
                                svct            := false,
                                splitL          := true,
                                interleavedComplex := true)),
                              List([2..16], i->2^i))
                    ),

                    dft_sc := rec(
                        small :=  _defaultSizes(s -> doSimdDft(s, AVX_4x64f, rec(
				       verify     := true,
				       stdTTensor := false,
				       svct       := true,
				       flipIxA    := true,
				       realVect   := true,
				       oddSizes   := true,
				       interleavedComplex := false,
				       globalUnrolling := 10000
				  )), List([1 .. 8], i -> 2^i)), # tsplRader:=false, tsplBluestein:=false, tsplPFA:=false,

                        medium := _defaultSizes(s->doSimdDft(s, AVX_4x64f, rec(
				       verify        := true,
				       tsplRader     := false,
				       tsplBluestein := false,
				       tsplPFA       := false,
				       oddSizes      := false,
				       globalUnrolling := 10000,
				       interleavedComplex := false
				  )), 16 * [1 .. 8]),
                    ),

                    trdft := _defaultSizes(s -> doSimdSymDFT(TRDFT, s, AVX_4x64f, rec(
				  verify     := true,
				  PRDFT      := false,
				  URDFT      := true,
				  cplxVect   := true,
                                  stdTTensor := false,
				  realVect   := true,
				  svct       := true, # <-- added from dft_sc
				  #flipIxA    := true, #<-- added from dft_sc, do we need this?
				  useDeref   := true,
                                  oddSizes   := true, # need this for TRDFT(16)
				  propagateNth := true,
                                  globalUnrolling :=10000,
                                  interleavedComplex := true,
			      )), 8 * [1 .. 32]),
                )
            ),
            8x32f := rec(
                wht := _defaultSizes(s->doSimdWht(s, AVX_8x32f, rec(verify := true, oddSizes := false, svct := true)), List([6..8], i->2^i)),
                1d := rec(
                    dft_ic := rec(
                        small := rec(
                            real := _defaultSizes(s -> doSimdDft(s, AVX_8x32f, rec(
					  verify     := true,
					  PRDFT      := true,
					  URDFT      := true,
					  CT         := true,
					  minCost    := true,
					  tsplPFA    := true,
					  tsplCT     := true,
					  oddSizes   := true,
					  PD         := true,
					  PFA        := true,
					  RealRader  := true,
					  Rader      := true,
					  realVect   := true,
					  cplxVect   := false,
					  stdTTensor := false,
					  tsplBluestein := true,
					  globalUnrolling := 10000,
					  interleavedComplex := true)), [2..64]),

                            cmplx := _defaultSizes(s->doSimdDft(s, AVX_8x32f, rec(
					  verify := true, globalUnrolling := 10000, tsplBluestein:=true,
					  PRDFT:=false, URDFT:= true, CT := true, minCost := true, tsplPFA := true,
					  tsplCT := true, oddSizes := true, PD := true, PFA := true,
					  RealRader := true, Rader := true, realVect := false, cplxVect := true,
					  stdTTensor := false, interleavedComplex := true)), [2..64])
                        ),

                        medium := _defaultSizes(s->doSimdDft(s, AVX_8x32f, rec(
				      tsplRader     := false,
				      tsplBluestein := false,
				      tsplPFA := false,
				      oddSizes := false,
				      cplxVect := false,
				      realVect := true,
				      globalUnrolling := 128,
                                      interleavedComplex := true,
				  )), List([6..16], i->2^i)),

                        medium_cx := _defaultSizes(s->doSimdDft(s, AVX_8x32f, rec(
                                    globalUnrolling := 128,
                                    tsplRader       := false,
                                    tsplBluestein   := false,
                                    tsplPFA         := false,
                                    PRDFT           := false,
                                    URDFT           := true,
                                    CT              := false,
                                    PD              := false,
                                    oddSizes        := false,
                                    cplxVect        := true,
                                    realVect        := false,
                                    svct            := true,
                                    flipIxA         := true,
                                    interleavedComplex := true
				)), List([4..16], i->2^i))
                    ),

                    dft_sc := rec(
                        small :=  _defaultSizes(s -> doSimdDft(s, AVX_8x32f, rec(
				       verify     := true,
				       stdTTensor := false,
				       svct       := true,
				       flipIxA    := true,
				       realVect   := true,
				       oddSizes   := true,
				       interleavedComplex := false,
				       globalUnrolling := 10000
				  )), List([1 .. 8], i -> 2^i)),

                        medium := _defaultSizes(s->doSimdDft(s, AVX_8x32f, rec(
				       verify        := true,
				       tsplRader     := false,
				       tsplBluestein := false,
				       tsplPFA       := false,
				       oddSizes      := false,
				       globalUnrolling := 10000,
				       interleavedComplex := false
				  )), 64*[1..4]),
                    ),

                    trdft := _defaultSizes(s -> doSimdSymDFT(TRDFT, s, AVX_8x32f, rec(
				  verify     := true,
				  PRDFT      := false,
				  URDFT      := true,
				  cplxVect   := true,
                                  stdTTensor := false,
				  realVect   := true,
				  svct       := true, # <-- added from dft_sc
				  #flipIxA    := true, #<-- added from dft_sc, do we need this?
				  useDeref   := true,
                                  oddSizes   := true, # need this for TRDFT(16)
				  propagateNth := true,
                                  globalUnrolling :=10000,
                                  interleavedComplex := true,
			      )), 16 * [1 .. 32]),
                )
            )
        );
    else
        return false;
    fi;
end;


# Copyright (c) 2018-2021, Carnegie Mellon University
# See LICENSE for details

Declare(DWTper);

#F DWTper(<n>, <j>, [<h(z)>,<g(z)>])
#F DWTper(<n>, <j>, <L>, <V>)
#F   returns a 2-channel <j>-stage discrete wavelet transform with periodic extensions
#F   (circulant transforms) where the
#F   low pass and the high pass analysis filters given by polynomials
#F   [<h(z)>,<g(z)>]
#F
#F   <L> = [<Lh>,<Lg>] - coefficient lists for h and g
#F   <V> = [<vh>,<vg>] - valuation for h and g
#F
#F  <n> - size of the output of the reconstructed sequence
#F  <j> - number of filter bank stages
Class(DWTper, NonTerminal, rec(

  abbrevs := [
    function(n,j,M)
    local S,L,V, j;
    if IsList(M[1]) then
     S:=List([1,2], j->FillZeros([M[1][j],M[2][j]]));
     V:=List(S, j->j[2]);
     L:=List(S, j->j[1]);
     return [n,j,L,V];
    else
    Checked(IsPosInt(n), Checked(ForAll(M,i->IsPolynomial(i)),true));
      S:=List(M, i-> FillZeros(i));
      V:=List(S, i->i[2]);
      L:=List(S, i->i[1]);
    return [n,j,L,V];
    fi;
    end,
    function(n,j,L,V)
    local S,V,L,i,j;
     S:=List([1,2], j->FillZeros([L[j],V[j]]));
     V:=List(S, j->j[2]);
     L:=List(S, j->j[1]);
     return [n,j,L,V];
    end
  ],

  dims := self >> [self.params[1], self.params[1]],

  half1 := self >> let(
      n  := self.params[1],
      l1 := self.params[3][1],
      v1 := self.params[4][1],
      DownSample(n,2,0) * Circulant(n,l1,v1).terminate() ),

  half2 := self >> let(
      n  := self.params[1],
      l2 := self.params[3][2],
      v2 := self.params[4][2],
      DownSample(n,2,0) * Circulant(n,l2,v2).terminate() ),

  terminate := self >> let(
      n := self.params[1],
      j := self.params[2],
      L := self.params[3],
      V := self.params[4],
      # DWT as filter bank stage + downsampling
      res := Cond(j = 1, I(n),
	          DirectSum(DWTper(n/2,j-1,L,V).terminate(), I(n/2))) *
             VStack(self.half1(), self.half2()),
      When(self.transposed, res.transpose(), res)
  ),

  LiftingScheme := self >> self.lifting(),

  lifting := meth(self)
               local n,j,LS,h,g,he,ho,ge,go;
               n := self.params[1];
               j := self.params[2];
               h := DownsampleTwo([self.params[3][1],self.params[4][1]]);
               g := DownsampleTwo([self.params[3][2],self.params[4][2]]);
               # Lifting scheme does not converge for wavelets longer than 9
               # (need to be fixed)
               if (Maximum(List(h, i-> Length(i[1])))>9 or
                   Maximum(List(g, i-> Length(i[1])))>9) then return [[]];fi;
               he := Poly(h[1][1],h[1][2]);
               ho := Poly(h[2][1],h[2][2]);
               ge := Poly(g[1][1],g[1][2]);
               go := Poly(g[2][1],g[2][2]);
               LS := LiftingScheme([[he,ho],[ge,go]]);
               return LS;
             end,

  isReal := True,
));

#F RuleFilter_DWT: (base case) DWT -> Mat,
#F   Computes filter by definition
#F
RulesFor(DWTper, rec(
    #F RuleFilt_Mallat_2:
    #F
    #F DWTper(n,j,[h,g])->DWTper(n/2,j-1,[h,g]),DWTper(n,1,[h,g])
    #F
    #F Mallat rule recursive (single stage DWT)
    #F The I(n/2) is inefficient because it copies the output
    #F However, this rule allows application of Lifting, POlyphase, etc.
    #F on DWTper(n,1,[h,g])
    #F
    DWTper_Mallat_2 := rec(
	info             := "DWTper(n,j,[h,g])->DWTper(n,j-1,[h,g])",
	forTransposition := false,
	isApplicable     := P -> P[1] > 2 and P[1] mod 2 =0 and P[2] > 1,

	allChildren := P -> [[ DWTper(P[1]/2,P[2]-1,P[3],P[4]), DWTper(P[1],1,P[3],P[4]) ]],

	rule := (P, C) -> DirectSum(C[1],I(P[1]/2))*C[2]
    ),

    #F DWTper_Mallat:
    #F
    #F DWTper(n,j,[h,g])->DWTper(n/2,j-1,[h,g]), DSCirculant
    #F
    DWTper_Mallat := rec(
        info             := "DWTper(n,j,[h,g])->DWTper(n/2,j-1,[h,g])",
        forTransposition := false,
        isApplicable     := P -> P[1]>2 and P[1] mod 2 = 0,

        allChildren := P -> let(
	    n        := P[1],
	    dcirc1 := DSCirculant(n, P[3][1], P[4][1], 2, 0),
	    dcirc2 := DSCirculant(n, P[3][2], P[4][2], 2, 0),
	    When(P[2]=1, [[ dcirc1, dcirc2 ]],
		         [[ dcirc1, dcirc2, DWTper(P[1]/2, P[2]-1, P[3], P[4]) ]])),

         rule := (P, C) -> When(P[2]=1, VStack(C[1], C[2]),
                                        VStack(C[3]*C[1], C[2]))
    ),

    #F DWTper_Polyphase:
    #F
    #F DWTper(n,1,[h,g])->[ [Circulant(he), Circulant(ho)],
    #F                      [Circulant(ge), Circulant(go)] ]
    #F
    #F Single-stage periodic DWT into a matrix of circulants of downsampled filters
    #F
    DWTper_Polyphase := rec(
	info             := "DWTper(n,1,[h,g]) -> [[Circ(he), Circ(ho)], [Circ(ge), Circ(go)]]",
	forTransposition := false,
	isApplicable     := P -> P[1]>2 and P[1] mod 2 =0 and P[2]=1,
	allChildren := function(P)
	    local n,h,g,he,ho,ge,go;
	    n := P[1];
	    h := DownsampleTwo([P[3][1], P[4][1]]);
	    g := DownsampleTwo([P[3][2], P[4][2]]);
	    he := Circulant(n/2, h[1][1], h[1][2]);
	    ho := Circulant(n/2, h[2][1], h[2][2]);
	    ge := Circulant(n/2, g[1][1], g[1][2]);
	    go := Circulant(n/2, g[2][1], g[2][2]);
	    return [[ he, ho, ge, go ]];
	end,
	rule := (P, C) -> BlockMat( [[ C[1], C[2] ],
		                     [ C[3], C[4] ]] ) * L(P[1],2)
    ),

    #F RuleDWTper_Lifting:
    #F
    DWTper_Lifting := rec(
        info             := "DWTper(n,1,[h,g]) -> Lifting steps",
        forTransposition := false,
        isApplicable     := ( L ) -> L[1]>2 and L[1] mod 2 =0 and L[2]=1,

        allChildren := function ( P )
            local n,j,LS,Lc,scheme,step,pol;
            n := P[1];
            LS := Copy(HashLookupWav(HashTableWavelets, [P[3],P[4]]));
            Lc := List(LS, scheme->
                     List(scheme{[2..Length(scheme)]}, step->
                        let(pol := FillZeros(ListPoly(step)),
                            Circulant(n/2,pol[1],pol[2]))));

            for i in [1..Length(LS)] do
             # attach the indicator of the type of the first liftings step
              Lc[i][1].lift :=LS[i][1];

             # fuse in the constants/shifts in the last lifting step
             #if (LS[i][1]=0 or LS[i][1]=-2) then LS[i][4]:=LS[i][4]*LS[i][3];
             #else  LS[i][4]:=LS[i][4]*LS[i][2];
             #fi;

             pol := FillZeros(ListPoly(LS[i][4]));
             Lc[i][3] := Circulant(n/2,pol[1],pol[2]);
            od;
            return Lc;
        end,

        rule := function ( P, C, Nonterms )
            local n, i, ind, b, l, M, first, last, ind0, ind1, lstep, last_ls;
            n := P[1];
            b := Nonterms[1].lift;
            l:=Length(C);

	    ind0 := fTensor(fBase(2,0), fId(Rows(C[3])));
	    ind1 := fTensor(fBase(2,1), fId(Rows(C[3])));
	    lstep := (f,b) -> When(b=0,
		LStep(Scat(ind0) * f * Gath(ind1)),
		LStep(Scat(ind1) * f * Gath(ind0)));

            M := When(b < 0,
		SUM(Scat(ind0)*C[2]*Gath(ind1), Scat(ind1)*C[1]*Gath(ind0)),
		SUM(Scat(ind0)*C[2]*Gath(ind0), Scat(ind1)*C[1]*Gath(ind1)));

	    b := (b+2) mod 2; # make b positive
	    for i in [1 .. l-2] do
	        M := M * lstep(C[i+2], b);
		b := (b+1) mod 2;
            od;

	    first := M.child(1);
	    M := Inplace(Compose(Drop(M.children(),1)));
	    return first * M * L(n,2);
       end
    )
));


# Copyright (c) 2018-2021, Carnegie Mellon University
# See LICENSE for details

Class(PrunedMDDFT, TaggedNonTerminal, rec(
    abbrevs := [
        (n,k,blk,pat) -> Checked(ForAll(n, IsPosIntSym), IsIntSym(k), IsPosIntSym(blk), ForAll(pat, IsList),
            [_unwrap(n), _unwrap(k), _unwrap(blk), pat, ]),
        ],
    dims      := self >> [Product(self.params[1]), self.params[3]*Product(self.params[4], i->Length(i))],
    isReal    := self >> false,
    normalizedArithCost := self >> let(n := self.params[1], IntDouble(5 * n * d_log(n) / d_log(2))),
    TType := TComplex,
    terminate := self >> let(nlist := self.params[1],
                                blk := self.params[3], pat_md := self.params[4],
                                scat3d := Tensor(List(Zip2(pat_md, nlist), j->let(pat := j[1], size := j[2],
                                    Tensor(Mat(List(pat, i->BasisVec(size/blk, i))).transpose(), I(blk)).terminate()))),
                                dft3d := MDDFT(nlist, self.params[2]),
                                t := dft3d * scat3d,
                                t.terminate()
                            )

));

Class(PrunedIMDDFT, TaggedNonTerminal, rec(
    abbrevs := [
        (n,k,blk,pat) -> Checked(ForAll(n, IsPosIntSym), IsIntSym(k), IsPosIntSym(blk), ForAll(pat, IsList),
            [_unwrap(n), _unwrap(k), _unwrap(blk), pat, ]),
        ],
    dims      := self >> [ self.params[3]*Product(self.params[4], i->Length(i)), Product(self.params[1]) ],
    isReal    := self >> false,
    normalizedArithCost := self >> let(n := self.params[1], IntDouble(5 * n * d_log(n) / d_log(2))),
    TType := TComplex,
    terminate := self >> let(nlist := self.params[1],
                                blk := self.params[3], pat_md := self.params[4],
                                gath3d := Tensor(List(Zip2(pat_md, nlist), j->let(pat := j[1], size := j[2],
                                    Tensor(Mat(List(pat, i->BasisVec(size/blk, i))), I(blk)).terminate()))),
                                dft3d := MDDFT(nlist, self.params[2]),
                                t := gath3d * dft3d,
                                t.terminate()
                            )

));

NewRulesFor(PrunedMDDFT, rec(
    PrunedMDDFT_Base := rec(
        info := "PrunedMDDFT -> PrunedDFT",
        applicable     := nt -> Length(nt.params[1])=1,
        children       := nt -> let(P := nt.params, tags := nt.getTags(), [[ PrunedDFT(P[1][1], P[2], P[3], P[4][1]).withTags(tags) ]]),
        apply          := (nt, C, Nonterms) -> C[1]
    ),
    PrunedMDDFT_RowCol := rec (
        info := "PrunedMDDFT_n -> PrunedMDDFT_n/d, PrunedMDDFT_d",
        applicable := nt -> Length(nt.params[1]) > 1 and not nt.hasTags(),

        children := nt -> let(
            dims := nt.params[1],
            len := Length(dims),
            pats := nt.params[4],
            List([1..len-1],
            i -> [ PrunedMDDFT(dims{[1..i]}, nt.params[2], nt.params[3], pats{[1..i]}),
                   PrunedMDDFT(dims{[i+1..len]}, nt.params[2], nt.params[3], pats{[i+1..len]}) ])),

        apply := (nt, C, Nonterms) -> let(
            n1 := Cols(Nonterms[1]),
            n2 := Rows(Nonterms[2]),
            Tensor(C[1], I(n2)) *
            Tensor(I(n1), C[2])
        )
    )
));

NewRulesFor(PrunedIMDDFT, rec(
    PrunedIMDDFT_Base := rec(
        info := "PrunedIMDDFT -> PrunedIDFT",
        applicable     := nt -> Length(nt.params[1])=1,
        children       := nt -> let(P := nt.params, tags := nt.getTags(), [[ PrunedIDFT(P[1][1], P[2], P[3], P[4][1]).withTags(tags) ]]),
        apply          := (nt, C, Nonterms) -> C[1]
    ),
    PrunedIMDDFT_RowCol := rec (
        info := "PrunedIMDDFT_n -> PrunedIMDDFT_n/d, PrunedIMDDFT_d",
        applicable := nt -> Length(nt.params[1]) > 1 and not nt.hasTags(),

        children := nt -> let(
            dims := nt.params[1],
            len := Length(dims),
            pats := nt.params[4],
            List([1..len-1],
            i -> [ PrunedIMDDFT(dims{[1..i]}, nt.params[2], nt.params[3], pats{[1..i]}),
                   PrunedIMDDFT(dims{[i+1..len]}, nt.params[2], nt.params[3], pats{[i+1..len]}) ])),

        apply := (nt, C, Nonterms) -> let(
            n1 := Cols(Nonterms[1]),
            n2 := Rows(Nonterms[2]),
            Tensor(C[1], I(n2)) *
            Tensor(I(n1), C[2])
        )
    )
));


# Copyright (c) 2018-2021, Carnegie Mellon University
# See LICENSE for details

Declare(VRC, VRCL, VRCR, VRCLR, VBlkInt);

##############################################################################
Class(VRC, RC, rec(
    toAMat := (self) >> AMatMat(RCMatCyc(MatSPL(self.child(1)))),
    new := meth(self, spl, v)
        local res;
        res := SPL(WithBases(self, rec(_children:=[spl], v:=v,
                                dimensions := spl.dimensions)));
        res.dimensions := res.dims();
        return res;
    end,
    print := (self, i, is) >> Print(self.__name__, "(\n", Blanks(i+is), self.child(1).print(i+is,is), ", ",
	#"\n", Blanks(i+is),
	self.v,
	#"\n", Blanks(i),
	")", self.printA()),

    unroll := self >> self,
    transpose := self >> VRC(self.child(1).conjTranspose(), self.v),
    vcost := self >> self.child(1).vcost(),

    from_rChildren := (self, rch) >> ObjId(self)(rch[1], self.v)
));

Class(VRCL, VRC, rec(
    toAMat := self >> AMatMat(MatSPL(Tensor(I(self.child(1).dims()[1]/self.v), L(2*self.v, 2)))) *
                      VRC(self.child(1), self.v).toAMat(),
    unroll := self >> self,
    transpose := self >> VRCR(self.child(1).conjTranspose(), self.v)
));

Class(VRCR, VRC, rec(
    toAMat := self >> VRC(self.child(1), self.v).toAMat() *
                      AMatMat(MatSPL(Tensor(I(self.child(1).dims()[2]/self.v), L(2*self.v, self.v)))),
    unroll := self >> self,
    transpose := self >> VRCL(self.child(1).conjTranspose(), self.v)
));

Class(VRCLR, VRC, rec(
    toAMat := self >> let(
    rows := Rows(self.child(1)), cols := Cols(self.child(1)), v := self.v,
    AMatMat(MatSPL(
        Tensor(I(rows/v), L(2*v, 2)) *
        RC(self.child(1)) *
        Tensor(I(cols/v), L(2*v, v))))
    ),
    unroll := self >> self,
    transpose := self >> VRCLR(self.child(1).conjTranspose(), self.v)
));

Class(vRC, RC, rec(
    print := (self, i, is) >> Print(self.name, "(", self.child(1).print(i+is,is), ")", self.printA()),
    vcost := self >> self.child(1).vcost()
));

Class(VBlkInt, BaseMat, SumsBase, rec(
    new := (self, spl, v) >> SPL(WithBases(self,
        rec(dimensions := spl.dims(), _children:=[spl], v := v))),
    #-----------------------------------------------------------------------
    dims := self >> self.dimensions,
    child := (self, i) >> self._children[i],
    rChildren := self >> [self._children[1], self.v],
    rSetChild := meth(self, n, what)
        if n=1 then self._children[1] := what;
        elif n=2 then self.v := what;
        else Error("<n> must be in [1..2]");
        fi;
    end,
    #-----------------------------------------------------------------------
    print := (self, i, is) >> Print(self.name, "(", self.child(1).print(i+is,is), ", ", self.v, ")", self.printA()),
    unroll := self >> self,
    transpose := self >> VBlkInt(self.child(1).transpose(), self.v),
    #-----------------------------------------------------------------------
    toAMat := self >> let(
        rows := Rows(self.child(1)), cols := Cols(self.child(1)), v := self.v,
        AMatMat(MatSPL(
            Tensor(I(rows/(2*v)), L(2*v, v)) *
            self.child(1) *
            Tensor(I(cols/(2*v)), L(2*v, 2))))
        )
));


##  Copyright (c) 2018-2021, Carnegie Mellon University
##  See LICENSE for details

Class(CConv, TaggedNonTerminal, rec(
    abbrevs := [
        (n,h) -> Checked(IsPosIntSym(n),
            [_unwrap(n), h, false]),
        (n,h,isFreqData) -> Checked(IsPosIntSym(n),
            [_unwrap(n), h, isFreqData])
        ],
    dims      := self >> [self.params[1], self.params[1]],
    terminate := self >> let(size := self.params[1],
        taps := When(self.params[7], MatSPL(DFT(self.params[1], -1)) * When(IsList(self.params[2]), self.params[2], self.params[2].list), self.params[2]),
        spiral.transforms.filtering.Circulant(size, taps, -size).terminate()),
    isReal    := self >> false,
    normalizedArithCost := self >> let(n := self.params[1], IntDouble(5 * n * d_log(n) / d_log(2))),
    TType := TComplex,
    hashAs := self >> ApplyFunc(ObjId(self), [self.params[1], fUnk(self.params[2].range(), self.params[2].domain())]::Drop(self.params, 2))
));

NewRulesFor(CConv, rec(
    CConv_DFT_IDFT := rec(
       forTransposition := false,
       applicable :=  (self, nt) >> not nt.hasTags(),
       children := nt -> [[ DFT(nt.params[1], 1),
                            DFT(nt.params[1], -1) ]],
       apply := (nt, C, cnt) -> Cond(ObjId(nt.params[2]) = var, # a variable is frequency domain data -> FData
                                    C[1] * Diag(FData(nt.params[2])) * C[2], # if data is provided it needs to be frequency domain
                                    ObjId(nt.params[2]) = Lambda,  # data is inside a larger array
                                    C[1] * Diag(nt.params[2]) * C[2],
                                    nt.params[7],   # if params[7] is true then data is frequency domain data
                                    C[1] * Diag(When(IsList(nt.params[2]), FList(TComplex, nt.params[2]), nt.params[2])) * C[2],
                                    let(cxfftdiag := 1/nt.params[1]*ComplexFFT(List(nt.params[2].tolist(), i->ComplexAny(_unwrap(i)))),
                                        C[1] * Diag(FData(cxfftdiag)) * C[2]))
    )
));

NewRulesFor(MDRConv, rec(
    MDPRConv_Base := rec(
        info := "MDRConv -> IMDPRDFT * RCDiag(sym) * MDPRDFT",
        applicable     := nt -> nt.params[3], # need symbol to be in frequency domain

        children       := nt -> [[ MDPRDFT(nt.params[1], -1).withTags(nt.getTags()),
                                   IMDPRDFT(nt.params[1], 1).withTags(nt.getTags())
                                 ]],

        # nonterminal, children, children non-terminals
        apply          := (nt, C, Nonterms) -> C[2] *
                            RCDiag(FDataOfs(nt.params[2], 2*Product(DropLast(nt.params[1], 1))* (Last(nt.params[1])/2+1), 0)) *
                            C[1]
    ),

    MDRConv_3D_2trip_zyx_freqdata := rec(
       forTransposition := false,
       applicable :=  (self, nt) >> not nt.hasTags() and Length(nt.params[1]) = 3 and nt.params[3],
       children := nt -> let(nlist := nt.params[1],
                            diag := nt.params[2],
                            nfreq := nlist[1]/2+1,
                            i := Ind(nfreq*nlist[2]),
                            hfunc := Cond(ObjId(diag) = Lambda,
                                let(j := Ind(nlist[3]),
                                    # Lambda(j, cxpack(diag.at(2*(j + i*nlist[3])), diag.at(2*(j + i*nlist[3])+1)))
                                    pos := i +j*nfreq*nlist[2],
                                    Lambda(j, cxpack(diag.at(2*pos), diag.at(2*pos+1)))
                                ),
                                IsVar(diag),
                                let(j := Ind(nlist[3]),
                                    pos := i +j*nfreq*nlist[2],
                                    Lambda(j, cxpack(nth(diag, 2*pos), nth(diag, 2*pos+1))).setRange(TComplex)
                                ),
                                ObjId(diag) = fUnk,
                                fUnk(TComplex, nlist[3]),
                                let(list := nt.params[2].list,  # here we assume FList(TReal, [...])
                                    clist := List([1..Length(list)/2], i->Cplx(list[2*i-1], list[2*i])),
                                    fc := FList(TComplex, clist),
                                    gf := fTensor(fBase(i), fId(nlist[3])),
                                    fCompose(fc, gf)
                                )
                            ),
                            [[ PRDFT(nlist[1], -1),  # stage 1: PRDFT z
                               DFT(nlist[2], -1),    # stage 2: DFT y
                               CConv(nlist[3], hfunc), # stage 3+4+5: complex conv in x
                               DFT(nlist[2], 1), # stage 6: iDFT in y
                               IPRDFT(nlist[1], 1),   # stage 7: iPRDFT in z
                               InfoNt(i)
                            ]]),

       apply := (nt, C, cnt) -> let(prdft1d := C[1],
                                    pdft1d := C[2],
                                    iopconv := C[3],
                                    ipdft1d := C[4],
                                    iprdft1d := C[5],
                                    i := cnt[6].params[1],
                                    nlist := nt.params[1],
                                    n1 := nlist[1],
                                    nfreq := nlist[1]/2+1,
                                    n2 := nlist[2],
                                    n3 := nlist[3],
                                    stage1 := L(2*nfreq*n3*n2, n3) * Tensor(I(n2), Tensor(L(2*nfreq, 2) * prdft1d, I(n3))) * Tensor(L(n2*n1, n2), I(n3)),
                                    stage2 := Tensor(I(n3), Tensor(RC(pdft1d), I(nfreq))),
                                    pp := Tensor(L(n3*n2*nfreq, n2*nfreq), I(2)) * Tensor(I(n3), L(2*nfreq*n2, nfreq)),
                                    ppi := Tensor(I(n3), L(2*nfreq*n2, 2*n2)) * Tensor(L(n3*n2*nfreq, n3), I(2)),
                                    stage543 := Grp(ppi * IDirSum(i, RC(iopconv)) * pp),
                                    stage76 := Tensor(L(n2*n1, n1), I(n3)) * Grp(Tensor((Tensor(I(n2), iprdft1d * L(2*nfreq, nfreq)) *
                                       Tensor(RC(ipdft1d), I(nfreq))), I(n3)) * L(2*nfreq*n3*n2, 2*nfreq*n2)),
                                    conv3dr := stage76 * stage543 * stage2 * stage1,
                                    conv3dr
                            )
    )
));

NewRulesFor(MDRConvR, rec(
    MDPRConvR_Base := rec(
        info := "MDRConv -> IMDPRDFT * Diag(sym) * MDPRDFT",
        applicable     := nt -> nt.params[3], # need symbol to be in frequency domain

        children       := nt -> [[ MDPRDFT(nt.params[1], -1).withTags(nt.getTags()),
                                   IMDPRDFT(nt.params[1], 1).withTags(nt.getTags())
                                 ]],

        # nonterminal, children, children non-terminals
        apply          := (nt, C, Nonterms) -> C[2] *
                            Diag(diagTensor(FDataOfs(nt.params[2], Product(DropLast(nt.params[1], 1))* (Last(nt.params[1])/2+1), 0), fConst(TReal, 2, 1))) *
                            C[1]
    )
));


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

# Radix N kernel for FFTE

buildScalarKernel_a := function(n, kk, conf, opts)
    local name, suffix, filesuffix, j, k, l, m, tmp1, tmp2, tmp3, i1, i2, gf, sf, gath, scat,
        gc, sc, dft, rts, rt, opcnts, dfts, dftc, i3, twt, twf, twl, tws, twc,
        cl, cc, c, cx, lp, mp;

    name := DFTnameStr(n, kk);
    suffix := "a";
    filesuffix := "c_";
#    suffix := "_j";
    Print("\n\n// == Generating \"", name, "\" ==================================================\n\n");

    # variables
    #t := var.fresh_t("t", TInt);
    j := var.fresh_t("j", TInt);
#    k := var.fresh_t("k", TInt);
    k := V(0);
    l := var.fresh_t("l", TInt);
 #   m := var.fresh_t("m", TInt);
   m := V(1);
    lp := var.fresh_t("lp", TPtr(TInt));
    mp := var.fresh_t("mp", TPtr(TInt));

    # temp arrays
    tmp1 := var.fresh_t("R", TArray(TReal, 2*n));
    tmp2 := var.fresh_t("S", TArray(TReal, 2*n));
    tmp3 := var.fresh_t("T", TArray(TReal, 2*n));

    # gather and scatter
    i1 := var.fresh_t("i", n);
    i2 := var.fresh_t("i", n);
    gf := fTensor(Lambda(i1, k + j*m + i1*l*m), fId(2));
    sf := fTensor(Lambda(i2, k+n*j*m + i2*m), fId(2));
    gath := Gath(gf);
    scat := Scat(sf);

    # generate gather and scatter code
    gc := BlockUnroll(unroll_cmd(opts.codegen(gath, tmp1, X, opts)), opts);
    sc := BlockUnroll(unroll_cmd(opts.codegen(scat, Y, tmp3, opts)), opts);

    # generate DFT kernel
    dft := RC(DFT(n, kk));
    rts := AllRuleTrees(dft, opts);
    opcnts := List(rts, r -> [ Length(Collect(CodeRuleTree(r, opts), @(1, [add, sub, mul], e->e.t=TReal))), r]);
    rt := Minimum(opcnts)[2];
    dfts := SumsRuleTree(rt, opts);
    dftc := BlockUnroll(opts.codegen(dfts, tmp2, tmp1, opts), opts);

    # twiddles as lookup table
    i3 := var.fresh_t("i", 2*n);
    twt := var.fresh_t("TW", TPtr(TReal));
    twf := Lambda(i3, cond(eq(i3, 0), 1, eq(i3, 1), 0, nth(twt, 2*((n-1)*j) + 2 * idiv(i3, 2) + (imod(i3, 2) - 2))));

    # debug twiddles
    twl := Map(twf.tolist(), RulesStrengthReduce);
    DoForAll([0..Length(twl)-1], _i->Unparse(assign(nth(Y, _i), twl[_i+1]), CUnparser, 0, 1));

    tws := RCDiag(twf);
    twc :=BlockUnroll(unroll_cmd(opts.codegen(tws, tmp3, tmp2, opts)), opts);

    # stitch code fragments together
    cl := func(TVoid, "transform", [Y, X, twt, j, k, l, m],
            decl([tmp1, tmp2, tmp3], chain(gc, dftc, twc, sc)));
    cc := Compile(cl, opts);

    # fixup to push decls inside (?)
    c := func(TVoid, "transform", [Y, X, twt, j, k, lp],
            decl(cc.vars::[l],
                chain(
                    assign(l, deref(lp)),
                    cc.cmd.cmds[1].cmd
                )
            )
         );

    # print Radix N FFTE kernel as function
#    PrintCode(name, c, opts);
#    PrintTo(name::".c", PrintCode(name, c, opts));

    # function with j and k loop in the function call
    cl := func(TVoid, "transform", [Y, X, twt, lp],
        decl(c.cmd.vars::c.free(),
            chain(
                assign(l, deref(lp)),
                loopn(j, l,
                    c.cmd.cmd)
            )
        )
    );

    # print Radix N FFTE kernel as function
    PrintCode(opts.FortranIze(name::suffix), cl, opts);
    PrintTo(name::filesuffix::suffix::".c", PrintCode(opts.FortranIze(name::suffix), cl, opts));
end;


# Copyright (c) 2018-2021, Carnegie Mellon University
# See LICENSE for details

Class(PkRDFT12_Base, PRDFT_Base, rec(
    dims := self >> [self.params[1], self.params[1]],
    terminate := self >> let(N := self.params[1], k := self.params[2],
	rr := When(self.transposed, Cols(self), Rows(self)),
	mat := Cond(IsEvenInt(N),
            Mat(Concatenation(
                    [List([0..N-1], c-> When(IsEvenInt(c), 1,1))],
                    [List([0..N-1], c-> When(IsEvenInt(c), 1,-1))],
                    List([2..rr-1], r -> When(r mod 2 = 0,
                        List([0..N-1], c -> self.projRe(self.omega(N,k,Int(r/2),c))),
                        List([0..N-1], c -> self.projIm(self.omega(N,k,Int(r/2),c))))))),
            Mat(Concatenation(
                    [List([0..N-1], c -> 1)],
                    List([2..rr], r -> When(r mod 2 = 0,
                        List([0..N-1], c -> self.projRe(self.omega(N,k,Int(r/2),c))),
                        List([0..N-1], c -> self.projIm(self.omega(N,k,Int(r/2),c)))))))),
        When(self.transposed, mat.transpose(), mat)),
));

Class(PkRDFT1, PkRDFT12_Base, rec(
    abbrevs := [ (n) -> Checked(IsPosInt(n),  [n, 1]),
                 (n,k) -> Checked(IsPosIntSym(n), IsIntSym(k),
                                  IsSymbolic(n) or IsSymbolic(k) or Gcd(n,k)=1, [n, k mod n]) ],
    omega := (N,k,r,c) -> E(N)^(k*r*c)
));
Class(PkRDFT2, PkRDFT12_Base, rec(
    abbrevs := [ (n) -> Checked(IsPosIntSym(n),  [n, 1]),
                 (n,k) -> Checked(IsPosIntSym(n), IsIntSym(k),
                                  IsSymbolic(n) or IsSymbolic(k) or Gcd(n,k)=1, [n, k mod (2*n)]) ],
    omega := (N,k,r,c) -> E(2*N)^(k*r*(2*c+1))
));

Class(PkDHT1, PkRDFT1, rec(
    terminate := self >> let(n := self.params[1], k := self.params[2], i := When(IsEvenInt(n), 2, 1),
        DirectSum(I(i), Tensor(I(Int((n-1)/2)), F(2))) *
        PkRDFT1(n, k).terminate()
    )
));

Class(PkDHT2, PkRDFT2, rec(
    terminate := self >> let(n := self.params[1], k := self.params[2], i := When(IsEvenInt(n), 2, 1),
        DirectSum(I(i), Tensor(I(Int((n-1)/2)), Diag(1,-1)*F(2))) *
        PkRDFT2(n, k).terminate()
    )
));

Class(URealDFT_Base, NonTerminal, rec(
    abbrevs := [ (n) -> Checked(IsPosInt(n),  [n, 1]),
                 (n,k) -> Checked(IsPosInt(n), IsInt(k), Gcd(n,k)=1, [n, k mod n]) ],
    terminate := self >> let(N := self.params[1], k := self.params[2],
	rr := When(self.transposed, Cols(self), Rows(self)),
	Mat(Concatenation(
	    [List([0..N-1], c-> When(IsEvenInt(c), 1,0))],
	    [List([0..N-1], c-> When(IsOddInt(c), 1,0))],
	    List([2..rr-1], r -> When(r mod 2 = 0,
		 List([0..N-1], c -> self.projRe(self.omega(N,k,Int(r/2),c))),
		 List([0..N-1], c -> self.projIm(self.omega(N,k,Int(r/2),c)))))))),
    isReal := True,
    SmallRandom := () -> Random([2..16]),
    LargeRandom := () -> 2 ^ Random([6..15])
));

Class(URDFT_Base, URealDFT_Base, rec(
    projRe := Re,
    projIm := Im,
    hashAs := self >> self
));

Class(URDFT, URDFT_Base, rec(
    dims := self >> let(n:=self.params[1], [ 2*(Int((n+1)/2)), n ]),
    omega := (N,k,r,c) -> E(N)^(k*r*c),
));

URDFT1:=URDFT;

# Regularized Rules
# R1 -> (R1, C1) (R1')
# R2 -> (R2, C2) (R1')
PRF12_CTReg_Children := (N,k,PRFt,DFTt,PRF1prime, maxRadix) -> Map2(
    Filtered(DivisorPairs(N),d->d[1] <= maxRadix/2 and d[2]<>2),
    (m,n) -> When(IsEvenInt(n),
	[ PRFt(2*m,k), DFTt(m,k), PRF1prime(n,k) ],
	[ PRFt(m,k),   DFTt(m,k), PRF1prime(n,k) ] )
);

PRF12_CTReg_Rule := (N,k,C,Conj,Tw) -> let(mm:=Cols(C[1]), m:=When(IsEvenInt(N), mm/2, mm),
    n:=Cols(C[3]), Nf:=Int(N/2), Nc:=Int((N+1)/2),
    nf:=Int(n/2), nc:=Int((n+1)/2), mf:=Int(m/2), mc:=Int((m+1)/2), j:=Ind(nc-1),

    SUM(
	BB(RC(Scat(H(Nc,m,0,n/2))) * C[1] * L(mm,2) * RC(Gath(H(nc*m, m, 0, nc)))),

	When(nc=1, [],
	ISum(j, BB(
	     RC(Scat(BH(Nc,N,m,j+1,n))) *
	     Conj * RC(C[2]) * Tw(j) *
	     RC(Gath(H(nc*m, m, j+1, nc))))))
    ) *
    Tensor(I(m), C[3]) * L(N,m)
);

PRF12_CTReg2_Rule := (N,k,C,Conj,Tw) -> let(mm:=Cols(C[1]), m:=When(IsEvenInt(N), mm/2, mm),
    n:=Cols(C[3]), Nf:=Int(N/2), Nc:=Int((N+1)/2),
    nf:=Int(n/2), nc:=Int((n+1)/2), mf:=Int(m/2), mc:=Int((m+1)/2), j:=Ind(nc-1),

    SUM(
	RC(Scat(H(Nc,m,0,n/2))) * C[1] * RC(Gath(H(nc*m, m, 0, 1))),

	When(nc=1, [],
	ISum(j,
	     RC(Scat(BH(Nc,N,m,j+1,n))) *
	     Conj * RC(C[2]) * Tw(j) * L(2*m, m) *
	     RC(Gath(H(nc*m, m, m*(j+1), 1)))))
    ) *
    Tensor(C[3], I(m))
);

PRF12_CTReg3_Rule := (N,k,C,Conj,Tw) -> let(mm:=Cols(C[1]), m:=When(IsEvenInt(N), mm/2, mm),
    n:=Cols(C[3]), Nf:=Int(N/2), Nc:=Int((N+1)/2),
    nf:=Int(n/2), nc:=Int((n+1)/2), mf:=Int(m/2), mc:=Int((m+1)/2), j:=Ind(nc-1),

    SUM(
	RC(Scat(H(Nc,m,0,n/2))) * C[1] * L(2*m, 2) * Gath(H(N, 2*m, 0, nc)),

	When(nc=1, [],
	ISum(j,
	     RC(Scat(BH(Nc,N,m,j+1,n))) *
	     Conj * RC(C[2]) * Tw(j) *
	     Gath(H(N, 2*m, j+1, nc))))
    ) *
    Tensor(I(m), L(n,2)*C[3]) * L(N,m)
);

PRF12_CTReg4_Rule := (N,k,C,Conj,Tw) -> let(mm:=Cols(C[1]), m:=When(IsEvenInt(N), mm/2, mm),
    n:=Cols(C[3]), Nf:=Int(N/2), Nc:=Int((N+1)/2),
    nf:=Int(n/2), nc:=Int((n+1)/2), mf:=Int(m/2), mc:=Int((m+1)/2), j:=Ind(nc-1),

    RC(Tensor(I(m/2), DirectSum(I(n/2+1), J(n/2-1)))) *
    RC(L(N/2, m)) *
    DirectSum(
        C[1] * L(2*m, 2),
	IterDirectSum(j, RC(M(m,m/2)) * Conj * RC(C[2]) * Tw(j))
    ) *
    L(N, nc) *
    Tensor(I(m), L(n,2)*C[3]) * L(N,m)
);

PRF12_CTReg5_Rule := (N,k,C,Conj,Tw) -> let(mm:=Cols(C[1]), m:=When(IsEvenInt(N), mm/2, mm),
    n:=Cols(C[3]), Nf:=Int(N/2), Nc:=Int((N+1)/2),
    nf:=Int(n/2), nc:=Int((n+1)/2), mf:=Int(m/2), mc:=Int((m+1)/2), j:=Ind(nc-1),

    RC(Tensor(I(m/2), DirectSum(I(n/2+1), J(n/2-1)))) *
    RC(L(N/2, m)) *
    DirectSum(
        C[1],
	IterDirectSum(j, RC(M(m,m/2)) * Conj * RC(C[2]) * Tw(j) * L(2*m, m))
    ) *
    Tensor(C[3], I(m))
);

unrc := m -> let(r := Dimensions(m)[1], c := Dimensions(m)[2],
    MatSPL(Gath(H(r,r/2,0,2))) * m * MatSPL(Scat(H(c,c/2,0,2))));

RulesFor(URDFT1, rec(
    URDFT1_Base1 := BaseRule(URDFT1, [1, @]),
    URDFT1_Base2 := BaseRule(URDFT1, [2, @]),
    URDFT1_Base4 := BaseRule(URDFT1, [4, @]),

    URDFT1_CT := rec(
        maxRadix := 32,
	isApplicable := P -> not IsPrime(P[1]) and not (IsEvenInt(P[1]) and IsPrime(P[1]/2)),
	allChildren  := (self, P) >> PRF12_CTReg_Children(P[1], P[2], URDFT1, DFT1, URDFT1, self.maxRadix),
	rule := (P,C) -> let(N:=P[1], k:=P[2], m:=When(IsEvenInt(N), Cols(C[1])/2, Cols(C[1])),
	    PRF12_CTReg_Rule(N, k, C, Diag(BHD(m,1,-1)),
                j -> RC(DirectSum(I(1), Diag(fPrecompute(fCompose(Twid(N,m,k,0,0,j+1), fAdd(m, m-1, 1))))))))),

    # slightly different variant of same rule,
    URDFT1_CT2 := rec(
	isApplicable := P -> not IsPrime(P[1]) and not (IsEvenInt(P[1]) and IsPrime(P[1]/2)),
	allChildren  := P -> PRF12_CTReg_Children(P[1], P[2], URDFT1, DFT1, URDFT1),
	rule := (P,C) -> let(N:=P[1], k:=P[2], m:=When(IsEvenInt(N), Cols(C[1])/2, Cols(C[1])),
	    PRF12_CTReg2_Rule(N, k, C, Diag(BHD(m,1,-1)), j->RC(Diag(fPrecompute(Twid(N,m,k,0,0,j+1))))))),

    URDFT1_CT3 := rec(
	isApplicable := P -> not IsPrime(P[1]) and not (IsEvenInt(P[1]) and IsPrime(P[1]/2)),
	allChildren  := P -> PRF12_CTReg_Children(P[1], P[2], URDFT1, DFT1, URDFT1),
	rule := (P,C) -> let(N:=P[1], k:=P[2], m:=When(IsEvenInt(N), Cols(C[1])/2, Cols(C[1])),
	    PRF12_CTReg3_Rule(N, k, C, Diag(BHD(m,1,-1)), j->RC(Diag(fPrecompute(Twid(N,m,k,0,0,j+1))))))),

    URDFT1_CT4 := rec(
	isApplicable := P -> not IsPrime(P[1]) and not (IsEvenInt(P[1]) and IsPrime(P[1]/2)),
	allChildren  := P -> PRF12_CTReg_Children(P[1], P[2], URDFT1, DFT1, URDFT1),
	rule := (P,C) -> let(N:=P[1], k:=P[2], m:=When(IsEvenInt(N), Cols(C[1])/2, Cols(C[1])),
	    PRF12_CTReg4_Rule(N, k, C, Diag(BHD(m,1,-1)), j->RC(Diag(fPrecompute(Twid(N,m,k,0,0,j+1))))))),

    URDFT1_CT5 := rec(
	isApplicable := P -> not IsPrime(P[1]) and not (IsEvenInt(P[1]) and IsPrime(P[1]/2)),
	allChildren  := P -> PRF12_CTReg_Children(P[1], P[2], URDFT1, DFT1, URDFT1),
	rule := (P,C) -> let(N:=P[1], k:=P[2], m:=When(IsEvenInt(N), Cols(C[1])/2, Cols(C[1])),
	    PRF12_CTReg5_Rule(N, k, C, Diag(BHD(m,1,-1)), j->RC(Diag(fPrecompute(Twid(N,m,k,0,0,j+1))))))),

));


Random(SymmetricGroup(20));

(1,4,8,2)(3,12)(5,14,10,18,17,7,16)(9,13)(11,15,20,19)


# Copyright (c) 2018-2020, Carnegie Mellon University
# See LICENSE for details
#
# Contains the CNOT and SWAP non-terminals and rewrite rules
#

##
#F qSWAPT( <qi>, <qj>, <n>,, <arch> ) Object
##
#F Awaps qi and qj in a system of n qubits, with architecture arch
#F Definition: (2^n x 2^n)-matrix
#F that swaps qubit qi and qubit qj, with the identity operation applied to all others
Class(qSWAPT, TaggedNonTerminal, rec(
  abbrevs   := [ (qi, qj, n, arch) -> Checked(IsPosInt(n), [qi, qj, n, arch]) ],
  dims      := self >> let(size := 2^self.params[3], [size, size]),
  terminate := self >> GenSwapMat(self.params[1], self.params[2], self.params[3]),
  isReal    := self >> true,
  rChildren := self >> self.params,
  from_rChildren := (self, rch) >> self.__bases__[1](rch[1], rch[2], rch[3], rch[4]),
  SmallRandom := () -> Random([2..5]),
  LargeRandom := () -> Random([6..15]),
  normalizedArithCost := self >> Error("ArithCost not implemented"),
  TType := T_Real(64)
));

##
#F CnotTerm( <i>, <j>, <n> )
##
## .terminate() function for the qCNOT Non-terminal. Expands qCNOT non-terminal into a 2^n by 2^n matrix
CnotTerm := function (i, j, n)
    return When(i < j, Tensor(Tensor(I(2^(i)), GenCnotMat(j, 0)), I(2^(n-j))), Tensor(Tensor(I(2^(j)), GenCnotMat(i, 1)), I(2^(n-i)))); # create the intended cnot matrix
end;

##
#F CnotSPL( <i>, <j>, <n> )
##
## Used for the qCNOT_Base breakdown rule. Represents a qCNOT Non-terminal as a tensor of CNOT and I SPL objects
CnotSPL := function (i, j, n)
    return When(i < j, Tensor(Tensor(I(2^(i)), CNOT(j-i, 0)), I(2^(n-1-j))), Tensor(Tensor(I(2^(j)), CNOT(i-j, 1)), I(2^(n-1-i)))); # create the intended cnot matrix
end;

##
#F qCNOT( <qj>, <dir>, <arch> ) Object
##
#F CNOT Non-terminal
#F Definition: (2^n x 2^n)-matrix  that applies a CNOT from qubit 0 to j
Class(qCNOT, TaggedNonTerminal, rec(
  abbrevs   := [ (qj, dir, arch) -> Checked([qj, dir, arch]) ],
  dims      := self >> let(size := 2^(self.params[1]+1), [size, size]),
  terminate := self >> GenCnotMat(self.params[1], self.params[2]),
  isReal    := self >> true,
  groups    := self >> [[2]],
  recursive_def := (self, arch) >> self.__bases__[1](self.params[1], self.params[2], arch),
  rChildren := self >> self.params,
  from_rChildren := (self, rch) >> self.__bases__[1](rch[1], rch[2], rch[3]),
  connected := self >> true,
  SmallRandom := () -> Random([2..5]),
  LargeRandom := () -> Random([6..15]),
  normalizedArithCost := self >> Error("ArithCost not implemented"),
  TType := T_Real(64)
));

##
#F qCNOT Breakdown Rules
##
NewRulesFor(qCNOT, rec(

    #F qCNOT_Base: qCNOT(_) =  CNOT() SPL object
    #F Directly represent as an implementable gate, if a proper edge exists
    qCNOT_Base := rec(
        info             := "qCNOT_(_) -> CNOT(_)",
        forTransposition := false,
        applicable       := (self, nt) >> (HasEdge(0, nt.params[1], nt.params[3]) = 1),
        apply            := (nt, c, cnt) -> CNOT(nt.params[1], nt.params[2]),
    )

));

##
#F CnotSPL( <i>, <j>, <n> )
##
## Used for the qSWAP_Base breakdown rule. Represents a qCNOT Non-terminal as a tensor of CNOT and I SPL objects
CnotSPL := function (i, j, n)
    return When(i < j, Tensor(Tensor(I(2^(i)), CNOT(j-i, 0)), I(2^(n-1-j))), Tensor(Tensor(I(2^(j)), CNOT(i-j, 1)), I(2^(n-1-i)))); # create the intended cnot matrix
end;

##
#F SwapGenChildren( <start>, <ending>, <n>, <arch> )
##
## decompose a qSWAPT transform into smaller qSWAPT transforms
SwapGenChildren := function (start, ending, n, arch)
    local move, children;
    move := Best_Move(start, ending, arch);
    children := [];
    Add(children, [qSWAPT(start, move, n, arch) * qSWAPT(move, ending, n, arch) * qSWAPT(start, move, n, arch)]);
    return children;
end;

##
#F qSWAPT Breakdown Rules
##
NewRulesFor(qSWAPT, rec(

    #F qSWAPT_Base: qSWAPT(_) =  qCNOT() SPL objects
    #F SWAP to CNOT conversion, only if an edge exists
    #F represent a swap as a series of 3 CNOTs with the middle being an alternate direction
    qSWAPT_Base := rec(
        info             := "qSWAPT() -> CNOT * CNOT * CNOT ",
        forTransposition := false,
        applicable       := (self, nt) >> ( (HasEdge(nt.params[1], nt.params[2], nt.params[4]) = 1) and (nt.params[1] <> nt.params[2])),
        children         := nt -> List( [ [ (CnotSPL(nt.params[1], nt.params[2], nt.params[3]))*(CnotSPL(nt.params[2], nt.params[1], nt.params[3]))*(CnotSPL(nt.params[1], nt.params[2], nt.params[3])) ] , [ (CnotSPL(nt.params[2], nt.params[1], nt.params[3]))*(CnotSPL(nt.params[1], nt.params[2], nt.params[3]))*(CnotSPL(nt.params[2], nt.params[1], nt.params[3])) ]  ] ),
        apply            := (nt, c, cnt) -> c[1],
    ),

    #F qSWAPT_ID: qSWAPT(_) =  I() SPL object
    #F SWAP to Identity conversion if the swap is trivial
    qSWAPT_Id := rec(
        info             := "qSWAPT() -> Identity ",
        forTransposition := false,
        applicable       := (self, nt) >> (nt.params[1] = nt.params[2]),
        apply            := (nt, c, cnt) -> I(2^(nt.params[3])),
    ),

    #F qSWAPT_Rec: qSWAPT(_) =   qSWAPT(_) *  qSWAPT(_)
    #F Break down an unimplementable qSWAP into an implementable swap and a swap that is 1 step closer to being implementable
    #F TODO, make this a bit more intelligent, right now SwapGenChildren just does a random walk
    qSWAPT_Rec := rec(
        info             := "qSWAPT() -> qSWAPT() * qSWAPT()",
        forTransposition := false,
        applicable       := (self, nt) >> ((nt.params[1] <> nt.params[2]) and (HasEdge(nt.params[1], nt.params[2], nt.params[4]) = 0)),
        children         := nt -> SwapGenChildren(nt.params[1], nt.params[2], nt.params[3], nt.params[4]),
        apply            := (nt, c, cnt) -> c[1],
    )

));

##
#F ShiftMat( <swap1>, <swap2>, <arch>, <n> )
##
## generates a martix of SWAP operations that swap the qubit groups swap1 and swap2 in parallel
## swap1 is the target position, and swap2 are original positions
ShiftMat := function (swap1, swap2, arch, n)
    local idx, format, backmat, targets, t, positions, e, sw1, sw2, s, i, test, already_swapped;
    idx := 1;
    format := I(2^(n));
    backmat := I(2^(n));
    positions := [];
    targets := [];
    for s in swap1 do
        Add(positions, s);
    od;
    for t in swap2 do
        Add(targets, t);
    od;
    for s in swap1 do
        if ((targets[idx] <> positions[idx])) then # just save the extra trouble, if the swap is trivial
            format := format * qSWAPT(positions[idx], targets[idx], n ,arch);
            backmat := qSWAPT(positions[idx], targets[idx], n , arch) * backmat;
            sw1 := targets[idx];
            sw2 := positions[idx];
            i := 1;
            for e in positions do
                if e = sw1 then
                    positions[i] := sw2;
                fi;
                if e = sw2 then
                    positions[i] := sw1;
                fi;
                i := i + 1;
            od;
        fi;
        idx := idx + 1;
    od;
    return [format, backmat];
end;


#
# cls 17: A_2
#
handle17char3:=function()
    local tmp1,tmp2,o,info,rep,cent,uu;
    o:=AllClasses(orbs)[17];
    info:=infos[17];

    rep:=Representative(o);
    #pr[15]=[0,0,1,1,1,0]
    #pr[13]=[0,1,1,1,0,0]
    #pr[26]=[1,1,1,2,1,0]
    tmp1:=ApplyRootsReflections(rep,[15,13,26]);
    uu:=Unipotent(chevalleyAdj(rep),[[3,1]]);
    tmp1:=Conj(tmp1,uu);
    tmp1:=ConjugateByTori(tmp1,[3],[-1]);

    cent:=FromPositiveBorel(o,info[2]);
    tmp2:=ApplyRootsReflections(cent,[15,13,26]);
    uu:=Unipotent(chevalleyAdj(cent),[[3,1]]);
    tmp2:=Conj(tmp2,uu);
    tmp2:=ConjugateByTori(tmp2,[3],[-1]);

    return [tmp1,tmp2];
end;

#
# cls 10: D_4(a_1)
#
handle10char3:=function()
    local tmp1,tmp2,tmp3,tmp4,o,info,rep,cent,uu;
    o:=AllClasses(orbs)[10];
    info:=infos[10];

    rep:=Representative(o);
    #pr[4] =[0,0,0,1,0,0]
    #pr[32]=[1,1,2,2,1,1]
    #pr[33]=[1,1,1,2,2,1]
    tmp1:=ApplyRootsReflections(rep,[4,32,33]);
    uu:=Unipotent(chevalleyAdj(rep),[[3,-1],[5,1]]);
    tmp1:=Conj(tmp1,uu);
    tmp1:=ConjugateByTori(tmp1,[4,1,2,6],[-1,-1,-1,-1]);

    #pr[20]=[0,1,0,1,1,1]
    #pr[21]=[0,0,1,1,1,1]
    tmp3:=ApplyRootsReflections(rep,[20,21]);
    uu:=Unipotent(chevalleyAdj(rep),[[3,1],[4,1],[5,-1],[9,1],[10,-1]]);
    tmp3:=Conj(tmp3,uu);
    tmp3:=ConjugateByTori(tmp3,[2,4],[-1,-1,-1,-1]);

    cent:=FromPositiveBorel(o,info[2]);
    tmp2:=ApplyRootsReflections(cent,[4,32,33]);
    uu:=Unipotent(chevalleyAdj(cent),[[3,-1],[5,1]]);
    tmp2:=Conj(tmp2,uu);
    tmp2:=ConjugateByTori(tmp2,[4,1,2,6],[-1,-1,-1,-1]);

    tmp4:=ApplyRootsReflections(cent,[20,21]);
    uu:=Unipotent(chevalleyAdj(cent),[[3,1],[4,1],[5,-1],[9,1],[10,-1]]);
    tmp4:=Conj(tmp4,uu);
    tmp4:=ConjugateByTori(tmp4,[2,4],[-1,-1,-1,-1]);

    return [tmp1,tmp3,tmp2,tmp4];
end;

#
# cls 4: E_6(a_3) [13,1,15,6,14,4]
#
handle4char3:=function()
    local tmp1,tmp2,o,info,rep,cent;
    o:=AllClasses(orbs)[4];
    info:=infos[4];

    rep:=Representative(o);
    tmp1:=ConjugateByTorus(rep,4,-1);# h_1 --> h_4

    cent:=FromPositiveBorel(o,info[2]);
    tmp2:=ConjugateByTorus(cent,4,-1);# h_1 --> h_4

    return [tmp1,tmp2];
end;