%mathpiper,def="BinaryFactors",public="todo"

LocalSymbols(lastcoef,OrdBuild, AddFoundSolutionSingle , AddFoundSolution, Fct, MkfactD,p)
[

LastCoef(_vector,_p) <--
[
  Local(n);
  n:=Length(vector);
  Add(vector*p^(0 .. (n-1)));
];

/*
Ord(vector,q):=
[
  Local(n);
  n:=Length(vector);
  q*Coef(Simplify(LastCoef(vector,p+q)-LastCoef(vector,p)),q,1);
];
*/

OrdBuild(vector,q):=
[
  Local(i,result,n);
  Bind(i,2);
  Bind(result, 0);
  Bind(n, Length(vector));
  While (i<=n)
  [
    Bind(result,result+(i-1)*vector[i]*p^(i-2));
    Bind(i, i+2);
  ];
  q*result;
];


Function(AddFoundSolutionSingle,{p})
[
  Local(calc);
//  If ( Not Contains(result,p),
//  [
    Bind(calc, Eval(lastcoef));
    If (IsEqual(calc, 0),
    [
      Local(newlist,count,root);
      count:=0;
      root := p;
      Local(rem);

      rem:={-root,1};
      {testpoly,rem}:=MkfactD(testpoly,rem);

      rem:={-root,1};
      {newlist,rem}:=MkfactD(poly,rem);
      While (rem = {})
      [
        count++;
        Bind(poly,newlist);
        rem:={-root,1};
        {newlist,rem}:=MkfactD(poly,rem);
      ];

      Local(lgcd,lc);
      Bind(lgcd,Gcd({andiv,an,root}));
      Bind(lc,Quotient(an,lgcd));
      Bind(result,{var+ (-(Quotient(root,lgcd)/lc)),count}:result);
      Bind(andiv,Quotient(andiv,lgcd^count));
      Bind(anmul,anmul*lc^count);

//      factor:=(x-root);
//      Bind(result,{factor,count}:result);

      Local(p,q);
      Bind(lastcoef, LastCoef(testpoly,p));
      Bind(ord, OrdBuild(testpoly,q));
    ]);
//  ]);
];
UnFence(AddFoundSolutionSingle,1);

Function(AddFoundSolution,{p})
[
  AddFoundSolutionSingle(p);
  AddFoundSolutionSingle(-2*q+p);
];
UnFence(AddFoundSolution,1);

Function(Fct,{poly,var})
[
  Local(maxNrRoots,result,ord,p,q,accu,calc,twoq,mask);

  Local(gcd);
  [
    Bind(gcd,Gcd(poly));
    If(poly[Length(poly)] < 0,Bind(gcd, gcd * -1));
    Bind(poly,poly/gcd);
  ];

  Local(unrat);
  Bind(unrat,Lcm(MapSingle("Denominator",poly)));
  Bind(poly,unrat*poly);

  Local(origdegree);
  Bind(origdegree,Length(poly)-1);

  Local(an,andiv,anmul);
  Bind(an,poly[Length(poly)]);
  Bind(poly,poly* (an^((origdegree-1) .. -1)));
  Bind(andiv,an^(origdegree-1));
  Bind(anmul,1);

  Local(leadingcoef,lowestcoef);
  Bind(leadingcoef,poly[Length(poly)]);
  [
    Local(i);
    Bind(i,1);
    Bind(lowestcoef,Abs(poly[i]));
    While (lowestcoef = 0 And i<=Length(poly))
    [
      Bind(i,i+1);
      Bind(lowestcoef,Abs(poly[i]));
    ];
  ];
  // testpoly is the square-free version of the polynomial, used for finding
  // the factors. the original polynomials is kept around to find the
  // multiplicity of the factor.
  Local(testpoly);
//  Bind(testpoly,Mkc(Quotient(polynom,Monic(Gcd(polynom,Deriv(var)polynom))),var));
  Local(deriv);
  // First determine a derivative of the original polynomial
  deriv:=Rest(poly);
  [
    Local(i);
    For (i:=1,i<=Length(deriv),i++)
    [
      deriv[i] := deriv[i]*i;
    ];
//    Echo("POLY = ",poly);
//    Echo("DERIV = ",deriv);
  ];
  [
    Local(q,r,next);
    q:=poly;
    r:=deriv;
    While(r != {})
    [
//Echo(q,r);
      next := MkfactD(q,r)[2];
      q:=r;
      r:=next;
    ];
    // now q is the gcd of the polynomial and its first derivative.

    // Make it monic
    q:=q/q[Length(q)];
    testpoly:=MkfactD(poly,q)[1];
//Echo("TESTPOLY = ",testpoly);
  ];

//  Bind(testpoly,poly); //@@@

  Bind(maxNrRoots,Length(testpoly)-1);
  Bind(result, {});

  Bind(lastcoef, LastCoef(testpoly,p));
  Bind(ord, OrdBuild(testpoly,q));

  Bind(accu,{});
  Bind(q,1);
  Bind(twoq,MultiplyN(q,2));
  Bind(mask,AddN(twoq,MathNegate(1)));
  if (IsEven(testpoly[1]))
  [
    Bind(accu,0:accu);
    AddFoundSolutionSingle(0);
  ];
  Bind(p,1);
  Bind(calc, Eval(lastcoef));
  If (IsEven(calc),
  [
    Bind(accu,1:accu);
    AddFoundSolution(1);
  ]);
  Bind(q,twoq);
  Bind(twoq,MultiplyN(q,2));
  Bind(mask,AddN(twoq,MathNegate(1)));
  While(Length(result)<maxNrRoots And Length(accu)>0 And q<=Abs(testpoly[1]))
  [
    Local(newaccu);
    Bind(newaccu,{});
    ForEach(p,accu)
    [
      Bind(calc,Eval(lastcoef));
      If (IsLessThan(calc,0),
        Bind(calc, AddN(calc,MultiplyN(twoq,QuotientN(AddN(MathNegate(calc),twoq),twoq))))
         );
      Bind(calc, BitAnd(calc, mask));
      If ( IsEqual(calc, 0),
      [
        Bind(newaccu, p:newaccu);
        AddFoundSolutionSingle(-2*q+p);
      ]);
      Bind(calc, AddN(calc, Eval(ord)));
      If (IsLessThan(calc,0),
        Bind(calc, AddN(calc,MultiplyN(twoq,QuotientN(AddN(MathNegate(calc),twoq),twoq))))
         );
      Bind(calc, BitAnd(calc, mask));
      If ( IsEqual(calc, 0),
      [
        Bind(newaccu, AddN(p,q):newaccu);
        AddFoundSolution(AddN(p,q));
      ]);
    ];
    Bind(accu, newaccu);
    Bind(q,twoq);
    Bind(twoq,MultiplyN(q,2));
    Bind(mask,AddN(twoq,MathNegate(1)));

//Echo("q = ",q);
//Echo("Length is",Length(accu),"accu = ",accu);
//Echo("result = ",result);
  ];

  // If the polynom is not one, it is a polynomial which is not reducible any further
  // with this algorithm, return as is.
  Bind(poly,poly*an^(0 .. (Length(poly)-1)));
  Bind(poly,gcd*anmul*poly);
  //TODO had to add this if statement, what was andiv again, and why would it become zero? This happens with for example Factor(2*x^2)
  If(Not IsZero(unrat * andiv ),Bind(poly,poly/(unrat * andiv )));
  If(poly != {1},
  [
    result:={(Add(poly*var^(0 .. (Length(poly)-1)))),1}:result;
  ]);
  result;
];



BinaryFactors(expr):=
[
  Local(result,uni,coefs);
  uni:=MakeUni(expr,VarList(expr)[1]);
  uni:=FunctionToList(uni);
  coefs:=uni[4];
  coefs:=Concat(ZeroVector(uni[3]),coefs);
  result:=Fct(coefs,uni[2]);
//  Echo(result,list);
//  Echo((Add(list*x^(0 .. (Length(list)-1)))));
//  Product(x-result)*(Add(list*x^(0 .. (Length(list)-1))));
  result;
];



MkfactD(numer,denom):=
[
  Local(q,r,i,j,ln,ld,nq);
  DropEndZeroes(numer);
  DropEndZeroes(denom);
  Bind(numer,Reverse(numer));
  Bind(denom,Reverse(denom));
  Bind(ln,Length(numer));
  Bind(ld,Length(denom));
  Bind(q,FillList(0,ln));
  Bind(r,FillList(0,ln));

  Bind(i,1);
  If(ld>0,
  [
    While(Length(numer)>=Length(denom))
    [
      Bind(nq,numer[1]/denom[1]);
      q[ln-(Length(numer)-ld)] := nq;
      For(j:=1,j<=Length(denom),j++)
      [
        numer[j] := (numer[j] - nq*denom[j]);
      ];
      r[i] := r[1] + numer[1];

      Bind(numer, Rest(numer));
      i++;
    ];
  ]);
  For(j:=0,j<Length(numer),j++)
  [
    r[i+j] := r[i+j] + numer[j+1];
  ];
  Bind(q,Reverse(q));
  Bind(r,Reverse(r));
  DropEndZeroes(q);
  DropEndZeroes(r);
  {q,r};
];

]; //LocalSymbols


%/mathpiper