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

BlocksInt := (n, min, max) ->
    List(Filtered([0..Log2Int(max)+1], i -> min <= (2^i) and (2^i) <= max and (2^i) < n), i->2^i);

# ---------
Class(divisorsIntNonTriv, AutoFoldExp, rec(
    ev := self >> DivisorsIntNonTriv(self.args[1].ev()),
    computeType := self >> TList(TInt)
));

Class(oddDivisorsIntNonTriv, AutoFoldExp, rec(
    ev := self >> Filtered(DivisorsIntNonTriv(self.args[1].ev()), IsOddInt),
    computeType := self >> TList(TInt)
));

Class(isPrime, AutoFoldExp, rec(
    ev := self >> let(a:=self.args[1].ev(), IsInt(a) and IsPrime(a)),
    computeType := self >> TBool
));

Class(hasOddDivisors, AutoFoldExp, rec(
    ev := self >> Filtered(DivisorsIntNonTriv(self.args[1].ev()), IsOddInt) <> [],
    computeType := self >> TBool
));

Class(divisorsIntNonSelf, AutoFoldExp, rec(
    ev := self >> [1] :: DivisorsIntNonTriv(self.args[1].ev()),
    computeType := self >> TList(TInt)
));

#F integersBetween(<min>, <max>)
#F    returns a list min..max, as a code object
#F
Class(integersBetween, AutoFoldExp, rec(
    ev := self >> [self.args[1].ev() .. self.args[2].ev()],
    computeType := self >> TList(TInt)
));

#F blocksInt(<n>, <min>, <max>)
#F    returns a list of possible block sizes min..max, as a code object
#F    block sizes is really any integers in the interval, that is less than <n>
#F    it should be defined in autolib .c files separately, depending on strategy, etc
#F    In Spiral, evaluation will use BlocksInt which will try 2-power sized blocks.
#F    This does not need to be consistent with autolib.c implementation.
#F
Class(blocksInt, AutoFoldExp, rec(
    ev := self >> BlocksInt(self.args[1].ev(), self.args[2].ev(), self.args[3].ev()),
    computeType := self >> TList(TInt)
));

# ---------------
# YSV NOTE: Refactor below as above
#
Class(rpDivisorsIntNonTriv, Exp, rec(computeType := self>> TPtr(TInt)));
Class(hasCoprimeFactors, Exp, rec(computeType := self >> TBool));

# ---------------
#DivisorsIntNonTrivSym := n ->
#    Cond(IsSymbolic(n), divisorsIntNonTriv(n), # inert form
#                        DivisorsIntNonTriv(EvalScalar(n))); # computes divisors

#DivisorsIntNonSelfSym := n ->
#    Cond(IsSymbolic(n), divisorsIntNonSelf(n), # inert form
#                        Concatenation([1],DivisorsIntNonTriv(EvalScalar(n)))); # computes divisors

RPDivisorsIntNonTrivSym := n ->
    Cond(IsSymbolic(n), rpDivisorsIntNonTriv(n), # inert form
                        RPDivisorsIntNonTriv(EvalScalar(n))); # computes divisors


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

# Here I try to be very clean, when defining functions.
# For example, no longer use .size since this often contains info from .params.
# Instead have explicit .domain / .range
# use checkParams instead of def, default def will just set .params
#

#F dLin(<N>, <a>, <b>, <t>) - interval -> diagonal linear scaling function
#F    f: i -> a*i + b,
#F    dom(f) = interval(0..N-1)
#F    range(f) = <t>, must be a type
#F
#F Example:
#F  spiral> dLin(8,1,1/2,TReal).tolist();
#F  [ 1/2, 3/2, 5/2, 7/2, 9/2, 11/2, 13/2, 15/2 ]
#F
Class(dLin, DiagFunc, rec(
    checkParams := (self, params) >> Checked(Length(params)=4,
	IsPosInt0Sym(params[1]), IsType(params[4]), params),
    lambda := self >> let(i:=Ind(self.params[1]), a := self.params[2], b := self.params[3],
	Lambda(i, a*i+b).setRange(self.params[4])),
    range := self >> self.params[4],
    domain := self >> self.params[1]
));

#F dOmega(<N>, <k>) - N-th root of unity diagonal function
#F   f : TInt -> Tcomplex : i -> omega(N, k*i)
#F
Class(dOmega, DiagFunc, rec(
    checkParams := (self, params) >> Checked(Length(params)=2,
	IsPosIntSym(params[1]), IsIntSym(params[2]), params),
    lambda := self >> let(i:=Ind(), Lambda(i, omega(self.params[1], self.params[2]*i)).setRange(TComplex)),
    range := self >> TComplex,
    domain := self >> TInt
));

Class(dOmegaPow, DiagFunc, rec(
    checkParams := (self, params) >> Checked(Length(params)=3,
	IsPosIntSym(params[1]), IsIntSym(params[2]), IsInt(params[3]), params),
    lambda := self >> let(i:=Ind(), Lambda(i, omega(self.params[1], (self.params[2]*i))^self.params[3]).setRange(TComplex)),
    range := self >> TComplex,
    domain := self >> TInt
));


# Checks whether the sum of two subspaces are hyperbolic
# given a quadratic form.
BindGlobal("IsHyperbolic", function(Q)
    local s;
    s := (Size(BaseField(Q)) - 1)^2;
    return function(x, y)
        return Size(Filtered(x+y, z -> not IsZero(z*Q*z))) = s;
    end;
end);

# Checks whether two subspaces of F_{r^2} are orthogonal
# given a sesquilinear form.
BindGlobal("IsOrthogonal", function(Q, r)
    local F;
    F := x -> List(x, y -> y^r);
    return function(x, y)
        return ForAll(Cartesian(x, y), z -> IsZero(z[1]*Q*F(z[2])));
    end;
end);

# The subset of isotropic spaces with respect to the quadratic form Q
# of the collection V.
BindGlobal("IsotropicSpacesQuadraticForm",
    Q -> V -> Filtered(V, y -> ForAll(y, x -> IsZero(x*Q*x)))
);

# The subset of nonisotropic spaces with respect to the quadratic form Q
# of the collection V for which the quadratic form evaluates to the same
# quadratic residue class as z.
BindGlobal("NonisotropicSpacesQuadraticForm", function(Q, z)
    return V -> Filtered(V, y -> ForAny(y, x -> x*Q*x = z));
end);

# The subset of isotropic spaces with respect to the bilinear form Q
# of the collection V.
BindGlobal("IsotropicSpacesBilinearForm",
    Q -> V -> Filtered(V,
                y -> ForAll(Cartesian(y, y), x -> IsZero(x[1]*Q*x[2])))
);

# The subset of isotropic spaces with respect to the scalar product with
# conjugation map f of the collection V.
BindGlobal("IsotropicSpacesSesquilinearForm", function(Q, r)
    local O;
    O := IsOrthogonal(Q, r);
    return V -> Filtered(V, y -> O(y, y));
end);


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

#F ExpandRotationsSPL33( <spl> )
#F   descends <spl> and replaces rotations by a product of three
#F   matrices such that multiplication with a vector requires
#F   3 adds and 3 mults rather than 2 adds and 4 mults. More
#F   precisely:
#F      x  y        1  1  0                        1 0
#F     -y  x   -->  0 -1  1  * diag(x-y, y, x+y) * 1 1
#F                                                 0 1
#F   Exceptions are the cases y = x and y = -x (angles +-pi/4)
#F   which are replaced by (2 adds and 2 mults)
#F
#F      x * F_2 * (1,2)   # y = x
#F      x * (1,2) * F_2   # y = -x
#F
ExpandRotationsSPL33 := S -> SubstTopDownNR(S, Rot, x->x.expandWinograd());

#F ExpandRotationsSPL33a( <spl> )
#F   descends <spl> and replaces rotations by a product of three
#F   matrices such that multiplication with a vector requires
#F   3 adds and 3 mults rather than 2 adds and 4 mults. More
#F   precisely:
#F     x y      1 (1-x)/y   1 0   1 (1-x)/y
#F    -y x      0   1       y 1   0   1
#F   Exceptions are the cases y = x and y = -x (angles +-pi/4)
#F   which are replaced by (2 adds and 2 mults)
#F
#F      x * F_2 * (1,2)   # y = x
#F      x * (1,2) * F_2   # y = -x
#F
ExpandRotationsSPL33a := S -> SubstTopDownNR(S, Rot, x->x.expandLifting());

#F ExpandRotationsSPL24( <spl> )
#F   descends <spl> and replaces rotations by the corresponding matrix,
#F   which requires (the maximum of) 2 additions and 4 multiplications.
#F
ExpandRotationsSPL24 := S -> SubstTopDownNR(S, Rot, x->x.expandDef());

ExpandRotationsSPLRandom := S -> SubstTopDownNR(S, Rot, x->x.expandRandom());

#F ExpandMonomialSPL( <spl> )
#F   descends <spl> and replaces monomials by products perm * diag.
#F
ExpandMonomialSPL :=
    S -> SubstTopDownNR(S, @.cond(s->ObjId(s)=Mon),
		 s-> Perm(s.element.perm, Length(s.element.diag)) *
                     Diag(s.element.diag));

#F The Exporting Functions
#F -----------------------
#F

#F ExpandRotationsSPL( <spl> )
#F
ExpandRotationsSPL := function ( S )
    Constraint(IsSPL(S));

    # EXPAND_ROTATIONS is one of (see above)
    # - ExpandRotations33      sums * diag * sums
    # - ExpandRotations33a     3 lifting steps (fused mult/add)
    # - ExpandRotations24      by definition
    if EXPAND_ROTATIONS = 1 then  S := ExpandRotationsSPL33(S);
    elif EXPAND_ROTATIONS = 2 then S := ExpandRotationsSPL33a(S);
    elif EXPAND_ROTATIONS = 3 then S := ExpandRotationsSPL24(S);
    elif EXPAND_ROTATIONS = 4 then S := ExpandRotationsSPLRandom(S);
    else Error("invalid value for EXPAND_ROTATIONS (see Doc(EXPAND_ROTATIONS))");
    fi;

    return S;
end;

# PrintNumberToSPLNC( <x> )
#   prints the scalar <x> in SPL syntax.

PrintNumberToSPLNC := function ( x )
  local precision, p, a, extra, c, n;

  precision := 16;

  # scalar case
  if IsScalar(x) then
    PrintScalarToSPLNC(x);
    return;
  # integers
  elif IsInt(x) then
    if x < 0 then Print("(", x, ".0)");
    else Print(x, ".0");
    fi;
    return;
  # rationals
  elif IsRat(x) then
    if x < 0 then Print("(", x, ")");
    else Print(x);
    fi;
    return;
  # floats
  elif IsDouble(x) then
      if x < 0 then Print(StringDouble("(%.17e)", x));
      else Print(StringDouble("%.17e", x));
      fi;
      return;
  # complex numbers
  elif IsComplex(x) then
      Print(StringComplex("(%.17e, %.17e)", x));
      return;
  fi;

  # sqrt of a rational and real
  if x = GaloisCyc(x, -1) and IsRat(x^2) then
    if x = -Sqrt(x^2) then
      Print("(-sqrt(");
      PrintNumberToSPLNC(x^2);
      Print("))");
    else
      Print("sqrt(");
      PrintNumberToSPLNC(x^2);
      Print(")");
    fi;
    return;
  fi;

  # x = a/b * cos(c*pi/d)
  p := RecognizeCosPi(x);
  if p <> false then
    extra := false;
    if p[1] < 0 then
      Print("(");
      extra := true;
    fi;
    if p[1] = 1 then
      Print("cos(");
    elif p[1] = -1 then
      Print("-cos(");
    else
      Print(p[1], "*cos(");
    fi;

    a := Numerator(p[2]);
    if a = 1 then
      Print("pi/", Denominator(p[2]), ")");
    elif a = -1 then
      Print("-pi/", Denominator(p[2]), ")");
    else
      Print(Numerator(p[2]), "*pi/", Denominator(p[2]), ")");
    fi;

    if extra then
      Print(")");
    fi;
    return;
  fi;

  # x = sqrt(2) * a/b * cos(c*pi/d)
  # this captures sum of two cosines/sines
  # the reason to include this is that the
  # substitution rule for rotations (see ExpandRotationsSPL33 or 24)
  # creates such numbers
  p := RecognizeCosPi(x/Sqrt(2));
  if p <> false then
    extra := false;
    if p[1] < 0 then
      Print("(");
      extra := true;
    fi;

    a := Numerator(p[1]);
    if a = 1 then
      Print("sqrt(2)");
    elif a = -1 then
      Print("-sqrt(2)");
    else
      Print(a, "*sqrt(2)");
    fi;
    if not IsInt(p[1]) then
      Print("/", Denominator(p[1]));
    fi;
    Print("*cos(");

    a := Numerator(p[2]);
    if a = 1 then
      Print("pi/", Denominator(p[2]), ")");
    elif a = -1 then
      Print("-pi/", Denominator(p[2]), ")");
    else
      Print(Numerator(p[2]), "*pi/", Denominator(p[2]), ")");
    fi;

    if extra then
      Print(")");
    fi;
    return;
  fi;

  # x = b/(a* CosPi(c/d))
  p := RecognizeCosPi(1/x);
  if p <> false then
    extra := false;
    if p[1] < 0 then
      Print("(-");
      extra := true;
    fi;
    Print(Denominator(p[1]), "/(", AbsInt(Numerator(p[1])), "*cos(");

    a := Numerator(p[2]);
    if a = 1 then
      Print("pi/", Denominator(p[2]), ")");
    elif a = -1 then
      Print("-pi/", Denominator(p[2]), ")");
    else
      Print(Numerator(p[2]), "*pi/", Denominator(p[2]), ")");
    fi;
    Print(")");

    if extra then
      Print(")");
    fi;
    return;
  fi;

  # x is a root of unity
  # note that w(n) (in spl) is E(n)^(n-1)
  a := NofCyc(x);
  if x^(2*a) = 1 then
    c := CoeffsCyc(x, a);
    n := PositionProperty(c, i -> i <> 0);
    if c[n] = 1 then
      if n = 2 then # x = E(a)
        Print("w(", a, ")");
      else
        Print("w(", a, ", ", n - 1, ")");
      fi;
    else # c[n] = -1
      if n = 2 then # x = -E(a)
        Print("(-w(", a, "))");
      else
        Print("(-w(", a, ", ", n - 1, "))");
      fi;
    fi;
    return;
  fi;

  # x is real
  if x = GaloisCyc(x, -1) then
       PrintNumberToSPLNC(ReComplex(Complex(x)));
  else
       PrintNumberToSPLNC(Complex(x));
  fi;
end;