Annotation of OpenXM_contrib/pari-2.2/src/basemath/base5.c, Revision 1.1.1.1
1.1 noro 1: /* $Id: base5.c,v 1.17 2001/10/01 12:11:29 karim Exp $
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"
23: GEN mat_to_vecpol(GEN x, long v);
24:
25: GEN
26: matbasistoalg(GEN nf,GEN x)
27: {
28: long i,j,lx,li;
29: GEN p1,z;
30:
31: if (typ(x)!=t_MAT)
32: err(talker,"argument must be a matrix in matbasistoalg");
33: lx=lg(x); z=cgetg(lx,t_MAT); if (lx==1) return z;
34:
35: li=lg(x[1]);
36: for (j=1; j<lx; j++)
37: {
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));
40: }
41: return z;
42: }
43:
44: GEN
45: matalgtobasis(GEN nf,GEN x)
46: {
47: long i,j,lx,li;
48: GEN p1,z;
49:
50: if (typ(x)!=t_MAT)
51: err(talker,"argument must be a matrix in matalgtobasis");
52: lx=lg(x); z=cgetg(lx,t_MAT); if (lx==1) return z;
53:
54: li=lg(x[1]);
55: for (j=1; j<lx; j++)
56: {
57: p1=cgetg(li,t_COL); z[j]=(long)p1;
58: for (i=1; i<li; i++) p1[i]=(long)algtobasis(nf,gcoeff(x,i,j));
59: }
60: return z;
61: }
62:
63: static GEN
64: rnfmakematrices(GEN rnf)
65: {
66: long i,j,k,n,r1,r2,ru,ruk,r1rel,r2rel;
67: GEN nf,pol,rac,base,base1,racnf,sig,vecmat,vecM,vecMC,vecT2,rack;
68: GEN M,p2,p3,MC,sigk,T2,T,p1,MD,TI,MDI;
69:
70: nf=(GEN)rnf[10]; racnf=(GEN)nf[6]; pol=(GEN)rnf[1];
71: n=degpol(pol);
72: base=(GEN)rnf[7]; base1=(GEN)base[1]; rac=(GEN)rnf[6]; sig=(GEN)rnf[2];
73: r1 = nf_get_r1(nf);
74: r2 = nf_get_r2(nf); ru = r1+r2;
75: vecmat=cgetg(8,t_VEC);
76: vecM=cgetg(ru+1,t_VEC); vecmat[1]=(long)vecM;
77: vecMC=cgetg(ru+1,t_VEC); vecmat[2]=(long)vecMC;
78: vecT2=cgetg(ru+1,t_VEC); vecmat[3]=(long)vecT2;
79: for (k=1; k<=ru; k++)
80: {
81: rack=(GEN)rac[k]; ruk=lg(rack)-1;
82: M=cgetg(n+1,t_MAT); vecM[k]=(long)M;
83: for (j=1; j<=n; j++)
84: {
85: p2=cgetg(ruk+1,t_COL); M[j]=(long)p2; p3=lift((GEN)base1[j]);
86: p3=gsubst(p3,varn(nf[1]),(GEN)racnf[k]);
87: for (i=1; i<=ruk; i++) p2[i]=lsubst(p3,varn(rnf[1]),(GEN)rack[i]);
88: }
89: MC=gconj(gtrans(M)); vecMC[k]=(long)MC;
90: if (k<=r1)
91: {
92: sigk=(GEN)sig[k]; r1rel=itos((GEN)sigk[1]); r2rel=itos((GEN)sigk[2]);
93: if (r1rel+r2rel != lg(MC)-1) err(talker,"bug in rnfmakematrices");
94: for (j=r1rel+1; j<=r1rel+r2rel; j++) MC[j]=lmul2n((GEN)MC[j],1);
95: }
96: T2=gmul(MC,M); vecT2[k]=(long)T2;
97: }
98: T=cgetg(n+1,t_MAT); vecmat[4]=(long)T;
99: for (j=1; j<=n; j++)
100: {
101: p1=cgetg(n+1,t_COL); T[j]=(long)p1;
102: for (i=1; i<=n; i++)
103: p1[i]=ltrace(gmodulcp(gmul((GEN)base1[i],(GEN)base1[j]),pol));
104: }
105: MD=cgetg(1,t_MAT); vecmat[5]=(long)MD; /* matrice de la differente */
106: TI=cgetg(1,t_MAT); vecmat[6]=(long)TI; /* matrice .... ? */
107: MDI=cgetg(1,t_MAT); vecmat[7]=(long)MDI; /* matrice .... ? */
108: return vecmat;
109: }
110:
111: GEN
112: rnfinitalg(GEN nf,GEN pol,long prec)
113: {
114: ulong av = avma;
115: long m,n,r1,r2,vnf,i,j,k,vpol,v1,r1j,r2j,lfac,degabs;
116: GEN RES,sig,rac,p1,p2,liftpol,delta,RAC,ro,p3,bas;
117: GEN f,f2,fac,fac1,fac2,id,p4,p5;
118:
119: if (typ(pol)!=t_POL) err(notpoler,"rnfinitalg");
120: nf=checknf(nf); n=degpol(pol); vpol=varn(pol);
121: vnf=0;
122: for (i=0; i<=n; i++)
123: {
124: long tp1;
125:
126: p1=(GEN)pol[i+2];
127: tp1=typ(p1);
128: if (! is_const_t(tp1))
129: {
130: if (tp1!=t_POLMOD) err(typeer,"rnfinitalg");
131: p1 = checknfelt_mod(nf, p1, "rnfinitalg");
132: if (! is_const_t(typ(p1)))
133: {
134: v1=varn(p1);
135: if (vnf && vnf!=v1) err(talker,"different variables in rnfinitalg");
136: if (!vnf) vnf=v1;
137: }
138: }
139: }
140: if (!vnf) vnf=varn(nf[1]);
141: if (vpol>=vnf)
142: err(talker,"main variable must be of higher priority in rnfinitalg");
143: RES=cgetg(12,t_VEC);
144: RES[1]=(long)pol;
145: m=degpol(nf[1]); degabs=n*m;
146: r1 = nf_get_r1(nf); r2 = (m-r1) >> 1;
147: sig=cgetg(r1+r2+1,t_VEC); RES[2]=(long)sig;
148: rac=(GEN)nf[6]; liftpol=lift(pol);
149: RAC=cgetg(r1+r2+1,t_VEC); RES[6]=(long)RAC;
150: for (j=1; j<=r1; j++)
151: {
152: p1=gsubst(liftpol,vnf,(GEN)rac[j]);
153: ro=roots(p1,prec);
154: r1j=0;
155: while (r1j<n && gcmp0(gimag((GEN)ro[r1j+1]))) r1j++;
156: p2=cgetg(3,t_VEC); p2[1]=lstoi(r1j); p2[2]=lstoi(r2j=((n-r1j)>>1));
157: sig[j]=(long)p2;
158: p3=cgetg(r1j+r2j+1,t_VEC);
159: for (i=1; i<=r1j; i++) p3[i]=lreal((GEN)ro[i]);
160: for (; i<=r1j+r2j; i++) p3[i]=(long)ro[(i<<1)-r1j];
161: RAC[j]=(long)p3;
162: }
163: for (; j<=r1+r2; j++)
164: {
165: p2=cgetg(3,t_VEC); p2[1]=zero; p2[2]=lstoi(n); sig[j]=(long)p2;
166: p1=gsubst(liftpol,vnf,(GEN)rac[j]);
167: RAC[j]=(long)roots(p1,prec);
168: }
169: p1 = rnfpseudobasis(nf,pol);
170:
171: delta = cgetg(3,t_VEC);
172: delta[1]=p1[3];
173: delta[2]=p1[4];
174: RES[3]=(long)delta;
175: p2 = matbasistoalg(nf,(GEN)p1[1]);
176: bas = cgetg(3,t_VEC);
177: bas[1]=(long)mat_to_vecpol(p2,vpol);
178: bas[2]=(long)p1[2];
179: RES[7]=(long)bas;
180: RES[8]=linvmat(p2);
181:
182: f2=idealdiv(nf,discsr(pol),(GEN)p1[3]);
183: fac=idealfactor(nf,f2);
184: fac1=(GEN)fac[1]; fac2=(GEN)fac[2]; lfac=lg(fac1)-1;
185: f=idmat(m);
186: for (i=1; i<=lfac; i++)
187: {
188: if (mpodd((GEN)fac2[i])) err(bugparier,"rnfinitalg (odd exponent)");
189: f=idealmul(nf,f,idealpow(nf,(GEN)fac1[i],gmul2n((GEN)fac2[i],-1)));
190: }
191: RES[4]=(long)f;
192: RES[10]=(long)nf;
193: RES[5]=(long)rnfmakematrices(RES);
194: if (DEBUGLEVEL>1) msgtimer("matrices");
195: RES[9]=lgetg(1,t_VEC); /* table de multiplication */
196: p2=cgetg(6,t_VEC); RES[11]=(long)p2;
197: p1=rnfequation2(nf,pol); for (i=1; i<=3; i++) p2[i]=p1[i];
198: p4=cgetg(degabs+1,t_MAT);
199: for (i=1; i<=n; i++)
200: { /* removing denominators speeds up multiplication */
201: GEN cop3,com, om = rnfelementreltoabs(RES,gmael(bas,1,i));
202:
203: if (DEBUGLEVEL>1) msgtimer("i = %ld",i);
204: com = content(om); om = gdiv(om,com);
205: id=gmael(bas,2,i);
206: for (j=1; j<=m; j++)
207: {
208: p5=cgetg(degabs+1,t_COL); p4[(i-1)*m+j]=(long)p5;
209: p1=gmul((GEN)nf[7],(GEN)id[j]);
210: p3 = gsubst(p1,varn(nf[1]), (GEN)p2[2]);
211: cop3 = content(p3); p3 = gdiv(p3,cop3);
212: p3 = gmul(gmul(com,cop3), lift_intern(gmul(om,p3)));
213:
214: for (k=1; k<lgef(p3)-1; k++) p5[k]=p3[k+1];
215: for ( ; k<=degabs; k++) p5[k]=zero;
216: }
217: }
218: if (DEBUGLEVEL>1) msgtimer("p4");
219: p3 = denom(p4);
220: p4 = hnfmodid(gmul(p3,p4), p3);
221: if (DEBUGLEVEL>1) msgtimer("hnfmod");
222: for (j=degabs-1; j>0; j--)
223: if (cmpis(gcoeff(p4,j,j),2) > 0)
224: {
225: p1=shifti(gcoeff(p4,j,j),-1);
226: for (k=j+1; k<=degabs; k++)
227: if (cmpii(gcoeff(p4,j,k),p1) > 0)
228: for (i=1; i<=j; i++)
229: coeff(p4,i,k)=lsubii(gcoeff(p4,i,k),gcoeff(p4,i,j));
230: }
231: p4 = gdiv(p4,p3);
232: p2[4]=(long)mat_to_vecpol(p4,vpol);
233: p2[5]=linvmat(p4);
234: return gerepilecopy(av,RES);
235: }
236:
237: GEN
238: rnfbasistoalg(GEN rnf,GEN x)
239: {
240: long tx=typ(x),lx=lg(x),av=avma,tetpil,i,n;
241: GEN p1,z,nf;
242:
243: checkrnf(rnf); nf=(GEN)rnf[10];
244: switch(tx)
245: {
246: case t_VEC:
247: x=gtrans(x); /* fall through */
248: case t_COL:
249: n=lg(x)-1; p1=cgetg(n+1,t_COL);
250: for (i=1; i<=n; i++)
251: {
252: if (typ(x[i])==t_COL) p1[i]=(long)basistoalg(nf,(GEN)x[i]);
253: else p1[i]=x[i];
254: }
255: p1=gmul(gmael(rnf,7,1),p1); tetpil=avma;
256: return gerepile(av,tetpil,gmodulcp(p1,(GEN)rnf[1]));
257:
258: case t_MAT:
259: z=cgetg(lx,tx);
260: for (i=1; i<lx; i++) z[i]=(long)rnfbasistoalg(rnf,(GEN)x[i]);
261: return z;
262:
263: case t_POLMOD:
264: return gcopy(x);
265:
266: default:
267: z=cgetg(3,t_POLMOD); z[1]=lcopy((GEN)rnf[1]);
268: z[2]=lmul(x,polun[varn(rnf[1])]); return z;
269: }
270: }
271:
272: extern long polegal_spec(GEN x, GEN y);
273:
274: /* assume x is a t_POLMOD */
275: GEN
276: lift_to_pol(GEN x)
277: {
278: GEN y = (GEN)x[2];
279: return (typ(y) != t_POL)? gtopoly(y,varn(x[1])): y;
280: }
281:
282: extern GEN mulmat_pol(GEN A, GEN x);
283:
284: GEN
285: rnfalgtobasis(GEN rnf,GEN x)
286: {
287: long av=avma,tx=typ(x), i,lx;
288: GEN z;
289:
290: checkrnf(rnf);
291: switch(tx)
292: {
293: case t_VEC: case t_COL: case t_MAT:
294: lx = lg(x); z = cgetg(lx,tx);
295: for (i=1; i<lx; i++) z[i]=(long)rnfalgtobasis(rnf,(GEN)x[i]);
296: return z;
297:
298: case t_POLMOD:
299: if (!polegal_spec((GEN)rnf[1],(GEN)x[1]))
300: err(talker,"not the same number field in rnfalgtobasis");
301: x = lift_to_pol(x); /* fall through */
302: case t_POL:
303: { /* cf algtobasis_intern */
304: GEN P = (GEN)rnf[1];
305: long N = degpol(P);
306: if (degpol(x) >= N) x = gres(x,P);
307: return gerepileupto(av, mulmat_pol((GEN)rnf[8], x));
308: }
309: }
310: return gscalcol(x, degpol(rnf[1]));
311: }
312:
313: /* x doit etre un polymod ou un polynome ou un vecteur de tels objets... */
314: GEN
315: rnfelementreltoabs(GEN rnf,GEN x)
316: {
317: long av=avma,tx,i,lx,va,tp3;
318: GEN z,p1,p2,p3,polabs,teta,alpha,s,k;
319:
320: checkrnf(rnf); tx=typ(x); lx=lg(x); va=varn((GEN)rnf[1]);
321: switch(tx)
322: {
323: case t_VEC: case t_COL: case t_MAT:
324: z=cgetg(lx,tx);
325: for (i=1; i<lx; i++) z[i]=(long)rnfelementreltoabs(rnf,(GEN)x[i]);
326: return z;
327:
328: case t_POLMOD:
329: x=lift_to_pol(x); /* fall through */
330: case t_POL:
331: if (gvar(x) > va) x = scalarpol(x,va);
332: p1=(GEN)rnf[11]; polabs=(GEN)p1[1]; alpha=(GEN)p1[2]; k=(GEN)p1[3];
333: if (typ(alpha) == t_INT)
334: teta=gmodulcp(gsub(polx[va],gmul(k,alpha)),polabs);
335: else
336: teta=gmodulcp(gsub(polx[va],gmul(k,(GEN)alpha[2])),polabs);
337: s=gzero;
338: for (i=lgef(x)-1; i>1; i--)
339: {
340: p3=(GEN)x[i]; tp3=typ(p3);
341: if (is_const_t(tp3)) p2 = p3;
342: else
343: switch(tp3)
344: {
345: case t_POLMOD:
346: p3 = (GEN)p3[2]; /* fall through */
347: case t_POL:
348: p2 = poleval(p3,alpha);
349: break;
350: default: err(talker, "incorrect data in rnfelementreltoabs");
351: return NULL; /* not reached */
352: }
353: s=gadd(p2,gmul(teta,s));
354: }
355: return gerepileupto(av,s);
356:
357: default: return gcopy(x);
358: }
359: }
360:
361: GEN
362: rnfelementabstorel(GEN rnf,GEN x)
363: {
364: long av=avma,tx,i,lx;
365: GEN z,p1,s,tetap,k,nf;
366:
367: checkrnf(rnf); tx=typ(x); lx=lg(x);
368: switch(tx)
369: {
370: case t_VEC: case t_COL: case t_MAT:
371: z=cgetg(lx,tx);
372: for (i=1; i<lx; i++) z[i]=(long)rnfelementabstorel(rnf,(GEN)x[i]);
373: return z;
374:
375: case t_POLMOD:
376: x=lift_to_pol(x); /* fall through */
377: case t_POL:
378: p1=(GEN)rnf[11]; k=(GEN)p1[3]; nf=(GEN)rnf[10];
379: tetap=gmodulcp(gadd(polx[varn(rnf[1])],
380: gmul(k,gmodulcp(polx[varn(nf[1])],(GEN)nf[1]))),(GEN)rnf[1]);
381: s=gzero;
382: for (i=lgef(x)-1; i>1; i--) s=gadd((GEN)x[i],gmul(tetap,s));
383: return gerepileupto(av,s);
384:
385: default: return gcopy(x);
386: }
387: }
388:
389: /* x doit etre un polymod ou un polynome ou un vecteur de tels objets... */
390: GEN
391: rnfelementup(GEN rnf,GEN x)
392: {
393: long i,lx,tx;
394: GEN z;
395:
396: checkrnf(rnf); tx=typ(x); lx=lg(x);
397: switch(tx)
398: {
399: case t_VEC: case t_COL: case t_MAT:
400: z=cgetg(lx,tx);
401: for (i=1; i<lx; i++) z[i]=(long)rnfelementup(rnf,(GEN)x[i]);
402: return z;
403:
404: case t_POLMOD:
405: x=(GEN)x[2]; /* fall through */
406: case t_POL:
407: return poleval(x,gmael(rnf,11,2));
408:
409: default: return gcopy(x);
410: }
411: }
412:
413: /* x doit etre un polymod ou un polynome ou un vecteur de tels objets..*/
414: GEN
415: rnfelementdown(GEN rnf,GEN x)
416: {
417: ulong av = avma;
418: long i,lx,tx;
419: GEN p1,z;
420:
421: checkrnf(rnf); tx=typ(x); lx=lg(x);
422: switch(tx)
423: {
424: case t_VEC: case t_COL: case t_MAT:
425: z=cgetg(lx,tx);
426: for (i=1; i<lx; i++) z[i]=(long)rnfelementdown(rnf,(GEN)x[i]);
427: return z;
428:
429: case t_POLMOD:
430: x=(GEN)x[2]; /* fall through */
431: case t_POL:
432: if (gcmp0(x)) return gzero;
433:
434: p1=rnfelementabstorel(rnf,x);
435: if (typ(p1)==t_POLMOD && varn(p1[1])==varn(rnf[1])) p1=(GEN)p1[2];
436: if (gvar(p1)>varn(rnf[1])) return gerepilecopy(av,p1);
437: if (lgef(p1)==3) return gerepilecopy(av,(GEN)p1[2]);
438: err(talker,"element is not in the base field in rnfelementdown");
439:
440: default: return gcopy(x);
441: }
442: }
443:
444: /* x est exprime sur la base relative */
445: static GEN
446: rnfprincipaltohermite(GEN rnf,GEN x)
447: {
448: long av=avma,tetpil;
449: GEN nf,bas,bas1,p1,z;
450:
451: x=rnfbasistoalg(rnf,x); nf=(GEN)rnf[10];
452: bas=(GEN)rnf[7]; bas1=(GEN)bas[1];
453: p1=rnfalgtobasis(rnf,gmul(x,gmodulcp(bas1,(GEN)rnf[1])));
454: z=cgetg(3,t_VEC); z[2]=bas[2];
455: settyp(p1,t_MAT); z[1]=(long)matalgtobasis(nf,p1);
456:
457: tetpil=avma;
458: return gerepile(av,tetpil,nfhermite(nf,z));
459: }
460:
461: GEN
462: rnfidealhermite(GEN rnf,GEN x)
463: {
464: long tx=typ(x),lx=lg(x),av=avma,tetpil,i,j,n,m;
465: GEN z,p1,p2,x1,x2,x1j,nf,bas,unnf,zeronf;
466:
467: checkrnf(rnf);
468: n=degpol(rnf[1]); nf=(GEN)rnf[10]; bas=(GEN)rnf[7];
469:
470: switch(tx)
471: {
472: case t_INT: case t_FRAC: case t_FRACN: z=cgetg(3,t_VEC);
473: m=degpol(nf[1]); zeronf=gscalcol_i(gzero,m); unnf=gscalcol_i(gun,m);
474: p1=cgetg(n+1,t_MAT); z[1]=(long)p1;
475: for (j=1; j<=n; j++)
476: {
477: p2=cgetg(n+1,t_COL); p1[j]=(long)p2;
478: for (i=1; i<=n; i++) p2[i]=(i==j)?(long)unnf:(long)zeronf;
479: }
480: z[2]=lmul(x,(GEN)bas[2]); return z;
481:
482: case t_POLMOD: case t_POL:
483: p1=rnfalgtobasis(rnf,x); tetpil=avma;
484: return gerepile(av,tetpil,rnfprincipaltohermite(rnf,p1));
485:
486: case t_VEC:
487: switch(lx)
488: {
489: case 3:
490: x1=(GEN)x[1];
491: if (typ(x1)!=t_MAT || lg(x1) < n+1 || lg(x1[1]) != n+1)
492: err(talker,"incorrect type in rnfidealhermite");
493: p1=cgetg(n+1,t_MAT);
494: for (j=1; j<=n; j++)
495: {
496: p2=cgetg(n+1,t_COL); p1[j]=(long)p2; x1j=(GEN)x1[j];
497: for (i=1; i<=n; i++)
498: {
499: tx = typ(x1j[i]);
500: if (is_const_t(tx)) p2[i] = x1j[i];
501: else
502: switch(tx)
503: {
504: case t_POLMOD: case t_POL:
505: p2[i]=(long)algtobasis(nf,(GEN)x1j[i]); break;
506: case t_COL:
507: p2[i]=x1j[i]; break;
508: default: err(talker,"incorrect type in rnfidealhermite");
509: }
510: }
511: }
512: x2=(GEN)x[2];
513: if (typ(x2)!=t_VEC || lg(x2)!=lg(x1))
514: err(talker,"incorrect type in rnfidealhermite");
515: tetpil=avma; z=cgetg(3,t_VEC); z[1]=lcopy(p1); z[2]=lcopy(x2);
516: z=gerepile(av,tetpil,nfhermite(nf,z));
517: if (lg(z[1]) != n+1)
518: err(talker,"not an ideal in rnfidealhermite");
519: return z;
520:
521: case 6:
522: err(impl,"rnfidealhermite for prime ideals");
523: default:
524: err(typeer,"rnfidealhermite");
525: }
526:
527: case t_COL:
528: if (lx!=(n+1)) err(typeer,"rnfidealhermite");
529: return rnfprincipaltohermite(rnf,x);
530:
531: case t_MAT:
532: return rnfidealabstorel(rnf,x);
533: }
534: err(typeer,"rnfidealhermite");
535: return NULL; /* not reached */
536: }
537:
538: GEN
539: rnfidealnormrel(GEN rnf,GEN id)
540: {
541: long av=avma,i,n;
542: GEN z,id2,nf;
543:
544: checkrnf(rnf);
545: id=rnfidealhermite(rnf,id); id2=(GEN)id[2];
546: n=degpol(rnf[1]); nf=(GEN)rnf[10];
547: if (n==1) { avma=av; return idmat(degpol(nf[1])); }
548: z=(GEN)id2[1]; for (i=2; i<=n; i++) z=idealmul(nf,z,(GEN)id2[i]);
549: return gerepileupto(av,z);
550: }
551:
552: GEN
553: rnfidealnormabs(GEN rnf,GEN id)
554: {
555: long av=avma,i,n;
556: GEN z,id2;
557:
558: checkrnf(rnf);
559: id=rnfidealhermite(rnf,id); id2=(GEN)id[2];
560: n=degpol(rnf[1]);
561: z=gun; for (i=1; i<=n; i++) z=gmul(z,dethnf((GEN)id2[i]));
562: return gerepileupto(av,z);
563: }
564:
565: GEN
566: rnfidealreltoabs(GEN rnf,GEN x)
567: {
568: long av=avma,i,j,k,n,m;
569: GEN nf,basinv,om,id,p1,p2,p3,p4,p5,c;
570:
571: checkrnf(rnf);
572: x = rnfidealhermite(rnf,x);
573: n=degpol(rnf[1]); nf=(GEN)rnf[10]; m=degpol(nf[1]);
574: basinv = gmael(rnf,11,5);
575: p3=cgetg(n*m+1,t_MAT); p2=gmael(rnf,11,2);
576: for (i=1; i<=n; i++)
577: {
578: om=rnfbasistoalg(rnf,gmael(x,1,i)); id=gmael(x,2,i);
579: om=rnfelementreltoabs(rnf,om);
580: for (j=1; j<=m; j++)
581: {
582: p1=gmul((GEN)nf[7],(GEN)id[j]);
583: p4=lift_intern(gmul(om,gsubst(p1,varn(nf[1]),p2)));
584: p5=cgetg(n*m+1,t_COL);
585: for (k=0; k<n*m; k++) p5[k+1]=(long)truecoeff(p4,k);
586: p3[(i-1)*m+j]=(long)p5;
587: }
588: }
589: p1 = gmul(basinv,p3); c = content(p1);
590: p2 = gmael(p1,1,1); /* x \cap Z */
591: if (is_pm1(c)) c = NULL; else { p1 = gdiv(p1, c); p2 = gdiv(p2, c); }
592: p1 = hnfmodid(p1, p2);
593: if (c) p1 = gmul(p1, c);
594: return gerepileupto(av, p1);
595: }
596:
597: GEN
598: rnfidealabstorel(GEN rnf,GEN x)
599: {
600: long av=avma,tetpil,n,m,j,k;
601: GEN nf,basabs,ma,xj,p1,p2,id;
602:
603: checkrnf(rnf); n=degpol(rnf[1]); nf=(GEN)rnf[10]; m=degpol(nf[1]);
604: if (typ(x)!=t_MAT || lg(x)!=(n*m+1) || lg(x[1])!=(n*m+1))
605: err(impl,"rnfidealabstorel for an ideal not in HNF");
606: basabs=gmael(rnf,11,4); ma=cgetg(n*m+1,t_MAT);
607: for (j=1; j<=n*m; j++)
608: {
609: p2=cgetg(n+1,t_COL); ma[j]=(long)p2;
610: xj=gmul(basabs,(GEN)x[j]);
611: xj=lift_intern(rnfelementabstorel(rnf,xj));
612: for (k=0; k<n; k++)
613: p2[k+1]=(long)truecoeff(xj,k);
614: }
615: ma=gmul((GEN)rnf[8],ma);
616: ma=matalgtobasis(nf,ma);
617: p1=cgetg(n*m+1,t_VEC); id=idmat(m);
618: for (j=1; j<=n*m; j++) p1[j]=(long)id;
619: p2=cgetg(3,t_VEC); p2[1]=(long)ma; p2[2]=(long)p1;
620: tetpil=avma; return gerepile(av,tetpil,nfhermite(nf,p2));
621: }
622:
623: GEN
624: rnfidealdown(GEN rnf,GEN x)
625: {
626: long av=avma;
627:
628: checkrnf(rnf); x=rnfidealhermite(rnf,x);
629: return gerepilecopy(av,gmael(x,2,1));
630: }
631:
632: /* lift ideal x to the relative extension, returns a Z-basis */
633: GEN
634: rnfidealup(GEN rnf,GEN x)
635: {
636: long av=avma,tetpil,i,n,m;
637: GEN nf,bas,bas2,p1,p2,zeronf,unnf;
638:
639: checkrnf(rnf);
640: bas=(GEN)rnf[7]; bas2=(GEN)bas[2];
641: n=lg(bas2)-1; nf=(GEN)rnf[10]; m=degpol((GEN)nf[1]);
642: zeronf=zerocol(m); unnf=gscalcol_i(gun,m);
643: p2=cgetg(3,t_VEC); p1=cgetg(n+1,t_VEC);
644: p2[1]=(long)idmat_intern(n,unnf,zeronf);
645: p2[2]=(long)p1;
646: for (i=1; i<=n; i++) p1[i]=(long)idealmul(nf,x,(GEN)bas2[i]);
647: tetpil=avma; return gerepile(av,tetpil,rnfidealreltoabs(rnf,p2));
648: }
649:
650: /* x a relative HNF ---> vector of 2 generators (relative polymods) */
651: GEN
652: rnfidealtwoelement(GEN rnf,GEN x)
653: {
654: long av=avma,tetpil,j;
655: GEN p1,p2,p3,res,polabs,nfabs,z;
656:
657: checkrnf(rnf);
658: res=(GEN)rnf[11]; polabs=(GEN)res[1];
659: nfabs=cgetg(10,t_VEC); nfabs[1]=(long)polabs;
660: for (j=2; j<=9; j++) nfabs[j]=zero;
661: nfabs[7]=(long)lift((GEN)res[4]); nfabs[8]=res[5];
662: p1=rnfidealreltoabs(rnf,x);
663: p2=ideal_two_elt(nfabs,p1);
664: p3=rnfelementabstorel(rnf,gmul((GEN)res[4],(GEN)p2[2]));
665: tetpil=avma; z=cgetg(3,t_VEC); z[1]=lcopy((GEN)p2[1]);
666: z[2]=(long)rnfalgtobasis(rnf,p3);
667: return gerepile(av,tetpil,z);
668: }
669:
670: GEN
671: rnfidealmul(GEN rnf,GEN x,GEN y) /* x et y sous HNF relative uniquement */
672: {
673: long av=avma,tetpil,i,j,n;
674: GEN z,nf,x1,x2,p1,p2,p3,p4,p5,res;
675:
676: z=rnfidealtwoelement(rnf,y);
677: nf=(GEN)rnf[10]; n=degpol(rnf[1]);
678: x=rnfidealhermite(rnf,x);
679: x1=gmodulcp(gmul(gmael(rnf,7,1),matbasistoalg(nf,(GEN)x[1])),(GEN) rnf[1]);
680: x2=(GEN)x[2]; p1=gmul((GEN)z[1],(GEN)x[1]);
681: p2=lift_intern(gmul(rnfbasistoalg(rnf,(GEN)z[2]),x1));
682: p3=cgetg(n+1,t_MAT);
683: for (j=1; j<=n; j++)
684: {
685: p4=cgetg(n+1,t_COL); p3[j]=(long)p4; p5=(GEN)p2[j];
686: for (i=1; i<=n; i++)
687: p4[i]=(long)algtobasis(nf,truecoeff((GEN)p5,i-1));
688: }
689: res=cgetg(3,t_VEC);
690: res[1]=(long)concatsp(p1,p3);
691: res[2]=(long)concatsp(x2,x2);
692: tetpil=avma; return gerepile(av,tetpil,nfhermite(nf,res));
693: }
694:
695: /*********************************************************************/
696: /** **/
697: /** LIBRARY FOR POLYNOMIALS WITH COEFFS. IN Z_K/P **/
698: /** An element in Z_K/P is a t_COL with degree(nf[1]) components. **/
699: /** These are integers modulo the prime p under prime ideal P **/
700: /** (only f(P/p) elements are non zero). These components are **/
701: /** given on the integer basis of K. **/
702: /** **/
703: /*********************************************************************/
704:
705: /* K.B: What follows is not meant to work (yet?) */
706:
707: GEN
708: polnfmulscal(GEN nf,GEN s,GEN x)
709: {
710: long i,lx=lgef(x);
711: GEN z;
712:
713: if (lx<3) return gcopy(x);
714: if (gcmp0(s))
715: {
716: z=cgetg(2,t_POL); z[1]=evallgef(2) | evalvarn(varn(x));
717: return z;
718: }
719: z=cgetg(lx,t_POL); z[1]=x[1];
720: for (i=2; i<lx; i++) z[i]=(long)element_mul(nf,s,(GEN)x[i]);
721: return z;
722: }
723:
724: GEN
725: polnfmul(GEN nf, GEN x, GEN y)
726: {
727: ulong av;
728: long m,i,d,imin,imax,lx,ly,lz;
729: GEN p1,z,zeronf;
730:
731: if (gcmp0(x) || gcmp0(y)) return zeropol(varn(x));
732: m=degpol(nf[1]); av=avma;
733: lx=degpol(x); ly=degpol(y); lz=lx+ly;
734: zeronf=gscalcol_i(gzero,m);
735: z=cgetg(lz+3,t_POL);
736: z[1] = evallgef(lz+3) | evalvarn(x) | evalsigne(1);
737: for (d=0; d<=lz; d++)
738: {
739: p1=zeronf; imin=max(0,d-ly); imax=min(d,lx);
740: for (i=imin; i<=imax; i++)
741: p1=gadd(p1,element_mul(nf,(GEN)x[i+2],(GEN)y[d-i+2]));
742: z[d+2]=(long)p1;
743: }
744: return gerepilecopy(av,z);
745: }
746:
747: /* division euclidienne */
748: GEN
749: polnfdeuc(GEN nf, GEN x, GEN y, GEN *ptr)
750: {
751: long av=avma,m,i,d,tx,lx,ly,lz,fl;
752: GEN z,unnf,lcy,r;
753: GEN *gptr[2];
754:
755: if (gcmp0(y)) err(talker,"division by zero in polnfdiv");
756: lx=lgef(x); ly=lgef(y); lz=lx-ly;
757: if (gcmp0(x) || lz<0) { *ptr=gcopy(x); return zeropol(varn(x)); }
758:
759: m=degpol(nf[1]); unnf=gscalcol_i(gun,m);
760: x=dummycopy(x); y=dummycopy(y);
761: for (i=2; i<lx; i++)
762: {
763: tx=typ(x[i]);
764: if (is_intreal_t(tx) || tx == t_INTMOD || is_frac_t(tx))
765: x[i]=lmul((GEN)x[i],unnf);
766: }
767: for (i=2; i<ly; i++)
768: {
769: tx=typ(y[i]);
770: if (is_intreal_t(tx) || tx == t_INTMOD || is_frac_t(tx))
771: y[i]=lmul((GEN)y[i],unnf);
772: }
773:
774: lz += 3;
775: z=cgetg(lz,t_POL); z[1]=evallgef(lz) | evalvarn(x) | evalsigne(1);
776: lcy=(GEN)y[ly-1];
777: if (gegal(lift(lcy),unnf)) fl=0;
778: else
779: {
780: fl=1; y=polnfmulscal(nf,element_inv(nf,lcy),y);
781: }
782: for (d=lz-1; d>=2; d--)
783: {
784: z[d]=x[d+ly-3];
785: for (i=d; i<d+ly-3; i++)
786: x[i]=lsub((GEN)x[i],element_mul(nf,(GEN)z[d],(GEN)y[i-d-2]));
787: }
788: if (fl) z=polnfmulscal(nf,lcy,z);
789:
790: for(;;)
791: {
792: if (!gcmp0((GEN)x[d]))
793: {
794: r=cgetg(d,t_POL);
795: r[1] = evallgef(d) | evalvarn(varn(x)) | evalsigne(1);
796: for (i=2; i<d; i++) r[i]=x[i];
797: break;
798: }
799: if (d==2) { r = zeropol(varn(x)); break; }
800: d--;
801: }
802: *ptr=r; gptr[0]=ptr; gptr[1]=&z;
803: gerepilemany(av,gptr,2); return z;
804: }
805:
806: GEN
807: polnfpow(GEN nf,GEN x,GEN k)
808: {
809: long s,av=avma,m;
810: GEN y,z;
811:
812: m=degpol(nf[1]);
813: if (typ(k)!=t_INT) err(talker,"not an integer exponent in nfpow");
814: s=signe(k); if (s<0) err(impl,"polnfpow for negative exponents");
815:
816: z=x; y=cgetg(3,t_POL);
817: y[1] = evallgef(3) | evalvarn(varn(x)) | evalsigne(1);
818: y[2] = (long)gscalcol_i(gun,m);
819: for(;;)
820: {
821: if (mpodd(k)) y=polnfmul(nf,z,y);
822: k=shifti(k,-1);
823: if (!signe(k)) { cgiv(k); return gerepileupto(av,y); }
824: z=polnfmul(nf,z,z);
825: }
826: }
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