/*
------------------------------------------------------------------------
Efficient Galois Fields in Maxima

by Alasdair McAndrew
and later extended by Fabrizio Caruso and Jacopo Daurizio

it is distribuited together with gf_roots by Jacopo Daurizio

Authors:

Fabrizio Caruso   (optimizations, testing)
Jacopo D'Aurizio   (optimizations, modular roots)
Alasdair McAndrew (original version of the package, pohlig-helman log, etc... )
------------------------------------------------------------------------*/

/* Released under terms of the GNU General Public License, version 2,
 * by permission of the authors to Robert Dodier circa 2007-12-02.
 */

/* Revision by Volker van Nek, 2012
 *
 * A lot of functions moved to src/numth.lisp.
 * lucas moved to src/combin.lisp next to fib.
 *
 * Remaining contents:
 *  1. Functions for Z_p
 *  2. Galois Fields (Itoh-Tsujii algorithm)
 *  3. Collected comments and algorithms for number theory
 *  4. Roots in finite fields (documented in gf_manual.pdf)
 */

/* *** Functions for Z_p, p prime ******************************************* */

/* Creates an array of couples [a!, 1/(a!)] mod p 
*/
zp_fact_array(p) := block([v2],
   v2 : make_array('fixnum, p, 2),
   for i:0 thru p-2 do (v2[i,0] : 1, v2[i,1] : 1),
   v2[p-1, 0] : -1, 
   v2[p-1, 1] : -1,
   if p > 3 then (
      for i:2 thru p-1 do v2[i,0] : mod(i * v2[i-1,0], p),
      for i:2 thru p-2 do v2[i,1] : mod((-1)^(p-i) * v2[p-i-1,0], p) ),
   v2 )$ 


/* Calculates the product a(a+1)(a+2)...(b-1)b in Z_p 
*/
zp_prod(a, b, p) := 
   if a = 1 and b = 0 then 1
   else if a = b then mod(a, p)
   else if (a = 1 or a = 2) and b = p-1 then b
   else block([s:1], 
      for i:a thru b do s : mod(s*i, p),
      s )$

/* Calculates (n!)^(-1) in Z_p using Wilson Theorem
   This algorithm DOES NOT require explicit inversion through gcd() 
*/
zp_inv_fact(n, p) := 
   if n = 0 or n = 1 then 1
   else if n = p-1 then n
   else mod(- zp_prod(n+1, p-1, p), p)$


/* Calculates the maximum exponent s for which p^s divides n! 
*/
zp_max_pow(n, p) := 
   if n < p then 0
   else block([k, s:0],
      k : length_base(p, n) - 1,
      for i:1 thru k do s : s + floor(n/p^i),
      s )$

length_base(b, n) := block([len:0], 
   while n # 0 do (
      n : quotient(n, b),
      len : len + 1 ),
   len )$


/* Calculates binomial(m,n) in Z_p using Wilson Theorem and fast inversions of k! 
*/ 
zp_binomial(m, n, p) := 
   if m < n then 0
   else (
      if m < 2*n then n : m-n,
      if n = 0 then 1
      else if n = 1 then mod(m, p)
      else if zp_max_pow(m, p) - zp_max_pow(m-n, p) > zp_max_pow(n,p) then 0
      else block([a,b,c, na,nb,nc],
         a : mod(n, p),   na : mod(floor(n/p), 2),
         b : mod(m, p),   nb : mod(floor(m/p), 2),
         c : mod(m-n, p), nc : mod(floor((m-n)/p), 2),
         mod(zp_prod(1, b, p) * zp_inv_fact(a, p) * zp_inv_fact(c, p) * (-1)^(na+nb+nc), p) ))$



/* *** Galois Fields ******************************************************** */

/* Inversion through Itoh-Tsujii algorithm -- Highly Experimental 
*/
gf_inv_ITA(poly) := block([p, r, s, t, u, gf_rat:false],
   p : gf_characteristic(),
   r : gf_order()/(p - 1),
   s : gf_exp(poly, r - 1),
   t : gf_mult(poly, s), 
   u : inv_mod(t, p),
   gf_mult(s, u) )$

/* Remark (VvN): 
A possible Lisp-implementation is listed below. 
However it is much slower than $gf_inv in src (e.g. 30 times in F3^102).

(defmfun $gf_inv_ita (a) 
  (gf-red? "gf_inv_ita") 
  (let ((*ef-arith?*))
    (setq a (gf-inv-ita (gf-p2x a) *gf-red*))
    (when a (gf-x2p a)) )) 

(defun gf-inv-ita (y red) 
  #+ (or ccl ecl gcl) (declare (optimize (speed 3) (safety 0)))
  (when (null y) 
    (gf-merror (intl:gettext "gf arithmetic: Quotient by zero")) )
  (let (($gf_rat) r x c)
    (setq r (truncate *gf-ord* (1- *gf-char*))
          x (gf-pow y (1- r) red)
          y (gf-times x y red) ) ;; y is (0 n) or nil
    (unless y (return-from gf-inv-ita))
    (setq c (inv-mod (cadr y) *gf-char*))
    (when c (gf-xctimes x c)) ))
*/


/* 
gf_dotprod(lst1, lst2) - cut out
use
matrix_element_add : gf_add
matrix_element_mult : gf_mult
and the dot-operator itself 

gf_mateval(M) - cut out
use matrixmap('gf_eval, M) 
*/


gf_eval_poly(poly, var) :=
  sum(gf_eval(ratcoeff(rat(poly, var), var, i)) * var^i, i, 0, hipow(poly, var) )$



/* *** Collected comments and algorithms ************************************ */

/* Complessita' : detta C la cardinalita' del campo, si hanno in media Osoft(C^(1/t)) operazioni,  */
/* dove t=log(C)/log(q), dove q e' il piu' grande primo che divide C                               */
/* diff1,diff2,ll,  --- allocare o non allocare? non cambia niente, sembra                         */


/* Berlekamp-Massey Algorithm 
*/
berlekamp_massey(seq) := block([x, m, r,r0,r1, v,v0,v1, q, h, d, p],
   m : length(seq),
   v0 : rat(0, x), 
   v1 : rat(1, x),
   r0 : rat(x^m, x),
   r1 : rat(sum(seq[i] * x^(i-1), i, 1, m), x), 
   h : hipow(r1, x),
   while 2*h >= m do (
      [q, r] : divide(r0, r1, x), 
      [v0, v1] : [v1, rat(v0 - q*v1, x)],
      [r0, r1] : [r1, r],
      h : hipow(r1, x) ),
   d : max(1 + h, hipow(v1, x)), 
   p : rat((x^d) * ratsubst(1/x, x, v1), x), 
   h : hipow(p, x),
   rat(p/coeff(p, x, h), x) )$



/* ricerca binaria in una lista ordinata crescente - complessità massima ?integer\-length(length(list)) accessi           */
/* l'allocazione di liste non è ancora abbastanza efficiente da permettere un'implementazione parziale di un crivello ... */
/* comunque può essere utilizzata per accelerare il gf_ind originario                                                     */
binsearch(elem, list) := block([l:length(list), l2, pos, k:1, check],
   l2 : ?integer\-length(l) - 1, 
   pos : ?ash(2, l2 - 1),
   while k < l2 + 2 do (
      if pos > l then (
         pos : pos - ?ash(2, l2 - k) + ?ash(2, l2 - k - 1),
         k : k + 1 ) 
   else (
      check : list[pos],
      if check = elem then return(pos) 
      else if check > elem then 
          pos : pos - ?ash(2, l2 - k) + ?ash(2, l2 - k - 1) 
      else if check < elem then 
         pos : pos + ?ash(2, l2 - k - 1),
      k : k+1 )),
  if k = l2 + 2 then 0  
  else pos )$


/* Bijection maps between N and N^2 */
n2n2(n) := block([a,b],
   a : ceiling((ceiling(sqrt(8*n + 9)) - 3) / 2),
   b : n - ?ash(a*(a + 1), -1),
   [b, a - b] )$

n22n(n2) := block([a, x:first(n2), y:last(n2)],
   a : x + y, 
   ?ash(a*(a + 1), -1) + x )$

giretto(n, p) := block([start, list],
   start : [0,0], 
   list : [start], 
   for i:1 thru n do (
      start : map(lambda([x], mod(x, p)), n2n2(n22n(start) + 1)),
      list : cons(start, list),
      print(i, " : ", start) ), 
   reverse(list) )$


/* Fast square detection               */
/* first(args(factor(x^2-n)))=x^2      */
issquare(n) := block([prime:2, prod:2, k],
   if mod(n, 4) = 3 or mod(n, 8) = 5 then (
      print("Invalid residue class modulo 4 or 8"),
      return() ), 
   while prod < ?ash(n, 4) do (
      if mod(n, prime) = 0 then (
         k : 0, 
         while mod(n, prime) = 0 do (
            n : n/prime,
            k : k+1 ),
         if oddp(k) then (
            print("The maximum power of ", prime, " dividing ", n, " is odd."),
            return() )),
      if jacobi(n, prime) # 1 then ( 
         print(n, "fails Legendre test for p=", prime),
         return() ),
      prime : next_prime(prime), 
      prod : prod*prime ), 
   is( prod > ?ash(n,4) ))$



/* dopo quanto possono occorrere k numeri interi consecutivi tutti composti? */
/* 2*3*5+1 = 31  32,33,34,35,36                                              */
/* 2*3*5*7+1 = 211  212,213,214,215,216,217,218,219,220                      */
/* da M=1+prod_{j=1..n} p_j  a   M+p_{n+1}-1                                 */
/* p_k interi consecutivi compaiono almeno dopo prod_{j=1..k-1} j log(j)     */
/* k log(k) dopo k^k e^{-k}                                                  */
/* m = k log(k)  log(m) = log(k) + log(log(k))                               */
/* log(k) = log( m/ log(k) ) ~ log(m) - log(log(m))                          */
/* M interi consecutivi dopo almeno (M/(e log M))^M                          */

/* base next_prime(2^30), generatore 2, facile log(16384)                    */



/* ************************************************************************** */ 
/* Roots in finite fields                                                     */
/*                                                                            */
/* Coded by Jacopo D'Aurizio                                                  */


/* ------------------------------------------- */
/*  Some number theoretic subroutines for F_p  */
/* ------------------------------------------- */
 
 
/* Low-complexity Lucas-Muller method for square roots 
*/  
lmp(a, p, m) := block([d1:a, d2:a^2 - 2, j],
   j : ?integer\-length(m),
   for i:2 thru j-1 do (
      if ?logbitp(j - i, m) then (
         d1 : mod(d1*d2 - a, p), 
         d2 : mod(d2^2 - 2, p) )
      else (
         d2 : mod(d1*d2 - a, p), 
         d1 : mod(d1^2 - 2, p) )),
   if ?logbitp(0, m) then mod(d1*d2 - a, p) 
   else mod(d1^2 - 2, p) )$
 

gf_sqrt([ap]) :=
   if length(ap) = 1 then gsqrt(ap[1], gf_characteristic())
   else gsqrt(ap[1], ap[2]);


gsqrt(a, p) := block([t:0, s:-4, term],
   a : mod(a, p), 
   if a = 0 then return([0,0]),
   /* if not primep(p) then error("ERROR: Second argument must be a prime number."), */
   if jacobi(a, p) # 1 then 
      error("ERROR: First argument must be a quadratic residue."),
   if p = 2 then return(mod(a, 2)),
   if mod(p, 4) = 3 then
      term : power_mod(a, ?ash(p + 1, -2), p)
   else (
      do (
         s : mod(s + a*(?ash(t, 1) + 1), p),
         t : t + 1,
         if jacobi(s, p) = -1 then return() ),
      term : mod(lmp(s + 2, p, ?ash(p - 1, -2)) * inv_mod(t, p), p) ),
   [term, p - term] )$


gf_cbrt([ap]) :=
   if length(ap) = 1 then gcbrt(ap[1], gf_characteristic())
   else gcbrt(ap[1], ap[2]);


/* Generalized Shank's algorithm for cube roots 
*/
gcbrt(a, p) := block(
   [c,c_1,c_2, s:0, q:p-1, b:2, bq,bq0, r, t,t0, j:0, i, omega],
   if p = 2 then return(mod(a, 2)),
   if mod(p, 3) = 2 then return(power_mod(a, (?ash(p, 1) - 1)/3, p)),
   if mod(p, 9) = 4 then (
      omega : mod(?ash(p + 1, -1) * (gsqrt(-3, p)[1] -1), p),
      c : power_mod(a, (?ash(p, 1) + 1)/9, p))                
   else if mod(p,9) = 7 then (
      omega : mod(?ash(p + 1, -1) * (gsqrt(-3, p)[1] - 1), p),
      c : power_mod(a, (p + 2)/9, p) ) 
   else (
      while mod(q, 3) = 0 do (
         s : s + 1, 
         q : q/3 ),
      omega : power_mod(b, (p - 1)/3, p), 
      while omega = 1 do (
         b : next_prime(b),
         omega : power_mod(b, (p - 1)/3, p) ),
      /* b:next_prime(b) e' sensato, tanto e' inutile provare */
      /* i composti se quello che li ha preceduti ha fallito. */
      /* Magari implementiamo un crivello in piccolo ad hoc.  */
      bq : power_mod(b, q, p),
      if mod(q, 3) = 1 then (
         r : power_mod(a, (q - 1)/3, p),
         t : mod(a*r*r*r, p), 
         t0 : t,
         while t # 1  do (
            t : mod(t^3, p), 
            j : j + 1 ),
         for i:1 thru s - j do (
            bq0 : bq, 
            bq : mod(bq0^3, p) ),
         if mod(t0 - bq, p) # 0 then bq0 : mod(bq0*bq0, p),
         c : mod(bq0 * inv_mod(r, p), p) )                    
      else (
         r : power_mod(a, (q + 1)/3, p),
         t : mod(inv_mod(a, p) * r*r*r, p), 
         t0 : t,
         while t # 1 do (
            t : mod(t^3, p), 
            j : j + 1 ),
         for i:1 thru s - j do (
            bq0 : bq, 
            bq : mod(bq0^3, p) ),
         if mod(t0 - bq, p) # 0 then bq0 : mod(bq0*bq0, p),
         c : mod(inv_mod(bq0, p) * r, p) )),
   c : mod(c, p), 
   c_1 : mod(c*omega, p), 
   c_2 : mod(-c - c_1, p),
   [c, c_1, c_2] )$                                 


/* Fast exponentiation of the Frobenius (companion) matrix       */
/*     (0  0  -a)   corresponding to the linear map              */
/* F = (1  0  -b)   p(x) -> x*p(x) (mod x^3+bx+a)                */
/*     (0  1   0)   It uses only 3 parameters (F_22,F_23,F_32)   */
/* that are sufficient to completely describe F^j for any j;     */
/* it returns (F^m)_22, corresponding to the evaluation of       */
/*                  x^m (mod x^3+bx+a)                           */
/* in x=0.                                                       */
f3power(a, b, p, m) := block([v_22:1, v_23:0, v_32:0,
                              w_22:1, w_23:0, w_32:0, c, j, k, l, n, index],
   if m = 0 then return(1),
   b : mod(b, p),
   a : mod(a, p),
   c : inv_mod(-a, p),
   j : ?integer\-length(m),
   for i:1 thru j do (
      k : mod(v_23 + b*v_32, p), 
      l : mod(?ash(v_22, 1), p), 
      if ?logbitp(j-i, m)  then (
         n : mod(a*v_32, p),
         w_22 : mod(l*v_23 - n*v_32, p),
         w_32 : mod(v_32*(k + v_23) + v_22*v_22, p),
         w_23 : mod(k*k - l*n - b*w_32, p) )
      else (
         w_22 : mod(v_32*(k + v_23) + v_22*v_22, p),
         w_23 : mod(l*v_23 - a*v_32*v_32, p),
         w_32 : mod(l*v_32 + c*k*k, p) ),
      v_22 : w_22,
      v_23 : w_23,
      v_32 : w_32 ),
    v_22 )$ 
 
  
/* This subroutine returns (1 0) A^(m) (1 0) mod p, where     */
/*          ( 0  -a )                                         */
/*     A =  ( 1  -b )                                         */
/* i.e the m-th term of the recurrence                        */
/* A_0 = 1, A_1 = 0, A_{n+2} = -b A_{n+1} - a A_{n}           */
/* with characteristic polynomial x^2 + b x + a               */  
f2power(a, b, p, m) := block([v_11:0, v_21:1, w_11, w_21, u, v, index],
   /* if m<2 then return(1-m), */
   /* b:mod(b,p), a:mod(a,p),  */
   index : ?integer\-length(m),
   for i:2 thru index do (
      if  ?logbitp(index - i, m) then ( 
         u : - a*v_21, 
         v : v_11 - b*v_21,
         w_11 : mod(u*(v + v_11), p),
         w_21 : mod(v*v + v_21*u, p) )    
      else (
         u : v_11*v_11, 
         v : v_21*v_21,
         w_11 : mod(u - a*v, p),
         w_21 : mod((v_11 + v_21)^2 - (u + (b + 1)*v), p) ),
      v_11 : w_11,
      v_21 : w_21 ),
   mod(v_11, p) )$
 

/* Stickelberger-Redei irreducibility test for cubic polynomial f(x)=x^3+bx+a    */
/* f(x) is irreducible over F_p iff its discriminant D=-4b^3-27a^2               */
/* is a quadratic residue AND 2*(sqrt(D)+sqrt(-27a^2))^2 is NOT a cubic residue. */
redei(a, b, p, ome, p3) := block([d, g, y, r],
   d : mod(- 4*b^3 - 27*a^2, p),
   if jacobi(d, p) # 1 then return(),
   g : mod(msqrt(d, p)[1] + 3*a*ome, p),
   y : mod(?ash(g*g, 1), p),
   r : power_mod(y, p3, p),
   is( mod(r, p) # 1 ))$
 

/* For VERY large p, it might be useful to factor (p-1) into prime factors */
/* (p-1) = 2^(a_1) 3^(a_2) ... q_l^(a_l)                                   */
/* then use a factor-addition-chain instead of the binary one:             */
/* r:y, for i:l downto 1 do (                                              */
/*                   r : power_mod(r,q_l^(a_l),p),                         */
/*                   if r=1 then return(false)                             */
/*                        ), if r=1 then return(true) else return(false)   */
/* to have great chances to shorten the cubic-residue test.                */


/* If a is a quadratic residue in F_p, this routine returns    */
/* two integers in [0, p-1] such that their squares            */
/* are congruent to a (mod p).                                 */
/*                                                             */
/* If b^2-4a is a quadratic non-residue mod p, the polynomial  */
/* x^2 - bx + a                                                */
/* has two roots in F_(p^2) = (Z/pZ[x])/(x^2-bx+a)             */
/* the former being the Frobenius conjugate of the latter      */
/* y = y^p                                                     */
/* so that sqrt(a)=y^((p+1)/2) for Viete's theorem.            */
/* The point is to compute                                     */
/* mu = (b/2 + sqrt(b^2-4a)/2)^((p+1)/2) = J + K sqrt(b^2-4a)  */
/* in a fast way. We notes that if a is a quadratic residue    */
/* mu can't be a proper element of the field extension         */
/* F_p (sqrt(b^2-4a))                                          */
/* so we must have K=0, or, in the same way,                   */
/* mu = (1/2) { (b/2 + sqrt(delta)/2)^((p+1)/2)                */
/*             +(b/2 - sqrt(delta)/2)^((p+1)/2 }               */
/* that is the (p+1)/2-th term of the sequence                 */
/* A_0 = 1,  A_1 = b/2,  A_{n+2}=b*A_{n+1}-a*A_{n}             */
/* All we need is the (p+1)/2-power of the matrix              */
/*       ( b  -a )                                             */
/*   A = ( 1   0 )    over Z/pZ                                */
/* The subroutine "mpower" returns it with about 8 log(p)      */
/* multiplications and 4 log(p) mod-reductions in Z/pZ,        */
/* using the standard "repeat-squaring" algorithm.             */

/* Field extension algorithm for square-root extraction through companion matrix powers */
/* returns two integers in [0,p-1] whose square are congruent to a (mod p)              */ 
msqrt(a ,p) := block([b:0, term],
   if mod(a, p) = 0 then return([0,0]),
   /* if not(primep(p)) then error("ERROR: Second argument must be a prime number."),   */
   if jacobi(a, p) # 1 then 
      error("ERROR: First argument must be a quadratic residue."),
   if p = 2 then return(mod(a, 2)),
   do (
      b : b+1, 
      if jacobi(b*b - 4*a, p) = -1 then return() ),
   /* print(b,"^2 - 4*",a," is a quadratic non-residue"), */
   term : mod(f2power(a, b, p, ?ash(p + 1, -1)), p),
   [term, p - term] )$
 

/* Shank's algorithm for square-root extraction                                         */
/* returns two integers in [0,p-1] whose square are congruent to a (mod p)              */
ssqrt(a, p) := block([nrflag:false, b:0, s:0, q:p-1, t,alpha,c,r, d],
   if mod(a, p) = 0 then return([0,0]),
   /* if not(primep(p)) then error("ERROR: Second argument must be a prime number."),   */
   if jacobi(a, p) # 1 then 
      error("ERROR: First argument must be a quadratic residue."),
   if p = 2 then return(mod(a, 2)),
   do (
      b : b+1, 
      if jacobi(b, p) = -1 then return() ),
   unless ?logbitp(0, q) do (
      s : s+1, 
      q : ?ash(q, -1) ),
   t : q, 
   alpha : inv_mod(a, p), 
   c : power_mod(b, t, p), 
   r : power_mod(a, ?ash((t + 1), -1), p),
   for i:1 thru s-1 do (
      d : mod(r*r*alpha, p), 
      for j:1 thru s-i-1 do d : mod(d*d, p),
      if mod(d + 1, p) = 0 then r : mod(r*c, p),
      c : mod(c*c, p) ),
   r : mod(r, p),
   [r, p - r] )$
 

/* Field extension algorithm for cubic-root extraction        */
/* For a cubic residue a and a prime p=1(mod 3) mcbrt finds   */
/* an irreducible polynomial of the form x^3+bx+a over F_p    */
/* so that -a=x^(p^2+p+1) and returns x^((p^2+p+1)/3)         */
/* computed over F_(p^3) = (F_p)/(x^3+bx+a)                   */
/* This subroutine returns three integers in [0,p-1]          */
/* whose third-power are congruent to a (mod p)               */ 
scbrt(a, p) := block( [x, b:1, h1,h2,h3, c,c_1,c_2, om,omega_1, p3],
   if mod(a, p) = 0 then return(0),
   /* if not primep(p) then error("ERROR: Second argument must be a prime number."), */
   if p = 2 then return(mod(a, 2)),
   if mod(p, 3) = 2 then return(power_mod(a, (?ash(p, 1) - 1)/3, p)),
   om : msqrt(-3, p), 
   p3 : (p - 1)/3,
   if power_mod(a, p3, p) # 1 then 
      error("ERROR: First argument must be a cubic residue."),
   unless redei(a, b, p, om[1], p3) do b : b+1,

   gf_minimal_set(p, x^3 + b*x + a), 
   h1 : gf_exp(x, p), /* get the benefit from gf_exp in numth.lisp (VvN) */
   h2 : gf_exp(h1, p3),
   h3 : gf_exp(x, (?ash(p, 1) + 1)/3),
   c : mod(- gf_mult(h2, h3), p),
   gf_unset(),

   omega_1 : mod((-1 + om[1])*(?ash(p + 1, -1)), p),
   c_1 : mod(omega_1*c, p),
   c_2 : mod(- c - c_1, p),
   [c, c_1, c_2] )$


/* Field extension algorithm for cubic-root extraction                     */
/* through companion matrix powers. This subroutine returns three integers */
/* in [0,p-1] whose third-power are congruent to a (mod p)                 */
mcbrt(a, p) := block([b:1, c,c_1,c_2, om,omega_1, p3],
   if mod(a, p) = 0 then return(0),
   /* if not(primep(p)) then error("ERROR: Second argument must be a prime number."), */
   if p = 2 then return(mod(a, 2)),
   if mod(p, 3) = 2 then return(power_mod(a, (?ash(p, 1) - 1)/3, p)),
   om : msqrt(-3, p), 
   p3 : (p - 1)/3,
   if power_mod(a, p3, p) # 1 then 
      error("ERROR: First argument must be a cubic residue."),
   unless redei(a, b, p, om[1], p3) do b : b+1,
   c : mod(- f3power(a, b, p, (1 + p*(p + 1))/3), p),
   omega_1 : mod((-1 + om[1])*(?ash(p + 1, -1)), p),
   c_1 : mod(omega_1*c, p),
   c_2 : mod(- c - c_1, p),
   [c, c_1, c_2] )$
 
/* For each prime p in the form 4k+1 we find two positive integers  */
/* a and b such that p=a^2+b^2. Useful to extend a Z-factorization  */
/* into a Z[i]-factorization (order of Gaussian integers)           */

qsplit(p) := block([m, a, b:1, c,d,e,f, k,j],
   if p = 2 then return([1,1]),
   m : msqrt(-1, p),
   if m[1] < m[2] then a : m[1] 
   else a : m[2],
   k : (a^2 + 1)/p,
   while k > 1 do (
      k : (a^2 + b^2)/p,   
      c : mod(a, k),
      d : mod(b, k),
      j : (c^2 + d^2)/k,
      e : (a*c + b*d)/k,
      f : (b*c - a*d)/k,
      a : abs(e),
      b : abs(f),
      k : j ),
   [a, b] )$         
 
 
/* For each prime p in the form 3k+1 we find two positive integers     */
/* a and b such that p=a^2+ab+b^2. Useful to extend a Z-factorization  */
/* into a Z[omega]-factorization (order of Eisenstein integers)        */ 
csplit(p):= block([m, a,b,c,d, t, x,y],
   if p = 3 then return([1,1]),
   m : msqrt(-3, p),
   if mod(m[1], 2) = 0 then b : m[2] 
   else b : m[1],
   a : (b^2 + 3)/(4*p), 
   c : p, 
   x : 0, 
   y : 1,
   while b # 1 do (
      if a > c then (
         d : a, 
         a : c, 
         c : d, 
         b : - b, 
         d : x, 
         x : - y, 
         y : d ),
      t : floor(b/?ash(a, 1)), 
      b : b - ?ash(a*t, 1), 
      c : c - t*(b + a*t), 
      x : x + t*y ),
   if x < 0 then 
      if y < - x then x : - (x + y) 
      else (x : - x, y : y - x), 
   if y < 0 then 
      if x < - y then y : - (x + y) 
      else (y : - y, x : x - y), 
   [x, y] )$
