
/* This module implements factorizing integers and polynomials */

/// Middle level function: returns a list of prime factors and their powers.
/// E.g. FactorizeInt(50) returns {{2, 1}, {5, 2}}.
1# FactorizeInt(0) <-- {};
1# FactorizeInt(1) <-- {};

3# FactorizeInt(n_IsInteger) <--
[
  Local(small'powers);
  // first, find powers of 2, 3, ..., p with p=257 currently -- this speeds up PollardRho and should avoids its worst-case performance
  small'powers := TrialFactorize(Abs(n), 257);	// value is {n1, {p1,q1}, {p2,q2}, ...} and n1=1 if completely factorized into these factors, and the remainder otherwise
  n := small'powers[1];	// remainder
  If(n=1, Tail(small'powers),
  // if n!=1, need to factorize the remainder with Pollard Rho algorithm
	  [
	  	If(Verbose, Echo({"FactorizeInt: Info: remaining number ", n}));
		SortFactorList(
	  	  PollardCombineLists(Tail(small'powers), PollardRhoFactorize(n))
		);
	  ]
  );
];

/// Sort the list of prime factors using HeapSort()
LocalSymbols(a,b, list) [

SortFactorList(list) := HeapSort(list, {{a,b}, a[1]<b[1]});

];

/// Simple trial factorization: can be very slow for integers > 1,000,000.
/// Try all prime factors up to Sqrt(n).
/// Resulting factors are automatically sorted.
/// This function is not used any more.
/*
2# TrialFactorize(n_IsPrimePower) <-- {GetPrimePower(n)};
3# TrialFactorize(n_IsInteger) <--
[
	Local(factorization);
	factorization := TrialFactorize(n, n);	// TrialFactorize will limit to Sqrt(n) automatically
	If(
		Head(factorization) = 1,	// all factors were smaller than Sqrt(n)
		Tail(factorization),
		// the first element needs to be replaced
		Concat(Tail(factorization), {{Head(factorization),1}})
	);
];
*/

/// Auxiliary function. Return the power of a given prime contained in a given integer and remaining integer.
/// E.g. FindPrimeFactor(63, 3) returns {7, 2} and FindPrimeFactor(42,17) returns {42, 0}
// use variable step loops, like in IntLog()
FindPrimeFactor(n, prime) :=
[
	Local(power, factor, old'factor, step);
	power := 1;
	old'factor := 1;	// in case the power should be 0
	factor := prime;
	// first loop: increase step
	While(Mod(n, factor)=0)	// avoid division, just compute Mod()
	[
		old'factor := factor;	// save old value here, avoid sqrt
		factor := factor^2;
		power := power*2;
	];
	power := Div(power,2);
	factor := old'factor;
	n := Div(n, factor);
	// second loop: decrease step
	step := Div(power,2);
	While(step>0 And n > 1)
	[
		factor := prime^step;
		If(
			Mod(n, factor)=0,
			[
				n := Div(n, factor);
				power := power + step;
			]
		);
		step := Div(step, 2);
	];
	{n, power};
];

/* simpler method but slower on worstcase such as p^n or n!
FindPrimeFactor(n, prime) :=
[
	Local(power, factor);
	power := 0;
	factor := prime;
	While(Mod(n, factor)=0)
	[
		factor := factor*prime;
		power++;
	];
	{n/(factor/prime), power};
];
*/

/// Auxiliary function. Factorizes by trials. Return prime factors up to given limit and the remaining number.
/// E.g. TrialFactorize(42, 2) returns {21, {{2, 1}}} and TrialFactorize(37, 4) returns {37}
TrialFactorize(n, limit) :=
[
	Local(power, prime, result);
	result := {n};	// first element of result will be replaced by the final value of n
	prime := 2;	// first prime
	While(prime <= limit And n>1 And prime*prime <= n)
	[	// find the max power of prime which divides n
		{n, power} := FindPrimeFactor(n, prime);
		If(
			power>0,
			DestructiveAppend(result, {prime,power})
		);
		prime := NextPseudoPrime(prime);	// faster than NextPrime and we don't need real primes here
	];
	// replace the first element which was n by the new n
	DestructiveReplace(result, 1, n);
];

/* This is Pollard's Rho method of factorizing, as described in
 * "Modern Computer Algebra". It is a rather fast algorithm for
 * factoring, but doesn't scale to polynomials regrettably.
 *
 * It acts 'by chance'. This is the Floyd cycle detection trick, where
 * you move x(i+1) = f(x(i)) and y(i+1) = f(f(y(i))), so the y goes twice
 * as fast as x, and for a certain i x(i) will be equal to y(i).
 *
 * "Modern Computer Algebra" reasons that if f(x) = (x^2+1) mod n for
 * the value n to be factored, then chances are good that gcd(x-y,n)
 * is a factor of n. The function x^2+1 is arbitrary, a higher order
 * polynomial could have been chosen also.
 *
 */

/*
Warning: The Pollard Rho algorithm cannot factor some numbers, e.g. 703, and
can enter an infinite loop. This currently results in an error message: "failed to factorize".
Hopefully the TrialFactorize() step will avoid these situations by excluding
small prime factors.
This problem could also be circumvented by trying a different random initial value for x when a loop is encountered -- hopefully another initial value will not get into a loop. (currently this is not implemented)
*/

RandomInteger(n) := MathFloor(Random()*n);
/// Polynomial for the Pollard Rho iteration
PollardRhoPolynomial(_x) <-- x^2+1;

2# PollardRhoFactorize(n_IsPrimePower) <-- {GetPrimePower(n)};
3# PollardRhoFactorize(_n) <--
[
  Local(x,y,restarts,gcd,repeat);
  gcd:=1;
  restarts := 100;	// allow at most this many restartings of the algorithm
  While(gcd = 1 And restarts>=0)	// outer loop: this will be typically executed only once but it is needed to restart the iteration if it "stalls"
  [
  	restarts--;
    /* Pick a random value between 1 and n-1 */
    x:= RandomInteger(n-1)+1;

    /* Initialize loop */
    gcd:=1; y:=x;
	repeat := 4;	// allow at most this many repetitions
//		Echo({"debug PollardRho: entering gcd loop, n=", n});
 
    /* loop until failure or success found */
    While(gcd = 1 And repeat>=0)
    [
      x:= Mod( PollardRhoPolynomial(x), n);
   	  y:= Mod( PollardRhoPolynomial(
	  	Mod( PollardRhoPolynomial(y), n)	// this is faster for large numbers
	  ), n);
   	  If(x-y = 0,
       	 [
		 	gcd := 1;
		 	repeat--;	// guard against "stalling" in an infinite loop but allow a few repetitions
		 ],
       	 gcd:=Gcd(x-y,n)
       	 );
//		Echo({"debug PollardRho: gcd=",gcd," x=", x," y=", y});
   	];
	If(Verbose And repeat<=0, Echo({"PollardRhoFactorize: Warning: stalled while factorizing ", n, "; counters ", x, y}));
  ];
  Check(restarts>0, "PollardRhoFactorize: Error: failed to factorize " : String(n));
  If(Verbose And gcd > 1, Echo({"PollardRhoFactorize: Info: while factorizing ", n, " found factor ", gcd}));
  /* Return result found */
  PollardCombineLists(PollardRhoFactorize(gcd), PollardRhoFactorize(Div(n,gcd)));
];

/* PollardCombineLists combines two assoc lists used for factoring.
   the first element in each item list is the factor, and the second
   the exponent. Thus, an assoc list of {{2,3},{3,5}} means 2^3*3^5.
*/

5 # PollardMerge(_list,{1,_n}) <-- True;
10 # PollardMerge(_list,_item)_(Assoc(item[1],list) = Empty) <--
  DestructiveInsert(list,1,item);

20 # PollardMerge(_list,_item) <--
[
  Local(assoc);
  assoc := Assoc(item[1],list);
  assoc[2]:=assoc[2]+item[2];
];

PollardCombineLists(_left,_right) <--
[
  ForEach(item,right)
  [
    PollardMerge(left,item);
  ];
  left;
];


/* TODO for Bk:
   - ModDivide, ModGcd, make an interface for in the scripts.
   - The cases non-monic polynomials and polys with rational
     coefficients are not handled very well yet. These two
     are related: if the non-monic goes well then the
     rational coeffs goes well. Problem is that Knuth describes
     an order n! algorithm, for the n possible options!
     This cannot be right... When you have many factors
     this might go wrong. The algorithm will terminate (a
     great improvement over the previous) but might not
     fully factor the polynomial.
*/

10 # FindMod(_poly,_item,_p,_n)_(Degree(Gcd(poly,item)) > 0) <-- Expand(item);
11 # FindMod(_poly,_item,_p,_n) <-- FindModAux(poly,item,p,n);

11 # FindModAux(_poly,_item,_p,_n)_(Mod(poly,item+n*p) = 0) <-- Expand(item+n*p);
12 # FindModAux(_poly,_item,_p,_n)_(Mod(poly,item-n*p) = 0) <-- Expand(item-n*p);

13 # FindModAux(_poly,_item,_p,_n)_(Mod(poly,(LeadingCoef(poly))*item+n*p) = 0) <-- Expand((LeadingCoef(poly))*item+n*p);
14 # FindModAux(_poly,_item,_p,_n)_(Mod(poly,(LeadingCoef(poly))*item-n*p) = 0) <-- Expand((LeadingCoef(poly))*item-n*p);

20 # FindModAux(_poly,_item,_p,_n)_(n<10) <--
[
/*
 Echo({item,p,"n = ",n});
 Echo({(Mod(LeadingCoef(poly),p))*item+n*p});
*/ 
  FindModAux(poly,item,p,n+1);
];
30 # FindModAux(_poly,_item,_p,_n) <-- 1;

5  # MergeTerm(_f,{1,_pow}) <-- True;
10 # MergeTerm(_f,_i) <-- MergeTerm(f,i,Assoc(i[1],f));
10 # MergeTerm(_f,_i,Empty) <-- DestructiveAppend(f,i);
20 # MergeTerm(_f,_i,list_IsList) <--
[
  list[2] := list[2] + i[2];
];

10 # MergeFactors(_f,_s) <--
[
  ForEach(i,s)
    MergeTerm(f,{Monic(i[1]),i[2]});
  f;
];

FactorUniVarSec(_poly) <--
[
  Local(checked,i);

  checked := Bk(poly);
  Local(pre);
  pre:=Div(poly,FW(checked));
  pre:=Eval(pre); //TODO very crude form of simplification?
  // Rescan the solutions, because there may be some that still
  // divide the remaining polynomial.
  For(i:=1,i<=Length(checked),i++)
  [
    if (Degree(checked[i][1]) > 0)
    While (Mod(pre,checked[i][1]) = 0)
    [
      checked[i][2] := checked[i][2] + 1;
      pre := Div(pre, checked[i][1]);
      pre:=Eval(pre); //TODO very crude form of simplification?
    ];
  ];

  if (pre != 1)
  [
    Local(lc,monic);
    lc := LeadingCoef(pre);
    monic := Monic(pre);
    if (monic != 1) [checked := {monic,1}:checked;];
    if (lc != 1) [checked := {lc,1}:checked;];
  ];
  checked;
];


MakeInteger(_poly) <--
[
  Local(cf,t1,t2);
  cf := MapSingle("Denom",Abs(Coef(poly,(0 .. Degree(poly)))));
  cf := Select({{n},Not IsZero(n)},cf);

  While (Length(cf) > 1)
  [
    t1:=Head(cf);
    cf:=Tail(cf);
    t2:=Head(cf);
    cf:=Tail(cf);
    cf := Lcm(t1,t2):cf;
  ];
  poly := poly*(cf[1]);
  poly;
];


Bk(_poly) <--
[
  Local(p,checked,factored,result,var);

  // result will contain the final result returned to the user. 
  checked := {};
  result:= {};
  // Create a internal representation, to speed up processing
  var:=(VarList(poly)[1]);
//  poly :=Apply("Subst",{var,Hold(x),poly};
  poly:=Subst(var,Hold(x))poly;
  poly := MakeUni(poly,VarList(poly));

  // Convert from polynomial containing rational coefficients
  // to one containing integer coefficients
  poly := MakeInteger(poly);

  // Trivial factors
  if (poly[2] > 0)
  [
    poly := UniVariate(poly[1],0,poly[3]);
  ];

//  poly := poly*LeadingCoef(poly);
/*Echo({poly," should have integer coefficients"});*/
  
  // square-free factorization
  [
    Local(dv,dd);
    dd := Apply("D",{x,poly});
    dv:=0;
    if (Degree(dd) > 0) [ dv:=Gcd(poly,dd); ];
    if (Degree(dv)>0)
    [
      Local(new);
      dv := Monic(dv);
      poly := Div(poly,dv);
      poly := MakeInteger(poly);
/*Echo({poly," should have integer coefficients"});*/
      new := Bk(dv);
      ForEach(item,new)
      [
        While(Mod(poly,item[1]) = 0)
        [
          item[2] := item[2] + 1;
          poly := Div(poly,item[1]);
        ];
      ];
      poly := MakeInteger(poly);

      MergeFactors(checked, new);
/*Echo({"squarefree: ",checked});      */
    ];
  ];


  p:=Max(1+2*Abs(Coef(poly,(0 .. Degree(poly)))));
  if (p<5) [p := 5;];
  if (p > 100) [ p := 100; ];
  While (Not IsPrime(p)) p++;

  factored := Bk(poly,p);
  if (Length(factored) < 2)
  [
    p++;
    While (Not IsPrime(p)) p++;

    factored := Bk(poly,p);
  ];
  
  ForEach(item,factored)
  [
    if (Degree(item[1]) = 1)
      MergeFactors(result,{{Monic(FindMod(poly,item[1],p,0)),item[2]}});

  ];
  MergeFactors(checked,result);
  Subst(Hold(x),var)checked;
];
Bk(_poly,_prime) <--
[
  Local(coefs,result);
  if (Degree(poly)<2)
  [
    result := {{poly,1}};
  ]
  else
  [
    coefs := MakeUni(poly)[3];
    result := Berlekamp(coefs,prime);
    Local(i);
    For(i:=1,i<=Length(result),i++)
    [
      result[i] := {Monic(NormalForm(UniVariate(x,0,result[i]))),1};
    ];
  ];
  result;
];



/* New factorization : split between integers and polynomials. */
10 # Factors(p_IsInteger) <-- FactorizeInt(p);
20 # Factors(p_CanBeUni)_(Length(VarList(p)) = 1) <--  FactorUniVarSec(p);



Factor(_p) <-- FW(Factors(p));

/* FW: pass FW the result of Factors, and it will show it in the
 * form of p0^n0*p1^n1*...
 */

10 # FWatom({_a,1}) <-- a;
20 # FWatom({_a,_n}) <-- UnList({Atom("^"),a, n});
5  # FW(_list)_(Length(list) = 0) <-- 1;
10 # FW(_list)_(Length(list) = 1) <-- FWatom(list[1]);
20 # FW(_list) <--
[
  Local(result);
  result:=FWatom(Head(list));
  ForEach(item,Tail(list))
  [
   result := UnList({ Atom("*"),result,FWatom(item)});
  ];
  result;
];

10 # Roots(poly_CanBeUni) <--
[
  Local(factors,result,uni,root,i);
  factors:=Factors(poly);
  result:={};
  ForEach(item,factors)
  [
    uni:=MakeUni(item[1]);
    If(Degree(uni) = 1,
      [
        root:= -Coef(uni,0)/Coef(uni,1);
        For(i:=0,i<item[2],i++)
          result:= root : result;
      ]
      );
  ];
  result;
];

10 # RootsWithMultiples(poly_CanBeUni) <--
[
  Local(factors,result,uni,root,i);
  factors:=Factors(poly);
  result:={};
  ForEach(item,factors)
  [
    uni:=MakeUni(item[1]);
    If(Degree(uni) = 1,
      [
        root:= -Coef(uni,0)/Coef(uni,1);
        For(i:=0,i<item[2],i++)
          result:= {root,item[2]} : result;
      ]
      );
  ];
  result;
];







