########################################################################
#
# walrus: Computational Methods for Finitely Generated Monoids and Groups
#
# WARNING
#
########################################################################
#
# TODO (documentation)
#  - Examples
#  - notes on the implementation (design decisions etc)
#
# TODO (technical)
#  - MakeIsReducedDiagram an operation
#  - Sort out families of elements etc
#  - what to do about the __ID hack?
#  - What to do about float vs rational?
#  - provide a way to label generators
#  - Introduce an InfoLevel and log things with info levels, remove Print
#    statements
#  - Put relators of different presentations into different families
#  - Check whether some sub-functions could be cleaned out from functions
#    and would become more generally useful
#  - Better indexing of locations on relator/places
#  - Better datastructure for storing one step reachables
#    (basically a hashmap from orb I think) plus wrapper functions
#  - PlaceQuadruples should be an object or a record
#  - Add proper error messages for "This shouldn't happen" with a pointer
#    towards the github issue tracker
#  - Make a reasonably standard format (and exporter/importer) to exchange
#    pregroup presentations so we can move them between GAP/other
#    implementations for cross-checking

#
# TODO (mathematical/functional)
#  - Write tests
#  - Interleaving
#  - Preparing the presentation (User choosing Pregroup/removing generators, relators)
#  - check LocationBlobGraph + distances
#  - Make the distance computation in LBG more efficient?
#  - Check OneStepReachables
#  - Check RSymTest
#
########################################################################
#
# Some notes on the implementation
#
# - Stored curvature is always "negative curvature", so in most cases a
#   positive value.
# - Curvature values are stored as rationals at first, later converted to
#   floats. This might not be the best way to do this (we might want to
#   always use rationals or always use floats)
#

# Alternative to LocationBlobGraph, only has pairs, coloured Green for location pair
# and red for intermult pair
# a bit hacky though
InstallMethod(VertexGraph, "for a pregroup presentation",
              [IsPregroupPresentation and IsPregroupPresentationRep],
function(pres)
    local mat, v, vd, vg, e, loc, loc2, pg, p, ploc, ploc2, imp, i, backmap, len, li, labels;

    pg := Pregroup(pres);

    li := LocationIndex(pres);

    # Green vertices [[a, b], 0] correspond to locations
    v := List(Keys(li), l -> [l, 0]);
    # Red vertices correspond to intermult pairs
    Append(v, List(IntermultPairs(pg), p -> [p, 1]));

    e := function(a,b)
        if (a[2] = 0) and (b[2] = 0) then              # both vertices are green
            if PregroupInverse(a[1][2]) = b[1][1] then # There are locations R(i,a,b) and R'(j,b^-1,c)
                ploc := li[a[1]];
                ploc2 := li[b[1]];
                for loc in ploc do
                    for loc2 in ploc2 do
                        if CheckReducedDiagram(loc, loc2) then
                            return 1;
                        fi;
                    od;
                od;
                return infinity;
            fi;
        elif (a[2] = 0) and (b[2] = 1) then            # a is green, b is red
            if PregroupInverse(a[1][2]) = b[1][1] then # There is location R(i,a,b)
                return 1;
            fi;
        elif (a[2] = 1) and (b[2] = 0) then            # a is red, b is green
            if PregroupInverse(a[1][2]) = b[1][1] then #
                return 0;
            fi;
        fi;
        return infinity;
    end;

    backmap := HashMap();
    for i in [1..Length(v)] do
        backmap[ [__ID(v[i][1][1]), __ID(v[i][1][2]), v[i][2] ] ] := i;
    od;

    vg := Digraph(v, {i,j} -> e(i,j) <> infinity);
    SetDigraphVertexLabels(vg, v);

    mat := List(DigraphVertices(vg), i -> List(DigraphVertices(vg), j -> e(v[i], v[j]) ) );
    vg!.mat := mat;
    vg!.backmap := backmap;

    return vg;
end);

InstallMethod(VertexGraphDistances, "for a pregroup presentation",
              [IsPregroupPresentation and IsPregroupPresentationRep],
function(pres)
    local vg, wt, f, vertices, n, mat, i, j, k, a, b, t, out;

    vg := VertexGraph(pres);
    vertices := DigraphVertices(vg);
    mat := vg!.mat;

#    SC_FLOYD_WARSHALL(mat);

    for k in vertices do
        for i in vertices do
            for j in vertices do
                t := mat[i, k] + mat[k, j];
                if t < mat[i,j] then
                    mat[i,j] := t;
                fi;
            od;
        od;
    od;
    # Can there be more than one such entry?
    return mat;
end);

InstallMethod(VertexTriples, "for a pregroup presentation",
            [IsPregroupPresentation and IsPregroupPresentationRep],
function(pres)
    local v, v1, v2, v1l, v2l, vl, vg, lv, vgd, dist, vtl;

    vg := VertexGraph(pres);
    vgd := VertexGraphDistances(pres);
    vtl := HashMap(16384);

    for v in DigraphVertices(vg) do

        vl := DigraphVertexLabel(vg, v);
        # Only green vertices
        if (vl[2] = 0) then
          for v1 in InNeighboursOfVertex(vg, v) do
              v1l := DigraphVertexLabel(vg, v1);
              for v2 in OutNeighboursOfVertex(vg, v) do
                  v2l := DigraphVertexLabel(vg, v2);
                  dist := vgd[v2][v1];
                  if (v1l[2] = 0) and (v2l[2] = 0) then
                      if dist = 1 then
                          vtl[ [v, v1, v2 ] ] := 1/6;
                      elif dist = 2 then
                          vtl[ [ v, v1, v2 ] ] := 1/4;
                      elif dist = 3 then
                          vtl[ [ v, v1, v2 ] ] := 3/10;
                      elif dist > 3 then
                          vtl[ [ v, v1, v2 ] ] := 1/3;
                      else
                          Error("this shouldn't happen");
                      fi;
                  elif (v1l[2] = 0) and (v2l[2] = 1) then
                      if dist = 0 then
                          vtl[ [ v, v1, v2 ] ] := 0;
                      elif dist = 1 then
                          vtl[ [ v, v1, v2 ] ] := 1/6;
                      elif dist > 1 then
                          vtl[ [ v, v1, v2 ] ] := 1/4;
                      else
                          Error("this shouldn't happen");
                      fi;
                  elif (v1l[2] = 1) and (v2l[2] = 0) then
                      if dist = 1 then
                          vtl[ [ v, v1, v2 ] ] := 0;
                      elif dist = 2 then
                          vtl[ [ v, v1, v2 ] ] := 1/6;
                      elif dist > 2 then
                          vtl[ [ v, v1, v2 ] ] := 1/4;
                      else
                          Error("this shouldn't happen");
                      fi;
                  elif (v1l[2] = 1) and (v2l[2] = 1) then
                      vtl[ [ v, v1, v2 ] ] := 0;
                      # what if dist=infinity (i.e. no path)
                  else
                      Error("this should not happen");
                  fi;
              od;
          od;
        fi;
    od;
    return vtl;
end);

InstallGlobalFunction(Vertex,
function(pres, v1, v, v2)
    local vt, t;

    t := VertexTriples(pres)[ [v, v1, v2] ];
    if t <> fail then
        return t;
    else
        return 1/3;
    fi;
end);

#XXX Computes triples (a,b,c) that are infixes
#    of strings found here with appropriate numbers
InstallMethod(ShortRedBlobIndex, "for a pregroup presentation",
              [IsPregroupPresentation],
function(pres)
    local pg, n, imm, index, nrl, cand, word, nonrletts, len, c;

    pg := Pregroup(pres);
    n := Size(pg);
    imm := IntermultMapIDs(pg);

    # TODO: This would be better done by a tree structure
    index := HashMap();

    cand := [[2..n]];

    nonrletts := [];
    word := [];

    len := 1;

    # minimum length 3
    while (len > 0) and (len < 7) do
        if Length(cand[len]) > 0 then
            c := Remove(cand[len], 1);
            word[len] := pg[c];
            nonrletts[len] := not IsRLetter(pres, pg[c]);
            # Possible not go further if we have too many R-letters?
            if IsIntermultPair(word[len], word[1]) and
               ReduceUPregroupWord(word{ [1..len] }) = [] then
                nrl := SizeBlist(nonrletts{[1..len]});
                if len = 3 then
                    # if len = 3 then no proper subword can be equal to 1
                    # because we only look at intermult pairs, and pairs
                    # of inverses are explicitly not intermult pairs
                    if nrl = 0 then
                        EnterAllSubwords(index, word{[1..len]}, 1/6);
                    elif nrl = 1 then
                        EnterAllSubwords(index, word{[1..len]}, 1/4);
                    else
                        # Print("? nrl", nrl, "\n");
                    fi;
                elif len = 4 then
                    if nrl = 0 then
                        EnterAllSubwords(index, word{[1..len]}, 1/4);
                    elif nrl = 1 then
                        EnterAllSubwords(index, word{[1..len]}, 1/3);
                    else
                        # Print("? nrl", nrl, "\n");
                    fi;
                elif len = 5 then
                    if (nrl = 0) then
                        EnterAllSubwords(index, word{[1..len]}, 3/10);
                    fi;
                elif (len = 6)
                     and (ReduceUPregroupWord(word{[2,3,4]}) <> [])
                     and (ReduceUPregroupWord(word{[3,4,5]}) <> []) then
                    if nrl = 0 then
                        EnterAllSubwords(index, word{[1..len]}, 1/3);
                    else
                        # Print("? nrl", nrl, "\n");
                    fi;
                fi;
                # We have entered, so backtrack
                len := len - 1;
            else
                if (len = 6) then
                    len := len - 1;
                else
                    len := len + 1;
                    cand[len] := ShallowCopy(imm[c]);
                fi;
            fi;
        else
            len := len - 1;
        fi;
    od;
    return index;
end);

# This should become an operation
InstallMethod(Blob, "for a pregroup presentation, an element, an element, and an element"
              , [ IsPregroupPresentation
                , IsElementOfPregroup
                , IsElementOfPregroup
                , IsElementOfPregroup ],
function(pres, a, b, c)
    local it, v, n;

    n := Size(Pregroup(pres));
    it := ShortRedBlobIndex(pres);
    v := it[ [__ID(a), __ID(b), __ID(c)] ];

    if v <> fail then
        return v;
    fi;
    return 5/14;
end);

# TODO: Use a map
InstallGlobalFunction(VertexFor,
function(vg, trip)
    return vg!.backmap[ [ __ID(trip[1]), __ID(trip[2]), trip[3] ] ];
end);

# Compute a list of
#  - places reachable from loc1 on Relator(loc1), and
#  - the corresponding location on Relator(loc2)
# by a consolidated edge between Relator(loc1) and Relator(loc2)
InstallGlobalFunction(ConsolidatedEdgePlaces,
function(loc1, loc2)
    local res, length, r1_loc, r2_loc, r1_length;

    res := [];
    length := 0;

    r1_loc := loc1;
    r2_loc := loc2;
    r1_length := Length(Relator(loc1));

    if OutLetter(r1_loc) <> PregroupInverse(InLetter(r2_loc)) then
        Error("This shouldn't happen");
#        return [];
    fi;

    repeat
        r1_loc := NextLocation(r1_loc);
        r2_loc := PrevLocation(r2_loc);
        length := length + 1;
        Append(res, List(Places(r1_loc), x -> [x, r2_loc, length]));
    until (OutLetter(r1_loc) <> PregroupInverse(InLetter(r2_loc)))
          or (length = r1_length);

    # Meh.
    if (length = r1_length) or
       (length = Length(Relator(loc2))) then
        return [];
    else
        return res;
    fi;
end);

# Helper function to add or update
# a "place quadruple"
AddOrUpdatePQ := function(L, pq)
    local pp;

    pp := PositionProperty(L, x -> x[1] = pq[1] and x[2] = pq[2]);
    if pp = fail then
        Add(L, Immutable(pq));
    else
        if L[pp][4] < pq[4] then
            L[pp] := Immutable(pq);
        fi;
    fi;
end;

# The RSym tester
# The epsilon is chosen by the user
InstallMethod(RSymTestOp, "for a pregroup presentation, and a rational",
              [IsPregroupPresentation, IsRat],
function(pres, eps)
    local i, j, rel, R, pplaces,
          places, Ps, P, Q, Pq,
          osrp, # a one-step reachable place
          osrpp,
          L,
          zeta,
          xi, psip, pp;
    # Make sure epsilon is a float
    # FIXME: To experiment and find out about rounding errors
    #        we try running this thing with rationals
    eps := Rat(eps);
    # FIXME: CAREFUL, if the zeta value is wrong, the RSymTester
    #        does not work correctly
    zeta := Minimum(Int(6 * (1 + eps) + 1) - 1,
                    LengthLongestRelator(pres));
    Info(InfoWalrus, 10
         , "RSymTest start");
    Info(InfoWalrus, 10
         , "zeta: ", zeta);

    # Precompute some things so it doesn't show up in weird places
    # in the profiling data
    # Some of this we might want to compute on demand?
    VertexGraphDistances(pres);
    pplaces := Places(pres);
    if not IsEmpty(pplaces) then
        OneStepReachablePlaces(pplaces[1]);
    fi;

    for rel in Relators(pres) do
        Info(InfoWalrus, 20
             , "relator: ", ViewString(rel), "\n");
        places := Places(rel);
        for Ps in places do
            Info(InfoWalrus, 20
                 , "  start place: "
                 , ViewString(Ps)
                 , "\n" );
            L := [ [__ID(Ps), 0, 0, 0] ]; # This list is called L in the paper
            # This is the list of possible decompositions
            # The meaning of the components of the quadruples q is
            # - q[1] is a place
            # - q[2] is the distance of q[1] from Ps
            # - q[3] is the number of steps that q[1] is from Ps
            # - q[4] is a curvature value
            for i in [1..zeta] do
                Info(InfoWalrus, 30
                     , STRINGIFY("L = ", ViewString(L)), ", i = ", i);
                for Pq in L do      # Pq is for "PlaceQuadruple", which is
                                    # a silly name
                    Info(InfoWalrus, 30,
                         STRINGIFY("Considering: ", Pq));
                    if Pq[3] = i - 1 then  # Reachable in i - 1 steps
                        osrpp := OneStepReachablePlaces(pplaces[Pq[1]]);
                        for osrp in Keys(osrpp) do
                            Info(InfoWalrus, 30,
                                 STRINGIFY("OneStepReachable: ", osrp));
                            if Pq[2] + osrp[2] <= Length(rel) then
                                psip := Pq[4]
                                        + osrp[2] * (1 + eps) / Length(rel)
                                        # storing positive values -> subtract here
                                        - osrpp[osrp];
                                Info(InfoWalrus, 30
                                     , STRINGIFY("psi' = "
                                                , Pq[4], " + "
                                                , osrp[2] * (1+eps) / Length(rel), " - "
                                                , osrpp[osrp], " = "
                                                , psip, "\n")
                                    );
                                if psip < 0 then
                                elif (Pq[4] > 0) and
                                     (osrp[1] = __ID(Ps)) and
                                     (Pq[2] + osrp[2] = Length(rel)) then
                                    # Add the place that caused the failure
                                    Add( L, Immutable( [ osrp[1], Pq[2] + osrp[2], i, psip ] ) );
                                    return [fail, L, Pq];
                                else
                                    AddOrUpdatePQ(L, [osrp[1], Pq[2] + osrp[2], i, psip]);
                                fi;
                            fi;
                        od;
                    fi;
                od;
            od;
        od;
    od;
    return true;
end);

InstallGlobalFunction(RSymTest,
function(args...)
    local pg, pgp, rgreen, inv;

    if Length(args) >= 2 then
        if IsPregroupPresentation(args[1]) then
            return RSymTestOp(args[1], args[2]);
        fi;
        if IsFreeGroup(args[1]) then
            pgp := PregroupPresentationFromFp(args[1], args[2], args[3]);
            return RSymTestOp(pgp, args[4]);
        fi;
    else
        # TODO: Usage message
    fi;
end);

InstallMethod(IsHyperbolic, "for a free group, a list, a list, and a rational number",
              [IsFreeGroup, IsObject, IsObject, IsRat],
              {freeg, rrel, grel, eps} -> RSymTest(freeg, rrel, grel, eps));

InstallMethod(IsHyperbolic, "for a pregroup presentation, and a rational number",
              [IsPregroupPresentation, IsRat],
              {pres, eps} -> RSymTest(pres,eps));


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

#Class(RulesConj, RuleSet);
RewriteRules(RulesVDiag, rec(
#    conj_LR_L := ARule(Compose, [@(1,ConjLR), @(2,ConjL)],
#                    e -> let(c1:=@(1).val.children(), c2:=@(2).val.children(),
#                    [ ConjL(c1[1] * Prm(fCompose(c1[3], c2[2])) * c2[1], c1[2]) ])),
#
#    conj_LR_LR := ARule(Compose, [@(1,ConjLR), @(2,ConjLR)],
#                    e -> let(c1:=@(1).val.children(), c2:=@(2).val.children(),
#                    [ ConjLR(c1[1] * Prm(fCompose(c1[3], c2[2])) * c2[1], c1[2], c2[3]) ])),
#
#    conj_R_LR := ARule(Compose, [@(1,ConjR), @(2,ConjLR)],
#                    e -> let(c1:=@(1).val.children(), c2:=@(2).val.children(),
#                    [ ConjR(c1[1] * Prm(fCompose(c1[2], c2[2])) * c2[1], c2[3]) ])),

    #--------------------------------------------------
    # handle RCDiag

    VGath_Conj_RCDiag := ARule(Compose, [@(1,VGath), [@(2,ConjDiag), @(3,RCDiag), @(4), @(5) ]],
       e -> let(f:=@(1).val.func, d:=@(3).val.element, v:=@(1).val.v, prm:=@(4).val,
                [ VRCDiag(VData(fCompose(d, prm, fTensor(f, fId(v))), v), v),@(1).val ] )),

    Conj_RCDiag_VScat := ARule(Compose, [[@(1,ConjDiag), @(2,RCDiag), @(3), @(4) ], @(5,VScat)],
       e -> let(f:=@(5).val.func, d:=@(2).val.element, v:=@(5).val.v, prm:=@(3).val,
                [ @(5).val, VRCDiag(VData(fCompose(d, prm, fTensor(f, fId(v))), v), v) ] )),

    VTensor_Conj_RCDiag := ARule(Compose, [@(1,VTensor), [@(2,ConjDiag), @(3,RCDiag), @(4, L, e->e.params[2] = e.params[1]/@(1).val.vlen), @(5, L,e->e.params[2] = @(1).val.vlen) ]],
        e -> let(d:=@(3).val.element, v:=@(1).val.vlen, prm:=@(4).val,
                [ @(1).val, VRCDiag(VData(fCompose(d, prm), v), v) ] )),

    PullInRightConjDiag := ARule( Compose,
        [ @(1, ConjDiag),
            @(2, [RecursStep, Grp, BB, SUM, Buf, ISum, Data, COND]) ],
        e -> [ CopyFields(@(2).val, rec(
                _children :=  List(@(2).val._children, c -> @(1).val * c),
                dimensions := [Rows(@(1).val), Cols(@(2).val)] )) ]),

    PullInLeftConjDiag := ARule( Compose,
        [ @(1, [RecursStep, Grp, BB, SUM, SUMAcc, Buf, ISum, ISumAcc, Data, COND]),
            @(2, ConjDiag) ],
        e -> [ CopyFields(@(1).val, rec(
                _children := List(@(1).val._children, c -> c * @(2).val),
                dimensions := [Rows(@(1).val), Cols(@(2).val)] )) ])
));

#_leftPerm := (m,n,v) -> Compose(VTensor(Tensor(I(m/(2*v)),L(n, v)), v), Tensor(I(m*n/(2*v^2)), VL(v^2, v)), VTensor(L(m*n/(2*v), m/v), v)).sums();
#_rightPerm := (m,n,v) -> VTensor(Tensor(I(n/2), L(m/v,m/(2*v))), v).sums();
#
#Class(RulesConjTerm, RuleSet);
#RewriteRules(RulesConjTerm, rec(
#    ConjR_VRC_Diag := ARule(Compose, [ [ConjR, @(1), @(2,L)], [@(3,VRC), @(4,Diag) ] ],
#                    e -> let(l := @(2).val, mn_by_2:=l.params[1], m:=l.params[2], n:=2*mn_by_2/m, v:=@(3).val.v,
#                        [ @(1).val * _leftPerm(m,n,v) * VRCL(@(3).val.child(1), v) ])),
#
#    VRCL_VRC := ARule(Compose, [ @(1, VRCL), @(2, VRC) ],
#                    e -> let(v:=@(1).val.v, [ VRCLR(@(1).val.child(1), v), VRCL(@(2).val.child(1), v) ])),
#
#    VRCL_L_ConjL := ARule(Compose, [ [ @(1,VRCL), [Prm, @(5), @(2,L), @(6)] ], [ ConjL, @(3),
#                        @(4,L, e->let(m2:=e.params[2], n2:=@(2).val.params[2], m2*n2 = @(2).val.params[1])) ] ],
#                    e -> let(lbar := @(2).val, n:= 2*lbar.params[2], m:=2*@(4).val.params[2], v:=@(1).val.v,
#                            [ _rightPerm(m,n,v) * @(3).val]))
#));


#
# walrus: Computational Methods for Finitely Generated Monoids and Groups
#

## Presentations
InstallGlobalFunction(NewPregroupPresentation,
function(pg, rels)
    local res;

    res := rec( pg := pg );
    res.rels := List([1..Length(rels)], x -> NewPregroupRelator(res, rels[x], x));
    # Orgh. Make sure Locations and Places are all computed for the moment
    Objectify(PregroupPresentationType, res);
    Locations(res);
    Places(res);
    SetVertexTripleCache(res, HashMap());

    return res;
end);

InstallGlobalFunction(PregroupPresentationFromFp,
function(F, rred, rgreen)
    local inv, pg, rgreens, inv_test;

    inv_test := function(x)
        local lr;
        if Length(x) = 2 then
            lr := LetterRepAssocWord(x);
            return lr[1] = lr[2];
        fi;
        return false;
    end;

    # Get the involutions
    inv := Filtered(rgreen, inv_test);
    rgreens := Filtered(rgreen, x -> not inv_test(x));
    pg := PregroupByRedRelators(F, rred, List(inv, x -> LetterRepAssocWord(x)[1]));

    rgreens := List(rgreens, pg!.convert_word);

    return NewPregroupPresentation(pg, rgreens);
end);

InstallMethod(ViewString
             , "for a pregroup presentation"
             , [IsPregroupPresentationRep],
function(pgp)
    # Note that we do not really regard 1 as a generator
    local res;

    return STRINGIFY("<pregroup presentation with "
                    , Size(pgp!.pg)-1, " generators and "
                    , Length(pgp!.rels), " relators>");
end);

InstallMethod(Pregroup
             , "for a pregroup presentation"
             , [IsPregroupPresentation],
             pgp -> pgp!.pg);

InstallMethod(Generators
             , "for a pregroup presentation"
             , [IsPregroupPresentation],
function(pres)
    local gens;

    gens := List(Pregroup(pres), x->x);
    Remove(gens, 1);
    return gens;
end);

InstallMethod(Relators
             , "for a pregroup presentation"
             , [IsPregroupPresentation],
             pgp -> pgp!.rels);

InstallMethod(RelatorsAndInverses
             , "for a pregroup presentation"
             , [IsPregroupPresentation],
function(pgp)
    local r;
    r := Relators(pgp);
    return Concatenation(r, List(r, Inverse));
end);

InstallMethod(Powers
             , "for a pregroup presentation"
             , [IsPregroupPresentation],
             x -> x!.powers);

InstallMethod(RLetters
             , "for a pregroup presentation"
             , [IsPregroupPresentation],
function(pres)
    local rels, gens, x, r, rlett;

    rels := RelatorsAndInverses(pres);
    gens := Generators(pres);
    rlett := Set([]);
    for r in rels do
        for x in gens do
            if x in r then AddSet(rlett, x); fi;
        od;
    od;
    return rlett;
end);

# An R-letter is a letter that occurs in any (interleave) of
# a relation (Definition 7.4)
# XXX: Note that the code below does not do interleaves yet!
InstallGlobalFunction(IsRLetter,
function(pres, x)
    # determine whether x occurs in I(R)
    return x in RLetters(pres);
end);

InstallMethod(Locations, "for a pregroup presentation",
              [IsPregroupPresentation and IsPregroupPresentationRep],
function(pres)
    local rel, locs, w, i, index;

    locs := [];

    for rel in RelatorsAndInverses(pres) do
        Append(locs, Locations(rel));
    od;

    # Hack
    # In particular this ID is ID within presentation
    index := HashMap(x -> HashBasic([__ID(x[1]), __ID(x[2])]));
    for i in [1..Length(locs)] do
        locs[i]![6] := i;

        if IsBound( index[ [ InLetter(locs[i]), OutLetter(locs[i]) ] ] ) then
            Add( index[ [ InLetter(locs[i]), OutLetter(locs[i]) ] ], locs[i] );
        else
            index[ [ InLetter(locs[i]), OutLetter(locs[i]) ] ] := [ locs[i] ];
        fi;
    od;
    SetLocationIndex(pres, index);
    return locs;
end);

# For a location R(i,a,b) find a matching location
# R'(j,b^(-1),c) such that a reduced diagram only
# containing R and R' exists
FindMatchingLocation := function(loc, c)
    local locs, b, binv, loc2;

    b := OutLetter(loc);
    binv := PregroupInverse(b);
    locs := LocationIndex(PregroupPresentationOf(loc));
    locs := locs[ [binv, c] ];

    if locs <> fail then
        for loc2 in locs do
            if CheckReducedDiagram(loc, loc2) then
                return loc2;
            fi;
        od;
    fi;
    return fail;
end;

# Given a pregroup presentation as the input, find all places
# B is true if a place will always occur on the boundary
InstallMethod(Places, "for a pregroup presentation",
              [IsPregroupPresentation and IsPregroupPresentationRep],
function(pres)
    local loc, loc2,
          places, a, b, c,
          rels,
          locs, i;

    # rels := RelatorsAndInverses(pres);
    rels := Relators(pres);
    locs := Locations(pres);
    places := [];

    for loc in locs do
        a := InLetter(loc);
        b := OutLetter(loc);
        for c in Generators(pres) do
            # Colour is "red"
            if IsIntermultPair(PregroupInverse(b), c) then
                Add(places, NewPlace(loc, c, "red"));
            fi;
            # Colour is "green"
            # find location R'(j,b^(-1),c) and check that a diagram that
            # meets at the edge b doesn't collapse.

            if FindMatchingLocation(loc, c) <> fail then
                Add(places, NewPlace(loc, c, "green"));
            fi;
        od;
    od;
    # Hack
    for i in [1..Length(places)] do
        places[i]![5] := i;
    od;
    return places;
end);

InstallMethod(LengthLongestRelator, "for a pregroup presentation",
              [IsPregroupPresentation and IsPregroupPresentationRep],
function(pres)
    return Maximum(List(Relators(pres), Length));
end);

# Definition 3.3: A diagram is semi-reduced, if no distinct adjacent faces
# are labelled by ww_1 and w_1^{-1}w for a relator ww_1 and have a common
# consolidated edge labelled by w and w^-1
# it is reduced if this also holds for a face incident with itself.
#
# test whether label on Relator(l2) beginning at b^(-1) is equal to inverse
# of label on Relator(l1) ending at b
InstallGlobalFunction(CheckReducedDiagram,
function(l1, l2)
    local i, j, r1, r2, iend, jend;

    r1 := Relator(l1);
    i := Position(l1);
    iend := i + 1;
    if iend > Length(r1) then iend := iend - Length(r1); fi;

    r2 := Relator(l2);
    j := Position(l2) - 1;
    jend := j - 1;
    if jend < 0 then jend := jend + Length(r2); fi;

    # Here inverses should match, or otherwise the passed
    # locations are already incompatible
    if r1[i] <> PregroupInverse(r2[j]) then
        Error("loc1 and loc2 are not compatible");
        return fail;
    fi;

    repeat
        i := i - 1;
        if i = 0 then i := Length(r1); fi;
        j := j + 1;
        if j > Length(r2) then j := 1; fi;

#        # Print("r1[", i, "] = ", r1[i], " r2[", j, "] = ", r2[j], "\n");
        if r1[i] <> PregroupInverse(r2[j]) then
            return true;
        fi;
    until (i = iend) or (j = jend);

    return false;
end);

InstallGlobalFunction(PregroupPresentationToFpGroup,
function(pres)
    local d, F, rels, gens, pg, p, i, j;

    # By Definition 2.2 of the paper
    d := Size(Pregroup(pres)) - 1;
    F := FreeGroup(d);
    pg := Pregroup(pres);

    rels := [];
    # rels := List([1..d], x -> [ F.(x) * F.(pg!.inv(x+1)-1), One(F) ]);
    for i in [2..d+1] do
        for j in [2..d+1] do
            p := pg[i] * pg[j];
            if p <> fail then
                if p = One(pg) then
                    Add(rels, [F.(i-1) * F.(j-1), One(F)]);
                else
                    Add(rels, [F.(i-1) * F.(j-1) * F.(__ID(PregroupInverse(p))-1), One(F)]);
                fi;
            fi;
        od;
    od;
    Append(rels, List(Relators(pres), x -> [Product(List(List(x), y -> F.(__ID(y)-1))), One(F)]));

    return F / rels;
end);

#T Put pregroup relations in (if pregroup is not the pregroup of the free group)
#T Choose sensible generator names and print them (maybe just use x1,x2,... or a,b,c))
if WALRUS_kbmag_available then

InstallGlobalFunction(PregroupPresentationToKBMAG,
    pres -> KBMAGRewritingSystem(PregroupPresentationToFpGroup(pres)));

fi;

# Writes out pregroup as a multiplication table
# and then the relators, intended as a simple exchange
# format
InstallGlobalFunction(PregroupPresentationToSimpleStream,
function(stream, pres)
    local row, col, table, n, i, rel;

    table := MultiplicationTableIDs(Pregroup(pres));
    n := Length(table);
    AppendTo(stream, "pregroup:\n" );

    for row in [1..n] do
        AppendTo(stream, "  ");
        for col in [1..n-1] do
            AppendTo(stream, String(table[row][col]));
            AppendTo(stream, " ");
        od;
        AppendTo(stream, String(table[row][n]));
        AppendTo(stream, "\n");
    od;

    AppendTo(stream, "relators:\n");
    for rel in Relators(pres) do
        AppendTo(stream, "  ");
        for i in [1..Length(rel)-1] do
            AppendTo(stream, String(__ID(rel[i])));
            AppendTo(stream, " ");
        od;
        AppendTo(stream, String(__ID(rel[Length(rel)])));
        AppendTo(stream, "\n");
    od;
end);

# Serialises a pregroup presentation as a GAP record
# that GAP can read back easily
InstallGlobalFunction(PregroupPresentationToStream,
function(stream, pres)
    local res, rel, rels;

    res := rec( table := MultiplicationTableIDs(Pregroup(pres)),
                rels := List(Relators(pres), r -> List(r, x -> __ID(x))));

    PrintTo(stream, res, ";\n");
end);

InstallGlobalFunction(PregroupPresentationFromStream,
function(stream)
    local res, r, pg, rels;
    res := READ_ALL_COMMANDS(stream, false, false, IdFunc);

    if Length(res) = 1
       and res[1][1] = true
       and IsBound(res[1][2])
       and IsRecord(res[1][2]) then
        # FIXME: Store element names, at least don't put arbitarary
        #        restriction o nnumber of pregroup elts here
        r := res[1][2];
        pg := PregroupByTable("1abcdefghijklmnopqrstuvwxyz"{[1..Length(r.table)]}, r.table);
        return NewPregroupPresentation(pg, List(r.rels, x -> pg_word(pg, x)));
    else
        Error("Could not read pregroup presentation from stream");
    fi;
end);

InstallGlobalFunction(PregroupPresentationToFile,
function(filename, pres)
    local outs;

    outs := OutputTextFile(filename, false);
    SetPrintFormattingStatus(outs, false);
    PregroupPresentationToStream(outs, pres);
    CloseStream(outs);
end);

InstallGlobalFunction(PregroupPresentationToSimpleFile,
function(filename, pres)
    local outs;

    outs := OutputTextFile(filename, false);
    SetPrintFormattingStatus(outs, false);
    PregroupPresentationToSimpleStream(outs, pres);
    CloseStream(outs);
end);


#############################################################################
##
#W    pcpgrp3.gi                                                Karel Dekimpe
#W                                                               Bettina Eick
##
##    This file contains the 3-dimensional almost crystallographic groups
##    as pcp groups. There are 17 types groups.
##

ACPcpGroupDim3Nr01 := function (k1)
local FTL;
  FTL := FromTheLeftCollector( 3 );
  SetConjugate( FTL, 2, 1, [2,1,  3,k1] );
return PcpGroupByCollector(FTL);
end;

ACPcpGroupDim3Nr02 := function (k1, k2, k3 , k4)
local FTL;
  FTL := FromTheLeftCollector( 4 );
  SetRelativeOrder( FTL, 1, 2 );
  SetPower( FTL, 1, [2,0,  3,0,  4,k4] );
  SetConjugate( FTL, 2, 1, [2,-1,  3,0,  4,k2] );
  SetConjugate( FTL, 3, 1, [2,0,  3,-1,  4,k3] );
  SetConjugate( FTL, 4, 1, [2,0,  3,0,  4,1] );
  SetConjugate( FTL, 3, 2, [3,1,  4,k1] );
  SetConjugate( FTL, 4, 2, [3,0,  4,1] );
  SetConjugate( FTL, 4, 3, [4,1] );
return PcpGroupByCollector(FTL);
end;

ACPcpGroupDim3Nr03 := function (k1, k2)
local FTL;
  FTL := FromTheLeftCollector( 4 );
  SetRelativeOrder( FTL, 1, 2 );
  SetPower( FTL, 1, [2,0,  3,0,  4,0] );
  SetConjugate( FTL, 2, 1, [2,1,  3,0,  4,-k2] );
  SetConjugate( FTL, 3, 1, [2,0,  3,-1,  4,0] );
  SetConjugate( FTL, 4, 1, [2,0,  3,0,  4,-1] );
  SetConjugate( FTL, 3, 2, [3,1,  4,k1] );
  SetConjugate( FTL, 4, 2, [3,0,  4,1] );
  SetConjugate( FTL, 4, 3, [4,1] );
return PcpGroupByCollector(FTL);
end;

ACPcpGroupDim3Nr04 := function (k1, k2)
local FTL;
  FTL := FromTheLeftCollector( 4 );
  SetRelativeOrder( FTL, 1, 2 );
  SetPower( FTL, 1, [2,1,  3,0,  4,k2] );
  SetConjugate( FTL, 2, 1, [2,1,  3,0,  4,2*k2] );
  SetConjugate( FTL, 3, 1, [2,0,  3,-1,  4,-k1] );
  SetConjugate( FTL, 4, 1, [2,0,  3,0,  4,-1] );
  SetConjugate( FTL, 3, 2, [3,1,  4,2*k1] );
  SetConjugate( FTL, 4, 2, [3,0,  4,1] );
  SetConjugate( FTL, 4, 3, [4,1] );
return PcpGroupByCollector(FTL);
end;

ACPcpGroupDim3Nr05 := function (k1, k2)
local FTL;
  FTL := FromTheLeftCollector( 4 );
  SetRelativeOrder( FTL, 1, 2 );
  SetPower( FTL, 1, [2,0,  3,0,  4,0] );
  SetConjugate( FTL, 2, 1, [2,0,  3,1,  4,-k2] );
  SetConjugate( FTL, 3, 1, [2,1,  3,0,  4,-k2] );
  SetConjugate( FTL, 4, 1, [2,0,  3,0,  4,-1] );
  SetConjugate( FTL, 3, 2, [3,1,  4,k1] );
  SetConjugate( FTL, 4, 2, [3,0,  4,1] );
  SetConjugate( FTL, 4, 3, [4,1] );
return PcpGroupByCollector(FTL);
end;

ACPcpGroupDim3Nr06 := function (k1, k2, k3 , k4)
local FTL;
  FTL := FromTheLeftCollector( 5 );
  SetRelativeOrder( FTL, 1, 2 );
  SetPower( FTL, 1, [3,0,  4,0,  5,0] );
  SetConjugate( FTL, 2, 1, [2, 1 ,  3,0,  4,0,  5,-k4] );
  SetConjugate( FTL, 3, 1, [3,1,  4,0,  5,-k2] );
  SetConjugate( FTL, 4, 1, [3,0,  4,-1,  5,0] );
  SetConjugate( FTL, 5, 1, [3,0,  4,0,  5,-1] );
  SetRelativeOrder( FTL, 2, 2 );
  SetPower( FTL, 2, [3,0,  4,0,  5,k4] );
  SetConjugate( FTL, 3, 2, [3,-1,  4,0,  5,k2] );
  SetConjugate( FTL, 4, 2, [3,0,  4,-1,  5,k3] );
  SetConjugate( FTL, 5, 2, [3,0,  4,0,  5,1] );
  SetConjugate( FTL, 4, 3, [4,1,  5,k1] );
return PcpGroupByCollector(FTL);
end;

ACPcpGroupDim3Nr07 := function (k1, k2, k3 , k4)
local FTL;
  FTL := FromTheLeftCollector( 5 );
  SetRelativeOrder( FTL, 1, 2 );
  SetPower( FTL, 1, [3,0,  4,0,  5,0] );
  SetConjugate( FTL, 2, 1, [2, 1 ,  3,0,  4,-1,  5,-2*k3 - k4] );
  SetConjugate( FTL, 3, 1, [3,1,  4,0,  5,k1 - k2] );
  SetConjugate( FTL, 4, 1, [3,0,  4,-1,  5,0] );
  SetConjugate( FTL, 5, 1, [3,0,  4,0,  5,-1] );
  SetRelativeOrder( FTL, 2, 2 );
  SetPower( FTL, 2, [3,0,  4,0,  5,k3] );
  SetConjugate( FTL, 3, 2, [3,-1,  4,0,  5,k2] );
  SetConjugate( FTL, 4, 2, [3,0,  4,-1,  5,-2*(k3 + k4)] );
  SetConjugate( FTL, 5, 2, [3,0,  4,0,  5,1] );
  SetConjugate( FTL, 4, 3, [4,1,  5,2*k1] );
return PcpGroupByCollector(FTL);
end;

ACPcpGroupDim3Nr08 := function (k1, k2, k3 , k4)
local FTL;
  FTL := FromTheLeftCollector( 5 );
  SetRelativeOrder( FTL, 1, 2 );
  SetPower( FTL, 1, [3,1,  4,0,  5,-k3] );
  SetConjugate( FTL, 2, 1, [2, 1 ,  3,1,  4,-1,  5,-2*k1 + k2 - 2*k3 - k4] );
  SetConjugate( FTL, 3, 1, [3,1,  4,0,  5,-2*k3] );
  SetConjugate( FTL, 4, 1, [3,0,  4,-1,  5,-k1] );
  SetConjugate( FTL, 5, 1, [3,0,  4,0,  5,-1] );
  SetRelativeOrder( FTL, 2, 2 );
  SetPower( FTL, 2, [3,0,  4,0,  5,k4] );
  SetConjugate( FTL, 3, 2, [3,-1,  4,0,  5,k1 + 2*k3] );
  SetConjugate( FTL, 4, 2, [3,0,  4,-1,  5,-k1 + 2*k2 - 2*k3] );
  SetConjugate( FTL, 5, 2, [3,0,  4,0,  5,1] );
  SetConjugate( FTL, 4, 3, [4,1,  5,2*k1] );
return PcpGroupByCollector(FTL);
end;

ACPcpGroupDim3Nr09 := function (k1, k2, k3 , k4)
local FTL;
  FTL := FromTheLeftCollector( 5 );
  SetRelativeOrder( FTL, 1, 2 );
  SetPower( FTL, 1, [3,0,  4,0,  5,0] );
  SetConjugate( FTL, 2, 1, [2, 1 ,  3,0,  4,0,  5,-k4] );
  SetConjugate( FTL, 3, 1, [3,0,  4,1,  5,-k3] );
  SetConjugate( FTL, 4, 1, [3,1,  4,0,  5,-k3] );
  SetConjugate( FTL, 5, 1, [3,0,  4,0,  5,-1] );
  SetRelativeOrder( FTL, 2, 2 );
  SetPower( FTL, 2, [3,0,  4,0,  5,k4] );
  SetConjugate( FTL, 3, 2, [3,-1,  4,0,  5,k2] );
  SetConjugate( FTL, 4, 2, [3,0,  4,-1,  5,-k2 + 2*k3] );
  SetConjugate( FTL, 5, 2, [3,0,  4,0,  5,1] );
  SetConjugate( FTL, 4, 3, [4,1,  5,k1] );
return PcpGroupByCollector(FTL);
end;

ACPcpGroupDim3Nr10 := function (k1, k2, k3 , k4)
local FTL;
  FTL := FromTheLeftCollector( 4 );
  SetRelativeOrder( FTL, 1, 4 );
  SetPower( FTL, 1, [2,0,  3,0,  4,k4] );
  SetConjugate( FTL, 2, 1, [2,0,  3,-1,  4,k3] );
  SetConjugate( FTL, 3, 1, [2,1,  3,0,  4,-k2] );
  SetConjugate( FTL, 4, 1, [2,0,  3,0,  4,1] );
  SetConjugate( FTL, 3, 2, [3,1,  4,k1] );
  SetConjugate( FTL, 4, 2, [3,0,  4,1] );
  SetConjugate( FTL, 4, 3, [4,1] );
return PcpGroupByCollector(FTL);
end;

ACPcpGroupDim3Nr11 := function (k1, k2, k3 , k4)
local FTL;
  FTL := FromTheLeftCollector( 5 );
  SetRelativeOrder( FTL, 1, 2 );
  SetPower( FTL, 1, [3,0,  4,0,  5,0] );
  SetConjugate( FTL, 2, 1, [2, 3 ,  3,0,  4,0,  5,-k4] );
  SetConjugate( FTL, 3, 1, [3,1,  4,0,  5,-k2 - k3] );
  SetConjugate( FTL, 4, 1, [3,0,  4,-1,  5,0] );
  SetConjugate( FTL, 5, 1, [3,0,  4,0,  5,-1] );
  SetRelativeOrder( FTL, 2, 4 );
  SetPower( FTL, 2, [3,0,  4,0,  5,k4] );
  SetConjugate( FTL, 3, 2, [3,0,  4,-1,  5,k3] );
  SetConjugate( FTL, 4, 2, [3,1,  4,0,  5,-k2] );
  SetConjugate( FTL, 5, 2, [3,0,  4,0,  5,1] );
  SetConjugate( FTL, 4, 3, [4,1,  5,k1] );
return PcpGroupByCollector(FTL);
end;

ACPcpGroupDim3Nr12 := function (k1, k2, k3 , k4)
local FTL;
  FTL := FromTheLeftCollector( 5 );
  SetRelativeOrder( FTL, 1, 2 );
  SetPower( FTL, 1, [3,1,  4,0,  5,k3] );
  SetConjugate( FTL, 2, 1, [2, 3 ,  3,0,  4,-1,  5,-k2 - k3 - k4] );
  SetConjugate( FTL, 3, 1, [3,1,  4,0,  5,2*k3] );
  SetConjugate( FTL, 4, 1, [3,0,  4,-1,  5,-k1] );
  SetConjugate( FTL, 5, 1, [3,0,  4,0,  5,-1] );
  SetRelativeOrder( FTL, 2, 4 );
  SetPower( FTL, 2, [3,0,  4,0,  5,k4] );
  SetConjugate( FTL, 3, 2, [3,0,  4,-1,  5,k1 - k2 - 2*k3] );
  SetConjugate( FTL, 4, 2, [3,1,  4,0,  5,-k2] );
  SetConjugate( FTL, 5, 2, [3,0,  4,0,  5,1] );
  SetConjugate( FTL, 4, 3, [4,1,  5,2*k1] );
return PcpGroupByCollector(FTL);
end;

ACPcpGroupDim3Nr13 := function (k1, k2, k3 , k4)
local FTL;
  FTL := FromTheLeftCollector( 4 );
  SetRelativeOrder( FTL, 1, 3 );
  SetPower( FTL, 1, [2,0,  3,0,  4,k4] );
  SetConjugate( FTL, 2, 1, [2,-1,  3,-1,  4,k2 + k3] );
  SetConjugate( FTL, 3, 1, [2,1,  3,0,  4,-k2] );
  SetConjugate( FTL, 4, 1, [2,0,  3,0,  4,1] );
  SetConjugate( FTL, 3, 2, [3,1,  4,k1] );
  SetConjugate( FTL, 4, 2, [3,0,  4,1] );
  SetConjugate( FTL, 4, 3, [4,1] );
return PcpGroupByCollector(FTL);
end;

ACPcpGroupDim3Nr14 := function (k1, k2, k3 , k4)
local FTL;
  FTL := FromTheLeftCollector( 5 );
  SetRelativeOrder( FTL, 1, 2 );
  SetPower( FTL, 1, [3,0,  4,0,  5,0] );
  SetConjugate( FTL, 2, 1, [2, 2 ,  3,0,  4,0,  5,-k4] );
  SetConjugate( FTL, 3, 1, [3,0,  4,-1,  5,-k2] );
  SetConjugate( FTL, 4, 1, [3,-1,  4,0,  5,k2] );
  SetConjugate( FTL, 5, 1, [3,0,  4,0,  5,-1] );
  SetRelativeOrder( FTL, 2, 3 );
  SetPower( FTL, 2, [3,0,  4,0,  5,k4] );
  SetConjugate( FTL, 3, 2, [3,-1,  4,-1,  5,k2 + k3] );
  SetConjugate( FTL, 4, 2, [3,1,  4,0,  5,-k2] );
  SetConjugate( FTL, 5, 2, [3,0,  4,0,  5,1] );
  SetConjugate( FTL, 4, 3, [4,1,  5,k1] );
return PcpGroupByCollector(FTL);
end;

ACPcpGroupDim3Nr15 := function (k1, k2, k3 , k4)
local FTL;
  FTL := FromTheLeftCollector( 5 );
  SetRelativeOrder( FTL, 1, 2 );
  SetPower( FTL, 1, [3,0,  4,0,  5,0] );
  SetConjugate( FTL, 2, 1, [2, 2 ,  3,0,  4,0,  5,-k4] );
  SetConjugate( FTL, 3, 1, [3,0,  4,1,  5,-k2] );
  SetConjugate( FTL, 4, 1, [3,1,  4,0,  5,-k2] );
  SetConjugate( FTL, 5, 1, [3,0,  4,0,  5,-1] );
  SetRelativeOrder( FTL, 2, 3 );
  SetPower( FTL, 2, [3,0,  4,0,  5,k4] );
  SetConjugate( FTL, 3, 2, [3,-1,  4,-1,  5,k1 + 3*k2 - k3] );
  SetConjugate( FTL, 4, 2, [3,1,  4,0,  5,-k1 - 3*k2 + 2*k3] );
  SetConjugate( FTL, 5, 2, [3,0,  4,0,  5,1] );
  SetConjugate( FTL, 4, 3, [4,1,  5,k1] );
return PcpGroupByCollector(FTL);
end;

ACPcpGroupDim3Nr16 := function (k1, k2, k3 , k4)
local FTL;
  FTL := FromTheLeftCollector( 4 );
  SetRelativeOrder( FTL, 1, 6 );
  SetPower( FTL, 1, [2,0,  3,0,  4,k4] );
  SetConjugate( FTL, 2, 1, [2,0,  3,-1,  4,k3] );
  SetConjugate( FTL, 3, 1, [2,1,  3,1,  4,k1 - k2 - k3] );
  SetConjugate( FTL, 4, 1, [2,0,  3,0,  4,1] );
  SetConjugate( FTL, 3, 2, [3,1,  4,k1] );
  SetConjugate( FTL, 4, 2, [3,0,  4,1] );
  SetConjugate( FTL, 4, 3, [4,1] );
return PcpGroupByCollector(FTL);
end;

ACPcpGroupDim3Nr17 := function (k1, k2, k3 , k4)
local FTL;
  FTL := FromTheLeftCollector( 5 );
  SetRelativeOrder( FTL, 1, 2 );
  SetPower( FTL, 1, [3,0,  4,0,  5,0] );
  SetConjugate( FTL, 2, 1, [2, 5 ,  3,0,  4,0,  5,-k4] );
  SetConjugate( FTL, 3, 1, [3,0,  4,1,  5,-k3] );
  SetConjugate( FTL, 4, 1, [3,1,  4,0,  5,-k3] );
  SetConjugate( FTL, 5, 1, [3,0,  4,0,  5,-1] );
  SetRelativeOrder( FTL, 2, 6 );
  SetPower( FTL, 2, [3,0,  4,0,  5,k4] );
  SetConjugate( FTL, 3, 2, [3,0,  4,-1,  5,k3] );
  SetConjugate( FTL, 4, 2, [3,1,  4,1,  5,k1 - k2 - k3] );
  SetConjugate( FTL, 5, 2, [3,0,  4,0,  5,1] );
  SetConjugate( FTL, 4, 3, [4,1,  5,k1] );
return PcpGroupByCollector(FTL);
end;

#############################################################################
##
## some small helpers
##
ACPcpDim3Funcs := [ ACPcpGroupDim3Nr01, ACPcpGroupDim3Nr02,
ACPcpGroupDim3Nr03,
ACPcpGroupDim3Nr04, ACPcpGroupDim3Nr05, ACPcpGroupDim3Nr06,
ACPcpGroupDim3Nr07, ACPcpGroupDim3Nr08, ACPcpGroupDim3Nr09,
ACPcpGroupDim3Nr10, ACPcpGroupDim3Nr11, ACPcpGroupDim3Nr12,
ACPcpGroupDim3Nr13, ACPcpGroupDim3Nr14, ACPcpGroupDim3Nr15,
ACPcpGroupDim3Nr16, ACPcpGroupDim3Nr17 ];
MakeReadOnlyGlobal( "ACPcpDim3Funcs" );


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

#Concatenation(Conf("spiral_dir"), Conf("path_sep"), "libgen", Conf("path_sep"),

#F InitLibgen(<opts>)
#F  opts must have a .libgen field.
#F  Example: opts := InitLibgen(LibgenDefaults);
#F
InitLibgen := function(opts)
    local base_opts, bench;
    opts := Copy(opts);

    base_opts := CopyFields(opts, rec(
            globalUnrolling := opts.libgen.basesUnrolling,
            breakdownRules  := opts.libgen.basesBreakdowns,
            hashFile        := opts.libgen.basesHashFile,
            benchTransforms := opts.libgen.bases));

    bench:= CopyFields(DPBench(rec(bases := base_opts), rec(verbosity:=0)),
                       rec(generateCfiles := false, generateSums := true, matrixVerify := false));
    bench.resumeAll();

    opts.libgen.baseBench := bench;
    opts.baseHashes := Concatenation(opts.baseHashes, [ CreateRecursBaseHash(bench.exp.bases.hashTable) ]);
    return opts;
end;

_bases := function(max)
   local t, facs, sizesTwoPower, sizesGeneral;
   sizesTwoPower := List([1..Log2Int(max)], x->2^x);
   facs := [2, 3, 5, 7, 11];
   sizesGeneral := Filtered([2 .. max], i -> ForAll(FactorsInt(i), f -> f in (facs)));
   t := [];
   Append(t, List(sizesTwoPower, PRDFT3));
   Append(t, List(sizesTwoPower, n -> PRDFT3(n, -1).transpose()));
   Append(t, List(sizesTwoPower, n -> DFT(n, -1 mod n)));
#  Append(t, List(sizesTwoPower, URDFT));
   Append(t, List(sizesGeneral, PRDFT));
   Append(t, List(sizesGeneral, DFT));
   return t;
end;

LibgenDefaultsMixin := rec(
    codegen := RecCodegen,
    verbosity := 1,
    hashTable := HashTableDP(),

    formulaStrategies := rec(
	sigmaSpl    := [ StandardSumsRules, HfuncSumsRules ],
	preRC       := [],
	rc          := [ StandardSumsRules, HfuncSumsRules ],
        postProcess := [
	    (s, opts) -> BlockSums(opts.globalUnrolling, s),
	    (s, opts) -> Process_fPrecompute(s, opts),
            RecursStepTerm
        ]
    ),

    libgen := rec(
	codeletTab := CreateCodeletHashTable(),
	terminateStrategy := [ HfuncSumsRules ], # used in SumsCodelet

	bases := _bases(34),
	basesUnrolling := 2^16,
        basesHashFile := let(p:=Conf("path_sep"),
            Concat(Conf("spiral_dir"), p, "spiral", p, "libgen", p, "realbases.hash")),
	basesBreakdowns := rec(
	    DFT    := [DFT_Base, DFT_CT, DFT_GoodThomas, DFT_PD, DFT_Rader],
	    PRDFT  := [PRDFT1_Base2, PRDFT1_CT, PRDFT1_PF, PRDFT_Rader, PRDFT_PD],
	    PRDFT3 := [PRDFT3_Base1, PRDFT3_Base2, PRDFT3_CT, PRDFT3_OddToPRDFT1])
    )
);

LibgenDefaults := CopyFields(SpiralDefaults, LibgenDefaultsMixin, rec(
    globalUnrolling := 66,
    breakdownRules := rec(
	DFT    := [DFT_Base, DFT_CT],
	PRDFT  := [PRDFT1_Base2, PRDFT1_CT],
	PRDFT3 := [PRDFT3_Base2, PRDFT3_CT],
	PDCT4  := [PDCT4_Base2, PDCT4_CT],
	PDST4  := [PDST4_Base2, PDST4_CT],
	InfoNt := [Info_Base]),
    libgen := Copy(LibgenDefaultsMixin.libgen)
));

CplxLibgenDefaults := CopyFields(CplxSpiralDefaults, LibgenDefaultsMixin, rec(
    globalUnrolling := 34,
    breakdownRules := rec(
	DFT    := [DFT_Base, DFT_CT],
	PRDFT  := [PRDFT1_Base2, PRDFT1_CT],
	PRDFT3 := [PRDFT3_Base2, PRDFT3_CT],
	InfoNt := [Info_Base]),
    libgen := CopyFields(Copy(LibgenDefaultsMixin.libgen), rec(
	bases := List([1..5], x->DFT(2^x)),
        basesHashFile := let(p:=Conf("path_sep"),
            Concat(Conf("spiral_dir"), p, "spiral", p, "libgen", p, "cplxbases.hash")),
	basesBreakdowns := rec(
	    DFT    := [DFT_Base, DFT_PRDFT],
	    PRDFT  := [PRDFT1_Base1, PRDFT1_Base2, PRDFT1_CT, PRDFT1_PF, PRDFT_PD, PRDFT_Rader],
	    PRDFT3 := [PRDFT3_Base1, PRDFT3_Base2, PRDFT3_CT, PRDFT3_OddToPRDFT1])
    ))
));


Read("SchreierSims.gi");

#######################################################################
# Description: The deterministic verification, parallelized w.r.t.    #
#              base points, described as method 1 in section 5.1.     #
# Input: - BSGS data structure returned by RandomSchreierSims         #
# Output: - boolean, true if BSGS is correct, else false              #
#######################################################################

Method1 := function(BSGS)
    local l, tasks, results;

    Print("Start verification.\n");
    Print("Apply parallel computing method w.r.t. base points.\n");

    tasks := [1..Length(BSGS[1])];  results := [1..Length(BSGS[1])];

    for l in [1..Length(BSGS[1])] do
        tasks[l] := RunTask(SimpleVerify, BSGS, l);
    od;
    for l in [1..Length(BSGS[1])] do
        results[l] := TaskResult(tasks[l]);
    od;

    Print("\nVerification done.");

    if false in results then
        Print("\nBSGS is wrong!\n");
    else
        Print("\nCorrectness of BSGS verified!\n");
    fi;
    Print("*********************************************************\n");
end;

#######################################################################
#######################################################################

#######################################################################
# Description: The deterministic verification, parallelized w.r.t.    #
#              orbit points, described as method 2 in section 5.1.    #
# Input: - BSGS data structure returned by RandomSchreierSims         #
# Output: - boolean, true if BSGS is correct, else false              #
#######################################################################

Method2 := function(BSGS)
    local l, tasks, results;

    Print("Start verification.\n");
    Print("Apply parallel computing method w.r.t. orbit points.\n");

    tasks := [1..Length(BSGS[1])];  results := [1..Length(BSGS[1])];

    for l in Reversed([1..Length(BSGS[1])]) do
        results[l] := ParallelVerify(BSGS, l);
        if false in results then
            break;
        fi;
    od;

    Print("\nVerification done.");

    if false in results then
        Print("\nBSGS is wrong!\n");
    else
        Print("\nCorrectness of BSGS verified!\n");
    fi;
    Print("*********************************************************\n");
end;


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

mizuno:=[[1,2,3,4,5,6,7,
          9,10,11,12,
          13,14,16,17,
          19,18,20,21,
          23,24,25,27,
          26,28,30,31,
          32,33,35,34,
          37,38,39,40,
          41,44,45,46,
          48,49,51,52,
          53,55,57,58,
          59,61,63,64,
          66,69,70,71,
          75,76,80,82,
          85,89,93,97],
         [8,
          15,22,29,36,
          43,42,47,50,
          54,56,60,62,
          65,67,68,72,
          73,74,77,78,
          79,81,83,84,
          86,87,88,90,
          91,92,94,95,
          96,98,99,100,
          101,102,103,104,
          105,106,107,108,
          109,110,111,112,
          114,113,115,116,
          117,118,119,120]];

reps:=[[[1,1],[2,1],[3,1],[4,1],[5,1],[6,1],[7,1],[101,1]],          # E_8
       [[1,1],[2,1],[9,1],[10,1],[5,1],[6,1],[7,1],[101,1]],         # E_8(a_1)
       [[1,1],[3,1],[2,1],[9,1],[11,1],[12,1],[13,1],[101,1]],       # E_8(a_2)
       [[8,1],[9,1],[10,1],[11,1],[16,1],[12,1],[7,1],[101,1]],      # E_7+A_1
       [[1,1],[15,1],[16,1],[17,1],[6,1],[7,1],[101,1]],             # E_7
       [[8,1],[9,1],[10,1],[11,1],[16,1],[12,1],[13,1],[102,1]],     # D_8
       [[8,1],[15,1],[16,1],[17,1],[18,1],[19,1],[7,1],[101,1]],     # E_7(a_1)+A_1
       [[1,1],[15,1],[16,1],[17,1],[24,1],[13,1],[101,1]],           # E_7(a_1)
       [[1,1],[15,1],[16,1],[17,1],[18,1],[24,1],[13,1],[102,1]],    # D_8(a_1)       ?
       [[1,1],[15,1],[16,1],[17,1],[18,1],[19,1],[103,1]],           # D_7
       [[14,1],[15,1],[21,1],[17,1],[18,1],[29,1],[19,1],[101,1]],   # E_7(a_2)+A_1
       [[20,1],[21,1],[17,1],[23,1],[24,1],[7,1],[101,1]],           # E_7(a_2)
       [[14,1],[20,1],[21,1],[22,1],[18,1],[33,1],[13,1],[102,1]],   # A_8
       [[20,1],[21,1],[28,1],[23,1],[24,1],[7,1],[101,1]],           # E_6+A_1
       [[14,1],[22,1],[23,1],[24,1],[19,1],[25,1],[35,1],[102,1]],   # D_7(a_1)
#       [[14,1],[22,1],[23,1],[24,1],[19,1],[25,1],[102,1]],          # (D_7(a_1))_2
       [[20,1],[21,1],[23,1],[24,1],[7,1],[101,1]],                  # E_6
       [[20,1],[21,1],[22,1],[23,1],[24,1],[25,1],[102,1],[103,1]],  # D_8(a_2)
       [[8,1],[28,1],[23,1],[24,1],[25,1],[30,1],[102,1]],           # D_6+A_1
       [[20,1],[21,1],[28,1],[23,1],[24,1],[10,1],[40,1],[103,1]],   # A_7
       [[20,1],[21,1],[28,1],[23,1],[24,1],[19,1],[103,1]],          # (A_7)_3
       [[20,1],[21,1],[28,1],[23,1],[31,1],[101,1],[102,1]],         # E_6(a_1)+A_1
       [[1,1],[28,1],[29,1],[30,1],[31,1],[101,1]],                  # D_6
       [[20,1],[21,1],[28,1],[29,1],[25,1],[31,1],[103,1]],          # D_7(a_2)
       [[20,1],[21,1],[23,1],[31,1],[101,1],[102,1]],                # E_6(a_1)
       [[26,1],[28,1],[27,1],[29,1],[30,1],[31,1],[102,1],[103,1]],  # D_5+A_2
#       [[26,1],[28,1],[27,1],[29,1],[30,1],[31,1],[102,1]],          # (D_5+A_2)_2
       [[20,1],[21,1],[28,1],[29,1],[30,1],[31,1],[105,1]],          # A_6+A_1
       [[28,1],[27,1],[29,1],[30,1],[31,1],[39,1],[102,1]],          # D_6(a_1)+A_1
       [[28,1],[29,1],[33,1],[31,1],[34,1],[101,1]],                 # D_6(a_1)
       [[29,1],[21,1],[20,1],[30,1],[31,1],[105,1]],                 # A_6
#       [[32,1],[33,1],[30,1],[32,1],[40,1],[101,1]],                 # D_5+A_1        ??? two times 32
       [[26,1],[29,1],[35,1],[38,1],[30,1],[44,1],[47,1],[105,1]],   # 2A_4           ? 26
       [[32,1],[37,1],[29,1],[31,1],[34,1],[105,1],[107,1]],         # A_5+A_2
       [[32,1],[37,1],[27,1],[33,1],[40,1],[36,1],[105,1]],          # A_5+2A_1
       [[32,1],[29,1],[31,1],[34,1],[106,1],[108,1]],                # D_6(a_2)
       [[30,1],[31,1],[32,1],[33,1],[101,1]],                        # D_5
       [[37,1],[33,1],[40,1],[34,1],[36,1],[41,1],[105,1]],          # D_5(a_1)+A_2   ? 26/20
       [[26,1],[27,1],[40,1],[41,1],[106,1],[107,1]],                # (A_5+A_1)'
       [[32,1],[27,1],[37,1],[33,1],[36,1],[105,1]],                 # (A_5+A_1)''
       [[37,1],[38,1],[40,1],[49,1],[41,1],[104,1],[108,1]],         # D_4+A_2
 #      [[37,1],[38,1],[40,1],[49,1],[41,1],[104,1]],                 # (D_4+A_2)_2
       [[37,1],[38,1],[40,1],[34,1],[36,1],[106,1],[107,1]],         # A_4+A_3
       [[20,1],[21,1],[49,1],[106,1],[107,1]],                       # A_5
       [[37,1],[42,1],[43,1],[44,1],[45,1],[103,1]],                 # D_5(a_1)+A_1
       [[37,1],[38,1],[39,1],[40,1],[41,1],[108,1],[109,1]],         # A_4+A_2+A_1

       [[38,1],[40,1],[39,1],[41,1],[108,1],[109,1]],       # A_4+A_2
       [[42,1],[43,1],[48,1],[49,1],[102,1]],               # D_5(a_1)
       [[47,1],[48,1],[49,1],[53,1],[101,1]],               # D_4+A_1
       [[42,1],[43,1],[44,1],[45,1],[107,1],[108,1]],       # A_4+2A_1
       [[47,1],[48,1],[49,1],[101,1]],                      # D_4
       [[42,1],[48,1],[49,1],[106,1],[107,1]],              # A_4+A_1
       [[37,1],[38,1],[39,1],[49,1],[108,1],[113,1]],       # 2A_3
       [[42,1],[48,1],[106,1],[107,1]],                     # A_4
       [[42,1],[44,1],[48,1],[49,1],[110,1],[113,1]],       # D_4(a_1)+A_2
       [[46,1],[47,1],[48,1],[49,1],[112,1],[113,1]],       # A_3+A_2+A_1
       [[46,1],[47,1],[48,1],[112,1],[116,1],[119,1]],      # A_3+A_2
#       [[46,1],[47,1],[48,1],[112,1],[116,1]],              # (A_3+A_2)_2
       [[53,1],[47,1],[48,1],[115,1],[116,1]],              # D_4(a_1)+A_1
       [[53,1],[54,1],[55,1],[112,1],[113,1]],              # A_3+2A_1
       [[47,1],[48,1],[115,1],[116,1]],                     # D_4(a_1)
       [[53,1],[54,1],[55,1],[117,1],[118,1],[119,1]],      # 2A_2+2A_1
       [[55,1],[56,1],[112,1],[113,1]],                     # A_3+A_1
       [[56,1],[57,1],[117,1],[118,1],[119,1]],             # 2A_2+A_1
       [[63,1],[106,1],[107,1]],                            # A_3
       [[56,1],[57,1],[117,1],[118,1]],                     # 2A_2
       [[60,1],[126,1],[127,1],[128,1]],                    # A_2+2A_1
       [[58,1],[59,1],[123,1],[124,1],[125,1]],             # A_2+3A_1
       [[63,1],[128,1],[129,1]],                            # A_2+A_1
       [[127,1],[130,1]],                                   # A_2
       [[63,1],[135,1],[136,1],[137,1]],                    # 4A_1
       [[141,1],[142,1],[143,1]],                           # 3A_1
       [[150,1],[151,1]],                                   # 2A_1
       [[157,1]]                                            # A_1
       ];

labels:=["E_8",
         "E_8(a_1)",
         "E_8(a_2)",
         "E_7+A_1",
         "E_7",
         "D_8",
         "E_7(a_1)+A_1",
         "E_7(a_1)",
         "D_8(a_1)",
         "D_7",
         "E_7(a_2)+A_1",
         "E_7(a_2)",
         "A_8",
         "E_6+A_1",
         "D_7(a_1)",
#         "(D_7(a_1))_2",
         "E_6",
         "D_8(a_2)",
         "D_6+A_1",
         "A_7",
         "(A_7)_3",
         "E_6(a_1)+A_1",
         "D_6",
         "D_7(a_2)",
         "E_6(a_1)",
         "D_5+A_2",
#         "(D_5+A_2)_2",
         "A_6+A_1",
         "D_6(a_1)+A_1",
         "D_6(a_1)",
         "A_6",
#         "D_5+A_1",
         "2A_4",
         "A_5+A_2",
         "A_5+2A_1",
         "D_6(a_2)",
         "D_5",
         "D_5(a_1)+A_2",
         "(A_5+A_1)'",
         "(A_5+A_1)''",
         "D_4+A_2",
#         "(D_4+A_2)_2",
         "A_4+A_3",
         "A_5",
         "D_5(a_1)+A_1",
         "A_4+A_2+A_1",

         "A_4+A_2",
         "D_5(a_1)",
         "D_4+A_1",
         "A_4+2A_1",
         "D_4",
         "A_4+A_1",
         "2A_3",
         "A_4",
         "D_4(a_1)+A_2",
         "A_3+A_2+A_1",
         "A_3+A_2",
#         "(A_3+A_2)_2",
         "D_4(a_1)+A_1",
         "A_3+2A_1",
         "D_4(a_1)",
         "2A_2+2A_1",
         "A_3+A_1",
         "2A_2+A_1",
         "A_3",
         "2A_2",
         "A_2+2A_1",
         "A_2+3A_1",
         "A_2+A_1",
         "A_2",
         "4A_1",
         "3A_1",
         "2A_1",
         "A_1",
         ];

I:=[ [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ] ];#, [  ], [  ], [  ], [  ], [  ] ];

II:=[ [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ] ];#, [  ], [  ], [  ], [  ], [  ] ];

tori:=[ [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ], [  ] ];#, [  ], [  ], [  ], [  ], [  ] ];

#blocks:=[];
blocks:=[[[55, 1], [45, 1], [39, 1], [27, 3], [19, 1], [9, 1]], [[27, 8], [25, 1], [7, 1]], [[27, 6], [25, 1], [21, 1], [19, 1], [9, 2], [3, 1]], [[27, 4], [25, 1], [19, 1], [18, 2], [15, 1], [12, 2], [9, 2], [3, 1]], [[27, 3], [26, 2], [19, 1], [18, 2], [15, 1], [12, 2], [9, 2], [1, 3]], [[27, 2], [25, 1], [21, 2], [18, 2], [15, 2], [12, 2], [9, 3], [7, 1], [3, 1]], [[27, 1], [21, 1], [19, 2], [18, 4], [15, 1], [9, 8], [3, 1]], [[27, 1], [20, 2], [19, 1], [18, 4], [15, 1], [9, 8], [1, 3]], [[19, 1], [15, 8], [9, 9], [3, 8], [2, 2]], [[23, 1], [22, 2], [19, 1], [16, 2], [15, 1], [13, 3], [12, 2], [11, 1], [10, 2], [7, 1], [4, 2], [3, 1], [1, 3]], [[19, 1], [18, 4], [15, 1], [12, 2], [9, 12], [7, 1], [3, 1]], [[19, 1], [18, 4], [15, 1], [12, 2], [9, 11], [8, 2], [1, 3]], [[19, 1], [18, 2], [15, 3], [13, 3], [9, 9], [7, 1], [6, 2], [3, 3]], [[19, 1], [15, 8], [9, 9], [3, 8], [2, 2]], [[19, 1], [17, 2], [15, 3], [12, 2], [11, 4], [9, 5], [6, 4], [3, 4], [1, 1]], [[19, 1], [15, 8], [9, 9], [3, 7], [1, 7]], [[9, 25], [8, 2], [2, 2], [1, 3]], [[19, 1], [17, 1], [16, 2], [15, 2], [12, 2], [11, 2], [10, 4], [9, 3], [6, 4], [3, 2], [2, 2], [1, 3]], [[9, 3], [7, 5], [6, 16], [5, 3], [3, 24], [1, 3]], [[9, 25], [8, 2], [2, 2], [1, 3]], [[9, 26], [7, 1], [3, 1], [2, 2]], [[19, 1], [16, 4], [15, 1], [11, 5], [10, 4], [9, 2], [6, 4], [3, 1], [1, 10]], [[9, 23], [7, 1], [6, 2], [5, 2], [4, 2], [3, 1], [1, 1]], [[9, 26], [7, 1], [1, 7]], [[9, 21], [7, 2], [6, 4], [3, 7]], [[9, 19], [8, 2], [7, 4], [6, 2], [3, 6], [1, 3]], [[9, 20], [8, 2], [7, 1], [6, 4], [3, 6], [1, 3]], [[9, 19], [8, 4], [6, 4], [3, 5], [1, 6]], [[9, 19], [7, 8], [3, 5], [1, 6]], [[9, 14], [7, 2], [6, 8], [5, 6], [3, 10]], [[9, 13], [8, 2], [7, 1], [6, 8], [5, 3], [4, 6], [3, 6], [1, 3]], [[9, 10], [7, 1], [6, 16], [3, 17], [2, 2]], [[9, 13], [7, 5], [6, 4], [5, 5], [4, 8], [3, 3], [1, 6]], [[9, 19], [7, 8], [1, 21]], [[9, 9], [8, 2], [6, 16], [3, 17], [2, 2]], [[9, 9], [8, 2], [6, 16], [3, 16], [2, 2], [1, 3]], [[9, 10], [7, 1], [6, 16], [3, 16], [1, 7]], [[9, 3], [8, 8], [7, 6], [6, 10], [3, 8], [2, 8], [1, 15]], [[9, 7], [8, 2], [7, 6], [6, 6], [5, 6], [4, 6], [3, 10], [2, 2], [1, 3]], [[9, 9], [8, 2], [6, 16], [3, 15], [1, 10]], [[9, 5], [8, 6], [7, 4], [6, 12], [3, 11], [2, 8], [1, 6]], [[9, 3], [8, 2], [7, 1], [6, 18], [5, 3], [3, 25]], [[9, 3], [7, 5], [6, 16], [5, 3], [3, 24], [1, 3]], [[9, 3], [8, 8], [7, 6], [6, 10], [3, 8], [2, 8], [1, 15]], [[9, 2], [8, 6], [7, 13], [6, 6], [3, 2], [2, 14], [1, 21]], [[9, 1], [8, 4], [7, 3], [6, 12], [5, 7], [4, 4], [3, 17], [2, 4], [1, 4]], [[9, 2], [7, 25], [3, 1], [1, 52]], [[9, 1], [8, 2], [7, 7], [6, 8], [5, 9], [4, 6], [3, 12], [2, 6], [1, 9]], [[8, 4], [7, 6], [6, 4], [5, 10], [4, 16], [3, 6], [2, 4], [1, 10]], [[9, 1], [7, 11], [5, 21], [3, 11], [1, 24]], [[7, 1], [6, 14], [5, 6], [3, 42], [1, 1]], [[7, 1], [6, 14], [5, 3], [4, 6], [3, 37], [2, 2], [1, 3]], [[7, 1], [6, 12], [5, 5], [4, 8], [3, 34], [1, 10]], [[7, 1], [6, 8], [5, 12], [4, 6], [3, 28], [2, 8], [1, 9]], [[7, 1], [6, 6], [5, 11], [4, 14], [3, 19], [2, 12], [1, 13]], [[7, 1], [6, 2], [5, 24], [3, 27], [1, 28]], [[3, 80], [2, 4]], [[7, 1], [6, 2], [5, 15], [4, 18], [3, 10], [2, 14], [1, 24]], [[3, 79], [2, 2], [1, 7]], [[7, 1], [5, 11], [4, 32], [3, 1], [1, 55]], [[3, 78], [1, 14]], [[3, 65], [2, 16], [1, 21]], [[3, 70], [2, 14], [1, 10]], [[3, 58], [2, 20], [1, 34]], [[3, 57], [1, 77]], [[3, 44], [2, 40], [1, 36]], [[3, 31], [2, 50], [1, 55]], [[3, 14], [2, 64], [1, 78]], [[3, 1], [2, 56], [1, 133]]];

#ords:=[];
ords:=[ 81, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 9, 27, 9, 9, 9, 27, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 9, 3, 9, 3, 3, 3, 3, 3, 3, 3, 3, 3 ];

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


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

same_params := (pat1, targ, pat2) -> pat1.target(targ).cond(e->e.params = pat2.val.params);
one_by_one := x -> x.range() = 1 and x.domain() = 1;

# does not work with .cond (!!!) NOTE
Enum(100, x->@(x), @z, @n, @m, @k, @l, @j, @g, @phi, @r, @s, @ss, @b, @bb);
Enum(200, x->@(x), @M, @N, @R, @S, @W, @F, @G, @D);

IsIndexMapping := x -> IsBound(x._perm) and x._perm;

# L^mn_n
ltensor_flip := function(match, mn, n)
    local m, i, pos, dom, ldom, lran, ll, rr, res, ldom;
    dom := Product(match, x->x.domain());
    ldom := 1; lran := 1; pos := 1;
    while lran<>n do
        lran:=lran*range(match[pos]);
        ldom:=ldom*domain(match[pos]);
	pos:=pos+1;
    od;
    ll := match{[1..pos-1]};
    rr := match{[pos..Length(match)]};
    res := fTensor(Concatenation(rr, ll));

    if ldom=1 or ldom=dom then
    return res;
    else
    return fCompose(res, L(dom, ldom));
    fi;
end;

# for given diagDirsum looking for child which relative domain start <= offset and relative domain end >= (offset + domain)
# returns [child index, offset relative to child]
_findDirsumChild := function( dirsum, offset, domain)
    local i, ch, d;
    ch := dirsum.children();
    d := 0;
    for i in [1..Length(ch)] do
        if offset >= d then
            d := d + ch[i].domain();
            if offset + domain <= d then
                return [i, offset - d + ch[i].domain()];
            fi;
        else
            return [0, 0];
        fi;
    od;
    return [0, 0];
end;

# *******************************************************************
Class(RulesFuncSimp, RuleSet);
RewriteRules(RulesFuncSimp, rec(
 # ===================================================================
 # Operator flattening and identity
 # ===================================================================
 FlattenTensor  := ARule(fTensor,  [@(1, fTensor) ], e -> @(1).val.children()),
 FlattenCompose := ARule(fCompose, [@(1, fCompose)], e -> @(1).val.children()),

 ComposeId1 := ARule(fCompose, [@(1), fId ], e -> [@(1).val]),
 ComposeId2 := ARule(fCompose, [fId,  @(1)], e -> [@(1).val]),

 fBase_1x1 := Rule(@(1, fBase, one_by_one), e->fId(1)),

 fId_drop_Value := Rule([@(1, fId), @(2, Value)], e->fId(@(2).val.v)),

 Const_fbase := ARule(fCompose, [@(1), @(2, fBase, e -> IsInt(e.params[2]))],
     e -> [ When(IsInt(@(1).val.range()),
                 fBase(@(1).val.range(), @(1).val.at(@(2).val.params[2])),
                 fConst(@(1).val.range(), 1, @(1).val.at(@(2).val.params[2]))) ]),

 Compose1x1_1 := ARule(fCompose, [@(1).cond(one_by_one), @(2)],  e -> [@(2).val]),
 Compose1x1_2 := ARule(fCompose, [@(2), @(1).cond(one_by_one) ], e -> [@(2).val]),

 TensorId1 := ARule(fTensor, [@(1), [@(2,[fId,J]), 1]], e -> [@(1).val]),
 TensorId2 := ARule(fTensor, [[@(2,[fId,J]), 1], @(1)], e -> [@(1).val]),

 TensorId1V := ARule(fTensor, [@(1), [@(2,[fId,J]), @(3, Value, e->e.v=1)]], e -> [@(1).val]),
 TensorId2V := ARule(fTensor, [[@(2,[fId,J]), @(3, Value, e->e.v=1)], @(1)], e -> [@(1).val]),

 diagTensorId1  := ARule(diagTensor, [@(1), [fConst, @(2), 1, 1]], e -> [@(1).val]),
 diagTensorIdV1 := ARule(diagTensor, [@(1), [fConst, @(2), 1, _1]], e -> [@(1).val]),
 diagTensorId2  := ARule(diagTensor, [[fConst, @(2), 1, 1], @(1)], e -> [@(1).val]),
 diagTensorIdV2 := ARule(diagTensor, [[fConst, @(2), 1, _1], @(1)], e -> [@(1).val]),

 diagTensorZero1  := ARule(diagTensor, [@(1), [fConst, @(2), 1, 0]], e -> [fConst(@(1).val.domain(), 0)]),
 diagTensorZeroV1 := ARule(diagTensor, [@(1), [fConst, @(2), 1, _0]], e -> [fConst(@(1).val.domain(), 0)]),
 diagTensorZero2  := ARule(diagTensor, [[fConst, @(2), 1, 0], @(1)], e -> [fConst(@(1).val.domain(), 0)]),
 diagTensorZeroV2 := ARule(diagTensor, [[fConst, @(2), 1, _0], @(1)], e -> [fConst(@(1).val.domain(), 0)]),

 DropL := Rule(@(1, [L,OS], e -> e.params[2] = 1 or e.params[2] = e.params[1]), e -> fId(@1.val.params[1])),
 DropTr := Rule(@(1, Tr, e -> e.params[1] = 1 or e.params[2] = 1), e -> fId(@1.val.domain())),

 IP_toI  := Rule([IP, @(2), fId], e -> fId(@(2).val)),
 J_1   := Rule([J, 1], e->fId(1)),
 OS_2  := Rule([OS, 2, @], e->fId(2)),

 OS_fAdd := ARule(fCompose, [ [OS, @(1), @(2).cond(e -> e in [@(1).val-1, -1])],
                              [fAdd, @(3), @(4).cond(e -> e = @(3).val - 1), 1] ],
     e -> [ fAdd(@(3).val, @(4).val, 1), J(@(4).val) ]),

 Lfold := ARule(fCompose, [@(1,L), @(2,L),e->let(
             prod := @(1).val.params[2] * @(2).val.params[2],
             a:=@(1).val.params[1],
             When(prod < a, prod in FactorsInt(a), (prod / a) in FactorsInt(a)))],
     e -> let(
         prod := @(1).val.params[2] * @(2).val.params[2], a:=@(1).val.params[1],
         [ L(a, When(prod < a, prod, prod / a)) ])),

 Hfold :=  ARule(fCompose, [@(1,H), @(2,H)],
     e-> [H(@(1).val.params[1],
             @(2).val.params[2],
             @(1).val.params[3]+@(2).val.params[3]*@(1).val.params[4],
             @(1).val.params[4]*@(2).val.params[4])]),

 # ===================================================================
 # Diagonal Functions
 # ===================================================================
 ComposePrecompute := Rule([fCompose, ..., [fPrecompute, @(1)], ...],
     e -> fPrecompute(ApplyFunc(fCompose, List(e.children(),
         x->When(ObjId(x)=fPrecompute, x.child(1), x))))),

 PrecomputePrecompute := Rule([fPrecompute, [fPrecompute, @(1)]], e->fPrecompute(@(1).val)),

 # drop diagDirsum when H refers to only one its child
 drop_diagDirsum_H := ARule( fCompose, [ @(1, diagDirsum), @(2, H, x -> x.params[4] = 1 and _findDirsumChild(@(1).val, x.params[3], x.params[2])[1]>0)],
     e -> let( f := _findDirsumChild(@(1).val, @(2).val.params[3], @(2).val.params[2]),
               obj := @(1).val.children()[f[1]],
               [ obj, H(obj.domain(), @(2).val.params[2], f[2], 1) ] )),

 RCData_fCompose_TReal := Rule([RCData, [@(1,fCompose), @(2).cond(e->e.range = TReal), ...]],
     e -> fCompose(RCData(@(2).val), diagTensor(fCompose(Drop(@(1).val.children(),1)), fId(2)))),

 RCData_fCompose_TInt := Rule([RCData, [@(1,fCompose), @(2).cond(e->e.range = TInt), ...]],
     e -> fCompose(RCData(@(2).val), fTensor(fCompose(Drop(@(1).val.children(),1)), fId(2)))),

# RCData_fCompose := Rule([RCData, [@(1,fCompose), @(2), ...]],
#     e -> fCompose(RCData(@(2).val), fTensor(fCompose(Drop(@(1).val.children(),1)), fId(2)))),

 RCData_Precompute := Rule([RCData, [fPrecompute, @(1)]], e->fPrecompute(RCData(@(1).val))),
 RCData_CRData     := Rule([RCData, [CRData, @(1)]], e -> @(1).val),
 CRData_RCData     := Rule([CRData, [RCData, @(1)]], e -> @(1).val),

 FConj_Precompute := Rule([@(0,[FConj,FRConj]), [fPrecompute, @(1)]], e->fPrecompute(ObjId(@(0).val)(@(1).val))),

 ComposeConstX := ARule(fCompose, [@(1,fConst), @(2)],
     e -> [fConst(@(1).val.params[1], @(2).val.domain(), @(1).val.params[3])]),

 fAdd0 := Rule([fAdd, @(1), @(2).cond(e->e=@(1).val), 0], e->fId(@(1).val)),

 fAddPair := ARule(fCompose, [@(1, fAdd), @(2, fAdd)],
     e -> [ fAdd(@(1).val.range(), @(2).val.domain(),
             @(1).val.params[3] + @(2).val.params[3]) ]),

 fTensor_fAdd_H := ARule(fTensor, [ [@(1, fAdd),@, _1, @], @(2, H)],
     e -> [ H(@(1).val.params[1] * @(2).val.params[1],
              @(2).val.params[2],
              @(2).val.params[1] * @(1).val.params[3] + @(2).val.params[3],
              @(2).val.params[4]) ]),

 # ===================================================================
 # fTensor
 # ===================================================================
 # fId(m) (X) fId(n) -> fId(m*n)
  TensorIdId := ARule(fTensor, [@(1,fId), @(2,fId)],
    e -> [ fId(@(1).val.params[1] * @(2).val.params[1]) ]),

  TensorId1 := ARule(fTensor, [@(1, fId, x->x.params[1]=1)],
    e -> []),

 # L(mn,m) o (fBase(m,j) (X) f) -> f (X) fBase(j,m)
 LTensorFlip := ARule(fCompose,
      [ @(1,L), [ @(3,fTensor), @(2).cond(e->range(e) = @(1).val.params[2] and domain(e)=1), ...] ],
 	e -> [ fTensor(Copy(Drop(@(3).val.children(), 1)), Copy(@(2).val)) ] ),

 # L(mn,n) o f (X) fBase(j,m) -> (fBase(m,j) (X) f)
 LTensorFlip1 := ARule(fCompose,
      [ @(1,L), [ @(3,fTensor), ...,
             @(2, fBase, e->range(e) = @(1).val.params[1]/@(1).val.params[2]) ]],
    e -> [fTensor(Copy(Last(@(3).val.children())), Copy(DropLast(@(3).val.children(), 1)))] ),

 L_H := ARule(fCompose, [ @(1, L), [ @(2, fTensor), @(3, fBase), @(4, fId, e->IsInt(@(1).val.params[1]/(@(1).val.params[2] * e.params[1])))] ],
    e-> [ H(@(1).val.params[1], @(4).val.params[1],
            @(4).val.params[1] * @(1).val.params[2] * imod(@(3).val.params[2], @(1).val.params[1] / (@(4).val.params[1] * @(1).val.params[2])) +
            idiv(@(3).val.params[2], @(1).val.params[1] / (@(4).val.params[1] * @(1).val.params[2])),
            @(1).val.params[2]) ]),

  Refl0_u_H0 := ARule(fCompose, [@(1, Refl0_u), @(2, H, e -> e.params[3]=0 and e.params[4]=1)], e -> [ let(
     k := @(1).val.params[1],
     H(@(1).val.range(), @(2).val.domain(), 0, k)) ]),

  Refl0_u_Hrest := ARule(fCompose, [
          @(1, Refl0_u),
          @(2, H, e -> e.params[3]=@(1).val.params[2] and e.params[4]=1),
          [fTensor, @(3,fBase), @(4, fId, e->e.params[1]=@(1).val.params[2])]],
      e -> [ let(k := @(1).val.params[1],
              BH(@(1).val.range(), 2*@(1).val.range(), @(4).val.domain(), 1+@(3).val.params[2], 2*k)) ]),

  Refl0_u_Hrest_1it := ARule(fCompose, [
          @(1, Refl0_u),
          @(2, H, e -> e.params[3]=@(1).val.params[2] and e.params[4]=1 and e.params[3]=e.params[2]) ],
      e -> [ let(k := @(1).val.params[1],
              BH(@(1).val.range(), 2*@(1).val.range(), @(2).val.domain(), 1, 2*k)) ]),

  Refl1_H := ARule(fCompose, [@(1, Refl1), [fTensor, @(2,fBase), @(3, fId, e->e.params[1]=@(1).val.params[2])]],
      e -> let(
          k := @(1).val.params[1],
          [ BH(@(1).val.range(), 2*@(1).val.range() - 1, @(3).val.domain(), @(2).val.params[2], 2*k) ])),

  fTensor_X_fId_H := ARule(fCompose, [[@(1, fTensor), ..., [fId, @(2)]], # NOTE: assumes d|base
        [@(3, H), @(4).cond(e->_divides(@(2).val,e)), @(5).cond(e->_divides(@(2).val,e)),
                  @(6).cond(e->_divides(@(2).val,e)), _1]], e ->
       let(p := @(3).val.params, d := @(2).val, base := p[3],
           [ @(1).val, fTensor(H(p[1]/d, p[2]/d, base/d, 1), fId(d)) ])),

 TrTensor := ARule(fCompose, [@(1, Tr), [ fTensor, @(2), @(3).cond(e->e.range()=@(1).val.params[1]) ]],
     e -> [ fCompose(fTensor(@(3).val, @(2).val), Tr(@(3).val.domain(), @(2).val.domain())) ]
 ),

 LTensorGeneral := ARule(
fCompose,
[@(1,[L,Tr]),
 @(2,fTensor,
 e -> let(
    p := @(1).val.params,
    a := When(ObjId(@(1).val)=Tr, p[1], p[1]/p[2]),
    b := p[2],
    ForAll(e.children(), x->AnySyms(x.domain(), x.range()) or x.domain()>1 and x.range()>1) and # workaround old fId(1) bug
    full_merge_tensor_chains(@(3), [b, a], e.children(), (x,y)->y,
 Product, fTensor,
                             fId, x->x, x->x, range) <> false))],
     e -> [ ltensor_flip(@(3).val, @(1).val.params[1], @(1).val.params[2]) ]
 ),

 # fTensor o fTensor -> fTensor( ..o.., ..o.. , ...)
 TensorMerge := ARule(fCompose,
      [ @(1,fTensor), @(2,fTensor,e->full_merge_tensor_chains(
          @(3), @(1).val.children(), e.children(),
                fCompose, fTensor, fTensor, x->x, x->x, domain, range) <> false) ],
 e -> [ fTensor(@(3).val) ]
 ),

 TensorMerge_fIdInt := ARule(fCompose,
      [ @(1,fTensor,e->let(l1:=Last(e.children()), ObjId(l1)=fId and IsInt(l1.domain()))),
        @(2,fTensor, e->let(l1:=Last(@(1).val.children()), l2 := Last(e.children()), IsInt(l2.domain()) and ObjId(l2)=fId and Gcd(l1.domain(), l2.domain())>1))],
        e -> let(l1 := Last(@(1).val.children()).domain(), l2 := Last(@(2).val.children()).domain(), gcd := Gcd(l1, l2),
            [ fTensor(fCompose(fTensor(DropLast(@(1).val.children(), 1), fId(l1/gcd)), fTensor(DropLast(@(2).val.children(), 1), fId(l2/gcd))), fId(gcd)) ])
    ),

 # diagTensor o fTensor -> diagTensor( ..o.., ..o.. , ...)
 diagTensorMerge := ARule(fCompose,
      [ @(1,diagTensor), @(2,fTensor,e->full_merge_tensor_chains(
          @(3), @(1).val.children(), e.children(),
                fCompose, diagTensor, fTensor, x->x, x->fConst(range(x), 1), domain, range) <> false) ],
 e -> [ diagTensor(@(3).val) ]
 ),

 # fTensor(..., Y, ...) o X -> fTensor(..., Y o X, ...)
 TensorComposeMergeRight := ARule(fCompose,
      [ @(1,fTensor), @(2).cond(e -> compat_tensor_chains(
                                @(1).val.children(), [e], domain, range)) ],
 e -> [ fTensor(merge_tensor_chains(
         @(1).val.children(), [@(2).val], fCompose, x->x, x->x, domain, range)) ]
 ),

 # X o fTensor(..., Y, ...) -> fTensor(..., X o Y, ...)
 TensorComposeMergeLeft := ARule(fCompose,
      [ @(1), @(2,fTensor,e-> IsInt(@(1).val.range()) and compat_tensor_chains(  # NOTE: BAD HACK!!! Cannot do that with diag functions...
                             [@(1).val], e.children(), domain, range)) ],
 e -> [ fTensor(merge_tensor_chains(
         [@(1).val], @(2).val.children(), fCompose, x->x, x->x, domain, range)) ]
 ),

 # [fBase,fId] X (fB o fAny) -> fB2 o (fI X fAny)
 TensorB := ARule(fTensor, [
        @(1, [fBase, fId], e -> Is2Power(e.range())),
        @(2, fCompose, e -> ObjId(e.child(1)) = fB)
    ],
    e -> [fCompose(
        let(i := @(1).val,
            b := @(2).val.child(1),
            fB(i.range() * b.range(), List(b.params[3], e -> Log2Int(i.range()) + e))
        ),
        fTensor(
            @(1).val,
            @(2).val.child(2)
        )
    )]
 ),

 # ===================================================================
 # Other
 # ===================================================================

 # primitive constant folding for functions
 Compose_FList_const := ARule(fCompose, [@(1, FList), @(2).cond(x->x.free()=[])],
     e -> let(
	 lst := @(1).val,  idx := List(@(2).val.tolist(), EvalScalar),
	 [ FList(lst.t, lst.list{1+idx}) ])),

 # fCond o f  (note: fCond o fCond should only be handled by Compose_fCond_lft)
 Compose_fCond_rt := ARule(fCompose, [[fCond, @(1), @(2), @(3)], @(4).cond(e->ObjId(e)<>fCond)],
     e -> [ fCond(fCompose(@(1).val, @(4).val), fCompose(@(2).val, @(4).val), fCompose(@(3).val, @(4).val)) ]),

 Compose_fCond_lft := ARule(fCompose, [@(4), [fCond, @(1), @(2), @(3)]],
     e -> [ fCond(@(1).val, fCompose(@(4).val, @(2).val), fCompose(@(4).val, @(3).val)) ]),

 fCond_fold0  := Rule([fCond, [fConst, @, @,  0], @(2), @(3)], e -> @(3).val),
 fCond_foldV0 := Rule([fCond, [fConst, @, @, _0], @(2), @(3)], e -> @(3).val),

 fCond_fold1  := Rule([fCond, [fConst, @, @,  1], @(2), @(3)], e -> @(2).val),
 fCond_foldV1 := Rule([fCond, [fConst, @, @, _1], @(2), @(3)], e -> @(2).val),

 # B2 o fTensor

    fCompose_B2_fTensor := ARule(fCompose, [@(1,B2), @(2,fTensor)],
        e -> [fB2(@(1).val.getES(), @(2).val.children())]
    ),

 # L(abc,b) o L(abc,c) -> L(abc,bc)
 fCompose_Tr := ARule( fCompose, [ [@(1, [Tr, L]), @, @(2)], [@(3, [Tr, L]), @, @(4).cond( x -> let( abc := @(1).val.range(), @(3).val.domain() = abc and (abc mod (@(2).val*x) = 0)))]],
     e -> let( abc := @(1).val.range(), bc := @(2).val*@(4).val,
         When( ObjId(@(1).val) = L, [L(abc, bc)], [Tr(abc/bc, bc)] ))),

 fDirsum_fIds := ARule( fDirsum, [@(1, fId), @(2, fId)], e -> [fId(@(1).val.range()+@(2).val.range())]),

));


# Copyright 2018-2019, Carnegie Mellon University
# See LICENSE for details

Class(SIMDchain, chain);

update_opts_params:= function(opts, new_param)
   opts.params := opts.params::[new_param];
end;

update_opts_includes:= function(opts, new_param)
   opts.includes := opts.includes::[new_param];
end;

Class(HCOLFuncGen, rec(
    generate := (self, ss, opts) >>  let(
          err_chk := When(opts.errorCheck,
            let( x:= var.fresh_t("x", T_Real(32)), j := Ind(1),
                 ch := List(Filtered(opts.params, v->v.t in [T_Real(32), T_Real(64)]),
                                        vv-> PointWise(1, Lambda([x, j], cond(isinf(vv), 1, cond(isnan(vv), 2, 0))))),
                 n := Length(ch),
                 t :=
                 OLCompose(
                    VStack(
                        Reduction(n, (a, b)->add(a, b), V(0), False),
                        I(n)
                    ),
                    VStack(    ch )
                 ),
                 tt := Rewrite(SumsSPL(t, opts), [RulesSumsHCOL, RulesTerminateReductionHCOL, RulesSumsHCOL], opts),
                 rtn_var := var("err", TPtr(TBool)), rtn := var("err_rtn", TBool),
                 update_opts_params(opts, rtn_var),
                 update_opts_includes(opts, "<math.h>"),
                 decl([rtn],
                    chain(
                      SubstBottomUp(opts.codegen.OLCompose(tt, rtn_var, self.getX(opts), opts),
                                    [nth, @(4, var, e->e.id = rtn_var.id), @(5, Value, e->e.v=0)], e->rtn),
                      creturnCond(neq(rtn, 0), -2)
                 ))),
            chain([])),

          code := opts.codegen.(ss.name)(ss, self.getY(opts), self.getX(opts), opts),

          finalCode := When(opts.useCReturn,
                let( w:= var.fresh_t("w", self.getRetType(opts)),
                     decl([w],
                        chain(
                            When(opts.errorCheck, err_chk, chain([])),
                            SIMDchain(
                                SubstBottomUp(code,
                                    [nth, @(2, var, e->e.id = self.getY(opts).id),
                                          @(3, Value, e->e.v=0)], e->w),
                               creturn(w))))),
             SIMDchain(err_chk, code)),

        func(self.getRetType(opts), "transform", self.getParams(finalCode, opts), finalCode)) ,

        getParams := (self, fc, opts) >> let(

            y := self.getY(opts), x := self.getX(opts),
            usedX := Length(Collect(fc, @(1, var, e->e.id=x.id)))>0,
            Cond(
                opts.useCReturn and not usedX,       opts.params,
                not opts.useCReturn and not usedX,   [y]::opts.params,
                opts.useCReturn and usedX,           [x]::opts.params,
                not opts.useCReturn and usedX,       [y, x]::opts.params
        )
    ),
    getRetType := (self, opts) >> When(opts.useCReturn, opts.YType.t, TVoid),
    getX :=  (self, opts) >> CopyFields(X, rec(t:=opts.XType)),
    getY :=  (self, opts) >> CopyFields(Y, rec(t:=opts.YType))
));