/* $Id: alglin1.c,v 1.99 2002/09/10 01:41:25 karim Exp $ Copyright (C) 2000 The PARI group. This file is part of the PARI/GP package. PARI/GP is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation. It is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY WHATSOEVER. Check the License for details. You should have received a copy of it, along with the package; see the file 'COPYING'. If not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ /********************************************************************/ /** **/ /** LINEAR ALGEBRA **/ /** (first part) **/ /** **/ /********************************************************************/ #include "pari.h" /* for linear algebra mod p */ #ifdef LONG_IS_64BIT # define MASK (0xffffffff00000000UL) #else # define MASK (0xffff0000UL) #endif /* 2p^2 < 2^BITS_IN_LONG */ #ifdef LONG_IS_64BIT # define u_OK_ULONG(p) ((ulong)p <= 3037000493UL) #else # define u_OK_ULONG(p) ((ulong)p <= 46337UL) #endif #define OK_ULONG(p) (lgefint(p) == 3 && u_OK_ULONG(p[2])) extern GEN ZM_init_CRT(GEN Hp, ulong p); extern int ZM_incremental_CRT(GEN H, GEN Hp, GEN q, GEN qp, ulong p); /*******************************************************************/ /* */ /* TRANSPOSE */ /* */ /*******************************************************************/ /* No copy*/ GEN gtrans_i(GEN x) { long i,j,lx,dx, tx=typ(x); GEN y,p1; if (! is_matvec_t(tx)) err(typeer,"gtrans_i"); switch(tx) { case t_VEC: y=dummycopy(x); settyp(y,t_COL); break; case t_COL: y=dummycopy(x); settyp(y,t_VEC); break; case t_MAT: lx=lg(x); if (lx==1) return cgetg(1,t_MAT); dx=lg(x[1]); y=cgetg(dx,tx); for (i=1; i> TWOPOTBYTES_IN_LONG; x = cgetg(l+1, t_STR); str = GSTR(x); strcpy(str,sx); strcat(str,sy); if (flx) free(sx); if (fly) free(sy); return x; } /* concat 3 matrices. Internal */ GEN concatsp3(GEN x, GEN y, GEN z) { long i, lx = lg(x), ly = lg(y), lz = lg(z); GEN t, r = cgetg(lx+ly+lz-2, t_MAT); t = r; for (i=1; i=3) break; return (ly==1)? x: concatsp(x,(GEN) y[1]); case t_MAT: z=cgetg(ly,ty); if (lx != ly) break; for (i=1; i=3) break; return (ly==1)? x: concatsp(x,(GEN) y[1]); case t_MAT: if (lx != lg(y[1])) break; z=cgetg(ly+1,ty); z[1]=(long)x; for (i=2; i<=ly; i++) z[i]=y[i-1]; return z; } break; case t_MAT: switch(ty) { case t_VEC: z=cgetg(lx,tx); if (ly != lx) break; for (i=1; i=lx) err(talker,"trying to concat elements of an empty vector"); y = (GEN)x[i++]; for (; i=3) break; return (ly==1)? gcopy(x): concat(x,(GEN) y[1]); case t_MAT: z=cgetg(ly,ty); if (lx != ly) break; for (i=1; i=3) break; return (ly==1)? gcopy(x): concat(x,(GEN) y[1]); case t_MAT: if (lx != lg(y[1])) break; z=cgetg(ly+1,ty); z[1]=lcopy(x); for (i=2; i<=ly; i++) z[i]=lcopy((GEN) y[i-1]); return z; } break; case t_MAT: switch(ty) { case t_VEC: z=cgetg(lx,tx); if (ly != lx) break; for (i=1; imax) return 0; } if (*s == '.') { s++; if (*s != '.') return 0; do s++; while (isspace((int)*s)); if (*s) { *b = str_to_long(s, &s); if (*b < 0) *b += lx; if (*b<1 || *b>max || *s) return 0; } return 1; } if (*s) return 0; *b = *a; return 1; } GEN vecextract_i(GEN A, long y1, long y2) { long i,lB = y2 - y1 + 2; GEN B = cgetg(lB, typ(A)); for (i=1; ifirst; i--,j++) y[j] = lcopy((GEN)x[i]); for (i=last-1; i>0; i--,j++) y[j] = lcopy((GEN)x[i]); } } else { if (first <= last) { y = cgetg(last-first+2,tx); for (i=first,j=1; i<=last; i++,j++) y[j] = lcopy((GEN)x[i]); } else { y = cgetg(first-last+2,tx); for (i=first,j=1; i>=last; i--,j++) y[j] = lcopy((GEN)x[i]); } } return y; } if (is_vec_t(tl)) { long ll=lg(l); y=cgetg(ll,tx); for (i=1; i=lx || j<=0) err(talker,"no such component in vecextract"); y[i] = lcopy((GEN) x[j]); } return y; } if (tl == t_VECSMALL) { long ll=lg(l); y=cgetg(ll,tx); for (i=1; i=lx || j<=0) err(talker,"no such component in vecextract"); y[i] = lcopy((GEN) x[j]); } return y; } err(talker,"incorrect mask in vecextract"); return NULL; /* not reached */ } GEN matextract(GEN x, GEN l1, GEN l2) { gpmem_t av = avma, tetpil; if (typ(x)!=t_MAT) err(typeer,"matextract"); x = extract(gtrans(extract(x,l2)),l1); tetpil=avma; return gerepile(av,tetpil, gtrans(x)); } GEN extract0(GEN x, GEN l1, GEN l2) { if (! l2) return extract(x,l1); return matextract(x,l1,l2); } /* v[a] + ... + v[b] */ GEN sum(GEN v, long a, long b) { GEN p; long i; if (a > b) return gzero; if (b > lg(v)-1) err(talker,"incorrect length in sum"); p = (GEN)v[a]; for (i=a+1; i<=b; i++) p = gadd(p, (GEN)v[i]); return p; } /*******************************************************************/ /* */ /* SCALAR-MATRIX OPERATIONS */ /* */ /*******************************************************************/ /* create the square nxn matrix equal to z*Id */ static GEN gscalmat_proto(GEN z, GEN myzero, long n, int flag) { long i,j; GEN y = cgetg(n+1,t_MAT); if (n < 0) err(talker,"negative size in scalmat"); if (flag) z = (flag==1)? stoi((long)z): gcopy(z); for (i=1; i<=n; i++) { y[i]=lgetg(n+1,t_COL); for (j=1; j<=n; j++) coeff(y,j,i) = (i==j)? (long)z: (long)myzero; } return y; } GEN gscalmat(GEN x, long n) { return gscalmat_proto(x,gzero,n,2); } GEN gscalsmat(long x, long n) { return gscalmat_proto((GEN)x,gzero,n,1); } GEN idmat(long n) { return gscalmat_proto(gun,gzero,n,0); } GEN idmat_intern(long n,GEN myun,GEN z) { return gscalmat_proto(myun,z,n,0); } GEN gscalcol_proto(GEN z, GEN myzero, long n) { GEN y = cgetg(n+1,t_COL); long i; if (n) { y[1]=(long)z; for (i=2; i<=n; i++) y[i]=(long)myzero; } return y; } GEN zerocol(long n) { GEN y = cgetg(n+1,t_COL); long i; for (i=1; i<=n; i++) y[i]=zero; return y; } GEN zerovec(long n) { GEN y = cgetg(n+1,t_VEC); long i; for (i=1; i<=n; i++) y[i]=zero; return y; } GEN zeromat(long m, long n) { GEN y = cgetg(n+1,t_MAT); GEN v = zerocol(m); long i; for (i=1; i<=n; i++) y[i]=(long)v; return y; } GEN gscalcol(GEN x, long n) { GEN y=gscalcol_proto(gzero,gzero,n); if (n) y[1]=lcopy(x); return y; } GEN gscalcol_i(GEN x, long n) { return gscalcol_proto(x,gzero,n); } GEN gtomat(GEN x) { long tx,lx,i; GEN y,p1; if (!x) return cgetg(1, t_MAT); tx = typ(x); if (! is_matvec_t(tx)) { y=cgetg(2,t_MAT); p1=cgetg(2,t_COL); y[1]=(long)p1; p1[1]=lcopy(x); return y; } switch(tx) { case t_VEC: lx=lg(x); y=cgetg(lx,t_MAT); for (i=1; i0; i--) { av = avma; m = mulii(negi((GEN)b[i]),t); for (j=i+1; j<=n; j++) m = addii(m, mulii(gcoeff(A,i,j),(GEN) u[j])); u[i] = lpileuptoint(av, divii(negi(m), gcoeff(A,i,i))); } } return c; } /* A, B integral upper HNF. A^(-1) B integral ? */ int hnfdivide(GEN A, GEN B) { gpmem_t av = avma; long n = lg(A)-1, i,j,k; GEN u, b, m, r; if (!n) return 1; u = cgetg(n+1, t_COL); for (k=1; k<=n; k++) { b = (GEN)B[k]; m = (GEN)b[k]; u[k] = ldvmdii(m, gcoeff(A,k,k), &r); if (r != gzero) { avma = av; return 0; } for (i=k-1; i>0; i--) { m = negi((GEN)b[i]); for (j=i+1; j<=k; j++) m = addii(m, mulii(gcoeff(A,i,j),(GEN) u[j])); m = dvmdii(m, gcoeff(A,i,i), &r); if (r != gzero) { avma = av; return 0; } u[i] = lnegi(m); } } avma = av; return 1; } /* A upper HNF, b integral vector. Return A^(-1) b if integral, * NULL otherwise. */ GEN hnf_invimage(GEN A, GEN b) { gpmem_t av = avma, av2; long n = lg(A)-1, i,j; GEN u, m, r; if (!n) return NULL; u = cgetg(n+1, t_COL); m = (GEN)b[n]; u[n] = ldvmdii(m, gcoeff(A,n,n), &r); if (r != gzero) { avma = av; return NULL; } for (i=n-1; i>0; i--) { av2 = avma; m = negi((GEN)b[i]); for (j=i+1; j<=n; j++) m = addii(m, mulii(gcoeff(A,i,j),(GEN) u[j])); m = dvmdii(m, gcoeff(A,i,i), &r); if (r != gzero) { avma = av; return NULL; } u[i] = lpileuptoint(av2, negi(m)); } return u; } GEN gauss_get_col(GEN a, GEN b, GEN p, long li) { GEN m, u=cgetg(li+1,t_COL); long i,j; u[li] = ldiv((GEN)b[li], p); for (i=li-1; i>0; i--) { gpmem_t av = avma; m = gneg_i((GEN)b[i]); for (j=i+1; j<=li; j++) m = gadd(m, gmul(gcoeff(a,i,j), (GEN)u[j])); u[i] = lpileupto(av, gdiv(gneg_i(m), gcoeff(a,i,i))); } return u; } GEN Fp_gauss_get_col(GEN a, GEN b, GEN piv, long li, GEN p) { GEN m, u=cgetg(li+1,t_COL); long i,j; u[li] = lresii(mulii((GEN)b[li], mpinvmod(piv,p)), p); for (i=li-1; i>0; i--) { gpmem_t av = avma; m = (GEN)b[i]; for (j=i+1; j<=li; j++) m = subii(m, mulii(gcoeff(a,i,j), (GEN)u[j])); m = resii(m, p); u[i] = lpileuptoint(av, resii(mulii(m, mpinvmod(gcoeff(a,i,i), p)), p)); } return u; } GEN Fq_gauss_get_col(GEN a, GEN b, GEN piv, long li, GEN T, GEN p) { GEN m, u=cgetg(li+1,t_COL); long i,j; u[li] = (long)FpXQ_mul((GEN)b[li], FpXQ_inv(piv,T,p), T,p); for (i=li-1; i>0; i--) { gpmem_t av = avma; m = (GEN)b[i]; for (j=i+1; j<=li; j++) m = gsub(m, gmul(gcoeff(a,i,j), (GEN)u[j])); m = FpX_res(m, T,p); u[i] = lpileupto(av, FpXQ_mul(m, FpXQ_inv(gcoeff(a,i,i), T,p), T,p)); } return u; } /* assume -p < a < p, return 1/a mod p */ static long u_Fp_inv(long a, long p) { if (a < 0) a = p + a; /* pb with ulongs < 0 */ return (long)u_invmod((ulong)a,(ulong)p); } /* assume 0 <= a[i,i] < p */ GEN u_Fp_gauss_get_col(GEN a, GEN b, ulong piv, long li, ulong p) { GEN u = cgetg(li+1,t_VECSMALL); ulong m; long i,j; m = b[li] % p; if (u_OK_ULONG(p)) { u[li] = (m * u_Fp_inv(piv,p)) % p; for (i=li-1; i>0; i--) { m = p - b[i]%p; for (j=i+1; j<=li; j++) { if (m & HIGHBIT) m %= p; m += coeff(a,i,j) * u[j]; } m %= p; if (m) m = ((p-m) * u_invmod((ulong)coeff(a,i,i), p)) % p; u[i] = m; } } else { u[li] = mulssmod(m, u_Fp_inv(piv,p), p); for (i=li-1; i>0; i--) { m = p - b[i]%p; for (j=i+1; j<=li; j++) m += mulssmod(coeff(a,i,j), u[j], p); m %= p; if (m) m = mulssmod(p-m, u_invmod((ulong)coeff(a,i,i), p), p); u[i] = m; } } return u; } /* bk += m * bi */ static void _addmul(GEN b, long k, long i, GEN m) { b[k] = ladd((GEN)b[k], gmul(m, (GEN)b[i])); } /* same, reduce mod p */ static void _Fp_addmul(GEN b, long k, long i, GEN m, GEN p) { if (lgefint(b[i]) > lgefint(p)) b[i] = lresii((GEN)b[i], p); b[k] = laddii((GEN)b[k], mulii(m, (GEN)b[i])); } /* same, reduce mod (T,p) */ static void _Fq_addmul(GEN b, long k, long i, GEN m, GEN T, GEN p) { b[i] = (long)FpX_res((GEN)b[i], T,p); b[k] = (long)ladd((GEN)b[k], gmul(m, (GEN)b[i])); } /* assume m < p && u_OK_ULONG(p) && (! (b[i] & MASK)) */ static void _u_Fp_addmul_OK(GEN b, long k, long i, ulong m, ulong p) { b[k] += m * b[i]; if (b[k] & MASK) b[k] %= p; } /* assume m < p */ static void _u_Fp_addmul(GEN b, long k, long i, ulong m, ulong p) { b[i] %= p; b[k] += mulssmod(m, b[i], p); if (b[k] & MASK) b[k] %= p; } /* same m = 1 */ static void _u_Fp_add(GEN b, long k, long i, ulong p) { b[k] += b[i]; if (b[k] & MASK) b[k] %= p; } /* Gaussan Elimination. Compute a^(-1)*b * b is a matrix or column vector, NULL meaning: take the identity matrix * If a and b are empty, the result is the empty matrix. * * li: nb lines of a and b * aco: nb columns of a * bco: nb columns of b (if matrix) * * li > aco is allowed if b = NULL, in which case return c such that c a = Id */ GEN gauss_intern(GEN a, GEN b) { gpmem_t av, lim; long i,j,k,li,bco, aco = lg(a)-1; int inexact, iscol; GEN p,m,u; if (typ(a)!=t_MAT) err(mattype1,"gauss"); if (b && typ(b)!=t_COL && typ(b)!=t_MAT) err(typeer,"gauss"); if (!aco) { if (b && lg(b)!=1) err(consister,"gauss"); if (DEBUGLEVEL) err(warner,"in Gauss lg(a)=1 lg(b)=%ld", b?1:-1); return cgetg(1,t_MAT); } av = avma; lim = stack_lim(av,1); li = lg(a[1])-1; if (li != aco && (li < aco || b)) err(mattype1,"gauss"); a = dummycopy(a); b = check_b(b,li, &iscol); bco = lg(b)-1; inexact = use_maximal_pivot(a); if(DEBUGLEVEL>4) fprintferr("Entering gauss with inexact=%ld\n",inexact); p = NULL; /* gcc -Wall */ for (i=1; i<=aco; i++) { /* k is the line where we find the pivot */ p = gcoeff(a,i,i); k = i; if (inexact) /* maximal pivot */ { long e, ex = gexpo(p); for (j=i+1; j<=li; j++) { e = gexpo(gcoeff(a,j,i)); if (e > ex) { ex=e; k=j; } } if (gcmp0(gcoeff(a,k,i))) return NULL; } else if (gcmp0(p)) /* first non-zero pivot */ { do k++; while (k<=li && gcmp0(gcoeff(a,k,i))); if (k>li) return NULL; } /* if (k!=i), exchange the lines s.t. k = i */ if (k != i) { for (j=i; j<=aco; j++) swap(coeff(a,i,j), coeff(a,k,j)); for (j=1; j<=bco; j++) swap(coeff(b,i,j), coeff(b,k,j)); p = gcoeff(a,i,i); } if (i == aco) break; for (k=i+1; k<=li; k++) { m = gcoeff(a,k,i); if (!gcmp0(m)) { m = gneg_i(gdiv(m,p)); for (j=i+1; j<=aco; j++) _addmul((GEN)a[j],k,i,m); for (j=1; j<=bco; j++) _addmul((GEN)b[j],k,i,m); } } if (low_stack(lim, stack_lim(av,1))) { if(DEBUGMEM>1) err(warnmem,"gauss. i=%ld",i); gerepileall(av,2, &a,&b); } } if(DEBUGLEVEL>4) fprintferr("Solving the triangular system\n"); u = cgetg(bco+1,t_MAT); for (j=1; j<=bco; j++) u[j] = (long)gauss_get_col(a,(GEN)b[j],p,aco); return gerepilecopy(av, iscol? (GEN)u[1]: u); } GEN gauss(GEN a, GEN b) { GEN z = gauss_intern(a,b); if (!z) err(matinv1); return z; } /* destroy a, b */ static GEN u_FpM_gauss_sp(GEN a, GEN b, ulong p) { long iscol,i,j,k,li,bco, aco = lg(a)-1; ulong piv, m; GEN u; if (!aco) return cgetg(1,t_MAT); li = lg(a[1])-1; bco = lg(b)-1; iscol = (typ(b)!=t_MAT); if (iscol) b = col_to_mat(b); piv = 0; /* gcc -Wall */ for (i=1; i<=aco; i++) { /* k is the line where we find the pivot */ piv = coeff(a,i,i) % p; coeff(a,i,i) = piv; k = i; if (!piv) { for (k++; k <= li; k++) { coeff(a,k,i) %= p; if (coeff(a,k,i)) break; } if (k>li) return NULL; } /* if (k!=i), exchange the lines s.t. k = i */ if (k != i) { for (j=i; j<=aco; j++) swap(coeff(a,i,j), coeff(a,k,j)); for (j=1; j<=bco; j++) swap(coeff(b,i,j), coeff(b,k,j)); piv = coeff(a,i,i); } if (i == aco) break; for (k=i+1; k<=li; k++) { m = coeff(a,k,i) % p; coeff(a,k,i) = 0; if (m) { m = mulssmod(m, u_invmod(piv,p), p); m = p - m; if (u_OK_ULONG(p)) { for (j=i+1; j<=aco; j++) _u_Fp_addmul_OK((GEN)a[j],k,i,m, p); for (j=1; j<=bco; j++) _u_Fp_addmul_OK((GEN)b[j],k,i,m, p); } else { for (j=i+1; j<=aco; j++) _u_Fp_addmul((GEN)a[j],k,i,m, p); for (j=1; j<=bco; j++) _u_Fp_addmul((GEN)b[j],k,i,m, p); } } } } u = cgetg(bco+1,t_MAT); for (j=1; j<=bco; j++) u[j] = (long)u_Fp_gauss_get_col(a,(GEN)b[j],piv,aco,p); return iscol? (GEN)u[1]: u; } static GEN u_idmat(long n) { GEN y = cgetg(n+1,t_MAT); long i; if (n < 0) err(talker,"negative size in u_idmat"); for (i=1; i<=n; i++) { y[i] = (long)vecsmall_const(n, 0); coeff(y, i,i) = 1; } return y; } GEN u_FpM_gauss(GEN a, GEN b, ulong p) { return u_FpM_gauss_sp(dummycopy(a), dummycopy(b), p); } static GEN u_FpM_inv_sp(GEN a, ulong p) { return u_FpM_gauss_sp(a, u_idmat(lg(a)-1), p); } GEN u_FpM_inv(GEN a, ulong p) { return u_FpM_inv_sp(dummycopy(a), p); } GEN FpM_gauss(GEN a, GEN b, GEN p) { gpmem_t av,lim; long i,j,k,li,bco, aco = lg(a)-1; int iscol; GEN piv,m,u; if (typ(a)!=t_MAT) err(mattype1,"gauss"); if (b && typ(b)!=t_COL && typ(b)!=t_MAT) err(typeer,"gauss"); if (!aco) { if (b && lg(b)!=1) err(consister,"gauss"); if (DEBUGLEVEL) err(warner,"in Gauss lg(a)=1 lg(b)=%ld", b?1:-1); return cgetg(1,t_MAT); } li = lg(a[1])-1; if (li != aco && (li < aco || b)) err(mattype1,"gauss"); b = check_b(b,li, &iscol); av = avma; if (OK_ULONG(p)) { ulong pp=p[2]; a = u_Fp_FpM(a, pp); b = u_Fp_FpM(b, pp); u = u_FpM_gauss_sp(a,b, pp); u = iscol? small_to_col((GEN)u[1]): small_to_mat(u); return gerepileupto(av, u); } lim = stack_lim(av,1); a = dummycopy(a); bco = lg(b)-1; piv = NULL; /* gcc -Wall */ for (i=1; i<=aco; i++) { /* k is the line where we find the pivot */ coeff(a,i,i) = lresii(gcoeff(a,i,i), p); piv = gcoeff(a,i,i); k = i; if (!signe(piv)) { for (k++; k <= li; k++) { coeff(a,k,i) = lresii(gcoeff(a,k,i), p); if (signe(coeff(a,k,i))) break; } if (k>li) return NULL; } /* if (k!=i), exchange the lines s.t. k = i */ if (k != i) { for (j=i; j<=aco; j++) swap(coeff(a,i,j), coeff(a,k,j)); for (j=1; j<=bco; j++) swap(coeff(b,i,j), coeff(b,k,j)); piv = gcoeff(a,i,i); } if (i == aco) break; for (k=i+1; k<=li; k++) { coeff(a,k,i) = lresii(gcoeff(a,k,i), p); m = gcoeff(a,k,i); coeff(a,k,i) = zero; if (signe(m)) { m = mulii(m, mpinvmod(piv,p)); m = resii(negi(m), p); for (j=i+1; j<=aco; j++) _Fp_addmul((GEN)a[j],k,i,m, p); for (j=1 ; j<=bco; j++) _Fp_addmul((GEN)b[j],k,i,m, p); } } if (low_stack(lim, stack_lim(av,1))) { GEN *gptr[2]; gptr[0]=&a; gptr[1]=&b; if(DEBUGMEM>1) err(warnmem,"FpM_gauss. i=%ld",i); gerepilemany(av,gptr,2); } } if(DEBUGLEVEL>4) fprintferr("Solving the triangular system\n"); u = cgetg(bco+1,t_MAT); for (j=1; j<=bco; j++) u[j] = (long)Fp_gauss_get_col(a,(GEN)b[j],piv,aco,p); return gerepilecopy(av, iscol? (GEN)u[1]: u); } GEN FqM_gauss(GEN a, GEN b, GEN T, GEN p) { gpmem_t av,lim; long i,j,k,li,bco, aco = lg(a)-1; int iscol; GEN piv,m,u; if (!T) return FpM_gauss(a,b,p); if (typ(a)!=t_MAT) err(mattype1,"gauss"); if (b && typ(b)!=t_COL && typ(b)!=t_MAT) err(typeer,"gauss"); if (!aco) { if (b && lg(b)!=1) err(consister,"gauss"); if (DEBUGLEVEL) err(warner,"in Gauss lg(a)=1 lg(b)=%ld", b?1:-1); return cgetg(1,t_MAT); } li = lg(a[1])-1; if (li != aco && (li < aco || b)) err(mattype1,"gauss"); b = check_b(b,li,&iscol); av = avma; lim = stack_lim(av,1); a = dummycopy(a); bco = lg(b)-1; piv = NULL; /* gcc -Wall */ for (i=1; i<=aco; i++) { /* k is the line where we find the pivot */ coeff(a,i,i) = (long)FpX_res(gcoeff(a,i,i), T,p); piv = gcoeff(a,i,i); k = i; if (!signe(piv)) { for (k++; k <= li; k++) { coeff(a,k,i) = (long)FpX_res(gcoeff(a,k,i), T,p); if (signe(coeff(a,k,i))) break; } if (k>li) return NULL; } /* if (k!=i), exchange the lines s.t. k = i */ if (k != i) { for (j=i; j<=aco; j++) swap(coeff(a,i,j), coeff(a,k,j)); for (j=1; j<=bco; j++) swap(coeff(b,i,j), coeff(b,k,j)); piv = gcoeff(a,i,i); } if (i == aco) break; for (k=i+1; k<=li; k++) { coeff(a,k,i) = (long)FpX_res(gcoeff(a,k,i), T,p); m = gcoeff(a,k,i); coeff(a,k,i) = zero; if (signe(m)) { m = FpXQ_mul(m, FpXQ_inv(piv,T,p),T,p); m = resii(negi(m), p); for (j=i+1; j<=aco; j++) _Fq_addmul((GEN)a[j],k,i,m, T,p); for (j=1; j<=bco; j++) _Fq_addmul((GEN)b[j],k,i,m, T,p); } } if (low_stack(lim, stack_lim(av,1))) { GEN *gptr[2]; gptr[0]=&a; gptr[1]=&b; if(DEBUGMEM>1) err(warnmem,"FpM_gauss. i=%ld",i); gerepilemany(av,gptr,2); } } if(DEBUGLEVEL>4) fprintferr("Solving the triangular system\n"); u = cgetg(bco+1,t_MAT); for (j=1; j<=bco; j++) u[j] = (long)Fq_gauss_get_col(a,(GEN)b[j],piv,aco,T,p); return gerepilecopy(av, iscol? (GEN)u[1]: u); } GEN FpM_inv(GEN x, GEN p) { return FpM_gauss(x, NULL, p); } /* set y = x * y */ #define HIGHWORD(a) ((a) >> BITS_IN_HALFULONG) static GEN u_FpM_Fp_mul_ip(GEN y, long x, long p) { int i,j, m = lg(y[1]), l = lg(y); if (HIGHWORD(x | p)) for(j=1; j5) msgtimer("inverse mod %ld (stable=%ld)", p,stable); if (stable && isscalarmat(gmul(M, H), dM)) break; /* DONE */ if (low_stack(lim, stack_lim(av,2))) { GEN *gptr[2]; gptr[0] = &H; gptr[1] = &q; if (DEBUGMEM>1) err(warnmem,"ZM_inv"); gerepilemany(av2,gptr, 2); } repeat: NEXT_PRIME_VIADIFF_CHECK(p,d); } if (DEBUGLEVEL>5) msgtimer("ZM_inv done"); return gerepilecopy(av, H); } /* same as above, M rational */ GEN QM_inv(GEN M, GEN dM) { gpmem_t av = avma; GEN cM, pM = Q_primitive_part(M, &cM); if (!cM) return ZM_inv(pM,dM); return gerepileupto(av, ZM_inv(pM, gdiv(dM,cM))); } /* x a matrix with integer coefficients. Return a multiple of the determinant * of the lattice generated by the columns of x (to be used with hnfmod) */ GEN detint(GEN x) { gpmem_t av = avma, av1, lim; GEN pass,c,v,det1,piv,pivprec,vi,p1; long i,j,k,rg,n,m,m1; if (typ(x)!=t_MAT) err(typeer,"detint"); n=lg(x)-1; if (!n) return gun; m1=lg(x[1]); m=m1-1; lim=stack_lim(av,1); c=new_chunk(m1); for (k=1; k<=m; k++) c[k]=0; av1=avma; pass=cgetg(m1,t_MAT); for (j=1; j<=m; j++) { p1=cgetg(m1,t_COL); pass[j]=(long)p1; for (i=1; i<=m; i++) p1[i]=zero; } for (k=1; k<=n; k++) for (j=1; j<=m; j++) if (typ(gcoeff(x,j,k)) != t_INT) err(talker,"not an integer matrix in detint"); v=cgetg(m1,t_COL); det1=gzero; piv=pivprec=gun; for (rg=0,k=1; k<=n; k++) { long t = 0; for (i=1; i<=m; i++) if (!c[i]) { vi=mulii(piv,gcoeff(x,i,k)); for (j=1; j<=m; j++) if (c[j]) vi=addii(vi,mulii(gcoeff(pass,i,j),gcoeff(x,j,k))); v[i]=(long)vi; if (!t && signe(vi)) t=i; } if (t) { if (rg == m-1) { det1=mppgcd((GEN)v[t],det1); c[t]=0; } else { rg++; pivprec = piv; piv=(GEN)v[t]; c[t]=k; for (i=1; i<=m; i++) if (!c[i]) { GEN p2 = negi((GEN)v[i]); for (j=1; j<=m; j++) if (c[j] && j!=t) { p1 = addii(mulii(gcoeff(pass,i,j), piv), mulii(gcoeff(pass,t,j), p2)); if (rg>1) p1 = divii(p1,pivprec); coeff(pass,i,j) = (long)p1; } coeff(pass,i,t) = (long)p2; } } } if (low_stack(lim, stack_lim(av,1))) { GEN *gptr[5]; if(DEBUGMEM>1) err(warnmem,"detint. k=%ld",k); gptr[0]=&det1; gptr[1]=ϖ gptr[2]=&pivprec; gptr[3]=&pass; gptr[4]=&v; gerepilemany(av1,gptr,5); } } return gerepileupto(av, absi(det1)); } static void gerepile_gauss_ker(GEN x, long k, long t, gpmem_t av) { gpmem_t tetpil = avma, A; long u,i, n = lg(x)-1, m = n? lg(x[1])-1: 0; size_t dec; if (DEBUGMEM > 1) err(warnmem,"gauss_pivot_ker. k=%ld, n=%ld",k,n); for (u=t+1; u<=m; u++) copyifstack(coeff(x,u,k), coeff(x,u,k)); for (i=k+1; i<=n; i++) for (u=1; u<=m; u++) copyifstack(coeff(x,u,i), coeff(x,u,i)); (void)gerepile(av,tetpil,NULL); dec = av-tetpil; for (u=t+1; u<=m; u++) { A=(gpmem_t)coeff(x,u,k); if (A=bot) coeff(x,u,k)+=dec; } for (i=k+1; i<=n; i++) for (u=1; u<=m; u++) { A=(gpmem_t)coeff(x,u,i); if (A=bot) coeff(x,u,i)+=dec; } } static void gerepile_gauss_FpM_ker(GEN x, GEN p, long k, long t, gpmem_t av) { gpmem_t tetpil = avma, A; long u,i, n = lg(x)-1, m = n? lg(x[1])-1: 0; size_t dec; if (DEBUGMEM > 1) err(warnmem,"gauss_pivot_ker. k=%ld, n=%ld",k,n); for (u=t+1; u<=m; u++) if (isonstack(coeff(x,u,k))) coeff(x,u,k) = lmodii(gcoeff(x,u,k),p); for (i=k+1; i<=n; i++) for (u=1; u<=m; u++) if (isonstack(coeff(x,u,i))) coeff(x,u,i) = lmodii(gcoeff(x,u,i),p); (void)gerepile(av,tetpil,NULL); dec = av-tetpil; for (u=t+1; u<=m; u++) { A=(gpmem_t)coeff(x,u,k); if (A=bot) coeff(x,u,k)+=dec; } for (i=k+1; i<=n; i++) for (u=1; u<=m; u++) { A=(gpmem_t)coeff(x,u,i); if (A=bot) coeff(x,u,i)+=dec; } } /* special gerepile for huge matrices */ static void gerepile_gauss(GEN x,long k,long t,gpmem_t av, long j, GEN c) { gpmem_t tetpil = avma, A; long u,i, n = lg(x)-1, m = n? lg(x[1])-1: 0; size_t dec; if (DEBUGMEM > 1) err(warnmem,"gauss_pivot. k=%ld, n=%ld",k,n); for (u=t+1; u<=m; u++) if (u==j || !c[u]) copyifstack(coeff(x,u,k), coeff(x,u,k)); for (u=1; u<=m; u++) if (u==j || !c[u]) for (i=k+1; i<=n; i++) copyifstack(coeff(x,u,i), coeff(x,u,i)); (void)gerepile(av,tetpil,NULL); dec = av-tetpil; for (u=t+1; u<=m; u++) if (u==j || !c[u]) { A=(gpmem_t)coeff(x,u,k); if (A=bot) coeff(x,u,k)+=dec; } for (u=1; u<=m; u++) if (u==j || !c[u]) for (i=k+1; i<=n; i++) { A=(gpmem_t)coeff(x,u,i); if (A=bot) coeff(x,u,i)+=dec; } } /*******************************************************************/ /* */ /* KERNEL of an m x n matrix */ /* return n - rk(x) linearly independant vectors */ /* */ /*******************************************************************/ static long gauss_get_pivot_NZ(GEN x, GEN x0/*unused*/, GEN c, long i0) { long i,lx = lg(x); (void)x0; if (c) for (i=i0; i bit_accuracy(lg(x))); } static long gauss_get_pivot_max(GEN x, GEN x0, GEN c, long i0) { long i,e, k = i0, ex = - (long)HIGHEXPOBIT, lx = lg(x); GEN p,r; if (c) for (i=i0; i ex) { ex=e; k=i; } } else for (i=i0; i ex) { ex=e; k=i; } } p = (GEN)x[k]; r = (GEN)x0[k]; if (isexactzero(r)) r = x0; return approx_0(p, r)? i: k; } /* x has INTEGER coefficients */ GEN keri(GEN x) { gpmem_t av, av0, tetpil, lim; GEN c,l,y,p,pp; long i,j,k,r,t,n,m; if (typ(x)!=t_MAT) err(typeer,"keri"); n=lg(x)-1; if (!n) return cgetg(1,t_MAT); av0=avma; m=lg(x[1])-1; r=0; pp=cgetg(n+1,t_COL); x=dummycopy(x); p=gun; c=cgetg(m+1, t_VECSMALL); for (k=1; k<=m; k++) c[k]=0; l=cgetg(n+1, t_VECSMALL); av = avma; lim = stack_lim(av,1); for (k=1; k<=n; k++) { j = 1; while ( j <= m && (c[j] || !signe(gcoeff(x,j,k))) ) j++; if (j > m) { r++; l[k] = 0; for(j=1; j nl) break; d[k] = ck[i]; c[i] = k; l[k] = i; /* pivot d[k] in x[i,k] */ } if (k > nc) { avma = av; return zerocol(nc); } if (k == 1) { avma = av; return gscalcol_i(gun,nc); } y = cgetg(nc+1,t_COL); y[1] = (long)ck[ l[1] ]; for (q=d[1],j=2; j m) { r++; d[k]=0; for(j=1; jm) { r++; d[d0[k]]=0; } else { c[j]=k; d[d0[k]]=j; p = gdiv(mun,gcoeff(x,j,k)); for (i=k+1; i<=n; i++) coeff(x,j,i) = lmul(p,gcoeff(x,j,i)); for (t=1; t<=m; t++) if (!c[t]) /* no pivot on that line yet */ { p=gcoeff(x,t,k); coeff(x,t,k)=zero; for (i=k+1; i<=n; i++) coeff(x,t,i) = ladd(gcoeff(x,t,i), gmul(p,gcoeff(x,j,i))); if (low_stack(lim, stack_lim(av,1))) gerepile_gauss(x,k,t,av,j,c); } for (i=k; i<=n; i++) coeff(x,j,i) = zero; /* dummy */ } } *dd=d; *rr=r; } /* compute ker(x - aI) */ static GEN ker0(GEN x, GEN a) { gpmem_t av = avma, tetpil; GEN d,y; long i,j,k,r,n; x = gauss_pivot_ker(x,a,&d,&r); if (!r) { avma=av; return cgetg(1,t_MAT); } n = lg(x)-1; tetpil=avma; y=cgetg(r+1,t_MAT); for (j=k=1; j<=r; j++,k++) { GEN p = cgetg(n+1,t_COL); y[j]=(long)p; while (d[k]) k++; for (i=1; i 0 for all j, but why take chances? */ for (j=1; j<=rx; j++) if (d[j]) { c[ d[j] ] = 1; y[k++] = x[j]; } for (j=1; j<=n; j++) if (!c[j]) y[k++] = j; avma = av; rx -= r; for (j=1; j<=rx; j++) y[j] = lcopy((GEN)y[j]); for ( ; j<=n; j++) y[j] = (long)_ei(n, y[j]); free(d); return y; } /* x is an n x k matrix, rank(x) = k <= n. Return an invertible n x n matrix * whose first k columns are given by x. If rank(x) < k, undefined result. */ GEN suppl(GEN x) { gpmem_t av = avma; GEN d; long r; gauss_pivot(x,&d,&r); avma = av; return get_suppl(x,d,r); } static void FpM_gauss_pivot(GEN x, GEN p, GEN *dd, long *rr); static void FqM_gauss_pivot(GEN x, GEN T, GEN p, GEN *dd, long *rr); GEN FpM_suppl(GEN x, GEN p) { gpmem_t av = avma; GEN d; long r; FpM_gauss_pivot(x,p, &d,&r); avma = av; return get_suppl(x,d,r); } GEN FqM_suppl(GEN x, GEN T, GEN p) { gpmem_t av = avma; GEN d; long r; if (!T) return FpM_suppl(x,p); FqM_gauss_pivot(x,T,p, &d,&r); avma = av; return get_suppl(x,d,r); } GEN image2(GEN x) { gpmem_t av=avma,tetpil; long k,n,i; GEN p1,p2; if (typ(x)!=t_MAT) err(typeer,"image2"); k=lg(x)-1; if (!k) return gcopy(x); n=lg(x[1])-1; p1=ker(x); k=lg(p1)-1; if (k) { p1=suppl(p1); n=lg(p1)-1; } else p1=idmat(n); tetpil=avma; p2=cgetg(n-k+1,t_MAT); for (i=k+1; i<=n; i++) p2[i-k]=lmul(x,(GEN) p1[i]); return gerepile(av,tetpil,p2); } GEN matimage0(GEN x,long flag) { switch(flag) { case 0: return image(x); case 1: return image2(x); default: err(flagerr,"matimage"); } return NULL; /* not reached */ } long rank(GEN x) { gpmem_t av = avma; long r; GEN d; gauss_pivot(x,&d,&r); /* yield r = dim ker(x) */ avma=av; if (d) free(d); return lg(x)-1 - r; } /* if p != NULL, assume x integral and compute rank over Fp */ static GEN indexrank0(GEN x, GEN p, int small) { gpmem_t av = avma; long i,j,n,r; GEN res,d,p1,p2; /* yield r = dim ker(x) */ FpM_gauss_pivot(x,p,&d,&r); /* now r = dim Im(x) */ n = lg(x)-1; r = n - r; avma=av; res=cgetg(3,t_VEC); p1=cgetg(r+1,small? t_VECSMALL: t_VEC); res[1]=(long)p1; p2=cgetg(r+1,small? t_VECSMALL: t_VEC); res[2]=(long)p2; if (d) { for (i=0,j=1; j<=n; j++) if (d[j]) { i++; p1[i]=d[j]; p2[i]=j; } free(d); qsort(p1+1,r,sizeof(long),(QSCOMP)pari_compare_long); } if (!small) for (i=1;i<=r;i++) { p1[i]=lstoi(p1[i]); p2[i]=lstoi(p2[i]); } return res; } GEN indexrank(GEN x) { return indexrank0(x,NULL,0); } GEN sindexrank(GEN x) { return indexrank0(x,NULL,1); } GEN FpM_sindexrank(GEN x, GEN p) { return indexrank0(x,p,1); } /*******************************************************************/ /* */ /* LINEAR ALGEBRA MODULO P */ /* */ /*******************************************************************/ /*If p is NULL no reduction is performed.*/ GEN FpM_mul(GEN x, GEN y, GEN p) { long i,j,l,lx=lg(x), ly=lg(y); GEN z; if (ly==1) return cgetg(ly,t_MAT); if (lx != lg(y[1])) err(operi,"* [mod p]",x,y); z=cgetg(ly,t_MAT); if (lx==1) { for (i=1; i m) { if (deplin) { c = cgetg(n+1, t_VECSMALL); for (i=1; im) { if (deplin) { c = cgetg(n+1, t_COL); for (i=1; im) { r++; d[k]=0; } else { c[j]=k; d[k]=j; piv = negi(mpinvmod(gcoeff(x,j,k), p)); for (i=k+1; i<=n; i++) coeff(x,j,i) = lmodii(mulii(piv,gcoeff(x,j,i)), p); for (t=1; t<=m; t++) if (!c[t]) /* no pivot on that line yet */ { piv=gcoeff(x,t,k); if (signe(piv)) { coeff(x,t,k)=zero; for (i=k+1; i<=n; i++) coeff(x,t,i) = laddii(gcoeff(x,t,i), mulii(piv,gcoeff(x,j,i))); if (low_stack(lim, stack_lim(av,1))) gerepile_gauss(x,k,t,av,j,c); } } for (i=k; i<=n; i++) coeff(x,j,i) = zero; /* dummy */ } } *dd=d; *rr=r; } static void FqM_gauss_pivot(GEN x, GEN T, GEN p, GEN *dd, long *rr) { gpmem_t av,lim; GEN c,d,piv; long i,j,k,r,t,n,m; if (typ(x)!=t_MAT) err(typeer,"FqM_gauss_pivot"); n=lg(x)-1; if (!n) { *dd=NULL; *rr=0; return; } m=lg(x[1])-1; r=0; x=dummycopy(x); c=new_chunk(m+1); for (k=1; k<=m; k++) c[k]=0; d=(GEN)gpmalloc((n+1)*sizeof(long)); av=avma; lim=stack_lim(av,1); for (k=1; k<=n; k++) { for (j=1; j<=m; j++) if (!c[j]) { coeff(x,j,k) = (long)FpX_res(gcoeff(x,j,k), T,p); if (signe(coeff(x,j,k))) break; } if (j>m) { r++; d[k]=0; } else { c[j]=k; d[k]=j; piv = gneg(FpXQ_inv(gcoeff(x,j,k), T,p)); for (i=k+1; i<=n; i++) coeff(x,j,i) = (long)Fq_mul(piv,gcoeff(x,j,i), T, p); for (t=1; t<=m; t++) if (!c[t]) /* no pivot on that line yet */ { piv=gcoeff(x,t,k); if (signe(piv)) { coeff(x,t,k)=zero; for (i=k+1; i<=n; i++) coeff(x,t,i) = ladd(gcoeff(x,t,i), gmul(piv,gcoeff(x,j,i))); if (low_stack(lim, stack_lim(av,1))) gerepile_gauss(x,k,t,av,j,c); } } for (i=k; i<=n; i++) coeff(x,j,i) = zero; /* dummy */ } } *dd=d; *rr=r; } GEN FpM_image(GEN x, GEN p) { gpmem_t av = avma; GEN d,y; long j,k,r; FpM_gauss_pivot(x,p,&d,&r); /* r = dim ker(x) */ if (!r) { avma=av; if (d) free(d); return gcopy(x); } /* r = dim Im(x) */ r = lg(x)-1 - r; avma=av; y=cgetg(r+1,t_MAT); for (j=k=1; j<=r; k++) if (d[k]) y[j++] = lcopy((GEN)x[k]); free(d); return y; } static GEN sFpM_invimage(GEN mat, GEN y, GEN p) { gpmem_t av=avma; long i, nbcol = lg(mat); GEN col,p1 = cgetg(nbcol+1,t_MAT),res; if (nbcol==1) return NULL; if (lg(y) != lg(mat[1])) err(consister,"FpM_invimage"); p1[nbcol] = (long)y; for (i=1; i 1) err(warnmem,"gauss_pivot_ker. k=%ld, n=%ld",k,n); for (u=t+1; u<=m; u++) if (isonstack(coeff(x,u,k))) coeff(x,u,k) = (long) Fq_res(gcoeff(x,u,k),T,p); for (i=k+1; i<=n; i++) for (u=1; u<=m; u++) if (isonstack(coeff(x,u,i))) coeff(x,u,i) = (long) Fq_res(gcoeff(x,u,i),T,p); (void)gerepile(av,tetpil,NULL); dec = av-tetpil; for (u=t+1; u<=m; u++) { A=(gpmem_t)coeff(x,u,k); if (A=bot) coeff(x,u,k)+=dec; } for (i=k+1; i<=n; i++) for (u=1; u<=m; u++) { A=(gpmem_t)coeff(x,u,i); if (A=bot) coeff(x,u,i)+=dec; } } static GEN FqM_ker_i(GEN x, GEN T, GEN p, long deplin) { gpmem_t av0,av,lim,tetpil; GEN y,c,d,piv,mun; long i,j,k,r,t,n,m; if (!T) return FpM_ker_i(x,p,deplin); if (typ(x)!=t_MAT) err(typeer,"FpM_ker"); n=lg(x)-1; if (!n) return cgetg(1,t_MAT); m=lg(x[1])-1; r=0; av0 = avma; x=dummycopy(x); mun=negi(gun); c=new_chunk(m+1); for (k=1; k<=m; k++) c[k]=0; d=new_chunk(n+1); av=avma; lim=stack_lim(av,1); for (k=1; k<=n; k++) { for (j=1; j<=m; j++) if (!c[j]) { coeff(x,j,k) = (long) Fq_res(gcoeff(x,j,k), T, p); if (signe(coeff(x,j,k))) break; } if (j>m) { if (deplin) { c = cgetg(n+1, t_COL); for (i=1; i n) err(talker2, "missing eigenspace. Compute the matrix to higher accuracy, then restart eigen at the current precision",NULL,NULL); for (i=1; i ex) { ex=e; k=j; } } p1 = gcoeff(a,i,k); if (gcmp0(p1)) return gerepilecopy(av, p1); } else if (gcmp0(p)) { do k++; while(k<=nbco && gcmp0(gcoeff(a,i,k))); if (k>nbco) return gerepilecopy(av, p); } if (k != i) { swap(a[i],a[k]); s = -s; p = gcoeff(a,i,i); } x = gmul(x,p); for (k=i+1; k<=nbco; k++) { GEN m = gcoeff(a,i,k); if (!gcmp0(m)) { m = gneg_i(gdiv(m,p)); for (j=i+1; j<=nbco; j++) coeff(a,j,k) = ladd(gcoeff(a,j,k), gmul(m,gcoeff(a,j,i))); } } } if (s<0) x = gneg_i(x); av1=avma; return gerepile(av,av1,gmul(x,gcoeff(a,nbco,nbco))); } GEN det2(GEN a) { long nbco = lg(a)-1; if (typ(a)!=t_MAT) err(mattype1,"det2"); if (!nbco) return gun; if (nbco != lg(a[1])-1) err(mattype1,"det2"); return det_simple_gauss(a, use_maximal_pivot(a)); } static GEN mydiv(GEN x, GEN y) { long tx = typ(x), ty = typ(y); if (tx == ty && tx == t_POL && varn(x) == varn(y)) return gdeuc(x,y); return gdiv(x,y); } /* determinant in a ring A: all computations are done within A * (Gauss-Bareiss algorithm) */ GEN det(GEN a) { gpmem_t av, lim; long nbco = lg(a)-1,i,j,k,s; GEN p,pprec; if (typ(a)!=t_MAT) err(mattype1,"det"); if (!nbco) return gun; if (nbco != lg(a[1])-1) err(mattype1,"det"); if (use_maximal_pivot(a)) return det_simple_gauss(a,1); if (DEBUGLEVEL > 7) (void)timer2(); av = avma; lim = stack_lim(av,2); a = dummycopy(a); s = 1; for (pprec=gun,i=1; inbco) return gerepilecopy(av, p); swap(a[k], a[i]); s = -s; p = gcoeff(a,i,i); } ci = (GEN*)a[i]; for (k=i+1; k<=nbco; k++) { ck = (GEN*)a[k]; m = (GEN)ck[i]; if (gcmp0(m)) { if (gcmp1(p)) { if (diveuc) a[k] = (long)mydiv((GEN)a[k], pprec); } else for (j=i+1; j<=nbco; j++) { p1 = gmul(p,ck[j]); if (diveuc) p1 = mydiv(p1,pprec); ck[j] = p1; } } else { m = gneg_i(m); for (j=i+1; j<=nbco; j++) { p1 = gadd(gmul(p,ck[j]), gmul(m,ci[j])); if (diveuc) p1 = mydiv(p1,pprec); ck[j] = p1; } } if (low_stack(lim,stack_lim(av,2))) { GEN *gptr[2]; gptr[0]=&a; gptr[1]=&pprec; if(DEBUGMEM>1) err(warnmem,"det. col = %ld",i); gerepilemany(av,gptr,2); p = gcoeff(a,i,i); ci = (GEN*)a[i]; } } if (DEBUGLEVEL > 7) msgtimer("det, col %ld / %ld",i,nbco-1); } p = gcoeff(a,nbco,nbco); if (s < 0) p = gneg(p); else p = gcopy(p); return gerepileupto(av, p); } /* return a solution of congruence system sum M_{ i,j } X_j = Y_i mod D_i * If ptu1 != NULL, put in *ptu1 a Z-basis of the homogeneous system */ static GEN gaussmoduloall(GEN M, GEN D, GEN Y, GEN *ptu1) { gpmem_t av = avma, tetpil; long n,m,i,j,lM; GEN p1,delta,H,U,u1,u2,x; if (typ(M)!=t_MAT) err(typeer,"gaussmodulo"); lM = lg(M); m = lM-1; if (!m) { if ((typ(Y)!=t_INT && lg(Y)!=1) || (typ(D)!=t_INT && lg(D)!=1)) err(consister,"gaussmodulo"); return gzero; } n = lg(M[1])-1; switch(typ(D)) { case t_VEC: case t_COL: delta=diagonal(D); break; case t_INT: delta=gscalmat(D,n); break; default: err(typeer,"gaussmodulo"); return NULL; /* not reached */ } if (typ(Y) == t_INT) { p1 = cgetg(n+1,t_COL); for (i=1; i<=n; i++) p1[i]=(long)Y; Y = p1; } p1 = hnfall(concatsp(M,delta)); H = (GEN)p1[1]; U = (GEN)p1[2]; Y = gauss(H,Y); if (!gcmp1(denom(Y))) return gzero; u1 = cgetg(m+1,t_MAT); u2 = cgetg(n+1,t_MAT); for (j=1; j<=m; j++) { p1 = (GEN)U[j]; setlg(p1,lM); u1[j] = (long)p1; } U += m; for (j=1; j<=n; j++) { p1 = (GEN)U[j]; setlg(p1,lM); u2[j] = (long)p1; } x = gmul(u2,Y); tetpil=avma; x=lllreducemodmatrix(x,u1); if (!ptu1) x = gerepile(av,tetpil,x); else { GEN *gptr[2]; *ptu1=gcopy(u1); gptr[0]=ptu1; gptr[1]=&x; gerepilemanysp(av,tetpil,gptr,2); } return x; } GEN matsolvemod0(GEN M, GEN D, GEN Y, long flag) { gpmem_t av; GEN p1,y; if (!flag) return gaussmoduloall(M,D,Y,NULL); av=avma; y = cgetg(3,t_VEC); p1 = gaussmoduloall(M,D,Y, (GEN*)y+2); if (p1==gzero) { avma=av; return gzero; } y[1] = (long)p1; return y; } GEN gaussmodulo2(GEN M, GEN D, GEN Y) { return matsolvemod0(M,D,Y,1); } GEN gaussmodulo(GEN M, GEN D, GEN Y) { return matsolvemod0(M,D,Y,0); }