Code coverage tests

This page documents the degree to which the PARI/GP source code is tested by our public test suite, distributed with the source distribution in directory src/test/. This is measured by the gcov utility; we then process gcov output using the lcov frond-end.

We test a few variants depending on Configure flags on the pari.math.u-bordeaux.fr machine (x86_64 architecture), and agregate them in the final report:

The target is to exceed 90% coverage for all mathematical modules (given that branches depending on DEBUGLEVEL or DEBUGMEM are not covered). This script is run to produce the results below.

LCOV - code coverage report
Current view: top level - basemath - bibli1.c (source / functions) Hit Total Coverage
Test: PARI/GP v2.18.0 lcov report (development 29644-f1a46412a2) Lines: 1190 1262 94.3 %
Date: 2024-10-12 09:06:38 Functions: 74 80 92.5 %
Legend: Lines: hit not hit

          Line data    Source code
       1             : /* Copyright (C) 2000  The PARI group.
       2             : 
       3             : This file is part of the PARI/GP package.
       4             : 
       5             : PARI/GP is free software; you can redistribute it and/or modify it under the
       6             : terms of the GNU General Public License as published by the Free Software
       7             : Foundation; either version 2 of the License, or (at your option) any later
       8             : version. It is distributed in the hope that it will be useful, but WITHOUT
       9             : ANY WARRANTY WHATSOEVER.
      10             : 
      11             : Check the License for details. You should have received a copy of it, along
      12             : with the package; see the file 'COPYING'. If not, write to the Free Software
      13             : Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
      14             : 
      15             : /********************************************************************/
      16             : /**                                                                **/
      17             : /**                 LLL Algorithm and close friends                **/
      18             : /**                                                                **/
      19             : /********************************************************************/
      20             : #include "pari.h"
      21             : #include "paripriv.h"
      22             : 
      23             : #define DEBUGLEVEL DEBUGLEVEL_qf
      24             : 
      25             : /********************************************************************/
      26             : /**             QR Factorization via Householder matrices          **/
      27             : /********************************************************************/
      28             : static int
      29    24476022 : no_prec_pb(GEN x)
      30             : {
      31    24401255 :   return (typ(x) != t_REAL || realprec(x) > DEFAULTPREC
      32    48877277 :                            || expo(x) < DEFAULTPREC>>1);
      33             : }
      34             : /* Find a Householder transformation which, applied to x[k..#x], zeroes
      35             :  * x[k+1..#x]; fill L = (mu_{i,j}). Return 0 if precision problem [obtained
      36             :  * a 0 vector], 1 otherwise */
      37             : static int
      38    24484909 : FindApplyQ(GEN x, GEN L, GEN B, long k, GEN Q, long prec)
      39             : {
      40    24484909 :   long i, lx = lg(x)-1;
      41    24484909 :   GEN x2, x1, xd = x + (k-1);
      42             : 
      43    24484909 :   x1 = gel(xd,1);
      44    24484909 :   x2 = mpsqr(x1);
      45    24483870 :   if (k < lx)
      46             :   {
      47    19295817 :     long lv = lx - (k-1) + 1;
      48    19295817 :     GEN beta, Nx, v = cgetg(lv, t_VEC);
      49    76178925 :     for (i=2; i<lv; i++) {
      50    56883478 :       x2 = mpadd(x2, mpsqr(gel(xd,i)));
      51    56882702 :       gel(v,i) = gel(xd,i);
      52             :     }
      53    19295447 :     if (!signe(x2)) return 0;
      54    19287294 :     Nx = gsqrt(x2, prec); if (signe(x1) < 0) setsigne(Nx, -1);
      55    19288317 :     gel(v,1) = mpadd(x1, Nx);
      56             : 
      57    19287519 :     if (!signe(x1))
      58      728795 :       beta = gtofp(x2, prec); /* make sure typ(beta) != t_INT */
      59             :     else
      60    18558724 :       beta = mpadd(x2, mpmul(Nx,x1));
      61    19287754 :     gel(Q,k) = mkvec2(invr(beta), v);
      62             : 
      63    19288074 :     togglesign(Nx);
      64    19287795 :     gcoeff(L,k,k) = Nx;
      65             :   }
      66             :   else
      67     5188053 :     gcoeff(L,k,k) = gel(x,k);
      68    24475848 :   gel(B,k) = x2;
      69    70125992 :   for (i=1; i<k; i++) gcoeff(L,k,i) = gel(x,i);
      70    24475848 :   return no_prec_pb(x2);
      71             : }
      72             : 
      73             : /* apply Householder transformation Q = [beta,v] to r with t_INT/t_REAL
      74             :  * coefficients, in place: r -= ((0|v).r * beta) v */
      75             : static void
      76    45659735 : ApplyQ(GEN Q, GEN r)
      77             : {
      78    45659735 :   GEN s, rd, beta = gel(Q,1), v = gel(Q,2);
      79    45659735 :   long i, l = lg(v), lr = lg(r);
      80             : 
      81    45659735 :   rd = r + (lr - l);
      82    45659735 :   s = mpmul(gel(v,1), gel(rd,1));
      83   473102226 :   for (i=2; i<l; i++) s = mpadd(s, mpmul(gel(v,i) ,gel(rd,i)));
      84    45655578 :   s = mpmul(beta, s);
      85   518950948 :   for (i=1; i<l; i++)
      86   473295320 :     if (signe(gel(v,i))) gel(rd,i) = mpsub(gel(rd,i), mpmul(s, gel(v,i)));
      87    45655628 : }
      88             : /* apply Q[1], ..., Q[j-1] to r */
      89             : static GEN
      90    16816281 : ApplyAllQ(GEN Q, GEN r, long j)
      91             : {
      92    16816281 :   pari_sp av = avma;
      93             :   long i;
      94    16816281 :   r = leafcopy(r);
      95    62473514 :   for (i=1; i<j; i++) ApplyQ(gel(Q,i), r);
      96    16814072 :   return gerepilecopy(av, r);
      97             : }
      98             : 
      99             : /* same, arbitrary coefficients [20% slower for t_REAL at DEFAULTPREC] */
     100             : static void
     101       22113 : RgC_ApplyQ(GEN Q, GEN r)
     102             : {
     103       22113 :   GEN s, rd, beta = gel(Q,1), v = gel(Q,2);
     104       22113 :   long i, l = lg(v), lr = lg(r);
     105             : 
     106       22113 :   rd = r + (lr - l);
     107       22113 :   s = gmul(gel(v,1), gel(rd,1));
     108      464373 :   for (i=2; i<l; i++) s = gadd(s, gmul(gel(v,i) ,gel(rd,i)));
     109       22113 :   s = gmul(beta, s);
     110      486486 :   for (i=1; i<l; i++)
     111      464373 :     if (signe(gel(v,i))) gel(rd,i) = gsub(gel(rd,i), gmul(s, gel(v,i)));
     112       22113 : }
     113             : static GEN
     114         567 : RgC_ApplyAllQ(GEN Q, GEN r, long j)
     115             : {
     116         567 :   pari_sp av = avma;
     117             :   long i;
     118         567 :   r = leafcopy(r);
     119       22680 :   for (i=1; i<j; i++) RgC_ApplyQ(gel(Q,i), r);
     120         567 :   return gerepilecopy(av, r);
     121             : }
     122             : 
     123             : int
     124          21 : RgM_QR_init(GEN x, GEN *pB, GEN *pQ, GEN *pL, long prec)
     125             : {
     126          21 :   x = RgM_gtomp(x, prec);
     127          21 :   return QR_init(x, pB, pQ, pL, prec);
     128             : }
     129             : 
     130             : static void
     131          35 : check_householder(GEN Q)
     132             : {
     133          35 :   long i, l = lg(Q);
     134          35 :   if (typ(Q) != t_VEC) pari_err_TYPE("mathouseholder", Q);
     135         854 :   for (i = 1; i < l; i++)
     136             :   {
     137         826 :     GEN q = gel(Q,i), v;
     138         826 :     if (typ(q) != t_VEC || lg(q) != 3) pari_err_TYPE("mathouseholder", Q);
     139         826 :     v = gel(q,2);
     140         826 :     if (typ(v) != t_VEC || lg(v)+i-2 != l) pari_err_TYPE("mathouseholder", Q);
     141             :   }
     142          28 : }
     143             : 
     144             : GEN
     145          35 : mathouseholder(GEN Q, GEN v)
     146             : {
     147          35 :   long l = lg(Q);
     148          35 :   check_householder(Q);
     149          28 :   switch(typ(v))
     150             :   {
     151          14 :     case t_MAT:
     152             :     {
     153             :       long lx, i;
     154          14 :       GEN M = cgetg_copy(v, &lx);
     155          14 :       if (lx == 1) return M;
     156          14 :       if (lgcols(v) != l+1) pari_err_TYPE("mathouseholder", v);
     157         574 :       for (i = 1; i < lx; i++) gel(M,i) = RgC_ApplyAllQ(Q, gel(v,i), l);
     158          14 :       return M;
     159             :     }
     160           7 :     case t_COL: if (lg(v) == l+1) break;
     161             :       /* fall through */
     162           7 :     default: pari_err_TYPE("mathouseholder", v);
     163             :   }
     164           7 :   return RgC_ApplyAllQ(Q, v, l);
     165             : }
     166             : 
     167             : GEN
     168          35 : matqr(GEN x, long flag, long prec)
     169             : {
     170          35 :   pari_sp av = avma;
     171             :   GEN B, Q, L;
     172          35 :   long n = lg(x)-1;
     173          35 :   if (typ(x) != t_MAT) pari_err_TYPE("matqr",x);
     174          35 :   if (!n)
     175             :   {
     176          14 :     if (!flag) retmkvec2(cgetg(1,t_MAT),cgetg(1,t_MAT));
     177           7 :     retmkvec2(cgetg(1,t_VEC),cgetg(1,t_MAT));
     178             :   }
     179          21 :   if (n != nbrows(x)) pari_err_DIM("matqr");
     180          21 :   if (!RgM_QR_init(x, &B,&Q,&L, prec)) pari_err_PREC("matqr");
     181          21 :   if (!flag) Q = shallowtrans(mathouseholder(Q, matid(n)));
     182          21 :   return gerepilecopy(av, mkvec2(Q, shallowtrans(L)));
     183             : }
     184             : 
     185             : /* compute B = | x[k] |^2, Q = Householder transforms and L = mu_{i,j} */
     186             : int
     187     7668333 : QR_init(GEN x, GEN *pB, GEN *pQ, GEN *pL, long prec)
     188             : {
     189     7668333 :   long j, k = lg(x)-1;
     190     7668333 :   GEN B = cgetg(k+1, t_VEC), Q = cgetg(k, t_VEC), L = zeromatcopy(k,k);
     191    29943347 :   for (j=1; j<=k; j++)
     192             :   {
     193    24484564 :     GEN r = gel(x,j);
     194    24484564 :     if (j > 1) r = ApplyAllQ(Q, r, j);
     195    24484891 :     if (!FindApplyQ(r, L, B, j, Q, prec)) return 0;
     196             :   }
     197     5458783 :   *pB = B; *pQ = Q; *pL = L; return 1;
     198             : }
     199             : /* x a square t_MAT with t_INT / t_REAL entries and maximal rank. Return
     200             :  * qfgaussred(x~*x) */
     201             : GEN
     202      297121 : gaussred_from_QR(GEN x, long prec)
     203             : {
     204      297121 :   long j, k = lg(x)-1;
     205             :   GEN B, Q, L;
     206      297121 :   if (!QR_init(x, &B,&Q,&L, prec)) return NULL;
     207     1061390 :   for (j=1; j<k; j++)
     208             :   {
     209      764261 :     GEN m = gel(L,j), invNx = invr(gel(m,j));
     210             :     long i;
     211      764273 :     gel(m,j) = gel(B,j);
     212     2958539 :     for (i=j+1; i<=k; i++) gel(m,i) = mpmul(invNx, gel(m,i));
     213             :   }
     214      297129 :   gcoeff(L,j,j) = gel(B,j);
     215      297129 :   return shallowtrans(L);
     216             : }
     217             : GEN
     218       14259 : R_from_QR(GEN x, long prec)
     219             : {
     220             :   GEN B, Q, L;
     221       14259 :   if (!QR_init(x, &B,&Q,&L, prec)) return NULL;
     222       14245 :   return shallowtrans(L);
     223             : }
     224             : 
     225             : /********************************************************************/
     226             : /**             QR Factorization via Gram-Schmidt                  **/
     227             : /********************************************************************/
     228             : 
     229             : /* return Gram-Schmidt orthogonal basis (f) attached to (e), B is the
     230             :  * vector of the (f_i . f_i)*/
     231             : GEN
     232       47750 : RgM_gram_schmidt(GEN e, GEN *ptB)
     233             : {
     234       47750 :   long i,j,lx = lg(e);
     235       47750 :   GEN f = RgM_shallowcopy(e), B, iB;
     236             : 
     237       47750 :   B = cgetg(lx, t_VEC);
     238       47750 :   iB= cgetg(lx, t_VEC);
     239             : 
     240      102151 :   for (i=1;i<lx;i++)
     241             :   {
     242       54401 :     GEN p1 = NULL;
     243       54401 :     pari_sp av = avma;
     244      116445 :     for (j=1; j<i; j++)
     245             :     {
     246       62044 :       GEN mu = gmul(RgV_dotproduct(gel(e,i),gel(f,j)), gel(iB,j));
     247       62044 :       GEN p2 = gmul(mu, gel(f,j));
     248       62044 :       p1 = p1? gadd(p1,p2): p2;
     249             :     }
     250       54401 :     p1 = p1? gerepileupto(av, gsub(gel(e,i), p1)): gel(e,i);
     251       54401 :     gel(f,i) = p1;
     252       54401 :     gel(B,i) = RgV_dotsquare(gel(f,i));
     253       54401 :     gel(iB,i) = ginv(gel(B,i));
     254             :   }
     255       47750 :   *ptB = B; return f;
     256             : }
     257             : 
     258             : /* B a Z-basis (which the caller should LLL-reduce for efficiency), t a vector.
     259             :  * Apply Babai's nearest plane algorithm to (B,t) */
     260             : GEN
     261       47750 : RgM_Babai(GEN B, GEN t)
     262             : {
     263       47750 :   GEN C, N, G = RgM_gram_schmidt(B, &N), b = t;
     264       47750 :   long j, n = lg(B)-1;
     265             : 
     266       47750 :   C = cgetg(n+1,t_COL);
     267      102151 :   for (j = n; j > 0; j--)
     268             :   {
     269       54401 :     GEN c = gdiv( RgV_dotproduct(b, gel(G,j)), gel(N,j) );
     270             :     long e;
     271       54401 :     c = grndtoi(c,&e);
     272       54401 :     if (e >= 0) return NULL;
     273       54401 :     if (signe(c)) b = RgC_sub(b, RgC_Rg_mul(gel(B,j), c));
     274       54401 :     gel(C,j) = c;
     275             :   }
     276       47750 :   return C;
     277             : }
     278             : 
     279             : /********************************************************************/
     280             : /**                                                                **/
     281             : /**                          LLL ALGORITHM                         **/
     282             : /**                                                                **/
     283             : /********************************************************************/
     284             : /* Def: a matrix M is said to be -partially reduced- if | m1 +- m2 | >= |m1|
     285             :  * for any two columns m1 != m2, in M.
     286             :  *
     287             :  * Input: an integer matrix mat whose columns are linearly independent. Find
     288             :  * another matrix T such that mat * T is partially reduced.
     289             :  *
     290             :  * Output: mat * T if flag = 0;  T if flag != 0,
     291             :  *
     292             :  * This routine is designed to quickly reduce lattices in which one row
     293             :  * is huge compared to the other rows.  For example, when searching for a
     294             :  * polynomial of degree 3 with root a mod N, the four input vectors might
     295             :  * be the coefficients of
     296             :  *     X^3 - (a^3 mod N), X^2 - (a^2 mod N), X - (a mod N), N.
     297             :  * All four constant coefficients are O(p) and the rest are O(1). By the
     298             :  * pigeon-hole principle, the coefficients of the smallest vector in the
     299             :  * lattice are O(p^(1/4)), hence significant reduction of vector lengths
     300             :  * can be anticipated.
     301             :  *
     302             :  * An improved algorithm would look only at the leading digits of dot*.  It
     303             :  * would use single-precision calculations as much as possible.
     304             :  *
     305             :  * Original code: Peter Montgomery (1994) */
     306             : static GEN
     307          35 : lllintpartialall(GEN m, long flag)
     308             : {
     309          35 :   const long ncol = lg(m)-1;
     310          35 :   const pari_sp av = avma;
     311             :   GEN tm1, tm2, mid;
     312             : 
     313          35 :   if (ncol <= 1) return flag? matid(ncol): gcopy(m);
     314             : 
     315          14 :   tm1 = flag? matid(ncol): NULL;
     316             :   {
     317          14 :     const pari_sp av2 = avma;
     318          14 :     GEN dot11 = ZV_dotsquare(gel(m,1));
     319          14 :     GEN dot22 = ZV_dotsquare(gel(m,2));
     320          14 :     GEN dot12 = ZV_dotproduct(gel(m,1), gel(m,2));
     321          14 :     GEN tm  = matid(2); /* For first two columns only */
     322             : 
     323          14 :     int progress = 0;
     324          14 :     long npass2 = 0;
     325             : 
     326             : /* Row reduce the first two columns of m. Our best result so far is
     327             :  * (first two columns of m)*tm.
     328             :  *
     329             :  * Initially tm = 2 x 2 identity matrix.
     330             :  * Inner products of the reduced matrix are in dot11, dot12, dot22. */
     331          49 :     while (npass2 < 2 || progress)
     332             :     {
     333          42 :       GEN dot12new, q = diviiround(dot12, dot22);
     334             : 
     335          35 :       npass2++; progress = signe(q);
     336          35 :       if (progress)
     337             :       {/* Conceptually replace (v1, v2) by (v1 - q*v2, v2), where v1 and v2
     338             :         * represent the reduced basis for the first two columns of the matrix.
     339             :         * We do this by updating tm and the inner products. */
     340          21 :         togglesign(q);
     341          21 :         dot12new = addii(dot12, mulii(q, dot22));
     342          21 :         dot11 = addii(dot11, mulii(q, addii(dot12, dot12new)));
     343          21 :         dot12 = dot12new;
     344          21 :         ZC_lincomb1_inplace(gel(tm,1), gel(tm,2), q);
     345             :       }
     346             : 
     347             :       /* Interchange the output vectors v1 and v2.  */
     348          35 :       swap(dot11,dot22);
     349          35 :       swap(gel(tm,1), gel(tm,2));
     350             : 
     351             :       /* Occasionally (including final pass) do garbage collection.  */
     352          35 :       if ((npass2 & 0xff) == 0 || !progress)
     353          14 :         gerepileall(av2, 4, &dot11,&dot12,&dot22,&tm);
     354             :     } /* while npass2 < 2 || progress */
     355             : 
     356             :     {
     357             :       long i;
     358           7 :       GEN det12 = subii(mulii(dot11, dot22), sqri(dot12));
     359             : 
     360           7 :       mid = cgetg(ncol+1, t_MAT);
     361          21 :       for (i = 1; i <= 2; i++)
     362             :       {
     363          14 :         GEN tmi = gel(tm,i);
     364          14 :         if (tm1)
     365             :         {
     366          14 :           GEN tm1i = gel(tm1,i);
     367          14 :           gel(tm1i,1) = gel(tmi,1);
     368          14 :           gel(tm1i,2) = gel(tmi,2);
     369             :         }
     370          14 :         gel(mid,i) = ZC_lincomb(gel(tmi,1),gel(tmi,2), gel(m,1),gel(m,2));
     371             :       }
     372          42 :       for (i = 3; i <= ncol; i++)
     373             :       {
     374          35 :         GEN c = gel(m,i);
     375          35 :         GEN dot1i = ZV_dotproduct(gel(mid,1), c);
     376          35 :         GEN dot2i = ZV_dotproduct(gel(mid,2), c);
     377             :        /* ( dot11  dot12 ) (q1)   ( dot1i )
     378             :         * ( dot12  dot22 ) (q2) = ( dot2i )
     379             :         *
     380             :         * Round -q1 and -q2 to nearest integer. Then compute
     381             :         *   c - q1*mid[1] - q2*mid[2].
     382             :         * This will be approximately orthogonal to the first two vectors in
     383             :         * the new basis. */
     384          35 :         GEN q1neg = subii(mulii(dot12, dot2i), mulii(dot22, dot1i));
     385          35 :         GEN q2neg = subii(mulii(dot12, dot1i), mulii(dot11, dot2i));
     386             : 
     387          35 :         q1neg = diviiround(q1neg, det12);
     388          35 :         q2neg = diviiround(q2neg, det12);
     389          35 :         if (tm1)
     390             :         {
     391          35 :           gcoeff(tm1,1,i) = addii(mulii(q1neg, gcoeff(tm,1,1)),
     392          35 :                                   mulii(q2neg, gcoeff(tm,1,2)));
     393          35 :           gcoeff(tm1,2,i) = addii(mulii(q1neg, gcoeff(tm,2,1)),
     394          35 :                                   mulii(q2neg, gcoeff(tm,2,2)));
     395             :         }
     396          35 :         gel(mid,i) = ZC_add(c, ZC_lincomb(q1neg,q2neg, gel(mid,1),gel(mid,2)));
     397             :       } /* for i */
     398             :     } /* local block */
     399             :   }
     400           7 :   if (DEBUGLEVEL>6)
     401             :   {
     402           0 :     if (tm1) err_printf("tm1 = %Ps",tm1);
     403           0 :     err_printf("mid = %Ps",mid); /* = m * tm1 */
     404             :   }
     405           7 :   gerepileall(av, tm1? 2: 1, &mid, &tm1);
     406             :   {
     407             :    /* For each pair of column vectors v and w in mid * tm2,
     408             :     * try to replace (v, w) by (v, v - q*w) for some q.
     409             :     * We compute all inner products and check them repeatedly. */
     410           7 :     const pari_sp av3 = avma;
     411           7 :     long i, j, npass = 0, e = LONG_MAX;
     412           7 :     GEN dot = cgetg(ncol+1, t_MAT); /* scalar products */
     413             : 
     414           7 :     tm2 = matid(ncol);
     415          56 :     for (i=1; i <= ncol; i++)
     416             :     {
     417          49 :       gel(dot,i) = cgetg(ncol+1,t_COL);
     418         245 :       for (j=1; j <= i; j++)
     419         196 :         gcoeff(dot,j,i) = gcoeff(dot,i,j) = ZV_dotproduct(gel(mid,i),gel(mid,j));
     420             :     }
     421             :     for(;;)
     422          35 :     {
     423          42 :       long reductions = 0, olde = e;
     424         336 :       for (i=1; i <= ncol; i++)
     425             :       {
     426             :         long ijdif;
     427        2058 :         for (ijdif=1; ijdif < ncol; ijdif++)
     428             :         {
     429             :           long d, k1, k2;
     430             :           GEN codi, q;
     431             : 
     432        1764 :           j = i + ijdif; if (j > ncol) j -= ncol;
     433             :           /* let k1, resp. k2,  index of larger, resp. smaller, column */
     434        1764 :           if (cmpii(gcoeff(dot,i,i), gcoeff(dot,j,j)) > 0) { k1 = i; k2 = j; }
     435        1022 :           else                                             { k1 = j; k2 = i; }
     436        1764 :           codi = gcoeff(dot,k2,k2);
     437        1764 :           q = signe(codi)? diviiround(gcoeff(dot,k1,k2), codi): gen_0;
     438        1764 :           if (!signe(q)) continue;
     439             : 
     440             :           /* Try to subtract a multiple of column k2 from column k1.  */
     441         700 :           reductions++; togglesign_safe(&q);
     442         700 :           ZC_lincomb1_inplace(gel(tm2,k1), gel(tm2,k2), q);
     443         700 :           ZC_lincomb1_inplace(gel(dot,k1), gel(dot,k2), q);
     444         700 :           gcoeff(dot,k1,k1) = addii(gcoeff(dot,k1,k1),
     445         700 :                                     mulii(q, gcoeff(dot,k2,k1)));
     446        5600 :           for (d = 1; d <= ncol; d++) gcoeff(dot,k1,d) = gcoeff(dot,d,k1);
     447             :         } /* for ijdif */
     448         294 :         if (gc_needed(av3,2))
     449             :         {
     450           0 :           if(DEBUGMEM>1) pari_warn(warnmem,"lllintpartialall");
     451           0 :           gerepileall(av3, 2, &dot,&tm2);
     452             :         }
     453             :       } /* for i */
     454          42 :       if (!reductions) break;
     455          35 :       e = 0;
     456         280 :       for (i = 1; i <= ncol; i++) e += expi( gcoeff(dot,i,i) );
     457          35 :       if (e == olde) break;
     458          35 :       if (DEBUGLEVEL>6)
     459             :       {
     460           0 :         npass++;
     461           0 :         err_printf("npass = %ld, red. last time = %ld, log_2(det) ~ %ld\n\n",
     462             :                     npass, reductions, e);
     463             :       }
     464             :     } /* for(;;)*/
     465             : 
     466             :    /* Sort columns so smallest comes first in m * tm1 * tm2.
     467             :     * Use insertion sort. */
     468          49 :     for (i = 1; i < ncol; i++)
     469             :     {
     470          42 :       long j, s = i;
     471             : 
     472         189 :       for (j = i+1; j <= ncol; j++)
     473         147 :         if (cmpii(gcoeff(dot,s,s),gcoeff(dot,j,j)) > 0) s = j;
     474          42 :       if (i != s)
     475             :       { /* Exchange with proper column; only the diagonal of dot is updated */
     476          28 :         swap(gel(tm2,i), gel(tm2,s));
     477          28 :         swap(gcoeff(dot,i,i), gcoeff(dot,s,s));
     478             :       }
     479             :     }
     480             :   } /* local block */
     481           7 :   return gerepileupto(av, ZM_mul(tm1? tm1: mid, tm2));
     482             : }
     483             : 
     484             : GEN
     485          35 : lllintpartial(GEN mat) { return lllintpartialall(mat,1); }
     486             : 
     487             : GEN
     488           0 : lllintpartial_inplace(GEN mat) { return lllintpartialall(mat,0); }
     489             : 
     490             : /********************************************************************/
     491             : /**                                                                **/
     492             : /**                    COPPERSMITH ALGORITHM                       **/
     493             : /**           Finding small roots of univariate equations.         **/
     494             : /**                                                                **/
     495             : /********************************************************************/
     496             : 
     497             : static int
     498         882 : check(double b, double x, double rho, long d, long dim, long delta, long t)
     499             : {
     500         882 :   double cond = delta * (d * (delta+1) - 2*b*dim + rho * (delta-1 + 2*t))
     501         882 :                 + x*dim*(dim - 1);
     502         882 :   if (DEBUGLEVEL >= 4)
     503           0 :     err_printf("delta = %d, t = %d (%.1lf)\n", delta, t, cond);
     504         882 :   return (cond <= 0);
     505             : }
     506             : 
     507             : static void
     508          21 : choose_params(GEN P, GEN N, GEN X, GEN B, long *pdelta, long *pt)
     509             : {
     510          21 :   long d = degpol(P), dim;
     511          21 :   GEN P0 = leading_coeff(P);
     512          21 :   double logN = gtodouble(glog(N, DEFAULTPREC)), x, b, rho;
     513          21 :   x = gtodouble(glog(X, DEFAULTPREC)) / logN;
     514          21 :   b = B? gtodouble(glog(B, DEFAULTPREC)) / logN: 1.;
     515          21 :   if (x * d >= b * b) pari_err_OVERFLOW("zncoppersmith [bound too large]");
     516             :   /* TODO : remove P0 completely */
     517          14 :   rho = is_pm1(P0)? 0: gtodouble(glog(P0, DEFAULTPREC)) / logN;
     518             : 
     519             :   /* Enumerate (delta,t) by increasing lattice dimension */
     520          14 :   for(dim = d + 1;; dim++)
     521         161 :   {
     522             :     long delta, t; /* dim = d*delta + t in the loop */
     523        1043 :     for (delta = 0, t = dim; t >= 0; delta++, t -= d)
     524         882 :       if (check(b,x,rho,d,dim,delta,t)) { *pdelta = delta; *pt = t; return; }
     525             :   }
     526             : }
     527             : 
     528             : static int
     529       14021 : sol_OK(GEN x, GEN N, GEN B)
     530       14021 : { return B? (cmpii(gcdii(x,N),B) >= 0): dvdii(x,N); }
     531             : /* deg(P) > 0, x >= 0. Find all j such that gcd(P(j), N) >= B, |j| <= x */
     532             : static GEN
     533           7 : do_exhaustive(GEN P, GEN N, long x, GEN B)
     534             : {
     535           7 :   GEN Pe, Po, sol = vecsmalltrunc_init(2*x + 2);
     536             :   pari_sp av;
     537             :   long j;
     538           7 :   RgX_even_odd(P, &Pe,&Po); av = avma;
     539           7 :   if (sol_OK(gel(P,2), N,B)) vecsmalltrunc_append(sol, 0);
     540        7007 :   for (j = 1; j <= x; j++, set_avma(av))
     541             :   {
     542        7000 :     GEN j2 = sqru(j), E = FpX_eval(Pe,j2,N), O = FpX_eval(Po,j2,N);
     543        7000 :     if (sol_OK(addmuliu(E,O,j), N,B)) vecsmalltrunc_append(sol, j);
     544        7000 :     if (sol_OK(submuliu(E,O,j), N,B)) vecsmalltrunc_append(sol,-j);
     545             :   }
     546           7 :   vecsmall_sort(sol); return zv_to_ZV(sol);
     547             : }
     548             : 
     549             : /* General Coppersmith, look for a root x0 <= p, p >= B, p | N, |x0| <= X.
     550             :  * B = N coded as NULL */
     551             : GEN
     552          35 : zncoppersmith(GEN P, GEN N, GEN X, GEN B)
     553             : {
     554             :   GEN Q, R, N0, M, sh, short_pol, *Xpowers, sol, nsp, cP, Z;
     555          35 :   long delta, i, j, row, d, l, t, dim, bnd = 10;
     556          35 :   const ulong X_SMALL = 1000;
     557          35 :   pari_sp av = avma;
     558             : 
     559          35 :   if (typ(P) != t_POL || !RgX_is_ZX(P)) pari_err_TYPE("zncoppersmith",P);
     560          28 :   if (typ(N) != t_INT) pari_err_TYPE("zncoppersmith",N);
     561          28 :   if (typ(X) != t_INT) {
     562           7 :     X = gfloor(X);
     563           7 :     if (typ(X) != t_INT) pari_err_TYPE("zncoppersmith",X);
     564             :   }
     565          28 :   if (signe(X) < 0) pari_err_DOMAIN("zncoppersmith", "X", "<", gen_0, X);
     566          28 :   P = FpX_red(P, N); d = degpol(P);
     567          28 :   if (d == 0) { set_avma(av); return cgetg(1, t_VEC); }
     568          28 :   if (d < 0) pari_err_ROOTS0("zncoppersmith");
     569          28 :   if (B && typ(B) != t_INT) B = gceil(B);
     570          28 :   if (abscmpiu(X, X_SMALL) <= 0)
     571           7 :     return gerepileupto(av, do_exhaustive(P, N, itos(X), B));
     572             : 
     573          21 :   if (B && equalii(B,N)) B = NULL;
     574          21 :   if (B) bnd = 1; /* bnd-hack is only for the case B = N */
     575          21 :   cP = gel(P,d+2);
     576          21 :   if (!gequal1(cP))
     577             :   {
     578             :     GEN r, z;
     579          14 :     gel(P,d+2) = cP = bezout(cP, N, &z, &r);
     580          35 :     for (j = 0; j < d; j++) gel(P,j+2) = Fp_mul(gel(P,j+2), z, N);
     581          14 :     if (!is_pm1(cP))
     582             :     {
     583           7 :       P = Q_primitive_part(P, &cP);
     584           7 :       if (cP) { N = diviiexact(N,cP); B = gceil(gdiv(B, cP)); }
     585             :     }
     586             :   }
     587          21 :   if (DEBUGLEVEL >= 2) err_printf("Modified P: %Ps\n", P);
     588             : 
     589          21 :   choose_params(P, N, X, B, &delta, &t);
     590          14 :   if (DEBUGLEVEL >= 2)
     591           0 :     err_printf("Init: trying delta = %d, t = %d\n", delta, t);
     592             :   for(;;)
     593             :   {
     594          14 :     dim = d * delta + t;
     595             :     /* TODO: In case of failure do not recompute the full vector */
     596          14 :     Xpowers = (GEN*)new_chunk(dim + 1);
     597          14 :     Xpowers[0] = gen_1;
     598         217 :     for (j = 1; j <= dim; j++) Xpowers[j] = mulii(Xpowers[j-1], X);
     599             : 
     600             :     /* TODO: in case of failure, use the part of the matrix already computed */
     601          14 :     M = zeromatcopy(dim,dim);
     602             : 
     603             :     /* Rows of M correspond to the polynomials
     604             :      * N^delta, N^delta Xi, ... N^delta (Xi)^d-1,
     605             :      * N^(delta-1)P(Xi), N^(delta-1)XiP(Xi), ... N^(delta-1)P(Xi)(Xi)^d-1,
     606             :      * ...
     607             :      * P(Xi)^delta, XiP(Xi)^delta, ..., P(Xi)^delta(Xi)^t-1 */
     608          42 :     for (j = 1; j <= d;   j++) gcoeff(M, j, j) = gel(Xpowers,j-1);
     609             : 
     610             :     /* P-part */
     611          14 :     if (delta) row = d + 1; else row = 0;
     612             : 
     613          14 :     Q = P;
     614          70 :     for (i = 1; i < delta; i++)
     615             :     {
     616         182 :       for (j = 0; j < d; j++,row++)
     617        1239 :         for (l = j + 1; l <= row; l++)
     618        1113 :           gcoeff(M, l, row) = mulii(Xpowers[l-1], gel(Q,l-j+1));
     619          56 :       Q = ZX_mul(Q, P);
     620             :     }
     621          63 :     for (j = 0; j < t; row++, j++)
     622         490 :       for (l = j + 1; l <= row; l++)
     623         441 :         gcoeff(M, l, row) = mulii(Xpowers[l-1], gel(Q,l-j+1));
     624             : 
     625             :     /* N-part */
     626          14 :     row = dim - t; N0 = N;
     627          84 :     while (row >= 1)
     628             :     {
     629         224 :       for (j = 0; j < d; j++,row--)
     630        1421 :         for (l = 1; l <= row; l++)
     631        1267 :           gcoeff(M, l, row) = mulii(gmael(M, row, l), N0);
     632          70 :       if (row >= 1) N0 = mulii(N0, N);
     633             :     }
     634             :     /* Z is the upper bound for the L^1 norm of the polynomial,
     635             :        ie. N^delta if B = N, B^delta otherwise */
     636          14 :     if (B) Z = powiu(B, delta); else Z = N0;
     637             : 
     638          14 :     if (DEBUGLEVEL >= 2)
     639             :     {
     640           0 :       if (DEBUGLEVEL >= 6) err_printf("Matrix to be reduced:\n%Ps\n", M);
     641           0 :       err_printf("Entering LLL\nbitsize bound: %ld\n", expi(Z));
     642           0 :       err_printf("expected shvector bitsize: %ld\n", expi(ZM_det_triangular(M))/dim);
     643             :     }
     644             : 
     645          14 :     sh = ZM_lll(M, 0.75, LLL_INPLACE);
     646             :     /* Take the first vector if it is non constant */
     647          14 :     short_pol = gel(sh,1);
     648          14 :     if (ZV_isscalar(short_pol)) short_pol = gel(sh, 2);
     649             : 
     650          14 :     nsp = gen_0;
     651         217 :     for (j = 1; j <= dim; j++) nsp = addii(nsp, absi_shallow(gel(short_pol,j)));
     652             : 
     653          14 :     if (DEBUGLEVEL >= 2)
     654             :     {
     655           0 :       err_printf("Candidate: %Ps\n", short_pol);
     656           0 :       err_printf("bitsize Norm: %ld\n", expi(nsp));
     657           0 :       err_printf("bitsize bound: %ld\n", expi(mului(bnd, Z)));
     658             :     }
     659          14 :     if (cmpii(nsp, mului(bnd, Z)) < 0) break; /* SUCCESS */
     660             : 
     661             :     /* Failed with the precomputed or supplied value */
     662           0 :     if (++t == d) { delta++; t = 1; }
     663           0 :     if (DEBUGLEVEL >= 2)
     664           0 :       err_printf("Increasing dim, delta = %d t = %d\n", delta, t);
     665             :   }
     666          14 :   bnd = itos(divii(nsp, Z)) + 1;
     667             : 
     668          14 :   while (!signe(gel(short_pol,dim))) dim--;
     669             : 
     670          14 :   R = cgetg(dim + 2, t_POL); R[1] = P[1];
     671         217 :   for (j = 1; j <= dim; j++)
     672         203 :     gel(R,j+1) = diviiexact(gel(short_pol,j), Xpowers[j-1]);
     673          14 :   gel(R,2) = subii(gel(R,2), mului(bnd - 1, N0));
     674             : 
     675          14 :   sol = cgetg(1, t_VEC);
     676          84 :   for (i = -bnd + 1; i < bnd; i++)
     677             :   {
     678          70 :     GEN r = nfrootsQ(R);
     679          70 :     if (DEBUGLEVEL >= 2) err_printf("Roots: %Ps\n", r);
     680          91 :     for (j = 1; j < lg(r); j++)
     681             :     {
     682          21 :       GEN z = gel(r,j);
     683          21 :       if (typ(z) == t_INT && sol_OK(FpX_eval(P,z,N), N,B))
     684          14 :         sol = shallowconcat(sol, z);
     685             :     }
     686          70 :     if (i < bnd) gel(R,2) = addii(gel(R,2), Z);
     687             :   }
     688          14 :   return gerepileupto(av, ZV_sort_uniq(sol));
     689             : }
     690             : 
     691             : /********************************************************************/
     692             : /**                                                                **/
     693             : /**                   LINEAR & ALGEBRAIC DEPENDENCE                **/
     694             : /**                                                                **/
     695             : /********************************************************************/
     696             : 
     697             : static int
     698        1634 : real_indep(GEN re, GEN im, long bit)
     699             : {
     700        1634 :   GEN d = gsub(gmul(gel(re,1),gel(im,2)), gmul(gel(re,2),gel(im,1)));
     701        1634 :   return (!gequal0(d) && gexpo(d) > - bit);
     702             : }
     703             : 
     704             : GEN
     705        8813 : lindepfull_bit(GEN x, long bit)
     706             : {
     707        8813 :   long lx = lg(x), ly, i, j;
     708             :   GEN re, im, M;
     709             : 
     710        8813 :   if (! is_vec_t(typ(x))) pari_err_TYPE("lindep2",x);
     711        8813 :   if (lx <= 2)
     712             :   {
     713          21 :     if (lx == 2 && gequal0(x)) return matid(1);
     714          14 :     return NULL;
     715             :   }
     716        8792 :   re = real_i(x);
     717        8792 :   im = imag_i(x);
     718             :   /* independent over R ? */
     719        8792 :   if (lx == 3 && real_indep(re,im,bit)) return NULL;
     720        8778 :   if (gequal0(im)) im = NULL;
     721        8778 :   ly = im? lx+2: lx+1;
     722        8778 :   M = cgetg(lx,t_MAT);
     723       41234 :   for (i=1; i<lx; i++)
     724             :   {
     725       32456 :     GEN c = cgetg(ly,t_COL); gel(M,i) = c;
     726      170460 :     for (j=1; j<lx; j++) gel(c,j) = gen_0;
     727       32456 :     gel(c,i) = gen_1;
     728       32456 :     gel(c,lx)           = gtrunc2n(gel(re,i), bit);
     729       32456 :     if (im) gel(c,lx+1) = gtrunc2n(gel(im,i), bit);
     730             :   }
     731        8778 :   return ZM_lll(M, 0.99, LLL_INPLACE);
     732             : }
     733             : GEN
     734        3311 : lindep_bit(GEN x, long bit)
     735             : {
     736        3311 :   pari_sp av = avma;
     737        3311 :   GEN v, M = lindepfull_bit(x,bit);
     738        3311 :   if (!M) { set_avma(av); return cgetg(1, t_COL); }
     739        3283 :   v = gel(M,1); setlg(v, lg(M));
     740        3283 :   return gerepilecopy(av, v);
     741             : }
     742             : /* deprecated */
     743             : GEN
     744         112 : lindep2(GEN x, long dig)
     745             : {
     746             :   long bit;
     747         112 :   if (dig < 0) pari_err_DOMAIN("lindep2", "accuracy", "<", gen_0, stoi(dig));
     748         112 :   if (dig) bit = (long) (dig/LOG10_2);
     749             :   else
     750             :   {
     751          98 :     bit = gprecision(x);
     752          98 :     if (!bit)
     753             :     {
     754          35 :       x = Q_primpart(x); /* left on stack */
     755          35 :       bit = 32 + gexpo(x);
     756             :     }
     757             :     else
     758          63 :       bit = (long)prec2nbits_mul(bit, 0.8);
     759             :   }
     760         112 :   return lindep_bit(x, bit);
     761             : }
     762             : 
     763             : /* x is a vector of elts of a p-adic field */
     764             : GEN
     765          28 : lindep_padic(GEN x)
     766             : {
     767          28 :   long i, j, prec = LONG_MAX, nx = lg(x)-1, v;
     768          28 :   pari_sp av = avma;
     769          28 :   GEN p = NULL, pn, m, a;
     770             : 
     771          28 :   if (nx < 2) return cgetg(1,t_COL);
     772         147 :   for (i=1; i<=nx; i++)
     773             :   {
     774         119 :     GEN c = gel(x,i), q;
     775         119 :     if (typ(c) != t_PADIC) continue;
     776             : 
     777          91 :     j = precp(c); if (j < prec) prec = j;
     778          91 :     q = gel(c,2);
     779          91 :     if (!p) p = q; else if (!equalii(p, q)) pari_err_MODULUS("lindep_padic", p, q);
     780             :   }
     781          28 :   if (!p) pari_err_TYPE("lindep_padic [not a p-adic vector]",x);
     782          28 :   v = gvaluation(x,p); pn = powiu(p,prec);
     783          28 :   if (v) x = gmul(x, powis(p, -v));
     784          28 :   x = RgV_to_FpV(x, pn);
     785             : 
     786          28 :   a = negi(gel(x,1));
     787          28 :   m = cgetg(nx,t_MAT);
     788         119 :   for (i=1; i<nx; i++)
     789             :   {
     790          91 :     GEN c = zerocol(nx);
     791          91 :     gel(c,1+i) = a;
     792          91 :     gel(c,1) = gel(x,i+1);
     793          91 :     gel(m,i) = c;
     794             :   }
     795          28 :   m = ZM_lll(ZM_hnfmodid(m, pn), 0.99, LLL_INPLACE);
     796          28 :   return gerepilecopy(av, gel(m,1));
     797             : }
     798             : /* x is a vector of t_POL/t_SER */
     799             : GEN
     800          77 : lindep_Xadic(GEN x)
     801             : {
     802          77 :   long i, prec = LONG_MAX, deg = 0, lx = lg(x), vx, v;
     803          77 :   pari_sp av = avma;
     804             :   GEN m;
     805             : 
     806          77 :   if (lx == 1) return cgetg(1,t_COL);
     807          77 :   vx = gvar(x);
     808          77 :   if (gequal0(x)) return col_ei(lx-1,1);
     809          70 :   v = gvaluation(x, pol_x(vx));
     810          70 :   if (!v)         x = shallowcopy(x);
     811           0 :   else if (v > 0) x = gdiv(x, pol_xn(v, vx));
     812           0 :   else            x = gmul(x, pol_xn(-v, vx));
     813             :   /* all t_SER have valuation >= 0 */
     814         735 :   for (i=1; i<lx; i++)
     815             :   {
     816         665 :     GEN c = gel(x,i);
     817         665 :     if (gvar(c) != vx) { gel(x,i) = scalarpol_shallow(c, vx); continue; }
     818         658 :     switch(typ(c))
     819             :     {
     820         231 :       case t_POL: deg = maxss(deg, degpol(c)); break;
     821           0 :       case t_RFRAC: pari_err_TYPE("lindep_Xadic", c);
     822         427 :       case t_SER:
     823         427 :         prec = minss(prec, valser(c)+lg(c)-2);
     824         427 :         gel(x,i) = ser2rfrac_i(c);
     825             :     }
     826             :   }
     827          70 :   if (prec == LONG_MAX) prec = deg+1;
     828          70 :   m = RgXV_to_RgM(x, prec);
     829          70 :   return gerepileupto(av, deplin(m));
     830             : }
     831             : static GEN
     832          35 : vec_lindep(GEN x)
     833             : {
     834          35 :   pari_sp av = avma;
     835          35 :   long i, l = lg(x); /* > 1 */
     836          35 :   long t = typ(gel(x,1)), h = lg(gel(x,1));
     837          35 :   GEN m = cgetg(l, t_MAT);
     838         126 :   for (i = 1; i < l; i++)
     839             :   {
     840          98 :     GEN y = gel(x,i);
     841          98 :     if (lg(y) != h || typ(y) != t) pari_err_TYPE("lindep",x);
     842          91 :     if (t != t_COL) y = shallowtrans(y); /* Sigh */
     843          91 :     gel(m,i) = y;
     844             :   }
     845          28 :   return gerepileupto(av, deplin(m));
     846             : }
     847             : 
     848             : GEN
     849           0 : lindep(GEN x) { return lindep2(x, 0); }
     850             : 
     851             : GEN
     852         434 : lindep0(GEN x,long bit)
     853             : {
     854         434 :   long i, tx = typ(x);
     855         434 :   if (tx == t_MAT) return deplin(x);
     856         147 :   if (! is_vec_t(tx)) pari_err_TYPE("lindep",x);
     857         441 :   for (i = 1; i < lg(x); i++)
     858         357 :     switch(typ(gel(x,i)))
     859             :     {
     860           7 :       case t_PADIC: return lindep_padic(x);
     861          21 :       case t_POL:
     862             :       case t_RFRAC:
     863          21 :       case t_SER: return lindep_Xadic(x);
     864          35 :       case t_VEC:
     865          35 :       case t_COL: return vec_lindep(x);
     866             :     }
     867          84 :   return lindep2(x, bit);
     868             : }
     869             : 
     870             : GEN
     871          77 : algdep0(GEN x, long n, long bit)
     872             : {
     873          77 :   long tx = typ(x), i;
     874             :   pari_sp av;
     875             :   GEN y;
     876             : 
     877          77 :   if (! is_scalar_t(tx)) pari_err_TYPE("algdep0",x);
     878          77 :   if (tx == t_POLMOD)
     879             :   {
     880          14 :     av = avma; y = minpoly(x, 0);
     881          14 :     return (degpol(y) > n)? gc_const(av, gen_1): y;
     882             :   }
     883          63 :   if (gequal0(x)) return pol_x(0);
     884          63 :   if (n <= 0)
     885             :   {
     886          14 :     if (!n) return gen_1;
     887           7 :     pari_err_DOMAIN("algdep", "degree", "<", gen_0, stoi(n));
     888             :   }
     889             : 
     890          49 :   av = avma; y = cgetg(n+2,t_COL);
     891          49 :   gel(y,1) = gen_1;
     892          49 :   gel(y,2) = x; /* n >= 1 */
     893         210 :   for (i=3; i<=n+1; i++) gel(y,i) = gmul(gel(y,i-1),x);
     894          49 :   if (typ(x) == t_PADIC)
     895          21 :     y = lindep_padic(y);
     896             :   else
     897          28 :     y = lindep2(y, bit);
     898          49 :   if (lg(y) == 1) pari_err(e_DOMAIN,"algdep", "degree(x)",">", stoi(n), x);
     899          49 :   y = RgV_to_RgX(y, 0);
     900          49 :   if (signe(leading_coeff(y)) > 0) return gerepilecopy(av, y);
     901          14 :   return gerepileupto(av, ZX_neg(y));
     902             : }
     903             : 
     904             : GEN
     905           0 : algdep(GEN x, long n)
     906             : {
     907           0 :   return algdep0(x,n,0);
     908             : }
     909             : 
     910             : static GEN
     911          56 : sertomat(GEN S, long p, long r, long vy)
     912             : {
     913             :   long n, m;
     914          56 :   GEN v = cgetg(r*p+1, t_VEC); /* v[r*n+m+1] = s^n * y^m */
     915             :   /* n = 0 */
     916         245 :   for (m = 0; m < r; m++) gel(v, m+1) = pol_xn(m, vy);
     917         175 :   for(n=1; n < p; n++)
     918         546 :     for (m = 0; m < r; m++)
     919             :     {
     920         427 :       GEN c = gel(S,n);
     921         427 :       if (m)
     922             :       {
     923         308 :         c = shallowcopy(c);
     924         308 :         setvalser(c, valser(c) + m);
     925             :       }
     926         427 :       gel(v, r*n + m + 1) = c;
     927             :     }
     928          56 :   return v;
     929             : }
     930             : 
     931             : GEN
     932          42 : seralgdep(GEN s, long p, long r)
     933             : {
     934          42 :   pari_sp av = avma;
     935             :   long vy, i, n, prec;
     936             :   GEN S, v, D;
     937             : 
     938          42 :   if (typ(s) != t_SER) pari_err_TYPE("seralgdep",s);
     939          42 :   if (p <= 0) pari_err_DOMAIN("seralgdep", "p", "<=", gen_0, stoi(p));
     940          42 :   if (r < 0) pari_err_DOMAIN("seralgdep", "r", "<", gen_0, stoi(r));
     941          42 :   if (is_bigint(addiu(muluu(p, r), 1))) pari_err_OVERFLOW("seralgdep");
     942          42 :   vy = varn(s);
     943          42 :   if (!vy) pari_err_PRIORITY("seralgdep", s, ">", 0);
     944          42 :   r++; p++;
     945          42 :   prec = valser(s) + lg(s)-2;
     946          42 :   if (r > prec) r = prec;
     947          42 :   S = cgetg(p+1, t_VEC); gel(S, 1) = s;
     948         119 :   for (i = 2; i <= p; i++) gel(S,i) = gmul(gel(S,i-1), s);
     949          42 :   v = sertomat(S, p, r, vy);
     950          42 :   D = lindep_Xadic(v);
     951          42 :   if (lg(D) == 1) { set_avma(av); return gen_0; }
     952          35 :   v = cgetg(p+1, t_VEC);
     953         133 :   for (n = 0; n < p; n++)
     954          98 :     gel(v, n+1) = RgV_to_RgX(vecslice(D, r*n+1, r*n+r), vy);
     955          35 :   return gerepilecopy(av, RgV_to_RgX(v, 0));
     956             : }
     957             : 
     958             : GEN
     959          14 : serdiffdep(GEN s, long p, long r)
     960             : {
     961          14 :   pari_sp av = avma;
     962             :   long vy, i, n, prec;
     963             :   GEN P, S, v, D;
     964             : 
     965          14 :   if (typ(s) != t_SER) pari_err_TYPE("serdiffdep",s);
     966          14 :   if (p <= 0) pari_err_DOMAIN("serdiffdep", "p", "<=", gen_0, stoi(p));
     967          14 :   if (r < 0) pari_err_DOMAIN("serdiffdep", "r", "<", gen_0, stoi(r));
     968          14 :   if (is_bigint(addiu(muluu(p, r), 1))) pari_err_OVERFLOW("serdiffdep");
     969          14 :   vy = varn(s);
     970          14 :   if (!vy) pari_err_PRIORITY("serdiffdep", s, ">", 0);
     971          14 :   r++; p++;
     972          14 :   prec = valser(s) + lg(s)-2;
     973          14 :   if (r > prec) r = prec;
     974          14 :   S = cgetg(p+1, t_VEC); gel(S, 1) = s;
     975          56 :   for (i = 2; i <= p; i++) gel(S,i) = derivser(gel(S,i-1));
     976          14 :   v = sertomat(S, p, r, vy);
     977          14 :   D = lindep_Xadic(v);
     978          14 :   if (lg(D) == 1) { set_avma(av); return gen_0; }
     979          14 :   P = RgV_to_RgX(vecslice(D, 1, r), vy);
     980          14 :   v = cgetg(p, t_VEC);
     981          56 :   for (n = 1; n < p; n++)
     982          42 :     gel(v, n) = RgV_to_RgX(vecslice(D, r*n+1, r*n+r), vy);
     983          14 :   return gerepilecopy(av, mkvec2(RgV_to_RgX(v, 0), gneg(P)));
     984             : }
     985             : 
     986             : /* FIXME: could precompute ZM_lll attached to V[2..] */
     987             : static GEN
     988        5502 : lindepcx(GEN V, long bit)
     989             : {
     990        5502 :   GEN Vr = real_i(V), Vi = imag_i(V);
     991        5502 :   if (gexpo(Vr) < -bit) V = Vi;
     992        5502 :   else if (gexpo(Vi) < -bit) V = Vr;
     993        5502 :   return lindepfull_bit(V, bit);
     994             : }
     995             : /* c floating point t_REAL or t_COMPLEX, T ZX, recognize in Q[x]/(T).
     996             :  * V helper vector (containing complex roots of T), MODIFIED */
     997             : static GEN
     998        5502 : cx_bestapprnf(GEN c, GEN T, GEN V, long bit)
     999             : {
    1000        5502 :   GEN M, a, v = NULL;
    1001             :   long i, l;
    1002        5502 :   gel(V,1) = gneg(c); M = lindepcx(V, bit);
    1003        5502 :   if (!M) pari_err(e_MISC, "cannot rationalize coeff in bestapprnf");
    1004        5502 :   l = lg(M); a = NULL;
    1005        5502 :   for (i = 1; i < l; i ++) { v = gel(M,i); a = gel(v,1); if (signe(a)) break; }
    1006        5502 :   v = RgC_Rg_div(vecslice(v, 2, lg(M)-1), a);
    1007        5502 :   if (!T) return gel(v,1);
    1008        4830 :   v = RgV_to_RgX(v, varn(T)); l = lg(v);
    1009        4830 :   if (l == 2) return gen_0;
    1010        4165 :   if (l == 3) return gel(v,2);
    1011        3668 :   return mkpolmod(v, T);
    1012             : }
    1013             : static GEN
    1014        8246 : bestapprnf_i(GEN x, GEN T, GEN V, long bit)
    1015             : {
    1016        8246 :   long i, l, tx = typ(x);
    1017             :   GEN z;
    1018        8246 :   switch (tx)
    1019             :   {
    1020         833 :     case t_INT: case t_FRAC: return x;
    1021        5502 :     case t_REAL: case t_COMPLEX: return cx_bestapprnf(x, T, V, bit);
    1022           0 :     case t_POLMOD: if (RgX_equal(gel(x,1),T)) return x;
    1023           0 :                    break;
    1024        1911 :     case t_POL: case t_SER: case t_VEC: case t_COL: case t_MAT:
    1025        1911 :       l = lg(x); z = cgetg(l, tx);
    1026        3437 :       for (i = 1; i < lontyp[tx]; i++) z[i] = x[i];
    1027        8211 :       for (; i < l; i++) gel(z,i) = bestapprnf_i(gel(x,i), T, V, bit);
    1028        1911 :       return z;
    1029             :   }
    1030           0 :   pari_err_TYPE("mfcxtoQ", x);
    1031             :   return NULL;/*LCOV_EXCL_LINE*/
    1032             : }
    1033             : 
    1034             : GEN
    1035        1946 : bestapprnf(GEN x, GEN T, GEN roT, long prec)
    1036             : {
    1037        1946 :   pari_sp av = avma;
    1038        1946 :   long tx = typ(x), dT = 1, bit;
    1039             :   GEN V;
    1040             : 
    1041        1946 :   if (T)
    1042             :   {
    1043        1610 :     if (typ(T) != t_POL) T = nf_get_pol(checknf(T));
    1044        1610 :     else if (!RgX_is_ZX(T)) pari_err_TYPE("bestapprnf", T);
    1045        1610 :     dT = degpol(T);
    1046             :   }
    1047        1946 :   if (is_rational_t(tx)) return gcopy(x);
    1048        1946 :   if (tx == t_POLMOD)
    1049             :   {
    1050           0 :     if (!T || !RgX_equal(T, gel(x,1))) pari_err_TYPE("bestapprnf",x);
    1051           0 :     return gcopy(x);
    1052             :   }
    1053             : 
    1054        1946 :   if (roT)
    1055             :   {
    1056         644 :     long l = gprecision(roT);
    1057         644 :     switch(typ(roT))
    1058             :     {
    1059         644 :       case t_INT: case t_FRAC: case t_REAL: case t_COMPLEX: break;
    1060           0 :       default: pari_err_TYPE("bestapprnf", roT);
    1061             :     }
    1062         644 :     if (prec < l) prec = l;
    1063             :   }
    1064        1302 :   else if (!T)
    1065         336 :     roT = gen_1;
    1066             :   else
    1067             :   {
    1068         966 :     long n = poliscyclo(T); /* cyclotomic is an important special case */
    1069         966 :     roT = n? rootsof1u_cx(n,prec): gel(QX_complex_roots(T,prec), 1);
    1070             :   }
    1071        1946 :   V = vec_prepend(gpowers(roT, dT-1), NULL);
    1072        1946 :   bit = prec2nbits_mul(prec, 0.8);
    1073        1946 :   return gerepilecopy(av, bestapprnf_i(x, T, V, bit));
    1074             : }
    1075             : 
    1076             : /********************************************************************/
    1077             : /**                                                                **/
    1078             : /**                              MINIM                             **/
    1079             : /**                                                                **/
    1080             : /********************************************************************/
    1081             : void
    1082      121623 : minim_alloc(long n, double ***q, GEN *x, double **y,  double **z, double **v)
    1083             : {
    1084             :   long i, s;
    1085             : 
    1086      121623 :   *x = cgetg(n, t_VECSMALL);
    1087      121623 :   *q = (double**) new_chunk(n);
    1088      121623 :   s = n * sizeof(double);
    1089      121623 :   *y = (double*) stack_malloc_align(s, sizeof(double));
    1090      121624 :   *z = (double*) stack_malloc_align(s, sizeof(double));
    1091      121627 :   *v = (double*) stack_malloc_align(s, sizeof(double));
    1092      525380 :   for (i=1; i<n; i++) (*q)[i] = (double*) stack_malloc_align(s, sizeof(double));
    1093      121628 : }
    1094             : 
    1095             : static void
    1096          70 : cvp_alloc(long n, double ***q, GEN *x, double **y,  double **z, double **v, double **t, double **tpre)
    1097             : {
    1098             :   long i, s;
    1099             : 
    1100          70 :   *x = cgetg(n, t_VECSMALL);
    1101          70 :   *q = (double**) new_chunk(n);
    1102          70 :   s = n * sizeof(double);
    1103          70 :   *y = (double*) stack_malloc_align(s, sizeof(double));
    1104          70 :   *z = (double*) stack_malloc_align(s, sizeof(double));
    1105          70 :   *v = (double*) stack_malloc_align(s, sizeof(double));
    1106          70 :   *t = (double*) stack_malloc_align(s, sizeof(double));
    1107          70 :   *tpre = (double*) stack_malloc_align(s, sizeof(double));
    1108         392 :   for (i=1; i<n; i++) (*q)[i] = (double*) stack_malloc_align(s, sizeof(double));
    1109          70 : }
    1110             : 
    1111             : static GEN
    1112      245868 : ZC_canon(GEN V)
    1113             : {
    1114      245868 :   long l = lg(V), j;
    1115      571655 :   for (j = 1; j < l  &&  signe(gel(V,j)) == 0; ++j);
    1116      245868 :   return (j < l  &&  signe(gel(V,j)) < 0)? ZC_neg(V): V;
    1117             : }
    1118             : 
    1119             : static GEN
    1120        5502 : ZM_zc_mul_canon(GEN u, GEN x)
    1121             : {
    1122        5502 :   return ZC_canon(ZM_zc_mul(u,x));
    1123             : }
    1124             : 
    1125             : static GEN
    1126      240366 : ZM_zc_mul_canon_zm(GEN u, GEN x)
    1127             : {
    1128      240366 :   pari_sp av = avma;
    1129      240366 :   GEN M = ZV_to_zv(ZC_canon(ZM_zc_mul(u,x)));
    1130      240366 :   return gerepileupto(av, M);
    1131             : }
    1132             : 
    1133             : struct qfvec
    1134             : {
    1135             :   GEN a, r, u;
    1136             : };
    1137             : 
    1138             : static void
    1139           0 : err_minim(GEN a)
    1140             : {
    1141           0 :   pari_err_DOMAIN("minim0","form","is not",
    1142             :                   strtoGENstr("positive definite"),a);
    1143           0 : }
    1144             : 
    1145             : static GEN
    1146         902 : minim_lll(GEN a, GEN *u)
    1147             : {
    1148         902 :   *u = lllgramint(a);
    1149         902 :   if (lg(*u) != lg(a)) err_minim(a);
    1150         902 :   return qf_ZM_apply(a,*u);
    1151             : }
    1152             : 
    1153             : static void
    1154         902 : forqfvec_init_dolll(struct qfvec *qv, GEN *pa, long dolll)
    1155             : {
    1156         902 :   GEN r, u, a = *pa;
    1157         902 :   if (!dolll) u = NULL;
    1158             :   else
    1159             :   {
    1160         860 :     if (typ(a) != t_MAT || !RgM_is_ZM(a)) pari_err_TYPE("qfminim",a);
    1161         860 :     a = *pa = minim_lll(a, &u);
    1162             :   }
    1163         902 :   qv->a = RgM_gtofp(a, DEFAULTPREC);
    1164         902 :   r = qfgaussred_positive(qv->a);
    1165         902 :   if (!r)
    1166             :   {
    1167           0 :     r = qfgaussred_positive(a); /* exact computation */
    1168           0 :     if (!r) err_minim(a);
    1169           0 :     r = RgM_gtofp(r, DEFAULTPREC);
    1170             :   }
    1171         902 :   qv->r = r;
    1172         902 :   qv->u = u;
    1173         902 : }
    1174             : 
    1175             : static void
    1176          42 : forqfvec_init(struct qfvec *qv, GEN a)
    1177          42 : { forqfvec_init_dolll(qv, &a, 1); }
    1178             : 
    1179             : static void
    1180          42 : forqfvec_i(void *E, long (*fun)(void *, GEN, GEN, double), struct qfvec *qv, GEN BORNE)
    1181             : {
    1182          42 :   GEN x, a = qv->a, r = qv->r, u = qv->u;
    1183          42 :   long n = lg(a)-1, i, j, k;
    1184             :   double p,BOUND,*v,*y,*z,**q;
    1185          42 :   const double eps = 1e-10;
    1186          42 :   if (!BORNE) BORNE = gen_0;
    1187             :   else
    1188             :   {
    1189          28 :     BORNE = gfloor(BORNE);
    1190          28 :     if (typ(BORNE) != t_INT) pari_err_TYPE("minim0",BORNE);
    1191          35 :     if (signe(BORNE) <= 0) return;
    1192             :   }
    1193          35 :   if (n == 0) return;
    1194          28 :   minim_alloc(n+1, &q, &x, &y, &z, &v);
    1195          98 :   for (j=1; j<=n; j++)
    1196             :   {
    1197          70 :     v[j] = rtodbl(gcoeff(r,j,j));
    1198         133 :     for (i=1; i<j; i++) q[i][j] = rtodbl(gcoeff(r,i,j));
    1199             :   }
    1200             : 
    1201          28 :   if (gequal0(BORNE))
    1202             :   {
    1203             :     double c;
    1204          14 :     p = rtodbl(gcoeff(a,1,1));
    1205          42 :     for (i=2; i<=n; i++) { c = rtodbl(gcoeff(a,i,i)); if (c < p) p = c; }
    1206          14 :     BORNE = roundr(dbltor(p));
    1207             :   }
    1208             :   else
    1209          14 :     p = gtodouble(BORNE);
    1210          28 :   BOUND = p * (1 + eps);
    1211          28 :   if (BOUND > (double)ULONG_MAX || (ulong)BOUND != (ulong)p)
    1212           7 :     pari_err_PREC("forqfvec");
    1213             : 
    1214          21 :   k = n; y[n] = z[n] = 0;
    1215          21 :   x[n] = (long)sqrt(BOUND/v[n]);
    1216          56 :   for(;;x[1]--)
    1217             :   {
    1218             :     do
    1219             :     {
    1220         140 :       if (k>1)
    1221             :       {
    1222          84 :         long l = k-1;
    1223          84 :         z[l] = 0;
    1224         245 :         for (j=k; j<=n; j++) z[l] += q[l][j]*x[j];
    1225          84 :         p = (double)x[k] + z[k];
    1226          84 :         y[l] = y[k] + p*p*v[k];
    1227          84 :         x[l] = (long)floor(sqrt((BOUND-y[l])/v[l])-z[l]);
    1228          84 :         k = l;
    1229             :       }
    1230             :       for(;;)
    1231             :       {
    1232         189 :         p = (double)x[k] + z[k];
    1233         189 :         if (y[k] + p*p*v[k] <= BOUND) break;
    1234          49 :         k++; x[k]--;
    1235             :       }
    1236         140 :     } while (k > 1);
    1237          77 :     if (! x[1] && y[1]<=eps) break;
    1238             : 
    1239          56 :     p = (double)x[1] + z[1]; p = y[1] + p*p*v[1]; /* norm(x) */
    1240          56 :     if (fun(E, u, x, p)) break;
    1241             :   }
    1242             : }
    1243             : 
    1244             : void
    1245           0 : forqfvec(void *E, long (*fun)(void *, GEN, GEN, double), GEN a, GEN BORNE)
    1246             : {
    1247           0 :   pari_sp av = avma;
    1248             :   struct qfvec qv;
    1249           0 :   forqfvec_init(&qv, a);
    1250           0 :   forqfvec_i(E, fun, &qv, BORNE);
    1251           0 :   set_avma(av);
    1252           0 : }
    1253             : 
    1254             : struct qfvecwrap
    1255             : {
    1256             :   void *E;
    1257             :   long (*fun)(void *, GEN);
    1258             : };
    1259             : 
    1260             : static long
    1261          56 : forqfvec_wrap(void *E, GEN u, GEN x, double d)
    1262             : {
    1263          56 :   pari_sp av = avma;
    1264          56 :   struct qfvecwrap *W = (struct qfvecwrap *) E;
    1265             :   (void) d;
    1266          56 :   return gc_long(av, W->fun(W->E, ZM_zc_mul_canon(u, x)));
    1267             : }
    1268             : 
    1269             : void
    1270          42 : forqfvec1(void *E, long (*fun)(void *, GEN), GEN a, GEN BORNE)
    1271             : {
    1272          42 :   pari_sp av = avma;
    1273             :   struct qfvecwrap wr;
    1274             :   struct qfvec qv;
    1275          42 :   wr.E = E; wr.fun = fun;
    1276          42 :   forqfvec_init(&qv, a);
    1277          42 :   forqfvec_i((void*) &wr, forqfvec_wrap, &qv, BORNE);
    1278          35 :   set_avma(av);
    1279          35 : }
    1280             : 
    1281             : void
    1282          42 : forqfvec0(GEN a, GEN BORNE, GEN code)
    1283          42 : { EXPRVOID_WRAP(code, forqfvec1(EXPR_ARGVOID, a,  BORNE)) }
    1284             : 
    1285             : enum { min_ALL = 0, min_FIRST, min_VECSMALL, min_VECSMALL2 };
    1286             : 
    1287             : /* Minimal vectors for the integral definite quadratic form: a.
    1288             :  * Result u:
    1289             :  *   u[1]= Number of vectors of square norm <= BORNE
    1290             :  *   u[2]= maximum norm found
    1291             :  *   u[3]= list of vectors found (at most STOCKMAX, unless NULL)
    1292             :  *
    1293             :  *  If BORNE = NULL: Minimal nonzero vectors.
    1294             :  *  flag = min_ALL,   as above
    1295             :  *  flag = min_FIRST, exits when first suitable vector is found.
    1296             :  *  flag = min_VECSMALL, return a t_VECSMALL of (half) the number of vectors
    1297             :  *  for each norm
    1298             :  *  flag = min_VECSMALL2, same but count only vectors with even norm, and shift
    1299             :  *  the answer */
    1300             : static GEN
    1301         847 : minim0_dolll(GEN a, GEN BORNE, GEN STOCKMAX, long flag, long dolll)
    1302             : {
    1303             :   GEN x, u, r, L, gnorme;
    1304         847 :   long n = lg(a)-1, i, j, k, s, maxrank, sBORNE;
    1305         847 :   pari_sp av = avma, av1;
    1306             :   double p,maxnorm,BOUND,*v,*y,*z,**q;
    1307         847 :   const double eps = 1e-10;
    1308         847 :   int stockall = 0;
    1309             :   struct qfvec qv;
    1310             : 
    1311         847 :   if (!BORNE)
    1312          56 :     sBORNE = 0;
    1313             :   else
    1314             :   {
    1315         791 :     BORNE = gfloor(BORNE);
    1316         791 :     if (typ(BORNE) != t_INT) pari_err_TYPE("minim0",BORNE);
    1317         791 :     if (is_bigint(BORNE)) pari_err_PREC( "qfminim");
    1318         790 :     sBORNE = itos(BORNE); set_avma(av);
    1319         790 :     if (sBORNE < 0) sBORNE = 0;
    1320             :   }
    1321         846 :   if (!STOCKMAX)
    1322             :   {
    1323         335 :     stockall = 1;
    1324         335 :     maxrank = 200;
    1325             :   }
    1326             :   else
    1327             :   {
    1328         511 :     STOCKMAX = gfloor(STOCKMAX);
    1329         511 :     if (typ(STOCKMAX) != t_INT) pari_err_TYPE("minim0",STOCKMAX);
    1330         511 :     maxrank = itos(STOCKMAX);
    1331         511 :     if (maxrank < 0)
    1332           0 :       pari_err_TYPE("minim0 [negative number of vectors]",STOCKMAX);
    1333             :   }
    1334             : 
    1335         846 :   switch(flag)
    1336             :   {
    1337         462 :     case min_VECSMALL:
    1338             :     case min_VECSMALL2:
    1339         462 :       if (sBORNE <= 0) return cgetg(1, t_VECSMALL);
    1340         434 :       L = zero_zv(sBORNE);
    1341         434 :       if (flag == min_VECSMALL2) sBORNE <<= 1;
    1342         434 :       if (n == 0) return L;
    1343         434 :       break;
    1344          35 :     case min_FIRST:
    1345          35 :       if (n == 0 || (!sBORNE && BORNE)) return cgetg(1,t_VEC);
    1346          21 :       L = NULL; /* gcc -Wall */
    1347          21 :       break;
    1348         349 :     case min_ALL:
    1349         349 :       if (n == 0 || (!sBORNE && BORNE))
    1350          14 :         retmkvec3(gen_0, gen_0, cgetg(1, t_MAT));
    1351         335 :       L = new_chunk(1+maxrank);
    1352         335 :       break;
    1353           0 :     default:
    1354           0 :       return NULL;
    1355             :   }
    1356         790 :   minim_alloc(n+1, &q, &x, &y, &z, &v);
    1357             : 
    1358         790 :   forqfvec_init_dolll(&qv, &a, dolll);
    1359         790 :   av1 = avma;
    1360         790 :   r = qv.r;
    1361         790 :   u = qv.u;
    1362        5912 :   for (j=1; j<=n; j++)
    1363             :   {
    1364        5122 :     v[j] = rtodbl(gcoeff(r,j,j));
    1365       29579 :     for (i=1; i<j; i++) q[i][j] = rtodbl(gcoeff(r,i,j)); /* |.| <= 1/2 */
    1366             :   }
    1367             : 
    1368         790 :   if (sBORNE) maxnorm = 0.;
    1369             :   else
    1370             :   {
    1371          56 :     GEN B = gcoeff(a,1,1);
    1372          56 :     long t = 1;
    1373         616 :     for (i=2; i<=n; i++)
    1374             :     {
    1375         560 :       GEN c = gcoeff(a,i,i);
    1376         560 :       if (cmpii(c, B) < 0) { B = c; t = i; }
    1377             :     }
    1378          56 :     if (flag == min_FIRST) return gerepilecopy(av, mkvec2(B, gel(u,t)));
    1379          49 :     maxnorm = -1.; /* don't update maxnorm */
    1380          49 :     if (is_bigint(B)) return NULL;
    1381          48 :     sBORNE = itos(B);
    1382             :   }
    1383         782 :   BOUND = sBORNE * (1 + eps);
    1384         782 :   if ((long)BOUND != sBORNE) return NULL;
    1385             : 
    1386         770 :   s = 0;
    1387         770 :   k = n; y[n] = z[n] = 0;
    1388         770 :   x[n] = (long)sqrt(BOUND/v[n]);
    1389     1223264 :   for(;;x[1]--)
    1390             :   {
    1391             :     do
    1392             :     {
    1393     2245614 :       if (k>1)
    1394             :       {
    1395     1022259 :         long l = k-1;
    1396     1022259 :         z[l] = 0;
    1397    11756080 :         for (j=k; j<=n; j++) z[l] += q[l][j]*x[j];
    1398     1022259 :         p = (double)x[k] + z[k];
    1399     1022259 :         y[l] = y[k] + p*p*v[k];
    1400     1022259 :         x[l] = (long)floor(sqrt((BOUND-y[l])/v[l])-z[l]);
    1401     1022259 :         k = l;
    1402             :       }
    1403             :       for(;;)
    1404             :       {
    1405     3263729 :         p = (double)x[k] + z[k];
    1406     3263729 :         if (y[k] + p*p*v[k] <= BOUND) break;
    1407     1018115 :         k++; x[k]--;
    1408             :       }
    1409             :     }
    1410     2245614 :     while (k > 1);
    1411     1224034 :     if (! x[1] && y[1]<=eps) break;
    1412             : 
    1413     1223271 :     p = (double)x[1] + z[1]; p = y[1] + p*p*v[1]; /* norm(x) */
    1414     1223271 :     if (maxnorm >= 0)
    1415             :     {
    1416     1220723 :       if (p > maxnorm) maxnorm = p;
    1417             :     }
    1418             :     else
    1419             :     { /* maxnorm < 0 : only look for minimal vectors */
    1420        2548 :       pari_sp av2 = avma;
    1421        2548 :       gnorme = roundr(dbltor(p));
    1422        2548 :       if (cmpis(gnorme, sBORNE) >= 0) set_avma(av2);
    1423             :       else
    1424             :       {
    1425          14 :         sBORNE = itos(gnorme); set_avma(av1);
    1426          14 :         BOUND = sBORNE * (1+eps);
    1427          14 :         L = new_chunk(maxrank+1);
    1428          14 :         s = 0;
    1429             :       }
    1430             :     }
    1431     1223271 :     s++;
    1432             : 
    1433     1223271 :     switch(flag)
    1434             :     {
    1435           7 :       case min_FIRST:
    1436           7 :         if (dolll) x = ZM_zc_mul_canon(u,x);
    1437           7 :         return gerepilecopy(av, mkvec2(roundr(dbltor(p)), x));
    1438             : 
    1439      248241 :       case min_ALL:
    1440      248241 :         if (s > maxrank && stockall) /* overflow */
    1441             :         {
    1442         490 :           long maxranknew = maxrank << 1;
    1443         490 :           GEN Lnew = new_chunk(1 + maxranknew);
    1444      344890 :           for (i=1; i<=maxrank; i++) Lnew[i] = L[i];
    1445         490 :           L = Lnew; maxrank = maxranknew;
    1446             :         }
    1447      248241 :         if (s<=maxrank) gel(L,s) = leafcopy(x);
    1448      248241 :         break;
    1449             : 
    1450       39200 :       case min_VECSMALL:
    1451       39200 :         { ulong norm = (ulong)(p + 0.5); L[norm]++; }
    1452       39200 :         break;
    1453             : 
    1454      935823 :       case min_VECSMALL2:
    1455      935823 :         { ulong norm = (ulong)(p + 0.5); if (!odd(norm)) L[norm>>1]++; }
    1456      935823 :         break;
    1457             : 
    1458             :     }
    1459             :   }
    1460         763 :   switch(flag)
    1461             :   {
    1462           7 :     case min_FIRST:
    1463           7 :       set_avma(av); return cgetg(1,t_VEC);
    1464         434 :     case min_VECSMALL:
    1465             :     case min_VECSMALL2:
    1466         434 :       set_avma((pari_sp)L); return L;
    1467             :   }
    1468         322 :   r = (maxnorm >= 0) ? roundr(dbltor(maxnorm)): stoi(sBORNE);
    1469         322 :   k = minss(s,maxrank);
    1470         322 :   L[0] = evaltyp(t_MAT) | evallg(k + 1);
    1471         322 :   if (dolll)
    1472      246092 :     for (j=1; j<=k; j++)
    1473      245805 :       gel(L,j) = dolll==1 ? ZM_zc_mul_canon(u, gel(L,j))
    1474      245805 :                           : ZM_zc_mul_canon_zm(u, gel(L,j));
    1475         322 :   return gerepilecopy(av, mkvec3(stoi(s<<1), r, L));
    1476             : }
    1477             : 
    1478             : /* Closest vectors for the integral definite quadratic form: a.
    1479             :  * Code bases on minim0_dolll
    1480             :  * Result u:
    1481             :  *   u[1]= Number of closest vectors of square distance <= BORNE
    1482             :  *   u[2]= maximum squared distance found
    1483             :  *   u[3]= list of vectors found (at most STOCKMAX, unless NULL)
    1484             :  *
    1485             :  *  If BORNE = NULL or <= 0.: returns closest vectors.
    1486             :  *  flag = min_ALL,   as above
    1487             :  *  flag = min_FIRST, exits when first suitable vector is found.
    1488             : */
    1489             : static GEN
    1490          91 : cvp0_dolll(GEN a, GEN target, GEN BORNE, GEN STOCKMAX, long flag, long dolll)
    1491             : {
    1492             :   GEN x, u, r, L;
    1493             :   GEN uinv, tv;
    1494             :   GEN pd;
    1495          91 :   long n = lg(a)-1, nt = lg(target)-1, i, j, k, s, maxrank;
    1496          91 :   pari_sp av = avma, av1;
    1497             :   double p,maxnorm,BOUND,*v,*y,*z,*tt,**q, *tpre, sBORNE;
    1498          91 :   const double eps = 1e-10;
    1499          91 :   int stockall = 0;
    1500             :   struct qfvec qv;
    1501          91 :   int done = 0;
    1502          91 :   if (typ(target) != t_VEC && typ(target) != t_COL ) pari_err_TYPE("cvp0",target);
    1503          91 :   if (n != nt) pari_err_TYPE("cvp0 [different dimensions]",target);
    1504          77 :   if (!BORNE)
    1505           0 :     sBORNE = 0.;
    1506             :   else
    1507             :   {
    1508          77 :     if (typ(BORNE) != t_REAL && typ(BORNE) != t_INT && typ(BORNE) != t_FRAC ) pari_err_TYPE("cvp0",BORNE);
    1509          77 :     sBORNE = gtodouble(BORNE); set_avma(av);
    1510          77 :     if (sBORNE < 0.) sBORNE = 0.;
    1511             :   }
    1512          77 :   if (!STOCKMAX)
    1513             :   {
    1514          77 :     stockall = 1;
    1515          77 :     maxrank = 200;
    1516             :   }
    1517             :   else
    1518             :   {
    1519           0 :     STOCKMAX = gfloor(STOCKMAX);
    1520           0 :     if (typ(STOCKMAX) != t_INT) pari_err_TYPE("cvp0",STOCKMAX);
    1521           0 :     maxrank = itos(STOCKMAX);
    1522           0 :     if (maxrank < 0)
    1523           0 :       pari_err_TYPE("cvp0 [negative number of vectors]",STOCKMAX);
    1524             :   }
    1525             : 
    1526          77 :   L = (flag==min_ALL) ? new_chunk(1+maxrank) : NULL;
    1527          77 :   if (n == 0 ) {
    1528           7 :     if (flag==min_ALL) {
    1529           7 :       retmkvec3(gen_0, gen_0, cgetg(1, t_MAT));
    1530             :     }
    1531             :     else {
    1532           0 :       return cgetg(1,t_VEC);
    1533             :     }
    1534             :   }
    1535             : 
    1536          70 :   cvp_alloc(n+1, &q, &x, &y, &z, &v, &tt, &tpre);
    1537             : 
    1538          70 :   forqfvec_init_dolll(&qv, &a, dolll);
    1539          70 :   av1 = avma;
    1540          70 :   r = qv.r;
    1541          70 :   u = qv.u;
    1542         392 :   for (j=1; j<=n; j++)
    1543             :   {
    1544         322 :     v[j] = rtodbl(gcoeff(r,j,j));
    1545        1729 :     for (i=1; i<j; i++) q[i][j] = rtodbl(gcoeff(r,i,j)); /* |.| <= 1/2 */
    1546             :   }
    1547             : 
    1548          70 :   if( dolll ) {
    1549             :     /* compute U^-1 * tt */
    1550          70 :     uinv = ZM_inv(u, &pd);
    1551          70 :     tv = RgM_RgC_mul(uinv, target);
    1552         392 :     for (j=1; j<=n; j++)
    1553             :     {
    1554         322 :       tt[j] = gtodouble(gel(tv, j));
    1555             :     }
    1556             :   } else {
    1557           0 :     for (j=1; j<=n; j++)
    1558             :     {
    1559           0 :       tt[j] = gtodouble(gel(target, j));
    1560             :     }
    1561             :   }
    1562             : 
    1563          70 :   if (sBORNE) maxnorm = 0.;
    1564             :   else
    1565             :   {
    1566          28 :     GEN B = gcoeff(a,1,1);
    1567         112 :     for (i = 2; i <= n; i++)
    1568          84 :       B = addii(B, gcoeff(a,i,i));
    1569          28 :     maxnorm = -1.; /* don't update maxnorm */
    1570          28 :     if (is_bigint(B)) return NULL;
    1571          28 :     sBORNE = 0.;
    1572         140 :     for(i=1; i<=n; i++)
    1573         112 :       sBORNE += v[i];
    1574             :   }
    1575          70 :   BOUND = sBORNE * (1 + eps);
    1576             : 
    1577             :   /* precompute contribution of tt to z[l] */
    1578             : 
    1579         392 :   for(k=1; k <= n; k++) {
    1580         322 :     tpre[k] = -tt[k];
    1581        1729 :     for(j=k+1; j<=n; j++) {
    1582        1407 :       tpre[k] -= q[k][j] * tt[j];
    1583             :     }
    1584             :   }
    1585             : 
    1586          70 :   s = 0;
    1587          70 :   k = n; y[n] = 0;
    1588          70 :   z[n] = tpre[n];
    1589          70 :   x[n] = (long)floor(sqrt(BOUND/v[n])-z[n]);
    1590         889 :   for(;;x[1]--)
    1591             :   {
    1592             :     do
    1593             :     {
    1594        8582 :       if (k>1)
    1595             :       {
    1596        7665 :         long l = k-1;
    1597        7665 :         z[l] = tpre[l];
    1598       61488 :         for (j=k; j<=n; j++) z[l] += q[l][j]*x[j];
    1599        7665 :         p = (double)x[k] + z[k];
    1600        7665 :         y[l] = y[k] + p*p*v[k];
    1601        7665 :         x[l] = (long)floor(sqrt((BOUND-y[l])/v[l])-z[l]);
    1602        7665 :         k = l;
    1603             :       }
    1604             :       for(;;)
    1605             :       {
    1606       16247 :         p = (double)x[k] + z[k];
    1607       16247 :         if (y[k] + p*p*v[k] <= BOUND) break;
    1608        7735 :         if (k >= n) {
    1609          70 :           done = 1;
    1610          70 :           break;
    1611             :         }
    1612        7665 :         k++; x[k]--;
    1613             :       }
    1614             :     }
    1615        8582 :     while (k > 1 && !done);
    1616         959 :     if (done) break;
    1617             : 
    1618         889 :     p = (double)x[1] + z[1];
    1619         889 :     p = y[1] + p*p*v[1]; /* norm(x-target) */
    1620         889 :     if (maxnorm >= 0)
    1621             :     {
    1622         175 :       if (p > maxnorm) maxnorm = p;
    1623             :     }
    1624             :     else
    1625             :     { /* maxnorm < 0 : only look for closest vectors */
    1626         714 :       if (p * (1+10*eps) < sBORNE) {
    1627         231 :         sBORNE = p; set_avma(av1);
    1628         231 :         BOUND = sBORNE * (1+eps);
    1629         231 :         L = new_chunk(maxrank+1);
    1630         231 :         s = 0;
    1631             :       }
    1632             :     }
    1633         889 :     s++;
    1634             : 
    1635         889 :     switch(flag)
    1636             :     {
    1637           0 :       case min_FIRST:
    1638           0 :         if (dolll) x = ZM_zc_mul(u,x);
    1639           0 :         return gerepilecopy(av, mkvec2(dbltor(p), x));
    1640             : 
    1641         889 :       case min_ALL:
    1642         889 :         if (s > maxrank && stockall) /* overflow */
    1643             :         {
    1644           0 :           long maxranknew = maxrank << 1;
    1645           0 :           GEN Lnew = new_chunk(1 + maxranknew);
    1646           0 :           for (i=1; i<=maxrank; i++) Lnew[i] = L[i];
    1647           0 :           L = Lnew; maxrank = maxranknew;
    1648             :         }
    1649         889 :         if (s<=maxrank) gel(L,s) = leafcopy(x);
    1650         889 :         break;
    1651             :     }
    1652             :   }
    1653          70 :   switch(flag)
    1654             :   {
    1655           0 :     case min_FIRST:
    1656           0 :       set_avma(av); return cgetg(1,t_VEC);
    1657             :   }
    1658          70 :   r = (maxnorm >= 0) ? dbltor(maxnorm): dbltor(sBORNE);
    1659          70 :   k = minss(s,maxrank);
    1660          70 :   L[0] = evaltyp(t_MAT) | evallg(k + 1);
    1661         322 :   for (j=1; j<=k; j++)
    1662         252 :     gel(L,j) = (dolll==1) ? ZM_zc_mul(u, gel(L,j)) : zc_to_ZC(gel(L,j));
    1663          70 :   return gerepilecopy(av, mkvec3(stoi(s), r, L));
    1664             : }
    1665             : 
    1666             : static GEN
    1667         553 : minim0(GEN a, GEN BORNE, GEN STOCKMAX, long flag)
    1668             : {
    1669         553 :   GEN v = minim0_dolll(a, BORNE, STOCKMAX, flag, 1);
    1670         552 :   if (!v) pari_err_PREC("qfminim");
    1671         546 :   return v;
    1672             : }
    1673             : 
    1674             : static GEN
    1675          91 : cvp0(GEN a, GEN target, GEN BORNE, GEN STOCKMAX, long flag)
    1676             : {
    1677          91 :   GEN v = cvp0_dolll(a, target, BORNE, STOCKMAX, flag, 1);
    1678          77 :   if (!v) pari_err_PREC("qfcvp");
    1679          77 :   return v;
    1680             : }
    1681             : 
    1682             : static GEN
    1683         252 : minim0_zm(GEN a, GEN BORNE, GEN STOCKMAX, long flag)
    1684             : {
    1685         252 :   GEN v = minim0_dolll(a, BORNE, STOCKMAX, flag, 2);
    1686         252 :   if (!v) pari_err_PREC("qfminim");
    1687         252 :   return v;
    1688             : }
    1689             : 
    1690             : GEN
    1691         462 : qfrep0(GEN a, GEN borne, long flag)
    1692         462 : { return minim0(a, borne, gen_0, (flag & 1)? min_VECSMALL2: min_VECSMALL); }
    1693             : 
    1694             : GEN
    1695         133 : qfminim0(GEN a, GEN borne, GEN stockmax, long flag, long prec)
    1696             : {
    1697         133 :   switch(flag)
    1698             :   {
    1699          49 :     case 0: return minim0(a,borne,stockmax,min_ALL);
    1700          35 :     case 1: return minim0(a,borne,gen_0   ,min_FIRST);
    1701          49 :     case 2:
    1702             :     {
    1703          49 :       long maxnum = -1;
    1704          49 :       if (typ(a) != t_MAT) pari_err_TYPE("qfminim",a);
    1705          49 :       if (stockmax) {
    1706          14 :         if (typ(stockmax) != t_INT) pari_err_TYPE("qfminim",stockmax);
    1707          14 :         maxnum = itos(stockmax);
    1708             :       }
    1709          49 :       a = fincke_pohst(a,borne,maxnum,prec,NULL);
    1710          42 :       if (!a) pari_err_PREC("qfminim");
    1711          42 :       return a;
    1712             :     }
    1713           0 :     default: pari_err_FLAG("qfminim");
    1714             :   }
    1715             :   return NULL; /* LCOV_EXCL_LINE */
    1716             : }
    1717             : 
    1718             : 
    1719             : GEN
    1720          91 : qfcvp0(GEN a, GEN target, GEN borne, GEN stockmax, long flag)
    1721             : {
    1722          91 :   switch(flag)
    1723             :   {
    1724          91 :     case 0: return cvp0(a,target,borne,stockmax,min_ALL);
    1725           0 :     case 1: return cvp0(a,target,borne,gen_0   ,min_FIRST);
    1726             :     /* case 2:
    1727             :        TODO: more robust finke_pohst enumeration */
    1728           0 :     default: pari_err_FLAG("qfcvp");
    1729             :   }
    1730             :   return NULL; /* LCOV_EXCL_LINE */
    1731             : }
    1732             : 
    1733             : GEN
    1734           7 : minim(GEN a, GEN borne, GEN stockmax)
    1735           7 : { return minim0(a,borne,stockmax,min_ALL); }
    1736             : 
    1737             : GEN
    1738         252 : minim_zm(GEN a, GEN borne, GEN stockmax)
    1739         252 : { return minim0_zm(a,borne,stockmax,min_ALL); }
    1740             : 
    1741             : GEN
    1742          42 : minim_raw(GEN a, GEN BORNE, GEN STOCKMAX)
    1743          42 : { return minim0_dolll(a, BORNE, STOCKMAX, min_ALL, 0); }
    1744             : 
    1745             : GEN
    1746           0 : minim2(GEN a, GEN borne, GEN stockmax)
    1747           0 : { return minim0(a,borne,stockmax,min_FIRST); }
    1748             : 
    1749             : /* If V depends linearly from the columns of the matrix, return 0.
    1750             :  * Otherwise, update INVP and L and return 1. No GC. */
    1751             : static int
    1752        1652 : addcolumntomatrix(GEN V, GEN invp, GEN L)
    1753             : {
    1754        1652 :   long i,j,k, n = lg(invp);
    1755        1652 :   GEN a = cgetg(n, t_COL), ak = NULL, mak;
    1756             : 
    1757       84231 :   for (k = 1; k < n; k++)
    1758       83706 :     if (!L[k])
    1759             :     {
    1760       27902 :       ak = RgMrow_zc_mul(invp, V, k);
    1761       27902 :       if (!gequal0(ak)) break;
    1762             :     }
    1763        1652 :   if (k == n) return 0;
    1764        1127 :   L[k] = 1;
    1765        1127 :   mak = gneg_i(ak);
    1766       43253 :   for (i=k+1; i<n; i++)
    1767       42126 :     gel(a,i) = gdiv(RgMrow_zc_mul(invp, V, i), mak);
    1768       43883 :   for (j=1; j<=k; j++)
    1769             :   {
    1770       42756 :     GEN c = gel(invp,j), ck = gel(c,k);
    1771       42756 :     if (gequal0(ck)) continue;
    1772        8757 :     gel(c,k) = gdiv(ck, ak);
    1773        8757 :     if (j==k)
    1774       43253 :       for (i=k+1; i<n; i++)
    1775       42126 :         gel(c,i) = gmul(gel(a,i), ck);
    1776             :     else
    1777      184814 :       for (i=k+1; i<n; i++)
    1778      177184 :         gel(c,i) = gadd(gel(c,i), gmul(gel(a,i), ck));
    1779             :   }
    1780        1127 :   return 1;
    1781             : }
    1782             : 
    1783             : GEN
    1784          42 : qfperfection(GEN a)
    1785             : {
    1786          42 :   pari_sp av = avma;
    1787             :   GEN u, L;
    1788          42 :   long r, s, k, l, n = lg(a)-1;
    1789             : 
    1790          42 :   if (!n) return gen_0;
    1791          42 :   if (typ(a) != t_MAT || !RgM_is_ZM(a)) pari_err_TYPE("qfperfection",a);
    1792          42 :   a = minim_lll(a, &u);
    1793          42 :   L = minim_raw(a,NULL,NULL);
    1794          42 :   r = (n*(n+1)) >> 1;
    1795          42 :   if (L)
    1796             :   {
    1797             :     GEN D, V, invp;
    1798          35 :     L = gel(L, 3); l = lg(L);
    1799          35 :     if (l == 2) { set_avma(av); return gen_1; }
    1800             :     /* |L[i]|^2 fits  into a long for all i */
    1801          21 :     D = zero_zv(r);
    1802          21 :     V = cgetg(r+1, t_VECSMALL);
    1803          21 :     invp = matid(r);
    1804          21 :     s = 0;
    1805        1659 :     for (k = 1; k < l; k++)
    1806             :     {
    1807        1652 :       pari_sp av2 = avma;
    1808        1652 :       GEN x = gel(L,k);
    1809             :       long i, j, I;
    1810       21098 :       for (i = I = 1; i<=n; i++)
    1811      145278 :         for (j=i; j<=n; j++,I++) V[I] = x[i]*x[j];
    1812        1652 :       if (!addcolumntomatrix(V,invp,D)) set_avma(av2);
    1813        1127 :       else if (++s == r) break;
    1814             :     }
    1815             :   }
    1816             :   else
    1817             :   {
    1818             :     GEN M;
    1819           7 :     L = fincke_pohst(a,NULL,-1, DEFAULTPREC, NULL);
    1820           7 :     if (!L) pari_err_PREC("qfminim");
    1821           7 :     L = gel(L, 3); l = lg(L);
    1822           7 :     if (l == 2) { set_avma(av); return gen_1; }
    1823           7 :     M = cgetg(l, t_MAT);
    1824         959 :     for (k = 1; k < l; k++)
    1825             :     {
    1826         952 :       GEN x = gel(L,k), c = cgetg(r+1, t_COL);
    1827             :       long i, I, j;
    1828       16184 :       for (i = I = 1; i<=n; i++)
    1829      144704 :         for (j=i; j<=n; j++,I++) gel(c,I) = mulii(gel(x,i), gel(x,j));
    1830         952 :       gel(M,k) = c;
    1831             :     }
    1832           7 :     s = ZM_rank(M);
    1833             :   }
    1834          28 :   return gc_utoipos(av, s);
    1835             : }
    1836             : 
    1837             : static GEN
    1838         140 : clonefill(GEN S, long s, long t)
    1839             : { /* initialize to dummy values */
    1840         140 :   GEN T = S, dummy = cgetg(1, t_STR);
    1841             :   long i;
    1842      308745 :   for (i = s+1; i <= t; i++) gel(S,i) = dummy;
    1843         140 :   S = gclone(S); if (isclone(T)) gunclone(T);
    1844         140 :   return S;
    1845             : }
    1846             : 
    1847             : /* increment ZV x, by incrementing cell of index k. Initial value x0[k] was
    1848             :  * chosen to minimize qf(x) for given x0[1..k-1] and x0[k+1,..] = 0
    1849             :  * The last nonzero entry must be positive and goes through x0[k]+1,2,3,...
    1850             :  * Others entries go through: x0[k]+1,-1,2,-2,...*/
    1851             : INLINE void
    1852     2950234 : step(GEN x, GEN y, GEN inc, long k)
    1853             : {
    1854     2950234 :   if (!signe(gel(y,k))) /* x[k+1..] = 0 */
    1855      160678 :     gel(x,k) = addiu(gel(x,k), 1); /* leading coeff > 0 */
    1856             :   else
    1857             :   {
    1858     2789556 :     long i = inc[k];
    1859     2789556 :     gel(x,k) = addis(gel(x,k), i),
    1860     2789577 :     inc[k] = (i > 0)? -1-i: 1-i;
    1861             :   }
    1862     2950255 : }
    1863             : 
    1864             : /* 1 if we are "sure" that x < y, up to few rounding errors, i.e.
    1865             :  * x < y - epsilon. More precisely :
    1866             :  * - sign(x - y) < 0
    1867             :  * - lgprec(x-y) > 3 || expo(x - y) - expo(x) > -24 */
    1868             : static int
    1869     1216159 : mplessthan(GEN x, GEN y)
    1870             : {
    1871     1216159 :   pari_sp av = avma;
    1872     1216159 :   GEN z = mpsub(x, y);
    1873     1216157 :   set_avma(av);
    1874     1216157 :   if (typ(z) == t_INT) return (signe(z) < 0);
    1875     1216157 :   if (signe(z) >= 0) return 0;
    1876       22395 :   if (realprec(z) > LOWDEFAULTPREC) return 1;
    1877       22395 :   return ( expo(z) - mpexpo(x) > -24 );
    1878             : }
    1879             : 
    1880             : /* 1 if we are "sure" that x > y, up to few rounding errors, i.e.
    1881             :  * x > y + epsilon */
    1882             : static int
    1883     4616680 : mpgreaterthan(GEN x, GEN y)
    1884             : {
    1885     4616680 :   pari_sp av = avma;
    1886     4616680 :   GEN z = mpsub(x, y);
    1887     4616685 :   set_avma(av);
    1888     4616762 :   if (typ(z) == t_INT) return (signe(z) > 0);
    1889     4616762 :   if (signe(z) <= 0) return 0;
    1890     2690923 :   if (realprec(z) > LOWDEFAULTPREC) return 1;
    1891      477443 :   return ( expo(z) - mpexpo(x) > -24 );
    1892             : }
    1893             : 
    1894             : /* x a t_INT, y  t_INT or t_REAL */
    1895             : INLINE GEN
    1896     1228220 : mulimp(GEN x, GEN y)
    1897             : {
    1898     1228220 :   if (typ(y) == t_INT) return mulii(x,y);
    1899     1228220 :   return signe(x) ? mulir(x,y): gen_0;
    1900             : }
    1901             : /* x + y*z, x,z two mp's, y a t_INT */
    1902             : INLINE GEN
    1903    13537276 : addmulimp(GEN x, GEN y, GEN z)
    1904             : {
    1905    13537276 :   if (!signe(y)) return x;
    1906     5830704 :   if (typ(z) == t_INT) return mpadd(x, mulii(y, z));
    1907     5830704 :   return mpadd(x, mulir(y, z));
    1908             : }
    1909             : 
    1910             : /* yk + vk * (xk + zk)^2 */
    1911             : static GEN
    1912     5775150 : norm_aux(GEN xk, GEN yk, GEN zk, GEN vk)
    1913             : {
    1914     5775150 :   GEN t = mpadd(xk, zk);
    1915     5775109 :   if (typ(t) == t_INT) { /* probably gen_0, avoid loss of accuracy */
    1916      305955 :     yk = addmulimp(yk, sqri(t), vk);
    1917             :   } else {
    1918     5469154 :     yk = mpadd(yk, mpmul(sqrr(t), vk));
    1919             :   }
    1920     5775030 :   return yk;
    1921             : }
    1922             : /* yk + vk * (xk + zk)^2 < B + epsilon */
    1923             : static int
    1924     4164486 : check_bound(GEN B, GEN xk, GEN yk, GEN zk, GEN vk)
    1925             : {
    1926     4164486 :   pari_sp av = avma;
    1927     4164486 :   int f = mpgreaterthan(norm_aux(xk,yk,zk,vk), B);
    1928     4164447 :   return gc_bool(av, !f);
    1929             : }
    1930             : 
    1931             : /* q(k-th canonical basis vector), where q is given in Cholesky form
    1932             :  * q(x) = sum_{i = 1}^n q[i,i] (x[i] + sum_{j > i} q[i,j] x[j])^2.
    1933             :  * Namely q(e_k) = q[k,k] + sum_{i < k} q[i,i] q[i,k]^2
    1934             :  * Assume 1 <= k <= n. */
    1935             : static GEN
    1936         182 : cholesky_norm_ek(GEN q, long k)
    1937             : {
    1938         182 :   GEN t = gcoeff(q,k,k);
    1939             :   long i;
    1940        1484 :   for (i = 1; i < k; i++) t = norm_aux(gen_0, t, gcoeff(q,i,k), gcoeff(q,i,i));
    1941         182 :   return t;
    1942             : }
    1943             : 
    1944             : /* q is the Cholesky decomposition of a quadratic form
    1945             :  * Enumerate vectors whose norm is less than BORNE (Algo 2.5.7),
    1946             :  * minimal vectors if BORNE = NULL (implies check = NULL).
    1947             :  * If (check != NULL) consider only vectors passing the check, and assumes
    1948             :  *   we only want the smallest possible vectors */
    1949             : static GEN
    1950       14692 : smallvectors(GEN q, GEN BORNE, long maxnum, FP_chk_fun *CHECK)
    1951             : {
    1952       14692 :   long N = lg(q), n = N-1, i, j, k, s, stockmax, checkcnt = 1;
    1953             :   pari_sp av, av1;
    1954             :   GEN inc, S, x, y, z, v, p1, alpha, norms;
    1955             :   GEN norme1, normax1, borne1, borne2;
    1956       14692 :   GEN (*check)(void *,GEN) = CHECK? CHECK->f: NULL;
    1957       14692 :   void *data = CHECK? CHECK->data: NULL;
    1958       14692 :   const long skipfirst = CHECK? CHECK->skipfirst: 0;
    1959       14692 :   const int stockall = (maxnum == -1);
    1960             : 
    1961       14692 :   alpha = dbltor(0.95);
    1962       14692 :   normax1 = gen_0;
    1963             : 
    1964       14692 :   v = cgetg(N,t_VEC);
    1965       14692 :   inc = const_vecsmall(n, 1);
    1966             : 
    1967       14692 :   av = avma;
    1968       14692 :   stockmax = stockall? 2000: maxnum;
    1969       14692 :   norms = cgetg(check?(stockmax+1): 1,t_VEC); /* unused if (!check) */
    1970       14692 :   S = cgetg(stockmax+1,t_VEC);
    1971       14692 :   x = cgetg(N,t_COL);
    1972       14692 :   y = cgetg(N,t_COL);
    1973       14692 :   z = cgetg(N,t_COL);
    1974       97716 :   for (i=1; i<N; i++) {
    1975       83024 :     gel(v,i) = gcoeff(q,i,i);
    1976       83024 :     gel(x,i) = gel(y,i) = gel(z,i) = gen_0;
    1977             :   }
    1978       14692 :   if (BORNE)
    1979             :   {
    1980       14671 :     borne1 = BORNE;
    1981       14671 :     if (gsigne(borne1) <= 0) retmkvec3(gen_0, gen_0, cgetg(1,t_MAT));
    1982       14657 :     if (typ(borne1) != t_REAL)
    1983             :     {
    1984             :       long prec;
    1985         419 :       prec = nbits2prec(gexpo(borne1) + 10);
    1986         419 :       borne1 = gtofp(borne1, maxss(prec, DEFAULTPREC));
    1987             :     }
    1988             :   }
    1989             :   else
    1990             :   {
    1991          21 :     borne1 = gcoeff(q,1,1);
    1992         203 :     for (i=2; i<N; i++)
    1993             :     {
    1994         182 :       GEN b = cholesky_norm_ek(q, i);
    1995         182 :       if (gcmp(b, borne1) < 0) borne1 = b;
    1996             :     }
    1997             :     /* borne1 = norm of smallest basis vector */
    1998             :   }
    1999       14678 :   borne2 = mulrr(borne1,alpha);
    2000       14678 :   if (DEBUGLEVEL>2)
    2001           0 :     err_printf("smallvectors looking for norm < %P.4G\n",borne1);
    2002       14678 :   s = 0; k = n;
    2003      381908 :   for(;; step(x,y,inc,k)) /* main */
    2004             :   { /* x (supposedly) small vector, ZV.
    2005             :      * For all t >= k, we have
    2006             :      *   z[t] = sum_{j > t} q[t,j] * x[j]
    2007             :      *   y[t] = sum_{i > t} q[i,i] * (x[i] + z[i])^2
    2008             :      *        = 0 <=> x[i]=0 for all i>t */
    2009             :     do
    2010             :     {
    2011     1610118 :       int skip = 0;
    2012     1610118 :       if (k > 1)
    2013             :       {
    2014     1228220 :         long l = k-1;
    2015     1228220 :         av1 = avma;
    2016     1228220 :         p1 = mulimp(gel(x,k), gcoeff(q,l,k));
    2017    14459569 :         for (j=k+1; j<N; j++) p1 = addmulimp(p1, gel(x,j), gcoeff(q,l,j));
    2018     1228220 :         gel(z,l) = gerepileuptoleaf(av1,p1);
    2019             : 
    2020     1228221 :         av1 = avma;
    2021     1228221 :         p1 = norm_aux(gel(x,k), gel(y,k), gel(z,k), gel(v,k));
    2022     1228213 :         gel(y,l) = gerepileuptoleaf(av1, p1);
    2023             :         /* skip the [x_1,...,x_skipfirst,0,...,0] */
    2024     1228217 :         if ((l <= skipfirst && !signe(gel(y,skipfirst)))
    2025     1228217 :          || mplessthan(borne1, gel(y,l))) skip = 1;
    2026             :         else /* initial value, minimizing (x[l] + z[l])^2, hence qf(x) for
    2027             :                 the given x[1..l-1] */
    2028     1214267 :           gel(x,l) = mpround( mpneg(gel(z,l)) );
    2029     1228215 :         k = l;
    2030             :       }
    2031     1228212 :       for(;; step(x,y,inc,k))
    2032             :       { /* at most 2n loops */
    2033     2838324 :         if (!skip)
    2034             :         {
    2035     2824373 :           if (check_bound(borne1, gel(x,k),gel(y,k),gel(z,k),gel(v,k))) break;
    2036     1340117 :           step(x,y,inc,k);
    2037     1340153 :           if (check_bound(borne1, gel(x,k),gel(y,k),gel(z,k),gel(v,k))) break;
    2038             :         }
    2039     1242890 :         skip = 0; inc[k] = 1;
    2040     1242890 :         if (++k > n) goto END;
    2041             :       }
    2042             : 
    2043     1595452 :       if (gc_needed(av,2))
    2044             :       {
    2045          15 :         if(DEBUGMEM>1) pari_warn(warnmem,"smallvectors");
    2046          15 :         if (stockmax) S = clonefill(S, s, stockmax);
    2047          15 :         if (check) {
    2048          15 :           GEN dummy = cgetg(1, t_STR);
    2049        9629 :           for (i=s+1; i<=stockmax; i++) gel(norms,i) = dummy;
    2050             :         }
    2051          15 :         gerepileall(av,7,&x,&y,&z,&normax1,&borne1,&borne2,&norms);
    2052             :       }
    2053             :     }
    2054     1595452 :     while (k > 1);
    2055      381907 :     if (!signe(gel(x,1)) && !signe(gel(y,1))) continue; /* exclude 0 */
    2056             : 
    2057      381178 :     av1 = avma;
    2058      381178 :     norme1 = norm_aux(gel(x,1),gel(y,1),gel(z,1),gel(v,1));
    2059      381178 :     if (mpgreaterthan(norme1,borne1)) { set_avma(av1); continue; /* main */ }
    2060             : 
    2061      381178 :     norme1 = gerepileuptoleaf(av1,norme1);
    2062      381178 :     if (check)
    2063             :     {
    2064      312592 :       if (checkcnt < 5 && mpcmp(norme1, borne2) < 0)
    2065             :       {
    2066        4405 :         if (!check(data,x)) { checkcnt++ ; continue; /* main */}
    2067         495 :         if (DEBUGLEVEL>4) err_printf("New bound: %Ps", norme1);
    2068         495 :         borne1 = norme1;
    2069         495 :         borne2 = mulrr(borne1, alpha);
    2070         495 :         s = 0; checkcnt = 0;
    2071             :       }
    2072             :     }
    2073             :     else
    2074             :     {
    2075       68586 :       if (!BORNE) /* find minimal vectors */
    2076             :       {
    2077        1890 :         if (mplessthan(norme1, borne1))
    2078             :         { /* strictly smaller vector than previously known */
    2079           0 :           borne1 = norme1; /* + epsilon */
    2080           0 :           s = 0;
    2081             :         }
    2082             :       }
    2083             :       else
    2084       66696 :         if (mpcmp(norme1,normax1) > 0) normax1 = norme1;
    2085             :     }
    2086      377269 :     if (++s > stockmax) continue; /* too many vectors: no longer remember */
    2087      376338 :     if (check) gel(norms,s) = norme1;
    2088      376338 :     gel(S,s) = leafcopy(x);
    2089      376338 :     if (s != stockmax) continue; /* still room, get next vector */
    2090             : 
    2091         125 :     if (check)
    2092             :     { /* overflow, eliminate vectors failing "check" */
    2093         104 :       pari_sp av2 = avma;
    2094             :       long imin, imax;
    2095         104 :       GEN per = indexsort(norms), S2 = cgetg(stockmax+1, t_VEC);
    2096         104 :       if (DEBUGLEVEL>2) err_printf("sorting... [%ld elts]\n",s);
    2097             :       /* let N be the minimal norm so far for x satisfying 'check'. Keep
    2098             :        * all elements of norm N */
    2099       24689 :       for (i = 1; i <= s; i++)
    2100             :       {
    2101       24683 :         long k = per[i];
    2102       24683 :         if (check(data,gel(S,k))) { borne1 = gel(norms,k); break; }
    2103             :       }
    2104         104 :       imin = i;
    2105       21113 :       for (; i <= s; i++)
    2106       21093 :         if (mpgreaterthan(gel(norms,per[i]), borne1)) break;
    2107         104 :       imax = i;
    2108       21113 :       for (i=imin, s=0; i < imax; i++) gel(S2,++s) = gel(S,per[i]);
    2109       21113 :       for (i = 1; i <= s; i++) gel(S,i) = gel(S2,i);
    2110         104 :       set_avma(av2);
    2111         104 :       if (s) { borne2 = mulrr(borne1, alpha); checkcnt = 0; }
    2112         104 :       if (!stockall) continue;
    2113         104 :       if (s > stockmax/2) stockmax <<= 1;
    2114         104 :       norms = cgetg(stockmax+1, t_VEC);
    2115       21113 :       for (i = 1; i <= s; i++) gel(norms,i) = borne1;
    2116             :     }
    2117             :     else
    2118             :     {
    2119          21 :       if (!stockall && BORNE) goto END;
    2120          21 :       if (!stockall) continue;
    2121          21 :       stockmax <<= 1;
    2122             :     }
    2123             : 
    2124             :     {
    2125         125 :       GEN Snew = clonefill(vec_lengthen(S,stockmax), s, stockmax);
    2126         125 :       if (isclone(S)) gunclone(S);
    2127         125 :       S = Snew;
    2128             :     }
    2129             :   }
    2130       14678 : END:
    2131       14678 :   if (s < stockmax) stockmax = s;
    2132       14678 :   if (check)
    2133             :   {
    2134             :     GEN per, alph, pols, p;
    2135       14650 :     if (DEBUGLEVEL>2) err_printf("final sort & check...\n");
    2136       14650 :     setlg(norms,stockmax+1); per = indexsort(norms);
    2137       14650 :     alph = cgetg(stockmax+1,t_VEC);
    2138       14650 :     pols = cgetg(stockmax+1,t_VEC);
    2139       84467 :     for (j=0,i=1; i<=stockmax; i++)
    2140             :     {
    2141       70075 :       long t = per[i];
    2142       70075 :       GEN N = gel(norms,t);
    2143       70075 :       if (j && mpgreaterthan(N, borne1)) break;
    2144       69817 :       if ((p = check(data,gel(S,t))))
    2145             :       {
    2146       55866 :         if (!j) borne1 = N;
    2147       55866 :         j++;
    2148       55866 :         gel(pols,j) = p;
    2149       55866 :         gel(alph,j) = gel(S,t);
    2150             :       }
    2151             :     }
    2152       14650 :     setlg(pols,j+1);
    2153       14650 :     setlg(alph,j+1);
    2154       14650 :     if (stockmax && isclone(S)) { alph = gcopy(alph); gunclone(S); }
    2155       14650 :     return mkvec2(pols, alph);
    2156             :   }
    2157          28 :   if (stockmax)
    2158             :   {
    2159          21 :     setlg(S,stockmax+1);
    2160          21 :     settyp(S,t_MAT);
    2161          21 :     if (isclone(S)) { p1 = S; S = gcopy(S); gunclone(p1); }
    2162             :   }
    2163             :   else
    2164           7 :     S = cgetg(1,t_MAT);
    2165          28 :   return mkvec3(utoi(s<<1), borne1, S);
    2166             : }
    2167             : 
    2168             : /* solve q(x) = x~.a.x <= bound, a > 0.
    2169             :  * If check is non-NULL keep x only if check(x).
    2170             :  * If a is a vector, assume a[1] is the LLL-reduced Cholesky form of q */
    2171             : GEN
    2172       14713 : fincke_pohst(GEN a, GEN B0, long stockmax, long PREC, FP_chk_fun *CHECK)
    2173             : {
    2174       14713 :   pari_sp av = avma;
    2175             :   VOLATILE long i,j,l;
    2176       14713 :   VOLATILE GEN r,rinv,rinvtrans,u,v,res,z,vnorm,rperm,perm,uperm, bound = B0;
    2177             : 
    2178       14713 :   if (typ(a) == t_VEC)
    2179             :   {
    2180       14245 :     r = gel(a,1);
    2181       14245 :     u = NULL;
    2182             :   }
    2183             :   else
    2184             :   {
    2185         468 :     long prec = PREC;
    2186         468 :     l = lg(a);
    2187         468 :     if (l == 1)
    2188             :     {
    2189           7 :       if (CHECK) pari_err_TYPE("fincke_pohst [dimension 0]", a);
    2190           7 :       retmkvec3(gen_0, gen_0, cgetg(1,t_MAT));
    2191             :     }
    2192         461 :     u = lllfp(a, 0.75, LLL_GRAM | LLL_IM);
    2193         454 :     if (!u || lg(u) != lg(a)) return gc_NULL(av);
    2194         454 :     r = qf_RgM_apply(a,u);
    2195         454 :     i = gprecision(r);
    2196         454 :     if (i)
    2197         412 :       prec = i;
    2198             :     else {
    2199          42 :       prec = DEFAULTPREC + nbits2extraprec(gexpo(r));
    2200          42 :       if (prec < PREC) prec = PREC;
    2201             :     }
    2202         454 :     if (DEBUGLEVEL>2) err_printf("first LLL: prec = %ld\n", prec);
    2203         454 :     r = qfgaussred_positive(r);
    2204         454 :     if (!r) return gc_NULL(av);
    2205        1984 :     for (i=1; i<l; i++)
    2206             :     {
    2207        1530 :       GEN s = gsqrt(gcoeff(r,i,i), prec);
    2208        1530 :       gcoeff(r,i,i) = s;
    2209        4236 :       for (j=i+1; j<l; j++) gcoeff(r,i,j) = gmul(s, gcoeff(r,i,j));
    2210             :     }
    2211             :   }
    2212             :   /* now r~ * r = a in LLL basis */
    2213       14699 :   rinv = RgM_inv_upper(r);
    2214       14699 :   if (!rinv) return gc_NULL(av);
    2215       14699 :   rinvtrans = shallowtrans(rinv);
    2216       14699 :   if (DEBUGLEVEL>2)
    2217           0 :     err_printf("Fincke-Pohst, final LLL: prec = %ld\n", gprecision(rinvtrans));
    2218       14699 :   v = lll(rinvtrans);
    2219       14699 :   if (lg(v) != lg(rinvtrans)) return gc_NULL(av);
    2220             : 
    2221       14699 :   rinvtrans = RgM_mul(rinvtrans, v);
    2222       14699 :   v = ZM_inv(shallowtrans(v),NULL);
    2223       14699 :   r = RgM_mul(r,v);
    2224       14699 :   u = u? ZM_mul(u,v): v;
    2225             : 
    2226       14699 :   l = lg(r);
    2227       14699 :   vnorm = cgetg(l,t_VEC);
    2228       97751 :   for (j=1; j<l; j++) gel(vnorm,j) = gnorml2(gel(rinvtrans,j));
    2229       14699 :   rperm = cgetg(l,t_MAT);
    2230       14699 :   uperm = cgetg(l,t_MAT); perm = indexsort(vnorm);
    2231       97751 :   for (i=1; i<l; i++) { uperm[l-i] = u[perm[i]]; rperm[l-i] = r[perm[i]]; }
    2232       14699 :   u = uperm;
    2233       14699 :   r = rperm; res = NULL;
    2234       14699 :   pari_CATCH(e_PREC) { }
    2235             :   pari_TRY {
    2236             :     GEN q;
    2237       14699 :     if (CHECK && CHECK->f_init) bound = CHECK->f_init(CHECK, r, u);
    2238       14692 :     q = gaussred_from_QR(r, gprecision(vnorm));
    2239       14692 :     if (q) res = smallvectors(q, bound, stockmax, CHECK);
    2240       14692 :   } pari_ENDCATCH;
    2241       14699 :   if (!res) return gc_NULL(av);
    2242       14692 :   if (CHECK)
    2243             :   {
    2244       14650 :     if (CHECK->f_post) res = CHECK->f_post(CHECK, res, u);
    2245       14650 :     return res;
    2246             :   }
    2247             : 
    2248          42 :   z = cgetg(4,t_VEC);
    2249          42 :   gel(z,1) = gcopy(gel(res,1));
    2250          42 :   gel(z,2) = gcopy(gel(res,2));
    2251          42 :   gel(z,3) = ZM_mul(u, gel(res,3)); return gerepileupto(av,z);
    2252             : }

Generated by: LCOV version 1.16