Annotation of OpenXM_contrib/pari-2.2/src/basemath/base5.c, Revision 1.2
1.2 ! noro 1: /* $Id: base5.c,v 1.30 2002/09/07 13:35:06 karim Exp $
1.1 noro 2:
3: Copyright (C) 2000 The PARI group.
4:
5: This file is part of the PARI/GP package.
6:
7: PARI/GP is free software; you can redistribute it and/or modify it under the
8: terms of the GNU General Public License as published by the Free Software
9: Foundation. It is distributed in the hope that it will be useful, but WITHOUT
10: ANY WARRANTY WHATSOEVER.
11:
12: Check the License for details. You should have received a copy of it, along
13: with the package; see the file 'COPYING'. If not, write to the Free Software
14: Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
15:
16: /*******************************************************************/
17: /* */
18: /* BASIC NF OPERATIONS */
19: /* (continued 2) */
20: /* */
21: /*******************************************************************/
22: #include "pari.h"
1.2 ! noro 23: extern GEN mul_content(GEN cx, GEN cy);
! 24: extern long polegal_spec(GEN x, GEN y);
! 25: extern GEN mulmat_pol(GEN A, GEN x);
1.1 noro 26:
27: GEN
28: matbasistoalg(GEN nf,GEN x)
29: {
1.2 ! noro 30: long i, j, li, lx = lg(x);
! 31: GEN p1, z = cgetg(lx,t_MAT);
1.1 noro 32:
1.2 ! noro 33: if (typ(x) != t_MAT) err(talker,"argument must be a matrix in matbasistoalg");
! 34: if (lx == 1) return z;
! 35: li = lg(x[1]);
1.1 noro 36: for (j=1; j<lx; j++)
37: {
1.2 ! noro 38: p1 = cgetg(li,t_COL); z[j] = (long)p1;
! 39: for (i=1; i<li; i++) p1[i] = (long)basistoalg(nf,gcoeff(x,i,j));
1.1 noro 40: }
41: return z;
42: }
43:
44: GEN
45: matalgtobasis(GEN nf,GEN x)
46: {
1.2 ! noro 47: long i, j, li, lx = lg(x);
! 48: GEN p1, c, z = cgetg(lx, t_MAT);
1.1 noro 49:
1.2 ! noro 50: if (typ(x) != t_MAT) err(talker,"argument must be a matrix in matalgtobasis");
! 51: if (lx == 1) return z;
! 52: li = lg(x[1]);
1.1 noro 53: for (j=1; j<lx; j++)
54: {
1.2 ! noro 55: p1 = cgetg(li,t_COL); z[j] = (long)p1;
! 56: for (i=1; i<li; i++)
! 57: {
! 58: c = gcoeff(x,i,j);
! 59: c = typ(c)==t_COL? gcopy(c): algtobasis(nf,c);
! 60: p1[i] = (long)c;
! 61: }
1.1 noro 62: }
63: return z;
64: }
65:
66: static GEN
67: rnfmakematrices(GEN rnf)
68: {
69: long i,j,k,n,r1,r2,ru,ruk,r1rel,r2rel;
70: GEN nf,pol,rac,base,base1,racnf,sig,vecmat,vecM,vecMC,vecT2,rack;
71: GEN M,p2,p3,MC,sigk,T2,T,p1,MD,TI,MDI;
72:
73: nf=(GEN)rnf[10]; racnf=(GEN)nf[6]; pol=(GEN)rnf[1];
74: n=degpol(pol);
75: base=(GEN)rnf[7]; base1=(GEN)base[1]; rac=(GEN)rnf[6]; sig=(GEN)rnf[2];
76: r1 = nf_get_r1(nf);
77: r2 = nf_get_r2(nf); ru = r1+r2;
78: vecmat=cgetg(8,t_VEC);
79: vecM=cgetg(ru+1,t_VEC); vecmat[1]=(long)vecM;
80: vecMC=cgetg(ru+1,t_VEC); vecmat[2]=(long)vecMC;
81: vecT2=cgetg(ru+1,t_VEC); vecmat[3]=(long)vecT2;
82: for (k=1; k<=ru; k++)
83: {
84: rack=(GEN)rac[k]; ruk=lg(rack)-1;
85: M=cgetg(n+1,t_MAT); vecM[k]=(long)M;
86: for (j=1; j<=n; j++)
87: {
88: p2=cgetg(ruk+1,t_COL); M[j]=(long)p2; p3=lift((GEN)base1[j]);
89: p3=gsubst(p3,varn(nf[1]),(GEN)racnf[k]);
90: for (i=1; i<=ruk; i++) p2[i]=lsubst(p3,varn(rnf[1]),(GEN)rack[i]);
91: }
92: MC=gconj(gtrans(M)); vecMC[k]=(long)MC;
93: if (k<=r1)
94: {
95: sigk=(GEN)sig[k]; r1rel=itos((GEN)sigk[1]); r2rel=itos((GEN)sigk[2]);
96: if (r1rel+r2rel != lg(MC)-1) err(talker,"bug in rnfmakematrices");
97: for (j=r1rel+1; j<=r1rel+r2rel; j++) MC[j]=lmul2n((GEN)MC[j],1);
98: }
99: T2=gmul(MC,M); vecT2[k]=(long)T2;
100: }
101: T=cgetg(n+1,t_MAT); vecmat[4]=(long)T;
102: for (j=1; j<=n; j++)
103: {
104: p1=cgetg(n+1,t_COL); T[j]=(long)p1;
105: for (i=1; i<=n; i++)
106: p1[i]=ltrace(gmodulcp(gmul((GEN)base1[i],(GEN)base1[j]),pol));
107: }
108: MD=cgetg(1,t_MAT); vecmat[5]=(long)MD; /* matrice de la differente */
109: TI=cgetg(1,t_MAT); vecmat[6]=(long)TI; /* matrice .... ? */
110: MDI=cgetg(1,t_MAT); vecmat[7]=(long)MDI; /* matrice .... ? */
111: return vecmat;
112: }
113:
114: GEN
115: rnfinitalg(GEN nf,GEN pol,long prec)
116: {
1.2 ! noro 117: gpmem_t av = avma;
! 118: long m,n,r1,r2,vnf,i,j,k,vpol,r1j,r2j,lfac,degabs;
1.1 noro 119: GEN RES,sig,rac,p1,p2,liftpol,delta,RAC,ro,p3,bas;
1.2 ! noro 120: GEN f,f2,fac,fac1,fac2,id,p4;
1.1 noro 121:
122: if (typ(pol)!=t_POL) err(notpoler,"rnfinitalg");
123: nf=checknf(nf); n=degpol(pol); vpol=varn(pol);
1.2 ! noro 124: pol = fix_relative_pol(nf,pol,0);
! 125: vnf = varn(nf[1]);
1.1 noro 126:
1.2 ! noro 127: if (vpol >= vnf)
1.1 noro 128: err(talker,"main variable must be of higher priority in rnfinitalg");
129: RES=cgetg(12,t_VEC);
130: RES[1]=(long)pol;
1.2 ! noro 131: m = degpol(nf[1]); degabs=n*m;
1.1 noro 132: r1 = nf_get_r1(nf); r2 = (m-r1) >> 1;
133: sig=cgetg(r1+r2+1,t_VEC); RES[2]=(long)sig;
134: rac=(GEN)nf[6]; liftpol=lift(pol);
135: RAC=cgetg(r1+r2+1,t_VEC); RES[6]=(long)RAC;
136: for (j=1; j<=r1; j++)
137: {
138: p1=gsubst(liftpol,vnf,(GEN)rac[j]);
139: ro=roots(p1,prec);
140: r1j=0;
141: while (r1j<n && gcmp0(gimag((GEN)ro[r1j+1]))) r1j++;
142: p2=cgetg(3,t_VEC); p2[1]=lstoi(r1j); p2[2]=lstoi(r2j=((n-r1j)>>1));
143: sig[j]=(long)p2;
144: p3=cgetg(r1j+r2j+1,t_VEC);
145: for (i=1; i<=r1j; i++) p3[i]=lreal((GEN)ro[i]);
146: for (; i<=r1j+r2j; i++) p3[i]=(long)ro[(i<<1)-r1j];
147: RAC[j]=(long)p3;
148: }
149: for (; j<=r1+r2; j++)
150: {
151: p2=cgetg(3,t_VEC); p2[1]=zero; p2[2]=lstoi(n); sig[j]=(long)p2;
152: p1=gsubst(liftpol,vnf,(GEN)rac[j]);
153: RAC[j]=(long)roots(p1,prec);
154: }
155: p1 = rnfpseudobasis(nf,pol);
156:
157: delta = cgetg(3,t_VEC);
158: delta[1]=p1[3];
159: delta[2]=p1[4];
160: RES[3]=(long)delta;
161: p2 = matbasistoalg(nf,(GEN)p1[1]);
162: bas = cgetg(3,t_VEC);
163: bas[1]=(long)mat_to_vecpol(p2,vpol);
164: bas[2]=(long)p1[2];
165: RES[7]=(long)bas;
166: RES[8]=linvmat(p2);
167:
1.2 ! noro 168: f2 = idealdiv(nf, discsr(pol), (GEN)p1[3]);
! 169: fac = idealfactor(nf,f2);
! 170: fac1 = (GEN)fac[1];
! 171: fac2 = (GEN)fac[2]; lfac = lg(fac1)-1;
! 172: f = idmat(m);
1.1 noro 173: for (i=1; i<=lfac; i++)
174: {
175: if (mpodd((GEN)fac2[i])) err(bugparier,"rnfinitalg (odd exponent)");
176: f=idealmul(nf,f,idealpow(nf,(GEN)fac1[i],gmul2n((GEN)fac2[i],-1)));
177: }
178: RES[4]=(long)f;
179: RES[10]=(long)nf;
180: RES[5]=(long)rnfmakematrices(RES);
181: if (DEBUGLEVEL>1) msgtimer("matrices");
182: RES[9]=lgetg(1,t_VEC); /* table de multiplication */
183: p2=cgetg(6,t_VEC); RES[11]=(long)p2;
184: p1=rnfequation2(nf,pol); for (i=1; i<=3; i++) p2[i]=p1[i];
185: p4=cgetg(degabs+1,t_MAT);
186: for (i=1; i<=n; i++)
187: { /* removing denominators speeds up multiplication */
1.2 ! noro 188: GEN c, cop3,com, om = rnfelementreltoabs(RES,gmael(bas,1,i));
1.1 noro 189:
190: if (DEBUGLEVEL>1) msgtimer("i = %ld",i);
1.2 ! noro 191: om = primitive_part(om, &com);
1.1 noro 192: id=gmael(bas,2,i);
193: for (j=1; j<=m; j++)
194: {
1.2 ! noro 195: p1 = gmul((GEN)nf[7],(GEN)id[j]);
! 196: p3 = gsubst(p1, vnf, (GEN)p2[2]);
! 197: p3 = primitive_part(p3, &cop3);
! 198: c = mul_content(cop3, com);
! 199:
! 200: p3 = lift_intern(gmul(om,p3));
! 201: if (c) p3 = gmul(c,p3);
! 202: p4[(i-1)*m+j] = (long)pol_to_vec(p3, degabs);
1.1 noro 203: }
204: }
205: if (DEBUGLEVEL>1) msgtimer("p4");
1.2 ! noro 206: p4 = Q_remove_denom(p4, &p3);
! 207: if (p3) p4 = hnfmodid(p4, p3); else p4 = idmat(degabs);
1.1 noro 208: if (DEBUGLEVEL>1) msgtimer("hnfmod");
209: for (j=degabs-1; j>0; j--)
210: if (cmpis(gcoeff(p4,j,j),2) > 0)
211: {
212: p1=shifti(gcoeff(p4,j,j),-1);
213: for (k=j+1; k<=degabs; k++)
214: if (cmpii(gcoeff(p4,j,k),p1) > 0)
215: for (i=1; i<=j; i++)
216: coeff(p4,i,k)=lsubii(gcoeff(p4,i,k),gcoeff(p4,i,j));
217: }
1.2 ! noro 218: if (p3) p4 = gdiv(p4,p3);
1.1 noro 219: p2[4]=(long)mat_to_vecpol(p4,vpol);
220: p2[5]=linvmat(p4);
221: return gerepilecopy(av,RES);
222: }
223:
224: GEN
225: rnfbasistoalg(GEN rnf,GEN x)
226: {
1.2 ! noro 227: long tx=typ(x), lx=lg(x), i, n;
! 228: gpmem_t av=avma, tetpil;
1.1 noro 229: GEN p1,z,nf;
230:
231: checkrnf(rnf); nf=(GEN)rnf[10];
232: switch(tx)
233: {
234: case t_VEC:
235: x=gtrans(x); /* fall through */
236: case t_COL:
237: n=lg(x)-1; p1=cgetg(n+1,t_COL);
238: for (i=1; i<=n; i++)
239: {
240: if (typ(x[i])==t_COL) p1[i]=(long)basistoalg(nf,(GEN)x[i]);
241: else p1[i]=x[i];
242: }
243: p1=gmul(gmael(rnf,7,1),p1); tetpil=avma;
244: return gerepile(av,tetpil,gmodulcp(p1,(GEN)rnf[1]));
245:
246: case t_MAT:
247: z=cgetg(lx,tx);
248: for (i=1; i<lx; i++) z[i]=(long)rnfbasistoalg(rnf,(GEN)x[i]);
249: return z;
250:
251: case t_POLMOD:
252: return gcopy(x);
253:
254: default:
255: z=cgetg(3,t_POLMOD); z[1]=lcopy((GEN)rnf[1]);
256: z[2]=lmul(x,polun[varn(rnf[1])]); return z;
257: }
258: }
259:
260: /* assume x is a t_POLMOD */
261: GEN
262: lift_to_pol(GEN x)
263: {
264: GEN y = (GEN)x[2];
265: return (typ(y) != t_POL)? gtopoly(y,varn(x[1])): y;
266: }
267:
268: GEN
269: rnfalgtobasis(GEN rnf,GEN x)
270: {
1.2 ! noro 271: long tx=typ(x), i, lx;
! 272: gpmem_t av=avma;
1.1 noro 273: GEN z;
274:
275: checkrnf(rnf);
276: switch(tx)
277: {
278: case t_VEC: case t_COL: case t_MAT:
279: lx = lg(x); z = cgetg(lx,tx);
280: for (i=1; i<lx; i++) z[i]=(long)rnfalgtobasis(rnf,(GEN)x[i]);
281: return z;
282:
283: case t_POLMOD:
284: if (!polegal_spec((GEN)rnf[1],(GEN)x[1]))
285: err(talker,"not the same number field in rnfalgtobasis");
286: x = lift_to_pol(x); /* fall through */
287: case t_POL:
1.2 ! noro 288: { /* cf algtobasis_i */
1.1 noro 289: GEN P = (GEN)rnf[1];
290: long N = degpol(P);
291: if (degpol(x) >= N) x = gres(x,P);
292: return gerepileupto(av, mulmat_pol((GEN)rnf[8], x));
293: }
294: }
295: return gscalcol(x, degpol(rnf[1]));
296: }
297:
1.2 ! noro 298: GEN
! 299: _checkrnfeq(GEN x)
! 300: {
! 301: if (typ(x) == t_VEC)
! 302: switch(lg(x))
! 303: {
! 304: case 12: /* checkrnf(x); */ return (GEN)x[11];
! 305: case 6: /* rnf[11]. FIXME: change the rnf struct */
! 306: case 4: return x;
! 307: }
! 308: return NULL;
! 309: }
! 310:
! 311: GEN
! 312: checkrnfeq(GEN x)
! 313: {
! 314: x = _checkrnfeq(x);
! 315: if (!x) err(talker,"please apply rnfequation(,,1)");
! 316: return x;
! 317: }
! 318:
! 319: GEN
! 320: eltreltoabs(GEN rnfeq, GEN x)
! 321: {
! 322: long i, k, va;
! 323: gpmem_t av = avma;
! 324: GEN polabs, teta, alpha, s;
! 325:
! 326: rnfeq = checkrnfeq(rnfeq);
! 327: polabs= (GEN)rnfeq[1];
! 328: alpha = (GEN)rnfeq[2];
! 329: k = itos((GEN)rnfeq[3]);
! 330:
! 331: va = varn(polabs);
! 332: if (gvar(x) > va) x = scalarpol(x,va);
! 333: /* Mod(X + k alpha, polabs(X)), alpha root of the polynomial defining base */
! 334: teta = gmodulcp(gsub(polx[va], gmulsg(k,lift_intern(alpha))), polabs);
! 335: s = gzero;
! 336: for (i=lgef(x)-1; i>1; i--)
! 337: {
! 338: GEN c = (GEN)x[i];
! 339: long tc = typ(c);
! 340: switch(tc)
! 341: {
! 342: case t_POLMOD: c = (GEN)c[2]; /* fall through */
! 343: case t_POL: c = poleval(c, alpha); break;
! 344: default:
! 345: if (!is_const_t(tc)) err(talker, "incorrect data in eltreltoabs");
! 346: }
! 347: s = gadd(c, gmul(teta,s));
! 348: }
! 349: return gerepileupto(av,s);
! 350: }
! 351:
1.1 noro 352: /* x doit etre un polymod ou un polynome ou un vecteur de tels objets... */
353: GEN
354: rnfelementreltoabs(GEN rnf,GEN x)
355: {
1.2 ! noro 356: long i, lx, tx = typ(x);
! 357: GEN z;
1.1 noro 358:
359: switch(tx)
360: {
361: case t_VEC: case t_COL: case t_MAT:
1.2 ! noro 362: lx = lg(x); z = cgetg(lx,tx);
! 363: for (i=1; i<lx; i++) z[i] = (long)rnfelementreltoabs(rnf, (GEN)x[i]);
1.1 noro 364: return z;
365:
1.2 ! noro 366: case t_POLMOD: x = lift_to_pol(x); /* fall through */
! 367: case t_POL: return eltreltoabs(rnf, x);
1.1 noro 368: default: return gcopy(x);
369: }
370: }
371:
1.2 ! noro 372: /* assume x,T,pol t_POL. T defines base field, pol defines rnf over T.
! 373: * x an absolute element of the extension */
! 374: GEN
! 375: get_theta_abstorel(GEN T, GEN pol, GEN k)
! 376: {
! 377: return gmodulcp(gadd(polx[varn(pol)],
! 378: gmul(k, gmodulcp(polx[varn(T)],T))), pol);
! 379: }
! 380: GEN
! 381: eltabstorel(GEN x, GEN T, GEN pol, GEN k)
! 382: {
! 383: return poleval(x, get_theta_abstorel(T,pol,k));
! 384: }
! 385:
1.1 noro 386: GEN
387: rnfelementabstorel(GEN rnf,GEN x)
388: {
1.2 ! noro 389: long tx, i, lx;
! 390: gpmem_t av=avma;
! 391: GEN z,k,nf,T;
1.1 noro 392:
393: checkrnf(rnf); tx=typ(x); lx=lg(x);
394: switch(tx)
395: {
396: case t_VEC: case t_COL: case t_MAT:
397: z=cgetg(lx,tx);
398: for (i=1; i<lx; i++) z[i]=(long)rnfelementabstorel(rnf,(GEN)x[i]);
399: return z;
400:
401: case t_POLMOD:
1.2 ! noro 402: x = lift_to_pol(x); /* fall through */
1.1 noro 403: case t_POL:
1.2 ! noro 404: k = (GEN)rnf[11]; k = (GEN)k[3];
! 405: nf = (GEN)rnf[10]; T = (GEN)nf[1];
! 406: return gerepileupto(av, eltabstorel(x,T,(GEN)rnf[1],k));
1.1 noro 407:
408: default: return gcopy(x);
409: }
410: }
411:
412: /* x doit etre un polymod ou un polynome ou un vecteur de tels objets... */
413: GEN
414: rnfelementup(GEN rnf,GEN x)
415: {
416: long i,lx,tx;
417: GEN z;
418:
419: checkrnf(rnf); tx=typ(x); lx=lg(x);
420: switch(tx)
421: {
422: case t_VEC: case t_COL: case t_MAT:
423: z=cgetg(lx,tx);
424: for (i=1; i<lx; i++) z[i]=(long)rnfelementup(rnf,(GEN)x[i]);
425: return z;
426:
427: case t_POLMOD:
428: x=(GEN)x[2]; /* fall through */
429: case t_POL:
430: return poleval(x,gmael(rnf,11,2));
431:
432: default: return gcopy(x);
433: }
434: }
435:
436: /* x doit etre un polymod ou un polynome ou un vecteur de tels objets..*/
437: GEN
438: rnfelementdown(GEN rnf,GEN x)
439: {
1.2 ! noro 440: gpmem_t av = avma;
1.1 noro 441: long i,lx,tx;
442: GEN p1,z;
443:
444: checkrnf(rnf); tx=typ(x); lx=lg(x);
445: switch(tx)
446: {
447: case t_VEC: case t_COL: case t_MAT:
448: z=cgetg(lx,tx);
449: for (i=1; i<lx; i++) z[i]=(long)rnfelementdown(rnf,(GEN)x[i]);
450: return z;
451:
452: case t_POLMOD:
453: x=(GEN)x[2]; /* fall through */
454: case t_POL:
455: if (gcmp0(x)) return gzero;
456:
457: p1=rnfelementabstorel(rnf,x);
458: if (typ(p1)==t_POLMOD && varn(p1[1])==varn(rnf[1])) p1=(GEN)p1[2];
459: if (gvar(p1)>varn(rnf[1])) return gerepilecopy(av,p1);
460: if (lgef(p1)==3) return gerepilecopy(av,(GEN)p1[2]);
461: err(talker,"element is not in the base field in rnfelementdown");
462:
463: default: return gcopy(x);
464: }
465: }
466:
467: /* x est exprime sur la base relative */
468: static GEN
469: rnfprincipaltohermite(GEN rnf,GEN x)
470: {
1.2 ! noro 471: gpmem_t av = avma;
1.1 noro 472: GEN nf,bas,bas1,p1,z;
473:
1.2 ! noro 474: x = rnfbasistoalg(rnf,x); nf = (GEN)rnf[10];
! 475: bas = (GEN)rnf[7]; bas1 = (GEN)bas[1];
! 476: p1 = rnfalgtobasis(rnf, gmul(x,gmodulcp(bas1,(GEN)rnf[1])));
! 477: settyp(p1,t_MAT);
! 478:
! 479: z = cgetg(3,t_VEC);
! 480: z[1] = (long)p1;
! 481: z[2] = bas[2];
! 482: return gerepileupto(av, nfhermite(nf,z));
! 483: }
1.1 noro 484:
1.2 ! noro 485: static GEN
! 486: rnfid(long n, long m)
! 487: {
! 488: return idmat_intern(n, gscalcol_i(gun,m), zerocol(m));
1.1 noro 489: }
490:
491: GEN
492: rnfidealhermite(GEN rnf,GEN x)
493: {
1.2 ! noro 494: long tx=typ(x), lx=lg(x), i, j, n, m;
! 495: gpmem_t av=avma, tetpil;
! 496: GEN z,p1,p2,x1,x2,x1j,nf,bas;
1.1 noro 497:
498: checkrnf(rnf);
1.2 ! noro 499: n = degpol(rnf[1]); nf = (GEN)rnf[10]; bas = (GEN)rnf[7];
1.1 noro 500:
501: switch(tx)
502: {
1.2 ! noro 503: case t_INT: case t_FRAC: case t_FRACN:
! 504: m = degpol(nf[1]);
! 505: z = cgetg(3,t_VEC);
! 506: z[1] = (long)rnfid(n, m);
! 507: z[2] = lmul(x, (GEN)bas[2]); return z;
1.1 noro 508:
509: case t_POLMOD: case t_POL:
1.2 ! noro 510: p1 = rnfalgtobasis(rnf,x);
! 511: return gerepileupto(av, rnfprincipaltohermite(rnf,p1));
1.1 noro 512:
513: case t_VEC:
514: switch(lx)
515: {
516: case 3:
517: x1=(GEN)x[1];
518: if (typ(x1)!=t_MAT || lg(x1) < n+1 || lg(x1[1]) != n+1)
519: err(talker,"incorrect type in rnfidealhermite");
520: p1=cgetg(n+1,t_MAT);
521: for (j=1; j<=n; j++)
522: {
523: p2=cgetg(n+1,t_COL); p1[j]=(long)p2; x1j=(GEN)x1[j];
524: for (i=1; i<=n; i++)
525: {
526: tx = typ(x1j[i]);
527: if (is_const_t(tx)) p2[i] = x1j[i];
528: else
529: switch(tx)
530: {
531: case t_POLMOD: case t_POL:
532: p2[i]=(long)algtobasis(nf,(GEN)x1j[i]); break;
533: case t_COL:
534: p2[i]=x1j[i]; break;
535: default: err(talker,"incorrect type in rnfidealhermite");
536: }
537: }
538: }
539: x2=(GEN)x[2];
540: if (typ(x2)!=t_VEC || lg(x2)!=lg(x1))
541: err(talker,"incorrect type in rnfidealhermite");
542: tetpil=avma; z=cgetg(3,t_VEC); z[1]=lcopy(p1); z[2]=lcopy(x2);
543: z=gerepile(av,tetpil,nfhermite(nf,z));
544: if (lg(z[1]) != n+1)
545: err(talker,"not an ideal in rnfidealhermite");
546: return z;
547:
548: case 6:
549: err(impl,"rnfidealhermite for prime ideals");
550: default:
551: err(typeer,"rnfidealhermite");
552: }
553:
554: case t_COL:
555: if (lx!=(n+1)) err(typeer,"rnfidealhermite");
556: return rnfprincipaltohermite(rnf,x);
557:
558: case t_MAT:
559: return rnfidealabstorel(rnf,x);
560: }
561: err(typeer,"rnfidealhermite");
562: return NULL; /* not reached */
563: }
564:
1.2 ! noro 565: static GEN
! 566: prodid(GEN nf, GEN I)
! 567: {
! 568: long i, l = lg(I);
! 569: GEN z;
! 570:
! 571: if (l == 1) return idmat(degpol(nf[1]));
! 572: z = (GEN)I[1];
! 573: for (i=2; i<l; i++) z = idealmul(nf, z, (GEN)I[i]);
! 574: return z;
! 575: }
! 576:
! 577: static GEN
! 578: prodidnorm(GEN I)
! 579: {
! 580: long i, l = lg(I);
! 581: GEN z;
! 582:
! 583: if (l == 1) return gun;
! 584: z = dethnf((GEN)I[1]);
! 585: for (i=2; i<l; i++) z = gmul(z, dethnf((GEN)I[i]));
! 586: return z;
! 587: }
! 588:
1.1 noro 589: GEN
590: rnfidealnormrel(GEN rnf,GEN id)
591: {
1.2 ! noro 592: gpmem_t av = avma;
! 593: GEN z, t, nf;
! 594: long n;
! 595:
! 596: checkrnf(rnf); nf = (GEN)rnf[10];
! 597: n = degpol(rnf[1]);
! 598: if (n == 1) { avma = av; return idmat(degpol(nf[1])); }
! 599:
! 600: id = rnfidealhermite(rnf,id);
! 601: t = prodid(nf, gmael(rnf,7,2));
! 602: z = prodid(nf, (GEN)id[2]);
! 603: return gerepileupto(av, idealdiv(nf,z,t));
1.1 noro 604: }
605:
606: GEN
607: rnfidealnormabs(GEN rnf,GEN id)
608: {
1.2 ! noro 609: gpmem_t av = avma;
! 610: GEN z, t;
! 611: long n;
1.1 noro 612:
613: checkrnf(rnf);
1.2 ! noro 614: n = degpol(rnf[1]);
! 615: if (n == 1) return gun;
! 616:
! 617: id = rnfidealhermite(rnf,id);
! 618: z = prodidnorm((GEN)id[2]);
! 619: t = prodidnorm(gmael(rnf,7,2));
! 620: return gerepileupto(av, gdiv(z, t));
1.1 noro 621: }
622:
623: GEN
624: rnfidealreltoabs(GEN rnf,GEN x)
625: {
1.2 ! noro 626: long i, j, n, m;
! 627: gpmem_t av = avma;
! 628: GEN nf,basinv,om,id,t,M,p1,p2,c;
1.1 noro 629:
1.2 ! noro 630: nf = (GEN)rnf[10];
1.1 noro 631: x = rnfidealhermite(rnf,x);
1.2 ! noro 632: n = degpol(rnf[1]);
! 633: m = degpol(nf[1]);
1.1 noro 634: basinv = gmael(rnf,11,5);
1.2 ! noro 635: t = gmael(rnf,11,2);
! 636: M = cgetg(n*m+1,t_MAT);
1.1 noro 637: for (i=1; i<=n; i++)
638: {
1.2 ! noro 639: om = rnfbasistoalg(rnf,gmael(x,1,i));
! 640: om = rnfelementreltoabs(rnf,om);
! 641: id = gmael(x,2,i);
1.1 noro 642: for (j=1; j<=m; j++)
643: {
1.2 ! noro 644: p1 = gmul((GEN)nf[7],(GEN)id[j]);
! 645: p2 = lift_intern(gmul(om, poleval(p1, t)));
! 646: M[(i-1)*m+j] = (long)pol_to_vec(p2, n*m);
1.1 noro 647: }
648: }
1.2 ! noro 649: p1 = primitive_part(gmul(basinv,M), &c);
! 650: p1 = hnfmodid(p1, gmael(p1,1,1)); /* mod x \cap Z */
1.1 noro 651: if (c) p1 = gmul(p1, c);
652: return gerepileupto(av, p1);
653: }
654:
655: GEN
656: rnfidealabstorel(GEN rnf,GEN x)
657: {
1.2 ! noro 658: long n, m, j;
! 659: gpmem_t av = avma;
! 660: GEN nf,basabs,M,xj,p1,p2,id;
! 661:
! 662: checkrnf(rnf); nf = (GEN)rnf[10];
! 663: n = degpol(rnf[1]);
! 664: m = degpol(nf[1]);
! 665: if (typ(x) != t_MAT || lg(x) != n*m+1 || lg(x[1]) != n*m+1)
1.1 noro 666: err(impl,"rnfidealabstorel for an ideal not in HNF");
1.2 ! noro 667: basabs = gmael(rnf,11,4);
! 668: M = cgetg(n*m+1,t_MAT);
1.1 noro 669: for (j=1; j<=n*m; j++)
670: {
1.2 ! noro 671: xj = gmul(basabs,(GEN)x[j]);
! 672: xj = lift_intern(rnfelementabstorel(rnf,xj));
! 673: M[j] = (long)pol_to_vec(xj, n);
! 674: }
! 675: M = gmul((GEN)rnf[8], M);
! 676: p1 = cgetg(n*m+1,t_VEC); id = idmat(m);
! 677: for (j=1; j<=n*m; j++) p1[j] = (long)id;
! 678: p2 = cgetg(3,t_VEC);
! 679: p2[1] = (long)M;
! 680: p2[2] = (long)p1;
! 681: return gerepileupto(av, nfhermite(nf,p2));
1.1 noro 682: }
683:
684: GEN
685: rnfidealdown(GEN rnf,GEN x)
686: {
1.2 ! noro 687: gpmem_t av = avma;
! 688: x = rnfidealhermite(rnf,x);
1.1 noro 689: return gerepilecopy(av,gmael(x,2,1));
690: }
691:
692: /* lift ideal x to the relative extension, returns a Z-basis */
693: GEN
694: rnfidealup(GEN rnf,GEN x)
695: {
1.2 ! noro 696: gpmem_t av = avma;
! 697: long i, n, m;
! 698: GEN nf,bas,bas2,p1,p2;
! 699:
! 700: checkrnf(rnf); nf = (GEN)rnf[10];
! 701: n = degpol(rnf[1]);
! 702: m = degpol((GEN)nf[1]);
! 703: bas = (GEN)rnf[7]; bas2 = (GEN)bas[2];
! 704:
! 705: p2 = cgetg(3,t_VEC); p1 = cgetg(n+1,t_VEC);
! 706: p2[1] = (long)rnfid(n, m);
! 707: p2[2] = (long)p1;
1.1 noro 708: for (i=1; i<=n; i++) p1[i]=(long)idealmul(nf,x,(GEN)bas2[i]);
1.2 ! noro 709: return gerepileupto(av, rnfidealreltoabs(rnf,p2));
1.1 noro 710: }
711:
712: /* x a relative HNF ---> vector of 2 generators (relative polymods) */
713: GEN
714: rnfidealtwoelement(GEN rnf,GEN x)
715: {
1.2 ! noro 716: gpmem_t av = avma;
! 717: long j;
1.1 noro 718: GEN p1,p2,p3,res,polabs,nfabs,z;
719:
720: checkrnf(rnf);
721: res=(GEN)rnf[11]; polabs=(GEN)res[1];
1.2 ! noro 722: nfabs = cgetg(10,t_VEC);
! 723: nfabs[1] = (long)polabs;
! 724: for (j=2; j<=9; j++) nfabs[j] = zero;
! 725: nfabs[7] = (long)lift((GEN)res[4]);
! 726: nfabs[8] = res[5];
! 727: p1 = rnfidealreltoabs(rnf,x);
! 728: p2 = ideal_two_elt(nfabs,p1);
! 729: p3 = rnfelementabstorel(rnf,gmul((GEN)res[4],(GEN)p2[2]));
! 730: z = cgetg(3,t_VEC);
! 731: z[1] = lcopy((GEN)p2[1]);
! 732: z[2] = (long)rnfalgtobasis(rnf,p3);
! 733: return gerepileupto(av, z);
1.1 noro 734: }
735:
736: GEN
737: rnfidealmul(GEN rnf,GEN x,GEN y) /* x et y sous HNF relative uniquement */
738: {
1.2 ! noro 739: long i, j, n;
! 740: gpmem_t av = avma;
! 741: GEN z,nf,x1,x2,p1,p2,p3,p4,res;
1.1 noro 742:
1.2 ! noro 743: z = rnfidealtwoelement(rnf,y);
! 744: nf = (GEN)rnf[10]; n = degpol(rnf[1]);
! 745: x = rnfidealhermite(rnf,x);
! 746: x1 = gmodulcp(gmul(gmael(rnf,7,1), matbasistoalg(nf,(GEN)x[1])),(GEN) rnf[1]);
! 747: x2 = (GEN)x[2];
! 748: p1 = gmul((GEN)z[1],(GEN)x[1]);
! 749: p2 = lift_intern(gmul(rnfbasistoalg(rnf,(GEN)z[2]),x1));
! 750: p3 = cgetg(n+1,t_MAT);
1.1 noro 751: for (j=1; j<=n; j++)
752: {
1.2 ! noro 753: p4 = pol_to_vec((GEN)p2[j], n); p3[j] = (long)p4;
! 754: for (i=1; i<=n; i++) p4[i] = (long)algtobasis(nf,(GEN)p4[i]);
1.1 noro 755: }
1.2 ! noro 756: res = cgetg(3,t_VEC);
! 757: res[1] = (long)concatsp(p1,p3);
! 758: res[2] = (long)concatsp(x2,x2);
! 759: return gerepileupto(av, nfhermite(nf,res));
1.1 noro 760: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to base5.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib / pari-2.2 / src / basemath