Annotation of OpenXM_contrib2/asir2018/engine/nd.c, Revision 1.24
1.24 ! noro 1: /* $OpenXM: OpenXM_contrib2/asir2018/engine/nd.c,v 1.23 2020/02/05 04:56:10 noro Exp $ */
1.1 noro 2:
3: #include "nd.h"
4:
1.11 noro 5: int Nnd_add,Nf4_red;
1.12 noro 6: struct oEGT eg_search,f4_symb,f4_conv,f4_elim1,f4_elim2;
1.1 noro 7:
8: int diag_period = 6;
9: int weight_check = 1;
10: int (*ndl_compare_function)(UINT *a1,UINT *a2);
1.21 noro 11: /* for general module order */
1.19 noro 12: int (*ndl_base_compare_function)(UINT *a1,UINT *a2);
1.21 noro 13: int (*dl_base_compare_function)(int nv,DL a,DL b);
14: int nd_base_ordtype;
1.1 noro 15: int nd_dcomp;
16: int nd_rref2;
17: NM _nm_free_list;
18: ND _nd_free_list;
19: ND_pairs _ndp_free_list;
20: NODE nd_hcf;
21:
22: Obj nd_top_weight;
23:
24: static NODE nd_subst;
25: static VL nd_vc;
26: static int nd_ntrans;
27: static int nd_nalg;
28: #if 0
29: static int ndv_alloc;
30: #endif
31: #if 1
32: static int nd_f4_nsp=0x7fffffff;
33: #else
34: static int nd_f4_nsp=50;
35: #endif
36: static double nd_scale=2;
37: static UINT **nd_bound;
38: static struct order_spec *nd_ord;
39: static EPOS nd_epos;
40: static BlockMask nd_blockmask;
41: static int nd_nvar;
42: static int nd_isrlex;
43: static int nd_epw,nd_bpe,nd_wpd,nd_exporigin;
44: static UINT nd_mask[32];
45: static UINT nd_mask0,nd_mask1;
46:
47: static NDV *nd_ps;
48: static NDV *nd_ps_trace;
49: static NDV *nd_ps_sym;
50: static NDV *nd_ps_trace_sym;
51: static RHist *nd_psh;
52: static int nd_psn,nd_pslen;
53: static RHist *nd_red;
54: static int *nd_work_vector;
55: static int **nd_matrix;
56: static int nd_matrix_len;
57: static struct weight_or_block *nd_worb;
58: static int nd_worb_len;
59: static int nd_found,nd_create,nd_notfirst;
60: static int nmv_adv;
61: static int nd_demand;
1.21 noro 62: static int nd_module,nd_module_ordtype,nd_mpos,nd_pot_nelim;
1.1 noro 63: static int nd_module_rank,nd_poly_weight_len;
64: static int *nd_poly_weight,*nd_module_weight;
65: static NODE nd_tracelist;
66: static NODE nd_alltracelist;
67: static int nd_gentrace,nd_gensyz,nd_nora,nd_newelim,nd_intersect,nd_lf;
68: static int *nd_gbblock;
69: static NODE nd_nzlist,nd_check_splist;
70: static int nd_splist;
71: static int *nd_sugarweight;
72: static int nd_f4red,nd_rank0,nd_last_nonzero;
73:
74: NumberField get_numberfield();
75: UINT *nd_det_compute_bound(NDV **dm,int n,int j);
76: void nd_det_reconstruct(NDV **dm,int n,int j,NDV d);
77: void nd_heu_nezgcdnpz(VL vl,P *pl,int m,int full,P *pr);
78: int nd_monic(int m,ND *p);
79: NDV plain_vect_to_ndv_q(Z *mat,int col,UINT *s0vect);
80: LIST ndvtopl(int mod,VL vl,VL dvl,NDV p,int rank);
81: NDV pltondv(VL vl,VL dvl,LIST p);
82: void pltozpl(LIST l,Q *cont,LIST *pp);
83: void ndl_max(UINT *d1,unsigned *d2,UINT *d);
84: void nmtodp(int mod,NM m,DP *r);
1.15 noro 85: void ndltodp(UINT *d,DP *r);
1.1 noro 86: NODE reverse_node(NODE n);
87: P ndc_div(int mod,union oNDC a,union oNDC b);
88: P ndctop(int mod,union oNDC c);
89: void finalize_tracelist(int i,P cont);
90: void conv_ilist(int demand,int trace,NODE g,int **indp);
91: void parse_nd_option(NODE opt);
92: void dltondl(int n,DL dl,UINT *r);
93: DP ndvtodp(int mod,NDV p);
94: DP ndtodp(int mod,ND p);
1.16 noro 95: DPM ndvtodpm(int mod,NDV p);
96: NDV dpmtondv(int mod,DPM p);
97: int dpm_getdeg(DPM p,int *rank);
98: void dpm_ptozp(DPM p,Z *cont,DPM *r);
99: int compdmm(int nv,DMM a,DMM b);
1.1 noro 100:
101: void Pdp_set_weight(NODE,VECT *);
102: void Pox_cmo_rpc(NODE,Obj *);
103:
104: ND nd_add_lf(ND p1,ND p2);
105: void nd_mul_c_lf(ND p,Z mul);
106: void ndv_mul_c_lf(NDV p,Z mul);
107: NODE nd_f4_red_main(int m,ND_pairs sp0,int nsp,UINT *s0vect,int col,
108: NM_ind_pair *rvect,int *rhead,IndArray *imat,int nred,ND_pairs *nz);
109: NODE nd_f4_red_mod64_main(int m,ND_pairs sp0,int nsp,UINT *s0vect,int col,
110: NM_ind_pair *rvect,int *rhead,IndArray *imat,int nred,ND_pairs *nz);
111: NODE nd_f4_red_lf_main(int m,ND_pairs sp0,int nsp,int trace,UINT *s0vect,int col,
112: NM_ind_pair *rvect,int *rhead,IndArray *imat,int nred);
113: int nd_gauss_elim_lf(mpz_t **mat0,int *sugar,int row,int col,int *colstat);
114: NODE nd_f4_lf_trace_main(int m,int **indp);
115: void nd_f4_lf_trace(LIST f,LIST v,int trace,int homo,struct order_spec *ord,LIST *rp);
116:
117: extern int lf_lazy;
118: extern Z current_mod_lf;
119:
120: extern int Denominator,DP_Multiple,MaxDeg;
121:
122: #define BLEN (8*sizeof(unsigned long))
123:
124: typedef struct matrix {
125: int row,col;
126: unsigned long **a;
127: } *matrix;
128:
129:
130: void nd_free_private_storage()
131: {
132: _nm_free_list = 0;
133: _ndp_free_list = 0;
134: #if 0
135: GC_gcollect();
136: #endif
137: }
138:
139: void _NM_alloc()
140: {
141: NM p;
142: int i;
143:
144: for ( i = 0; i < 1024; i++ ) {
145: p = (NM)MALLOC(sizeof(struct oNM)+(nd_wpd-1)*sizeof(UINT));
146: p->next = _nm_free_list; _nm_free_list = p;
147: }
148: }
149:
150: matrix alloc_matrix(int row,int col)
151: {
152: unsigned long **a;
153: int i,len,blen;
154: matrix mat;
155:
156: mat = (matrix)MALLOC(sizeof(struct matrix));
157: mat->row = row;
158: mat->col = col;
159: mat->a = a = (unsigned long **)MALLOC(row*sizeof(unsigned long *));
160: return mat;
161: }
162:
163:
164: void _ND_alloc()
165: {
166: ND p;
167: int i;
168:
169: for ( i = 0; i < 1024; i++ ) {
170: p = (ND)MALLOC(sizeof(struct oND));
171: p->body = (NM)_nd_free_list; _nd_free_list = p;
172: }
173: }
174:
175: void _NDP_alloc()
176: {
177: ND_pairs p;
178: int i;
179:
180: for ( i = 0; i < 1024; i++ ) {
181: p = (ND_pairs)MALLOC(sizeof(struct oND_pairs)
182: +(nd_wpd-1)*sizeof(UINT));
183: p->next = _ndp_free_list; _ndp_free_list = p;
184: }
185: }
186:
187: INLINE int nd_length(ND p)
188: {
189: NM m;
190: int i;
191:
192: if ( !p )
193: return 0;
194: else {
195: for ( i = 0, m = BDY(p); m; m = NEXT(m), i++ );
196: return i;
197: }
198: }
199:
200: extern int dp_negative_weight;
201:
202: INLINE int ndl_reducible(UINT *d1,UINT *d2)
203: {
204: UINT u1,u2;
205: int i,j;
206:
207: if ( nd_module && (MPOS(d1) != MPOS(d2)) ) return 0;
208:
209: if ( !dp_negative_weight && TD(d1) < TD(d2) ) return 0;
210: #if USE_UNROLL
211: switch ( nd_bpe ) {
212: case 3:
213: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
214: u1 = d1[i]; u2 = d2[i];
215: if ( (u1&0x38000000) < (u2&0x38000000) ) return 0;
216: if ( (u1& 0x7000000) < (u2& 0x7000000) ) return 0;
217: if ( (u1& 0xe00000) < (u2& 0xe00000) ) return 0;
218: if ( (u1& 0x1c0000) < (u2& 0x1c0000) ) return 0;
219: if ( (u1& 0x38000) < (u2& 0x38000) ) return 0;
220: if ( (u1& 0x7000) < (u2& 0x7000) ) return 0;
221: if ( (u1& 0xe00) < (u2& 0xe00) ) return 0;
222: if ( (u1& 0x1c0) < (u2& 0x1c0) ) return 0;
223: if ( (u1& 0x38) < (u2& 0x38) ) return 0;
224: if ( (u1& 0x7) < (u2& 0x7) ) return 0;
225: }
226: return 1;
227: break;
228: case 4:
229: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
230: u1 = d1[i]; u2 = d2[i];
231: if ( (u1&0xf0000000) < (u2&0xf0000000) ) return 0;
232: if ( (u1& 0xf000000) < (u2& 0xf000000) ) return 0;
233: if ( (u1& 0xf00000) < (u2& 0xf00000) ) return 0;
234: if ( (u1& 0xf0000) < (u2& 0xf0000) ) return 0;
235: if ( (u1& 0xf000) < (u2& 0xf000) ) return 0;
236: if ( (u1& 0xf00) < (u2& 0xf00) ) return 0;
237: if ( (u1& 0xf0) < (u2& 0xf0) ) return 0;
238: if ( (u1& 0xf) < (u2& 0xf) ) return 0;
239: }
240: return 1;
241: break;
242: case 6:
243: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
244: u1 = d1[i]; u2 = d2[i];
245: if ( (u1&0x3f000000) < (u2&0x3f000000) ) return 0;
246: if ( (u1& 0xfc0000) < (u2& 0xfc0000) ) return 0;
247: if ( (u1& 0x3f000) < (u2& 0x3f000) ) return 0;
248: if ( (u1& 0xfc0) < (u2& 0xfc0) ) return 0;
249: if ( (u1& 0x3f) < (u2& 0x3f) ) return 0;
250: }
251: return 1;
252: break;
253: case 8:
254: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
255: u1 = d1[i]; u2 = d2[i];
256: if ( (u1&0xff000000) < (u2&0xff000000) ) return 0;
257: if ( (u1& 0xff0000) < (u2& 0xff0000) ) return 0;
258: if ( (u1& 0xff00) < (u2& 0xff00) ) return 0;
259: if ( (u1& 0xff) < (u2& 0xff) ) return 0;
260: }
261: return 1;
262: break;
263: case 16:
264: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
265: u1 = d1[i]; u2 = d2[i];
266: if ( (u1&0xffff0000) < (u2&0xffff0000) ) return 0;
267: if ( (u1& 0xffff) < (u2& 0xffff) ) return 0;
268: }
269: return 1;
270: break;
271: case 32:
272: for ( i = nd_exporigin; i < nd_wpd; i++ )
273: if ( d1[i] < d2[i] ) return 0;
274: return 1;
275: break;
276: default:
277: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
278: u1 = d1[i]; u2 = d2[i];
279: for ( j = 0; j < nd_epw; j++ )
280: if ( (u1&nd_mask[j]) < (u2&nd_mask[j]) ) return 0;
281: }
282: return 1;
283: }
284: #else
285: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
286: u1 = d1[i]; u2 = d2[i];
287: for ( j = 0; j < nd_epw; j++ )
288: if ( (u1&nd_mask[j]) < (u2&nd_mask[j]) ) return 0;
289: }
290: return 1;
291: #endif
292: }
293:
1.24 ! noro 294: int ndl_reducible_s(UINT *d1,UINT *d2,UINT *quo)
! 295: {
! 296: UINT u1,u2;
! 297: int i,j;
! 298:
! 299: if ( nd_module && (MPOS(d1) != MPOS(d2)) ) return 0;
! 300:
! 301: if ( !dp_negative_weight && TD(d1) < TD(d2) ) return 0;
! 302: #if USE_UNROLL
! 303: switch ( nd_bpe ) {
! 304: case 3:
! 305: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
! 306: u1 = d1[i]; u2 = d2[i];
! 307: if ( (u1&0x38000000) < (u2&0x38000000) ) return 0;
! 308: if ( (u1& 0x7000000) < (u2& 0x7000000) ) return 0;
! 309: if ( (u1& 0xe00000) < (u2& 0xe00000) ) return 0;
! 310: if ( (u1& 0x1c0000) < (u2& 0x1c0000) ) return 0;
! 311: if ( (u1& 0x38000) < (u2& 0x38000) ) return 0;
! 312: if ( (u1& 0x7000) < (u2& 0x7000) ) return 0;
! 313: if ( (u1& 0xe00) < (u2& 0xe00) ) return 0;
! 314: if ( (u1& 0x1c0) < (u2& 0x1c0) ) return 0;
! 315: if ( (u1& 0x38) < (u2& 0x38) ) return 0;
! 316: if ( (u1& 0x7) < (u2& 0x7) ) return 0;
! 317: }
! 318: for ( i = 0; i < nd_wpd; i++ ) d1[i] -= d2[i];
! 319: return 1;
! 320: break;
! 321: case 4:
! 322: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
! 323: u1 = d1[i]; u2 = d2[i];
! 324: if ( (u1&0xf0000000) < (u2&0xf0000000) ) return 0;
! 325: if ( (u1& 0xf000000) < (u2& 0xf000000) ) return 0;
! 326: if ( (u1& 0xf00000) < (u2& 0xf00000) ) return 0;
! 327: if ( (u1& 0xf0000) < (u2& 0xf0000) ) return 0;
! 328: if ( (u1& 0xf000) < (u2& 0xf000) ) return 0;
! 329: if ( (u1& 0xf00) < (u2& 0xf00) ) return 0;
! 330: if ( (u1& 0xf0) < (u2& 0xf0) ) return 0;
! 331: if ( (u1& 0xf) < (u2& 0xf) ) return 0;
! 332: }
! 333: for ( i = 0; i < nd_wpd; i++ ) d1[i] -= d2[i];
! 334: return 1;
! 335: break;
! 336: case 6:
! 337: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
! 338: u1 = d1[i]; u2 = d2[i];
! 339: if ( (u1&0x3f000000) < (u2&0x3f000000) ) return 0;
! 340: if ( (u1& 0xfc0000) < (u2& 0xfc0000) ) return 0;
! 341: if ( (u1& 0x3f000) < (u2& 0x3f000) ) return 0;
! 342: if ( (u1& 0xfc0) < (u2& 0xfc0) ) return 0;
! 343: if ( (u1& 0x3f) < (u2& 0x3f) ) return 0;
! 344: }
! 345: for ( i = 0; i < nd_wpd; i++ ) d1[i] -= d2[i];
! 346: return 1;
! 347: break;
! 348: case 8:
! 349: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
! 350: u1 = d1[i]; u2 = d2[i];
! 351: if ( (u1&0xff000000) < (u2&0xff000000) ) return 0;
! 352: if ( (u1& 0xff0000) < (u2& 0xff0000) ) return 0;
! 353: if ( (u1& 0xff00) < (u2& 0xff00) ) return 0;
! 354: if ( (u1& 0xff) < (u2& 0xff) ) return 0;
! 355: }
! 356: for ( i = 0; i < nd_wpd; i++ ) d1[i] -= d2[i];
! 357: return 1;
! 358: break;
! 359: case 16:
! 360: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
! 361: u1 = d1[i]; u2 = d2[i];
! 362: if ( (u1&0xffff0000) < (u2&0xffff0000) ) return 0;
! 363: if ( (u1& 0xffff) < (u2& 0xffff) ) return 0;
! 364: }
! 365: for ( i = 0; i < nd_wpd; i++ ) d1[i] -= d2[i];
! 366: return 1;
! 367: break;
! 368: case 32:
! 369: for ( i = nd_exporigin; i < nd_wpd; i++ )
! 370: if ( d1[i] < d2[i] ) return 0;
! 371: for ( i = 0; i < nd_wpd; i++ ) d1[i] -= d2[i];
! 372: return 1;
! 373: break;
! 374: default:
! 375: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
! 376: u1 = d1[i]; u2 = d2[i];
! 377: for ( j = 0; j < nd_epw; j++ )
! 378: if ( (u1&nd_mask[j]) < (u2&nd_mask[j]) ) return 0;
! 379: }
! 380: for ( i = 0; i < nd_wpd; i++ ) d1[i] -= d2[i];
! 381: return 1;
! 382: }
! 383: #else
! 384: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
! 385: u1 = d1[i]; u2 = d2[i];
! 386: for ( j = 0; j < nd_epw; j++ )
! 387: if ( (u1&nd_mask[j]) < (u2&nd_mask[j]) ) return 0;
! 388: }
! 389: for ( i = 0; i < nd_wpd; i++ ) d1[i] -= d2[i];
! 390: return 1;
! 391: #endif
! 392: }
! 393:
1.1 noro 394: /*
395: * If the current order is a block order,
396: * then the last block is length 1 and contains
397: * the homo variable. Otherwise, the original
398: * order is either 0 or 2.
399: */
400:
401: void ndl_homogenize(UINT *d,UINT *r,int obpe,EPOS oepos,int ompos,int weight)
402: {
403: int w,i,e,n,omask0;
404:
405: omask0 = obpe==32?0xffffffff:((1<<obpe)-1);
406: n = nd_nvar-1;
407: ndl_zero(r);
408: for ( i = 0; i < n; i++ ) {
409: e = GET_EXP_OLD(d,i);
410: PUT_EXP(r,i,e);
411: }
412: w = TD(d);
413: PUT_EXP(r,nd_nvar-1,weight-w);
414: if ( nd_module ) MPOS(r) = d[ompos];
415: TD(r) = weight;
416: if ( nd_blockmask ) ndl_weight_mask(r);
417: }
418:
419: void ndl_dehomogenize(UINT *d)
420: {
421: UINT mask;
422: UINT h;
423: int i,bits;
424:
425: if ( nd_blockmask ) {
426: h = GET_EXP(d,nd_nvar-1);
427: XOR_EXP(d,nd_nvar-1,h);
428: TD(d) -= h;
429: ndl_weight_mask(d);
430: } else {
431: if ( nd_isrlex ) {
432: if ( nd_bpe == 32 ) {
433: h = d[nd_exporigin];
434: for ( i = nd_exporigin+1; i < nd_wpd; i++ )
435: d[i-1] = d[i];
436: d[i-1] = 0;
437: TD(d) -= h;
438: } else {
439: bits = nd_epw*nd_bpe;
440: mask = bits==32?0xffffffff:((1<<(nd_epw*nd_bpe))-1);
441: h = (d[nd_exporigin]>>((nd_epw-1)*nd_bpe))&nd_mask0;
442: for ( i = nd_exporigin; i < nd_wpd; i++ )
443: d[i] = ((d[i]<<nd_bpe)&mask)
444: |(i+1<nd_wpd?((d[i+1]>>((nd_epw-1)*nd_bpe))&nd_mask0):0);
445: TD(d) -= h;
446: }
447: } else {
448: h = GET_EXP(d,nd_nvar-1);
449: XOR_EXP(d,nd_nvar-1,h);
450: TD(d) -= h;
451: }
452: }
453: }
454:
455: void ndl_lcm(UINT *d1,unsigned *d2,UINT *d)
456: {
457: UINT t1,t2,u,u1,u2;
458: int i,j,l;
459:
460: if ( nd_module && (MPOS(d1) != MPOS(d2)) )
461: error("ndl_lcm : inconsistent monomials");
462: #if USE_UNROLL
463: switch ( nd_bpe ) {
464: case 3:
465: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
466: u1 = d1[i]; u2 = d2[i];
467: t1 = (u1&0x38000000); t2 = (u2&0x38000000); u = t1>t2?t1:t2;
468: t1 = (u1& 0x7000000); t2 = (u2& 0x7000000); u |= t1>t2?t1:t2;
469: t1 = (u1& 0xe00000); t2 = (u2& 0xe00000); u |= t1>t2?t1:t2;
470: t1 = (u1& 0x1c0000); t2 = (u2& 0x1c0000); u |= t1>t2?t1:t2;
471: t1 = (u1& 0x38000); t2 = (u2& 0x38000); u |= t1>t2?t1:t2;
472: t1 = (u1& 0x7000); t2 = (u2& 0x7000); u |= t1>t2?t1:t2;
473: t1 = (u1& 0xe00); t2 = (u2& 0xe00); u |= t1>t2?t1:t2;
474: t1 = (u1& 0x1c0); t2 = (u2& 0x1c0); u |= t1>t2?t1:t2;
475: t1 = (u1& 0x38); t2 = (u2& 0x38); u |= t1>t2?t1:t2;
476: t1 = (u1& 0x7); t2 = (u2& 0x7); u |= t1>t2?t1:t2;
477: d[i] = u;
478: }
479: break;
480: case 4:
481: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
482: u1 = d1[i]; u2 = d2[i];
483: t1 = (u1&0xf0000000); t2 = (u2&0xf0000000); u = t1>t2?t1:t2;
484: t1 = (u1& 0xf000000); t2 = (u2& 0xf000000); u |= t1>t2?t1:t2;
485: t1 = (u1& 0xf00000); t2 = (u2& 0xf00000); u |= t1>t2?t1:t2;
486: t1 = (u1& 0xf0000); t2 = (u2& 0xf0000); u |= t1>t2?t1:t2;
487: t1 = (u1& 0xf000); t2 = (u2& 0xf000); u |= t1>t2?t1:t2;
488: t1 = (u1& 0xf00); t2 = (u2& 0xf00); u |= t1>t2?t1:t2;
489: t1 = (u1& 0xf0); t2 = (u2& 0xf0); u |= t1>t2?t1:t2;
490: t1 = (u1& 0xf); t2 = (u2& 0xf); u |= t1>t2?t1:t2;
491: d[i] = u;
492: }
493: break;
494: case 6:
495: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
496: u1 = d1[i]; u2 = d2[i];
497: t1 = (u1&0x3f000000); t2 = (u2&0x3f000000); u = t1>t2?t1:t2;
498: t1 = (u1& 0xfc0000); t2 = (u2& 0xfc0000); u |= t1>t2?t1:t2;
499: t1 = (u1& 0x3f000); t2 = (u2& 0x3f000); u |= t1>t2?t1:t2;
500: t1 = (u1& 0xfc0); t2 = (u2& 0xfc0); u |= t1>t2?t1:t2;
501: t1 = (u1& 0x3f); t2 = (u2& 0x3f); u |= t1>t2?t1:t2;
502: d[i] = u;
503: }
504: break;
505: case 8:
506: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
507: u1 = d1[i]; u2 = d2[i];
508: t1 = (u1&0xff000000); t2 = (u2&0xff000000); u = t1>t2?t1:t2;
509: t1 = (u1& 0xff0000); t2 = (u2& 0xff0000); u |= t1>t2?t1:t2;
510: t1 = (u1& 0xff00); t2 = (u2& 0xff00); u |= t1>t2?t1:t2;
511: t1 = (u1& 0xff); t2 = (u2& 0xff); u |= t1>t2?t1:t2;
512: d[i] = u;
513: }
514: break;
515: case 16:
516: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
517: u1 = d1[i]; u2 = d2[i];
518: t1 = (u1&0xffff0000); t2 = (u2&0xffff0000); u = t1>t2?t1:t2;
519: t1 = (u1& 0xffff); t2 = (u2& 0xffff); u |= t1>t2?t1:t2;
520: d[i] = u;
521: }
522: break;
523: case 32:
524: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
525: u1 = d1[i]; u2 = d2[i];
526: d[i] = u1>u2?u1:u2;
527: }
528: break;
529: default:
530: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
531: u1 = d1[i]; u2 = d2[i];
532: for ( j = 0, u = 0; j < nd_epw; j++ ) {
533: t1 = (u1&nd_mask[j]); t2 = (u2&nd_mask[j]); u |= t1>t2?t1:t2;
534: }
535: d[i] = u;
536: }
537: break;
538: }
539: #else
540: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
541: u1 = d1[i]; u2 = d2[i];
542: for ( j = 0, u = 0; j < nd_epw; j++ ) {
543: t1 = (u1&nd_mask[j]); t2 = (u2&nd_mask[j]); u |= t1>t2?t1:t2;
544: }
545: d[i] = u;
546: }
547: #endif
548: if ( nd_module ) MPOS(d) = MPOS(d1);
549: TD(d) = ndl_weight(d);
550: if ( nd_blockmask ) ndl_weight_mask(d);
551: }
552:
553: void ndl_max(UINT *d1,unsigned *d2,UINT *d)
554: {
555: UINT t1,t2,u,u1,u2;
556: int i,j,l;
557:
558: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
559: u1 = d1[i]; u2 = d2[i];
560: for ( j = 0, u = 0; j < nd_epw; j++ ) {
561: t1 = (u1&nd_mask[j]); t2 = (u2&nd_mask[j]); u |= t1>t2?t1:t2;
562: }
563: d[i] = u;
564: }
565: }
566:
567: int ndl_weight(UINT *d)
568: {
569: UINT t,u;
570: int i,j;
571:
572: if ( current_dl_weight_vector )
573: for ( i = 0, t = 0; i < nd_nvar; i++ ) {
574: u = GET_EXP(d,i);
575: t += MUL_WEIGHT(u,i);
576: }
577: else
578: for ( t = 0, i = nd_exporigin; i < nd_wpd; i++ ) {
579: u = d[i];
580: for ( j = 0; j < nd_epw; j++, u>>=nd_bpe )
581: t += (u&nd_mask0);
582: }
1.20 noro 583: if ( nd_module && nd_module_rank && MPOS(d) )
584: t += nd_module_weight[MPOS(d)-1];
585: for ( i = nd_exporigin; i < nd_wpd; i++ )
586: if ( d[i] && !t )
587: printf("afo\n");
1.1 noro 588: return t;
589: }
590:
591: /* for sugarweight */
592:
593: int ndl_weight2(UINT *d)
594: {
595: int t,u;
596: int i,j;
597:
598: for ( i = 0, t = 0; i < nd_nvar; i++ ) {
599: u = GET_EXP(d,i);
600: t += nd_sugarweight[i]*u;
601: }
1.20 noro 602: if ( nd_module && nd_module_rank && MPOS(d) )
603: t += nd_module_weight[MPOS(d)-1];
1.1 noro 604: return t;
605: }
606:
607: void ndl_weight_mask(UINT *d)
608: {
609: UINT t,u;
610: UINT *mask;
611: int i,j,k,l;
612:
613: l = nd_blockmask->n;
614: for ( k = 0; k < l; k++ ) {
615: mask = nd_blockmask->mask[k];
616: if ( current_dl_weight_vector )
617: for ( i = 0, t = 0; i < nd_nvar; i++ ) {
618: u = GET_EXP_MASK(d,i,mask);
619: t += MUL_WEIGHT(u,i);
620: }
621: else
622: for ( t = 0, i = nd_exporigin; i < nd_wpd; i++ ) {
623: u = d[i]&mask[i];
624: for ( j = 0; j < nd_epw; j++, u>>=nd_bpe )
625: t += (u&nd_mask0);
626: }
627: d[k+1] = t;
628: }
629: }
630:
1.21 noro 631: int ndl_glex_compare(UINT *d1,UINT *d2)
632: {
633: if ( TD(d1) > TD(d2) ) return 1;
634: else if ( TD(d1) < TD(d2) ) return -1;
635: else return ndl_lex_compare(d1,d2);
636: }
637:
1.1 noro 638: int ndl_lex_compare(UINT *d1,UINT *d2)
639: {
640: int i;
641:
642: d1 += nd_exporigin;
643: d2 += nd_exporigin;
644: for ( i = nd_exporigin; i < nd_wpd; i++, d1++, d2++ )
645: if ( *d1 > *d2 )
646: return nd_isrlex ? -1 : 1;
647: else if ( *d1 < *d2 )
648: return nd_isrlex ? 1 : -1;
649: return 0;
650: }
651:
652: int ndl_block_compare(UINT *d1,UINT *d2)
653: {
654: int i,l,j,ord_o,ord_l;
655: struct order_pair *op;
656: UINT t1,t2,m;
657: UINT *mask;
658:
659: l = nd_blockmask->n;
660: op = nd_blockmask->order_pair;
661: for ( j = 0; j < l; j++ ) {
662: mask = nd_blockmask->mask[j];
663: ord_o = op[j].order;
664: if ( ord_o < 2 ) {
665: if ( (t1=d1[j+1]) > (t2=d2[j+1]) ) return 1;
666: else if ( t1 < t2 ) return -1;
667: }
668: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
669: m = mask[i];
670: t1 = d1[i]&m;
671: t2 = d2[i]&m;
672: if ( t1 > t2 )
673: return !ord_o ? -1 : 1;
674: else if ( t1 < t2 )
675: return !ord_o ? 1 : -1;
676: }
677: }
678: return 0;
679: }
680:
681: int ndl_matrix_compare(UINT *d1,UINT *d2)
682: {
683: int i,j,s,row;
684: int *v;
685: Z **mat;
686: Z *w;
687: Z t1;
688: Z t,t2;
689:
1.6 noro 690: for ( j = 0; j < nd_nvar; j++ )
691: nd_work_vector[j] = GET_EXP(d1,j)-GET_EXP(d2,j);
1.1 noro 692: if ( nd_top_weight ) {
693: if ( OID(nd_top_weight) == O_VECT ) {
1.6 noro 694: mat = (Z **)&BDY((VECT)nd_top_weight);
695: row = 1;
1.1 noro 696: } else {
697: mat = (Z **)BDY((MAT)nd_top_weight);
1.6 noro 698: row = ((MAT)nd_top_weight)->row;
1.1 noro 699: }
700: for ( i = 0; i < row; i++ ) {
1.6 noro 701: w = mat[i];
1.1 noro 702: for ( j = 0, t = 0; j < nd_nvar; j++ ) {
1.6 noro 703: STOZ(nd_work_vector[j],t1);
1.1 noro 704: mulz(w[j],t1,&t2);
705: addz(t,t2,&t1);
706: t = t1;
707: }
1.6 noro 708: if ( t ) {
709: s = sgnz(t);
1.1 noro 710: if ( s > 0 ) return 1;
711: else if ( s < 0 ) return -1;
1.6 noro 712: }
1.1 noro 713: }
1.6 noro 714: }
715: for ( i = 0; i < nd_matrix_len; i++ ) {
716: v = nd_matrix[i];
717: for ( j = 0, s = 0; j < nd_nvar; j++ )
718: s += v[j]*nd_work_vector[j];
719: if ( s > 0 ) return 1;
720: else if ( s < 0 ) return -1;
721: }
1.1 noro 722: if ( !ndl_equal(d1,d2) )
1.6 noro 723: error("ndl_matrix_compare : invalid matrix");
724: return 0;
1.1 noro 725: }
726:
727: int ndl_composite_compare(UINT *d1,UINT *d2)
728: {
729: int i,j,s,start,end,len,o;
730: int *v;
731: struct sparse_weight *sw;
732:
733: for ( j = 0; j < nd_nvar; j++ )
734: nd_work_vector[j] = GET_EXP(d1,j)-GET_EXP(d2,j);
735: for ( i = 0; i < nd_worb_len; i++ ) {
736: len = nd_worb[i].length;
737: switch ( nd_worb[i].type ) {
738: case IS_DENSE_WEIGHT:
739: v = nd_worb[i].body.dense_weight;
740: for ( j = 0, s = 0; j < len; j++ )
741: s += v[j]*nd_work_vector[j];
742: if ( s > 0 ) return 1;
743: else if ( s < 0 ) return -1;
744: break;
745: case IS_SPARSE_WEIGHT:
746: sw = nd_worb[i].body.sparse_weight;
747: for ( j = 0, s = 0; j < len; j++ )
748: s += sw[j].value*nd_work_vector[sw[j].pos];
749: if ( s > 0 ) return 1;
750: else if ( s < 0 ) return -1;
751: break;
752: case IS_BLOCK:
753: o = nd_worb[i].body.block.order;
754: start = nd_worb[i].body.block.start;
755: switch ( o ) {
756: case 0:
757: end = start+len;
758: for ( j = start, s = 0; j < end; j++ )
759: s += MUL_WEIGHT(nd_work_vector[j],j);
760: if ( s > 0 ) return 1;
761: else if ( s < 0 ) return -1;
762: for ( j = end-1; j >= start; j-- )
763: if ( nd_work_vector[j] < 0 ) return 1;
764: else if ( nd_work_vector[j] > 0 ) return -1;
765: break;
766: case 1:
767: end = start+len;
768: for ( j = start, s = 0; j < end; j++ )
769: s += MUL_WEIGHT(nd_work_vector[j],j);
770: if ( s > 0 ) return 1;
771: else if ( s < 0 ) return -1;
772: for ( j = start; j < end; j++ )
773: if ( nd_work_vector[j] > 0 ) return 1;
774: else if ( nd_work_vector[j] < 0 ) return -1;
775: break;
776: case 2:
777: end = start+len;
778: for ( j = start; j < end; j++ )
779: if ( nd_work_vector[j] > 0 ) return 1;
780: else if ( nd_work_vector[j] < 0 ) return -1;
781: break;
782: }
783: break;
784: }
785: }
786: return 0;
787: }
788:
789: /* TDH -> WW -> TD-> RL */
790:
791: int ndl_ww_lex_compare(UINT *d1,UINT *d2)
792: {
793: int i,m,e1,e2;
794:
795: if ( TD(d1) > TD(d2) ) return 1;
796: else if ( TD(d1) < TD(d2) ) return -1;
797: m = nd_nvar>>1;
798: for ( i = 0, e1 = e2 = 0; i < m; i++ ) {
799: e1 += current_weyl_weight_vector[i]*(GET_EXP(d1,m+i)-GET_EXP(d1,i));
800: e2 += current_weyl_weight_vector[i]*(GET_EXP(d2,m+i)-GET_EXP(d2,i));
801: }
802: if ( e1 > e2 ) return 1;
803: else if ( e1 < e2 ) return -1;
804: return ndl_lex_compare(d1,d2);
805: }
806:
1.21 noro 807: // common function for module glex and grlex comparison
808: int ndl_module_glex_compare(UINT *d1,UINT *d2)
1.1 noro 809: {
1.21 noro 810: int c;
1.1 noro 811:
1.21 noro 812: switch ( nd_module_ordtype ) {
813: case 0:
814: if ( TD(d1) > TD(d2) ) return 1;
815: else if ( TD(d1) < TD(d2) ) return -1;
816: else if ( (c = ndl_lex_compare(d1,d2)) != 0 ) return c;
817: else if ( MPOS(d1) < MPOS(d2) ) return 1;
818: else if ( MPOS(d1) > MPOS(d2) ) return -1;
819: else return 0;
820: break;
1.1 noro 821:
1.21 noro 822: case 1:
1.19 noro 823: if ( nd_pot_nelim && MPOS(d1)>=nd_pot_nelim+1 && MPOS(d2) >= nd_pot_nelim+1 ) {
824: if ( TD(d1) > TD(d2) ) return 1;
825: else if ( TD(d1) < TD(d2) ) return -1;
826: if ( (c = ndl_lex_compare(d1,d2)) != 0 ) return c;
827: if ( MPOS(d1) < MPOS(d2) ) return 1;
828: else if ( MPOS(d1) > MPOS(d2) ) return -1;
829: }
830: if ( MPOS(d1) < MPOS(d2) ) return 1;
831: else if ( MPOS(d1) > MPOS(d2) ) return -1;
1.21 noro 832: else if ( TD(d1) > TD(d2) ) return 1;
833: else if ( TD(d1) < TD(d2) ) return -1;
834: else return ndl_lex_compare(d1,d2);
835: break;
1.1 noro 836:
1.21 noro 837: case 2: // weight -> POT
838: if ( TD(d1) > TD(d2) ) return 1;
839: else if ( TD(d1) < TD(d2) ) return -1;
840: else if ( MPOS(d1) < MPOS(d2) ) return 1;
841: else if ( MPOS(d1) > MPOS(d2) ) return -1;
842: else return ndl_lex_compare(d1,d2);
843: break;
1.1 noro 844:
1.21 noro 845: default:
846: error("ndl_module_glex_compare : invalid module_ordtype");
847: }
1.1 noro 848: }
849:
1.21 noro 850: // common for module comparison
851: int ndl_module_compare(UINT *d1,UINT *d2)
1.1 noro 852: {
1.21 noro 853: int c;
1.1 noro 854:
1.21 noro 855: switch ( nd_module_ordtype ) {
856: case 0:
1.23 noro 857: if ( (c = (*ndl_base_compare_function)(d1,d2)) != 0 ) return c;
1.21 noro 858: else if ( MPOS(d1) > MPOS(d2) ) return -1;
859: else if ( MPOS(d1) < MPOS(d2) ) return 1;
860: else return 0;
861: break;
1.1 noro 862:
1.21 noro 863: case 1:
864: if ( MPOS(d1) < MPOS(d2) ) return 1;
865: else if ( MPOS(d1) > MPOS(d2) ) return -1;
866: else return (*ndl_base_compare_function)(d1,d2);
867: break;
1.1 noro 868:
1.21 noro 869: case 2: // weight -> POT
870: if ( TD(d1) > TD(d2) ) return 1;
871: else if ( TD(d1) < TD(d2) ) return -1;
872: else if ( MPOS(d1) < MPOS(d2) ) return 1;
873: else if ( MPOS(d1) > MPOS(d2) ) return -1;
874: else return (*ndl_base_compare_function)(d1,d2);
875: break;
1.1 noro 876:
1.21 noro 877: default:
878: error("ndl_module_compare : invalid module_ordtype");
879: }
1.1 noro 880: }
881:
1.21 noro 882: extern DMMstack dmm_stack;
883: void _addtodl(int n,DL d1,DL d2);
884: int _eqdl(int n,DL d1,DL d2);
885:
886: int ndl_module_schreyer_compare(UINT *m1,UINT *m2)
887: {
888: int pos1,pos2,t,j;
889: DMM *in;
890: DMMstack s;
891: static DL d1=0;
892: static DL d2=0;
893: static int dlen=0;
894:
895: pos1 = MPOS(m1); pos2 = MPOS(m2);
896: if ( pos1 == pos2 ) return (*ndl_base_compare_function)(m1,m2);
897: if ( nd_nvar > dlen ) {
898: NEWDL(d1,nd_nvar);
899: NEWDL(d2,nd_nvar);
900: dlen = nd_nvar;
901: }
902: d1->td = TD(m1);
903: for ( j = 0; j < nd_nvar; j++ ) d1->d[j] = GET_EXP(m1,j);
904: d2->td = TD(m2);
905: for ( j = 0; j < nd_nvar; j++ ) d2->d[j] = GET_EXP(m2,j);
906: for ( s = dmm_stack; s; s = NEXT(s) ) {
907: in = s->in;
908: _addtodl(nd_nvar,in[pos1]->dl,d1);
909: _addtodl(nd_nvar,in[pos2]->dl,d2);
910: if ( in[pos1]->pos == in[pos2]->pos && _eqdl(nd_nvar,d1,d2)) {
911: if ( pos1 < pos2 ) return 1;
912: else if ( pos1 > pos2 ) return -1;
913: else return 0;
914: }
915: pos1 = in[pos1]->pos;
916: pos2 = in[pos2]->pos;
917: if ( pos1 == pos2 ) return (*dl_base_compare_function)(nd_nvar,d1,d2);
918: }
919: // comparison by the bottom order
920: LAST:
921: switch ( nd_base_ordtype ) {
922: case 0:
923: t = (*dl_base_compare_function)(nd_nvar,d1,d2);
924: if ( t ) return t;
925: else if ( pos1 < pos2 ) return 1;
926: else if ( pos1 > pos2 ) return -1;
927: else return 0;
928: break;
929: case 1:
930: if ( pos1 < pos2 ) return 1;
931: else if ( pos1 > pos2 ) return -1;
932: else return (*dl_base_compare_function)(nd_nvar,d1,d2);
933: break;
934: case 2:
935: if ( d1->td > d2->td ) return 1;
936: else if ( d1->td < d2->td ) return -1;
937: else if ( pos1 < pos2 ) return 1;
938: else if ( pos1 > pos2 ) return -1;
939: else return (*dl_base_compare_function)(nd_nvar,d1,d2);
940: break;
941: default:
942: error("ndl_schreyer_compare : invalid base ordtype");
943: }
1.1 noro 944: }
945:
946: INLINE int ndl_equal(UINT *d1,UINT *d2)
947: {
948: int i;
949:
950: switch ( nd_wpd ) {
951: case 2:
952: if ( TD(d2) != TD(d1) ) return 0;
953: if ( d2[1] != d1[1] ) return 0;
954: return 1;
955: break;
956: case 3:
957: if ( TD(d2) != TD(d1) ) return 0;
958: if ( d2[1] != d1[1] ) return 0;
959: if ( d2[2] != d1[2] ) return 0;
960: return 1;
961: break;
962: default:
963: for ( i = 0; i < nd_wpd; i++ )
964: if ( *d1++ != *d2++ ) return 0;
965: return 1;
966: break;
967: }
968: }
969:
970: INLINE void ndl_copy(UINT *d1,UINT *d2)
971: {
972: int i;
973:
974: switch ( nd_wpd ) {
975: case 2:
976: TD(d2) = TD(d1);
977: d2[1] = d1[1];
978: break;
979: case 3:
980: TD(d2) = TD(d1);
981: d2[1] = d1[1];
982: d2[2] = d1[2];
983: break;
984: default:
985: for ( i = 0; i < nd_wpd; i++ )
986: d2[i] = d1[i];
987: break;
988: }
989: }
990:
991: INLINE void ndl_zero(UINT *d)
992: {
993: int i;
994: for ( i = 0; i < nd_wpd; i++ ) d[i] = 0;
995: }
996:
997: INLINE void ndl_add(UINT *d1,UINT *d2,UINT *d)
998: {
999: int i;
1000:
1001: if ( nd_module ) {
1002: if ( MPOS(d1) && MPOS(d2) && (MPOS(d1) != MPOS(d2)) )
1003: error("ndl_add : invalid operation");
1004: }
1005: #if 1
1006: switch ( nd_wpd ) {
1007: case 2:
1008: TD(d) = TD(d1)+TD(d2);
1009: d[1] = d1[1]+d2[1];
1010: break;
1011: case 3:
1012: TD(d) = TD(d1)+TD(d2);
1013: d[1] = d1[1]+d2[1];
1014: d[2] = d1[2]+d2[2];
1015: break;
1016: default:
1017: for ( i = 0; i < nd_wpd; i++ ) d[i] = d1[i]+d2[i];
1018: break;
1019: }
1020: #else
1021: for ( i = 0; i < nd_wpd; i++ ) d[i] = d1[i]+d2[i];
1022: #endif
1023: }
1024:
1025: /* d1 += d2 */
1026: INLINE void ndl_addto(UINT *d1,UINT *d2)
1027: {
1028: int i;
1029:
1030: if ( nd_module ) {
1031: if ( MPOS(d1) && MPOS(d2) && (MPOS(d1) != MPOS(d2)) )
1032: error("ndl_addto : invalid operation");
1033: }
1034: #if 1
1035: switch ( nd_wpd ) {
1036: case 2:
1037: TD(d1) += TD(d2);
1038: d1[1] += d2[1];
1039: break;
1040: case 3:
1041: TD(d1) += TD(d2);
1042: d1[1] += d2[1];
1043: d1[2] += d2[2];
1044: break;
1045: default:
1046: for ( i = 0; i < nd_wpd; i++ ) d1[i] += d2[i];
1047: break;
1048: }
1049: #else
1050: for ( i = 0; i < nd_wpd; i++ ) d1[i] += d2[i];
1051: #endif
1052: }
1053:
1.24 ! noro 1054: /* d1 -= d2 */
! 1055: INLINE void ndl_subfrom(UINT *d1,UINT *d2)
! 1056: {
! 1057: int i;
! 1058:
! 1059: if ( nd_module ) {
! 1060: if ( MPOS(d1) && MPOS(d2) && (MPOS(d1) != MPOS(d2)) )
! 1061: error("ndl_addto : invalid operation");
! 1062: }
! 1063: #if 1
! 1064: switch ( nd_wpd ) {
! 1065: case 2:
! 1066: TD(d1) -= TD(d2);
! 1067: d1[1] -= d2[1];
! 1068: break;
! 1069: case 3:
! 1070: TD(d1) -= TD(d2);
! 1071: d1[1] -= d2[1];
! 1072: d1[2] -= d2[2];
! 1073: break;
! 1074: default:
! 1075: for ( i = 0; i < nd_wpd; i++ ) d1[i] -= d2[i];
! 1076: break;
! 1077: }
! 1078: #else
! 1079: for ( i = 0; i < nd_wpd; i++ ) d1[i] -= d2[i];
! 1080: #endif
! 1081: }
! 1082:
1.1 noro 1083: INLINE void ndl_sub(UINT *d1,UINT *d2,UINT *d)
1084: {
1085: int i;
1086:
1087: for ( i = 0; i < nd_wpd; i++ ) d[i] = d1[i]-d2[i];
1088: }
1089:
1090: int ndl_disjoint(UINT *d1,UINT *d2)
1091: {
1092: UINT t1,t2,u,u1,u2;
1093: int i,j;
1094:
1095: if ( nd_module && (MPOS(d1) == MPOS(d2)) ) return 0;
1096: #if USE_UNROLL
1097: switch ( nd_bpe ) {
1098: case 3:
1099: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1100: u1 = d1[i]; u2 = d2[i];
1101: t1 = u1&0x38000000; t2 = u2&0x38000000; if ( t1&&t2 ) return 0;
1102: t1 = u1& 0x7000000; t2 = u2& 0x7000000; if ( t1&&t2 ) return 0;
1103: t1 = u1& 0xe00000; t2 = u2& 0xe00000; if ( t1&&t2 ) return 0;
1104: t1 = u1& 0x1c0000; t2 = u2& 0x1c0000; if ( t1&&t2 ) return 0;
1105: t1 = u1& 0x38000; t2 = u2& 0x38000; if ( t1&&t2 ) return 0;
1106: t1 = u1& 0x7000; t2 = u2& 0x7000; if ( t1&&t2 ) return 0;
1107: t1 = u1& 0xe00; t2 = u2& 0xe00; if ( t1&&t2 ) return 0;
1108: t1 = u1& 0x1c0; t2 = u2& 0x1c0; if ( t1&&t2 ) return 0;
1109: t1 = u1& 0x38; t2 = u2& 0x38; if ( t1&&t2 ) return 0;
1110: t1 = u1& 0x7; t2 = u2& 0x7; if ( t1&&t2 ) return 0;
1111: }
1112: return 1;
1113: break;
1114: case 4:
1115: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1116: u1 = d1[i]; u2 = d2[i];
1117: t1 = u1&0xf0000000; t2 = u2&0xf0000000; if ( t1&&t2 ) return 0;
1118: t1 = u1& 0xf000000; t2 = u2& 0xf000000; if ( t1&&t2 ) return 0;
1119: t1 = u1& 0xf00000; t2 = u2& 0xf00000; if ( t1&&t2 ) return 0;
1120: t1 = u1& 0xf0000; t2 = u2& 0xf0000; if ( t1&&t2 ) return 0;
1121: t1 = u1& 0xf000; t2 = u2& 0xf000; if ( t1&&t2 ) return 0;
1122: t1 = u1& 0xf00; t2 = u2& 0xf00; if ( t1&&t2 ) return 0;
1123: t1 = u1& 0xf0; t2 = u2& 0xf0; if ( t1&&t2 ) return 0;
1124: t1 = u1& 0xf; t2 = u2& 0xf; if ( t1&&t2 ) return 0;
1125: }
1126: return 1;
1127: break;
1128: case 6:
1129: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1130: u1 = d1[i]; u2 = d2[i];
1131: t1 = u1&0x3f000000; t2 = u2&0x3f000000; if ( t1&&t2 ) return 0;
1132: t1 = u1& 0xfc0000; t2 = u2& 0xfc0000; if ( t1&&t2 ) return 0;
1133: t1 = u1& 0x3f000; t2 = u2& 0x3f000; if ( t1&&t2 ) return 0;
1134: t1 = u1& 0xfc0; t2 = u2& 0xfc0; if ( t1&&t2 ) return 0;
1135: t1 = u1& 0x3f; t2 = u2& 0x3f; if ( t1&&t2 ) return 0;
1136: }
1137: return 1;
1138: break;
1139: case 8:
1140: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1141: u1 = d1[i]; u2 = d2[i];
1142: t1 = u1&0xff000000; t2 = u2&0xff000000; if ( t1&&t2 ) return 0;
1143: t1 = u1& 0xff0000; t2 = u2& 0xff0000; if ( t1&&t2 ) return 0;
1144: t1 = u1& 0xff00; t2 = u2& 0xff00; if ( t1&&t2 ) return 0;
1145: t1 = u1& 0xff; t2 = u2& 0xff; if ( t1&&t2 ) return 0;
1146: }
1147: return 1;
1148: break;
1149: case 16:
1150: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1151: u1 = d1[i]; u2 = d2[i];
1152: t1 = u1&0xffff0000; t2 = u2&0xffff0000; if ( t1&&t2 ) return 0;
1153: t1 = u1& 0xffff; t2 = u2& 0xffff; if ( t1&&t2 ) return 0;
1154: }
1155: return 1;
1156: break;
1157: case 32:
1158: for ( i = nd_exporigin; i < nd_wpd; i++ )
1159: if ( d1[i] && d2[i] ) return 0;
1160: return 1;
1161: break;
1162: default:
1163: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1164: u1 = d1[i]; u2 = d2[i];
1165: for ( j = 0; j < nd_epw; j++ ) {
1166: if ( (u1&nd_mask0) && (u2&nd_mask0) ) return 0;
1167: u1 >>= nd_bpe; u2 >>= nd_bpe;
1168: }
1169: }
1170: return 1;
1171: break;
1172: }
1173: #else
1174: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1175: u1 = d1[i]; u2 = d2[i];
1176: for ( j = 0; j < nd_epw; j++ ) {
1177: if ( (u1&nd_mask0) && (u2&nd_mask0) ) return 0;
1178: u1 >>= nd_bpe; u2 >>= nd_bpe;
1179: }
1180: }
1181: return 1;
1182: #endif
1183: }
1184:
1185: int ndl_check_bound(UINT *d1,UINT *d2)
1186: {
1187: UINT u2;
1188: int i,j,ind,k;
1189:
1190: ind = 0;
1191: #if USE_UNROLL
1192: switch ( nd_bpe ) {
1193: case 3:
1194: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1195: u2 = d2[i];
1196: if ( d1[ind++]+((u2>>27)&0x7) >= 0x8 ) return 1;
1197: if ( d1[ind++]+((u2>>24)&0x7) >= 0x8 ) return 1;
1198: if ( d1[ind++]+((u2>>21)&0x7) >= 0x8 ) return 1;
1199: if ( d1[ind++]+((u2>>18)&0x7) >= 0x8 ) return 1;
1200: if ( d1[ind++]+((u2>>15)&0x7) >= 0x8 ) return 1;
1201: if ( d1[ind++]+((u2>>12)&0x7) >= 0x8 ) return 1;
1202: if ( d1[ind++]+((u2>>9)&0x7) >= 0x8 ) return 1;
1203: if ( d1[ind++]+((u2>>6)&0x7) >= 0x8 ) return 1;
1204: if ( d1[ind++]+((u2>>3)&0x7) >= 0x8 ) return 1;
1205: if ( d1[ind++]+(u2&0x7) >= 0x8 ) return 1;
1206: }
1207: return 0;
1208: break;
1209: case 4:
1210: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1211: u2 = d2[i];
1212: if ( d1[ind++]+((u2>>28)&0xf) >= 0x10 ) return 1;
1213: if ( d1[ind++]+((u2>>24)&0xf) >= 0x10 ) return 1;
1214: if ( d1[ind++]+((u2>>20)&0xf) >= 0x10 ) return 1;
1215: if ( d1[ind++]+((u2>>16)&0xf) >= 0x10 ) return 1;
1216: if ( d1[ind++]+((u2>>12)&0xf) >= 0x10 ) return 1;
1217: if ( d1[ind++]+((u2>>8)&0xf) >= 0x10 ) return 1;
1218: if ( d1[ind++]+((u2>>4)&0xf) >= 0x10 ) return 1;
1219: if ( d1[ind++]+(u2&0xf) >= 0x10 ) return 1;
1220: }
1221: return 0;
1222: break;
1223: case 6:
1224: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1225: u2 = d2[i];
1226: if ( d1[ind++]+((u2>>24)&0x3f) >= 0x40 ) return 1;
1227: if ( d1[ind++]+((u2>>18)&0x3f) >= 0x40 ) return 1;
1228: if ( d1[ind++]+((u2>>12)&0x3f) >= 0x40 ) return 1;
1229: if ( d1[ind++]+((u2>>6)&0x3f) >= 0x40 ) return 1;
1230: if ( d1[ind++]+(u2&0x3f) >= 0x40 ) return 1;
1231: }
1232: return 0;
1233: break;
1234: case 8:
1235: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1236: u2 = d2[i];
1237: if ( d1[ind++]+((u2>>24)&0xff) >= 0x100 ) return 1;
1238: if ( d1[ind++]+((u2>>16)&0xff) >= 0x100 ) return 1;
1239: if ( d1[ind++]+((u2>>8)&0xff) >= 0x100 ) return 1;
1240: if ( d1[ind++]+(u2&0xff) >= 0x100 ) return 1;
1241: }
1242: return 0;
1243: break;
1244: case 16:
1245: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1246: u2 = d2[i];
1247: if ( d1[ind++]+((u2>>16)&0xffff) > 0x10000 ) return 1;
1248: if ( d1[ind++]+(u2&0xffff) > 0x10000 ) return 1;
1249: }
1250: return 0;
1251: break;
1252: case 32:
1253: for ( i = nd_exporigin; i < nd_wpd; i++ )
1254: if ( d1[i]+d2[i]<d1[i] ) return 1;
1255: return 0;
1256: break;
1257: default:
1258: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1259: u2 = d2[i];
1260: k = (nd_epw-1)*nd_bpe;
1261: for ( j = 0; j < nd_epw; j++, k -= nd_bpe )
1262: if ( d1[ind++]+((u2>>k)&nd_mask0) > nd_mask0 ) return 1;
1263: }
1264: return 0;
1265: break;
1266: }
1267: #else
1268: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1269: u2 = d2[i];
1270: k = (nd_epw-1)*nd_bpe;
1271: for ( j = 0; j < nd_epw; j++, k -= nd_bpe )
1272: if ( d1[ind++]+((u2>>k)&nd_mask0) > nd_mask0 ) return 1;
1273: }
1274: return 0;
1275: #endif
1276: }
1277:
1278: int ndl_check_bound2(int index,UINT *d2)
1279: {
1280: return ndl_check_bound(nd_bound[index],d2);
1281: }
1282:
1283: INLINE int ndl_hash_value(UINT *d)
1284: {
1285: int i;
1.11 noro 1286: UINT r;
1.1 noro 1287:
1288: r = 0;
1289: for ( i = 0; i < nd_wpd; i++ )
1.12 noro 1290: r = (r*1511+d[i]);
1.11 noro 1291: r %= REDTAB_LEN;
1.1 noro 1292: return r;
1293: }
1294:
1295: INLINE int ndl_find_reducer(UINT *dg)
1296: {
1297: RHist r;
1298: int d,k,i;
1299:
1300: d = ndl_hash_value(dg);
1301: for ( r = nd_red[d], k = 0; r; r = NEXT(r), k++ ) {
1302: if ( ndl_equal(dg,DL(r)) ) {
1303: if ( k > 0 ) nd_notfirst++;
1304: nd_found++;
1305: return r->index;
1306: }
1307: }
1308: if ( Reverse )
1309: for ( i = nd_psn-1; i >= 0; i-- ) {
1310: r = nd_psh[i];
1311: if ( ndl_reducible(dg,DL(r)) ) {
1312: nd_create++;
1313: nd_append_red(dg,i);
1314: return i;
1315: }
1316: }
1317: else
1318: for ( i = 0; i < nd_psn; i++ ) {
1319: r = nd_psh[i];
1320: if ( ndl_reducible(dg,DL(r)) ) {
1321: nd_create++;
1322: nd_append_red(dg,i);
1323: return i;
1324: }
1325: }
1326: return -1;
1327: }
1328:
1.24 ! noro 1329: // ret=0,...,nd_psn-1 => reducer found
! 1330: // ret=nd_psn => reducer not found
! 1331: // ret=-1 => singular top reducible
! 1332:
! 1333: int comp_sig(SIG s1,SIG s2);
! 1334: void _ndltodl(UINT *ndl,DL dl);
! 1335:
! 1336: void print_sig(SIG s)
! 1337: {
! 1338: int i;
! 1339:
! 1340: fprintf(asir_out,"<<");
! 1341: for ( i = 0; i < nd_nvar; i++ ) {
! 1342: fprintf(asir_out,"%d",s->dl->d[i]);
! 1343: if ( i != nd_nvar-1 ) fprintf(asir_out,",");
! 1344: }
! 1345: fprintf(asir_out,">>*e%d",s->pos);
! 1346: }
! 1347:
! 1348: INLINE int ndl_find_reducer_s(UINT *dg,SIG sig)
! 1349: {
! 1350: RHist r;
! 1351: int i,singular,ret;
! 1352: static int wpd;
! 1353: static SIG quo;
! 1354: static UINT *tmp;
! 1355:
! 1356: if ( wpd < nd_wpd ) {
! 1357: wpd = nd_wpd;
! 1358: NEWSIG(quo);
! 1359: tmp = (UINT *)MALLOC(wpd*sizeof(UINT));
! 1360: }
! 1361: singular = 0;
! 1362: for ( i = 0; i < nd_psn; i++ ) {
! 1363: r = nd_psh[i];
! 1364: if ( ndl_reducible(dg,DL(r)) ) {
! 1365: ndl_copy(dg,tmp);
! 1366: ndl_subfrom(tmp,DL(r));
! 1367: _ndltodl(tmp,DL(quo));
! 1368: _addtodl(nd_nvar,DL(nd_psh[i]->sig),DL(quo));
! 1369: quo->pos = nd_psh[i]->sig->pos;
! 1370: ret = comp_sig(sig,quo);
! 1371: if ( ret > 0 ) { singular = 0; break; }
! 1372: if ( ret == 0 ) { singular = 1; }
! 1373: }
! 1374: }
! 1375: if ( singular ) return -1;
! 1376: else return i;
! 1377: }
! 1378:
1.1 noro 1379: ND nd_merge(ND p1,ND p2)
1380: {
1381: int n,c;
1382: int t,can,td1,td2;
1383: ND r;
1384: NM m1,m2,mr0,mr,s;
1385:
1386: if ( !p1 ) return p2;
1387: else if ( !p2 ) return p1;
1388: else {
1389: can = 0;
1390: for ( n = NV(p1), m1 = BDY(p1), m2 = BDY(p2), mr0 = 0; m1 && m2; ) {
1391: c = DL_COMPARE(DL(m1),DL(m2));
1392: switch ( c ) {
1393: case 0:
1394: s = m1; m1 = NEXT(m1);
1395: can++; NEXTNM2(mr0,mr,s);
1396: s = m2; m2 = NEXT(m2); FREENM(s);
1397: break;
1398: case 1:
1399: s = m1; m1 = NEXT(m1); NEXTNM2(mr0,mr,s);
1400: break;
1401: case -1:
1402: s = m2; m2 = NEXT(m2); NEXTNM2(mr0,mr,s);
1403: break;
1404: }
1405: }
1406: if ( !mr0 )
1407: if ( m1 ) mr0 = m1;
1408: else if ( m2 ) mr0 = m2;
1409: else return 0;
1410: else if ( m1 ) NEXT(mr) = m1;
1411: else if ( m2 ) NEXT(mr) = m2;
1412: else NEXT(mr) = 0;
1413: BDY(p1) = mr0;
1414: SG(p1) = MAX(SG(p1),SG(p2));
1415: LEN(p1) = LEN(p1)+LEN(p2)-can;
1416: FREEND(p2);
1417: return p1;
1418: }
1419: }
1420:
1421: ND nd_add(int mod,ND p1,ND p2)
1422: {
1423: int n,c;
1424: int t,can,td1,td2;
1425: ND r;
1426: NM m1,m2,mr0,mr,s;
1427:
1.11 noro 1428: Nnd_add++;
1.1 noro 1429: if ( !p1 ) return p2;
1430: else if ( !p2 ) return p1;
1431: else if ( mod == -1 ) return nd_add_sf(p1,p2);
1432: else if ( mod == -2 ) return nd_add_lf(p1,p2);
1433: else if ( !mod ) return nd_add_q(p1,p2);
1434: else {
1435: can = 0;
1436: for ( n = NV(p1), m1 = BDY(p1), m2 = BDY(p2), mr0 = 0; m1 && m2; ) {
1437: c = DL_COMPARE(DL(m1),DL(m2));
1438: switch ( c ) {
1439: case 0:
1440: t = ((CM(m1))+(CM(m2))) - mod;
1441: if ( t < 0 ) t += mod;
1442: s = m1; m1 = NEXT(m1);
1443: if ( t ) {
1444: can++; NEXTNM2(mr0,mr,s); CM(mr) = (t);
1445: } else {
1446: can += 2; FREENM(s);
1447: }
1448: s = m2; m2 = NEXT(m2); FREENM(s);
1449: break;
1450: case 1:
1451: s = m1; m1 = NEXT(m1); NEXTNM2(mr0,mr,s);
1452: break;
1453: case -1:
1454: s = m2; m2 = NEXT(m2); NEXTNM2(mr0,mr,s);
1455: break;
1456: }
1457: }
1458: if ( !mr0 )
1459: if ( m1 ) mr0 = m1;
1460: else if ( m2 ) mr0 = m2;
1461: else return 0;
1462: else if ( m1 ) NEXT(mr) = m1;
1463: else if ( m2 ) NEXT(mr) = m2;
1464: else NEXT(mr) = 0;
1465: BDY(p1) = mr0;
1466: SG(p1) = MAX(SG(p1),SG(p2));
1467: LEN(p1) = LEN(p1)+LEN(p2)-can;
1468: FREEND(p2);
1469: return p1;
1470: }
1471: }
1472:
1473: /* XXX on opteron, the inlined manipulation of destructive additon of
1474: * two NM seems to make gcc optimizer get confused, so the part is
1475: * done in a function.
1476: */
1477:
1478: int nm_destructive_add_q(NM *m1,NM *m2,NM *mr0,NM *mr)
1479: {
1480: NM s;
1481: P t;
1482: int can;
1483:
1484: addp(nd_vc,CP(*m1),CP(*m2),&t);
1485: s = *m1; *m1 = NEXT(*m1);
1486: if ( t ) {
1487: can = 1; NEXTNM2(*mr0,*mr,s); CP(*mr) = (t);
1488: } else {
1489: can = 2; FREENM(s);
1490: }
1491: s = *m2; *m2 = NEXT(*m2); FREENM(s);
1492: return can;
1493: }
1494:
1495: ND nd_add_q(ND p1,ND p2)
1496: {
1497: int n,c,can;
1498: ND r;
1499: NM m1,m2,mr0,mr,s;
1500: P t;
1501:
1502: if ( !p1 ) return p2;
1503: else if ( !p2 ) return p1;
1504: else {
1505: can = 0;
1506: for ( n = NV(p1), m1 = BDY(p1), m2 = BDY(p2), mr0 = 0; m1 && m2; ) {
1507: c = DL_COMPARE(DL(m1),DL(m2));
1508: switch ( c ) {
1509: case 0:
1510: #if defined(__x86_64__)
1511: can += nm_destructive_add_q(&m1,&m2,&mr0,&mr);
1512: #else
1513: addp(nd_vc,CP(m1),CP(m2),&t);
1514: s = m1; m1 = NEXT(m1);
1515: if ( t ) {
1516: can++; NEXTNM2(mr0,mr,s); CP(mr) = (t);
1517: } else {
1518: can += 2; FREENM(s);
1519: }
1520: s = m2; m2 = NEXT(m2); FREENM(s);
1521: #endif
1522: break;
1523: case 1:
1524: s = m1; m1 = NEXT(m1); NEXTNM2(mr0,mr,s);
1525: break;
1526: case -1:
1527: s = m2; m2 = NEXT(m2); NEXTNM2(mr0,mr,s);
1528: break;
1529: }
1530: }
1531: if ( !mr0 )
1532: if ( m1 ) mr0 = m1;
1533: else if ( m2 ) mr0 = m2;
1534: else return 0;
1535: else if ( m1 ) NEXT(mr) = m1;
1536: else if ( m2 ) NEXT(mr) = m2;
1537: else NEXT(mr) = 0;
1538: BDY(p1) = mr0;
1539: SG(p1) = MAX(SG(p1),SG(p2));
1540: LEN(p1) = LEN(p1)+LEN(p2)-can;
1541: FREEND(p2);
1542: return p1;
1543: }
1544: }
1545:
1546: ND nd_add_sf(ND p1,ND p2)
1547: {
1548: int n,c,can;
1549: ND r;
1550: NM m1,m2,mr0,mr,s;
1551: int t;
1552:
1553: if ( !p1 ) return p2;
1554: else if ( !p2 ) return p1;
1555: else {
1556: can = 0;
1557: for ( n = NV(p1), m1 = BDY(p1), m2 = BDY(p2), mr0 = 0; m1 && m2; ) {
1558: c = DL_COMPARE(DL(m1),DL(m2));
1559: switch ( c ) {
1560: case 0:
1561: t = _addsf(CM(m1),CM(m2));
1562: s = m1; m1 = NEXT(m1);
1563: if ( t ) {
1564: can++; NEXTNM2(mr0,mr,s); CM(mr) = (t);
1565: } else {
1566: can += 2; FREENM(s);
1567: }
1568: s = m2; m2 = NEXT(m2); FREENM(s);
1569: break;
1570: case 1:
1571: s = m1; m1 = NEXT(m1); NEXTNM2(mr0,mr,s);
1572: break;
1573: case -1:
1574: s = m2; m2 = NEXT(m2); NEXTNM2(mr0,mr,s);
1575: break;
1576: }
1577: }
1578: if ( !mr0 )
1579: if ( m1 ) mr0 = m1;
1580: else if ( m2 ) mr0 = m2;
1581: else return 0;
1582: else if ( m1 ) NEXT(mr) = m1;
1583: else if ( m2 ) NEXT(mr) = m2;
1584: else NEXT(mr) = 0;
1585: BDY(p1) = mr0;
1586: SG(p1) = MAX(SG(p1),SG(p2));
1587: LEN(p1) = LEN(p1)+LEN(p2)-can;
1588: FREEND(p2);
1589: return p1;
1590: }
1591: }
1592:
1593:
1594: ND nd_reduce2(int mod,ND d,ND g,NDV p,NM mul,NDC dn,Obj *divp)
1595: {
1596: int c,c1,c2;
1597: Z cg,cred,gcd,tq;
1598: P cgp,credp,gcdp;
1599: Obj tr,tr1;
1600:
1601: if ( mod == -1 ) {
1602: CM(mul) = _mulsf(_invsf(HCM(p)),_chsgnsf(HCM(g)));
1603: *divp = (Obj)ONE;
1604: } else if ( mod == -2 ) {
1605: Z inv,t;
1606: divlf(ONE,HCZ(p),&inv);
1607: chsgnlf(HCZ(g),&t);
1608: mullf(inv,t,&CZ(mul));
1609: *divp = (Obj)ONE;
1610: } else if ( mod ) {
1611: c1 = invm(HCM(p),mod); c2 = mod-HCM(g);
1612: DMAR(c1,c2,0,mod,c); CM(mul) = c;
1613: *divp = (Obj)ONE;
1614: } else if ( nd_vc ) {
1615: ezgcdpz(nd_vc,HCP(g),HCP(p),&gcdp);
1616: divsp(nd_vc,HCP(g),gcdp,&cgp); divsp(nd_vc,HCP(p),gcdp,&credp);
1617: chsgnp(cgp,&CP(mul));
1618: nd_mul_c_q(d,credp); nd_mul_c_q(g,credp);
1619: if ( dn ) {
1620: mulr(nd_vc,(Obj)dn->r,(Obj)credp,&tr);
1621: reductr(nd_vc,tr,&tr1); dn->r = (R)tr1;
1622: }
1623: *divp = (Obj)credp;
1624: } else {
1.6 noro 1625: igcd_cofactor(HCZ(g),HCZ(p),&gcd,&cg,&cred);
1626: chsgnz(cg,&CZ(mul));
1.1 noro 1627: nd_mul_c_q(d,(P)cred); nd_mul_c_q(g,(P)cred);
1628: if ( dn ) {
1629: mulz(dn->z,cred,&tq); dn->z = tq;
1630: }
1631: *divp = (Obj)cred;
1632: }
1633: return nd_add(mod,g,ndv_mul_nm(mod,mul,p));
1634: }
1635:
1636: /* ret=1 : success, ret=0 : overflow */
1.6 noro 1637: int nd_nf(int mod,ND d,ND g,NDV *ps,int full,ND *rp)
1.1 noro 1638: {
1639: NM m,mrd,tail;
1640: NM mul;
1641: int n,sugar,psugar,sugar0,stat,index;
1642: int c,c1,c2,dummy;
1643: RHist h;
1644: NDV p,red;
1645: Q cg,cred,gcd,tq,qq;
1646: Z iq;
1647: DP dmul;
1648: NODE node;
1649: LIST hist;
1650: double hmag;
1651: P tp,tp1;
1652: Obj tr,tr1,div;
1653: union oNDC hg;
1654: P cont;
1655:
1656: if ( !g ) {
1657: *rp = d;
1658: return 1;
1659: }
1660: if ( !mod ) hmag = ((double)p_mag(HCP(g)))*nd_scale;
1661:
1662: sugar0 = sugar = SG(g);
1663: n = NV(g);
1664: mul = (NM)MALLOC(sizeof(struct oNM)+(nd_wpd-1)*sizeof(UINT));
1665: if ( d )
1666: for ( tail = BDY(d); NEXT(tail); tail = NEXT(tail) );
1667: for ( ; g; ) {
1668: index = ndl_find_reducer(HDL(g));
1669: if ( index >= 0 ) {
1670: h = nd_psh[index];
1671: ndl_sub(HDL(g),DL(h),DL(mul));
1672: if ( ndl_check_bound2(index,DL(mul)) ) {
1673: nd_free(g); nd_free(d);
1674: return 0;
1675: }
1676: p = nd_demand ? ndv_load(index) : ps[index];
1677: /* d+g -> div*(d+g)+mul*p */
1.6 noro 1678: g = nd_reduce2(mod,d,g,p,mul,0,&div);
1.1 noro 1679: if ( nd_gentrace ) {
1680: /* Trace=[div,index,mul,ONE] */
1.6 noro 1681: STOZ(index,iq);
1.1 noro 1682: nmtodp(mod,mul,&dmul);
1683: node = mknode(4,div,iq,dmul,ONE);
1684: }
1685: sugar = MAX(sugar,SG(p)+TD(DL(mul)));
1686: if ( !mod && g && !nd_vc && ((double)(p_mag(HCP(g))) > hmag) ) {
1687: hg = HCU(g);
1688: nd_removecont2(d,g);
1.6 noro 1689: if ( nd_gentrace ) {
1.1 noro 1690: /* overwrite cont : Trace=[div,index,mul,cont] */
1.6 noro 1691: /* exact division */
1.1 noro 1692: cont = ndc_div(mod,hg,HCU(g));
1693: if ( nd_gentrace && !UNIQ(cont) ) ARG3(node) = (pointer)cont;
1694: }
1695: hmag = ((double)p_mag(HCP(g)))*nd_scale;
1696: }
1697: MKLIST(hist,node);
1698: MKNODE(node,hist,nd_tracelist); nd_tracelist = node;
1699: } else if ( !full ) {
1700: *rp = g;
1701: return 1;
1702: } else {
1703: m = BDY(g);
1704: if ( NEXT(m) ) {
1705: BDY(g) = NEXT(m); NEXT(m) = 0; LEN(g)--;
1706: } else {
1707: FREEND(g); g = 0;
1708: }
1709: if ( d ) {
1710: NEXT(tail)=m; tail=m; LEN(d)++;
1711: } else {
1712: MKND(n,m,1,d); tail = BDY(d);
1713: }
1714: }
1715: }
1716: if ( d ) SG(d) = sugar;
1717: *rp = d;
1718: return 1;
1719: }
1720:
1.24 ! noro 1721: // ret=1 => success
! 1722: // ret=0 => overflow
! 1723: // ret=-1 => singular top reducible
! 1724:
! 1725: int nd_nf_s(int mod,ND d,ND g,NDV *ps,int full,ND *rp)
! 1726: {
! 1727: NM m,mrd,tail;
! 1728: NM mul;
! 1729: int n,sugar,psugar,sugar0,stat,index;
! 1730: int c,c1,c2,dummy;
! 1731: RHist h;
! 1732: NDV p,red;
! 1733: Q cg,cred,gcd,tq,qq;
! 1734: Z iq;
! 1735: DP dmul;
! 1736: NODE node;
! 1737: LIST hist;
! 1738: double hmag;
! 1739: P tp,tp1;
! 1740: Obj tr,tr1,div;
! 1741: union oNDC hg;
! 1742: P cont;
! 1743: SIG sig;
! 1744:
! 1745: if ( !g ) {
! 1746: *rp = d;
! 1747: return 1;
! 1748: }
! 1749: if ( !mod ) hmag = ((double)p_mag(HCP(g)))*nd_scale;
! 1750:
! 1751: sugar0 = sugar = SG(g);
! 1752: n = NV(g);
! 1753: mul = (NM)MALLOC(sizeof(struct oNM)+(nd_wpd-1)*sizeof(UINT));
! 1754: if ( d )
! 1755: for ( tail = BDY(d); NEXT(tail); tail = NEXT(tail) );
! 1756: sig = g->sig;
! 1757: for ( ; g; ) {
! 1758: index = ndl_find_reducer_s(HDL(g),sig);
! 1759: if ( index >= 0 && index < nd_psn ) {
! 1760: // reducer found
! 1761: h = nd_psh[index];
! 1762: ndl_sub(HDL(g),DL(h),DL(mul));
! 1763: if ( ndl_check_bound2(index,DL(mul)) ) {
! 1764: nd_free(g); nd_free(d);
! 1765: return 0;
! 1766: }
! 1767: p = ps[index];
! 1768: /* d+g -> div*(d+g)+mul*p */
! 1769: g = nd_reduce2(mod,d,g,p,mul,0,&div);
! 1770: sugar = MAX(sugar,SG(p)+TD(DL(mul)));
! 1771: if ( !mod && g && ((double)(p_mag(HCP(g))) > hmag) ) {
! 1772: hg = HCU(g);
! 1773: nd_removecont2(d,g);
! 1774: hmag = ((double)p_mag(HCP(g)))*nd_scale;
! 1775: }
! 1776: } else if ( index == -1 ) {
! 1777: // singular top reducible
! 1778: return -1;
! 1779: } else if ( !full ) {
! 1780: *rp = g;
! 1781: g->sig = sig;
! 1782: return 1;
! 1783: } else {
! 1784: m = BDY(g);
! 1785: if ( NEXT(m) ) {
! 1786: BDY(g) = NEXT(m); NEXT(m) = 0; LEN(g)--;
! 1787: } else {
! 1788: FREEND(g); g = 0;
! 1789: }
! 1790: if ( d ) {
! 1791: NEXT(tail)=m; tail=m; LEN(d)++;
! 1792: } else {
! 1793: MKND(n,m,1,d); tail = BDY(d);
! 1794: }
! 1795: }
! 1796: }
! 1797: if ( d ) {
! 1798: SG(d) = sugar;
! 1799: d->sig = sig;
! 1800: }
! 1801: *rp = d;
! 1802: return 1;
! 1803: }
! 1804:
1.1 noro 1805: int nd_nf_pbucket(int mod,ND g,NDV *ps,int full,ND *rp)
1806: {
1807: int hindex,index;
1808: NDV p;
1809: ND u,d,red;
1810: NODE l;
1811: NM mul,m,mrd,tail;
1812: int sugar,psugar,n,h_reducible;
1813: PGeoBucket bucket;
1814: int c,c1,c2;
1815: Z cg,cred,gcd,zzz;
1816: RHist h;
1817: double hmag,gmag;
1818: int count = 0;
1819: int hcount = 0;
1820:
1821: if ( !g ) {
1822: *rp = 0;
1823: return 1;
1824: }
1825: sugar = SG(g);
1826: n = NV(g);
1.6 noro 1827: if ( !mod ) hmag = ((double)p_mag((P)HCZ(g)))*nd_scale;
1.1 noro 1828: bucket = create_pbucket();
1829: add_pbucket(mod,bucket,g);
1830: d = 0;
1831: mul = (NM)MALLOC(sizeof(struct oNM)+(nd_wpd-1)*sizeof(UINT));
1832: while ( 1 ) {
1833: if ( mod > 0 || mod == -1 )
1834: hindex = head_pbucket(mod,bucket);
1835: else if ( mod == -2 )
1836: hindex = head_pbucket_lf(bucket);
1837: else
1838: hindex = head_pbucket_q(bucket);
1839: if ( hindex < 0 ) {
1840: if ( DP_Print > 3 ) printf("(%d %d)",count,hcount);
1841: if ( d ) SG(d) = sugar;
1842: *rp = d;
1843: return 1;
1844: }
1845: g = bucket->body[hindex];
1846: index = ndl_find_reducer(HDL(g));
1847: if ( index >= 0 ) {
1848: count++;
1849: if ( !d ) hcount++;
1850: h = nd_psh[index];
1851: ndl_sub(HDL(g),DL(h),DL(mul));
1852: if ( ndl_check_bound2(index,DL(mul)) ) {
1853: nd_free(d);
1854: free_pbucket(bucket);
1855: *rp = 0;
1856: return 0;
1857: }
1858: p = ps[index];
1859: if ( mod == -1 )
1860: CM(mul) = _mulsf(_invsf(HCM(p)),_chsgnsf(HCM(g)));
1861: else if ( mod == -2 ) {
1862: Z inv,t;
1863: divlf(ONE,HCZ(p),&inv);
1864: chsgnlf(HCZ(g),&t);
1865: mullf(inv,t,&CZ(mul));
1866: } else if ( mod ) {
1867: c1 = invm(HCM(p),mod); c2 = mod-HCM(g);
1868: DMAR(c1,c2,0,mod,c); CM(mul) = c;
1869: } else {
1.6 noro 1870: igcd_cofactor(HCZ(g),HCZ(p),&gcd,&cg,&cred);
1871: chsgnz(cg,&CZ(mul));
1.1 noro 1872: nd_mul_c_q(d,(P)cred);
1873: mulq_pbucket(bucket,cred);
1874: g = bucket->body[hindex];
1.6 noro 1875: gmag = (double)p_mag((P)HCZ(g));
1.1 noro 1876: }
1877: red = ndv_mul_nm(mod,mul,p);
1878: bucket->body[hindex] = nd_remove_head(g);
1879: red = nd_remove_head(red);
1880: add_pbucket(mod,bucket,red);
1881: psugar = SG(p)+TD(DL(mul));
1882: sugar = MAX(sugar,psugar);
1883: if ( !mod && hmag && (gmag > hmag) ) {
1884: g = normalize_pbucket(mod,bucket);
1885: if ( !g ) {
1886: if ( d ) SG(d) = sugar;
1887: *rp = d;
1888: return 1;
1889: }
1890: nd_removecont2(d,g);
1.6 noro 1891: hmag = ((double)p_mag((P)HCZ(g)))*nd_scale;
1.1 noro 1892: add_pbucket(mod,bucket,g);
1893: }
1894: } else if ( !full ) {
1895: g = normalize_pbucket(mod,bucket);
1896: if ( g ) SG(g) = sugar;
1897: *rp = g;
1898: return 1;
1899: } else {
1900: m = BDY(g);
1901: if ( NEXT(m) ) {
1902: BDY(g) = NEXT(m); NEXT(m) = 0; LEN(g)--;
1903: } else {
1904: FREEND(g); g = 0;
1905: }
1906: bucket->body[hindex] = g;
1907: NEXT(m) = 0;
1908: if ( d ) {
1909: NEXT(tail)=m; tail=m; LEN(d)++;
1910: } else {
1911: MKND(n,m,1,d); tail = BDY(d);
1912: }
1913: }
1914: }
1915: }
1916:
1917: /* input : list of NDV, cand : list of NDV */
1918:
1919: int ndv_check_membership(int m,NODE input,int obpe,int oadv,EPOS oepos,NODE cand)
1920: {
1921: int n,i,stat;
1922: ND nf,d;
1923: NDV r;
1924: NODE t,s;
1925: union oNDC dn;
1926: Z q;
1927: LIST list;
1928:
1.24 ! noro 1929: ndv_setup(m,0,cand,nd_gentrace?1:0,1,0);
1.1 noro 1930: n = length(cand);
1931:
1932: if ( nd_gentrace ) { nd_alltracelist = 0; nd_tracelist = 0; }
1933: /* membercheck : list is a subset of Id(cand) ? */
1934: for ( t = input, i = 0; t; t = NEXT(t), i++ ) {
1935: again:
1936: nd_tracelist = 0;
1937: if ( nd_bpe > obpe )
1938: r = ndv_dup_realloc((NDV)BDY(t),obpe,oadv,oepos);
1939: else
1940: r = (NDV)BDY(t);
1941: #if 0
1942: // moved to nd_f4_lf_trace()
1943: if ( m == -2 ) ndv_mod(m,r);
1944: #endif
1945: d = ndvtond(m,r);
1.6 noro 1946: stat = nd_nf(m,0,d,nd_ps,0,&nf);
1.1 noro 1947: if ( !stat ) {
1948: nd_reconstruct(0,0);
1949: goto again;
1950: } else if ( nf ) return 0;
1951: if ( nd_gentrace ) {
1952: nd_tracelist = reverse_node(nd_tracelist);
1953: MKLIST(list,nd_tracelist);
1.6 noro 1954: STOZ(i,q); s = mknode(2,q,list); MKLIST(list,s);
1.1 noro 1955: MKNODE(s,list,nd_alltracelist);
1956: nd_alltracelist = s; nd_tracelist = 0;
1957: }
1958: if ( DP_Print ) { printf("."); fflush(stdout); }
1959: }
1960: if ( DP_Print ) { printf("\n"); }
1961: return 1;
1962: }
1963:
1964: ND nd_remove_head(ND p)
1965: {
1966: NM m;
1967:
1968: m = BDY(p);
1969: if ( !NEXT(m) ) {
1970: FREEND(p); p = 0;
1971: } else {
1972: BDY(p) = NEXT(m); LEN(p)--;
1973: }
1974: FREENM(m);
1975: return p;
1976: }
1977:
1978: ND nd_separate_head(ND p,ND *head)
1979: {
1980: NM m,m0;
1981: ND r;
1982:
1983: m = BDY(p);
1984: if ( !NEXT(m) ) {
1985: *head = p; p = 0;
1986: } else {
1987: m0 = m;
1988: BDY(p) = NEXT(m); LEN(p)--;
1989: NEXT(m0) = 0;
1990: MKND(NV(p),m0,1,r);
1991: *head = r;
1992: }
1993: return p;
1994: }
1995:
1996: PGeoBucket create_pbucket()
1997: {
1998: PGeoBucket g;
1999:
2000: g = CALLOC(1,sizeof(struct oPGeoBucket));
2001: g->m = -1;
2002: return g;
2003: }
2004:
2005: void free_pbucket(PGeoBucket b) {
2006: int i;
2007:
2008: for ( i = 0; i <= b->m; i++ )
2009: if ( b->body[i] ) {
2010: nd_free(b->body[i]);
2011: b->body[i] = 0;
2012: }
2013: GCFREE(b);
2014: }
2015:
2016: void add_pbucket_symbolic(PGeoBucket g,ND d)
2017: {
2018: int l,i,k,m;
2019:
2020: if ( !d )
2021: return;
2022: l = LEN(d);
2023: for ( k = 0, m = 1; l > m; k++, m <<= 1 );
2024: /* 2^(k-1) < l <= 2^k (=m) */
2025: d = nd_merge(g->body[k],d);
2026: for ( ; d && LEN(d) > m; k++, m <<= 1 ) {
2027: g->body[k] = 0;
2028: d = nd_merge(g->body[k+1],d);
2029: }
2030: g->body[k] = d;
2031: g->m = MAX(g->m,k);
2032: }
2033:
2034: void add_pbucket(int mod,PGeoBucket g,ND d)
2035: {
2036: int l,i,k,m;
2037:
2038: if ( !d )
2039: return;
2040: l = LEN(d);
2041: for ( k = 0, m = 1; l > m; k++, m <<= 1 );
2042: /* 2^(k-1) < l <= 2^k (=m) */
2043: d = nd_add(mod,g->body[k],d);
2044: for ( ; d && LEN(d) > m; k++, m <<= 1 ) {
2045: g->body[k] = 0;
2046: d = nd_add(mod,g->body[k+1],d);
2047: }
2048: g->body[k] = d;
2049: g->m = MAX(g->m,k);
2050: }
2051:
2052: void mulq_pbucket(PGeoBucket g,Z c)
2053: {
2054: int k;
2055:
2056: for ( k = 0; k <= g->m; k++ )
2057: nd_mul_c_q(g->body[k],(P)c);
2058: }
2059:
2060: NM remove_head_pbucket_symbolic(PGeoBucket g)
2061: {
2062: int j,i,k,c;
2063: NM head;
2064:
2065: k = g->m;
2066: j = -1;
2067: for ( i = 0; i <= k; i++ ) {
2068: if ( !g->body[i] ) continue;
2069: if ( j < 0 ) j = i;
2070: else {
2071: c = DL_COMPARE(HDL(g->body[i]),HDL(g->body[j]));
2072: if ( c > 0 )
2073: j = i;
2074: else if ( c == 0 )
2075: g->body[i] = nd_remove_head(g->body[i]);
2076: }
2077: }
2078: if ( j < 0 ) return 0;
2079: else {
2080: head = BDY(g->body[j]);
2081: if ( !NEXT(head) ) {
2082: FREEND(g->body[j]);
2083: g->body[j] = 0;
2084: } else {
2085: BDY(g->body[j]) = NEXT(head);
2086: LEN(g->body[j])--;
2087: }
2088: return head;
2089: }
2090: }
2091:
2092: int head_pbucket(int mod,PGeoBucket g)
2093: {
2094: int j,i,c,k,nv,sum;
2095: UINT *di,*dj;
2096: ND gi,gj;
2097:
2098: k = g->m;
2099: while ( 1 ) {
2100: j = -1;
2101: for ( i = 0; i <= k; i++ ) {
2102: if ( !(gi = g->body[i]) )
2103: continue;
2104: if ( j < 0 ) {
2105: j = i;
2106: gj = g->body[j];
2107: dj = HDL(gj);
2108: sum = HCM(gj);
2109: } else {
2110: c = DL_COMPARE(HDL(gi),dj);
2111: if ( c > 0 ) {
2112: if ( sum ) HCM(gj) = sum;
2113: else g->body[j] = nd_remove_head(gj);
2114: j = i;
2115: gj = g->body[j];
2116: dj = HDL(gj);
2117: sum = HCM(gj);
2118: } else if ( c == 0 ) {
2119: if ( mod == -1 )
2120: sum = _addsf(sum,HCM(gi));
2121: else {
2122: sum = sum+HCM(gi)-mod;
2123: if ( sum < 0 ) sum += mod;
2124: }
2125: g->body[i] = nd_remove_head(gi);
2126: }
2127: }
2128: }
2129: if ( j < 0 ) return -1;
2130: else if ( sum ) {
2131: HCM(gj) = sum;
2132: return j;
2133: } else
2134: g->body[j] = nd_remove_head(gj);
2135: }
2136: }
2137:
2138: int head_pbucket_q(PGeoBucket g)
2139: {
2140: int j,i,c,k,nv;
2141: Z sum,t;
2142: ND gi,gj;
2143:
2144: k = g->m;
2145: while ( 1 ) {
2146: j = -1;
2147: for ( i = 0; i <= k; i++ ) {
2148: if ( !(gi = g->body[i]) ) continue;
2149: if ( j < 0 ) {
2150: j = i;
2151: gj = g->body[j];
1.6 noro 2152: sum = HCZ(gj);
1.1 noro 2153: } else {
2154: nv = NV(gi);
2155: c = DL_COMPARE(HDL(gi),HDL(gj));
2156: if ( c > 0 ) {
1.6 noro 2157: if ( sum ) HCZ(gj) = sum;
1.1 noro 2158: else g->body[j] = nd_remove_head(gj);
2159: j = i;
2160: gj = g->body[j];
1.6 noro 2161: sum = HCZ(gj);
1.1 noro 2162: } else if ( c == 0 ) {
1.6 noro 2163: addz(sum,HCZ(gi),&t);
1.1 noro 2164: sum = t;
2165: g->body[i] = nd_remove_head(gi);
2166: }
2167: }
2168: }
2169: if ( j < 0 ) return -1;
2170: else if ( sum ) {
1.6 noro 2171: HCZ(gj) = sum;
1.1 noro 2172: return j;
2173: } else
2174: g->body[j] = nd_remove_head(gj);
2175: }
2176: }
2177:
2178: int head_pbucket_lf(PGeoBucket g)
2179: {
2180: int j,i,c,k,nv;
2181: Z sum,t;
2182: ND gi,gj;
2183:
2184: k = g->m;
2185: while ( 1 ) {
2186: j = -1;
2187: for ( i = 0; i <= k; i++ ) {
2188: if ( !(gi = g->body[i]) ) continue;
2189: if ( j < 0 ) {
2190: j = i;
2191: gj = g->body[j];
2192: sum = HCZ(gj);
2193: } else {
2194: nv = NV(gi);
2195: c = DL_COMPARE(HDL(gi),HDL(gj));
2196: if ( c > 0 ) {
2197: if ( sum ) HCZ(gj) = sum;
2198: else g->body[j] = nd_remove_head(gj);
2199: j = i;
2200: gj = g->body[j];
2201: sum = HCZ(gj);
2202: } else if ( c == 0 ) {
2203: addlf(sum,HCZ(gi),&t);
2204: sum = t;
2205: g->body[i] = nd_remove_head(gi);
2206: }
2207: }
2208: }
2209: if ( j < 0 ) return -1;
2210: else if ( sum ) {
2211: HCZ(gj) = sum;
2212: return j;
2213: } else
2214: g->body[j] = nd_remove_head(gj);
2215: }
2216: }
2217:
2218: ND normalize_pbucket(int mod,PGeoBucket g)
2219: {
2220: int i;
2221: ND r,t;
2222:
2223: r = 0;
2224: for ( i = 0; i <= g->m; i++ ) {
2225: r = nd_add(mod,r,g->body[i]);
2226: g->body[i] = 0;
2227: }
2228: g->m = -1;
2229: return r;
2230: }
2231:
2232: #if 0
2233: void register_hcf(NDV p)
2234: {
2235: DCP dc,t;
2236: P hc,h;
2237: int c;
2238: NODE l,l1,prev;
2239:
2240: hc = p->body->c.p;
2241: if ( !nd_vc || NUM(hc) ) return;
2242: fctrp(nd_vc,hc,&dc);
2243: for ( t = dc; t; t = NEXT(t) ) {
2244: h = t->c;
2245: if ( NUM(h) ) continue;
2246: for ( prev = 0, l = nd_hcf; l; prev = l, l = NEXT(l) ) {
2247: c = compp(nd_vc,h,(P)BDY(l));
2248: if ( c >= 0 ) break;
2249: }
2250: if ( !l || c > 0 ) {
2251: MKNODE(l1,h,l);
2252: if ( !prev )
2253: nd_hcf = l1;
2254: else
2255: NEXT(prev) = l1;
2256: }
2257: }
2258: }
2259: #else
2260: void register_hcf(NDV p)
2261: {
2262: DCP dc,t;
2263: P hc,h,q;
2264: Q dmy;
2265: int c;
2266: NODE l,l1,prev;
2267:
2268: hc = p->body->c.p;
2269: if ( NUM(hc) ) return;
2270: ptozp(hc,1,&dmy,&h);
2271: #if 1
2272: for ( l = nd_hcf; l; l = NEXT(l) ) {
2273: while ( 1 ) {
2274: if ( divtpz(nd_vc,h,(P)BDY(l),&q) ) h = q;
2275: else break;
2276: }
2277: }
2278: if ( NUM(h) ) return;
2279: #endif
2280: for ( prev = 0, l = nd_hcf; l; prev = l, l = NEXT(l) ) {
2281: c = compp(nd_vc,h,(P)BDY(l));
2282: if ( c >= 0 ) break;
2283: }
2284: if ( !l || c > 0 ) {
2285: MKNODE(l1,h,l);
2286: if ( !prev )
2287: nd_hcf = l1;
2288: else
2289: NEXT(prev) = l1;
2290: }
2291: }
2292: #endif
2293:
2294: int do_diagonalize(int sugar,int m)
2295: {
1.6 noro 2296: int i,nh,stat;
2297: NODE r,g,t;
2298: ND h,nf,s,head;
2299: NDV nfv;
2300: Q q;
2301: P nm,nmp,dn,mnp,dnp,cont,cont1;
2302: union oNDC hc;
2303: NODE node;
2304: LIST l;
2305: Z iq;
1.1 noro 2306:
1.6 noro 2307: for ( i = nd_psn-1; i >= 0 && SG(nd_psh[i]) == sugar; i-- ) {
2308: if ( nd_gentrace ) {
2309: /* Trace = [1,index,1,1] */
2310: STOZ(i,iq); node = mknode(4,ONE,iq,ONE,ONE);
2311: MKLIST(l,node); MKNODE(nd_tracelist,l,0);
2312: }
2313: if ( nd_demand )
2314: nfv = ndv_load(i);
2315: else
2316: nfv = nd_ps[i];
2317: s = ndvtond(m,nfv);
2318: s = nd_separate_head(s,&head);
2319: stat = nd_nf(m,head,s,nd_ps,1,&nf);
2320: if ( !stat ) return 0;
2321: ndv_free(nfv);
2322: hc = HCU(nf); nd_removecont(m,nf);
2323: /* exact division */
2324: cont = ndc_div(m,hc,HCU(nf));
1.1 noro 2325: if ( nd_gentrace ) finalize_tracelist(i,cont);
1.6 noro 2326: nfv = ndtondv(m,nf);
2327: nd_free(nf);
2328: nd_bound[i] = ndv_compute_bound(nfv);
2329: if ( !m ) register_hcf(nfv);
2330: if ( nd_demand ) {
2331: ndv_save(nfv,i);
2332: ndv_free(nfv);
2333: } else
2334: nd_ps[i] = nfv;
2335: }
2336: return 1;
1.1 noro 2337: }
2338:
2339: LIST compute_splist()
2340: {
2341: NODE g,tn0,tn,node;
2342: LIST l0;
2343: ND_pairs d,t;
2344: int i;
2345: Z i1,i2;
2346:
2347: g = 0; d = 0;
2348: for ( i = 0; i < nd_psn; i++ ) {
2349: d = update_pairs(d,g,i,0);
2350: g = update_base(g,i);
2351: }
2352: for ( t = d, tn0 = 0; t; t = NEXT(t) ) {
2353: NEXTNODE(tn0,tn);
1.6 noro 2354: STOZ(t->i1,i1); STOZ(t->i2,i2);
1.1 noro 2355: node = mknode(2,i1,i2); MKLIST(l0,node);
2356: BDY(tn) = l0;
2357: }
2358: if ( tn0 ) NEXT(tn) = 0; MKLIST(l0,tn0);
2359: return l0;
2360: }
2361:
2362: /* return value = 0 => input is not a GB */
2363:
2364: NODE nd_gb(int m,int ishomo,int checkonly,int gensyz,int **indp)
2365: {
1.6 noro 2366: int i,nh,sugar,stat;
2367: NODE r,g,t;
2368: ND_pairs d;
2369: ND_pairs l;
2370: ND h,nf,s,head,nf1;
2371: NDV nfv;
2372: Z q;
2373: union oNDC dn,hc;
2374: int diag_count = 0;
2375: P cont;
2376: LIST list;
2377:
1.11 noro 2378: Nnd_add = 0;
1.6 noro 2379: g = 0; d = 0;
2380: for ( i = 0; i < nd_psn; i++ ) {
2381: d = update_pairs(d,g,i,gensyz);
2382: g = update_base(g,i);
2383: }
2384: sugar = 0;
2385: while ( d ) {
1.1 noro 2386: again:
1.6 noro 2387: l = nd_minp(d,&d);
2388: if ( MaxDeg > 0 && SG(l) > MaxDeg ) break;
2389: if ( SG(l) != sugar ) {
2390: if ( ishomo ) {
2391: diag_count = 0;
2392: stat = do_diagonalize(sugar,m);
1.1 noro 2393: if ( !stat ) {
1.6 noro 2394: NEXT(l) = d; d = l;
2395: d = nd_reconstruct(0,d);
2396: goto again;
1.1 noro 2397: }
1.6 noro 2398: }
2399: sugar = SG(l);
2400: if ( DP_Print ) fprintf(asir_out,"%d",sugar);
2401: }
2402: stat = nd_sp(m,0,l,&h);
2403: if ( !stat ) {
2404: NEXT(l) = d; d = l;
2405: d = nd_reconstruct(0,d);
2406: goto again;
2407: }
1.1 noro 2408: #if USE_GEOBUCKET
1.6 noro 2409: stat = (m&&!nd_gentrace)?nd_nf_pbucket(m,h,nd_ps,!Top,&nf)
2410: :nd_nf(m,0,h,nd_ps,!Top,&nf);
1.1 noro 2411: #else
1.6 noro 2412: stat = nd_nf(m,0,h,nd_ps,!Top,&nf);
1.1 noro 2413: #endif
1.6 noro 2414: if ( !stat ) {
2415: NEXT(l) = d; d = l;
2416: d = nd_reconstruct(0,d);
2417: goto again;
2418: } else if ( nf ) {
2419: if ( checkonly || gensyz ) return 0;
1.1 noro 2420: if ( nd_newelim ) {
2421: if ( nd_module ) {
2422: if ( MPOS(HDL(nf)) > 1 ) return 0;
2423: } else if ( !(HDL(nf)[nd_exporigin] & nd_mask[0]) ) return 0;
2424: }
1.6 noro 2425: if ( DP_Print ) { printf("+"); fflush(stdout); }
2426: hc = HCU(nf);
2427: nd_removecont(m,nf);
2428: if ( !m && nd_nalg ) {
2429: nd_monic(0,&nf);
2430: nd_removecont(m,nf);
2431: }
2432: if ( nd_gentrace ) {
2433: /* exact division */
1.1 noro 2434: cont = ndc_div(m,hc,HCU(nf));
2435: if ( m || !UNIQ(cont) ) {
1.6 noro 2436: t = mknode(4,NULLP,NULLP,NULLP,cont);
2437: MKLIST(list,t); MKNODE(t,list,nd_tracelist);
1.1 noro 2438: nd_tracelist = t;
2439: }
2440: }
1.6 noro 2441: nfv = ndtondv(m,nf); nd_free(nf);
1.24 ! noro 2442: nh = ndv_newps(m,nfv,0);
1.6 noro 2443: if ( !m && (ishomo && ++diag_count == diag_period) ) {
2444: diag_count = 0;
2445: stat = do_diagonalize(sugar,m);
2446: if ( !stat ) {
2447: NEXT(l) = d; d = l;
2448: d = nd_reconstruct(1,d);
2449: goto again;
1.1 noro 2450: }
1.6 noro 2451: }
2452: d = update_pairs(d,g,nh,0);
2453: g = update_base(g,nh);
2454: FREENDP(l);
2455: } else {
2456: if ( nd_gentrace && gensyz ) {
2457: nd_tracelist = reverse_node(nd_tracelist);
2458: MKLIST(list,nd_tracelist);
2459: STOZ(-1,q); t = mknode(2,q,list); MKLIST(list,t);
2460: MKNODE(t,list,nd_alltracelist);
2461: nd_alltracelist = t; nd_tracelist = 0;
2462: }
2463: if ( DP_Print ) { printf("."); fflush(stdout); }
2464: FREENDP(l);
2465: }
2466: }
2467: conv_ilist(nd_demand,0,g,indp);
1.11 noro 2468: if ( !checkonly && DP_Print ) { printf("nd_gb done. Number of nd_add=%d\n",Nnd_add); fflush(stdout); }
1.1 noro 2469: return g;
2470: }
2471:
1.24 ! noro 2472: ND_pairs update_pairs_s(ND_pairs d,NODE g,int t,NODE syz);
! 2473: ND_pairs nd_newpairs_s( NODE g, int t ,NODE syz);
! 2474:
! 2475: int nd_nf_pbucket_s(int mod,ND g,NDV *ps,int full,ND *nf);
! 2476: int nd_nf_s(int mod,ND d,ND g,NDV *ps,int full,ND *nf);
! 2477:
! 2478: void _copydl(int n,DL d1,DL d2);
! 2479: void _subfromdl(int n,DL d1,DL d2);
! 2480: extern int (*cmpdl)(int n,DL d1,DL d2);
! 2481:
! 2482: NODE insert_sig(NODE l,SIG s)
! 2483: {
! 2484: int pos;
! 2485: DL sig;
! 2486: struct oNODE root;
! 2487: NODE p,prev,r;
! 2488: SIG t;
! 2489:
! 2490: pos = s->pos; sig = DL(s);
! 2491: root.next = l; prev = &root;
! 2492: for ( p = l; p; p = p->next ) {
! 2493: t = (SIG)p->body;
! 2494: if ( t->pos == pos ) {
! 2495: if ( _dl_redble(DL(t),sig,nd_nvar) )
! 2496: return root.next;
! 2497: else if ( _dl_redble(sig,DL(t),nd_nvar) )
! 2498: // remove p
! 2499: prev->next = p->next;
! 2500: } else
! 2501: prev = p;
! 2502: }
! 2503: NEWNODE(r); r->body = (pointer)s;
! 2504: r->next = root.next;
! 2505: return r;
! 2506: }
! 2507:
! 2508: ND_pairs remove_spair_s(ND_pairs d,SIG sig)
! 2509: {
! 2510: struct oND_pairs root;
! 2511: ND_pairs prev,p;
! 2512: SIG spsig;
! 2513:
! 2514: root.next = d;
! 2515: prev = &root; p = d;
! 2516: while ( p ) {
! 2517: spsig = p->sig;
! 2518: if ( sig->pos == spsig->pos && _dl_redble(DL(sig),DL(spsig),nd_nvar) )
! 2519: // remove p
! 2520: prev->next = p->next;
! 2521: else
! 2522: prev = p;
! 2523: p = p->next;
! 2524: }
! 2525: return (ND_pairs)root.next;
! 2526: }
! 2527:
! 2528: NODE nd_sba_buch(int m,int ishomo,int **indp)
! 2529: {
! 2530: int i,nh,sugar,stat;
! 2531: NODE r,g,t;
! 2532: ND_pairs d;
! 2533: ND_pairs l;
! 2534: ND h,nf,s,head,nf1;
! 2535: NDV nfv;
! 2536: Z q;
! 2537: union oNDC dn,hc;
! 2538: P cont;
! 2539: LIST list;
! 2540: SIG sig;
! 2541: NODE syzlist;
! 2542: static int wpd;
! 2543: static SIG quo,mul;
! 2544: static DL lcm;
! 2545:
! 2546: syzlist = 0;
! 2547: Nnd_add = 0;
! 2548: g = 0; d = 0;
! 2549: for ( i = 0; i < nd_psn; i++ ) {
! 2550: d = update_pairs_s(d,g,i,0);
! 2551: g = append_one(g,i);
! 2552: }
! 2553: sugar = 0;
! 2554: while ( d ) {
! 2555: again:
! 2556: l = d; d = d->next;
! 2557: sig = l->sig;
! 2558: if ( wpd < nd_wpd ) {
! 2559: wpd = nd_wpd;
! 2560: NEWSIG(quo);
! 2561: NEWSIG(mul);
! 2562: NEWDL(lcm,nd_nvar);
! 2563: }
! 2564: _ndltodl(l->lcm,lcm);
! 2565: for ( i = 0; i < nd_psn; i++ ) {
! 2566: if ( sig->pos == nd_psh[i]->sig->pos &&
! 2567: _dl_redble(DL(nd_psh[i]->sig),DL(sig),nd_nvar) ) {
! 2568: _copydl(nd_nvar,DL(sig),DL(quo));
! 2569: _subfromdl(nd_nvar,DL(nd_psh[i]->sig),DL(quo));
! 2570: _ndltodl(DL(nd_psh[i]),DL(mul));
! 2571: _addtodl(nd_nvar,DL(quo),DL(mul));
! 2572: if ( (*cmpdl)(nd_nvar,lcm,DL(mul)) > 0 )
! 2573: break;
! 2574: }
! 2575: }
! 2576: if ( i < nd_psn ) {
! 2577: if ( DP_Print ) fprintf(asir_out,"M");
! 2578: continue;
! 2579: }
! 2580: if ( SG(l) != sugar ) {
! 2581: sugar = SG(l);
! 2582: if ( DP_Print ) fprintf(asir_out,"%d",sugar);
! 2583: }
! 2584: stat = nd_sp(m,0,l,&h);
! 2585: if ( !stat ) {
! 2586: NEXT(l) = d; d = l;
! 2587: d = nd_reconstruct(0,d);
! 2588: goto again;
! 2589: }
! 2590: #if 0 && USE_GEOBUCKET
! 2591: stat = m?nd_nf_pbucket_s(m,h,nd_ps,!Top,&nf):nd_nf_s(m,0,h,nd_ps,!Top,&nf);
! 2592: #else
! 2593: stat = nd_nf_s(m,0,h,nd_ps,!Top,&nf);
! 2594: #endif
! 2595: if ( !stat ) {
! 2596: NEXT(l) = d; d = l;
! 2597: d = nd_reconstruct(0,d);
! 2598: goto again;
! 2599: } else if ( stat == -1 ) {
! 2600: if ( DP_Print ) { printf("S"); fflush(stdout); }
! 2601: } else if ( nf ) {
! 2602: if ( DP_Print ) { printf("+"); fflush(stdout); }
! 2603: hc = HCU(nf);
! 2604: nd_removecont(m,nf);
! 2605: nfv = ndtondv(m,nf); nd_free(nf);
! 2606: nh = ndv_newps(m,nfv,0);
! 2607: d = update_pairs_s(d,g,nh,syzlist);
! 2608: g = append_one(g,nh);
! 2609: FREENDP(l);
! 2610: } else {
! 2611: // syzygy
! 2612: d = remove_spair_s(d,sig);
! 2613: syzlist = insert_sig(syzlist,sig);
! 2614: if ( DP_Print ) { printf("."); fflush(stdout); }
! 2615: FREENDP(l);
! 2616: }
! 2617: }
! 2618: conv_ilist(nd_demand,0,g,indp);
! 2619: if ( DP_Print ) { printf("nd_sba done. Number of nd_add=%d\n",Nnd_add); fflush(stdout); }
! 2620: return g;
! 2621: }
! 2622:
1.1 noro 2623: /* splist = [[i1,i2],...] */
2624:
2625: int check_splist(int m,NODE splist)
2626: {
2627: NODE t,p;
2628: ND_pairs d,r,l;
2629: int stat;
2630: ND h,nf;
2631:
2632: for ( d = 0, t = splist; t; t = NEXT(t) ) {
2633: p = BDY((LIST)BDY(t));
1.6 noro 2634: NEXTND_pairs(d,r);
2635: r->i1 = ZTOS((Q)ARG0(p)); r->i2 = ZTOS((Q)ARG1(p));
2636: ndl_lcm(DL(nd_psh[r->i1]),DL(nd_psh[r->i2]),r->lcm);
1.1 noro 2637: SG(r) = TD(LCM(r)); /* XXX */
2638: }
2639: if ( d ) NEXT(r) = 0;
2640:
1.6 noro 2641: while ( d ) {
1.1 noro 2642: again:
1.6 noro 2643: l = nd_minp(d,&d);
2644: stat = nd_sp(m,0,l,&h);
2645: if ( !stat ) {
2646: NEXT(l) = d; d = l;
2647: d = nd_reconstruct(0,d);
2648: goto again;
2649: }
2650: stat = nd_nf(m,0,h,nd_ps,!Top,&nf);
2651: if ( !stat ) {
2652: NEXT(l) = d; d = l;
2653: d = nd_reconstruct(0,d);
2654: goto again;
2655: } else if ( nf ) return 0;
1.1 noro 2656: if ( DP_Print) { printf("."); fflush(stdout); }
1.6 noro 2657: }
1.1 noro 2658: if ( DP_Print) { printf("done.\n"); fflush(stdout); }
2659: return 1;
2660: }
2661:
2662: int check_splist_f4(int m,NODE splist)
2663: {
2664: UINT *s0vect;
1.6 noro 2665: PGeoBucket bucket;
1.1 noro 2666: NODE p,rp0,t;
2667: ND_pairs d,r,l,ll;
2668: int col,stat;
2669:
2670: for ( d = 0, t = splist; t; t = NEXT(t) ) {
2671: p = BDY((LIST)BDY(t));
1.6 noro 2672: NEXTND_pairs(d,r);
2673: r->i1 = ZTOS((Q)ARG0(p)); r->i2 = ZTOS((Q)ARG1(p));
2674: ndl_lcm(DL(nd_psh[r->i1]),DL(nd_psh[r->i2]),r->lcm);
1.1 noro 2675: SG(r) = TD(LCM(r)); /* XXX */
2676: }
2677: if ( d ) NEXT(r) = 0;
2678:
1.6 noro 2679: while ( d ) {
2680: l = nd_minsugarp(d,&d);
2681: bucket = create_pbucket();
2682: stat = nd_sp_f4(m,0,l,bucket);
2683: if ( !stat ) {
2684: for ( ll = l; NEXT(ll); ll = NEXT(ll) );
2685: NEXT(ll) = d; d = l;
2686: d = nd_reconstruct(0,d);
2687: continue;
2688: }
2689: if ( bucket->m < 0 ) continue;
2690: col = nd_symbolic_preproc(bucket,0,&s0vect,&rp0);
2691: if ( !col ) {
2692: for ( ll = l; NEXT(ll); ll = NEXT(ll) );
2693: NEXT(ll) = d; d = l;
2694: d = nd_reconstruct(0,d);
2695: continue;
1.1 noro 2696: }
1.6 noro 2697: if ( nd_f4_red(m,l,0,s0vect,col,rp0,0) ) return 0;
2698: }
2699: return 1;
1.1 noro 2700: }
2701:
2702: int do_diagonalize_trace(int sugar,int m)
2703: {
1.6 noro 2704: int i,nh,stat;
2705: NODE r,g,t;
2706: ND h,nf,nfq,s,head;
2707: NDV nfv,nfqv;
2708: Q q,den,num;
2709: union oNDC hc;
2710: NODE node;
2711: LIST l;
2712: Z iq;
2713: P cont,cont1;
1.1 noro 2714:
1.6 noro 2715: for ( i = nd_psn-1; i >= 0 && SG(nd_psh[i]) == sugar; i-- ) {
2716: if ( nd_gentrace ) {
2717: /* Trace = [1,index,1,1] */
2718: STOZ(i,iq); node = mknode(4,ONE,iq,ONE,ONE);
2719: MKLIST(l,node); MKNODE(nd_tracelist,l,0);
2720: }
2721: /* for nd_ps */
2722: s = ndvtond(m,nd_ps[i]);
2723: s = nd_separate_head(s,&head);
2724: stat = nd_nf_pbucket(m,s,nd_ps,1,&nf);
2725: if ( !stat ) return 0;
2726: nf = nd_add(m,head,nf);
2727: ndv_free(nd_ps[i]);
2728: nd_ps[i] = ndtondv(m,nf);
2729: nd_free(nf);
2730:
2731: /* for nd_ps_trace */
2732: if ( nd_demand )
2733: nfv = ndv_load(i);
2734: else
2735: nfv = nd_ps_trace[i];
2736: s = ndvtond(0,nfv);
2737: s = nd_separate_head(s,&head);
2738: stat = nd_nf(0,head,s,nd_ps_trace,1,&nf);
2739: if ( !stat ) return 0;
2740: ndv_free(nfv);
2741: hc = HCU(nf); nd_removecont(0,nf);
2742: /* exact division */
1.1 noro 2743: cont = ndc_div(0,hc,HCU(nf));
1.6 noro 2744: if ( nd_gentrace ) finalize_tracelist(i,cont);
2745: nfv = ndtondv(0,nf);
2746: nd_free(nf);
2747: nd_bound[i] = ndv_compute_bound(nfv);
2748: register_hcf(nfv);
2749: if ( nd_demand ) {
2750: ndv_save(nfv,i);
2751: ndv_free(nfv);
2752: } else
2753: nd_ps_trace[i] = nfv;
2754: }
2755: return 1;
1.1 noro 2756: }
2757:
2758: static struct oEGT eg_invdalg;
2759: struct oEGT eg_le;
2760:
2761: void nd_subst_vector(VL vl,P p,NODE subst,P *r)
2762: {
2763: NODE tn;
2764: P p1;
2765:
2766: for ( tn = subst; tn; tn = NEXT(NEXT(tn)) ) {
2767: substp(vl,p,BDY(tn),BDY(NEXT(tn)),&p1); p = p1;
2768: }
2769: *r = p;
2770: }
2771:
2772: NODE nd_gb_trace(int m,int ishomo,int **indp)
2773: {
1.6 noro 2774: int i,nh,sugar,stat;
2775: NODE r,g,t;
2776: ND_pairs d;
2777: ND_pairs l;
2778: ND h,nf,nfq,s,head;
2779: NDV nfv,nfqv;
2780: Z q,den,num;
2781: P hc;
2782: union oNDC dn,hnfq;
2783: struct oEGT eg_monic,egm0,egm1;
2784: int diag_count = 0;
2785: P cont;
2786: LIST list;
2787:
2788: init_eg(&eg_monic);
2789: init_eg(&eg_invdalg);
2790: init_eg(&eg_le);
2791: g = 0; d = 0;
2792: for ( i = 0; i < nd_psn; i++ ) {
2793: d = update_pairs(d,g,i,0);
2794: g = update_base(g,i);
2795: }
2796: sugar = 0;
2797: while ( d ) {
1.1 noro 2798: again:
1.6 noro 2799: l = nd_minp(d,&d);
2800: if ( MaxDeg > 0 && SG(l) > MaxDeg ) break;
2801: if ( SG(l) != sugar ) {
1.1 noro 2802: #if 1
1.6 noro 2803: if ( ishomo ) {
2804: if ( DP_Print > 2 ) fprintf(asir_out,"|");
2805: stat = do_diagonalize_trace(sugar,m);
2806: if ( DP_Print > 2 ) fprintf(asir_out,"|");
2807: diag_count = 0;
1.1 noro 2808: if ( !stat ) {
1.6 noro 2809: NEXT(l) = d; d = l;
2810: d = nd_reconstruct(1,d);
2811: goto again;
1.1 noro 2812: }
1.6 noro 2813: }
2814: #endif
2815: sugar = SG(l);
2816: if ( DP_Print ) fprintf(asir_out,"%d",sugar);
2817: }
2818: stat = nd_sp(m,0,l,&h);
2819: if ( !stat ) {
2820: NEXT(l) = d; d = l;
2821: d = nd_reconstruct(1,d);
2822: goto again;
2823: }
1.1 noro 2824: #if USE_GEOBUCKET
1.6 noro 2825: stat = nd_nf_pbucket(m,h,nd_ps,!Top,&nf);
1.1 noro 2826: #else
1.6 noro 2827: stat = nd_nf(m,0,h,nd_ps,!Top,&nf);
1.1 noro 2828: #endif
1.6 noro 2829: if ( !stat ) {
2830: NEXT(l) = d; d = l;
2831: d = nd_reconstruct(1,d);
2832: goto again;
2833: } else if ( nf ) {
2834: if ( nd_demand ) {
2835: nfqv = ndv_load(nd_psn);
2836: nfq = ndvtond(0,nfqv);
2837: } else
2838: nfq = 0;
2839: if ( !nfq ) {
2840: if ( !nd_sp(0,1,l,&h) || !nd_nf(0,0,h,nd_ps_trace,!Top,&nfq) ) {
2841: NEXT(l) = d; d = l;
2842: d = nd_reconstruct(1,d);
2843: goto again;
2844: }
2845: }
2846: if ( nfq ) {
2847: /* m|HC(nfq) => failure */
2848: if ( nd_vc ) {
2849: nd_subst_vector(nd_vc,HCP(nfq),nd_subst,&hc); q = (Z)hc;
2850: } else
2851: q = HCZ(nfq);
2852: if ( !remqi((Q)q,m) ) return 0;
2853:
2854: if ( DP_Print ) { printf("+"); fflush(stdout); }
2855: hnfq = HCU(nfq);
2856: if ( nd_nalg ) {
2857: /* m|DN(HC(nf)^(-1)) => failure */
2858: get_eg(&egm0);
2859: if ( !nd_monic(m,&nfq) ) return 0;
2860: get_eg(&egm1); add_eg(&eg_monic,&egm0,&egm1);
2861: nd_removecont(0,nfq); nfqv = ndtondv(0,nfq); nd_free(nfq);
2862: nfv = ndv_dup(0,nfqv); ndv_mod(m,nfv); nd_free(nf);
2863: } else {
2864: nd_removecont(0,nfq); nfqv = ndtondv(0,nfq); nd_free(nfq);
2865: nd_removecont(m,nf); nfv = ndtondv(m,nf); nd_free(nf);
2866: }
2867: if ( nd_gentrace ) {
2868: /* exact division */
2869: cont = ndc_div(0,hnfq,HCU(nfqv));
2870: if ( !UNIQ(cont) ) {
2871: t = mknode(4,NULLP,NULLP,NULLP,cont);
2872: MKLIST(list,t); MKNODE(t,list,nd_tracelist);
2873: nd_tracelist = t;
2874: }
2875: }
1.24 ! noro 2876: nh = ndv_newps(0,nfv,nfqv);
1.6 noro 2877: if ( ishomo && ++diag_count == diag_period ) {
2878: diag_count = 0;
2879: if ( DP_Print > 2 ) fprintf(asir_out,"|");
2880: stat = do_diagonalize_trace(sugar,m);
2881: if ( DP_Print > 2 ) fprintf(asir_out,"|");
2882: if ( !stat ) {
1.1 noro 2883: NEXT(l) = d; d = l;
2884: d = nd_reconstruct(1,d);
2885: goto again;
1.6 noro 2886: }
1.1 noro 2887: }
1.6 noro 2888: d = update_pairs(d,g,nh,0);
2889: g = update_base(g,nh);
2890: } else {
2891: if ( DP_Print ) { printf("*"); fflush(stdout); }
2892: }
2893: } else {
2894: if ( DP_Print ) { printf("."); fflush(stdout); }
1.1 noro 2895: }
1.6 noro 2896: FREENDP(l);
2897: }
2898: if ( nd_nalg ) {
2899: if ( DP_Print ) {
2900: print_eg("monic",&eg_monic);
2901: print_eg("invdalg",&eg_invdalg);
2902: print_eg("le",&eg_le);
1.1 noro 2903: }
1.6 noro 2904: }
1.1 noro 2905: conv_ilist(nd_demand,1,g,indp);
1.6 noro 2906: if ( DP_Print ) { printf("nd_gb_trace done.\n"); fflush(stdout); }
2907: return g;
1.1 noro 2908: }
2909:
2910: int ndv_compare(NDV *p1,NDV *p2)
2911: {
2912: return DL_COMPARE(HDL(*p1),HDL(*p2));
2913: }
2914:
2915: int ndv_compare_rev(NDV *p1,NDV *p2)
2916: {
2917: return -DL_COMPARE(HDL(*p1),HDL(*p2));
2918: }
2919:
2920: int ndvi_compare(NDVI p1,NDVI p2)
2921: {
2922: return DL_COMPARE(HDL(p1->p),HDL(p2->p));
2923: }
2924:
2925: int ndvi_compare_rev(NDVI p1,NDVI p2)
2926: {
2927: return -DL_COMPARE(HDL(p1->p),HDL(p2->p));
2928: }
2929:
2930: NODE ndv_reduceall(int m,NODE f)
2931: {
2932: int i,j,n,stat;
2933: ND nf,g,head;
2934: NODE t,a0,a;
2935: union oNDC dn;
2936: Q q,num,den;
2937: NODE node;
2938: LIST l;
2939: Z iq,jq;
2940: int *perm;
2941: union oNDC hc;
2942: P cont,cont1;
2943:
2944: if ( nd_nora ) return f;
2945: n = length(f);
1.24 ! noro 2946: ndv_setup(m,0,f,0,1,0);
1.1 noro 2947: perm = (int *)MALLOC(n*sizeof(int));
2948: if ( nd_gentrace ) {
2949: for ( t = nd_tracelist, i = 0; i < n; i++, t = NEXT(t) )
1.6 noro 2950: perm[i] = ZTOS((Q)ARG1(BDY((LIST)BDY(t))));
1.1 noro 2951: }
2952: for ( i = 0; i < n; ) {
2953: if ( nd_gentrace ) {
2954: /* Trace = [1,index,1,1] */
1.6 noro 2955: STOZ(i,iq); node = mknode(4,ONE,iq,ONE,ONE);
1.1 noro 2956: MKLIST(l,node); MKNODE(nd_tracelist,l,0);
2957: }
2958: g = ndvtond(m,nd_ps[i]);
2959: g = nd_separate_head(g,&head);
1.6 noro 2960: stat = nd_nf(m,head,g,nd_ps,1,&nf);
1.1 noro 2961: if ( !stat )
2962: nd_reconstruct(0,0);
2963: else {
2964: if ( DP_Print ) { printf("."); fflush(stdout); }
2965: ndv_free(nd_ps[i]);
2966: hc = HCU(nf); nd_removecont(m,nf);
2967: if ( nd_gentrace ) {
2968: for ( t = nd_tracelist; t; t = NEXT(t) ) {
1.6 noro 2969: jq = ARG1(BDY((LIST)BDY(t))); j = ZTOS(jq);
2970: STOZ(perm[j],jq); ARG1(BDY((LIST)BDY(t))) = jq;
1.1 noro 2971: }
1.6 noro 2972: /* exact division */
1.1 noro 2973: cont = ndc_div(m,hc,HCU(nf));
2974: finalize_tracelist(perm[i],cont);
2975: }
2976: nd_ps[i] = ndtondv(m,nf); nd_free(nf);
2977: nd_bound[i] = ndv_compute_bound(nd_ps[i]);
2978: i++;
2979: }
2980: }
2981: if ( DP_Print ) { printf("\n"); }
2982: for ( a0 = 0, i = 0; i < n; i++ ) {
2983: NEXTNODE(a0,a);
2984: if ( !nd_gentrace ) BDY(a) = (pointer)nd_ps[i];
2985: else {
2986: for ( j = 0; j < n; j++ ) if ( perm[j] == i ) break;
2987: BDY(a) = (pointer)nd_ps[j];
2988: }
2989: }
2990: NEXT(a) = 0;
2991: return a0;
2992: }
2993:
2994: ND_pairs update_pairs( ND_pairs d, NODE /* of index */ g, int t, int gensyz)
2995: {
2996: ND_pairs d1,nd,cur,head,prev,remove;
2997:
2998: if ( !g ) return d;
2999: /* for testing */
3000: if ( gensyz && nd_gensyz == 2 ) {
3001: d1 = nd_newpairs(g,t);
3002: if ( !d )
3003: return d1;
3004: else {
3005: nd = d;
3006: while ( NEXT(nd) ) nd = NEXT(nd);
3007: NEXT(nd) = d1;
3008: return d;
3009: }
3010: }
3011: d = crit_B(d,t);
3012: d1 = nd_newpairs(g,t);
3013: d1 = crit_M(d1);
3014: d1 = crit_F(d1);
3015: if ( gensyz || do_weyl )
3016: head = d1;
3017: else {
3018: prev = 0; cur = head = d1;
3019: while ( cur ) {
3020: if ( crit_2( cur->i1,cur->i2 ) ) {
3021: remove = cur;
3022: if ( !prev ) head = cur = NEXT(cur);
3023: else cur = NEXT(prev) = NEXT(cur);
3024: FREENDP(remove);
3025: } else {
3026: prev = cur; cur = NEXT(cur);
3027: }
3028: }
3029: }
3030: if ( !d )
3031: return head;
3032: else {
3033: nd = d;
3034: while ( NEXT(nd) ) nd = NEXT(nd);
3035: NEXT(nd) = head;
3036: return d;
3037: }
3038: }
3039:
1.24 ! noro 3040: ND_pairs merge_pairs_s(ND_pairs d,ND_pairs d1);
! 3041:
! 3042: ND_pairs update_pairs_s( ND_pairs d, NODE /* of index */ g, int t,NODE syz)
! 3043: {
! 3044: ND_pairs d1;
! 3045:
! 3046: if ( !g ) return d;
! 3047: d1 = nd_newpairs_s(g,t,syz);
! 3048: d = merge_pairs_s(d,d1);
! 3049: return d;
! 3050: }
1.1 noro 3051:
3052: ND_pairs nd_newpairs( NODE g, int t )
3053: {
3054: NODE h;
3055: UINT *dl;
3056: int ts,s,i,t0,min,max;
3057: ND_pairs r,r0;
3058:
3059: dl = DL(nd_psh[t]);
3060: ts = SG(nd_psh[t]) - TD(dl);
1.17 noro 3061: if ( nd_module && nd_intersect && (MPOS(dl) > nd_intersect) ) return 0;
1.1 noro 3062: for ( r0 = 0, h = g; h; h = NEXT(h) ) {
3063: if ( nd_module && (MPOS(DL(nd_psh[(long)BDY(h)])) != MPOS(dl)) )
3064: continue;
3065: if ( nd_gbblock ) {
3066: t0 = (long)BDY(h);
3067: for ( i = 0; nd_gbblock[i] >= 0; i += 2 ) {
3068: min = nd_gbblock[i]; max = nd_gbblock[i+1];
3069: if ( t0 >= min && t0 <= max && t >= min && t <= max )
3070: break;
3071: }
3072: if ( nd_gbblock[i] >= 0 )
3073: continue;
3074: }
3075: NEXTND_pairs(r0,r);
3076: r->i1 = (long)BDY(h);
3077: r->i2 = t;
3078: ndl_lcm(DL(nd_psh[r->i1]),dl,r->lcm);
3079: s = SG(nd_psh[r->i1])-TD(DL(nd_psh[r->i1]));
3080: SG(r) = MAX(s,ts) + TD(LCM(r));
3081: /* experimental */
3082: if ( nd_sugarweight )
3083: r->sugar2 = ndl_weight2(r->lcm);
3084: }
3085: if ( r0 ) NEXT(r) = 0;
3086: return r0;
3087: }
3088:
1.24 ! noro 3089:
! 3090: int comp_sig(SIG s1,SIG s2)
! 3091: {
! 3092: #if 0
! 3093: if ( s1->pos > s2->pos ) return 1;
! 3094: else if ( s1->pos < s2->pos ) return -1;
! 3095: else return (*cmpdl)(nd_nvar,s1->dl,s2->dl);
! 3096: #else
! 3097: static DL m1,m2;
! 3098: static int nvar;
! 3099: int ret;
! 3100:
! 3101: if ( nvar < nd_nvar ) {
! 3102: nvar = nd_nvar;
! 3103: NEWDL(m1,nvar);
! 3104: NEWDL(m2,nvar);
! 3105: }
! 3106: _ndltodl(DL(nd_psh[s1->pos]),m1);
! 3107: _ndltodl(DL(nd_psh[s2->pos]),m2);
! 3108: _addtodl(nd_nvar,s1->dl,m1);
! 3109: _addtodl(nd_nvar,s2->dl,m2);
! 3110: ret = (*cmpdl)(nd_nvar,m1,m2);
! 3111: if ( ret != 0 ) return ret;
! 3112: else if ( s1->pos > s2->pos ) return 1;
! 3113: else if ( s1->pos < s2->pos ) return -1;
! 3114: else return 0;
! 3115: #endif
! 3116: }
! 3117:
! 3118: int _create_spair_s(int i1,int i2,ND_pairs sp,SIG sig1,SIG sig2)
! 3119: {
! 3120: int ret,s1,s2;
! 3121: RHist p1,p2;
! 3122: static int wpd;
! 3123: static UINT *lcm;
! 3124:
! 3125: sp->i1 = i1;
! 3126: sp->i2 = i2;
! 3127: p1 = nd_psh[i1];
! 3128: p2 = nd_psh[i2];
! 3129: ndl_lcm(DL(p1),DL(p2),sp->lcm);
! 3130: s1 = SG(p1)-TD(DL(p1));
! 3131: s2 = SG(p2)-TD(DL(p2));
! 3132: SG(sp) = MAX(s1,s2) + TD(sp->lcm);
! 3133:
! 3134: if ( wpd < nd_wpd ) {
! 3135: wpd = nd_wpd;
! 3136: lcm = (UINT *)MALLOC(wpd*sizeof(UINT));
! 3137: }
! 3138: // DL(sig1) <- sp->lcm
! 3139: // DL(sig1) -= DL(p1)
! 3140: // DL(sig1) += DL(p1->sig)
! 3141: ndl_copy(sp->lcm,lcm);
! 3142: ndl_subfrom(lcm,DL(p1));
! 3143: _ndltodl(lcm,DL(sig1));
! 3144: _addtodl(nd_nvar,DL(p1->sig),DL(sig1));
! 3145: sig1->pos = p1->sig->pos;
! 3146:
! 3147: // DL(sig2) <- sp->lcm
! 3148: // DL(sig2) -= DL(p2)
! 3149: // DL(sig2) += DL(p2->sig)
! 3150: ndl_copy(sp->lcm,lcm);
! 3151: ndl_subfrom(lcm,DL(p2));
! 3152: _ndltodl(lcm,DL(sig2));
! 3153: _addtodl(nd_nvar,DL(p2->sig),DL(sig2));
! 3154: sig2->pos = p2->sig->pos;
! 3155:
! 3156: ret = comp_sig(sig1,sig2);
! 3157: if ( ret == 0 ) return 0;
! 3158: else if ( ret > 0 ) sp->sig = sig1;
! 3159: else sp->sig = sig2;
! 3160: return 1;
! 3161: }
! 3162:
! 3163: SIG dup_sig(SIG sig)
! 3164: {
! 3165: SIG r;
! 3166:
! 3167: if ( !sig ) return 0;
! 3168: else {
! 3169: NEWSIG(r);
! 3170: _copydl(nd_nvar,DL(sig),DL(r));
! 3171: r->pos = sig->pos;
! 3172: return r;
! 3173: }
! 3174: }
! 3175:
! 3176: void dup_ND_pairs(ND_pairs to,ND_pairs from)
! 3177: {
! 3178: to->i1 = from->i1;
! 3179: to->i2 = from->i2;
! 3180: to->sugar = from->sugar;
! 3181: to->sugar2 = from->sugar2;
! 3182: ndl_copy(from->lcm,to->lcm);
! 3183: to->sig = dup_sig(from->sig);
! 3184: }
! 3185:
! 3186: ND_pairs merge_pairs_s(ND_pairs p1,ND_pairs p2)
! 3187: {
! 3188: struct oND_pairs root;
! 3189: ND_pairs q1,q2,r0,r;
! 3190: int ret;
! 3191:
! 3192: r = &root;
! 3193: for ( q1 = p1, q2 = p2; q1 != 0 && q2 != 0; ) {
! 3194: ret = comp_sig(q1->sig,q2->sig);
! 3195: if ( ret < 0 ) {
! 3196: r->next = q1; r = q1; q1 = q1->next;
! 3197: } else if ( ret > 0 ) {
! 3198: r->next = q2; r = q2; q2 = q2->next;
! 3199: } else {
! 3200: ret = DL_COMPARE(q1->lcm,q2->lcm);
! 3201: if ( ret < 0 ) {
! 3202: r->next = q1; r = q1; q1 = q1->next;
! 3203: q2 = q2->next;
! 3204: } else {
! 3205: r->next = q2; r = q2; q2 = q2->next;
! 3206: q1 = q1->next;
! 3207: }
! 3208: }
! 3209: }
! 3210: if ( q1 ) {
! 3211: r->next = q1;
! 3212: } else {
! 3213: r->next = q2;
! 3214: }
! 3215: return root.next;
! 3216: }
! 3217:
! 3218: ND_pairs insert_pair_s(ND_pairs l,ND_pairs s)
! 3219: {
! 3220: ND_pairs p,prev;
! 3221: int ret;
! 3222:
! 3223: for ( p = l, prev = 0; p != 0; prev = p, p = p->next ) {
! 3224: if ( (ret = comp_sig(s->sig,p->sig)) <= 0 )
! 3225: break;
! 3226: }
! 3227: if ( ret == 0 ) {
! 3228: ret = DL_COMPARE(s->lcm,p->lcm);
! 3229: if ( ret < 0 ) {
! 3230: // replace p with s
! 3231: s->next = p->next;
! 3232: if ( prev == 0 ) {
! 3233: return s;
! 3234: } else {
! 3235: prev->next = s;
! 3236: return l;
! 3237: }
! 3238: } else
! 3239: return l;
! 3240: } else {
! 3241: // insert s between prev and p
! 3242: s->next = p;
! 3243: if ( prev == 0 ) {
! 3244: return s;
! 3245: } else {
! 3246: prev->next = s;
! 3247: return l;
! 3248: }
! 3249: }
! 3250: }
! 3251:
! 3252: ND_pairs nd_newpairs_s( NODE g, int t, NODE syz)
! 3253: {
! 3254: NODE h,s;
! 3255: UINT *dl;
! 3256: int ts,ret;
! 3257: ND_pairs r,r0,_sp,sp;
! 3258: SIG _sig1,_sig2,spsig,tsig;
! 3259:
! 3260: dl = DL(nd_psh[t]);
! 3261: ts = SG(nd_psh[t]) - TD(dl);
! 3262: NEWND_pairs(_sp);
! 3263: NEWSIG(_sig1); NEWSIG(_sig2);
! 3264: r0 = 0;
! 3265: for ( h = g; h; h = NEXT(h) ) {
! 3266: ret = _create_spair_s((long)BDY(h),t,_sp,_sig1,_sig2);
! 3267: if ( ret ) {
! 3268: spsig = _sp->sig;
! 3269: for ( s = syz; s; s = s->next ) {
! 3270: tsig = (SIG)s->body;
! 3271: if ( tsig->pos == spsig->pos && _dl_redble(DL(tsig),DL(spsig),nd_nvar) )
! 3272: break;
! 3273: }
! 3274: if ( s == 0 ) {
! 3275: NEWND_pairs(sp);
! 3276: dup_ND_pairs(sp,_sp);
! 3277: r0 = insert_pair_s(r0,sp);
! 3278: }
! 3279: }
! 3280: }
! 3281: return r0;
! 3282: }
! 3283:
1.1 noro 3284: /* ipair = [i1,i2],[i1,i2],... */
3285: ND_pairs nd_ipairtospair(NODE ipair)
3286: {
3287: int s1,s2;
3288: NODE tn,t;
3289: ND_pairs r,r0;
3290:
3291: for ( r0 = 0, t = ipair; t; t = NEXT(t) ) {
3292: NEXTND_pairs(r0,r);
3293: tn = BDY((LIST)BDY(t));
1.6 noro 3294: r->i1 = ZTOS((Q)ARG0(tn));
3295: r->i2 = ZTOS((Q)ARG1(tn));
1.1 noro 3296: ndl_lcm(DL(nd_psh[r->i1]),DL(nd_psh[r->i2]),r->lcm);
3297: s1 = SG(nd_psh[r->i1])-TD(DL(nd_psh[r->i1]));
3298: s2 = SG(nd_psh[r->i2])-TD(DL(nd_psh[r->i2]));
3299: SG(r) = MAX(s1,s2) + TD(LCM(r));
3300: /* experimental */
3301: if ( nd_sugarweight )
3302: r->sugar2 = ndl_weight2(r->lcm);
3303: }
3304: if ( r0 ) NEXT(r) = 0;
3305: return r0;
3306: }
3307:
3308: /* kokokara */
3309:
3310: ND_pairs crit_B( ND_pairs d, int s )
3311: {
3312: ND_pairs cur,head,prev,remove;
3313: UINT *t,*tl,*lcm;
3314: int td,tdl;
3315:
3316: if ( !d ) return 0;
3317: t = DL(nd_psh[s]);
3318: prev = 0;
3319: head = cur = d;
3320: lcm = (UINT *)MALLOC(nd_wpd*sizeof(UINT));
3321: while ( cur ) {
3322: tl = cur->lcm;
3323: if ( ndl_reducible(tl,t) ) {
3324: ndl_lcm(DL(nd_psh[cur->i1]),t,lcm);
3325: if ( !ndl_equal(lcm,tl) ) {
3326: ndl_lcm(DL(nd_psh[cur->i2]),t,lcm);
3327: if (!ndl_equal(lcm,tl)) {
3328: remove = cur;
3329: if ( !prev ) {
3330: head = cur = NEXT(cur);
3331: } else {
3332: cur = NEXT(prev) = NEXT(cur);
3333: }
3334: FREENDP(remove);
3335: } else {
3336: prev = cur; cur = NEXT(cur);
3337: }
3338: } else {
3339: prev = cur; cur = NEXT(cur);
3340: }
3341: } else {
3342: prev = cur; cur = NEXT(cur);
3343: }
3344: }
3345: return head;
3346: }
3347:
3348: ND_pairs crit_M( ND_pairs d1 )
3349: {
3350: ND_pairs e,d2,d3,dd,p;
3351: UINT *id,*jd;
3352:
3353: if ( !d1 ) return d1;
3354: for ( dd = 0, e = d1; e; e = d3 ) {
3355: if ( !(d2 = NEXT(e)) ) {
3356: NEXT(e) = dd;
3357: return e;
3358: }
3359: id = LCM(e);
3360: for ( d3 = 0; d2; d2 = p ) {
3361: p = NEXT(d2);
3362: jd = LCM(d2);
3363: if ( ndl_equal(jd,id) )
3364: ;
3365: else if ( TD(jd) > TD(id) )
3366: if ( ndl_reducible(jd,id) ) continue;
3367: else ;
3368: else if ( ndl_reducible(id,jd) ) goto delit;
3369: NEXT(d2) = d3;
3370: d3 = d2;
3371: }
3372: NEXT(e) = dd;
3373: dd = e;
3374: continue;
3375: /**/
3376: delit: NEXT(d2) = d3;
3377: d3 = d2;
3378: for ( ; p; p = d2 ) {
3379: d2 = NEXT(p);
3380: NEXT(p) = d3;
3381: d3 = p;
3382: }
3383: FREENDP(e);
3384: }
3385: return dd;
3386: }
3387:
3388: ND_pairs crit_F( ND_pairs d1 )
3389: {
3390: ND_pairs rest, head,remove;
3391: ND_pairs last, p, r, w;
3392: int s;
3393:
3394: if ( !d1 ) return d1;
3395: for ( head = last = 0, p = d1; NEXT(p); ) {
3396: r = w = equivalent_pairs(p,&rest);
3397: s = SG(r);
3398: w = NEXT(w);
3399: while ( w ) {
3400: if ( crit_2(w->i1,w->i2) ) {
3401: r = w;
3402: w = NEXT(w);
3403: while ( w ) {
3404: remove = w;
3405: w = NEXT(w);
3406: FREENDP(remove);
3407: }
3408: break;
3409: } else if ( SG(w) < s ) {
3410: FREENDP(r);
3411: r = w;
3412: s = SG(r);
3413: w = NEXT(w);
3414: } else {
3415: remove = w;
3416: w = NEXT(w);
3417: FREENDP(remove);
3418: }
3419: }
3420: if ( last ) NEXT(last) = r;
3421: else head = r;
3422: NEXT(last = r) = 0;
3423: p = rest;
3424: if ( !p ) return head;
3425: }
3426: if ( !last ) return p;
3427: NEXT(last) = p;
3428: return head;
3429: }
3430:
3431: int crit_2( int dp1, int dp2 )
3432: {
3433: return ndl_disjoint(DL(nd_psh[dp1]),DL(nd_psh[dp2]));
3434: }
3435:
3436: ND_pairs equivalent_pairs( ND_pairs d1, ND_pairs *prest )
3437: {
3438: ND_pairs w,p,r,s;
3439: UINT *d;
3440:
3441: w = d1;
3442: d = LCM(w);
3443: s = NEXT(w);
3444: NEXT(w) = 0;
3445: for ( r = 0; s; s = p ) {
3446: p = NEXT(s);
3447: if ( ndl_equal(d,LCM(s)) ) {
3448: NEXT(s) = w; w = s;
3449: } else {
3450: NEXT(s) = r; r = s;
3451: }
3452: }
3453: *prest = r;
3454: return w;
3455: }
3456:
3457: NODE update_base(NODE nd,int ndp)
3458: {
3459: UINT *dl, *dln;
3460: NODE last, p, head;
3461:
3462: dl = DL(nd_psh[ndp]);
3463: for ( head = last = 0, p = nd; p; ) {
3464: dln = DL(nd_psh[(long)BDY(p)]);
3465: if ( ndl_reducible( dln, dl ) ) {
3466: p = NEXT(p);
3467: if ( last ) NEXT(last) = p;
3468: } else {
3469: if ( !last ) head = p;
3470: p = NEXT(last = p);
3471: }
3472: }
3473: head = append_one(head,ndp);
3474: return head;
3475: }
3476:
3477: ND_pairs nd_minp( ND_pairs d, ND_pairs *prest )
3478: {
3479: ND_pairs m,ml,p,l;
3480: UINT *lcm;
3481: int s,td,len,tlen,c,c1;
3482:
3483: if ( !(p = NEXT(m = d)) ) {
3484: *prest = p;
3485: NEXT(m) = 0;
3486: return m;
3487: }
3488: if ( !NoSugar ) {
3489: if ( nd_sugarweight ) {
3490: s = m->sugar2;
3491: for ( ml = 0, l = m; p; p = NEXT(l = p) )
3492: if ( (p->sugar2 < s)
3493: || ((p->sugar2 == s) && (DL_COMPARE(LCM(p),LCM(m)) < 0)) ) {
3494: ml = l; m = p; s = m->sugar2;
3495: }
3496: } else {
3497: s = SG(m);
3498: for ( ml = 0, l = m; p; p = NEXT(l = p) )
3499: if ( (SG(p) < s)
3500: || ((SG(p) == s) && (DL_COMPARE(LCM(p),LCM(m)) < 0)) ) {
3501: ml = l; m = p; s = SG(m);
3502: }
3503: }
3504: } else {
3505: for ( ml = 0, l = m; p; p = NEXT(l = p) )
3506: if ( DL_COMPARE(LCM(p),LCM(m)) < 0 ) {
3507: ml = l; m = p; s = SG(m);
3508: }
3509: }
3510: if ( !ml ) *prest = NEXT(m);
3511: else {
3512: NEXT(ml) = NEXT(m);
3513: *prest = d;
3514: }
3515: NEXT(m) = 0;
3516: return m;
3517: }
3518:
3519: ND_pairs nd_minsugarp( ND_pairs d, ND_pairs *prest )
3520: {
3521: int msugar,i;
3522: ND_pairs t,dm0,dm,dr0,dr;
3523:
3524: if ( nd_sugarweight ) {
3525: for ( msugar = d->sugar2, t = NEXT(d); t; t = NEXT(t) )
3526: if ( t->sugar2 < msugar ) msugar = t->sugar2;
3527: dm0 = 0; dr0 = 0;
3528: for ( i = 0, t = d; t; t = NEXT(t) )
3529: if ( i < nd_f4_nsp && t->sugar2 == msugar ) {
3530: if ( dm0 ) NEXT(dm) = t;
3531: else dm0 = t;
3532: dm = t;
3533: i++;
3534: } else {
3535: if ( dr0 ) NEXT(dr) = t;
3536: else dr0 = t;
3537: dr = t;
3538: }
3539: } else {
3540: for ( msugar = SG(d), t = NEXT(d); t; t = NEXT(t) )
3541: if ( SG(t) < msugar ) msugar = SG(t);
3542: dm0 = 0; dr0 = 0;
3543: for ( i = 0, t = d; t; t = NEXT(t) )
3544: if ( i < nd_f4_nsp && SG(t) == msugar ) {
3545: if ( dm0 ) NEXT(dm) = t;
3546: else dm0 = t;
3547: dm = t;
3548: i++;
3549: } else {
3550: if ( dr0 ) NEXT(dr) = t;
3551: else dr0 = t;
3552: dr = t;
3553: }
3554: }
3555: NEXT(dm) = 0;
3556: if ( dr0 ) NEXT(dr) = 0;
3557: *prest = dr0;
3558: return dm0;
3559: }
3560:
3561: int nd_tdeg(NDV c)
3562: {
3563: int wmax = 0;
3564: int i,len;
3565: NMV a;
3566:
3567: len = LEN(c);
3568: for ( a = BDY(c), i = 0; i < len; i++, NMV_ADV(a) )
3569: wmax = MAX(TD(DL(a)),wmax);
3570: return wmax;
3571: }
3572:
1.24 ! noro 3573: int ndv_newps(int m,NDV a,NDV aq)
1.1 noro 3574: {
3575: int len;
3576: RHist r;
3577: NDV b;
3578: NODE tn;
3579: LIST l;
3580: Z iq;
3581:
3582: if ( nd_psn == nd_pslen ) {
3583: nd_pslen *= 2;
3584: nd_ps = (NDV *)REALLOC((char *)nd_ps,nd_pslen*sizeof(NDV));
3585: nd_ps_trace = (NDV *)REALLOC((char *)nd_ps_trace,nd_pslen*sizeof(NDV));
3586: nd_psh = (RHist *)REALLOC((char *)nd_psh,nd_pslen*sizeof(RHist));
3587: nd_bound = (UINT **)
3588: REALLOC((char *)nd_bound,nd_pslen*sizeof(UINT *));
3589: nd_ps_sym = (NDV *)REALLOC((char *)nd_ps_sym,nd_pslen*sizeof(NDV));
3590: nd_ps_trace_sym = (NDV *)REALLOC((char *)nd_ps_trace_sym,nd_pslen*sizeof(NDV));
3591: }
3592: NEWRHist(r); nd_psh[nd_psn] = r;
3593: nd_ps[nd_psn] = a;
3594: if ( aq ) {
3595: nd_ps_trace[nd_psn] = aq;
3596: if ( !m ) {
3597: register_hcf(aq);
3598: } else if ( m == -2 ) {
3599: /* do nothing */
3600: } else
3601: error("ndv_newps : invalud modulus");
3602: nd_bound[nd_psn] = ndv_compute_bound(aq);
3603: #if 1
3604: SG(r) = SG(aq);
3605: #else
3606: SG(r) = nd_tdeg(aq);
3607: #endif
3608: ndl_copy(HDL(aq),DL(r));
1.24 ! noro 3609: r->sig = dup_sig(aq->sig);
1.1 noro 3610: } else {
3611: if ( !m ) register_hcf(a);
3612: nd_bound[nd_psn] = ndv_compute_bound(a);
3613: #if 1
3614: SG(r) = SG(a);
3615: #else
3616: SG(r) = nd_tdeg(a);
3617: #endif
3618: ndl_copy(HDL(a),DL(r));
1.24 ! noro 3619: r->sig = dup_sig(a->sig);
1.1 noro 3620: }
3621: if ( nd_demand ) {
3622: if ( aq ) {
3623: ndv_save(nd_ps_trace[nd_psn],nd_psn);
3624: nd_ps_sym[nd_psn] = ndv_symbolic(m,nd_ps_trace[nd_psn]);
3625: nd_ps_trace_sym[nd_psn] = ndv_symbolic(m,nd_ps_trace[nd_psn]);
3626: nd_ps_trace[nd_psn] = 0;
3627: } else {
3628: ndv_save(nd_ps[nd_psn],nd_psn);
3629: nd_ps_sym[nd_psn] = ndv_symbolic(m,nd_ps[nd_psn]);
3630: nd_ps[nd_psn] = 0;
3631: }
3632: }
3633: if ( nd_gentrace ) {
3634: /* reverse the tracelist and append it to alltracelist */
3635: nd_tracelist = reverse_node(nd_tracelist); MKLIST(l,nd_tracelist);
1.6 noro 3636: STOZ(nd_psn,iq); tn = mknode(2,iq,l); MKLIST(l,tn);
1.1 noro 3637: MKNODE(tn,l,nd_alltracelist); nd_alltracelist = tn; nd_tracelist = 0;
3638: }
3639: return nd_psn++;
3640: }
3641:
3642: /* nd_tracelist = [[0,index,div],...,[nd_psn-1,index,div]] */
3643: /* return 1 if success, 0 if failure (HC(a mod p)) */
3644:
1.24 ! noro 3645: int ndv_setup(int mod,int trace,NODE f,int dont_sort,int dont_removecont,int sba)
1.1 noro 3646: {
1.6 noro 3647: int i,j,td,len,max;
3648: NODE s,s0,f0,tn;
3649: UINT *d;
3650: RHist r;
3651: NDVI w;
3652: NDV a,am;
3653: union oNDC hc;
3654: NODE node;
3655: P hcp;
3656: Z iq,jq;
3657: LIST l;
3658:
3659: nd_found = 0; nd_notfirst = 0; nd_create = 0;
3660: /* initialize the tracelist */
3661: nd_tracelist = 0;
3662:
3663: for ( nd_psn = 0, s = f; s; s = NEXT(s) ) if ( BDY(s) ) nd_psn++;
3664: w = (NDVI)MALLOC(nd_psn*sizeof(struct oNDVI));
3665: for ( i = j = 0, s = f; s; s = NEXT(s), j++ )
3666: if ( BDY(s) ) { w[i].p = BDY(s); w[i].i = j; i++; }
3667: if ( !dont_sort ) {
3668: /* XXX heuristic */
3669: if ( !nd_ord->id && (nd_ord->ord.simple<2) )
3670: qsort(w,nd_psn,sizeof(struct oNDVI),
3671: (int (*)(const void *,const void *))ndvi_compare_rev);
3672: else
3673: qsort(w,nd_psn,sizeof(struct oNDVI),
3674: (int (*)(const void *,const void *))ndvi_compare);
3675: }
3676: nd_pslen = 2*nd_psn;
3677: nd_ps = (NDV *)MALLOC(nd_pslen*sizeof(NDV));
3678: nd_ps_trace = (NDV *)MALLOC(nd_pslen*sizeof(NDV));
3679: nd_ps_sym = (NDV *)MALLOC(nd_pslen*sizeof(NDV));
3680: nd_ps_trace_sym = (NDV *)MALLOC(nd_pslen*sizeof(NDV));
3681: nd_psh = (RHist *)MALLOC(nd_pslen*sizeof(RHist));
3682: nd_bound = (UINT **)MALLOC(nd_pslen*sizeof(UINT *));
3683: nd_hcf = 0;
1.1 noro 3684:
1.6 noro 3685: if ( trace && nd_vc )
3686: makesubst(nd_vc,&nd_subst);
3687: else
3688: nd_subst = 0;
1.1 noro 3689:
1.6 noro 3690: if ( !nd_red )
3691: nd_red = (RHist *)MALLOC(REDTAB_LEN*sizeof(RHist));
3692: for ( i = 0; i < REDTAB_LEN; i++ ) nd_red[i] = 0;
3693: for ( i = 0; i < nd_psn; i++ ) {
3694: hc = HCU(w[i].p);
3695: if ( trace ) {
3696: if ( mod == -2 ) {
3697: /* over a large finite field */
3698: /* trace = small modulus */
3699: a = nd_ps_trace[i] = ndv_dup(-2,w[i].p);
3700: ndv_mod(-2,a);
3701: if ( !dont_removecont) ndv_removecont(-2,a);
3702: am = nd_ps[i] = ndv_dup(trace,w[i].p);
3703: ndv_mod(trace,am);
3704: if ( DL_COMPARE(HDL(am),HDL(a)) )
3705: return 0;
3706: ndv_removecont(trace,am);
3707: } else {
3708: a = nd_ps_trace[i] = ndv_dup(0,w[i].p);
3709: if ( !dont_removecont) ndv_removecont(0,a);
3710: register_hcf(a);
3711: am = nd_ps[i] = ndv_dup(mod,a);
3712: ndv_mod(mod,am);
3713: if ( DL_COMPARE(HDL(am),HDL(a)) )
3714: return 0;
3715: ndv_removecont(mod,am);
3716: }
3717: } else {
3718: a = nd_ps[i] = ndv_dup(mod,w[i].p);
3719: if ( mod || !dont_removecont ) ndv_removecont(mod,a);
3720: if ( !mod ) register_hcf(a);
1.1 noro 3721: }
1.6 noro 3722: if ( nd_gentrace ) {
3723: STOZ(i,iq); STOZ(w[i].i,jq); node = mknode(3,iq,jq,ONE);
3724: /* exact division */
1.1 noro 3725: if ( !dont_removecont )
1.6 noro 3726: ARG2(node) = (pointer)ndc_div(trace?0:mod,hc,HCU(a));
3727: MKLIST(l,node); NEXTNODE(nd_tracelist,tn); BDY(tn) = l;
3728: }
3729: NEWRHist(r); SG(r) = HTD(a); ndl_copy(HDL(a),DL(r));
3730: nd_bound[i] = ndv_compute_bound(a);
3731: nd_psh[i] = r;
3732: if ( nd_demand ) {
3733: if ( trace ) {
3734: ndv_save(nd_ps_trace[i],i);
3735: nd_ps_sym[i] = ndv_symbolic(mod,nd_ps_trace[i]);
3736: nd_ps_trace_sym[i] = ndv_symbolic(mod,nd_ps_trace[i]);
3737: nd_ps_trace[i] = 0;
3738: } else {
3739: ndv_save(nd_ps[i],i);
3740: nd_ps_sym[i] = ndv_symbolic(mod,nd_ps[i]);
3741: nd_ps[i] = 0;
3742: }
1.1 noro 3743: }
1.6 noro 3744: }
1.24 ! noro 3745: if ( sba ) {
! 3746: // setup signatures
! 3747: for ( i = 0; i < nd_psn; i++ ) {
! 3748: SIG sig;
! 3749:
! 3750: NEWSIG(sig); sig->pos = i;
! 3751: nd_ps[i]->sig = sig;
! 3752: if ( nd_demand ) nd_ps_sym[i]->sig = sig;
! 3753: nd_psh[i]->sig = sig;
! 3754: if ( trace ) {
! 3755: nd_ps_trace[i]->sig = sig;
! 3756: if ( nd_demand ) nd_ps_trace_sym[i]->sig = sig;
! 3757: }
! 3758: }
! 3759: }
1.6 noro 3760: if ( nd_gentrace && nd_tracelist ) NEXT(tn) = 0;
3761: return 1;
1.1 noro 3762: }
3763:
3764: struct order_spec *append_block(struct order_spec *spec,
3765: int nv,int nalg,int ord);
3766:
3767: extern VECT current_dl_weight_vector_obj;
3768: static VECT prev_weight_vector_obj;
3769:
3770: void preprocess_algcoef(VL vv,VL av,struct order_spec *ord,LIST f,
3771: struct order_spec **ord1p,LIST *f1p,NODE *alistp)
3772: {
3773: NODE alist,t,s,r0,r,arg;
3774: VL tv;
3775: P poly;
3776: DP d;
3777: Alg alpha,dp;
3778: DAlg inv,da,hc;
3779: MP m;
3780: int i,nvar,nalg,n;
3781: NumberField nf;
3782: LIST f1,f2;
3783: struct order_spec *current_spec;
3784: VECT obj,obj0;
3785: VECT tmp;
3786:
3787: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++);
3788: for ( nalg = 0, tv = av; tv; tv = NEXT(tv), nalg++);
3789:
3790: for ( alist = 0, tv = av; tv; tv = NEXT(tv) ) {
3791: NEXTNODE(alist,t); MKV(tv->v,poly);
3792: MKAlg(poly,alpha); BDY(t) = (pointer)alpha;
3793: tv->v = tv->v->priv;
3794: }
3795: NEXT(t) = 0;
3796:
3797: /* simplification, making polynomials monic */
3798: setfield_dalg(alist);
3799: obj_algtodalg((Obj)f,(Obj *)&f1);
3800: for ( t = BDY(f); t; t = NEXT(t) ) {
3801: initd(ord); ptod(vv,vv,(P)BDY(t),&d);
3802: hc = (DAlg)BDY(d)->c;
3803: if ( NID(hc) == N_DA ) {
3804: invdalg(hc,&inv);
3805: for ( m = BDY(d); m; m = NEXT(m) ) {
3806: muldalg(inv,(DAlg)m->c,&da); m->c = (Obj)da;
3807: }
3808: }
3809: initd(ord); dtop(vv,vv,d,(Obj *)&poly); BDY(f) = (pointer)poly;
3810: }
3811: obj_dalgtoalg((Obj)f1,(Obj *)&f);
3812:
3813: /* append alg vars to the var list */
3814: for ( tv = vv; NEXT(tv); tv = NEXT(tv) );
3815: NEXT(tv) = av;
3816:
3817: /* append a block to ord */
3818: *ord1p = append_block(ord,nvar,nalg,2);
3819:
3820: /* create generator list */
3821: nf = get_numberfield();
3822: for ( i = nalg-1, t = BDY(f); i >= 0; i-- ) {
3823: MKAlg(nf->defpoly[i],dp);
3824: MKNODE(s,dp,t); t = s;
3825: }
3826: MKLIST(f1,t);
3827: *alistp = alist;
3828: algobjtorat((Obj)f1,(Obj *)f1p);
3829:
3830: /* creating a new weight vector */
3831: prev_weight_vector_obj = obj0 = current_dl_weight_vector_obj;
3832: n = nvar+nalg+1;
3833: MKVECT(obj,n);
3834: if ( obj0 && obj0->len == nvar )
3835: for ( i = 0; i < nvar; i++ ) BDY(obj)[i] = BDY(obj0)[i];
3836: else
3837: for ( i = 0; i < nvar; i++ ) BDY(obj)[i] = (pointer)ONE;
3838: for ( i = 0; i < nalg; i++ ) BDY(obj)[i+nvar] = 0;
3839: BDY(obj)[n-1] = (pointer)ONE;
3840: arg = mknode(1,obj);
3841: Pdp_set_weight(arg,&tmp);
3842: }
3843:
3844: NODE postprocess_algcoef(VL av,NODE alist,NODE r)
3845: {
3846: NODE s,t,u0,u;
3847: P p;
3848: VL tv;
3849: Obj obj;
3850: VECT tmp;
3851: NODE arg;
3852:
3853: u0 = 0;
3854: for ( t = r; t; t = NEXT(t) ) {
3855: p = (P)BDY(t);
3856: for ( tv = av, s = alist; tv; tv = NEXT(tv), s = NEXT(s) ) {
3857: substr(CO,0,(Obj)p,tv->v,(Obj)BDY(s),&obj); p = (P)obj;
3858: }
3859: if ( OID(p) == O_P || (OID(p) == O_N && NID((Num)p) != N_A) ) {
3860: NEXTNODE(u0,u);
3861: BDY(u) = (pointer)p;
3862: }
3863: }
3864: arg = mknode(1,prev_weight_vector_obj);
3865: Pdp_set_weight(arg,&tmp);
3866:
3867: return u0;
3868: }
3869:
3870: void nd_gr(LIST f,LIST v,int m,int homo,int retdp,int f4,struct order_spec *ord,LIST *rp)
3871: {
3872: VL tv,fv,vv,vc,av;
3873: NODE fd,fd0,r,r0,t,x,s,xx,alist;
3874: int e,max,nvar,i;
3875: NDV b;
3876: int ishomo,nalg,mrank,trank,wmax,len;
3877: NMV a;
3878: Alg alpha,dp;
3879: P p,zp;
3880: Q dmy;
3881: LIST f1,f2,zpl;
3882: Obj obj;
3883: NumberField nf;
3884: struct order_spec *ord1;
3885: NODE tr,tl1,tl2,tl3,tl4,nzlist;
3886: LIST l1,l2,l3,l4,l5;
3887: int j;
3888: Z jq,bpe,last_nonzero;
3889: int *perm;
3890: EPOS oepos;
3891: int obpe,oadv,ompos,cbpe;
1.15 noro 3892: VECT hvect;
1.1 noro 3893:
3894: nd_module = 0;
3895: if ( !m && Demand ) nd_demand = 1;
3896: else nd_demand = 0;
3897: parse_nd_option(current_option);
3898:
3899: if ( DP_Multiple )
3900: nd_scale = ((double)DP_Multiple)/(double)(Denominator?Denominator:1);
3901: #if 0
3902: ndv_alloc = 0;
3903: #endif
3904: get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc);
3905: if ( m && nd_vc )
3906: error("nd_{gr,f4} : computation over Fp(X) is unsupported. Use dp_gr_mod_main().");
3907: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
3908: switch ( ord->id ) {
3909: case 1:
3910: if ( ord->nv != nvar )
3911: error("nd_{gr,f4} : invalid order specification");
3912: break;
3913: default:
3914: break;
3915: }
3916: nd_nalg = 0;
3917: av = 0;
3918: if ( !m ) {
3919: get_algtree((Obj)f,&av);
3920: for ( nalg = 0, tv = av; tv; tv = NEXT(tv), nalg++ );
3921: nd_ntrans = nvar;
3922: nd_nalg = nalg;
3923: /* #i -> t#i */
3924: if ( nalg ) {
3925: preprocess_algcoef(vv,av,ord,f,&ord1,&f1,&alist);
3926: ord = ord1;
3927: f = f1;
3928: }
3929: nvar += nalg;
3930: }
3931: nd_init_ord(ord);
3932: mrank = 0;
3933: for ( t = BDY(f), max = 1; t; t = NEXT(t) )
3934: for ( tv = vv; tv; tv = NEXT(tv) ) {
3935: if ( nd_module ) {
1.16 noro 3936: if ( OID(BDY(t)) == O_DPM ) {
3937: e = dpm_getdeg((DPM)BDY(t),&trank);
3938: max = MAX(e,max);
3939: mrank = MAX(mrank,trank);
3940: } else {
3941: s = BDY((LIST)BDY(t));
3942: trank = length(s);
3943: mrank = MAX(mrank,trank);
3944: for ( ; s; s = NEXT(s) ) {
3945: e = getdeg(tv->v,(P)BDY(s));
3946: max = MAX(e,max);
3947: }
1.1 noro 3948: }
3949: } else {
3950: e = getdeg(tv->v,(P)BDY(t));
3951: max = MAX(e,max);
3952: }
3953: }
3954: nd_setup_parameters(nvar,nd_nzlist?0:max);
3955: obpe = nd_bpe; oadv = nmv_adv; oepos = nd_epos; ompos = nd_mpos;
3956: ishomo = 1;
3957: for ( fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
3958: if ( nd_module ) {
1.16 noro 3959: if ( OID(BDY(t)) == O_DPM ) {
3960: Z cont;
3961: DPM zdpm;
3962:
3963: if ( !m && !nd_gentrace ) dpm_ptozp((DPM)BDY(t),&cont,&zdpm);
3964: else zdpm = (DPM)BDY(t);
3965: b = (pointer)dpmtondv(m,zdpm);
3966: } else {
3967: if ( !m && !nd_gentrace ) pltozpl((LIST)BDY(t),&dmy,&zpl);
3968: else zpl = (LIST)BDY(t);
1.1 noro 3969: b = (pointer)pltondv(CO,vv,zpl);
1.16 noro 3970: }
1.1 noro 3971: } else {
3972: if ( !m && !nd_gentrace ) ptozp((P)BDY(t),1,&dmy,&zp);
3973: else zp = (P)BDY(t);
3974: b = (pointer)ptondv(CO,vv,zp);
3975: }
3976: if ( ishomo )
3977: ishomo = ishomo && ndv_ishomo(b);
3978: if ( m ) ndv_mod(m,b);
3979: if ( b ) { NEXTNODE(fd0,fd); BDY(fd) = (pointer)b; }
3980: }
3981: if ( fd0 ) NEXT(fd) = 0;
3982:
3983: if ( !ishomo && homo ) {
3984: for ( t = fd0, wmax = max; t; t = NEXT(t) ) {
3985: b = (NDV)BDY(t); len = LEN(b);
3986: for ( a = BDY(b), i = 0; i < len; i++, NMV_ADV(a) )
3987: wmax = MAX(TD(DL(a)),wmax);
3988: }
3989: homogenize_order(ord,nvar,&ord1);
3990: nd_init_ord(ord1);
3991: nd_setup_parameters(nvar+1,nd_nzlist?0:wmax);
3992: for ( t = fd0; t; t = NEXT(t) )
3993: ndv_homogenize((NDV)BDY(t),obpe,oadv,oepos,ompos);
3994: }
3995:
1.24 ! noro 3996: ndv_setup(m,0,fd0,(nd_gbblock||nd_splist||nd_check_splist)?1:0,0,0);
1.1 noro 3997: if ( nd_gentrace ) {
3998: MKLIST(l1,nd_tracelist); MKNODE(nd_alltracelist,l1,0);
3999: }
4000: if ( nd_splist ) {
4001: *rp = compute_splist();
4002: return;
4003: }
4004: if ( nd_check_splist ) {
4005: if ( f4 ) {
4006: if ( check_splist_f4(m,nd_check_splist) ) *rp = (LIST)ONE;
4007: else *rp = 0;
4008: } else {
4009: if ( check_splist(m,nd_check_splist) ) *rp = (LIST)ONE;
4010: else *rp = 0;
4011: }
4012: return;
4013: }
4014: x = f4?nd_f4(m,0,&perm):nd_gb(m,ishomo || homo,0,0,&perm);
4015: if ( !x ) {
4016: *rp = 0; return;
4017: }
1.15 noro 4018: if ( nd_gentrace ) {
4019: MKVECT(hvect,nd_psn);
4020: for ( i = 0; i < nd_psn; i++ )
4021: ndltodp(nd_psh[i]->dl,(DP *)&BDY(hvect)[i]);
4022: }
1.1 noro 4023: if ( !ishomo && homo ) {
4024: /* dehomogenization */
4025: for ( t = x; t; t = NEXT(t) ) ndv_dehomogenize((NDV)BDY(t),ord);
4026: nd_init_ord(ord);
4027: nd_setup_parameters(nvar,0);
4028: }
4029: nd_demand = 0;
4030: if ( nd_module && nd_intersect ) {
4031: for ( j = nd_psn-1, x = 0; j >= 0; j-- )
1.17 noro 4032: if ( MPOS(DL(nd_psh[j])) > nd_intersect ) {
1.1 noro 4033: MKNODE(xx,(pointer)((unsigned long)j),x); x = xx;
4034: }
4035: conv_ilist(nd_demand,0,x,0);
4036: goto FINAL;
4037: }
4038: if ( nd_gentrace && f4 ) { nzlist = nd_alltracelist; }
4039: x = ndv_reducebase(x,perm);
4040: if ( nd_gentrace && !f4 ) { tl1 = nd_alltracelist; nd_alltracelist = 0; }
4041: x = ndv_reduceall(m,x);
4042: cbpe = nd_bpe;
4043: if ( nd_gentrace && !f4 ) {
4044: tl2 = nd_alltracelist; nd_alltracelist = 0;
4045: ndv_check_membership(m,fd0,obpe,oadv,oepos,x);
4046: tl3 = nd_alltracelist; nd_alltracelist = 0;
4047: if ( nd_gensyz ) {
4048: nd_gb(m,0,1,1,0);
4049: tl4 = nd_alltracelist; nd_alltracelist = 0;
4050: } else tl4 = 0;
4051: }
4052: nd_bpe = cbpe;
4053: nd_setup_parameters(nd_nvar,0);
4054: FINAL:
4055: for ( r0 = 0, t = x; t; t = NEXT(t) ) {
1.16 noro 4056: NEXTNODE(r0,r);
4057: if ( nd_module ) {
4058: if ( retdp ) BDY(r) = ndvtodpm(m,BDY(t));
4059: else BDY(r) = ndvtopl(m,CO,vv,BDY(t),mrank);
4060: } else if ( retdp ) BDY(r) = ndvtodp(m,BDY(t));
4061: else BDY(r) = ndvtop(m,CO,vv,BDY(t));
1.1 noro 4062: }
4063: if ( r0 ) NEXT(r) = 0;
4064: if ( !m && nd_nalg )
4065: r0 = postprocess_algcoef(av,alist,r0);
4066: MKLIST(*rp,r0);
4067: if ( nd_gentrace ) {
4068: if ( f4 ) {
1.6 noro 4069: STOZ(16,bpe);
4070: STOZ(nd_last_nonzero,last_nonzero);
1.15 noro 4071: tr = mknode(6,*rp,(!ishomo&&homo)?ONE:0,BDY(nzlist),bpe,last_nonzero,hvect); MKLIST(*rp,tr);
1.1 noro 4072: } else {
4073: tl1 = reverse_node(tl1); tl2 = reverse_node(tl2);
4074: tl3 = reverse_node(tl3);
4075: /* tl2 = [[i,[[*,j,*,*],...]],...] */
4076: for ( t = tl2; t; t = NEXT(t) ) {
4077: /* s = [i,[*,j,*,*],...] */
4078: s = BDY((LIST)BDY(t));
1.6 noro 4079: j = perm[ZTOS((Q)ARG0(s))]; STOZ(j,jq); ARG0(s) = (pointer)jq;
1.1 noro 4080: for ( s = BDY((LIST)ARG1(s)); s; s = NEXT(s) ) {
1.6 noro 4081: j = perm[ZTOS((Q)ARG1(BDY((LIST)BDY(s))))]; STOZ(j,jq);
1.1 noro 4082: ARG1(BDY((LIST)BDY(s))) = (pointer)jq;
4083: }
4084: }
4085: for ( j = length(x)-1, t = 0; j >= 0; j-- ) {
1.6 noro 4086: STOZ(perm[j],jq); MKNODE(s,jq,t); t = s;
1.1 noro 4087: }
4088: MKLIST(l1,tl1); MKLIST(l2,tl2); MKLIST(l3,t); MKLIST(l4,tl3);
4089: MKLIST(l5,tl4);
1.6 noro 4090: STOZ(nd_bpe,bpe);
1.15 noro 4091: tr = mknode(9,*rp,(!ishomo&&homo)?ONE:0,l1,l2,l3,l4,l5,bpe,hvect); MKLIST(*rp,tr);
1.1 noro 4092: }
4093: }
4094: #if 0
4095: fprintf(asir_out,"ndv_alloc=%d\n",ndv_alloc);
4096: #endif
4097: }
4098:
1.24 ! noro 4099: void nd_sba(LIST f,LIST v,int m,int homo,int retdp,struct order_spec *ord,LIST *rp)
! 4100: {
! 4101: VL tv,fv,vv,vc,av;
! 4102: NODE fd,fd0,r,r0,t,x,s,xx;
! 4103: int e,max,nvar,i;
! 4104: NDV b;
! 4105: int ishomo,nalg,wmax,len;
! 4106: NMV a;
! 4107: P p,zp;
! 4108: Q dmy;
! 4109: struct order_spec *ord1;
! 4110: int j;
! 4111: int *perm;
! 4112: EPOS oepos;
! 4113: int obpe,oadv,ompos,cbpe;
! 4114:
! 4115: nd_module = 0;
! 4116: nd_demand = 0;
! 4117: parse_nd_option(current_option);
! 4118:
! 4119: if ( DP_Multiple )
! 4120: nd_scale = ((double)DP_Multiple)/(double)(Denominator?Denominator:1);
! 4121: get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc);
! 4122: if ( m && nd_vc )
! 4123: error("nd_sba : computation over Fp(X) is unsupported. Use dp_gr_mod_main().");
! 4124: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
! 4125: switch ( ord->id ) {
! 4126: case 1:
! 4127: if ( ord->nv != nvar )
! 4128: error("nd_sba : invalid order specification");
! 4129: break;
! 4130: default:
! 4131: break;
! 4132: }
! 4133: nd_nalg = 0;
! 4134: nd_init_ord(ord);
! 4135: // for SIG comparison
! 4136: initd(ord);
! 4137: for ( t = BDY(f), max = 1; t; t = NEXT(t) ) {
! 4138: for ( tv = vv; tv; tv = NEXT(tv) ) {
! 4139: e = getdeg(tv->v,(P)BDY(t));
! 4140: max = MAX(e,max);
! 4141: }
! 4142: }
! 4143: // nd_setup_parameters(nvar,max);
! 4144: nd_setup_parameters(nvar,16);
! 4145: obpe = nd_bpe; oadv = nmv_adv; oepos = nd_epos; ompos = nd_mpos;
! 4146: ishomo = 1;
! 4147: for ( fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
! 4148: if ( !m ) ptozp((P)BDY(t),1,&dmy,&zp);
! 4149: else zp = (P)BDY(t);
! 4150: b = (pointer)ptondv(CO,vv,zp);
! 4151: if ( ishomo )
! 4152: ishomo = ishomo && ndv_ishomo(b);
! 4153: if ( m ) ndv_mod(m,b);
! 4154: if ( b ) { NEXTNODE(fd0,fd); BDY(fd) = (pointer)b; }
! 4155: }
! 4156: if ( fd0 ) NEXT(fd) = 0;
! 4157:
! 4158: if ( !ishomo && homo ) {
! 4159: for ( t = fd0, wmax = max; t; t = NEXT(t) ) {
! 4160: b = (NDV)BDY(t); len = LEN(b);
! 4161: for ( a = BDY(b), i = 0; i < len; i++, NMV_ADV(a) )
! 4162: wmax = MAX(TD(DL(a)),wmax);
! 4163: }
! 4164: homogenize_order(ord,nvar,&ord1);
! 4165: nd_init_ord(ord1);
! 4166: nd_setup_parameters(nvar+1,nd_nzlist?0:wmax);
! 4167: for ( t = fd0; t; t = NEXT(t) )
! 4168: ndv_homogenize((NDV)BDY(t),obpe,oadv,oepos,ompos);
! 4169: }
! 4170:
! 4171: ndv_setup(m,0,fd0,0,0,1);
! 4172: x = nd_sba_buch(m,ishomo || homo,&perm);
! 4173: if ( !x ) {
! 4174: *rp = 0; return;
! 4175: }
! 4176: if ( !ishomo && homo ) {
! 4177: /* dehomogenization */
! 4178: for ( t = x; t; t = NEXT(t) ) ndv_dehomogenize((NDV)BDY(t),ord);
! 4179: nd_init_ord(ord);
! 4180: nd_setup_parameters(nvar,0);
! 4181: }
! 4182: nd_demand = 0;
! 4183: x = ndv_reducebase(x,perm);
! 4184: x = ndv_reduceall(m,x);
! 4185: nd_setup_parameters(nd_nvar,0);
! 4186: for ( r0 = 0, t = x; t; t = NEXT(t) ) {
! 4187: NEXTNODE(r0,r);
! 4188: if ( retdp ) BDY(r) = ndvtodp(m,BDY(t));
! 4189: BDY(r) = ndvtop(m,CO,vv,BDY(t));
! 4190: }
! 4191: if ( r0 ) NEXT(r) = 0;
! 4192: MKLIST(*rp,r0);
! 4193: }
! 4194:
1.1 noro 4195: void nd_gr_postproc(LIST f,LIST v,int m,struct order_spec *ord,int do_check,LIST *rp)
4196: {
4197: VL tv,fv,vv,vc,av;
4198: NODE fd,fd0,r,r0,t,x,s,xx,alist;
4199: int e,max,nvar,i;
4200: NDV b;
4201: int ishomo,nalg;
4202: Alg alpha,dp;
4203: P p,zp;
4204: Q dmy;
4205: LIST f1,f2;
4206: Obj obj;
4207: NumberField nf;
4208: struct order_spec *ord1;
4209: int *perm;
4210:
4211: parse_nd_option(current_option);
4212: get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc);
4213: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
4214: switch ( ord->id ) {
4215: case 1:
4216: if ( ord->nv != nvar )
4217: error("nd_check : invalid order specification");
4218: break;
4219: default:
4220: break;
4221: }
4222: nd_nalg = 0;
4223: av = 0;
4224: if ( !m ) {
4225: get_algtree((Obj)f,&av);
4226: for ( nalg = 0, tv = av; tv; tv = NEXT(tv), nalg++ );
4227: nd_ntrans = nvar;
4228: nd_nalg = nalg;
4229: /* #i -> t#i */
4230: if ( nalg ) {
4231: preprocess_algcoef(vv,av,ord,f,&ord1,&f1,&alist);
4232: ord = ord1;
4233: f = f1;
4234: }
4235: nvar += nalg;
4236: }
4237: nd_init_ord(ord);
4238: for ( t = BDY(f), max = 1; t; t = NEXT(t) )
4239: for ( tv = vv; tv; tv = NEXT(tv) ) {
4240: e = getdeg(tv->v,(P)BDY(t));
4241: max = MAX(e,max);
4242: }
4243: nd_setup_parameters(nvar,max);
4244: ishomo = 1;
4245: for ( fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
4246: ptozp((P)BDY(t),1,&dmy,&zp);
4247: b = (pointer)ptondv(CO,vv,zp);
4248: if ( ishomo )
4249: ishomo = ishomo && ndv_ishomo(b);
4250: if ( m ) ndv_mod(m,b);
4251: if ( b ) { NEXTNODE(fd0,fd); BDY(fd) = (pointer)b; }
4252: }
4253: if ( fd0 ) NEXT(fd) = 0;
1.24 ! noro 4254: ndv_setup(m,0,fd0,0,1,0);
1.1 noro 4255: for ( x = 0, i = 0; i < nd_psn; i++ )
4256: x = update_base(x,i);
4257: if ( do_check ) {
4258: x = nd_gb(m,ishomo,1,0,&perm);
4259: if ( !x ) {
4260: *rp = 0;
4261: return;
4262: }
4263: } else {
4264: #if 0
4265: /* bug ? */
4266: for ( t = x; t; t = NEXT(t) )
4267: BDY(t) = (pointer)nd_ps[(long)BDY(t)];
4268: #else
4269: conv_ilist(0,0,x,&perm);
4270: #endif
4271: }
4272: x = ndv_reducebase(x,perm);
4273: x = ndv_reduceall(m,x);
4274: for ( r0 = 0, t = x; t; t = NEXT(t) ) {
4275: NEXTNODE(r0,r);
4276: BDY(r) = ndvtop(m,CO,vv,BDY(t));
4277: }
4278: if ( r0 ) NEXT(r) = 0;
4279: if ( !m && nd_nalg )
4280: r0 = postprocess_algcoef(av,alist,r0);
4281: MKLIST(*rp,r0);
4282: }
4283:
4284: NDV recompute_trace(NODE trace,NDV *p,int m);
4285: void nd_gr_recompute_trace(LIST f,LIST v,int m,struct order_spec *ord,LIST tlist,LIST *rp);
4286:
4287: NDV recompute_trace(NODE ti,NDV *p,int mod)
4288: {
4289: int c,c1,c2,i;
4290: NM mul,m,tail;
4291: ND d,r,rm;
4292: NODE sj;
4293: NDV red;
4294: Obj mj;
4295:
4296: mul = (NM)MALLOC(sizeof(struct oNM)+(nd_wpd-1)*sizeof(UINT));
4297: CM(mul) = 1;
4298: tail = 0;
4299: for ( i = 0, d = r = 0; ti; ti = NEXT(ti), i++ ) {
4300: sj = BDY((LIST)BDY(ti));
4301: if ( ARG0(sj) ) {
1.6 noro 4302: red = p[ZTOS((Q)ARG1(sj))];
1.1 noro 4303: mj = (Obj)ARG2(sj);
4304: if ( OID(mj) != O_DP ) ndl_zero(DL(mul));
4305: else dltondl(nd_nvar,BDY((DP)mj)->dl,DL(mul));
4306: rm = ndv_mul_nm(mod,mul,red);
4307: if ( !r ) r = rm;
4308: else {
4309: for ( m = BDY(r); m && !ndl_equal(m->dl,BDY(rm)->dl); m = NEXT(m), LEN(r)-- ) {
4310: if ( d ) {
4311: NEXT(tail) = m; tail = m; LEN(d)++;
4312: } else {
4313: MKND(nd_nvar,m,1,d); tail = BDY(d);
4314: }
4315: }
4316: if ( !m ) return 0; /* failure */
4317: else {
4318: BDY(r) = m;
4319: if ( mod > 0 || mod == -1 ) {
4320: c1 = invm(HCM(rm),mod); c2 = mod-HCM(r);
4321: DMAR(c1,c2,0,mod,c);
4322: nd_mul_c(mod,rm,c);
4323: } else {
4324: Z t,u;
4325:
4326: chsgnlf(HCZ(r),&t);
4327: divlf(t,HCZ(rm),&u);
4328: nd_mul_c_lf(rm,u);
4329: }
4330: r = nd_add(mod,r,rm);
4331: }
4332: }
4333: }
4334: }
4335: if ( tail ) NEXT(tail) = 0;
4336: d = nd_add(mod,d,r);
4337: nd_mul_c(mod,d,invm(HCM(d),mod));
4338: return ndtondv(mod,d);
4339: }
4340:
4341: void nd_gr_recompute_trace(LIST f,LIST v,int m,struct order_spec *ord,LIST tlist,LIST *rp)
4342: {
4343: VL tv,fv,vv,vc,av;
4344: NODE fd,fd0,r,r0,t,x,s,xx,alist;
4345: int e,max,nvar,i;
4346: NDV b;
4347: int ishomo,nalg;
4348: Alg alpha,dp;
4349: P p,zp;
4350: Q dmy;
4351: LIST f1,f2;
4352: Obj obj;
4353: NumberField nf;
4354: struct order_spec *ord1;
4355: NODE permtrace,intred,ind,perm,trace,ti;
4356: int len,n,j;
4357: NDV *db,*pb;
4358:
4359: parse_nd_option(current_option);
4360: get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc);
4361: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
4362: switch ( ord->id ) {
4363: case 1:
4364: if ( ord->nv != nvar )
4365: error("nd_check : invalid order specification");
4366: break;
4367: default:
4368: break;
4369: }
4370: nd_init_ord(ord);
1.6 noro 4371: nd_bpe = ZTOS((Q)ARG7(BDY(tlist)));
1.1 noro 4372: nd_setup_parameters(nvar,0);
4373:
4374: len = length(BDY(f));
4375: db = (NDV *)MALLOC(len*sizeof(NDV *));
4376: for ( i = 0, t = BDY(f); t; i++, t = NEXT(t) ) {
4377: ptozp((P)BDY(t),1,&dmy,&zp);
4378: b = ptondv(CO,vv,zp);
4379: ndv_mod(m,b);
4380: ndv_mul_c(m,b,invm(HCM(b),m));
4381: db[i] = b;
4382: }
4383:
4384: permtrace = BDY((LIST)ARG2(BDY(tlist)));
4385: intred = BDY((LIST)ARG3(BDY(tlist)));
4386: ind = BDY((LIST)ARG4(BDY(tlist)));
4387: perm = BDY((LIST)ARG0(permtrace));
4388: trace = NEXT(permtrace);
4389:
4390: for ( i = length(perm)-1, t = trace; t; t = NEXT(t) ) {
1.6 noro 4391: j = ZTOS((Q)ARG0(BDY((LIST)BDY(t))));
1.1 noro 4392: if ( j > i ) i = j;
4393: }
4394: n = i+1;
4395: pb = (NDV *)MALLOC(n*sizeof(NDV *));
4396: for ( t = perm, i = 0; t; t = NEXT(t), i++ ) {
4397: ti = BDY((LIST)BDY(t));
1.6 noro 4398: pb[ZTOS((Q)ARG0(ti))] = db[ZTOS((Q)ARG1(ti))];
1.1 noro 4399: }
4400: for ( t = trace; t; t = NEXT(t) ) {
4401: ti = BDY((LIST)BDY(t));
1.6 noro 4402: pb[ZTOS((Q)ARG0(ti))] = recompute_trace(BDY((LIST)ARG1(ti)),pb,m);
4403: if ( !pb[ZTOS((Q)ARG0(ti))] ) { *rp = 0; return; }
1.1 noro 4404: if ( DP_Print ) {
4405: fprintf(asir_out,"."); fflush(asir_out);
4406: }
4407: }
4408: for ( t = intred; t; t = NEXT(t) ) {
4409: ti = BDY((LIST)BDY(t));
1.6 noro 4410: pb[ZTOS((Q)ARG0(ti))] = recompute_trace(BDY((LIST)ARG1(ti)),pb,m);
4411: if ( !pb[ZTOS((Q)ARG0(ti))] ) { *rp = 0; return; }
1.1 noro 4412: if ( DP_Print ) {
4413: fprintf(asir_out,"*"); fflush(asir_out);
4414: }
4415: }
4416: for ( r0 = 0, t = ind; t; t = NEXT(t) ) {
4417: NEXTNODE(r0,r);
1.6 noro 4418: b = pb[ZTOS((Q)BDY(t))];
1.1 noro 4419: ndv_mul_c(m,b,invm(HCM(b),m));
4420: #if 0
1.6 noro 4421: BDY(r) = ndvtop(m,CO,vv,pb[ZTOS((Q)BDY(t))]);
1.1 noro 4422: #else
1.6 noro 4423: BDY(r) = ndvtodp(m,pb[ZTOS((Q)BDY(t))]);
1.1 noro 4424: #endif
4425: }
4426: if ( r0 ) NEXT(r) = 0;
4427: MKLIST(*rp,r0);
4428: if ( DP_Print ) fprintf(asir_out,"\n");
4429: }
4430:
1.16 noro 4431: void nd_gr_trace(LIST f,LIST v,int trace,int homo,int retdp,int f4,struct order_spec *ord,LIST *rp)
1.1 noro 4432: {
4433: VL tv,fv,vv,vc,av;
4434: NODE fd,fd0,in0,in,r,r0,t,s,cand,alist;
4435: int m,nocheck,nvar,mindex,e,max;
4436: NDV c;
4437: NMV a;
4438: P p,zp;
4439: Q dmy;
4440: EPOS oepos;
4441: int obpe,oadv,wmax,i,len,cbpe,ishomo,nalg,mrank,trank,ompos;
4442: Alg alpha,dp;
4443: P poly;
4444: LIST f1,f2,zpl;
4445: Obj obj;
4446: NumberField nf;
4447: struct order_spec *ord1;
4448: struct oEGT eg_check,eg0,eg1;
4449: NODE tr,tl1,tl2,tl3,tl4;
4450: LIST l1,l2,l3,l4,l5;
4451: int *perm;
4452: int j,ret;
4453: Z jq,bpe;
1.15 noro 4454: VECT hvect;
1.1 noro 4455:
4456: nd_module = 0;
4457: nd_lf = 0;
4458: parse_nd_option(current_option);
4459: if ( nd_lf ) {
4460: if ( f4 )
4461: nd_f4_lf_trace(f,v,trace,homo,ord,rp);
4462: else
4463: error("nd_gr_trace is not implemented yet over a large finite field");
4464: return;
4465: }
4466: if ( DP_Multiple )
4467: nd_scale = ((double)DP_Multiple)/(double)(Denominator?Denominator:1);
4468:
4469: get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc);
4470: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
4471: switch ( ord->id ) {
4472: case 1:
4473: if ( ord->nv != nvar )
4474: error("nd_gr_trace : invalid order specification");
4475: break;
4476: default:
4477: break;
4478: }
4479:
4480: get_algtree((Obj)f,&av);
4481: for ( nalg = 0, tv = av; tv; tv = NEXT(tv), nalg++ );
4482: nd_ntrans = nvar;
4483: nd_nalg = nalg;
4484: /* #i -> t#i */
4485: if ( nalg ) {
4486: preprocess_algcoef(vv,av,ord,f,&ord1,&f1,&alist);
4487: ord = ord1;
4488: f = f1;
4489: }
4490: nvar += nalg;
4491:
4492: nocheck = 0;
4493: mindex = 0;
4494:
4495: if ( Demand ) nd_demand = 1;
4496: else nd_demand = 0;
4497:
4498: /* setup modulus */
4499: if ( trace < 0 ) {
4500: trace = -trace;
4501: nocheck = 1;
4502: }
4503: m = trace > 1 ? trace : get_lprime(mindex);
4504: nd_init_ord(ord);
4505: mrank = 0;
4506: for ( t = BDY(f), max = 1; t; t = NEXT(t) )
4507: for ( tv = vv; tv; tv = NEXT(tv) ) {
4508: if ( nd_module ) {
1.16 noro 4509: if ( OID(BDY(t)) == O_DPM ) {
4510: e = dpm_getdeg((DPM)BDY(t),&trank);
4511: max = MAX(e,max);
4512: mrank = MAX(mrank,trank);
4513: } else {
1.1 noro 4514: s = BDY((LIST)BDY(t));
4515: trank = length(s);
4516: mrank = MAX(mrank,trank);
4517: for ( ; s; s = NEXT(s) ) {
4518: e = getdeg(tv->v,(P)BDY(s));
4519: max = MAX(e,max);
4520: }
1.16 noro 4521: }
1.1 noro 4522: } else {
4523: e = getdeg(tv->v,(P)BDY(t));
4524: max = MAX(e,max);
4525: }
4526: }
4527: nd_setup_parameters(nvar,max);
4528: obpe = nd_bpe; oadv = nmv_adv; oepos = nd_epos; ompos = nd_mpos;
4529: ishomo = 1;
4530: for ( in0 = 0, fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
4531: if ( nd_module ) {
1.16 noro 4532: if ( OID(BDY(t)) == O_DPM ) {
4533: Z cont;
4534: DPM zdpm;
4535:
1.17 noro 4536: if ( !nd_gentrace ) dpm_ptozp((DPM)BDY(t),&cont,&zdpm);
1.16 noro 4537: else zdpm = (DPM)BDY(t);
4538: c = (pointer)dpmtondv(m,zdpm);
4539: } else {
4540: if ( !nd_gentrace ) pltozpl((LIST)BDY(t),&dmy,&zpl);
4541: else zpl = (LIST)BDY(t);
1.1 noro 4542: c = (pointer)pltondv(CO,vv,zpl);
1.16 noro 4543: }
1.1 noro 4544: } else {
1.16 noro 4545: if ( !nd_gentrace ) ptozp((P)BDY(t),1,&dmy,&zp);
4546: else zp = (P)BDY(t);
4547: c = (pointer)ptondv(CO,vv,zp);
1.1 noro 4548: }
4549: if ( ishomo )
4550: ishomo = ishomo && ndv_ishomo(c);
4551: if ( c ) {
4552: NEXTNODE(in0,in); BDY(in) = (pointer)c;
4553: NEXTNODE(fd0,fd); BDY(fd) = (pointer)ndv_dup(0,c);
4554: }
4555: }
4556: if ( in0 ) NEXT(in) = 0;
4557: if ( fd0 ) NEXT(fd) = 0;
4558: if ( !ishomo && homo ) {
4559: for ( t = in0, wmax = max; t; t = NEXT(t) ) {
4560: c = (NDV)BDY(t); len = LEN(c);
4561: for ( a = BDY(c), i = 0; i < len; i++, NMV_ADV(a) )
4562: wmax = MAX(TD(DL(a)),wmax);
4563: }
4564: homogenize_order(ord,nvar,&ord1);
4565: nd_init_ord(ord1);
4566: nd_setup_parameters(nvar+1,wmax);
4567: for ( t = fd0; t; t = NEXT(t) )
4568: ndv_homogenize((NDV)BDY(t),obpe,oadv,oepos,ompos);
4569: }
4570: if ( MaxDeg > 0 ) nocheck = 1;
4571: while ( 1 ) {
4572: tl1 = tl2 = tl3 = tl4 = 0;
4573: if ( Demand )
4574: nd_demand = 1;
1.24 ! noro 4575: ret = ndv_setup(m,1,fd0,nd_gbblock?1:0,0,0);
1.1 noro 4576: if ( nd_gentrace ) {
4577: MKLIST(l1,nd_tracelist); MKNODE(nd_alltracelist,l1,0);
4578: }
4579: if ( ret )
4580: cand = f4?nd_f4_trace(m,&perm):nd_gb_trace(m,ishomo || homo,&perm);
4581: if ( !ret || !cand ) {
4582: /* failure */
4583: if ( trace > 1 ) { *rp = 0; return; }
4584: else m = get_lprime(++mindex);
4585: continue;
4586: }
1.15 noro 4587: if ( nd_gentrace ) {
4588: MKVECT(hvect,nd_psn);
4589: for ( i = 0; i < nd_psn; i++ )
4590: ndltodp(nd_psh[i]->dl,(DP *)&BDY(hvect)[i]);
4591: }
1.1 noro 4592: if ( !ishomo && homo ) {
4593: /* dehomogenization */
4594: for ( t = cand; t; t = NEXT(t) ) ndv_dehomogenize((NDV)BDY(t),ord);
4595: nd_init_ord(ord);
4596: nd_setup_parameters(nvar,0);
4597: }
4598: nd_demand = 0;
4599: cand = ndv_reducebase(cand,perm);
4600: if ( nd_gentrace ) { tl1 = nd_alltracelist; nd_alltracelist = 0; }
4601: cand = ndv_reduceall(0,cand);
4602: cbpe = nd_bpe;
4603: if ( nd_gentrace ) { tl2 = nd_alltracelist; nd_alltracelist = 0; }
4604: get_eg(&eg0);
4605: if ( nocheck )
4606: break;
4607: if ( (ret = ndv_check_membership(0,in0,obpe,oadv,oepos,cand)) != 0 ) {
4608: if ( nd_gentrace ) {
4609: tl3 = nd_alltracelist; nd_alltracelist = 0;
4610: } else tl3 = 0;
4611: /* gbcheck : cand is a GB of Id(cand) ? */
4612: if ( nd_vc || nd_gentrace || nd_gensyz )
4613: ret = nd_gb(0,0,1,nd_gensyz?1:0,0)!=0;
4614: else
4615: ret = nd_f4(0,1,0)!=0;
4616: if ( nd_gentrace && nd_gensyz ) {
4617: tl4 = nd_alltracelist; nd_alltracelist = 0;
4618: } else tl4 = 0;
4619: }
4620: if ( ret ) break;
4621: else if ( trace > 1 ) {
4622: /* failure */
4623: *rp = 0; return;
4624: } else {
4625: /* try the next modulus */
4626: m = get_lprime(++mindex);
4627: /* reset the parameters */
4628: if ( !ishomo && homo ) {
4629: nd_init_ord(ord1);
4630: nd_setup_parameters(nvar+1,wmax);
4631: } else {
4632: nd_init_ord(ord);
4633: nd_setup_parameters(nvar,max);
4634: }
4635: }
4636: }
4637: get_eg(&eg1); init_eg(&eg_check); add_eg(&eg_check,&eg0,&eg1);
4638: if ( DP_Print )
1.6 noro 4639: fprintf(asir_out,"check=%.3fsec\n",eg_check.exectime);
1.1 noro 4640: /* dp->p */
4641: nd_bpe = cbpe;
4642: nd_setup_parameters(nd_nvar,0);
4643: for ( r = cand; r; r = NEXT(r) ) {
1.16 noro 4644: if ( nd_module ) {
1.17 noro 4645: if ( retdp ) BDY(r) = ndvtodpm(0,BDY(r));
1.16 noro 4646: else BDY(r) = ndvtopl(0,CO,vv,BDY(r),mrank);
1.17 noro 4647: } else if ( retdp ) BDY(r) = ndvtodp(0,BDY(r));
4648: else BDY(r) = (pointer)ndvtop(0,CO,vv,BDY(r));
1.1 noro 4649: }
4650: if ( nd_nalg )
4651: cand = postprocess_algcoef(av,alist,cand);
4652: MKLIST(*rp,cand);
4653: if ( nd_gentrace ) {
4654: tl1 = reverse_node(tl1); tl2 = reverse_node(tl2);
4655: tl3 = reverse_node(tl3);
4656: /* tl2 = [[i,[[*,j,*,*],...]],...] */
4657: for ( t = tl2; t; t = NEXT(t) ) {
4658: /* s = [i,[*,j,*,*],...] */
4659: s = BDY((LIST)BDY(t));
1.6 noro 4660: j = perm[ZTOS((Q)ARG0(s))]; STOZ(j,jq); ARG0(s) = (pointer)jq;
1.1 noro 4661: for ( s = BDY((LIST)ARG1(s)); s; s = NEXT(s) ) {
1.6 noro 4662: j = perm[ZTOS((Q)ARG1(BDY((LIST)BDY(s))))]; STOZ(j,jq);
1.1 noro 4663: ARG1(BDY((LIST)BDY(s))) = (pointer)jq;
4664: }
4665: }
4666: for ( j = length(cand)-1, t = 0; j >= 0; j-- ) {
1.6 noro 4667: STOZ(perm[j],jq); MKNODE(s,jq,t); t = s;
1.1 noro 4668: }
4669: MKLIST(l1,tl1); MKLIST(l2,tl2); MKLIST(l3,t); MKLIST(l4,tl3);
4670: MKLIST(l5,tl4);
1.6 noro 4671: STOZ(nd_bpe,bpe);
1.15 noro 4672: tr = mknode(9,*rp,(!ishomo&&homo)?ONE:0,l1,l2,l3,l4,l5,bpe,hvect); MKLIST(*rp,tr);
1.1 noro 4673: }
4674: }
4675:
4676: /* XXX : module element is not considered */
4677:
4678: void dltondl(int n,DL dl,UINT *r)
4679: {
4680: UINT *d;
4681: int i,j,l,s,ord_l;
4682: struct order_pair *op;
4683:
4684: d = (unsigned int *)dl->d;
4685: for ( i = 0; i < nd_wpd; i++ ) r[i] = 0;
4686: if ( nd_blockmask ) {
4687: l = nd_blockmask->n;
4688: op = nd_blockmask->order_pair;
4689: for ( j = 0, s = 0; j < l; j++ ) {
4690: ord_l = op[j].length;
4691: for ( i = 0; i < ord_l; i++, s++ ) PUT_EXP(r,s,d[s]);
4692: }
4693: TD(r) = ndl_weight(r);
4694: ndl_weight_mask(r);
4695: } else {
4696: for ( i = 0; i < n; i++ ) PUT_EXP(r,i,d[i]);
4697: TD(r) = ndl_weight(r);
4698: }
4699: }
4700:
4701: DL ndltodl(int n,UINT *ndl)
4702: {
4703: DL dl;
4704: int *d;
4705: int i,j,l,s,ord_l;
4706: struct order_pair *op;
4707:
4708: NEWDL(dl,n);
4709: dl->td = TD(ndl);
4710: d = dl->d;
4711: if ( nd_blockmask ) {
4712: l = nd_blockmask->n;
4713: op = nd_blockmask->order_pair;
4714: for ( j = 0, s = 0; j < l; j++ ) {
4715: ord_l = op[j].length;
4716: for ( i = 0; i < ord_l; i++, s++ ) d[s] = GET_EXP(ndl,s);
4717: }
4718: } else {
4719: for ( i = 0; i < n; i++ ) d[i] = GET_EXP(ndl,i);
4720: }
4721: return dl;
4722: }
4723:
1.24 ! noro 4724: void _ndltodl(UINT *ndl,DL dl)
! 4725: {
! 4726: int *d;
! 4727: int i,j,l,s,ord_l,n;
! 4728: struct order_pair *op;
! 4729:
! 4730: n = nd_nvar;
! 4731: dl->td = TD(ndl);
! 4732: d = dl->d;
! 4733: if ( nd_blockmask ) {
! 4734: l = nd_blockmask->n;
! 4735: op = nd_blockmask->order_pair;
! 4736: for ( j = 0, s = 0; j < l; j++ ) {
! 4737: ord_l = op[j].length;
! 4738: for ( i = 0; i < ord_l; i++, s++ ) d[s] = GET_EXP(ndl,s);
! 4739: }
! 4740: } else {
! 4741: for ( i = 0; i < n; i++ ) d[i] = GET_EXP(ndl,i);
! 4742: }
! 4743: }
! 4744:
1.1 noro 4745: void nmtodp(int mod,NM m,DP *r)
4746: {
4747: DP dp;
4748: MP mr;
4749:
4750: NEWMP(mr);
4751: mr->dl = ndltodl(nd_nvar,DL(m));
4752: mr->c = (Obj)ndctop(mod,m->c);
4753: NEXT(mr) = 0; MKDP(nd_nvar,mr,dp); dp->sugar = mr->dl->td;
4754: *r = dp;
4755: }
4756:
1.15 noro 4757: void ndltodp(UINT *d,DP *r)
4758: {
4759: DP dp;
4760: MP mr;
4761:
4762: NEWMP(mr);
4763: mr->dl = ndltodl(nd_nvar,d);
4764: mr->c = (Obj)ONE;
4765: NEXT(mr) = 0; MKDP(nd_nvar,mr,dp); dp->sugar = mr->dl->td;
4766: *r = dp;
4767: }
4768:
1.1 noro 4769: void ndl_print(UINT *dl)
4770: {
4771: int n;
4772: int i,j,l,ord_l,s,s0;
4773: struct order_pair *op;
4774:
4775: n = nd_nvar;
4776: printf("<<");
4777: if ( nd_blockmask ) {
4778: l = nd_blockmask->n;
4779: op = nd_blockmask->order_pair;
4780: for ( j = 0, s = s0 = 0; j < l; j++ ) {
4781: ord_l = op[j].length;
4782: for ( i = 0; i < ord_l; i++, s++ )
4783: printf(s==n-1?"%d":"%d,",GET_EXP(dl,s));
4784: }
4785: } else {
4786: for ( i = 0; i < n; i++ ) printf(i==n-1?"%d":"%d,",GET_EXP(dl,i));
4787: }
4788: printf(">>");
4789: if ( nd_module && MPOS(dl) )
4790: printf("*e%d",MPOS(dl));
4791: }
4792:
4793: void nd_print(ND p)
4794: {
4795: NM m;
4796:
4797: if ( !p )
4798: printf("0\n");
4799: else {
4800: for ( m = BDY(p); m; m = NEXT(m) ) {
4801: if ( CM(m) & 0x80000000 ) printf("+@_%d*",IFTOF(CM(m)));
4802: else printf("+%d*",CM(m));
4803: ndl_print(DL(m));
4804: }
4805: printf("\n");
4806: }
4807: }
4808:
4809: void nd_print_q(ND p)
4810: {
4811: NM m;
4812:
4813: if ( !p )
4814: printf("0\n");
4815: else {
4816: for ( m = BDY(p); m; m = NEXT(m) ) {
4817: printf("+");
1.6 noro 4818: printexpr(CO,(Obj)CZ(m));
1.1 noro 4819: printf("*");
4820: ndl_print(DL(m));
4821: }
4822: printf("\n");
4823: }
4824: }
4825:
4826: void ndp_print(ND_pairs d)
4827: {
4828: ND_pairs t;
4829:
4830: for ( t = d; t; t = NEXT(t) ) printf("%d,%d ",t->i1,t->i2);
4831: printf("\n");
4832: }
4833:
4834: void nd_removecont(int mod,ND p)
4835: {
4836: int i,n;
4837: Z *w;
4838: NM m;
4839: struct oVECT v;
4840:
4841: if ( mod == -1 ) nd_mul_c(mod,p,_invsf(HCM(p)));
4842: else if ( mod == -2 ) {
4843: Z inv;
4844: divlf(ONE,HCZ(p),&inv);
4845: nd_mul_c_lf(p,inv);
4846: } else if ( mod ) nd_mul_c(mod,p,invm(HCM(p),mod));
4847: else {
4848: for ( m = BDY(p), n = 0; m; m = NEXT(m), n++ );
4849: w = (Z *)MALLOC(n*sizeof(Q));
4850: v.len = n;
4851: v.body = (pointer *)w;
1.6 noro 4852: for ( m = BDY(p), i = 0; i < n; m = NEXT(m), i++ ) w[i] = CZ(m);
1.1 noro 4853: removecont_array((P *)w,n,1);
1.6 noro 4854: for ( m = BDY(p), i = 0; i < n; m = NEXT(m), i++ ) CZ(m) = w[i];
1.1 noro 4855: }
4856: }
4857:
4858: void nd_removecont2(ND p1,ND p2)
4859: {
4860: int i,n1,n2,n;
4861: Z *w;
4862: NM m;
4863: struct oVECT v;
4864:
4865: n1 = nd_length(p1);
4866: n2 = nd_length(p2);
4867: n = n1+n2;
4868: w = (Z *)MALLOC(n*sizeof(Q));
4869: v.len = n;
4870: v.body = (pointer *)w;
4871: i = 0;
4872: if ( p1 )
1.6 noro 4873: for ( m = BDY(p1); i < n1; m = NEXT(m), i++ ) w[i] = CZ(m);
1.1 noro 4874: if ( p2 )
1.6 noro 4875: for ( m = BDY(p2); i < n; m = NEXT(m), i++ ) w[i] = CZ(m);
1.1 noro 4876: removecont_array((P *)w,n,1);
4877: i = 0;
4878: if ( p1 )
1.6 noro 4879: for ( m = BDY(p1); i < n1; m = NEXT(m), i++ ) CZ(m) = w[i];
1.1 noro 4880: if ( p2 )
1.6 noro 4881: for ( m = BDY(p2); i < n; m = NEXT(m), i++ ) CZ(m) = w[i];
1.1 noro 4882: }
4883:
4884: void ndv_removecont(int mod,NDV p)
4885: {
4886: int i,len,all_p;
4887: Z *c;
4888: P *w;
4889: Z dvr,t;
4890: P g,cont,tp;
4891: NMV m;
4892:
4893: if ( mod == -1 )
4894: ndv_mul_c(mod,p,_invsf(HCM(p)));
4895: else if ( mod == -2 ) {
4896: Z inv;
4897: divlf(ONE,HCZ(p),&inv);
4898: ndv_mul_c_lf(p,inv);
4899: } else if ( mod )
4900: ndv_mul_c(mod,p,invm(HCM(p),mod));
4901: else {
4902: len = p->len;
4903: w = (P *)MALLOC(len*sizeof(P));
4904: c = (Z *)MALLOC(len*sizeof(Q));
4905: for ( m = BDY(p), all_p = 1, i = 0; i < len; NMV_ADV(m), i++ ) {
4906: ptozp(CP(m),1,(Q *)&c[i],&w[i]);
4907: all_p = all_p && !NUM(w[i]);
4908: }
4909: if ( all_p ) {
4910: qltozl((Q *)c,len,&dvr); nd_heu_nezgcdnpz(nd_vc,w,len,1,&g);
4911: mulp(nd_vc,(P)dvr,g,&cont);
4912: for ( m = BDY(p), i = 0; i < len; NMV_ADV(m), i++ ) {
4913: divsp(nd_vc,CP(m),cont,&tp); CP(m) = tp;
4914: }
4915: } else {
4916: sortbynm((Q *)c,len);
4917: qltozl((Q *)c,len,&dvr);
4918: for ( m = BDY(p), i = 0; i < len; NMV_ADV(m), i++ ) {
4919: divsp(nd_vc,CP(m),(P)dvr,&tp); CP(m) = tp;
4920: }
4921: }
4922: }
4923: }
4924:
4925: /* koko */
4926:
4927: void ndv_homogenize(NDV p,int obpe,int oadv,EPOS oepos,int ompos)
4928: {
4929: int len,i,max;
4930: NMV m,mr0,mr,t;
4931:
4932: len = p->len;
1.14 noro 4933: for ( m = BDY(p), i = 0, max = 0; i < len; NMV_OADV(m), i++ )
1.1 noro 4934: max = MAX(max,TD(DL(m)));
4935: mr0 = nmv_adv>oadv?(NMV)REALLOC(BDY(p),len*nmv_adv):BDY(p);
4936: m = (NMV)((char *)mr0+(len-1)*oadv);
4937: mr = (NMV)((char *)mr0+(len-1)*nmv_adv);
4938: t = (NMV)MALLOC(nmv_adv);
4939: for ( i = 0; i < len; i++, NMV_OPREV(m), NMV_PREV(mr) ) {
4940: ndl_homogenize(DL(m),DL(t),obpe,oepos,ompos,max);
1.6 noro 4941: CZ(mr) = CZ(m);
1.1 noro 4942: ndl_copy(DL(t),DL(mr));
4943: }
4944: NV(p)++;
4945: BDY(p) = mr0;
4946: }
4947:
4948: void ndv_dehomogenize(NDV p,struct order_spec *ord)
4949: {
4950: int i,j,adj,len,newnvar,newwpd,newadv,newexporigin,newmpos;
4951: int pos;
4952: Q *w;
4953: Q dvr,t;
4954: NMV m,r;
4955:
4956: len = p->len;
4957: newnvar = nd_nvar-1;
4958: newexporigin = nd_get_exporigin(ord);
4959: if ( nd_module ) newmpos = newexporigin-1;
4960: newwpd = newnvar/nd_epw+(newnvar%nd_epw?1:0)+newexporigin;
4961: for ( m = BDY(p), i = 0; i < len; NMV_ADV(m), i++ )
4962: ndl_dehomogenize(DL(m));
4963: if ( newwpd != nd_wpd ) {
4964: newadv = ROUND_FOR_ALIGN(sizeof(struct oNMV)+(newwpd-1)*sizeof(UINT));
4965: for ( m = r = BDY(p), i = 0; i < len; NMV_ADV(m), NDV_NADV(r), i++ ) {
1.6 noro 4966: CZ(r) = CZ(m);
1.1 noro 4967: if ( nd_module ) pos = MPOS(DL(m));
4968: for ( j = 0; j < newexporigin; j++ ) DL(r)[j] = DL(m)[j];
4969: adj = nd_exporigin-newexporigin;
4970: for ( ; j < newwpd; j++ ) DL(r)[j] = DL(m)[j+adj];
4971: if ( nd_module ) {
4972: DL(r)[newmpos] = pos;
4973: }
4974: }
4975: }
4976: NV(p)--;
4977: }
4978:
4979: void nd_heu_nezgcdnpz(VL vl,P *pl,int m,int full,P *pr)
4980: {
4981: int i;
4982: P *tpl,*tpl1;
4983: NODE l;
4984: P h,gcd,t;
4985:
4986: tpl = (P *)MALLOC(m*sizeof(P));
4987: tpl1 = (P *)MALLOC(m*sizeof(P));
4988: bcopy(pl,tpl,m*sizeof(P));
4989: gcd = (P)ONE;
4990: for ( l = nd_hcf; l; l = NEXT(l) ) {
4991: h = (P)BDY(l);
4992: while ( 1 ) {
4993: for ( i = 0; i < m; i++ )
4994: if ( !divtpz(vl,tpl[i],h,&tpl1[i]) )
4995: break;
4996: if ( i == m ) {
4997: bcopy(tpl1,tpl,m*sizeof(P));
4998: mulp(vl,gcd,h,&t); gcd = t;
4999: } else
5000: break;
5001: }
5002: }
5003: if ( DP_Print > 2 ){fprintf(asir_out,"[%d]",nmonop(gcd)); fflush(asir_out);}
5004: if ( full ) {
5005: heu_nezgcdnpz(vl,tpl,m,&t);
5006: mulp(vl,gcd,t,pr);
5007: } else
5008: *pr = gcd;
5009: }
5010:
5011: void removecont_array(P *p,int n,int full)
5012: {
5013: int all_p,all_q,i;
5014: Z *c;
5015: P *w;
5016: P t,s;
5017:
5018: for ( all_q = 1, i = 0; i < n; i++ )
5019: all_q = all_q && NUM(p[i]);
5020: if ( all_q ) {
5021: removecont_array_q((Z *)p,n);
5022: } else {
5023: c = (Z *)MALLOC(n*sizeof(Z));
5024: w = (P *)MALLOC(n*sizeof(P));
5025: for ( i = 0; i < n; i++ ) {
5026: ptozp(p[i],1,(Q *)&c[i],&w[i]);
5027: }
5028: removecont_array_q(c,n);
5029: nd_heu_nezgcdnpz(nd_vc,w,n,full,&t);
5030: for ( i = 0; i < n; i++ ) {
5031: divsp(nd_vc,w[i],t,&s); mulp(nd_vc,s,(P)c[i],&p[i]);
5032: }
5033: }
5034: }
5035:
5036: /* c is an int array */
5037:
5038: void removecont_array_q(Z *c,int n)
5039: {
5040: struct oVECT v;
5041: Z d0,d1,a,u,u1,gcd;
5042: int i,j;
5043: Z *q,*r;
5044:
5045: q = (Z *)MALLOC(n*sizeof(Z));
5046: r = (Z *)MALLOC(n*sizeof(Z));
5047: v.id = O_VECT; v.len = n; v.body = (pointer *)c;
5048: gcdvz_estimate(&v,&d0);
5049: for ( i = 0; i < n; i++ ) {
5050: divqrz(c[i],d0,&q[i],&r[i]);
5051: }
5052: for ( i = 0; i < n; i++ ) if ( r[i] ) break;
5053: if ( i < n ) {
5054: v.id = O_VECT; v.len = n; v.body = (pointer *)r;
5055: gcdvz(&v,&d1);
5056: gcdz(d0,d1,&gcd);
1.6 noro 5057: /* exact division */
5058: divsz(d0,gcd,&a);
1.1 noro 5059: for ( i = 0; i < n; i++ ) {
5060: mulz(a,q[i],&u);
5061: if ( r[i] ) {
1.6 noro 5062: /* exact division */
5063: divsz(r[i],gcd,&u1);
1.1 noro 5064: addz(u,u1,&q[i]);
5065: } else
5066: q[i] = u;
5067: }
5068: }
5069: for ( i = 0; i < n; i++ ) c[i] = q[i];
5070: }
5071:
1.4 noro 5072: void gcdv_mpz_estimate(mpz_t d0,mpz_t *c,int n);
5073:
5074: void mpz_removecont_array(mpz_t *c,int n)
5075: {
5076: mpz_t d0,a,u,u1,gcd;
5077: int i,j;
1.13 noro 5078: static mpz_t *q,*r;
5079: static int c_len = 0;
1.4 noro 5080:
5081: for ( i = 0; i < n; i++ )
5082: if ( mpz_sgn(c[i]) ) break;
5083: if ( i == n ) return;
5084: gcdv_mpz_estimate(d0,c,n);
1.13 noro 5085: if ( n > c_len ) {
5086: q = (mpz_t *)MALLOC(n*sizeof(mpz_t));
5087: r = (mpz_t *)MALLOC(n*sizeof(mpz_t));
5088: c_len = n;
5089: }
1.4 noro 5090: for ( i = 0; i < n; i++ ) {
5091: mpz_init(q[i]); mpz_init(r[i]);
5092: mpz_fdiv_qr(q[i],r[i],c[i],d0);
5093: }
5094: for ( i = 0; i < n; i++ )
5095: if ( mpz_sgn(r[i]) ) break;
5096: mpz_init(gcd); mpz_init(a); mpz_init(u); mpz_init(u1);
5097: if ( i < n ) {
5098: mpz_gcd(gcd,d0,r[i]);
5099: for ( j = i+1; j < n; j++ ) mpz_gcd(gcd,gcd,r[j]);
5100: mpz_div(a,d0,gcd);
5101: for ( i = 0; i < n; i++ ) {
5102: mpz_mul(u,a,q[i]);
5103: if ( mpz_sgn(r[i]) ) {
5104: mpz_div(u1,r[i],gcd);
5105: mpz_add(q[i],u,u1);
5106: } else
5107: mpz_set(q[i],u);
5108: }
5109: }
5110: for ( i = 0; i < n; i++ )
5111: mpz_set(c[i],q[i]);
5112: }
5113:
1.1 noro 5114: void nd_mul_c(int mod,ND p,int mul)
5115: {
5116: NM m;
5117: int c,c1;
5118:
5119: if ( !p ) return;
5120: if ( mul == 1 ) return;
5121: if ( mod == -1 )
5122: for ( m = BDY(p); m; m = NEXT(m) )
5123: CM(m) = _mulsf(CM(m),mul);
5124: else
5125: for ( m = BDY(p); m; m = NEXT(m) ) {
5126: c1 = CM(m); DMAR(c1,mul,0,mod,c); CM(m) = c;
5127: }
5128: }
5129:
5130: void nd_mul_c_lf(ND p,Z mul)
5131: {
5132: NM m;
5133: Z c;
5134:
5135: if ( !p ) return;
5136: if ( UNIZ(mul) ) return;
5137: for ( m = BDY(p); m; m = NEXT(m) ) {
5138: mullf(CZ(m),mul,&c); CZ(m) = c;
5139: }
5140: }
5141:
5142: void nd_mul_c_q(ND p,P mul)
5143: {
5144: NM m;
5145: P c;
5146:
5147: if ( !p ) return;
5148: if ( UNIQ(mul) ) return;
5149: for ( m = BDY(p); m; m = NEXT(m) ) {
5150: mulp(nd_vc,CP(m),mul,&c); CP(m) = c;
5151: }
5152: }
5153:
5154: void nd_mul_c_p(VL vl,ND p,P mul)
5155: {
5156: NM m;
5157: P c;
5158:
5159: if ( !p ) return;
5160: for ( m = BDY(p); m; m = NEXT(m) ) {
5161: mulp(vl,CP(m),mul,&c); CP(m) = c;
5162: }
5163: }
5164:
5165: void nd_free(ND p)
5166: {
5167: NM t,s;
5168:
5169: if ( !p ) return;
5170: t = BDY(p);
5171: while ( t ) {
5172: s = NEXT(t);
5173: FREENM(t);
5174: t = s;
5175: }
5176: FREEND(p);
5177: }
5178:
5179: void ndv_free(NDV p)
5180: {
5181: GCFREE(BDY(p));
5182: }
5183:
5184: void nd_append_red(UINT *d,int i)
5185: {
5186: RHist m,m0;
5187: int h;
5188:
5189: NEWRHist(m);
5190: h = ndl_hash_value(d);
5191: m->index = i;
5192: ndl_copy(d,DL(m));
5193: NEXT(m) = nd_red[h];
5194: nd_red[h] = m;
5195: }
5196:
5197: UINT *ndv_compute_bound(NDV p)
5198: {
5199: UINT *d1,*d2,*t;
5200: UINT u;
5201: int i,j,k,l,len,ind;
5202: NMV m;
5203:
5204: if ( !p )
5205: return 0;
5206: d1 = (UINT *)MALLOC(nd_wpd*sizeof(UINT));
5207: d2 = (UINT *)MALLOC(nd_wpd*sizeof(UINT));
5208: len = LEN(p);
5209: m = BDY(p); ndl_copy(DL(m),d1); NMV_ADV(m);
5210: for ( i = 1; i < len; i++, NMV_ADV(m) ) {
5211: ndl_max(DL(m),d1,d2);
5212: t = d1; d1 = d2; d2 = t;
5213: }
5214: l = nd_nvar+31;
5215: t = (UINT *)MALLOC_ATOMIC(l*sizeof(UINT));
5216: for ( i = nd_exporigin, ind = 0; i < nd_wpd; i++ ) {
5217: u = d1[i];
5218: k = (nd_epw-1)*nd_bpe;
5219: for ( j = 0; j < nd_epw; j++, k -= nd_bpe, ind++ )
5220: t[ind] = (u>>k)&nd_mask0;
5221: }
5222: for ( ; ind < l; ind++ ) t[ind] = 0;
5223: return t;
5224: }
5225:
5226: UINT *nd_compute_bound(ND p)
5227: {
5228: UINT *d1,*d2,*t;
5229: UINT u;
5230: int i,j,k,l,len,ind;
5231: NM m;
5232:
5233: if ( !p )
5234: return 0;
5235: d1 = (UINT *)MALLOC(nd_wpd*sizeof(UINT));
5236: d2 = (UINT *)MALLOC(nd_wpd*sizeof(UINT));
5237: len = LEN(p);
5238: m = BDY(p); ndl_copy(DL(m),d1); m = NEXT(m);
5239: for ( m = NEXT(m); m; m = NEXT(m) ) {
5240: ndl_lcm(DL(m),d1,d2);
5241: t = d1; d1 = d2; d2 = t;
5242: }
5243: l = nd_nvar+31;
5244: t = (UINT *)MALLOC_ATOMIC(l*sizeof(UINT));
5245: for ( i = nd_exporigin, ind = 0; i < nd_wpd; i++ ) {
5246: u = d1[i];
5247: k = (nd_epw-1)*nd_bpe;
5248: for ( j = 0; j < nd_epw; j++, k -= nd_bpe, ind++ )
5249: t[ind] = (u>>k)&nd_mask0;
5250: }
5251: for ( ; ind < l; ind++ ) t[ind] = 0;
5252: return t;
5253: }
5254:
5255: /* if nd_module == 1 then d[nd_exporigin-1] indicates the position */
5256: /* of a term. In this case we need additional 1 word. */
5257:
5258: int nd_get_exporigin(struct order_spec *ord)
5259: {
5260: switch ( ord->id ) {
1.21 noro 5261: case 0: case 2: case 256: case 258: case 300:
1.1 noro 5262: return 1+nd_module;
5263: case 1: case 257:
5264: /* block order */
5265: /* poly ring d[0]:weight d[1]:w0,...,d[nd_exporigin-1]:w(n-1) */
5266: /* module d[0]:weight d[1]:w0,...,d[nd_exporigin-2]:w(n-1) */
5267: return ord->ord.block.length+1+nd_module;
5268: case 3: case 259:
5269: #if 0
5270: error("nd_get_exporigin : composite order is not supported yet.");
5271: #else
5272: return 1+nd_module;
5273: #endif
5274: default:
5275: error("nd_get_exporigin : ivalid argument.");
5276: return 0;
5277: }
5278: }
5279:
5280: void nd_setup_parameters(int nvar,int max) {
5281: int i,j,n,elen,ord_o,ord_l,l,s,wpd;
5282: struct order_pair *op;
5283:
5284: nd_nvar = nvar;
5285: if ( max ) {
5286: /* XXX */
5287: if ( do_weyl ) nd_bpe = 32;
5288: else if ( max < 2 ) nd_bpe = 1;
5289: else if ( max < 4 ) nd_bpe = 2;
5290: else if ( max < 8 ) nd_bpe = 3;
5291: else if ( max < 16 ) nd_bpe = 4;
5292: else if ( max < 32 ) nd_bpe = 5;
5293: else if ( max < 64 ) nd_bpe = 6;
5294: else if ( max < 256 ) nd_bpe = 8;
5295: else if ( max < 1024 ) nd_bpe = 10;
5296: else if ( max < 65536 ) nd_bpe = 16;
5297: else nd_bpe = 32;
5298: }
5299: if ( !do_weyl && weight_check && (current_dl_weight_vector || nd_matrix) ) {
5300: UINT t;
5301: int st;
5302: int *v;
5303: /* t = max(weights) */
5304: t = 0;
5305: if ( current_dl_weight_vector )
5306: for ( i = 0, t = 0; i < nd_nvar; i++ ) {
5307: if ( (st=current_dl_weight_vector[i]) < 0 ) st = -st;
5308: if ( t < st ) t = st;
5309: }
5310: if ( nd_matrix )
5311: for ( i = 0; i < nd_matrix_len; i++ )
5312: for ( j = 0, v = nd_matrix[i]; j < nd_nvar; j++ ) {
5313: if ( (st=v[j]) < 0 ) st = -st;
5314: if ( t < st ) t = st;
5315: }
5316: /* i = bitsize of t */
5317: for ( i = 0; t; t >>=1, i++ );
5318: /* i += bitsize of nd_nvar */
5319: for ( t = nd_nvar; t; t >>=1, i++);
5320: /* nd_bpe+i = bitsize of max(weights)*max(exp)*nd_nvar */
5321: if ( (nd_bpe+i) >= 31 )
5322: error("nd_setup_parameters : too large weight");
5323: }
5324: nd_epw = (sizeof(UINT)*8)/nd_bpe;
5325: elen = nd_nvar/nd_epw+(nd_nvar%nd_epw?1:0);
5326: nd_exporigin = nd_get_exporigin(nd_ord);
5327: wpd = nd_exporigin+elen;
5328: if ( nd_module )
5329: nd_mpos = nd_exporigin-1;
5330: else
5331: nd_mpos = -1;
5332: if ( wpd != nd_wpd ) {
5333: nd_free_private_storage();
5334: nd_wpd = wpd;
5335: }
5336: if ( nd_bpe < 32 ) {
5337: nd_mask0 = (1<<nd_bpe)-1;
5338: } else {
5339: nd_mask0 = 0xffffffff;
5340: }
5341: bzero(nd_mask,sizeof(nd_mask));
5342: nd_mask1 = 0;
5343: for ( i = 0; i < nd_epw; i++ ) {
5344: nd_mask[nd_epw-i-1] = (nd_mask0<<(i*nd_bpe));
5345: nd_mask1 |= (1<<(nd_bpe-1))<<(i*nd_bpe);
5346: }
5347: nmv_adv = ROUND_FOR_ALIGN(sizeof(struct oNMV)+(nd_wpd-1)*sizeof(UINT));
5348: nd_epos = nd_create_epos(nd_ord);
5349: nd_blockmask = nd_create_blockmask(nd_ord);
5350: nd_work_vector = (int *)REALLOC(nd_work_vector,nd_nvar*sizeof(int));
5351: }
5352:
5353: ND_pairs nd_reconstruct(int trace,ND_pairs d)
5354: {
5355: int i,obpe,oadv,h;
5356: static NM prev_nm_free_list;
5357: static ND_pairs prev_ndp_free_list;
5358: RHist mr0,mr;
5359: RHist r;
5360: RHist *old_red;
5361: ND_pairs s0,s,t;
5362: EPOS oepos;
5363:
5364: obpe = nd_bpe;
5365: oadv = nmv_adv;
5366: oepos = nd_epos;
5367: if ( obpe < 2 ) nd_bpe = 2;
5368: else if ( obpe < 3 ) nd_bpe = 3;
5369: else if ( obpe < 4 ) nd_bpe = 4;
5370: else if ( obpe < 5 ) nd_bpe = 5;
5371: else if ( obpe < 6 ) nd_bpe = 6;
5372: else if ( obpe < 8 ) nd_bpe = 8;
5373: else if ( obpe < 10 ) nd_bpe = 10;
5374: else if ( obpe < 16 ) nd_bpe = 16;
5375: else if ( obpe < 32 ) nd_bpe = 32;
5376: else error("nd_reconstruct : exponent too large");
5377:
5378: nd_setup_parameters(nd_nvar,0);
5379: prev_nm_free_list = _nm_free_list;
5380: prev_ndp_free_list = _ndp_free_list;
5381: _nm_free_list = 0;
5382: _ndp_free_list = 0;
5383: for ( i = nd_psn-1; i >= 0; i-- ) {
5384: ndv_realloc(nd_ps[i],obpe,oadv,oepos);
5385: ndv_realloc(nd_ps_sym[i],obpe,oadv,oepos);
5386: }
5387: if ( trace )
5388: for ( i = nd_psn-1; i >= 0; i-- ) {
5389: ndv_realloc(nd_ps_trace[i],obpe,oadv,oepos);
5390: ndv_realloc(nd_ps_trace_sym[i],obpe,oadv,oepos);
5391: }
5392: s0 = 0;
5393: for ( t = d; t; t = NEXT(t) ) {
5394: NEXTND_pairs(s0,s);
5395: s->i1 = t->i1;
5396: s->i2 = t->i2;
1.24 ! noro 5397: s->sig = t->sig;
1.1 noro 5398: SG(s) = SG(t);
5399: ndl_reconstruct(LCM(t),LCM(s),obpe,oepos);
5400: }
5401:
5402: old_red = (RHist *)MALLOC(REDTAB_LEN*sizeof(RHist));
5403: for ( i = 0; i < REDTAB_LEN; i++ ) {
5404: old_red[i] = nd_red[i];
5405: nd_red[i] = 0;
5406: }
5407: for ( i = 0; i < REDTAB_LEN; i++ )
5408: for ( r = old_red[i]; r; r = NEXT(r) ) {
5409: NEWRHist(mr);
5410: mr->index = r->index;
5411: SG(mr) = SG(r);
5412: ndl_reconstruct(DL(r),DL(mr),obpe,oepos);
5413: h = ndl_hash_value(DL(mr));
5414: NEXT(mr) = nd_red[h];
5415: nd_red[h] = mr;
1.24 ! noro 5416: mr->sig = r->sig;
1.1 noro 5417: }
5418: for ( i = 0; i < REDTAB_LEN; i++ ) old_red[i] = 0;
5419: old_red = 0;
5420: for ( i = 0; i < nd_psn; i++ ) {
5421: NEWRHist(r); SG(r) = SG(nd_psh[i]);
5422: ndl_reconstruct(DL(nd_psh[i]),DL(r),obpe,oepos);
1.24 ! noro 5423: r->sig = nd_psh[i]->sig;
1.1 noro 5424: nd_psh[i] = r;
5425: }
5426: if ( s0 ) NEXT(s) = 0;
5427: prev_nm_free_list = 0;
5428: prev_ndp_free_list = 0;
5429: #if 0
5430: GC_gcollect();
5431: #endif
5432: return s0;
5433: }
5434:
5435: void ndl_reconstruct(UINT *d,UINT *r,int obpe,EPOS oepos)
5436: {
5437: int n,i,ei,oepw,omask0,j,s,ord_l,l;
5438: struct order_pair *op;
5439:
5440: n = nd_nvar;
5441: oepw = (sizeof(UINT)*8)/obpe;
5442: omask0 = (1<<obpe)-1;
5443: TD(r) = TD(d);
5444: for ( i = nd_exporigin; i < nd_wpd; i++ ) r[i] = 0;
5445: if ( nd_blockmask ) {
5446: l = nd_blockmask->n;
5447: op = nd_blockmask->order_pair;
5448: for ( i = 1; i < nd_exporigin; i++ )
5449: r[i] = d[i];
5450: for ( j = 0, s = 0; j < l; j++ ) {
5451: ord_l = op[j].length;
5452: for ( i = 0; i < ord_l; i++, s++ ) {
5453: ei = GET_EXP_OLD(d,s);
5454: PUT_EXP(r,s,ei);
5455: }
5456: }
5457: } else {
5458: for ( i = 0; i < n; i++ ) {
5459: ei = GET_EXP_OLD(d,i);
5460: PUT_EXP(r,i,ei);
5461: }
5462: }
5463: if ( nd_module ) MPOS(r) = MPOS(d);
5464: }
5465:
5466: ND nd_copy(ND p)
5467: {
5468: NM m,mr,mr0;
5469: int c,n;
5470: ND r;
5471:
5472: if ( !p )
5473: return 0;
5474: else {
5475: for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {
5476: NEXTNM(mr0,mr);
5477: CM(mr) = CM(m);
5478: ndl_copy(DL(m),DL(mr));
5479: }
5480: NEXT(mr) = 0;
5481: MKND(NV(p),mr0,LEN(p),r);
5482: SG(r) = SG(p);
5483: return r;
5484: }
5485: }
5486:
5487: int nd_sp(int mod,int trace,ND_pairs p,ND *rp)
5488: {
5489: NM m1,m2;
5490: NDV p1,p2;
5491: ND t1,t2;
5492: UINT *lcm;
5493: P gp,tp;
5494: Z g,t;
5495: Z iq;
5496: int td;
5497: LIST hist;
5498: NODE node;
5499: DP d;
5500:
5501: if ( !mod && nd_demand ) {
5502: p1 = ndv_load(p->i1); p2 = ndv_load(p->i2);
5503: } else {
5504: if ( trace ) {
5505: p1 = nd_ps_trace[p->i1]; p2 = nd_ps_trace[p->i2];
5506: } else {
5507: p1 = nd_ps[p->i1]; p2 = nd_ps[p->i2];
5508: }
5509: }
5510: lcm = LCM(p);
5511: NEWNM(m1); ndl_sub(lcm,HDL(p1),DL(m1));
5512: if ( ndl_check_bound2(p->i1,DL(m1)) ) {
5513: FREENM(m1); return 0;
5514: }
5515: NEWNM(m2); ndl_sub(lcm,HDL(p2),DL(m2));
5516: if ( ndl_check_bound2(p->i2,DL(m2)) ) {
5517: FREENM(m1); FREENM(m2); return 0;
5518: }
5519:
5520: if ( mod == -1 ) {
5521: CM(m1) = HCM(p2); CM(m2) = _chsgnsf(HCM(p1));
5522: } else if ( mod > 0 ) {
5523: CM(m1) = HCM(p2); CM(m2) = mod-HCM(p1);
5524: } else if ( mod == -2 ) {
5525: CZ(m1) = HCZ(p2); chsgnlf(HCZ(p1),&CZ(m2));
5526: } else if ( nd_vc ) {
5527: ezgcdpz(nd_vc,HCP(p1),HCP(p2),&gp);
5528: divsp(nd_vc,HCP(p2),gp,&CP(m1));
5529: divsp(nd_vc,HCP(p1),gp,&tp); chsgnp(tp,&CP(m2));
5530: } else {
1.6 noro 5531: igcd_cofactor(HCZ(p1),HCZ(p2),&g,&t,&CZ(m1)); chsgnz(t,&CZ(m2));
1.1 noro 5532: }
5533: t1 = ndv_mul_nm(mod,m1,p1); t2 = ndv_mul_nm(mod,m2,p2);
5534: *rp = nd_add(mod,t1,t2);
5535: if ( nd_gentrace ) {
5536: /* nd_tracelist is initialized */
1.6 noro 5537: STOZ(p->i1,iq); nmtodp(mod,m1,&d); node = mknode(4,ONE,iq,d,ONE);
1.1 noro 5538: MKLIST(hist,node); MKNODE(nd_tracelist,hist,0);
1.6 noro 5539: STOZ(p->i2,iq); nmtodp(mod,m2,&d); node = mknode(4,ONE,iq,d,ONE);
1.1 noro 5540: MKLIST(hist,node); MKNODE(node,hist,nd_tracelist);
5541: nd_tracelist = node;
5542: }
1.24 ! noro 5543: if ( *rp )
! 5544: (*rp)->sig = p->sig;
1.1 noro 5545: FREENM(m1); FREENM(m2);
5546: return 1;
5547: }
5548:
5549: void ndv_mul_c(int mod,NDV p,int mul)
5550: {
5551: NMV m;
5552: int c,c1,len,i;
5553:
5554: if ( !p ) return;
5555: len = LEN(p);
5556: if ( mod == -1 )
5557: for ( m = BDY(p), i = 0; i < len; i++, NMV_ADV(m) )
5558: CM(m) = _mulsf(CM(m),mul);
5559: else
5560: for ( m = BDY(p), i = 0; i < len; i++, NMV_ADV(m) ) {
5561: c1 = CM(m); DMAR(c1,mul,0,mod,c); CM(m) = c;
5562: }
5563: }
5564:
5565: void ndv_mul_c_lf(NDV p,Z mul)
5566: {
5567: NMV m;
5568: Z c;
5569: int len,i;
5570:
5571: if ( !p ) return;
5572: len = LEN(p);
5573: for ( m = BDY(p), i = 0; i < len; i++, NMV_ADV(m) ) {
5574: mullf(CZ(m),mul,&c); CZ(m) = c;
5575: }
5576: }
5577:
5578: /* for nd_det */
5579: void ndv_mul_c_q(NDV p,Z mul)
5580: {
5581: NMV m;
5582: Z c;
5583: int len,i;
5584:
5585: if ( !p ) return;
5586: len = LEN(p);
5587: for ( m = BDY(p), i = 0; i < len; i++, NMV_ADV(m) ) {
1.6 noro 5588: mulz(CZ(m),mul,&c); CZ(m) = c;
1.1 noro 5589: }
5590: }
5591:
5592: ND weyl_ndv_mul_nm(int mod,NM m0,NDV p) {
5593: int n2,i,j,l,n,tlen;
5594: UINT *d0;
5595: NM *tab,*psum;
5596: ND s,r;
5597: NM t;
5598: NMV m1;
5599:
5600: if ( !p ) return 0;
5601: n = NV(p); n2 = n>>1;
5602: d0 = DL(m0);
5603: l = LEN(p);
5604: for ( i = 0, tlen = 1; i < n2; i++ ) tlen *= (GET_EXP(d0,n2+i)+1);
5605: tab = (NM *)MALLOC(tlen*sizeof(NM));
5606: psum = (NM *)MALLOC(tlen*sizeof(NM));
5607: for ( i = 0; i < tlen; i++ ) psum[i] = 0;
5608: m1 = (NMV)(((char *)BDY(p))+nmv_adv*(l-1));
5609: for ( i = l-1; i >= 0; i--, NMV_PREV(m1) ) {
5610: /* m0(NM) * m1(NMV) => tab(NM) */
5611: weyl_mul_nm_nmv(n,mod,m0,m1,tab,tlen);
5612: for ( j = 0; j < tlen; j++ ) {
5613: if ( tab[j] ) {
5614: NEXT(tab[j]) = psum[j]; psum[j] = tab[j];
5615: }
5616: }
5617: }
5618: for ( i = tlen-1, r = 0; i >= 0; i-- )
5619: if ( psum[i] ) {
5620: for ( j = 0, t = psum[i]; t; t = NEXT(t), j++ );
5621: MKND(n,psum[i],j,s);
5622: r = nd_add(mod,r,s);
5623: }
5624: if ( r ) SG(r) = SG(p)+TD(d0);
5625: return r;
5626: }
5627:
5628: /* product of monomials */
5629: /* XXX block order is not handled correctly */
5630:
5631: void weyl_mul_nm_nmv(int n,int mod,NM m0,NMV m1,NM *tab,int tlen)
5632: {
5633: int i,n2,j,s,curlen,homo,h,a,b,k,l,u,min;
5634: UINT *d0,*d1,*d,*dt,*ctab;
5635: Z *ctab_q;
5636: Z q,q1;
5637: UINT c0,c1,c;
5638: NM *p;
5639: NM m,t;
5640: int mpos;
5641:
5642: for ( i = 0; i < tlen; i++ ) tab[i] = 0;
5643: if ( !m0 || !m1 ) return;
5644: d0 = DL(m0); d1 = DL(m1); n2 = n>>1;
5645: if ( nd_module )
5646: if ( MPOS(d0) ) error("weyl_mul_nm_nmv : invalid operation");
5647:
5648: NEWNM(m); d = DL(m);
5649: if ( mod ) {
5650: c0 = CM(m0); c1 = CM(m1); DMAR(c0,c1,0,mod,c); CM(m) = c;
5651: } else if ( nd_vc )
5652: mulp(nd_vc,CP(m0),CP(m1),&CP(m));
5653: else
1.6 noro 5654: mulz(CZ(m0),CZ(m1),&CZ(m));
1.1 noro 5655: for ( i = 0; i < nd_wpd; i++ ) d[i] = 0;
5656: homo = n&1 ? 1 : 0;
5657: if ( homo ) {
5658: /* offset of h-degree */
5659: h = GET_EXP(d0,n-1)+GET_EXP(d1,n-1);
5660: PUT_EXP(DL(m),n-1,h);
5661: TD(DL(m)) = h;
5662: if ( nd_blockmask ) ndl_weight_mask(DL(m));
5663: }
5664: tab[0] = m;
5665: NEWNM(m); d = DL(m);
5666: for ( i = 0, curlen = 1; i < n2; i++ ) {
5667: a = GET_EXP(d0,i); b = GET_EXP(d1,n2+i);
5668: k = GET_EXP(d0,n2+i); l = GET_EXP(d1,i);
5669: /* xi^a*(Di^k*xi^l)*Di^b */
5670: a += l; b += k;
5671: s = MUL_WEIGHT(a,i)+MUL_WEIGHT(b,n2+i);
5672: if ( !k || !l ) {
5673: for ( j = 0; j < curlen; j++ )
5674: if ( (t = tab[j]) != 0 ) {
5675: dt = DL(t);
5676: PUT_EXP(dt,i,a); PUT_EXP(dt,n2+i,b); TD(dt) += s;
5677: if ( nd_blockmask ) ndl_weight_mask(dt);
5678: }
5679: curlen *= k+1;
5680: continue;
5681: }
5682: min = MIN(k,l);
5683: if ( mod ) {
5684: ctab = (UINT *)MALLOC((min+1)*sizeof(UINT));
5685: mkwcm(k,l,mod,(int *)ctab);
5686: } else {
5687: ctab_q = (Z *)MALLOC((min+1)*sizeof(Z));
5688: mkwc(k,l,ctab_q);
5689: }
5690: for ( j = min; j >= 0; j-- ) {
5691: for ( u = 0; u < nd_wpd; u++ ) d[u] = 0;
5692: PUT_EXP(d,i,a-j); PUT_EXP(d,n2+i,b-j);
5693: h = MUL_WEIGHT(a-j,i)+MUL_WEIGHT(b-j,n2+i);
5694: if ( homo ) {
5695: TD(d) = s;
5696: PUT_EXP(d,n-1,s-h);
5697: } else TD(d) = h;
5698: if ( nd_blockmask ) ndl_weight_mask(d);
5699: if ( mod ) c = ctab[j];
5700: else q = ctab_q[j];
5701: p = tab+curlen*j;
5702: if ( j == 0 ) {
5703: for ( u = 0; u < curlen; u++, p++ ) {
5704: if ( tab[u] ) {
5705: ndl_addto(DL(tab[u]),d);
5706: if ( mod ) {
5707: c0 = CM(tab[u]); DMAR(c0,c,0,mod,c1); CM(tab[u]) = c1;
5708: } else if ( nd_vc )
5709: mulp(nd_vc,CP(tab[u]),(P)q,&CP(tab[u]));
5710: else {
1.6 noro 5711: mulz(CZ(tab[u]),q,&q1); CZ(tab[u]) = q1;
1.1 noro 5712: }
5713: }
5714: }
5715: } else {
5716: for ( u = 0; u < curlen; u++, p++ ) {
5717: if ( tab[u] ) {
5718: NEWNM(t);
5719: ndl_add(DL(tab[u]),d,DL(t));
5720: if ( mod ) {
5721: c0 = CM(tab[u]); DMAR(c0,c,0,mod,c1); CM(t) = c1;
5722: } else if ( nd_vc )
5723: mulp(nd_vc,CP(tab[u]),(P)q,&CP(t));
5724: else
1.6 noro 5725: mulz(CZ(tab[u]),q,&CZ(t));
1.1 noro 5726: *p = t;
5727: }
5728: }
5729: }
5730: }
5731: curlen *= k+1;
5732: }
5733: FREENM(m);
5734: if ( nd_module ) {
5735: mpos = MPOS(d1);
5736: for ( i = 0; i < tlen; i++ )
5737: if ( tab[i] ) {
5738: d = DL(tab[i]);
5739: MPOS(d) = mpos;
5740: TD(d) = ndl_weight(d);
5741: }
5742: }
5743: }
5744:
5745: ND ndv_mul_nm_symbolic(NM m0,NDV p)
5746: {
5747: NM mr,mr0;
5748: NMV m;
5749: UINT *d,*dt,*dm;
5750: int c,n,td,i,c1,c2,len;
5751: Q q;
5752: ND r;
5753:
5754: if ( !p ) return 0;
5755: else {
5756: n = NV(p); m = BDY(p);
5757: d = DL(m0);
5758: len = LEN(p);
5759: mr0 = 0;
5760: td = TD(d);
5761: c = CM(m0);
5762: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
5763: NEXTNM(mr0,mr);
5764: CM(mr) = 1;
5765: ndl_add(DL(m),d,DL(mr));
5766: }
5767: NEXT(mr) = 0;
5768: MKND(NV(p),mr0,len,r);
5769: SG(r) = SG(p) + TD(d);
5770: return r;
5771: }
5772: }
5773:
5774: ND ndv_mul_nm(int mod,NM m0,NDV p)
5775: {
5776: NM mr,mr0;
5777: NMV m;
5778: UINT *d,*dt,*dm;
5779: int c,n,td,i,c1,c2,len;
5780: P q;
5781: ND r;
5782:
5783: if ( !p ) return 0;
5784: else if ( do_weyl ) {
5785: if ( mod < 0 ) {
5786: error("ndv_mul_nm : not implemented (weyl)");
5787: return 0;
5788: } else
5789: return weyl_ndv_mul_nm(mod,m0,p);
5790: } else {
5791: n = NV(p); m = BDY(p);
5792: d = DL(m0);
5793: len = LEN(p);
5794: mr0 = 0;
5795: td = TD(d);
5796: if ( mod == -1 ) {
5797: c = CM(m0);
5798: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
5799: NEXTNM(mr0,mr);
5800: CM(mr) = _mulsf(CM(m),c);
5801: ndl_add(DL(m),d,DL(mr));
5802: }
5803: } else if ( mod == -2 ) {
5804: Z cl;
5805: cl = CZ(m0);
5806: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
5807: NEXTNM(mr0,mr);
5808: mullf(CZ(m),cl,&CZ(mr));
5809: ndl_add(DL(m),d,DL(mr));
5810: }
5811: } else if ( mod ) {
5812: c = CM(m0);
5813: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
5814: NEXTNM(mr0,mr);
5815: c1 = CM(m);
5816: DMAR(c1,c,0,mod,c2);
5817: CM(mr) = c2;
5818: ndl_add(DL(m),d,DL(mr));
5819: }
5820: } else {
5821: q = CP(m0);
5822: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
5823: NEXTNM(mr0,mr);
5824: mulp(nd_vc,CP(m),q,&CP(mr));
5825: ndl_add(DL(m),d,DL(mr));
5826: }
5827: }
5828: NEXT(mr) = 0;
5829: MKND(NV(p),mr0,len,r);
5830: SG(r) = SG(p) + TD(d);
5831: return r;
5832: }
5833: }
5834:
5835: ND nd_quo(int mod,PGeoBucket bucket,NDV d)
5836: {
5837: NM mq0,mq;
5838: NMV tm;
5839: Q q;
5840: int i,nv,sg,c,c1,c2,hindex;
5841: ND p,t,r;
5842:
5843: if ( bucket->m < 0 ) return 0;
5844: else {
5845: nv = NV(d);
5846: mq0 = 0;
5847: tm = (NMV)MALLOC(nmv_adv);
5848: while ( 1 ) {
5849: if ( mod > 0 || mod == -1 )
5850: hindex = head_pbucket(mod,bucket);
5851: else if ( mod == -2 )
5852: hindex = head_pbucket_lf(bucket);
5853: else
5854: hindex = head_pbucket_q(bucket);
5855: if ( hindex < 0 ) break;
5856: p = bucket->body[hindex];
5857: NEXTNM(mq0,mq);
5858: ndl_sub(HDL(p),HDL(d),DL(mq));
5859: ndl_copy(DL(mq),DL(tm));
5860: if ( mod ) {
5861: c1 = invm(HCM(d),mod); c2 = HCM(p);
5862: DMAR(c1,c2,0,mod,c); CM(mq) = c;
5863: CM(tm) = mod-c;
5864: } else {
1.6 noro 5865: divsz(HCZ(p),HCZ(d),&CZ(mq));
5866: chsgnz(CZ(mq),&CZ(tm));
1.1 noro 5867: }
5868: t = ndv_mul_nmv_trunc(mod,tm,d,HDL(d));
5869: bucket->body[hindex] = nd_remove_head(p);
5870: t = nd_remove_head(t);
5871: add_pbucket(mod,bucket,t);
5872: }
5873: if ( !mq0 )
5874: r = 0;
5875: else {
5876: NEXT(mq) = 0;
5877: for ( i = 0, mq = mq0; mq; mq = NEXT(mq), i++ );
5878: MKND(nv,mq0,i,r);
5879: /* XXX */
5880: SG(r) = HTD(r);
5881: }
5882: return r;
5883: }
5884: }
5885:
5886: void ndv_realloc(NDV p,int obpe,int oadv,EPOS oepos)
5887: {
5888: NMV m,mr,mr0,t;
5889: int len,i,k;
5890:
5891: if ( !p ) return;
5892: m = BDY(p); len = LEN(p);
5893: mr0 = nmv_adv>oadv?(NMV)REALLOC(BDY(p),len*nmv_adv):BDY(p);
5894: m = (NMV)((char *)mr0+(len-1)*oadv);
5895: mr = (NMV)((char *)mr0+(len-1)*nmv_adv);
5896: t = (NMV)MALLOC(nmv_adv);
5897: for ( i = 0; i < len; i++, NMV_OPREV(m), NMV_PREV(mr) ) {
1.6 noro 5898: CZ(t) = CZ(m);
1.1 noro 5899: for ( k = 0; k < nd_wpd; k++ ) DL(t)[k] = 0;
5900: ndl_reconstruct(DL(m),DL(t),obpe,oepos);
1.6 noro 5901: CZ(mr) = CZ(t);
1.1 noro 5902: ndl_copy(DL(t),DL(mr));
5903: }
5904: BDY(p) = mr0;
5905: }
5906:
5907: NDV ndv_dup_realloc(NDV p,int obpe,int oadv,EPOS oepos)
5908: {
5909: NMV m,mr,mr0;
5910: int len,i;
5911: NDV r;
5912:
5913: if ( !p ) return 0;
5914: m = BDY(p); len = LEN(p);
5915: mr0 = mr = (NMV)MALLOC(len*nmv_adv);
5916: for ( i = 0; i < len; i++, NMV_OADV(m), NMV_ADV(mr) ) {
5917: ndl_zero(DL(mr));
5918: ndl_reconstruct(DL(m),DL(mr),obpe,oepos);
1.6 noro 5919: CZ(mr) = CZ(m);
1.1 noro 5920: }
5921: MKNDV(NV(p),mr0,len,r);
5922: SG(r) = SG(p);
1.24 ! noro 5923: r->sig = p->sig;
1.1 noro 5924: return r;
5925: }
5926:
5927: /* duplicate p */
5928:
5929: NDV ndv_dup(int mod,NDV p)
5930: {
5931: NDV d;
5932: NMV t,m,m0;
5933: int i,len;
5934:
5935: if ( !p ) return 0;
5936: len = LEN(p);
5937: m0 = m = (NMV)((mod>0 || mod==-1)?MALLOC_ATOMIC(len*nmv_adv):MALLOC(len*nmv_adv));
5938: for ( t = BDY(p), i = 0; i < len; i++, NMV_ADV(t), NMV_ADV(m) ) {
5939: ndl_copy(DL(t),DL(m));
1.6 noro 5940: CZ(m) = CZ(t);
1.1 noro 5941: }
5942: MKNDV(NV(p),m0,len,d);
5943: SG(d) = SG(p);
5944: return d;
5945: }
5946:
5947: NDV ndv_symbolic(int mod,NDV p)
5948: {
5949: NDV d;
5950: NMV t,m,m0;
5951: int i,len;
5952:
5953: if ( !p ) return 0;
5954: len = LEN(p);
5955: m0 = m = (NMV)((mod>0||mod==-1)?MALLOC_ATOMIC(len*nmv_adv):MALLOC(len*nmv_adv));
5956: for ( t = BDY(p), i = 0; i < len; i++, NMV_ADV(t), NMV_ADV(m) ) {
5957: ndl_copy(DL(t),DL(m));
1.6 noro 5958: CZ(m) = ONE;
1.1 noro 5959: }
5960: MKNDV(NV(p),m0,len,d);
5961: SG(d) = SG(p);
5962: return d;
5963: }
5964:
5965: ND nd_dup(ND p)
5966: {
5967: ND d;
5968: NM t,m,m0;
5969:
5970: if ( !p ) return 0;
5971: for ( m0 = 0, t = BDY(p); t; t = NEXT(t) ) {
5972: NEXTNM(m0,m);
5973: ndl_copy(DL(t),DL(m));
1.6 noro 5974: CZ(m) = CZ(t);
1.1 noro 5975: }
5976: if ( m0 ) NEXT(m) = 0;
5977: MKND(NV(p),m0,LEN(p),d);
5978: SG(d) = SG(p);
5979: return d;
5980: }
5981:
5982: /* XXX if p->len == 0 then it represents 0 */
5983:
5984: void ndv_mod(int mod,NDV p)
5985: {
5986: NMV t,d;
5987: int r,s,u;
5988: int i,len,dlen;
5989: P cp;
5990: Z c;
5991: Obj gfs;
5992:
5993: if ( !p ) return;
5994: len = LEN(p);
5995: dlen = 0;
5996: if ( mod == -1 )
5997: for ( t = d = BDY(p), i = 0; i < len; i++, NMV_ADV(t) ) {
5998: simp_ff((Obj)CP(t),&gfs);
5999: if ( gfs ) {
6000: r = FTOIF(CONT((GFS)gfs));
6001: CM(d) = r;
6002: ndl_copy(DL(t),DL(d));
6003: NMV_ADV(d);
6004: dlen++;
6005: }
6006: }
6007: else if ( mod == -2 )
6008: for ( t = d = BDY(p), i = 0; i < len; i++, NMV_ADV(t) ) {
6009: simp_ff((Obj)CP(t),&gfs);
6010: if ( gfs ) {
6011: lmtolf((LM)gfs,&CZ(d));
6012: ndl_copy(DL(t),DL(d));
6013: NMV_ADV(d);
6014: dlen++;
6015: }
6016: }
6017: else
6018: for ( t = d = BDY(p), i = 0; i < len; i++, NMV_ADV(t) ) {
6019: if ( nd_vc ) {
6020: nd_subst_vector(nd_vc,CP(t),nd_subst,&cp);
6021: c = (Z)cp;
6022: } else
1.6 noro 6023: c = CZ(t);
1.1 noro 6024: r = remqi((Q)c,mod);
6025: if ( r ) {
6026: CM(d) = r;
6027: ndl_copy(DL(t),DL(d));
6028: NMV_ADV(d);
6029: dlen++;
6030: }
6031: }
6032: LEN(p) = dlen;
6033: }
6034:
6035: NDV ptondv(VL vl,VL dvl,P p)
6036: {
6037: ND nd;
6038:
6039: nd = ptond(vl,dvl,p);
6040: return ndtondv(0,nd);
6041: }
6042:
6043: void pltozpl(LIST l,Q *cont,LIST *pp)
6044: {
1.16 noro 6045: NODE nd,nd1;
6046: int n;
6047: P *pl;
6048: Q *cl;
6049: int i;
6050: P dmy;
6051: Z dvr,inv;
6052: LIST r;
6053:
6054: nd = BDY(l); n = length(nd);
6055: pl = (P *)MALLOC(n*sizeof(P));
6056: cl = (Q *)MALLOC(n*sizeof(Q));
6057: for ( i = 0; i < n; i++, nd = NEXT(nd) ) {
6058: ptozp((P)BDY(nd),1,&cl[i],&dmy);
6059: }
6060: qltozl(cl,n,&dvr);
6061: divz(ONE,dvr,&inv);
6062: nd = BDY(l);
6063: for ( i = 0; i < n; i++, nd = NEXT(nd) )
6064: divsp(CO,(P)BDY(nd),(P)dvr,&pl[i]);
6065: nd = 0;
6066: for ( i = n-1; i >= 0; i-- ) {
6067: MKNODE(nd1,pl[i],nd); nd = nd1;
6068: }
6069: MKLIST(r,nd);
6070: *pp = r;
1.1 noro 6071: }
6072:
6073: /* (a1,a2,...,an) -> a1*e(1)+...+an*e(n) */
6074:
6075: NDV pltondv(VL vl,VL dvl,LIST p)
6076: {
6077: int i;
6078: NODE t;
6079: ND r,ri;
6080: NM m;
6081:
6082: if ( !nd_module ) error("pltond : module order must be set");
6083: r = 0;
6084: for ( i = 1, t = BDY(p); t; t = NEXT(t), i++ ) {
6085: ri = ptond(vl,dvl,(P)BDY(t));
6086: if ( ri )
6087: for ( m = BDY(ri); m; m = NEXT(m) ) {
6088: MPOS(DL(m)) = i;
6089: TD(DL(m)) = ndl_weight(DL(m));
6090: if ( nd_blockmask ) ndl_weight_mask(DL(m));
6091: }
6092: r = nd_add(0,r,ri);
6093: }
6094: return ndtondv(0,r);
6095: }
6096:
6097: ND ptond(VL vl,VL dvl,P p)
6098: {
6099: int n,i,j,k,e;
6100: VL tvl;
6101: V v;
6102: DCP dc;
6103: DCP *w;
6104: ND r,s,t,u;
6105: P x;
6106: int c;
6107: UINT *d;
6108: NM m,m0;
6109:
6110: if ( !p )
6111: return 0;
6112: else if ( NUM(p) ) {
6113: NEWNM(m);
6114: ndl_zero(DL(m));
6115: if ( !INT((Q)p) )
6116: error("ptond : input must be integer-coefficient");
1.6 noro 6117: CZ(m) = (Z)p;
1.1 noro 6118: NEXT(m) = 0;
6119: MKND(nd_nvar,m,1,r);
6120: SG(r) = 0;
6121: return r;
6122: } else {
6123: for ( dc = DC(p), k = 0; dc; dc = NEXT(dc), k++ );
6124: w = (DCP *)MALLOC(k*sizeof(DCP));
6125: for ( dc = DC(p), j = 0; j < k; dc = NEXT(dc), j++ ) w[j] = dc;
6126: for ( i = 0, tvl = dvl, v = VR(p);
6127: tvl && tvl->v != v; tvl = NEXT(tvl), i++ );
6128: if ( !tvl ) {
6129: for ( j = k-1, s = 0, MKV(v,x); j >= 0; j-- ) {
6130: t = ptond(vl,dvl,COEF(w[j]));
6131: pwrp(vl,x,DEG(w[j]),&p);
6132: nd_mul_c_p(CO,t,p); s = nd_add(0,s,t);
6133: }
6134: return s;
6135: } else {
6136: NEWNM(m0); d = DL(m0);
6137: for ( j = k-1, s = 0; j >= 0; j-- ) {
1.6 noro 6138: ndl_zero(d); e = ZTOS(DEG(w[j])); PUT_EXP(d,i,e);
1.1 noro 6139: TD(d) = MUL_WEIGHT(e,i);
6140: if ( nd_blockmask) ndl_weight_mask(d);
6141: if ( nd_module ) MPOS(d) = 0;
6142: t = ptond(vl,dvl,COEF(w[j]));
6143: for ( m = BDY(t); m; m = NEXT(m) )
6144: ndl_addto(DL(m),d);
6145: SG(t) += TD(d);
6146: s = nd_add(0,s,t);
6147: }
6148: FREENM(m0);
6149: return s;
6150: }
6151: }
6152: }
6153:
6154: P ndvtop(int mod,VL vl,VL dvl,NDV p)
6155: {
6156: VL tvl;
6157: int len,n,j,i,e;
6158: NMV m;
6159: Z q;
6160: P c;
6161: UINT *d;
6162: P s,r,u,t,w;
6163: GFS gfs;
6164:
6165: if ( !p ) return 0;
6166: else {
6167: len = LEN(p);
6168: n = NV(p);
6169: m = (NMV)(((char *)BDY(p))+nmv_adv*(len-1));
6170: for ( j = len-1, s = 0; j >= 0; j--, NMV_PREV(m) ) {
6171: if ( mod == -1 ) {
6172: e = IFTOF(CM(m)); MKGFS(e,gfs); c = (P)gfs;
6173: } else if ( mod == -2 ) {
6174: c = (P)CZ(m);
6175: } else if ( mod > 0 ) {
1.6 noro 6176: STOZ(CM(m),q); c = (P)q;
1.1 noro 6177: } else
6178: c = CP(m);
6179: d = DL(m);
6180: for ( i = 0, t = c, tvl = dvl; i < n; tvl = NEXT(tvl), i++ ) {
1.6 noro 6181: MKV(tvl->v,r); e = GET_EXP(d,i); STOZ(e,q);
1.1 noro 6182: pwrp(vl,r,q,&u); mulp(vl,t,u,&w); t = w;
6183: }
6184: addp(vl,s,t,&u); s = u;
6185: }
6186: return s;
6187: }
6188: }
6189:
6190: LIST ndvtopl(int mod,VL vl,VL dvl,NDV p,int rank)
6191: {
6192: VL tvl;
6193: int len,n,j,i,e;
6194: NMV m;
6195: Z q;
6196: P c;
6197: UINT *d;
6198: P s,r,u,t,w;
6199: GFS gfs;
6200: P *a;
6201: LIST l;
6202: NODE nd,nd1;
6203:
6204: if ( !p ) return 0;
6205: else {
6206: a = (P *)MALLOC((rank+1)*sizeof(P));
6207: for ( i = 0; i <= rank; i++ ) a[i] = 0;
6208: len = LEN(p);
6209: n = NV(p);
6210: m = (NMV)(((char *)BDY(p))+nmv_adv*(len-1));
6211: for ( j = len-1; j >= 0; j--, NMV_PREV(m) ) {
6212: if ( mod == -1 ) {
6213: e = IFTOF(CM(m)); MKGFS(e,gfs); c = (P)gfs;
6214: } else if ( mod ) {
1.6 noro 6215: STOZ(CM(m),q); c = (P)q;
1.1 noro 6216: } else
6217: c = CP(m);
6218: d = DL(m);
6219: for ( i = 0, t = c, tvl = dvl; i < n; tvl = NEXT(tvl), i++ ) {
1.6 noro 6220: MKV(tvl->v,r); e = GET_EXP(d,i); STOZ(e,q);
1.1 noro 6221: pwrp(vl,r,q,&u); mulp(vl,t,u,&w); t = w;
6222: }
6223: addp(vl,a[MPOS(d)],t,&u); a[MPOS(d)] = u;
6224: }
6225: nd = 0;
6226: for ( i = rank; i > 0; i-- ) {
6227: MKNODE(nd1,a[i],nd); nd = nd1;
6228: }
6229: MKLIST(l,nd);
6230: return l;
6231: }
6232: }
6233:
6234: NDV ndtondv(int mod,ND p)
6235: {
6236: NDV d;
6237: NMV m,m0;
6238: NM t;
6239: int i,len;
6240:
6241: if ( !p ) return 0;
6242: len = LEN(p);
6243: if ( mod > 0 || mod == -1 )
6244: m0 = m = (NMV)MALLOC_ATOMIC_IGNORE_OFF_PAGE(len*nmv_adv);
6245: else
6246: m0 = m = MALLOC(len*nmv_adv);
6247: #if 0
6248: ndv_alloc += nmv_adv*len;
6249: #endif
6250: for ( t = BDY(p), i = 0; t; t = NEXT(t), i++, NMV_ADV(m) ) {
6251: ndl_copy(DL(t),DL(m));
1.6 noro 6252: CZ(m) = CZ(t);
1.1 noro 6253: }
6254: MKNDV(NV(p),m0,len,d);
6255: SG(d) = SG(p);
1.24 ! noro 6256: d->sig = p->sig;
1.1 noro 6257: return d;
6258: }
6259:
1.16 noro 6260: static int dmm_comp_nv;
6261:
6262: int dmm_comp(DMM *a,DMM *b)
6263: {
6264: return -compdmm(dmm_comp_nv,*a,*b);
6265: }
6266:
6267: void dmm_sort_by_ord(DMM *a,int len,int nv)
6268: {
6269: dmm_comp_nv = nv;
6270: qsort(a,len,sizeof(DMM),(int (*)(const void *,const void *))dmm_comp);
6271: }
6272:
6273: void dpm_sort(DPM p,DPM *rp)
6274: {
6275: DMM t,t1;
6276: int len,i,n;
6277: DMM *a;
6278: DPM d;
6279:
6280: if ( !p ) *rp = 0;
6281: for ( t = BDY(p), len = 0; t; t = NEXT(t), len++ );
6282: a = (DMM *)MALLOC(len*sizeof(DMM));
6283: for ( i = 0, t = BDY(p); i < len; i++, t = NEXT(t) ) a[i] = t;
6284: n = p->nv;
6285: dmm_sort_by_ord(a,len,n);
6286: t = 0;
6287: for ( i = len-1; i >= 0; i-- ) {
6288: NEWDMM(t1);
6289: t1->c = a[i]->c;
6290: t1->dl = a[i]->dl;
6291: t1->pos = a[i]->pos;
6292: t1->next = t;
6293: t = t1;
6294: }
6295: MKDPM(n,t,d);
6296: SG(d) = SG(p);
6297: *rp = d;
6298: }
6299:
1.18 noro 6300: int dpm_comp(DPM *a,DPM *b)
6301: {
1.22 noro 6302: return -compdpm(CO,*a,*b);
1.18 noro 6303: }
6304:
6305: NODE dpm_sort_list(NODE l)
6306: {
6307: int i,len;
6308: NODE t,t1;
6309: DPM *a;
6310:
6311: len = length(l);
6312: a = (DPM *)MALLOC(len*sizeof(DPM));
6313: for ( t = l, i = 0; i < len; i++, t = NEXT(t) ) a[i] = (DPM)BDY(t);
6314: qsort(a,len,sizeof(DPM),(int (*)(const void *,const void *))dpm_comp);
6315: t = 0;
6316: for ( i = len-1; i >= 0; i-- ) {
6317: MKNODE(t1,(pointer)a[i],t); t = t1;
6318: }
6319: return t;
6320: }
6321:
1.20 noro 6322: int nmv_comp(NMV a,NMV b)
6323: {
1.21 noro 6324: int t;
6325: t = DL_COMPARE(a->dl,b->dl);
6326: return -t;
1.20 noro 6327: }
6328:
1.16 noro 6329: NDV dpmtondv(int mod,DPM p)
6330: {
6331: NDV d;
6332: NMV m,m0;
6333: DMM t;
6334: DMM *a;
6335: int i,len,n;
6336:
6337: if ( !p ) return 0;
6338: for ( t = BDY(p), len = 0; t; t = NEXT(t), len++ );
6339: a = (DMM *)MALLOC(len*sizeof(DMM));
6340: for ( i = 0, t = BDY(p); i < len; i++, t = NEXT(t) ) a[i] = t;
6341: n = p->nv;
6342: dmm_sort_by_ord(a,len,n);
6343: if ( mod > 0 || mod == -1 )
6344: m0 = m = (NMV)MALLOC_ATOMIC_IGNORE_OFF_PAGE(len*nmv_adv);
6345: else
6346: m0 = m = MALLOC(len*nmv_adv);
6347: #if 0
6348: ndv_alloc += nmv_adv*len;
6349: #endif
6350: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
6351: dltondl(n,a[i]->dl,DL(m));
6352: MPOS(DL(m)) = a[i]->pos;
1.20 noro 6353: TD(DL(m)) = ndl_weight(DL(m));
1.16 noro 6354: CZ(m) = (Z)a[i]->c;
6355: }
1.20 noro 6356: qsort(m0,len,nmv_adv,(int (*)(const void *,const void *))nmv_comp);
1.16 noro 6357: MKNDV(NV(p),m0,len,d);
6358: SG(d) = SG(p);
6359: return d;
6360: }
6361:
1.1 noro 6362: ND ndvtond(int mod,NDV p)
6363: {
6364: ND d;
6365: NM m,m0;
6366: NMV t;
6367: int i,len;
6368:
6369: if ( !p ) return 0;
6370: m0 = 0;
6371: len = p->len;
6372: for ( t = BDY(p), i = 0; i < len; NMV_ADV(t), i++ ) {
6373: NEXTNM(m0,m);
6374: ndl_copy(DL(t),DL(m));
1.6 noro 6375: CZ(m) = CZ(t);
1.1 noro 6376: }
6377: NEXT(m) = 0;
6378: MKND(NV(p),m0,len,d);
6379: SG(d) = SG(p);
6380: return d;
6381: }
6382:
6383: DP ndvtodp(int mod,NDV p)
6384: {
6385: MP m,m0;
6386: DP d;
6387: NMV t;
6388: int i,len;
6389:
6390: if ( !p ) return 0;
6391: m0 = 0;
6392: len = p->len;
6393: for ( t = BDY(p), i = 0; i < len; NMV_ADV(t), i++ ) {
6394: NEXTMP(m0,m);
6395: m->dl = ndltodl(nd_nvar,DL(t));
6396: m->c = (Obj)ndctop(mod,t->c);
6397: }
6398: NEXT(m) = 0;
6399: MKDP(nd_nvar,m0,d);
6400: SG(d) = SG(p);
6401: return d;
6402: }
6403:
1.16 noro 6404: DPM ndvtodpm(int mod,NDV p)
6405: {
6406: DMM m,m0;
6407: DPM d;
6408: NMV t;
6409: int i,len;
6410:
6411: if ( !p ) return 0;
6412: m0 = 0;
6413: len = p->len;
6414: for ( t = BDY(p), i = 0; i < len; NMV_ADV(t), i++ ) {
6415: NEXTDMM(m0,m);
6416: m->dl = ndltodl(nd_nvar,DL(t));
6417: m->c = (Obj)ndctop(mod,t->c);
6418: m->pos = MPOS(DL(t));
6419: }
6420: NEXT(m) = 0;
6421: MKDPM(nd_nvar,m0,d);
6422: SG(d) = SG(p);
6423: return d;
6424: }
6425:
6426:
1.1 noro 6427: DP ndtodp(int mod,ND p)
6428: {
6429: MP m,m0;
6430: DP d;
6431: NM t;
6432: int i,len;
6433:
6434: if ( !p ) return 0;
6435: m0 = 0;
6436: len = p->len;
6437: for ( t = BDY(p); t; t = NEXT(t) ) {
6438: NEXTMP(m0,m);
6439: m->dl = ndltodl(nd_nvar,DL(t));
6440: m->c = (Obj)ndctop(mod,t->c);
6441: }
6442: NEXT(m) = 0;
6443: MKDP(nd_nvar,m0,d);
6444: SG(d) = SG(p);
6445: return d;
6446: }
6447:
6448: void ndv_print(NDV p)
6449: {
6450: NMV m;
6451: int i,len;
6452:
6453: if ( !p ) printf("0\n");
6454: else {
6455: len = LEN(p);
6456: for ( m = BDY(p), i = 0; i < len; i++, NMV_ADV(m) ) {
6457: if ( CM(m) & 0x80000000 ) printf("+@_%d*",IFTOF(CM(m)));
6458: else printf("+%d*",CM(m));
6459: ndl_print(DL(m));
6460: }
6461: printf("\n");
6462: }
6463: }
6464:
6465: void ndv_print_q(NDV p)
6466: {
6467: NMV m;
6468: int i,len;
6469:
6470: if ( !p ) printf("0\n");
6471: else {
6472: len = LEN(p);
6473: for ( m = BDY(p), i = 0; i < len; i++, NMV_ADV(m) ) {
6474: printf("+");
1.6 noro 6475: printexpr(CO,(Obj)CZ(m));
1.1 noro 6476: printf("*");
6477: ndl_print(DL(m));
6478: }
6479: printf("\n");
6480: }
6481: }
6482:
6483: NODE ndv_reducebase(NODE x,int *perm)
6484: {
6485: int len,i,j;
6486: NDVI w;
6487: NODE t,t0;
6488:
6489: len = length(x);
6490: w = (NDVI)MALLOC(len*sizeof(struct oNDVI));
6491: for ( i = 0, t = x; i < len; i++, t = NEXT(t) ) {
6492: w[i].p = BDY(t); w[i].i = perm[i];
6493: }
6494: for ( i = 0; i < len; i++ ) {
6495: for ( j = 0; j < i; j++ ) {
6496: if ( w[i].p && w[j].p ) {
6497: if ( ndl_reducible(HDL(w[i].p),HDL(w[j].p)) ) w[i].p = 0;
6498: else if ( ndl_reducible(HDL(w[j].p),HDL(w[i].p)) ) w[j].p = 0;
6499: }
6500: }
6501: }
6502: for ( i = j = 0, t0 = 0; i < len; i++ ) {
6503: if ( w[i].p ) {
6504: NEXTNODE(t0,t); BDY(t) = (pointer)w[i].p;
6505: perm[j++] = w[i].i;
6506: }
6507: }
6508: NEXT(t) = 0; x = t0;
6509: return x;
6510: }
6511:
6512: /* XXX incomplete */
6513:
1.21 noro 6514: extern DMMstack dmm_stack;
6515: int ndl_module_schreyer_compare(UINT *a,UINT *b);
1.16 noro 6516:
1.1 noro 6517: void nd_init_ord(struct order_spec *ord)
6518: {
6519: nd_module = (ord->id >= 256);
6520: if ( nd_module ) {
6521: nd_dcomp = -1;
1.21 noro 6522: nd_module_ordtype = ord->module_ordtype;
1.1 noro 6523: nd_pot_nelim = ord->pot_nelim;
6524: nd_poly_weight_len = ord->nv;
6525: nd_poly_weight = ord->top_weight;
6526: nd_module_rank = ord->module_rank;
6527: nd_module_weight = ord->module_top_weight;
6528: }
6529: nd_matrix = 0;
6530: nd_matrix_len = 0;
6531: switch ( ord->id ) {
6532: case 0:
6533: switch ( ord->ord.simple ) {
6534: case 0:
6535: nd_dcomp = 1;
6536: nd_isrlex = 1;
6537: break;
6538: case 1:
6539: nd_dcomp = 1;
6540: nd_isrlex = 0;
6541: break;
6542: case 2:
6543: nd_dcomp = 0;
6544: nd_isrlex = 0;
6545: ndl_compare_function = ndl_lex_compare;
6546: break;
6547: case 11:
6548: /* XXX */
6549: nd_dcomp = 0;
6550: nd_isrlex = 1;
6551: ndl_compare_function = ndl_ww_lex_compare;
6552: break;
6553: default:
6554: error("nd_gr : unsupported order");
6555: }
6556: break;
6557: case 1:
6558: /* block order */
6559: /* XXX */
6560: nd_dcomp = -1;
6561: nd_isrlex = 0;
6562: ndl_compare_function = ndl_block_compare;
6563: break;
6564: case 2:
6565: /* matrix order */
6566: /* XXX */
6567: nd_dcomp = -1;
6568: nd_isrlex = 0;
6569: nd_matrix_len = ord->ord.matrix.row;
6570: nd_matrix = ord->ord.matrix.matrix;
6571: ndl_compare_function = ndl_matrix_compare;
6572: break;
6573: case 3:
6574: /* composite order */
6575: nd_dcomp = -1;
6576: nd_isrlex = 0;
6577: nd_worb_len = ord->ord.composite.length;
6578: nd_worb = ord->ord.composite.w_or_b;
6579: ndl_compare_function = ndl_composite_compare;
6580: break;
6581:
6582: /* module order */
6583: case 256:
6584: switch ( ord->ord.simple ) {
6585: case 0:
1.21 noro 6586: nd_dcomp = 0;
1.1 noro 6587: nd_isrlex = 1;
1.21 noro 6588: ndl_compare_function = ndl_module_glex_compare;
1.1 noro 6589: break;
6590: case 1:
1.21 noro 6591: nd_dcomp = 0;
1.1 noro 6592: nd_isrlex = 0;
6593: ndl_compare_function = ndl_module_glex_compare;
6594: break;
6595: case 2:
1.21 noro 6596: nd_dcomp = 0;
1.1 noro 6597: nd_isrlex = 0;
1.21 noro 6598: ndl_compare_function = ndl_module_compare;
6599: ndl_base_compare_function = ndl_lex_compare;
1.1 noro 6600: break;
6601: default:
1.21 noro 6602: error("nd_init_ord : unsupported order");
1.1 noro 6603: }
6604: break;
6605: case 257:
6606: /* block order */
6607: nd_isrlex = 0;
1.21 noro 6608: ndl_compare_function = ndl_module_compare;
6609: ndl_base_compare_function = ndl_block_compare;
1.1 noro 6610: break;
6611: case 258:
6612: /* matrix order */
6613: nd_isrlex = 0;
6614: nd_matrix_len = ord->ord.matrix.row;
6615: nd_matrix = ord->ord.matrix.matrix;
1.21 noro 6616: ndl_compare_function = ndl_module_compare;
6617: ndl_base_compare_function = ndl_matrix_compare;
1.1 noro 6618: break;
6619: case 259:
6620: /* composite order */
6621: nd_isrlex = 0;
6622: nd_worb_len = ord->ord.composite.length;
6623: nd_worb = ord->ord.composite.w_or_b;
1.21 noro 6624: ndl_compare_function = ndl_module_compare;
6625: ndl_base_compare_function = ndl_composite_compare;
6626: break;
6627: case 300:
6628: /* schreyer order */
6629: if ( ord->base->id != 256 )
6630: error("nd_init_ord : unsupported base order");
6631: ndl_compare_function = ndl_module_schreyer_compare;
6632: dmm_stack = ord->dmmstack;
6633: switch ( ord->base->ord.simple ) {
6634: case 0:
6635: nd_isrlex = 1;
6636: ndl_base_compare_function = ndl_glex_compare;
6637: dl_base_compare_function = cmpdl_revgradlex;
6638: break;
6639: case 1:
6640: nd_isrlex = 0;
6641: ndl_base_compare_function = ndl_glex_compare;
6642: dl_base_compare_function = cmpdl_gradlex;
6643: break;
6644: case 2:
6645: nd_isrlex = 0;
6646: ndl_base_compare_function = ndl_lex_compare;
6647: dl_base_compare_function = cmpdl_lex;
6648: break;
6649: default:
6650: error("nd_init_ord : unsupported order");
6651: }
1.1 noro 6652: break;
6653: }
6654: nd_ord = ord;
6655: }
6656:
6657: BlockMask nd_create_blockmask(struct order_spec *ord)
6658: {
6659: int n,i,j,s,l;
6660: UINT *t;
6661: BlockMask bm;
6662:
6663: /* we only create mask table for block order */
6664: if ( ord->id != 1 && ord->id != 257 )
6665: return 0;
6666: n = ord->ord.block.length;
6667: bm = (BlockMask)MALLOC(sizeof(struct oBlockMask));
6668: bm->n = n;
6669: bm->order_pair = ord->ord.block.order_pair;
6670: bm->mask = (UINT **)MALLOC(n*sizeof(UINT *));
6671: for ( i = 0, s = 0; i < n; i++ ) {
6672: bm->mask[i] = t = (UINT *)MALLOC_ATOMIC(nd_wpd*sizeof(UINT));
6673: for ( j = 0; j < nd_wpd; j++ ) t[j] = 0;
6674: l = bm->order_pair[i].length;
6675: for ( j = 0; j < l; j++, s++ ) PUT_EXP(t,s,nd_mask0);
6676: }
6677: return bm;
6678: }
6679:
6680: EPOS nd_create_epos(struct order_spec *ord)
6681: {
6682: int i,j,l,s,ord_l,ord_o;
6683: EPOS epos;
6684: struct order_pair *op;
6685:
6686: epos = (EPOS)MALLOC_ATOMIC(nd_nvar*sizeof(struct oEPOS));
6687: switch ( ord->id ) {
1.21 noro 6688: case 0: case 256: case 300:
1.1 noro 6689: if ( nd_isrlex ) {
6690: for ( i = 0; i < nd_nvar; i++ ) {
6691: epos[i].i = nd_exporigin + (nd_nvar-1-i)/nd_epw;
6692: epos[i].s = (nd_epw-((nd_nvar-1-i)%nd_epw)-1)*nd_bpe;
6693: }
6694: } else {
6695: for ( i = 0; i < nd_nvar; i++ ) {
6696: epos[i].i = nd_exporigin + i/nd_epw;
6697: epos[i].s = (nd_epw-(i%nd_epw)-1)*nd_bpe;
6698: }
6699: }
6700: break;
6701: case 1: case 257:
6702: /* block order */
6703: l = ord->ord.block.length;
6704: op = ord->ord.block.order_pair;
6705: for ( j = 0, s = 0; j < l; j++ ) {
6706: ord_o = op[j].order;
6707: ord_l = op[j].length;
6708: if ( !ord_o )
6709: for ( i = 0; i < ord_l; i++ ) {
6710: epos[s+i].i = nd_exporigin + (s+ord_l-i-1)/nd_epw;
6711: epos[s+i].s = (nd_epw-((s+ord_l-i-1)%nd_epw)-1)*nd_bpe;
6712: }
6713: else
6714: for ( i = 0; i < ord_l; i++ ) {
6715: epos[s+i].i = nd_exporigin + (s+i)/nd_epw;
6716: epos[s+i].s = (nd_epw-((s+i)%nd_epw)-1)*nd_bpe;
6717: }
6718: s += ord_l;
6719: }
6720: break;
6721: case 2:
6722: /* matrix order */
6723: case 3:
6724: /* composite order */
6725: default:
6726: for ( i = 0; i < nd_nvar; i++ ) {
6727: epos[i].i = nd_exporigin + i/nd_epw;
6728: epos[i].s = (nd_epw-(i%nd_epw)-1)*nd_bpe;
6729: }
6730: break;
6731: }
6732: return epos;
6733: }
6734:
6735: /* external interface */
6736:
6737: void nd_nf_p(Obj f,LIST g,LIST v,int m,struct order_spec *ord,Obj *rp)
6738: {
6739: NODE t,in0,in;
6740: ND ndf,nf;
6741: NDV ndvf;
6742: VL vv,tv;
6743: int stat,nvar,max,mrank;
6744: union oNDC dn;
6745: Q cont;
6746: P pp;
6747: LIST ppl;
6748:
6749: if ( !f ) {
6750: *rp = 0;
6751: return;
6752: }
6753: pltovl(v,&vv);
6754: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
6755:
6756: /* max=65536 implies nd_bpe=32 */
6757: max = 65536;
6758:
6759: nd_module = 0;
6760: /* nd_module will be set if ord is a module ordering */
6761: nd_init_ord(ord);
6762: nd_setup_parameters(nvar,max);
6763: if ( nd_module && OID(f) != O_LIST )
6764: error("nd_nf_p : the first argument must be a list");
6765: if ( nd_module ) mrank = length(BDY((LIST)f));
6766: /* conversion to ndv */
6767: for ( in0 = 0, t = BDY(g); t; t = NEXT(t) ) {
6768: NEXTNODE(in0,in);
6769: if ( nd_module ) {
6770: if ( !BDY(t) || OID(BDY(t)) != O_LIST
6771: || length(BDY((LIST)BDY(t))) != mrank )
6772: error("nd_nf_p : inconsistent basis element");
6773: if ( !m ) pltozpl((LIST)BDY(t),&cont,&ppl);
6774: else ppl = (LIST)BDY(t);
6775: BDY(in) = (pointer)pltondv(CO,vv,ppl);
6776: } else {
6777: if ( !m ) ptozp((P)BDY(t),1,&cont,&pp);
6778: else pp = (P)BDY(t);
6779: BDY(in) = (pointer)ptondv(CO,vv,pp);
6780: }
6781: if ( m ) ndv_mod(m,(NDV)BDY(in));
6782: }
6783: if ( in0 ) NEXT(in) = 0;
6784:
6785: if ( nd_module ) ndvf = pltondv(CO,vv,(LIST)f);
6786: else ndvf = ptondv(CO,vv,(P)f);
6787: if ( m ) ndv_mod(m,ndvf);
6788: ndf = (pointer)ndvtond(m,ndvf);
6789:
6790: /* dont sort, dont removecont */
1.24 ! noro 6791: ndv_setup(m,0,in0,1,1,0);
1.1 noro 6792: nd_scale=2;
1.6 noro 6793: stat = nd_nf(m,0,ndf,nd_ps,1,&nf);
1.1 noro 6794: if ( !stat )
6795: error("nd_nf_p : exponent too large");
6796: if ( nd_module ) *rp = (Obj)ndvtopl(m,CO,vv,ndtondv(m,nf),mrank);
6797: else *rp = (Obj)ndvtop(m,CO,vv,ndtondv(m,nf));
6798: }
6799:
6800: int nd_to_vect(int mod,UINT *s0,int n,ND d,UINT *r)
6801: {
6802: NM m;
6803: UINT *t,*s;
6804: int i;
6805:
6806: for ( i = 0; i < n; i++ ) r[i] = 0;
6807: for ( i = 0, s = s0, m = BDY(d); m; m = NEXT(m) ) {
6808: t = DL(m);
6809: for ( ; !ndl_equal(t,s); s += nd_wpd, i++ );
6810: r[i] = CM(m);
6811: }
6812: for ( i = 0; !r[i]; i++ );
6813: return i;
6814: }
6815:
6816: int nd_to_vect_q(UINT *s0,int n,ND d,Z *r)
6817: {
6818: NM m;
6819: UINT *t,*s;
6820: int i;
6821:
6822: for ( i = 0; i < n; i++ ) r[i] = 0;
6823: for ( i = 0, s = s0, m = BDY(d); m; m = NEXT(m) ) {
6824: t = DL(m);
6825: for ( ; !ndl_equal(t,s); s += nd_wpd, i++ );
1.6 noro 6826: r[i] = CZ(m);
1.1 noro 6827: }
6828: for ( i = 0; !r[i]; i++ );
6829: return i;
6830: }
6831:
6832: int nd_to_vect_lf(UINT *s0,int n,ND d,mpz_t *r)
6833: {
6834: NM m;
6835: UINT *t,*s;
6836: int i;
6837:
6838: for ( i = 0; i < n; i++ ) { mpz_init(r[i]); mpz_set_ui(r[i],0); }
6839: for ( i = 0, s = s0, m = BDY(d); m; m = NEXT(m) ) {
6840: t = DL(m);
6841: for ( ; !ndl_equal(t,s); s += nd_wpd, i++ );
6842: mpz_set(r[i],BDY(CZ(m)));
6843: }
6844: for ( i = 0; !mpz_sgn(r[i]); i++ );
6845: return i;
6846: }
6847:
6848: unsigned long *nd_to_vect_2(UINT *s0,int n,int *s0hash,ND p)
6849: {
6850: NM m;
6851: unsigned long *v;
6852: int i,j,h,size;
6853: UINT *s,*t;
6854:
6855: size = sizeof(unsigned long)*(n+BLEN-1)/BLEN;
6856: v = (unsigned long *)MALLOC_ATOMIC_IGNORE_OFF_PAGE(size);
6857: bzero(v,size);
6858: for ( i = j = 0, s = s0, m = BDY(p); m; j++, m = NEXT(m) ) {
6859: t = DL(m);
6860: h = ndl_hash_value(t);
6861: for ( ; h != s0hash[i] || !ndl_equal(t,s); s += nd_wpd, i++ );
6862: v[i/BLEN] |= 1L <<(i%BLEN);
6863: }
6864: return v;
6865: }
6866:
6867: int nd_nm_to_vect_2(UINT *s0,int n,int *s0hash,NDV p,NM m,unsigned long *v)
6868: {
6869: NMV mr;
6870: UINT *d,*t,*s;
6871: int i,j,len,h,head;
6872:
6873: d = DL(m);
6874: len = LEN(p);
6875: t = (UINT *)MALLOC(nd_wpd*sizeof(UINT));
6876: for ( i = j = 0, s = s0, mr = BDY(p); j < len; j++, NMV_ADV(mr) ) {
6877: ndl_add(d,DL(mr),t);
6878: h = ndl_hash_value(t);
6879: for ( ; h != s0hash[i] || !ndl_equal(t,s); s += nd_wpd, i++ );
6880: if ( j == 0 ) head = i;
6881: v[i/BLEN] |= 1L <<(i%BLEN);
6882: }
6883: return head;
6884: }
6885:
6886: Z *nm_ind_pair_to_vect(int mod,UINT *s0,int n,NM_ind_pair pair)
6887: {
6888: NM m;
6889: NMV mr;
6890: UINT *d,*t,*s;
6891: NDV p;
6892: int i,j,len;
6893: Z *r;
6894:
6895: m = pair->mul;
6896: d = DL(m);
6897: p = nd_ps[pair->index];
6898: len = LEN(p);
6899: r = (Z *)CALLOC(n,sizeof(Q));
6900: t = (UINT *)MALLOC(nd_wpd*sizeof(UINT));
6901: for ( i = j = 0, s = s0, mr = BDY(p); j < len; j++, NMV_ADV(mr) ) {
6902: ndl_add(d,DL(mr),t);
6903: for ( ; !ndl_equal(t,s); s += nd_wpd, i++ );
1.6 noro 6904: r[i] = CZ(mr);
1.1 noro 6905: }
6906: return r;
6907: }
6908:
1.11 noro 6909: IndArray nm_ind_pair_to_vect_compress(int trace,UINT *s0,int n,NM_ind_pair pair,int start)
1.1 noro 6910: {
6911: NM m;
6912: NMV mr;
1.11 noro 6913: UINT *d,*t,*s,*u;
1.1 noro 6914: NDV p;
6915: unsigned char *ivc;
6916: unsigned short *ivs;
6917: UINT *v,*ivi,*s0v;
1.11 noro 6918: int i,j,len,prev,diff,cdiff,h,st,ed,md,c;
1.1 noro 6919: IndArray r;
6920:
6921: m = pair->mul;
6922: d = DL(m);
6923: if ( trace )
6924: p = nd_demand?nd_ps_trace_sym[pair->index]:nd_ps_trace[pair->index];
6925: else
6926: p = nd_demand?nd_ps_sym[pair->index]:nd_ps[pair->index];
6927:
6928: len = LEN(p);
6929: t = (UINT *)MALLOC(nd_wpd*sizeof(UINT));
6930: v = (unsigned int *)MALLOC(len*sizeof(unsigned int));
1.11 noro 6931: for ( prev = start, mr = BDY(p), j = 0; j < len; j++, NMV_ADV(mr) ) {
6932: ndl_add(d,DL(mr),t);
6933: st = prev;
6934: ed = n;
6935: while ( ed > st ) {
6936: md = (st+ed)/2;
6937: u = s0+md*nd_wpd;
6938: c = DL_COMPARE(u,t);
6939: if ( c == 0 ) break;
6940: else if ( c > 0 ) st = md;
6941: else ed = md;
6942: }
6943: prev = v[j] = md;
1.1 noro 6944: }
6945: r = (IndArray)MALLOC(sizeof(struct oIndArray));
6946: r->head = v[0];
6947: diff = 0;
6948: for ( i = 1; i < len; i++ ) {
6949: cdiff = v[i]-v[i-1]; diff = MAX(cdiff,diff);
6950: }
6951: if ( diff < 256 ) {
6952: r->width = 1;
6953: ivc = (unsigned char *)MALLOC_ATOMIC(len*sizeof(unsigned char));
6954: r->index.c = ivc;
6955: for ( i = 1, ivc[0] = 0; i < len; i++ ) ivc[i] = v[i]-v[i-1];
6956: } else if ( diff < 65536 ) {
6957: r->width = 2;
6958: ivs = (unsigned short *)MALLOC_ATOMIC(len*sizeof(unsigned short));
6959: r->index.s = ivs;
6960: for ( i = 1, ivs[0] = 0; i < len; i++ ) ivs[i] = v[i]-v[i-1];
6961: } else {
6962: r->width = 4;
6963: ivi = (unsigned int *)MALLOC_ATOMIC(len*sizeof(unsigned int));
6964: r->index.i = ivi;
6965: for ( i = 1, ivi[0] = 0; i < len; i++ ) ivi[i] = v[i]-v[i-1];
6966: }
6967: return r;
6968: }
6969:
6970: int compress_array(Z *svect,Z *cvect,int n)
6971: {
6972: int i,j;
6973:
6974: for ( i = j = 0; i < n; i++ )
6975: if ( svect[i] ) cvect[j++] = svect[i];
6976: return j;
6977: }
6978:
6979: void expand_array(Z *svect,Z *cvect,int n)
6980: {
6981: int i,j;
6982:
6983: for ( i = j = 0; j < n; i++ )
6984: if ( svect[i] ) svect[i] = cvect[j++];
6985: }
6986:
1.8 noro 6987: #if 0
1.1 noro 6988: int ndv_reduce_vect_q(Z *svect,int trace,int col,IndArray *imat,NM_ind_pair *rp0,int nred)
6989: {
6990: int i,j,k,len,pos,prev,nz;
6991: Z cs,mcs,c1,c2,cr,gcd,t;
6992: IndArray ivect;
6993: unsigned char *ivc;
6994: unsigned short *ivs;
6995: unsigned int *ivi;
6996: NDV redv;
6997: NMV mr;
6998: NODE rp;
6999: int maxrs;
7000: double hmag;
7001: Z *cvect;
1.3 noro 7002: int l;
1.1 noro 7003:
7004: maxrs = 0;
7005: for ( i = 0; i < col && !svect[i]; i++ );
7006: if ( i == col ) return maxrs;
7007: hmag = p_mag((P)svect[i])*nd_scale;
7008: cvect = (Z *)MALLOC(col*sizeof(Q));
7009: for ( i = 0; i < nred; i++ ) {
7010: ivect = imat[i];
7011: k = ivect->head;
7012: if ( svect[k] ) {
7013: maxrs = MAX(maxrs,rp0[i]->sugar);
7014: redv = nd_demand?ndv_load(rp0[i]->index)
7015: :(trace?nd_ps_trace[rp0[i]->index]:nd_ps[rp0[i]->index]);
7016: len = LEN(redv); mr = BDY(redv);
1.6 noro 7017: igcd_cofactor(svect[k],CZ(mr),&gcd,&cs,&cr);
1.1 noro 7018: chsgnz(cs,&mcs);
7019: if ( !UNIQ(cr) ) {
7020: for ( j = 0; j < col; j++ ) {
7021: mulz(svect[j],cr,&c1); svect[j] = c1;
7022: }
7023: }
7024: svect[k] = 0; prev = k;
7025: switch ( ivect->width ) {
7026: case 1:
7027: ivc = ivect->index.c;
7028: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
7029: pos = prev+ivc[j]; prev = pos;
1.6 noro 7030: muladdtoz(CZ(mr),mcs,&svect[pos]);
1.1 noro 7031: }
7032: break;
7033: case 2:
7034: ivs = ivect->index.s;
7035: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
7036: pos = prev+ivs[j]; prev = pos;
1.6 noro 7037: muladdtoz(CZ(mr),mcs,&svect[pos]);
1.1 noro 7038: }
7039: break;
7040: case 4:
7041: ivi = ivect->index.i;
7042: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
7043: pos = prev+ivi[j]; prev = pos;
1.6 noro 7044: muladdtoz(CZ(mr),mcs,&svect[pos]);
1.1 noro 7045: }
7046: break;
7047: }
7048: for ( j = k+1; j < col && !svect[j]; j++ );
7049: if ( j == col ) break;
7050: if ( hmag && ((double)p_mag((P)svect[j]) > hmag) ) {
7051: nz = compress_array(svect,cvect,col);
7052: removecont_array((P *)cvect,nz,1);
7053: expand_array(svect,cvect,nz);
7054: hmag = ((double)p_mag((P)svect[j]))*nd_scale;
7055: }
7056: }
7057: }
7058: nz = compress_array(svect,cvect,col);
7059: removecont_array((P *)cvect,nz,1);
7060: expand_array(svect,cvect,nz);
7061: if ( DP_Print ) {
7062: fprintf(asir_out,"-"); fflush(asir_out);
7063: }
7064: return maxrs;
7065: }
1.4 noro 7066: #else
1.9 noro 7067:
1.4 noro 7068: /* direct mpz version */
7069: int ndv_reduce_vect_q(Z *svect0,int trace,int col,IndArray *imat,NM_ind_pair *rp0,int nred)
7070: {
7071: int i,j,k,len,pos,prev;
7072: mpz_t cs,cr,gcd;
7073: IndArray ivect;
7074: unsigned char *ivc;
7075: unsigned short *ivs;
7076: unsigned int *ivi;
7077: NDV redv;
7078: NMV mr;
7079: NODE rp;
7080: int maxrs;
7081: double hmag;
7082: int l;
1.13 noro 7083: static mpz_t *svect;
7084: static int svect_len=0;
1.4 noro 7085:
7086: maxrs = 0;
7087: for ( i = 0; i < col && !svect0[i]; i++ );
7088: if ( i == col ) return maxrs;
7089: hmag = p_mag((P)svect0[i])*nd_scale;
1.13 noro 7090: if ( col > svect_len ) {
7091: svect = (mpz_t *)MALLOC(col*sizeof(mpz_t));
7092: svect_len = col;
7093: }
1.4 noro 7094: for ( i = 0; i < col; i++ ) {
7095: mpz_init(svect[i]);
7096: if ( svect0[i] )
7097: mpz_set(svect[i],BDY(svect0[i]));
7098: else
7099: mpz_set_ui(svect[i],0);
7100: }
7101: mpz_init(gcd); mpz_init(cs); mpz_init(cr);
7102: for ( i = 0; i < nred; i++ ) {
7103: ivect = imat[i];
7104: k = ivect->head;
7105: if ( mpz_sgn(svect[k]) ) {
7106: maxrs = MAX(maxrs,rp0[i]->sugar);
7107: redv = nd_demand?ndv_load(rp0[i]->index)
7108: :(trace?nd_ps_trace[rp0[i]->index]:nd_ps[rp0[i]->index]);
7109: len = LEN(redv); mr = BDY(redv);
1.6 noro 7110: mpz_gcd(gcd,svect[k],BDY(CZ(mr)));
1.4 noro 7111: mpz_div(cs,svect[k],gcd);
1.6 noro 7112: mpz_div(cr,BDY(CZ(mr)),gcd);
1.4 noro 7113: mpz_neg(cs,cs);
1.9 noro 7114: if ( MUNIMPZ(cr) )
7115: for ( j = 0; j < col; j++ ) mpz_neg(svect[j],svect[j]);
7116: else if ( !UNIMPZ(cr) )
7117: for ( j = 0; j < col; j++ ) {
7118: if ( mpz_sgn(svect[j]) ) mpz_mul(svect[j],svect[j],cr);
7119: }
1.4 noro 7120: mpz_set_ui(svect[k],0);
7121: prev = k;
7122: switch ( ivect->width ) {
7123: case 1:
7124: ivc = ivect->index.c;
7125: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
7126: pos = prev+ivc[j]; prev = pos;
1.6 noro 7127: mpz_addmul(svect[pos],BDY(CZ(mr)),cs);
1.4 noro 7128: }
7129: break;
7130: case 2:
7131: ivs = ivect->index.s;
7132: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
7133: pos = prev+ivs[j]; prev = pos;
1.6 noro 7134: mpz_addmul(svect[pos],BDY(CZ(mr)),cs);
1.4 noro 7135: }
7136: break;
7137: case 4:
7138: ivi = ivect->index.i;
7139: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
7140: pos = prev+ivi[j]; prev = pos;
1.6 noro 7141: mpz_addmul(svect[pos],BDY(CZ(mr)),cs);
1.4 noro 7142: }
7143: break;
7144: }
7145: for ( j = k+1; j < col && !svect[j]; j++ );
7146: if ( j == col ) break;
7147: if ( hmag && ((double)mpz_sizeinbase(svect[j],2) > hmag) ) {
7148: mpz_removecont_array(svect,col);
7149: hmag = ((double)mpz_sizeinbase(svect[j],2))*nd_scale;
7150: }
7151: }
7152: }
7153: mpz_removecont_array(svect,col);
7154: if ( DP_Print ) {
7155: fprintf(asir_out,"-"); fflush(asir_out);
7156: }
7157: for ( i = 0; i < col; i++ )
7158: if ( mpz_sgn(svect[i]) ) MPZTOZ(svect[i],svect0[i]);
7159: else svect0[i] = 0;
7160: return maxrs;
7161: }
7162: #endif
1.1 noro 7163:
7164: int ndv_reduce_vect(int m,UINT *svect,int col,IndArray *imat,NM_ind_pair *rp0,int nred)
7165: {
7166: int i,j,k,len,pos,prev;
7167: UINT c,c1,c2,c3,up,lo,dmy;
7168: IndArray ivect;
7169: unsigned char *ivc;
7170: unsigned short *ivs;
7171: unsigned int *ivi;
7172: NDV redv;
7173: NMV mr;
7174: NODE rp;
7175: int maxrs;
7176:
7177: maxrs = 0;
7178: for ( i = 0; i < nred; i++ ) {
7179: ivect = imat[i];
7180: k = ivect->head; svect[k] %= m;
7181: if ( (c = svect[k]) != 0 ) {
7182: maxrs = MAX(maxrs,rp0[i]->sugar);
7183: c = m-c; redv = nd_ps[rp0[i]->index];
7184: len = LEN(redv); mr = BDY(redv);
7185: svect[k] = 0; prev = k;
7186: switch ( ivect->width ) {
7187: case 1:
7188: ivc = ivect->index.c;
7189: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
7190: pos = prev+ivc[j]; c1 = CM(mr); prev = pos;
7191: if ( c1 ) {
7192: c2 = svect[pos];
7193: DMA(c1,c,c2,up,lo);
7194: if ( up ) { DSAB(m,up,lo,dmy,c3); svect[pos] = c3;
7195: } else svect[pos] = lo;
7196: }
7197: }
7198: break;
7199: case 2:
7200: ivs = ivect->index.s;
7201: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
7202: pos = prev+ivs[j]; c1 = CM(mr);
7203: prev = pos;
7204: if ( c1 ) {
7205: c2 = svect[pos];
7206: DMA(c1,c,c2,up,lo);
7207: if ( up ) { DSAB(m,up,lo,dmy,c3); svect[pos] = c3;
7208: } else svect[pos] = lo;
7209: }
7210: }
7211: break;
7212: case 4:
7213: ivi = ivect->index.i;
7214: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
7215: pos = prev+ivi[j]; c1 = CM(mr);
7216: prev = pos;
7217: if ( c1 ) {
7218: c2 = svect[pos];
7219: DMA(c1,c,c2,up,lo);
7220: if ( up ) { DSAB(m,up,lo,dmy,c3); svect[pos] = c3;
7221: } else svect[pos] = lo;
7222: }
7223: }
7224: break;
7225: }
7226: }
7227: }
7228: for ( i = 0; i < col; i++ )
7229: if ( svect[i] >= (UINT)m ) svect[i] %= m;
7230: return maxrs;
7231: }
7232:
7233: int ndv_reduce_vect_sf(int m,UINT *svect,int col,IndArray *imat,NM_ind_pair *rp0,int nred)
7234: {
7235: int i,j,k,len,pos,prev;
7236: UINT c,c1,c2,c3,up,lo,dmy;
7237: IndArray ivect;
7238: unsigned char *ivc;
7239: unsigned short *ivs;
7240: unsigned int *ivi;
7241: NDV redv;
7242: NMV mr;
7243: NODE rp;
7244: int maxrs;
7245:
7246: maxrs = 0;
7247: for ( i = 0; i < nred; i++ ) {
7248: ivect = imat[i];
7249: k = ivect->head;
7250: if ( (c = svect[k]) != 0 ) {
7251: maxrs = MAX(maxrs,rp0[i]->sugar);
7252: c = _chsgnsf(c); redv = nd_ps[rp0[i]->index];
7253: len = LEN(redv); mr = BDY(redv);
7254: svect[k] = 0; prev = k;
7255: switch ( ivect->width ) {
7256: case 1:
7257: ivc = ivect->index.c;
7258: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
7259: pos = prev+ivc[j]; prev = pos;
7260: svect[pos] = _addsf(_mulsf(CM(mr),c),svect[pos]);
7261: }
7262: break;
7263: case 2:
7264: ivs = ivect->index.s;
7265: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
7266: pos = prev+ivs[j]; prev = pos;
7267: svect[pos] = _addsf(_mulsf(CM(mr),c),svect[pos]);
7268: }
7269: break;
7270: case 4:
7271: ivi = ivect->index.i;
7272: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
7273: pos = prev+ivi[j]; prev = pos;
7274: svect[pos] = _addsf(_mulsf(CM(mr),c),svect[pos]);
7275: }
7276: break;
7277: }
7278: }
7279: }
7280: return maxrs;
7281: }
7282:
7283: ND nd_add_lf(ND p1,ND p2)
7284: {
7285: int n,c,can;
7286: ND r;
7287: NM m1,m2,mr0,mr,s;
7288: Z t;
7289:
7290: if ( !p1 ) return p2;
7291: else if ( !p2 ) return p1;
7292: else {
7293: can = 0;
7294: for ( n = NV(p1), m1 = BDY(p1), m2 = BDY(p2), mr0 = 0; m1 && m2; ) {
7295: c = DL_COMPARE(DL(m1),DL(m2));
7296: switch ( c ) {
7297: case 0:
7298: addlf(CZ(m1),CZ(m2),&t);
7299: s = m1; m1 = NEXT(m1);
7300: if ( t ) {
7301: can++; NEXTNM2(mr0,mr,s); CZ(mr) = (t);
7302: } else {
7303: can += 2; FREENM(s);
7304: }
7305: s = m2; m2 = NEXT(m2); FREENM(s);
7306: break;
7307: case 1:
7308: s = m1; m1 = NEXT(m1); NEXTNM2(mr0,mr,s);
7309: break;
7310: case -1:
7311: s = m2; m2 = NEXT(m2); NEXTNM2(mr0,mr,s);
7312: break;
7313: }
7314: }
7315: if ( !mr0 )
7316: if ( m1 ) mr0 = m1;
7317: else if ( m2 ) mr0 = m2;
7318: else return 0;
7319: else if ( m1 ) NEXT(mr) = m1;
7320: else if ( m2 ) NEXT(mr) = m2;
7321: else NEXT(mr) = 0;
7322: BDY(p1) = mr0;
7323: SG(p1) = MAX(SG(p1),SG(p2));
7324: LEN(p1) = LEN(p1)+LEN(p2)-can;
7325: FREEND(p2);
7326: return p1;
7327: }
7328: }
7329:
7330: int ndv_reduce_vect_lf(mpz_t *svect,int trace,int col,IndArray *imat,NM_ind_pair *rp0,int nred)
7331: {
7332: int i,j,k,len,pos,prev;
7333: mpz_t c,mc,c1;
7334: IndArray ivect;
7335: unsigned char *ivc;
7336: unsigned short *ivs;
7337: unsigned int *ivi;
7338: NDV redv;
7339: NMV mr;
7340: NODE rp;
7341: int maxrs;
7342:
7343: maxrs = 0;
7344: lf_lazy = 1;
7345: for ( i = 0; i < nred; i++ ) {
7346: ivect = imat[i];
7347: k = ivect->head;
7348: mpz_mod(svect[k],svect[k],BDY(current_mod_lf));
7349: if ( mpz_sgn(svect[k]) ) {
7350: maxrs = MAX(maxrs,rp0[i]->sugar);
7351: mpz_neg(svect[k],svect[k]);
7352: redv = trace?nd_ps_trace[rp0[i]->index]:nd_ps[rp0[i]->index];
7353: len = LEN(redv); mr = BDY(redv);
7354: prev = k;
7355: switch ( ivect->width ) {
7356: case 1:
7357: ivc = ivect->index.c;
7358: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
7359: pos = prev+ivc[j]; prev = pos;
7360: mpz_addmul(svect[pos],svect[k],BDY(CZ(mr)));
7361: }
7362: break;
7363: case 2:
7364: ivs = ivect->index.s;
7365: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
7366: pos = prev+ivs[j]; prev = pos;
7367: mpz_addmul(svect[pos],svect[k],BDY(CZ(mr)));
7368: }
7369: break;
7370: case 4:
7371: ivi = ivect->index.i;
7372: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
7373: pos = prev+ivi[j]; prev = pos;
7374: mpz_addmul(svect[pos],svect[k],BDY(CZ(mr)));
7375: }
7376: break;
7377: }
7378: mpz_set_ui(svect[k],0);
7379: }
7380: }
7381: lf_lazy=0;
7382: for ( i = 0; i < col; i++ ) {
7383: mpz_mod(svect[i],svect[i],BDY(current_mod_lf));
7384: }
7385: return maxrs;
7386: }
7387:
7388: int nd_gauss_elim_lf(mpz_t **mat0,int *sugar,int row,int col,int *colstat)
7389: {
7390: int i,j,k,l,rank,s;
7391: mpz_t a,a1,inv;
7392: mpz_t *t,*pivot,*pk;
7393: mpz_t **mat;
7394: struct oEGT eg0,eg1,eg_forward,eg_mod,eg_back;
7395: int size,size1;
7396:
7397: mpz_init(inv);
7398: mpz_init(a);
7399: mat = (mpz_t **)mat0;
7400: size = 0;
7401: for ( rank = 0, j = 0; j < col; j++ ) {
7402: for ( i = rank; i < row; i++ ) {
7403: mpz_mod(mat[i][j],mat[i][j],BDY(current_mod_lf));
7404: }
7405: for ( i = rank; i < row; i++ )
7406: if ( mpz_sgn(mat[i][j]) )
7407: break;
7408: if ( i == row ) {
7409: colstat[j] = 0;
7410: continue;
7411: } else
7412: colstat[j] = 1;
7413: if ( i != rank ) {
7414: t = mat[i]; mat[i] = mat[rank]; mat[rank] = t;
7415: s = sugar[i]; sugar[i] = sugar[rank]; sugar[rank] = s;
7416: }
7417: pivot = mat[rank];
7418: s = sugar[rank];
7419: mpz_invert(inv,pivot[j],BDY(current_mod_lf));
7420: for ( k = j, pk = pivot+k; k < col; k++, pk++ )
7421: if ( mpz_sgn(*pk) ) {
7422: mpz_mul(a,*pk,inv); mpz_mod(*pk,a,BDY(current_mod_lf));
7423: }
7424: for ( i = rank+1; i < row; i++ ) {
7425: t = mat[i];
7426: if ( mpz_sgn(t[j]) ) {
7427: sugar[i] = MAX(sugar[i],s);
7428: mpz_neg(a,t[j]);
7429: red_by_vect_lf(t+j,pivot+j,a,col-j);
7430: }
7431: }
7432: rank++;
7433: }
7434: for ( j = col-1, l = rank-1; j >= 0; j-- )
7435: if ( colstat[j] ) {
7436: pivot = mat[l];
7437: s = sugar[l];
7438: for ( k = j; k < col; k++ )
7439: mpz_mod(pivot[k],pivot[k],BDY(current_mod_lf));
7440: for ( i = 0; i < l; i++ ) {
7441: t = mat[i];
7442: if ( mpz_sgn(t[j]) ) {
7443: sugar[i] = MAX(sugar[i],s);
7444: mpz_neg(a,t[j]);
7445: red_by_vect_lf(t+j,pivot+j,a,col-j);
7446: }
7447: }
7448: l--;
7449: }
7450: for ( j = 0, l = 0; l < rank; j++ )
7451: if ( colstat[j] ) {
7452: t = mat[l];
7453: for ( k = j; k < col; k++ ) {
7454: mpz_mod(t[k],t[k],BDY(current_mod_lf));
7455: }
7456: l++;
7457: }
7458: return rank;
7459: }
7460:
7461:
7462: NDV vect_to_ndv(UINT *vect,int spcol,int col,int *rhead,UINT *s0vect)
7463: {
7464: int j,k,len;
7465: UINT *p;
7466: UINT c;
7467: NDV r;
7468: NMV mr0,mr;
7469:
7470: for ( j = 0, len = 0; j < spcol; j++ ) if ( vect[j] ) len++;
7471: if ( !len ) return 0;
7472: else {
7473: mr0 = (NMV)MALLOC_ATOMIC_IGNORE_OFF_PAGE(nmv_adv*len);
7474: #if 0
7475: ndv_alloc += nmv_adv*len;
7476: #endif
7477: mr = mr0;
7478: p = s0vect;
7479: for ( j = k = 0; j < col; j++, p += nd_wpd )
7480: if ( !rhead[j] ) {
7481: if ( (c = vect[k++]) != 0 ) {
7482: ndl_copy(p,DL(mr)); CM(mr) = c; NMV_ADV(mr);
7483: }
7484: }
7485: MKNDV(nd_nvar,mr0,len,r);
7486: return r;
7487: }
7488: }
7489:
7490: NDV vect_to_ndv_2(unsigned long *vect,int col,UINT *s0vect)
7491: {
7492: int j,k,len;
7493: UINT *p;
7494: NDV r;
7495: NMV mr0,mr;
7496:
7497: for ( j = 0, len = 0; j < col; j++ ) if ( vect[j/BLEN] & (1L<<(j%BLEN)) ) len++;
7498: if ( !len ) return 0;
7499: else {
7500: mr0 = (NMV)MALLOC_ATOMIC_IGNORE_OFF_PAGE(nmv_adv*len);
7501: mr = mr0;
7502: p = s0vect;
7503: for ( j = 0; j < col; j++, p += nd_wpd )
7504: if ( vect[j/BLEN] & (1L<<(j%BLEN)) ) {
7505: ndl_copy(p,DL(mr)); CM(mr) = 1; NMV_ADV(mr);
7506: }
7507: MKNDV(nd_nvar,mr0,len,r);
7508: return r;
7509: }
7510: }
7511:
7512: /* for preprocessed vector */
7513:
7514: NDV vect_to_ndv_q(Z *vect,int spcol,int col,int *rhead,UINT *s0vect)
7515: {
1.6 noro 7516: int j,k,len;
7517: UINT *p;
7518: Z c;
7519: NDV r;
7520: NMV mr0,mr;
1.1 noro 7521:
1.6 noro 7522: for ( j = 0, len = 0; j < spcol; j++ ) if ( vect[j] ) len++;
7523: if ( !len ) return 0;
7524: else {
7525: mr0 = (NMV)MALLOC(nmv_adv*len);
1.1 noro 7526: #if 0
1.6 noro 7527: ndv_alloc += nmv_adv*len;
1.1 noro 7528: #endif
1.6 noro 7529: mr = mr0;
7530: p = s0vect;
7531: for ( j = k = 0; j < col; j++, p += nd_wpd ) {
7532: if ( !rhead[j] ) {
7533: if ( (c = vect[k++]) != 0 ) {
7534: if ( !INT(c) )
7535: error("vect_to_ndv_q : components must be integers");
7536: ndl_copy(p,DL(mr)); CZ(mr) = c; NMV_ADV(mr);
7537: }
7538: }
1.1 noro 7539: }
1.6 noro 7540: MKNDV(nd_nvar,mr0,len,r);
7541: return r;
7542: }
1.1 noro 7543: }
7544:
7545: NDV vect_to_ndv_lf(mpz_t *vect,int spcol,int col,int *rhead,UINT *s0vect)
7546: {
7547: int j,k,len;
7548: UINT *p;
7549: mpz_t c;
7550: NDV r;
7551: NMV mr0,mr;
7552:
7553: for ( j = 0, len = 0; j < spcol; j++ ) if ( mpz_sgn(vect[j]) ) len++;
7554: if ( !len ) return 0;
7555: else {
7556: mr0 = (NMV)MALLOC(nmv_adv*len);
7557: #if 0
7558: ndv_alloc += nmv_adv*len;
7559: #endif
7560: mr = mr0;
7561: p = s0vect;
7562: for ( j = k = 0; j < col; j++, p += nd_wpd )
7563: if ( !rhead[j] ) {
7564: c[0] = vect[k++][0];
7565: if ( mpz_sgn(c) ) {
7566: ndl_copy(p,DL(mr)); MPZTOZ(c,CZ(mr)); NMV_ADV(mr);
7567: }
7568: }
7569: MKNDV(nd_nvar,mr0,len,r);
7570: return r;
7571: }
7572: }
7573:
7574: /* for plain vector */
7575:
7576: NDV plain_vect_to_ndv_q(Z *vect,int col,UINT *s0vect)
7577: {
7578: int j,k,len;
7579: UINT *p;
7580: Z c;
7581: NDV r;
7582: NMV mr0,mr;
7583:
7584: for ( j = 0, len = 0; j < col; j++ ) if ( vect[j] ) len++;
7585: if ( !len ) return 0;
7586: else {
7587: mr0 = (NMV)MALLOC(nmv_adv*len);
7588: #if 0
7589: ndv_alloc += nmv_adv*len;
7590: #endif
7591: mr = mr0;
7592: p = s0vect;
7593: for ( j = k = 0; j < col; j++, p += nd_wpd, k++ )
7594: if ( (c = vect[k]) != 0 ) {
7595: if ( !INT(c) )
1.6 noro 7596: error("plain_vect_to_ndv_q : components must be integers");
7597: ndl_copy(p,DL(mr)); CZ(mr) = c; NMV_ADV(mr);
1.1 noro 7598: }
7599: MKNDV(nd_nvar,mr0,len,r);
7600: return r;
7601: }
7602: }
7603:
7604: int nd_sp_f4(int m,int trace,ND_pairs l,PGeoBucket bucket)
7605: {
7606: ND_pairs t;
7607: NODE sp0,sp;
7608: int stat;
7609: ND spol;
7610:
7611: for ( t = l; t; t = NEXT(t) ) {
7612: stat = nd_sp(m,trace,t,&spol);
7613: if ( !stat ) return 0;
7614: if ( spol ) {
7615: add_pbucket_symbolic(bucket,spol);
7616: }
7617: }
7618: return 1;
7619: }
7620:
7621: int nd_symbolic_preproc(PGeoBucket bucket,int trace,UINT **s0vect,NODE *r)
7622: {
7623: NODE rp0,rp;
7624: NM mul,head,s0,s;
7625: int index,col,i,sugar;
7626: RHist h;
7627: UINT *s0v,*p;
7628: NM_ind_pair pair;
7629: ND red;
7630: NDV *ps;
7631:
7632: s0 = 0; rp0 = 0; col = 0;
7633: if ( nd_demand )
7634: ps = trace?nd_ps_trace_sym:nd_ps_sym;
7635: else
7636: ps = trace?nd_ps_trace:nd_ps;
7637: while ( 1 ) {
7638: head = remove_head_pbucket_symbolic(bucket);
7639: if ( !head ) break;
7640: if ( !s0 ) s0 = head;
7641: else NEXT(s) = head;
7642: s = head;
7643: index = ndl_find_reducer(DL(head));
7644: if ( index >= 0 ) {
7645: h = nd_psh[index];
7646: NEWNM(mul);
7647: ndl_sub(DL(head),DL(h),DL(mul));
7648: if ( ndl_check_bound2(index,DL(mul)) )
7649: return 0;
7650: sugar = TD(DL(mul))+SG(ps[index]);
7651: MKNM_ind_pair(pair,mul,index,sugar);
7652: red = ndv_mul_nm_symbolic(mul,ps[index]);
7653: add_pbucket_symbolic(bucket,nd_remove_head(red));
7654: NEXTNODE(rp0,rp); BDY(rp) = (pointer)pair;
7655: }
7656: col++;
7657: }
7658: if ( rp0 ) NEXT(rp) = 0;
7659: NEXT(s) = 0;
7660: s0v = (UINT *)MALLOC_ATOMIC(col*nd_wpd*sizeof(UINT));
7661: for ( i = 0, p = s0v, s = s0; i < col;
7662: i++, p += nd_wpd, s = NEXT(s) ) ndl_copy(DL(s),p);
7663: *s0vect = s0v;
7664: *r = rp0;
7665: return col;
7666: }
7667:
7668: void print_ndp(ND_pairs l)
7669: {
7670: ND_pairs t;
7671:
7672: for ( t = l; t; t = NEXT(t) )
7673: printf("[%d,%d] ",t->i1,t->i2);
7674: printf("\n");
7675: }
7676:
7677: NODE nd_f4(int m,int checkonly,int **indp)
7678: {
7679: int i,nh,stat,index,f4red;
7680: NODE r,g,tn0,tn,node;
7681: ND_pairs d,l,t,ll0,ll,lh;
7682: LIST l0,l1;
7683: ND spol,red;
7684: NDV nf,redv;
7685: NM s0,s;
7686: NODE rp0,srp0,nflist,nzlist,nzlist_t;
7687: int nsp,nred,col,rank,len,k,j,a,i1s,i2s;
7688: UINT c;
7689: UINT **spmat;
7690: UINT *s0vect,*svect,*p,*v;
7691: int *colstat;
7692: IndArray *imat;
7693: int *rhead;
7694: int spcol,sprow;
7695: int sugar,sugarh;
7696: PGeoBucket bucket;
7697: struct oEGT eg0,eg1,eg_f4;
7698: Z i1,i2,sugarq;
1.12 noro 7699:
7700: init_eg(&f4_symb); init_eg(&f4_conv); init_eg(&f4_conv); init_eg(&f4_elim1); init_eg(&f4_elim2);
1.1 noro 7701: #if 0
7702: ndv_alloc = 0;
7703: #endif
1.11 noro 7704: Nf4_red=0;
1.1 noro 7705: g = 0; d = 0;
7706: for ( i = 0; i < nd_psn; i++ ) {
7707: d = update_pairs(d,g,i,0);
7708: g = update_base(g,i);
7709: }
7710: nzlist = 0;
7711: nzlist_t = nd_nzlist;
7712: f4red = 1;
7713: nd_last_nonzero = 0;
7714: while ( d ) {
7715: get_eg(&eg0);
7716: l = nd_minsugarp(d,&d);
7717: sugar = nd_sugarweight?l->sugar2:SG(l);
7718: if ( MaxDeg > 0 && sugar > MaxDeg ) break;
7719: if ( nzlist_t ) {
7720: node = BDY((LIST)BDY(nzlist_t));
1.6 noro 7721: sugarh = ZTOS((Q)ARG0(node));
1.1 noro 7722: tn = BDY((LIST)ARG1(node));
7723: if ( !tn ) {
7724: nzlist_t = NEXT(nzlist_t);
7725: continue;
7726: }
7727: /* tn = [[i1,i2],...] */
7728: lh = nd_ipairtospair(tn);
7729: }
7730: bucket = create_pbucket();
7731: stat = nd_sp_f4(m,0,l,bucket);
7732: if ( !stat ) {
7733: for ( t = l; NEXT(t); t = NEXT(t) );
7734: NEXT(t) = d; d = l;
7735: d = nd_reconstruct(0,d);
7736: continue;
7737: }
7738: if ( bucket->m < 0 ) continue;
7739: col = nd_symbolic_preproc(bucket,0,&s0vect,&rp0);
7740: if ( !col ) {
7741: for ( t = l; NEXT(t); t = NEXT(t) );
7742: NEXT(t) = d; d = l;
7743: d = nd_reconstruct(0,d);
7744: continue;
7745: }
1.12 noro 7746: get_eg(&eg1); init_eg(&eg_f4); add_eg(&eg_f4,&eg0,&eg1); add_eg(&f4_symb,&eg0,&eg1);
1.1 noro 7747: if ( DP_Print )
1.6 noro 7748: fprintf(asir_out,"sugar=%d,symb=%.3fsec,",
1.5 noro 7749: sugar,eg_f4.exectime);
1.1 noro 7750: nflist = nd_f4_red(m,nd_nzlist?lh:l,0,s0vect,col,rp0,nd_gentrace?&ll:0);
7751: if ( checkonly && nflist ) return 0;
7752: /* adding new bases */
7753: if ( nflist ) nd_last_nonzero = f4red;
7754: for ( r = nflist; r; r = NEXT(r) ) {
7755: nf = (NDV)BDY(r);
7756: ndv_removecont(m,nf);
7757: if ( !m && nd_nalg ) {
7758: ND nf1;
7759:
7760: nf1 = ndvtond(m,nf);
7761: nd_monic(0,&nf1);
7762: nd_removecont(m,nf1);
7763: nf = ndtondv(m,nf1);
7764: }
1.24 ! noro 7765: nh = ndv_newps(m,nf,0);
1.1 noro 7766: d = update_pairs(d,g,nh,0);
7767: g = update_base(g,nh);
7768: }
7769: if ( DP_Print ) {
7770: fprintf(asir_out,"f4red=%d,gblen=%d\n",f4red,length(g)); fflush(asir_out);
7771: }
7772: if ( nd_gentrace ) {
7773: for ( t = ll, tn0 = 0; t; t = NEXT(t) ) {
7774: NEXTNODE(tn0,tn);
1.6 noro 7775: STOZ(t->i1,i1); STOZ(t->i2,i2);
1.1 noro 7776: node = mknode(2,i1,i2); MKLIST(l0,node);
7777: BDY(tn) = l0;
7778: }
7779: if ( tn0 ) NEXT(tn) = 0; MKLIST(l0,tn0);
1.6 noro 7780: STOZ(sugar,sugarq); node = mknode(2,sugarq,l0); MKLIST(l1,node);
1.1 noro 7781: MKNODE(node,l1,nzlist); nzlist = node;
7782: }
7783: if ( nd_nzlist ) nzlist_t = NEXT(nzlist_t);
7784: f4red++;
7785: if ( nd_f4red && f4red > nd_f4red ) break;
7786: if ( nd_rank0 && !nflist ) break;
7787: }
7788: if ( nd_gentrace ) {
7789: MKLIST(l0,reverse_node(nzlist));
7790: MKNODE(nd_alltracelist,l0,0);
7791: }
7792: #if 0
7793: fprintf(asir_out,"ndv_alloc=%d\n",ndv_alloc);
7794: #endif
1.12 noro 7795: if ( DP_Print ) {
7796: fprintf(asir_out,"number of red=%d,",Nf4_red);
7797: fprintf(asir_out,"symb=%.3fsec,conv=%.3fsec,elim1=%.3fsec,elim2=%.3fsec\n",
7798: f4_symb.exectime,f4_conv.exectime,f4_elim1.exectime,f4_elim2.exectime);
7799: }
1.1 noro 7800: conv_ilist(nd_demand,0,g,indp);
7801: return g;
7802: }
7803:
7804: NODE nd_f4_trace(int m,int **indp)
7805: {
7806: int i,nh,stat,index;
7807: NODE r,g;
7808: ND_pairs d,l,l0,t;
7809: ND spol,red;
7810: NDV nf,redv,nfqv,nfv;
7811: NM s0,s;
7812: NODE rp0,srp0,nflist;
7813: int nsp,nred,col,rank,len,k,j,a;
7814: UINT c;
7815: UINT **spmat;
7816: UINT *s0vect,*svect,*p,*v;
7817: int *colstat;
7818: IndArray *imat;
7819: int *rhead;
7820: int spcol,sprow;
7821: int sugar;
7822: PGeoBucket bucket;
7823: struct oEGT eg0,eg1,eg_f4;
7824:
7825: g = 0; d = 0;
7826: for ( i = 0; i < nd_psn; i++ ) {
7827: d = update_pairs(d,g,i,0);
7828: g = update_base(g,i);
7829: }
7830: while ( d ) {
7831: get_eg(&eg0);
7832: l = nd_minsugarp(d,&d);
7833: sugar = SG(l);
7834: if ( MaxDeg > 0 && sugar > MaxDeg ) break;
7835: bucket = create_pbucket();
7836: stat = nd_sp_f4(m,0,l,bucket);
7837: if ( !stat ) {
7838: for ( t = l; NEXT(t); t = NEXT(t) );
7839: NEXT(t) = d; d = l;
7840: d = nd_reconstruct(1,d);
7841: continue;
7842: }
7843: if ( bucket->m < 0 ) continue;
7844: col = nd_symbolic_preproc(bucket,0,&s0vect,&rp0);
7845: if ( !col ) {
7846: for ( t = l; NEXT(t); t = NEXT(t) );
7847: NEXT(t) = d; d = l;
7848: d = nd_reconstruct(1,d);
7849: continue;
7850: }
7851: get_eg(&eg1); init_eg(&eg_f4); add_eg(&eg_f4,&eg0,&eg1);
7852: if ( DP_Print )
1.3 noro 7853: fprintf(asir_out,"\nsugar=%d,symb=%.3fsec,",
1.5 noro 7854: sugar,eg_f4.exectime);
1.1 noro 7855: nflist = nd_f4_red(m,l,0,s0vect,col,rp0,&l0);
7856: if ( !l0 ) continue;
7857: l = l0;
7858:
7859: /* over Q */
7860: bucket = create_pbucket();
7861: stat = nd_sp_f4(0,1,l,bucket);
7862: if ( !stat ) {
7863: for ( t = l; NEXT(t); t = NEXT(t) );
7864: NEXT(t) = d; d = l;
7865: d = nd_reconstruct(1,d);
7866: continue;
7867: }
7868: if ( bucket->m < 0 ) continue;
7869: col = nd_symbolic_preproc(bucket,1,&s0vect,&rp0);
7870: if ( !col ) {
7871: for ( t = l; NEXT(t); t = NEXT(t) );
7872: NEXT(t) = d; d = l;
7873: d = nd_reconstruct(1,d);
7874: continue;
7875: }
7876: nflist = nd_f4_red(0,l,1,s0vect,col,rp0,0);
7877: /* adding new bases */
7878: for ( r = nflist; r; r = NEXT(r) ) {
7879: nfqv = (NDV)BDY(r);
7880: ndv_removecont(0,nfqv);
1.6 noro 7881: if ( !remqi((Q)HCZ(nfqv),m) ) return 0;
1.1 noro 7882: if ( nd_nalg ) {
7883: ND nf1;
7884:
7885: nf1 = ndvtond(m,nfqv);
7886: nd_monic(0,&nf1);
7887: nd_removecont(0,nf1);
7888: nfqv = ndtondv(0,nf1); nd_free(nf1);
7889: }
7890: nfv = ndv_dup(0,nfqv);
7891: ndv_mod(m,nfv);
7892: ndv_removecont(m,nfv);
1.24 ! noro 7893: nh = ndv_newps(0,nfv,nfqv);
1.1 noro 7894: d = update_pairs(d,g,nh,0);
7895: g = update_base(g,nh);
7896: }
7897: }
7898: #if 0
7899: fprintf(asir_out,"ndv_alloc=%d\n",ndv_alloc);
7900: #endif
7901: conv_ilist(nd_demand,1,g,indp);
7902: return g;
7903: }
7904:
7905: int rref(matrix mat,int *sugar)
7906: {
7907: int row,col,i,j,k,l,s,wcol,wj;
7908: unsigned long bj;
7909: unsigned long **a;
7910: unsigned long *ai,*ak,*as,*t;
7911: int *pivot;
7912:
7913: row = mat->row;
7914: col = mat->col;
7915: a = mat->a;
7916: wcol = (col+BLEN-1)/BLEN;
7917: pivot = (int *)MALLOC_ATOMIC(row*sizeof(int));
7918: i = 0;
7919: for ( j = 0; j < col; j++ ) {
7920: wj = j/BLEN; bj = 1L<<(j%BLEN);
7921: for ( k = i; k < row; k++ )
7922: if ( a[k][wj] & bj ) break;
7923: if ( k == row ) continue;
7924: pivot[i] = j;
7925: if ( k != i ) {
7926: t = a[i]; a[i] = a[k]; a[k] = t;
7927: s = sugar[i]; sugar[i] = sugar[k]; sugar[k] = s;
7928: }
7929: ai = a[i];
7930: for ( k = i+1; k < row; k++ ) {
7931: ak = a[k];
7932: if ( ak[wj] & bj ) {
7933: for ( l = wj; l < wcol; l++ )
7934: ak[l] ^= ai[l];
7935: sugar[k] = MAX(sugar[k],sugar[i]);
7936: }
7937: }
7938: i++;
7939: }
7940: for ( k = i-1; k >= 0; k-- ) {
7941: j = pivot[k]; wj = j/BLEN; bj = 1L<<(j%BLEN);
7942: ak = a[k];
7943: for ( s = 0; s < k; s++ ) {
7944: as = a[s];
7945: if ( as[wj] & bj ) {
7946: for ( l = wj; l < wcol; l++ )
7947: as[l] ^= ak[l];
7948: sugar[s] = MAX(sugar[s],sugar[k]);
7949: }
7950: }
7951: }
7952: return i;
7953: }
7954:
7955: void print_matrix(matrix mat)
7956: {
7957: int row,col,i,j;
7958: unsigned long *ai;
7959:
7960: row = mat->row;
7961: col = mat->col;
7962: printf("%d x %d\n",row,col);
7963: for ( i = 0; i < row; i++ ) {
7964: ai = mat->a[i];
7965: for ( j = 0; j < col; j++ ) {
7966: if ( ai[j/BLEN] & (1L<<(j%BLEN)) ) putchar('1');
7967: else putchar('0');
7968: }
7969: putchar('\n');
7970: }
7971: }
7972:
7973: NDV vect_to_ndv_2(unsigned long *vect,int col,UINT *s0vect);
7974:
7975: void red_by_vect_2(matrix mat,int *sugar,unsigned long *v,int rhead,int rsugar)
7976: {
7977: int row,col,wcol,wj,i,j;
7978: unsigned long bj;
7979: unsigned long *ai;
7980: unsigned long **a;
7981: int len;
7982: int *pos;
7983:
7984: row = mat->row;
7985: col = mat->col;
7986: wcol = (col+BLEN-1)/BLEN;
7987: pos = (int *)MALLOC(wcol*sizeof(int));
7988: bzero(pos,wcol*sizeof(int));
7989: for ( i = j = 0; i < wcol; i++ )
7990: if ( v[i] ) pos[j++] = i;;
7991: len = j;
7992: wj = rhead/BLEN;
7993: bj = 1L<<rhead%BLEN;
7994: a = mat->a;
7995: for ( i = 0; i < row; i++ ) {
7996: ai = a[i];
7997: if ( ai[wj]&bj ) {
7998: for ( j = 0; j < len; j++ )
7999: ai[pos[j]] ^= v[pos[j]];
8000: sugar[i] = MAX(sugar[i],rsugar);
8001: }
8002: }
8003: }
8004:
8005: NODE nd_f4_red_2(ND_pairs sp0,UINT *s0vect,int col,NODE rp0,ND_pairs *nz)
8006: {
8007: int nsp,nred,i,i0,k,rank,row;
8008: NODE r0,rp;
8009: ND_pairs sp;
8010: ND spol;
8011: NM_ind_pair rt;
8012: int *s0hash;
8013: UINT *s;
8014: int *pivot,*sugar,*head;
8015: matrix mat;
8016: NM m;
8017: NODE r;
8018: struct oEGT eg0,eg1,eg2,eg_elim1,eg_elim2;
8019: int rhead,rsugar,size;
8020: unsigned long *v;
8021:
8022: get_eg(&eg0);
8023: for ( sp = sp0, nsp = 0; sp; sp = NEXT(sp), nsp++ );
8024: nred = length(rp0);
8025: mat = alloc_matrix(nsp,col);
8026: s0hash = (int *)MALLOC(col*sizeof(int));
8027: for ( i = 0, s = s0vect; i < col; i++, s += nd_wpd )
8028: s0hash[i] = ndl_hash_value(s);
8029:
8030: sugar = (int *)MALLOC(nsp*sizeof(int));
8031: for ( i = 0, sp = sp0; sp; sp = NEXT(sp) ) {
8032: nd_sp(2,0,sp,&spol);
8033: if ( spol ) {
8034: mat->a[i] = nd_to_vect_2(s0vect,col,s0hash,spol);
8035: sugar[i] = SG(spol);
8036: i++;
8037: }
8038: }
8039: mat->row = i;
8040: if ( DP_Print ) {
8041: fprintf(asir_out,"%dx%d,",mat->row,mat->col); fflush(asir_out);
8042: }
8043: size = ((col+BLEN-1)/BLEN)*sizeof(unsigned long);
8044: v = CALLOC((col+BLEN-1)/BLEN,sizeof(unsigned long));
8045: for ( rp = rp0, i = 0; rp; rp = NEXT(rp), i++ ) {
8046: rt = (NM_ind_pair)BDY(rp);
8047: bzero(v,size);
8048: rhead = nd_nm_to_vect_2(s0vect,col,s0hash,nd_ps[rt->index],rt->mul,v);
8049: rsugar = SG(nd_ps[rt->index])+TD(DL(rt->mul));
8050: red_by_vect_2(mat,sugar,v,rhead,rsugar);
8051: }
8052:
8053: get_eg(&eg1);
8054: init_eg(&eg_elim1); add_eg(&eg_elim1,&eg0,&eg1);
8055: rank = rref(mat,sugar);
8056:
8057: for ( i = 0, r0 = 0; i < rank; i++ ) {
8058: NEXTNODE(r0,r);
8059: BDY(r) = (pointer)vect_to_ndv_2(mat->a[i],col,s0vect);
8060: SG((NDV)BDY(r)) = sugar[i];
8061: }
8062: if ( r0 ) NEXT(r) = 0;
8063: get_eg(&eg2);
8064: init_eg(&eg_elim2); add_eg(&eg_elim2,&eg1,&eg2);
8065: if ( DP_Print ) {
8066: fprintf(asir_out,"elim1=%.3fsec,elim2=%.3fsec,",
1.5 noro 8067: eg_elim1.exectime,eg_elim2.exectime);
1.1 noro 8068: fflush(asir_out);
8069: }
8070: return r0;
8071: }
8072:
8073:
8074: NODE nd_f4_red(int m,ND_pairs sp0,int trace,UINT *s0vect,int col,NODE rp0,ND_pairs *nz)
8075: {
8076: IndArray *imat;
1.11 noro 8077: int nsp,nred,i,start;
1.1 noro 8078: int *rhead;
8079: NODE r0,rp;
8080: ND_pairs sp;
8081: NM_ind_pair *rvect;
8082: UINT *s;
8083: int *s0hash;
1.11 noro 8084: struct oEGT eg0,eg1,eg_conv;
1.1 noro 8085:
8086: if ( m == 2 && nd_rref2 )
8087: return nd_f4_red_2(sp0,s0vect,col,rp0,nz);
8088:
8089: for ( sp = sp0, nsp = 0; sp; sp = NEXT(sp), nsp++ );
8090: nred = length(rp0);
8091: imat = (IndArray *)MALLOC(nred*sizeof(IndArray));
8092: rhead = (int *)MALLOC(col*sizeof(int));
8093: for ( i = 0; i < col; i++ ) rhead[i] = 0;
8094:
8095: /* construction of index arrays */
1.11 noro 8096: get_eg(&eg0);
1.1 noro 8097: if ( DP_Print ) {
1.11 noro 8098: fprintf(asir_out,"%dx%d,",nsp+nred,col);
8099: fflush(asir_out);
1.1 noro 8100: }
8101: rvect = (NM_ind_pair *)MALLOC(nred*sizeof(NM_ind_pair));
1.11 noro 8102: for ( start = 0, rp = rp0, i = 0; rp; i++, rp = NEXT(rp) ) {
1.1 noro 8103: rvect[i] = (NM_ind_pair)BDY(rp);
1.11 noro 8104: imat[i] = nm_ind_pair_to_vect_compress(trace,s0vect,col,rvect[i],start);
1.1 noro 8105: rhead[imat[i]->head] = 1;
1.11 noro 8106: start = imat[i]->head;
8107: }
1.12 noro 8108: get_eg(&eg1); init_eg(&eg_conv); add_eg(&eg_conv,&eg0,&eg1); add_eg(&f4_conv,&eg0,&eg1);
1.11 noro 8109: if ( DP_Print ) {
8110: fprintf(asir_out,"conv=%.3fsec,",eg_conv.exectime);
8111: fflush(asir_out);
1.1 noro 8112: }
8113: if ( m > 0 )
1.7 noro 8114: #if SIZEOF_LONG==8
1.1 noro 8115: r0 = nd_f4_red_mod64_main(m,sp0,nsp,s0vect,col,rvect,rhead,imat,nred,nz);
8116: #else
8117: r0 = nd_f4_red_main(m,sp0,nsp,s0vect,col,rvect,rhead,imat,nred,nz);
8118: #endif
8119: else if ( m == -1 )
8120: r0 = nd_f4_red_sf_main(m,sp0,nsp,s0vect,col,rvect,rhead,imat,nred,nz);
8121: else if ( m == -2 )
8122: r0 = nd_f4_red_lf_main(m,sp0,nsp,trace,s0vect,col,rvect,rhead,imat,nred);
8123: else
8124: r0 = nd_f4_red_q_main(sp0,nsp,trace,s0vect,col,rvect,rhead,imat,nred);
8125: return r0;
8126: }
8127:
8128: /* for Fp, 2<=p<2^16 */
8129:
8130: NODE nd_f4_red_main(int m,ND_pairs sp0,int nsp,UINT *s0vect,int col,
8131: NM_ind_pair *rvect,int *rhead,IndArray *imat,int nred,ND_pairs *nz)
8132: {
8133: int spcol,sprow,a;
8134: int i,j,k,l,rank;
8135: NODE r0,r;
8136: ND_pairs sp;
8137: ND spol;
8138: UINT **spmat;
8139: UINT *svect,*v;
8140: int *colstat;
8141: struct oEGT eg0,eg1,eg2,eg_f4,eg_f4_1,eg_f4_2;
8142: int maxrs;
8143: int *spsugar;
8144: ND_pairs *spactive;
8145:
8146: spcol = col-nred;
8147: get_eg(&eg0);
8148: /* elimination (1st step) */
8149: spmat = (UINT **)MALLOC(nsp*sizeof(UINT *));
8150: svect = (UINT *)MALLOC(col*sizeof(UINT));
8151: spsugar = (int *)MALLOC(nsp*sizeof(int));
8152: spactive = !nz?0:(ND_pairs *)MALLOC(nsp*sizeof(ND_pairs));
8153: for ( a = sprow = 0, sp = sp0; a < nsp; a++, sp = NEXT(sp) ) {
8154: nd_sp(m,0,sp,&spol);
8155: if ( !spol ) continue;
8156: nd_to_vect(m,s0vect,col,spol,svect);
8157: if ( m == -1 )
8158: maxrs = ndv_reduce_vect_sf(m,svect,col,imat,rvect,nred);
8159: else
8160: maxrs = ndv_reduce_vect(m,svect,col,imat,rvect,nred);
8161: for ( i = 0; i < col; i++ ) if ( svect[i] ) break;
8162: if ( i < col ) {
8163: spmat[sprow] = v = (UINT *)MALLOC_ATOMIC(spcol*sizeof(UINT));
8164: for ( j = k = 0; j < col; j++ )
8165: if ( !rhead[j] ) v[k++] = svect[j];
8166: spsugar[sprow] = MAX(maxrs,SG(spol));
8167: if ( nz )
8168: spactive[sprow] = sp;
8169: sprow++;
8170: }
8171: nd_free(spol);
8172: }
8173: get_eg(&eg1); init_eg(&eg_f4_1); add_eg(&eg_f4_1,&eg0,&eg1);
8174: if ( DP_Print ) {
1.5 noro 8175: fprintf(asir_out,"elim1=%.3fsec,",eg_f4_1.exectime);
1.1 noro 8176: fflush(asir_out);
8177: }
8178: /* free index arrays */
8179: for ( i = 0; i < nred; i++ ) GCFREE(imat[i]->index.c);
8180:
8181: /* elimination (2nd step) */
8182: colstat = (int *)MALLOC(spcol*sizeof(int));
8183: if ( m == -1 )
8184: rank = nd_gauss_elim_sf(spmat,spsugar,sprow,spcol,m,colstat);
8185: else
8186: rank = nd_gauss_elim_mod(spmat,spsugar,spactive,sprow,spcol,m,colstat);
8187: r0 = 0;
8188: for ( i = 0; i < rank; i++ ) {
8189: NEXTNODE(r0,r); BDY(r) =
8190: (pointer)vect_to_ndv(spmat[i],spcol,col,rhead,s0vect);
8191: SG((NDV)BDY(r)) = spsugar[i];
8192: GCFREE(spmat[i]);
8193: }
8194: if ( r0 ) NEXT(r) = 0;
8195:
8196: for ( ; i < sprow; i++ ) GCFREE(spmat[i]);
8197: get_eg(&eg2); init_eg(&eg_f4_2); add_eg(&eg_f4_2,&eg1,&eg2);
8198: init_eg(&eg_f4); add_eg(&eg_f4,&eg0,&eg2);
8199: if ( DP_Print ) {
1.5 noro 8200: fprintf(asir_out,"elim2=%.3fsec,",eg_f4_2.exectime);
1.1 noro 8201: fprintf(asir_out,"nsp=%d,nred=%d,spmat=(%d,%d),rank=%d ",
8202: nsp,nred,sprow,spcol,rank);
1.5 noro 8203: fprintf(asir_out,"%.3fsec,",eg_f4.exectime);
1.1 noro 8204: }
8205: if ( nz ) {
8206: for ( i = 0; i < rank-1; i++ ) NEXT(spactive[i]) = spactive[i+1];
8207: if ( rank > 0 ) {
8208: NEXT(spactive[rank-1]) = 0;
8209: *nz = spactive[0];
8210: } else
8211: *nz = 0;
8212: }
8213: return r0;
8214: }
8215:
8216:
8217: /* for small finite fields */
8218:
8219: NODE nd_f4_red_sf_main(int m,ND_pairs sp0,int nsp,UINT *s0vect,int col,
8220: NM_ind_pair *rvect,int *rhead,IndArray *imat,int nred,ND_pairs *nz)
8221: {
8222: int spcol,sprow,a;
8223: int i,j,k,l,rank;
8224: NODE r0,r;
8225: ND_pairs sp;
8226: ND spol;
8227: UINT **spmat;
8228: UINT *svect,*v;
8229: int *colstat;
8230: struct oEGT eg0,eg1,eg2,eg_f4,eg_f4_1,eg_f4_2;
8231: int maxrs;
8232: int *spsugar;
8233: ND_pairs *spactive;
8234:
8235: spcol = col-nred;
8236: get_eg(&eg0);
8237: /* elimination (1st step) */
8238: spmat = (UINT **)MALLOC(nsp*sizeof(UINT *));
8239: svect = (UINT *)MALLOC(col*sizeof(UINT));
8240: spsugar = (int *)MALLOC(nsp*sizeof(int));
8241: spactive = !nz?0:(ND_pairs *)MALLOC(nsp*sizeof(ND_pairs));
8242: for ( a = sprow = 0, sp = sp0; a < nsp; a++, sp = NEXT(sp) ) {
8243: nd_sp(m,0,sp,&spol);
8244: if ( !spol ) continue;
8245: nd_to_vect(m,s0vect,col,spol,svect);
8246: maxrs = ndv_reduce_vect_sf(m,svect,col,imat,rvect,nred);
8247: for ( i = 0; i < col; i++ ) if ( svect[i] ) break;
8248: if ( i < col ) {
8249: spmat[sprow] = v = (UINT *)MALLOC_ATOMIC(spcol*sizeof(UINT));
8250: for ( j = k = 0; j < col; j++ )
8251: if ( !rhead[j] ) v[k++] = svect[j];
8252: spsugar[sprow] = MAX(maxrs,SG(spol));
8253: if ( nz )
8254: spactive[sprow] = sp;
8255: sprow++;
8256: }
8257: nd_free(spol);
8258: }
8259: get_eg(&eg1); init_eg(&eg_f4_1); add_eg(&eg_f4_1,&eg0,&eg1);
8260: if ( DP_Print ) {
1.5 noro 8261: fprintf(asir_out,"elim1=%.3fsec,",eg_f4_1.exectime);
1.1 noro 8262: fflush(asir_out);
8263: }
8264: /* free index arrays */
8265: for ( i = 0; i < nred; i++ ) GCFREE(imat[i]->index.c);
8266:
8267: /* elimination (2nd step) */
8268: colstat = (int *)MALLOC(spcol*sizeof(int));
8269: rank = nd_gauss_elim_sf(spmat,spsugar,sprow,spcol,m,colstat);
8270: r0 = 0;
8271: for ( i = 0; i < rank; i++ ) {
8272: NEXTNODE(r0,r); BDY(r) =
8273: (pointer)vect_to_ndv(spmat[i],spcol,col,rhead,s0vect);
8274: SG((NDV)BDY(r)) = spsugar[i];
8275: GCFREE(spmat[i]);
8276: }
8277: if ( r0 ) NEXT(r) = 0;
8278:
8279: for ( ; i < sprow; i++ ) GCFREE(spmat[i]);
8280: get_eg(&eg2); init_eg(&eg_f4_2); add_eg(&eg_f4_2,&eg1,&eg2);
8281: init_eg(&eg_f4); add_eg(&eg_f4,&eg0,&eg2);
8282: if ( DP_Print ) {
1.5 noro 8283: fprintf(asir_out,"elim2=%.3fsec,",eg_f4_2.exectime);
1.1 noro 8284: fprintf(asir_out,"nsp=%d,nred=%d,spmat=(%d,%d),rank=%d ",
8285: nsp,nred,sprow,spcol,rank);
1.5 noro 8286: fprintf(asir_out,"%.3fsec,",eg_f4.exectime);
1.1 noro 8287: }
8288: if ( nz ) {
8289: for ( i = 0; i < rank-1; i++ ) NEXT(spactive[i]) = spactive[i+1];
8290: if ( rank > 0 ) {
8291: NEXT(spactive[rank-1]) = 0;
8292: *nz = spactive[0];
8293: } else
8294: *nz = 0;
8295: }
8296: return r0;
8297: }
8298:
8299: NODE nd_f4_red_lf_main(int m,ND_pairs sp0,int nsp,int trace,UINT *s0vect,int col,
8300: NM_ind_pair *rvect,int *rhead,IndArray *imat,int nred)
8301: {
8302: int spcol,sprow,a;
8303: int i,j,k,l,rank;
8304: NODE r0,r;
8305: ND_pairs sp;
8306: ND spol;
8307: mpz_t **spmat;
8308: mpz_t *svect,*v;
8309: int *colstat;
8310: struct oEGT eg0,eg1,eg2,eg_f4,eg_f4_1,eg_f4_2;
8311: int maxrs;
8312: int *spsugar;
8313: pointer *w;
8314:
8315: spcol = col-nred;
8316: get_eg(&eg0);
8317: /* elimination (1st step) */
8318: spmat = (mpz_t **)MALLOC(nsp*sizeof(mpz_t *));
8319: svect = (mpz_t *)MALLOC(col*sizeof(mpz_t));
8320: spsugar = (int *)MALLOC(nsp*sizeof(int));
8321: for ( a = sprow = 0, sp = sp0; a < nsp; a++, sp = NEXT(sp) ) {
8322: nd_sp(m,trace,sp,&spol);
8323: if ( !spol ) continue;
8324: nd_to_vect_lf(s0vect,col,spol,svect);
8325: maxrs = ndv_reduce_vect_lf(svect,trace,col,imat,rvect,nred);
8326: for ( i = 0; i < col; i++ ) if ( mpz_sgn(svect[i]) ) break;
8327: if ( i < col ) {
8328: spmat[sprow] = v = (mpz_t *)MALLOC(spcol*sizeof(mpz_t));
8329: for ( j = k = 0; j < col; j++ )
8330: if ( !rhead[j] ) v[k++][0] = svect[j][0];
8331: spsugar[sprow] = MAX(maxrs,SG(spol));
8332: sprow++;
8333: }
8334: /* nd_free(spol); */
8335: }
8336: get_eg(&eg1); init_eg(&eg_f4_1); add_eg(&eg_f4_1,&eg0,&eg1);
8337: if ( DP_Print ) {
1.5 noro 8338: fprintf(asir_out,"elim1=%.3fsec,",eg_f4_1.exectime);
1.1 noro 8339: fflush(asir_out);
8340: }
8341: /* free index arrays */
8342: /* for ( i = 0; i < nred; i++ ) GCFREE(imat[i]->index.c); */
8343:
8344: /* elimination (2nd step) */
8345: colstat = (int *)MALLOC(spcol*sizeof(int));
8346: rank = nd_gauss_elim_lf(spmat,spsugar,sprow,spcol,colstat);
8347: w = (pointer *)MALLOC(rank*sizeof(pointer));
8348: for ( i = 0; i < rank; i++ ) {
8349: #if 0
8350: w[rank-i-1] = (pointer)vect_to_ndv_lf(spmat[i],spcol,col,rhead,s0vect);
8351: SG((NDV)w[rank-i-1]) = spsugar[i];
8352: #else
8353: w[i] = (pointer)vect_to_ndv_lf(spmat[i],spcol,col,rhead,s0vect);
8354: SG((NDV)w[i]) = spsugar[i];
8355: #endif
8356: /* GCFREE(spmat[i]); */
8357:
8358: }
8359: #if 0
8360: qsort(w,rank,sizeof(NDV),
8361: (int (*)(const void *,const void *))ndv_compare);
8362: #endif
8363: r0 = 0;
8364: for ( i = 0; i < rank; i++ ) {
8365: NEXTNODE(r0,r); BDY(r) = w[i];
8366: }
8367: if ( r0 ) NEXT(r) = 0;
8368:
8369: /* for ( ; i < sprow; i++ ) GCFREE(spmat[i]); */
8370: get_eg(&eg2); init_eg(&eg_f4_2); add_eg(&eg_f4_2,&eg1,&eg2);
8371: init_eg(&eg_f4); add_eg(&eg_f4,&eg0,&eg2);
8372: if ( DP_Print ) {
1.5 noro 8373: fprintf(asir_out,"elim2=%.3fsec,",eg_f4_2.exectime);
1.1 noro 8374: fprintf(asir_out,"nsp=%d,nred=%d,spmat=(%d,%d),rank=%d ",
8375: nsp,nred,sprow,spcol,rank);
1.5 noro 8376: fprintf(asir_out,"%.3fsec,",eg_f4.exectime);
1.1 noro 8377: }
8378: return r0;
8379: }
8380:
8381: NODE nd_f4_red_q_main(ND_pairs sp0,int nsp,int trace,UINT *s0vect,int col,
8382: NM_ind_pair *rvect,int *rhead,IndArray *imat,int nred)
8383: {
8384: int spcol,sprow,a;
8385: int i,j,k,l,rank;
8386: NODE r0,r;
8387: ND_pairs sp;
8388: ND spol;
8389: Z **spmat;
8390: Z *svect,*v;
8391: int *colstat;
8392: struct oEGT eg0,eg1,eg2,eg_f4,eg_f4_1,eg_f4_2;
8393: int maxrs;
8394: int *spsugar;
8395: pointer *w;
8396:
8397: spcol = col-nred;
8398: get_eg(&eg0);
8399: /* elimination (1st step) */
8400: spmat = (Z **)MALLOC(nsp*sizeof(Q *));
8401: svect = (Z *)MALLOC(col*sizeof(Q));
8402: spsugar = (int *)MALLOC(nsp*sizeof(int));
8403: for ( a = sprow = 0, sp = sp0; a < nsp; a++, sp = NEXT(sp) ) {
8404: nd_sp(0,trace,sp,&spol);
8405: if ( !spol ) continue;
8406: nd_to_vect_q(s0vect,col,spol,svect);
8407: maxrs = ndv_reduce_vect_q(svect,trace,col,imat,rvect,nred);
8408: for ( i = 0; i < col; i++ ) if ( svect[i] ) break;
8409: if ( i < col ) {
8410: spmat[sprow] = v = (Z *)MALLOC(spcol*sizeof(Q));
8411: for ( j = k = 0; j < col; j++ )
8412: if ( !rhead[j] ) v[k++] = svect[j];
8413: spsugar[sprow] = MAX(maxrs,SG(spol));
8414: sprow++;
8415: }
8416: /* nd_free(spol); */
8417: }
8418: get_eg(&eg1); init_eg(&eg_f4_1); add_eg(&eg_f4_1,&eg0,&eg1);
8419: if ( DP_Print ) {
1.5 noro 8420: fprintf(asir_out,"elim1=%.3fsec,",eg_f4_1.exectime);
1.1 noro 8421: fflush(asir_out);
8422: }
8423: /* free index arrays */
8424: /* for ( i = 0; i < nred; i++ ) GCFREE(imat[i]->index.c); */
8425:
8426: /* elimination (2nd step) */
8427: colstat = (int *)MALLOC(spcol*sizeof(int));
8428: rank = nd_gauss_elim_q(spmat,spsugar,sprow,spcol,colstat);
8429: w = (pointer *)MALLOC(rank*sizeof(pointer));
8430: for ( i = 0; i < rank; i++ ) {
8431: #if 0
8432: w[rank-i-1] = (pointer)vect_to_ndv_q(spmat[i],spcol,col,rhead,s0vect);
8433: SG((NDV)w[rank-i-1]) = spsugar[i];
8434: #else
8435: w[i] = (pointer)vect_to_ndv_q(spmat[i],spcol,col,rhead,s0vect);
8436: SG((NDV)w[i]) = spsugar[i];
8437: #endif
8438: /* GCFREE(spmat[i]); */
8439: }
8440: #if 0
8441: qsort(w,rank,sizeof(NDV),
8442: (int (*)(const void *,const void *))ndv_compare);
8443: #endif
8444: r0 = 0;
8445: for ( i = 0; i < rank; i++ ) {
8446: NEXTNODE(r0,r); BDY(r) = w[i];
8447: }
8448: if ( r0 ) NEXT(r) = 0;
8449:
8450: /* for ( ; i < sprow; i++ ) GCFREE(spmat[i]); */
8451: get_eg(&eg2); init_eg(&eg_f4_2); add_eg(&eg_f4_2,&eg1,&eg2);
8452: init_eg(&eg_f4); add_eg(&eg_f4,&eg0,&eg2);
8453: if ( DP_Print ) {
1.5 noro 8454: fprintf(asir_out,"elim2=%.3fsec,",eg_f4_2.exectime);
1.1 noro 8455: fprintf(asir_out,"nsp=%d,nred=%d,spmat=(%d,%d),rank=%d ",
8456: nsp,nred,sprow,spcol,rank);
1.5 noro 8457: fprintf(asir_out,"%.3fsec,",eg_f4.exectime);
1.1 noro 8458: }
8459: return r0;
8460: }
8461:
8462: FILE *nd_write,*nd_read;
8463:
8464: void nd_send_int(int a) {
8465: write_int(nd_write,(unsigned int *)&a);
8466: }
8467:
8468: void nd_send_intarray(int *p,int len) {
8469: write_intarray(nd_write,(unsigned int *)p,len);
8470: }
8471:
8472: int nd_recv_int() {
8473: int a;
8474:
8475: read_int(nd_read,(unsigned int *)&a);
8476: return a;
8477: }
8478:
8479: void nd_recv_intarray(int *p,int len) {
8480: read_intarray(nd_read,(unsigned int *)p,len);
8481: }
8482:
8483: void nd_send_ndv(NDV p) {
8484: int len,i;
8485: NMV m;
8486:
8487: if ( !p ) nd_send_int(0);
8488: else {
8489: len = LEN(p);
8490: nd_send_int(len);
8491: m = BDY(p);
8492: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
8493: nd_send_int(CM(m));
8494: nd_send_intarray((int *)DL(m),nd_wpd);
8495: }
8496: }
8497: }
8498:
8499: void nd_send_nd(ND p) {
8500: int len,i;
8501: NM m;
8502:
8503: if ( !p ) nd_send_int(0);
8504: else {
8505: len = LEN(p);
8506: nd_send_int(len);
8507: m = BDY(p);
8508: for ( i = 0; i < len; i++, m = NEXT(m) ) {
8509: nd_send_int(CM(m));
8510: nd_send_intarray((int *)DL(m),nd_wpd);
8511: }
8512: }
8513: }
8514:
8515: NDV nd_recv_ndv()
8516: {
8517: int len,i;
8518: NMV m,m0;
8519: NDV r;
8520:
8521: len = nd_recv_int();
8522: if ( !len ) return 0;
8523: else {
8524: m0 = m = (NMV)MALLOC_ATOMIC_IGNORE_OFF_PAGE(nmv_adv*len);
8525: #if 0
8526: ndv_alloc += len*nmv_adv;
8527: #endif
8528: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
8529: CM(m) = nd_recv_int();
8530: nd_recv_intarray((int *)DL(m),nd_wpd);
8531: }
8532: MKNDV(nd_nvar,m0,len,r);
8533: return r;
8534: }
8535: }
8536:
8537: int nd_gauss_elim_q(Z **mat0,int *sugar,int row,int col,int *colstat)
8538: {
8539: int i,j,t,c,rank,inv;
8540: int *ci,*ri;
8541: Z dn;
8542: MAT m,nm;
8543:
8544: NEWMAT(m); m->row = row; m->col = col; m->body = (pointer **)mat0;
8545: rank = generic_gauss_elim(m,&nm,&dn,&ri,&ci);
8546: for ( i = 0; i < row; i++ )
8547: for ( j = 0; j < col; j++ )
8548: mat0[i][j] = 0;
8549: c = col-rank;
8550: for ( i = 0; i < rank; i++ ) {
8551: mat0[i][ri[i]] = dn;
8552: for ( j = 0; j < c; j++ )
8553: mat0[i][ci[j]] = (Z)BDY(nm)[i][j];
8554: }
8555: return rank;
8556: }
8557:
8558: int nd_gauss_elim_mod(UINT **mat0,int *sugar,ND_pairs *spactive,int row,int col,int md,int *colstat)
8559: {
8560: int i,j,k,l,inv,a,rank,s;
8561: unsigned int *t,*pivot,*pk;
8562: unsigned int **mat;
8563: ND_pairs pair;
8564:
8565: mat = (unsigned int **)mat0;
8566: for ( rank = 0, j = 0; j < col; j++ ) {
8567: for ( i = rank; i < row; i++ )
8568: mat[i][j] %= md;
8569: for ( i = rank; i < row; i++ )
8570: if ( mat[i][j] )
8571: break;
8572: if ( i == row ) {
8573: colstat[j] = 0;
8574: continue;
8575: } else
8576: colstat[j] = 1;
8577: if ( i != rank ) {
8578: t = mat[i]; mat[i] = mat[rank]; mat[rank] = t;
8579: s = sugar[i]; sugar[i] = sugar[rank]; sugar[rank] = s;
8580: if ( spactive ) {
8581: pair = spactive[i]; spactive[i] = spactive[rank];
8582: spactive[rank] = pair;
8583: }
8584: }
8585: pivot = mat[rank];
8586: s = sugar[rank];
8587: inv = invm(pivot[j],md);
8588: for ( k = j, pk = pivot+k; k < col; k++, pk++ )
8589: if ( *pk ) {
8590: if ( *pk >= (unsigned int)md )
8591: *pk %= md;
8592: DMAR(*pk,inv,0,md,*pk)
8593: }
8594: for ( i = rank+1; i < row; i++ ) {
8595: t = mat[i];
8596: if ( (a = t[j]) != 0 ) {
8597: sugar[i] = MAX(sugar[i],s);
8598: red_by_vect(md,t+j,pivot+j,md-a,col-j);
8599: }
8600: }
8601: rank++;
8602: }
8603: for ( j = col-1, l = rank-1; j >= 0; j-- )
8604: if ( colstat[j] ) {
8605: pivot = mat[l];
8606: s = sugar[l];
8607: for ( i = 0; i < l; i++ ) {
8608: t = mat[i];
8609: t[j] %= md;
8610: if ( (a = t[j]) != 0 ) {
8611: sugar[i] = MAX(sugar[i],s);
8612: red_by_vect(md,t+j,pivot+j,md-a,col-j);
8613: }
8614: }
8615: l--;
8616: }
8617: for ( j = 0, l = 0; l < rank; j++ )
8618: if ( colstat[j] ) {
8619: t = mat[l];
8620: for ( k = j; k < col; k++ )
8621: if ( t[k] >= (unsigned int)md )
8622: t[k] %= md;
8623: l++;
8624: }
8625: return rank;
8626: }
8627:
8628:
1.7 noro 8629: int nd_gauss_elim_sf(UINT **mat0,int *sugar,int row,int col,int md,int *colstat)
1.1 noro 8630: {
1.7 noro 8631: int i,j,k,l,inv,a,rank,s;
8632: unsigned int *t,*pivot,*pk;
8633: unsigned int **mat;
8634:
8635: mat = (unsigned int **)mat0;
8636: for ( rank = 0, j = 0; j < col; j++ ) {
8637: for ( i = rank; i < row; i++ )
8638: if ( mat[i][j] )
8639: break;
8640: if ( i == row ) {
8641: colstat[j] = 0;
8642: continue;
8643: } else
8644: colstat[j] = 1;
8645: if ( i != rank ) {
8646: t = mat[i]; mat[i] = mat[rank]; mat[rank] = t;
8647: s = sugar[i]; sugar[i] = sugar[rank]; sugar[rank] = s;
8648: }
8649: pivot = mat[rank];
8650: s = sugar[rank];
8651: inv = _invsf(pivot[j]);
8652: for ( k = j, pk = pivot+k; k < col; k++, pk++ )
8653: if ( *pk )
8654: *pk = _mulsf(*pk,inv);
8655: for ( i = rank+1; i < row; i++ ) {
8656: t = mat[i];
8657: if ( (a = t[j]) != 0 ) {
8658: sugar[i] = MAX(sugar[i],s);
8659: red_by_vect_sf(md,t+j,pivot+j,_chsgnsf(a),col-j);
8660: }
8661: }
8662: rank++;
8663: }
8664: for ( j = col-1, l = rank-1; j >= 0; j-- )
8665: if ( colstat[j] ) {
8666: pivot = mat[l];
8667: s = sugar[l];
8668: for ( i = 0; i < l; i++ ) {
8669: t = mat[i];
8670: if ( (a = t[j]) != 0 ) {
8671: sugar[i] = MAX(sugar[i],s);
8672: red_by_vect_sf(md,t+j,pivot+j,_chsgnsf(a),col-j);
8673: }
8674: }
8675: l--;
8676: }
8677: return rank;
8678: }
1.1 noro 8679:
1.7 noro 8680: int ndv_ishomo(NDV p)
8681: {
8682: NMV m;
8683: int len,h;
1.1 noro 8684:
8685: if ( !p ) return 1;
8686: len = LEN(p);
8687: m = BDY(p);
8688: h = TD(DL(m));
8689: NMV_ADV(m);
8690: for ( len--; len; len--, NMV_ADV(m) )
1.20 noro 8691: if ( TD(DL(m)) != h ) {
8692: return 0;
8693: }
1.1 noro 8694: return 1;
8695: }
8696:
8697: void ndv_save(NDV p,int index)
8698: {
8699: FILE *s;
8700: char name[BUFSIZ];
8701: short id;
8702: int nv,sugar,len,n,i,td,e,j;
8703: NMV m;
8704: unsigned int *dl;
8705: int mpos;
8706:
8707: sprintf(name,"%s/%d",Demand,index);
8708: s = fopen(name,"w");
8709: savevl(s,0);
8710: if ( !p ) {
8711: saveobj(s,0);
8712: return;
8713: }
8714: id = O_DP;
8715: nv = NV(p);
8716: sugar = SG(p);
8717: len = LEN(p);
8718: write_short(s,(unsigned short *)&id); write_int(s,(unsigned int *)&nv); write_int(s,(unsigned int *)&sugar);
8719: write_int(s,(unsigned int *)&len);
8720:
8721: for ( m = BDY(p), i = 0; i < len; i++, NMV_ADV(m) ) {
1.6 noro 8722: saveobj(s,(Obj)CZ(m));
1.1 noro 8723: dl = DL(m);
8724: td = TD(dl);
8725: write_int(s,(unsigned int *)&td);
8726: for ( j = 0; j < nv; j++ ) {
8727: e = GET_EXP(dl,j);
8728: write_int(s,(unsigned int *)&e);
8729: }
8730: if ( nd_module ) {
8731: mpos = MPOS(dl); write_int(s,(unsigned int *)&mpos);
8732: }
8733: }
8734: fclose(s);
8735: }
8736:
8737: void nd_save_mod(ND p,int index)
8738: {
8739: FILE *s;
8740: char name[BUFSIZ];
8741: int nv,sugar,len,c;
8742: NM m;
8743:
8744: sprintf(name,"%s/%d",Demand,index);
8745: s = fopen(name,"w");
8746: if ( !p ) {
8747: len = 0;
8748: write_int(s,(unsigned int *)&len);
8749: fclose(s);
8750: return;
8751: }
8752: nv = NV(p);
8753: sugar = SG(p);
8754: len = LEN(p);
8755: write_int(s,(unsigned int *)&nv); write_int(s,(unsigned int *)&sugar); write_int(s,(unsigned int *)&len);
8756: for ( m = BDY(p); m; m = NEXT(m) ) {
8757: c = CM(m); write_int(s,(unsigned int *)&c);
8758: write_intarray(s,(unsigned int *)DL(m),nd_wpd);
8759: }
8760: fclose(s);
8761: }
8762:
8763: NDV ndv_load(int index)
8764: {
8765: FILE *s;
8766: char name[BUFSIZ];
8767: short id;
8768: int nv,sugar,len,n,i,td,e,j;
8769: NDV d;
8770: NMV m0,m;
8771: unsigned int *dl;
8772: Obj obj;
8773: int mpos;
8774:
8775: sprintf(name,"%s/%d",Demand,index);
8776: s = fopen(name,"r");
8777: if ( !s ) return 0;
8778:
8779: skipvl(s);
8780: read_short(s,(unsigned short *)&id);
8781: if ( !id ) return 0;
8782: read_int(s,(unsigned int *)&nv);
8783: read_int(s,(unsigned int *)&sugar);
8784: read_int(s,(unsigned int *)&len);
8785:
8786: m0 = m = MALLOC(len*nmv_adv);
8787: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
1.6 noro 8788: loadobj(s,&obj); CZ(m) = (Z)obj;
1.1 noro 8789: dl = DL(m);
8790: ndl_zero(dl);
8791: read_int(s,(unsigned int *)&td); TD(dl) = td;
8792: for ( j = 0; j < nv; j++ ) {
8793: read_int(s,(unsigned int *)&e);
8794: PUT_EXP(dl,j,e);
8795: }
8796: if ( nd_module ) {
8797: read_int(s,(unsigned int *)&mpos); MPOS(dl) = mpos;
8798: }
8799: if ( nd_blockmask ) ndl_weight_mask(dl);
8800: }
8801: fclose(s);
8802: MKNDV(nv,m0,len,d);
8803: SG(d) = sugar;
8804: return d;
8805: }
8806:
8807: ND nd_load_mod(int index)
8808: {
8809: FILE *s;
8810: char name[BUFSIZ];
8811: int nv,sugar,len,i,c;
8812: ND d;
8813: NM m0,m;
8814:
8815: sprintf(name,"%s/%d",Demand,index);
8816: s = fopen(name,"r");
8817: /* if the file does not exist, it means p[index]=0 */
8818: if ( !s ) return 0;
8819:
8820: read_int(s,(unsigned int *)&nv);
8821: if ( !nv ) { fclose(s); return 0; }
8822:
8823: read_int(s,(unsigned int *)&sugar);
8824: read_int(s,(unsigned int *)&len);
8825: for ( m0 = 0, i = 0; i < len; i++ ) {
8826: NEXTNM(m0,m);
8827: read_int(s,(unsigned int *)&c); CM(m) = c;
8828: read_intarray(s,(unsigned int *)DL(m),nd_wpd);
8829: }
8830: NEXT(m) = 0;
8831: MKND(nv,m0,len,d);
8832: SG(d) = sugar;
8833: fclose(s);
8834: return d;
8835: }
8836:
8837: void nd_det(int mod,MAT f,P *rp)
8838: {
8839: VL fv,tv;
8840: int n,i,j,max,e,nvar,sgn,k0,l0,len0,len,k,l,a;
8841: pointer **m;
8842: P **w;
8843: P mp,r;
8844: NDV **dm;
8845: NDV *t,*mi,*mj;
8846: NDV d,s,mij,mjj;
8847: ND u;
8848: NMV nmv;
8849: UINT *bound;
8850: PGeoBucket bucket;
8851: struct order_spec *ord;
8852: Z dq,dt,ds;
8853: Z mone;
8854: Z gn,qn,dn0,nm,dn;
8855:
8856: create_order_spec(0,0,&ord);
8857: nd_init_ord(ord);
8858: get_vars((Obj)f,&fv);
8859: if ( f->row != f->col )
8860: error("nd_det : non-square matrix");
8861: n = f->row;
8862: m = f->body;
8863: for ( nvar = 0, tv = fv; tv; tv = NEXT(tv), nvar++ );
8864:
8865: if ( !nvar ) {
8866: if ( !mod )
8867: detp(CO,(P **)m,n,rp);
8868: else {
8869: w = (P **)almat_pointer(n,n);
8870: for ( i = 0; i < n; i++ )
8871: for ( j = 0; j < n; j++ )
8872: ptomp(mod,(P)m[i][j],&w[i][j]);
8873: detmp(CO,mod,w,n,&mp);
8874: mptop(mp,rp);
8875: }
8876: return;
8877: }
8878:
8879: if ( !mod ) {
8880: w = (P **)almat_pointer(n,n);
8881: dq = ONE;
8882: for ( i = 0; i < n; i++ ) {
8883: dn0 = ONE;
8884: for ( j = 0; j < n; j++ ) {
8885: if ( !m[i][j] ) continue;
8886: lgp(m[i][j],&nm,&dn);
1.6 noro 8887: gcdz(dn0,dn,&gn); divsz(dn0,gn,&qn); mulz(qn,dn,&dn0);
1.1 noro 8888: }
8889: if ( !UNIZ(dn0) ) {
8890: ds = dn0;
8891: for ( j = 0; j < n; j++ )
8892: mulp(CO,(P)m[i][j],(P)ds,&w[i][j]);
8893: mulz(dq,ds,&dt); dq = dt;
8894: } else
8895: for ( j = 0; j < n; j++ )
8896: w[i][j] = (P)m[i][j];
8897: }
8898: m = (pointer **)w;
8899: }
8900:
8901: for ( i = 0, max = 1; i < n; i++ )
8902: for ( j = 0; j < n; j++ )
8903: for ( tv = fv; tv; tv = NEXT(tv) ) {
8904: e = getdeg(tv->v,(P)m[i][j]);
8905: max = MAX(e,max);
8906: }
8907: nd_setup_parameters(nvar,max);
8908: dm = (NDV **)almat_pointer(n,n);
8909: for ( i = 0, max = 1; i < n; i++ )
8910: for ( j = 0; j < n; j++ ) {
8911: dm[i][j] = ptondv(CO,fv,m[i][j]);
8912: if ( mod ) ndv_mod(mod,dm[i][j]);
8913: if ( dm[i][j] && !LEN(dm[i][j]) ) dm[i][j] = 0;
8914: }
8915: d = ptondv(CO,fv,(P)ONE);
8916: if ( mod ) ndv_mod(mod,d);
8917: chsgnz(ONE,&mone);
8918: for ( j = 0, sgn = 1; j < n; j++ ) {
8919: if ( DP_Print ) {
8920: fprintf(asir_out,".");
8921: }
8922: for ( i = j; i < n && !dm[i][j]; i++ );
8923: if ( i == n ) {
8924: *rp = 0;
8925: return;
8926: }
8927: k0 = i; l0 = j; len0 = LEN(dm[k0][l0]);
8928: for ( k = j; k < n; k++ )
8929: for ( l = j; l < n; l++ )
8930: if ( dm[k][l] && LEN(dm[k][l]) < len0 ) {
8931: k0 = k; l0 = l; len0 = LEN(dm[k][l]);
8932: }
8933: if ( k0 != j ) {
8934: t = dm[j]; dm[j] = dm[k0]; dm[k0] = t;
8935: sgn = -sgn;
8936: }
8937: if ( l0 != j ) {
8938: for ( k = j; k < n; k++ ) {
8939: s = dm[k][j]; dm[k][j] = dm[k][l0]; dm[k][l0] = s;
8940: }
8941: sgn = -sgn;
8942: }
8943: bound = nd_det_compute_bound(dm,n,j);
8944: for ( k = 0; k < nd_nvar; k++ )
8945: if ( bound[k]*2 > nd_mask0 ) break;
8946: if ( k < nd_nvar )
8947: nd_det_reconstruct(dm,n,j,d);
8948:
8949: for ( i = j+1, mj = dm[j], mjj = mj[j]; i < n; i++ ) {
8950: /* if ( DP_Print ) fprintf(asir_out," i=%d\n ",i); */
8951: mi = dm[i]; mij = mi[j];
8952: if ( mod )
8953: ndv_mul_c(mod,mij,mod-1);
8954: else
8955: ndv_mul_c_q(mij,mone);
8956: for ( k = j+1; k < n; k++ ) {
8957: /* if ( DP_Print ) fprintf(asir_out,"k=%d ",k); */
8958: bucket = create_pbucket();
8959: if ( mi[k] ) {
8960: nmv = BDY(mjj); len = LEN(mjj);
8961: for ( a = 0; a < len; a++, NMV_ADV(nmv) ) {
8962: u = ndv_mul_nmv_trunc(mod,nmv,mi[k],DL(BDY(d)));
8963: add_pbucket(mod,bucket,u);
8964: }
8965: }
8966: if ( mj[k] && mij ) {
8967: nmv = BDY(mij); len = LEN(mij);
8968: for ( a = 0; a < len; a++, NMV_ADV(nmv) ) {
8969: u = ndv_mul_nmv_trunc(mod,nmv,mj[k],DL(BDY(d)));
8970: add_pbucket(mod,bucket,u);
8971: }
8972: }
8973: u = nd_quo(mod,bucket,d);
8974: mi[k] = ndtondv(mod,u);
8975: }
8976: /* if ( DP_Print ) fprintf(asir_out,"\n",k); */
8977: }
8978: d = mjj;
8979: }
8980: if ( DP_Print ) {
8981: fprintf(asir_out,"\n");
8982: }
8983: if ( sgn < 0 ) {
8984: if ( mod )
8985: ndv_mul_c(mod,d,mod-1);
8986: else
8987: ndv_mul_c_q(d,mone);
8988: }
8989: r = ndvtop(mod,CO,fv,d);
8990: if ( !mod && !UNIQ(dq) )
8991: divsp(CO,r,(P)dq,rp);
8992: else
8993: *rp = r;
8994: }
8995:
8996: ND ndv_mul_nmv_trunc(int mod,NMV m0,NDV p,UINT *d)
8997: {
8998: NM mr,mr0;
8999: NM tnm;
9000: NMV m;
9001: UINT *d0,*dt,*dm;
9002: int c,n,td,i,c1,c2,len;
9003: Z q;
9004: ND r;
9005:
9006: if ( !p ) return 0;
9007: else {
9008: n = NV(p); m = BDY(p); len = LEN(p);
9009: d0 = DL(m0);
9010: td = TD(d);
9011: mr0 = 0;
9012: NEWNM(tnm);
9013: if ( mod ) {
9014: c = CM(m0);
9015: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
9016: ndl_add(DL(m),d0,DL(tnm));
9017: if ( ndl_reducible(DL(tnm),d) ) {
9018: NEXTNM(mr0,mr);
9019: c1 = CM(m); DMAR(c1,c,0,mod,c2); CM(mr) = c2;
9020: ndl_copy(DL(tnm),DL(mr));
9021: }
9022: }
9023: } else {
1.6 noro 9024: q = CZ(m0);
1.1 noro 9025: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
9026: ndl_add(DL(m),d0,DL(tnm));
9027: if ( ndl_reducible(DL(tnm),d) ) {
9028: NEXTNM(mr0,mr);
1.6 noro 9029: mulz(CZ(m),q,&CZ(mr));
1.1 noro 9030: ndl_copy(DL(tnm),DL(mr));
9031: }
9032: }
9033: }
9034: if ( !mr0 )
9035: return 0;
9036: else {
9037: NEXT(mr) = 0;
9038: for ( len = 0, mr = mr0; mr; mr = NEXT(mr), len++ );
9039: MKND(NV(p),mr0,len,r);
9040: SG(r) = SG(p) + TD(d0);
9041: return r;
9042: }
9043: }
9044: }
9045:
9046: void nd_det_reconstruct(NDV **dm,int n,int j,NDV d)
9047: {
9048: int i,obpe,oadv,h,k,l;
9049: static NM prev_nm_free_list;
9050: EPOS oepos;
9051:
9052: obpe = nd_bpe;
9053: oadv = nmv_adv;
9054: oepos = nd_epos;
9055: if ( obpe < 2 ) nd_bpe = 2;
9056: else if ( obpe < 3 ) nd_bpe = 3;
9057: else if ( obpe < 4 ) nd_bpe = 4;
9058: else if ( obpe < 5 ) nd_bpe = 5;
9059: else if ( obpe < 6 ) nd_bpe = 6;
9060: else if ( obpe < 8 ) nd_bpe = 8;
9061: else if ( obpe < 10 ) nd_bpe = 10;
9062: else if ( obpe < 16 ) nd_bpe = 16;
9063: else if ( obpe < 32 ) nd_bpe = 32;
9064: else error("nd_det_reconstruct : exponent too large");
9065:
9066: nd_setup_parameters(nd_nvar,0);
9067: prev_nm_free_list = _nm_free_list;
9068: _nm_free_list = 0;
9069: for ( k = j; k < n; k++ )
9070: for (l = j; l < n; l++ )
9071: ndv_realloc(dm[k][l],obpe,oadv,oepos);
9072: ndv_realloc(d,obpe,oadv,oepos);
9073: prev_nm_free_list = 0;
9074: #if 0
9075: GC_gcollect();
9076: #endif
9077: }
9078:
9079: /* returns a UINT array containing degree bounds */
9080:
9081: UINT *nd_det_compute_bound(NDV **dm,int n,int j)
9082: {
9083: UINT *d0,*d1,*d,*t,*r;
9084: int k,l,i;
9085:
9086: d0 = (UINT *)MALLOC(nd_nvar*sizeof(UINT));
9087: for ( k = 0; k < nd_nvar; k++ ) d0[k] = 0;
9088: for ( k = j; k < n; k++ )
9089: for ( l = j; l < n; l++ )
9090: if ( dm[k][l] ) {
9091: d = ndv_compute_bound(dm[k][l]);
9092: for ( i = 0; i < nd_nvar; i++ )
9093: d0[i] = MAX(d0[i],d[i]);
9094: }
9095: return d0;
9096: }
9097:
9098: DL nd_separate_d(UINT *d,UINT *trans)
9099: {
9100: int n,td,i,e,j;
9101: DL a;
9102:
9103: ndl_zero(trans);
9104: td = 0;
9105: for ( i = 0; i < nd_ntrans; i++ ) {
9106: e = GET_EXP(d,i);
9107: PUT_EXP(trans,i,e);
9108: td += MUL_WEIGHT(e,i);
9109: }
9110: if ( nd_ntrans+nd_nalg < nd_nvar ) {
9111: /* homogenized */
9112: i = nd_nvar-1;
9113: e = GET_EXP(d,i);
9114: PUT_EXP(trans,i,e);
9115: td += MUL_WEIGHT(e,i);
9116: }
9117: TD(trans) = td;
9118: if ( nd_blockmask) ndl_weight_mask(trans);
9119: NEWDL(a,nd_nalg);
9120: td = 0;
9121: for ( i = 0; i < nd_nalg; i++ ) {
9122: j = nd_ntrans+i;
9123: e = GET_EXP(d,j);
9124: a->d[i] = e;
9125: td += e;
9126: }
9127: a->td = td;
9128: return a;
9129: }
9130:
9131: int nd_monic(int mod,ND *p)
9132: {
9133: UINT *trans,*t;
9134: DL alg;
9135: MP mp0,mp;
9136: NM m,m0,m1,ma0,ma,mb,mr0,mr;
9137: ND r;
9138: DL dl;
9139: DP nm;
9140: NDV ndv;
9141: DAlg inv,cd;
9142: ND s,c;
9143: Z l,mul;
9144: Z ln;
9145: int n,ntrans,i,e,td,is_lc,len;
9146: NumberField nf;
9147: struct oEGT eg0,eg1;
9148:
9149: if ( !(nf = get_numberfield()) )
9150: error("nd_monic : current_numberfield is not set");
9151:
9152: /* Q coef -> DAlg coef */
9153: NEWNM(ma0); ma = ma0;
9154: m = BDY(*p);
9155: is_lc = 1;
9156: while ( 1 ) {
9157: NEWMP(mp0); mp = mp0;
1.6 noro 9158: mp->c = (Obj)CZ(m);
1.1 noro 9159: mp->dl = nd_separate_d(DL(m),DL(ma));
9160: NEWNM(mb);
9161: for ( m = NEXT(m); m; m = NEXT(m) ) {
9162: alg = nd_separate_d(DL(m),DL(mb));
9163: if ( !ndl_equal(DL(ma),DL(mb)) )
9164: break;
1.6 noro 9165: NEXTMP(mp0,mp); mp->c = (Obj)CZ(m); mp->dl = alg;
1.1 noro 9166: }
9167: NEXT(mp) = 0;
9168: MKDP(nd_nalg,mp0,nm);
9169: MKDAlg(nm,ONE,cd);
9170: if ( is_lc == 1 ) {
9171: /* if the lc is a rational number, we have nothing to do */
9172: if ( !mp0->dl->td )
9173: return 1;
9174:
9175: get_eg(&eg0);
9176: invdalg(cd,&inv);
9177: get_eg(&eg1); add_eg(&eg_invdalg,&eg0,&eg1);
9178: /* check the validity of inv */
9179: if ( mod && !remqi((Q)inv->dn,mod) )
9180: return 0;
9181: CA(ma) = nf->one;
9182: is_lc = 0;
9183: ln = ONE;
9184: } else {
9185: muldalg(cd,inv,&CA(ma));
9186: lcmz(ln,CA(ma)->dn,&ln);
9187: }
9188: if ( m ) {
9189: NEXT(ma) = mb; ma = mb;
9190: } else {
9191: NEXT(ma) = 0;
9192: break;
9193: }
9194: }
9195: /* l = lcm(denoms) */
9196: l = ln;
9197: for ( mr0 = 0, m = ma0; m; m = NEXT(m) ) {
1.6 noro 9198: divsz(l,CA(m)->dn,&mul);
1.1 noro 9199: for ( mp = BDY(CA(m)->nm); mp; mp = NEXT(mp) ) {
9200: NEXTNM(mr0,mr);
1.6 noro 9201: mulz((Z)mp->c,mul,&CZ(mr));
1.1 noro 9202: dl = mp->dl;
9203: td = TD(DL(m));
9204: ndl_copy(DL(m),DL(mr));
9205: for ( i = 0; i < nd_nalg; i++ ) {
9206: e = dl->d[i];
9207: PUT_EXP(DL(mr),i+nd_ntrans,e);
9208: td += MUL_WEIGHT(e,i+nd_ntrans);
9209: }
9210: if ( nd_module ) MPOS(DL(mr)) = MPOS(DL(m));
9211: TD(DL(mr)) = td;
9212: if ( nd_blockmask) ndl_weight_mask(DL(mr));
9213: }
9214: }
9215: NEXT(mr) = 0;
9216: for ( len = 0, mr = mr0; mr; mr = NEXT(mr), len++ );
9217: MKND(NV(*p),mr0,len,r);
9218: /* XXX */
9219: SG(r) = SG(*p);
9220: nd_free(*p);
9221: *p = r;
9222: return 1;
9223: }
9224:
9225: NODE reverse_node(NODE n)
9226: {
9227: NODE t,t1;
9228:
9229: for ( t = 0; n; n = NEXT(n) ) {
9230: MKNODE(t1,BDY(n),t); t = t1;
9231: }
9232: return t;
9233: }
9234:
9235: P ndc_div(int mod,union oNDC a,union oNDC b)
9236: {
9237: union oNDC c;
9238: int inv,t;
9239:
9240: if ( mod == -1 ) c.m = _mulsf(a.m,_invsf(b.m));
1.10 noro 9241: else if ( mod == -2 ) divlf(a.z,b.z,&c.z);
1.1 noro 9242: else if ( mod ) {
9243: inv = invm(b.m,mod);
9244: DMAR(a.m,inv,0,mod,t); c.m = t;
9245: } else if ( nd_vc )
9246: divsp(nd_vc,a.p,b.p,&c.p);
9247: else
9248: divsz(a.z,b.z,&c.z);
9249: return ndctop(mod,c);
9250: }
9251:
9252: P ndctop(int mod,union oNDC c)
9253: {
9254: Z q;
9255: int e;
9256: GFS gfs;
9257:
9258: if ( mod == -1 ) {
9259: e = IFTOF(c.m); MKGFS(e,gfs); return (P)gfs;
9260: } else if ( mod == -2 ) {
1.10 noro 9261: q = c.z; return (P)q;
1.1 noro 9262: } else if ( mod > 0 ) {
1.6 noro 9263: STOZ(c.m,q); return (P)q;
1.1 noro 9264: } else
9265: return (P)c.p;
9266: }
9267:
9268: /* [0,0,0,cont] = p -> p/cont */
9269:
9270: void finalize_tracelist(int i,P cont)
9271: {
9272: LIST l;
9273: NODE node;
9274: Z iq;
9275:
9276: if ( !UNIQ(cont) ) {
9277: node = mknode(4,NULLP,NULLP,NULLP,cont);
9278: MKLIST(l,node); MKNODE(node,l,nd_tracelist);
9279: nd_tracelist = node;
9280: }
1.6 noro 9281: STOZ(i,iq);
1.1 noro 9282: nd_tracelist = reverse_node(nd_tracelist);
9283: MKLIST(l,nd_tracelist);
9284: node = mknode(2,iq,l); MKLIST(l,node);
9285: MKNODE(node,l,nd_alltracelist); MKLIST(l,node);
9286: nd_alltracelist = node; nd_tracelist = 0;
9287: }
9288:
9289: void conv_ilist(int demand,int trace,NODE g,int **indp)
9290: {
9291: int n,i,j;
9292: int *ind;
9293: NODE t;
9294:
9295: n = length(g);
9296: ind = (int *)MALLOC(n*sizeof(int));
9297: for ( i = 0, t = g; i < n; i++, t = NEXT(t) ) {
9298: j = (long)BDY(t); ind[i] = j;
9299: BDY(t) = (pointer)(demand?ndv_load(j):(trace?nd_ps_trace[j]:nd_ps[j]));
9300: }
9301: if ( indp ) *indp = ind;
9302: }
9303:
9304: void parse_nd_option(NODE opt)
9305: {
9306: NODE t,p,u;
9307: int i,s,n;
9308: char *key;
9309: Obj value;
9310:
9311: nd_gentrace = 0; nd_gensyz = 0; nd_nora = 0; nd_gbblock = 0;
9312: nd_newelim = 0; nd_intersect = 0; nd_nzlist = 0;
9313: nd_splist = 0; nd_check_splist = 0;
9314: nd_sugarweight = 0;
9315: nd_f4red =0;
9316: nd_rank0 = 0;
9317: for ( t = opt; t; t = NEXT(t) ) {
9318: p = BDY((LIST)BDY(t));
9319: key = BDY((STRING)BDY(p));
9320: value = (Obj)BDY(NEXT(p));
9321: if ( !strcmp(key,"gentrace") )
9322: nd_gentrace = value?1:0;
9323: else if ( !strcmp(key,"gensyz") )
9324: nd_gensyz = value?1:0;
9325: else if ( !strcmp(key,"nora") )
9326: nd_nora = value?1:0;
9327: else if ( !strcmp(key,"gbblock") ) {
9328: if ( value && OID(value) == O_LIST ) {
9329: u = BDY((LIST)value);
9330: nd_gbblock = MALLOC((2*length(u)+1)*sizeof(int));
9331: for ( i = 0; u; u = NEXT(u) ) {
9332: p = BDY((LIST)BDY(u));
1.6 noro 9333: s = nd_gbblock[i++] = ZTOS((Q)BDY(p));
9334: nd_gbblock[i++] = s+ZTOS((Q)BDY(NEXT(p)))-1;
1.1 noro 9335: }
9336: nd_gbblock[i] = -1;
9337: } else
9338: nd_gbblock = 0;
9339: } else if ( !strcmp(key,"newelim") )
9340: nd_newelim = value?1:0;
9341: else if ( !strcmp(key,"intersect") )
9342: nd_intersect = value?1:0;
1.17 noro 9343: else if ( !strcmp(key,"syzgen") )
9344: nd_intersect = ZTOS((Q)value);
1.1 noro 9345: else if ( !strcmp(key,"lf") )
9346: nd_lf = value?1:0;
9347: else if ( !strcmp(key,"trace") ) {
9348: if ( value ) {
9349: u = BDY((LIST)value);
9350: nd_nzlist = BDY((LIST)ARG2(u));
1.6 noro 9351: nd_bpe = ZTOS((Q)ARG3(u));
1.1 noro 9352: }
9353: } else if ( !strcmp(key,"f4red") ) {
1.6 noro 9354: nd_f4red = ZTOS((Q)value);
1.1 noro 9355: } else if ( !strcmp(key,"rank0") ) {
9356: nd_rank0 = value?1:0;
9357: } else if ( !strcmp(key,"splist") ) {
9358: nd_splist = value?1:0;
9359: } else if ( !strcmp(key,"check_splist") ) {
9360: nd_check_splist = BDY((LIST)value);
9361: } else if ( !strcmp(key,"sugarweight") ) {
9362: u = BDY((LIST)value);
9363: n = length(u);
9364: nd_sugarweight = MALLOC(n*sizeof(int));
9365: for ( i = 0; i < n; i++, u = NEXT(u) )
1.6 noro 9366: nd_sugarweight[i] = ZTOS((Q)BDY(u));
1.1 noro 9367: }
9368: }
9369: }
9370:
9371: ND mdptond(DP d);
9372: ND nd_mul_nm(int mod,NM m0,ND p);
9373: ND nd_mul_nm_lf(NM m0,ND p);
9374: ND *btog(NODE ti,ND **p,int nb,int mod);
9375: ND btog_one(NODE ti,ND *p,int nb,int mod);
9376: MAT nd_btog(LIST f,LIST v,int m,struct order_spec *ord,LIST tlist,MAT *rp);
9377: VECT nd_btog_one(LIST f,LIST v,int m,struct order_spec *ord,LIST tlist,int pos,MAT *rp);
9378:
9379: /* d:monomial */
9380: ND mdptond(DP d)
9381: {
9382: NM m;
9383: ND r;
9384:
9385: if ( OID(d) == 1 )
9386: r = ptond(CO,CO,(P)d);
9387: else {
9388: NEWNM(m);
9389: dltondl(NV(d),BDY(d)->dl,DL(m));
1.6 noro 9390: CZ(m) = (Z)BDY(d)->c;
1.1 noro 9391: NEXT(m) = 0;
9392: MKND(NV(d),m,1,r);
9393: }
9394: return r;
9395: }
9396:
9397: ND nd_mul_nm(int mod,NM m0,ND p)
9398: {
9399: UINT *d0;
9400: int c0,c1,c;
9401: NM tm,mr,mr0;
9402: ND r;
9403:
9404: if ( !p ) return 0;
9405: d0 = DL(m0);
9406: c0 = CM(m0);
9407: mr0 = 0;
9408: for ( tm = BDY(p); tm; tm = NEXT(tm) ) {
9409: NEXTNM(mr0,mr);
9410: c = CM(tm); DMAR(c0,c,0,mod,c1); CM(mr) = c1;
9411: ndl_add(d0,DL(tm),DL(mr));
9412: }
9413: NEXT(mr) = 0;
9414: MKND(NV(p),mr0,LEN(p),r);
9415: return r;
9416: }
9417:
9418: ND nd_mul_nm_lf(NM m0,ND p)
9419: {
9420: UINT *d0;
9421: Z c0,c1,c;
9422: NM tm,mr,mr0;
9423: ND r;
9424:
9425: if ( !p ) return 0;
9426: d0 = DL(m0);
9427: c0 = CZ(m0);
9428: mr0 = 0;
9429: for ( tm = BDY(p); tm; tm = NEXT(tm) ) {
9430: NEXTNM(mr0,mr);
9431: c = CZ(tm); mullf(c0,CZ(tm),&c1); CZ(mr) = c1;
9432: ndl_add(d0,DL(tm),DL(mr));
9433: }
9434: NEXT(mr) = 0;
9435: MKND(NV(p),mr0,LEN(p),r);
9436: return r;
9437: }
9438:
9439: ND *btog(NODE ti,ND **p,int nb,int mod)
9440: {
9441: PGeoBucket *r;
9442: int i,ci;
9443: NODE t,s;
9444: ND m,tp;
9445: ND *pi,*rd;
9446: P c;
9447:
9448: r = (PGeoBucket *)MALLOC(nb*sizeof(PGeoBucket));
9449: for ( i = 0; i < nb; i++ )
9450: r[i] = create_pbucket();
9451: for ( t = ti; t; t = NEXT(t) ) {
9452: s = BDY((LIST)BDY(t));
9453: if ( ARG0(s) ) {
9454: m = mdptond((DP)ARG2(s));
1.6 noro 9455: ptomp(mod,(P)HCZ(m),&c);
1.1 noro 9456: if ( (ci = ((MQ)c)->cont) != 0 ) {
9457: HCM(m) = ci;
1.6 noro 9458: pi = p[ZTOS((Q)ARG1(s))];
1.1 noro 9459: for ( i = 0; i < nb; i++ ) {
9460: tp = nd_mul_nm(mod,BDY(m),pi[i]);
9461: add_pbucket(mod,r[i],tp);
9462: }
9463: }
9464: ci = 1;
9465: } else {
9466: ptomp(mod,(P)ARG3(s),&c); ci = ((MQ)c)->cont;
9467: ci = invm(ci,mod);
9468: }
9469: }
9470: rd = (ND *)MALLOC(nb*sizeof(ND));
9471: for ( i = 0; i < nb; i++ )
9472: rd[i] = normalize_pbucket(mod,r[i]);
9473: if ( ci != 1 )
9474: for ( i = 0; i < nb; i++ ) nd_mul_c(mod,rd[i],ci);
9475: return rd;
9476: }
9477:
9478: /* YYY */
9479: ND *btog_lf(NODE ti,ND **p,int nb)
9480: {
9481: PGeoBucket *r;
9482: int i;
9483: NODE t,s;
9484: ND m,tp;
9485: ND *pi,*rd;
9486: LM lm;
9487: Z lf,c;
9488:
9489: r = (PGeoBucket *)MALLOC(nb*sizeof(PGeoBucket));
9490: for ( i = 0; i < nb; i++ )
9491: r[i] = create_pbucket();
9492: for ( t = ti; t; t = NEXT(t) ) {
9493: s = BDY((LIST)BDY(t));
9494: if ( ARG0(s) ) {
9495: m = mdptond((DP)ARG2(s));
1.6 noro 9496: simp_ff((Obj)HCZ(m),(Obj *)&lm);
1.1 noro 9497: if ( lm ) {
9498: lmtolf(lm,&lf); HCZ(m) = lf;
1.6 noro 9499: pi = p[ZTOS((Q)ARG1(s))];
1.1 noro 9500: for ( i = 0; i < nb; i++ ) {
9501: tp = nd_mul_nm_lf(BDY(m),pi[i]);
9502: add_pbucket(-2,r[i],tp);
9503: }
9504: }
9505: c = ONE;
9506: } else {
9507: simp_ff((Obj)ARG3(s),(Obj *)&lm); lmtolf(lm,&lf); invz(lf,current_mod_lf,&c);
9508: }
9509: }
9510: rd = (ND *)MALLOC(nb*sizeof(ND));
9511: for ( i = 0; i < nb; i++ )
9512: rd[i] = normalize_pbucket(-2,r[i]);
9513: for ( i = 0; i < nb; i++ ) nd_mul_c_lf(rd[i],c);
9514: return rd;
9515: }
9516:
9517: ND btog_one(NODE ti,ND *p,int nb,int mod)
9518: {
9519: PGeoBucket r;
9520: int i,ci,j;
9521: NODE t,s;
9522: ND m,tp;
9523: ND pi,rd;
9524: P c;
9525:
9526: r = create_pbucket();
9527: for ( t = ti; t; t = NEXT(t) ) {
9528: s = BDY((LIST)BDY(t));
9529: if ( ARG0(s) ) {
9530: m = mdptond((DP)ARG2(s));
1.6 noro 9531: ptomp(mod,(P)HCZ(m),&c);
1.1 noro 9532: if ( (ci = ((MQ)c)->cont) != 0 ) {
9533: HCM(m) = ci;
1.6 noro 9534: pi = p[j=ZTOS((Q)ARG1(s))];
1.1 noro 9535: if ( !pi ) {
9536: pi = nd_load_mod(j);
9537: tp = nd_mul_nm(mod,BDY(m),pi);
9538: nd_free(pi);
9539: add_pbucket(mod,r,tp);
9540: } else {
9541: tp = nd_mul_nm(mod,BDY(m),pi);
9542: add_pbucket(mod,r,tp);
9543: }
9544: }
9545: ci = 1;
9546: } else {
9547: ptomp(mod,(P)ARG3(s),&c); ci = ((MQ)c)->cont;
9548: ci = invm(ci,mod);
9549: }
9550: }
9551: rd = normalize_pbucket(mod,r);
9552: free_pbucket(r);
9553: if ( ci != 1 ) nd_mul_c(mod,rd,ci);
9554: return rd;
9555: }
9556:
9557: MAT nd_btog_lf(LIST f,LIST v,struct order_spec *ord,LIST tlist,MAT *rp);
9558:
9559: MAT nd_btog(LIST f,LIST v,int mod,struct order_spec *ord,LIST tlist,MAT *rp)
9560: {
9561: int i,j,n,m,nb,pi0,pi1,nvar;
9562: VL fv,tv,vv;
9563: NODE permtrace,perm,trace,intred,ind,t,pi,ti;
9564: ND **p;
9565: ND *c;
9566: ND u;
9567: P inv;
9568: MAT mat;
9569:
9570: if ( mod == -2 )
9571: return nd_btog_lf(f,v,ord,tlist,rp);
9572:
9573: parse_nd_option(current_option);
9574: get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc);
9575: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
9576: switch ( ord->id ) {
9577: case 1:
9578: if ( ord->nv != nvar )
9579: error("nd_check : invalid order specification");
9580: break;
9581: default:
9582: break;
9583: }
9584: nd_init_ord(ord);
9585: #if 0
1.6 noro 9586: nd_bpe = ZTOS((Q)ARG7(BDY(tlist)));
1.1 noro 9587: #else
9588: nd_bpe = 32;
9589: #endif
9590: nd_setup_parameters(nvar,0);
9591: permtrace = BDY((LIST)ARG2(BDY(tlist)));
9592: intred = BDY((LIST)ARG3(BDY(tlist)));
9593: ind = BDY((LIST)ARG4(BDY(tlist)));
9594: perm = BDY((LIST)BDY(permtrace)); trace =NEXT(permtrace);
9595: for ( i = length(perm)-1, t = trace; t; t = NEXT(t) ) {
1.6 noro 9596: j = ZTOS((Q)BDY(BDY((LIST)BDY(t))));
1.1 noro 9597: if ( j > i ) i = j;
9598: }
9599: n = i+1;
9600: nb = length(BDY(f));
9601: p = (ND **)MALLOC(n*sizeof(ND *));
9602: for ( t = perm, i = 0; t; t = NEXT(t), i++ ) {
9603: pi = BDY((LIST)BDY(t));
1.6 noro 9604: pi0 = ZTOS((Q)ARG0(pi)); pi1 = ZTOS((Q)ARG1(pi));
1.1 noro 9605: p[pi0] = c = (ND *)MALLOC(nb*sizeof(ND));
9606: ptomp(mod,(P)ARG2(pi),&inv);
9607: ((MQ)inv)->cont = invm(((MQ)inv)->cont,mod);
9608: u = ptond(CO,vv,(P)ONE);
9609: HCM(u) = ((MQ)inv)->cont;
9610: c[pi1] = u;
9611: }
9612: for ( t = trace,i=0; t; t = NEXT(t), i++ ) {
9613: printf("%d ",i); fflush(stdout);
9614: ti = BDY((LIST)BDY(t));
1.6 noro 9615: p[j=ZTOS((Q)ARG0(ti))] = btog(BDY((LIST)ARG1(ti)),p,nb,mod);
1.1 noro 9616: }
9617: for ( t = intred, i=0; t; t = NEXT(t), i++ ) {
9618: printf("%d ",i); fflush(stdout);
9619: ti = BDY((LIST)BDY(t));
1.6 noro 9620: p[j=ZTOS((Q)ARG0(ti))] = btog(BDY((LIST)ARG1(ti)),p,nb,mod);
1.1 noro 9621: }
9622: m = length(ind);
9623: MKMAT(mat,nb,m);
9624: for ( j = 0, t = ind; j < m; j++, t = NEXT(t) )
1.6 noro 9625: for ( i = 0, c = p[ZTOS((Q)BDY(t))]; i < nb; i++ )
1.1 noro 9626: BDY(mat)[i][j] = ndtodp(mod,c[i]);
9627: return mat;
9628: }
9629:
9630: MAT nd_btog_lf(LIST f,LIST v,struct order_spec *ord,LIST tlist,MAT *rp)
9631: {
9632: int i,j,n,m,nb,pi0,pi1,nvar;
9633: VL fv,tv,vv;
9634: NODE permtrace,perm,trace,intred,ind,t,pi,ti;
9635: ND **p;
9636: ND *c;
9637: ND u;
9638: MAT mat;
9639: LM lm;
9640: Z lf,inv;
9641:
9642: parse_nd_option(current_option);
9643: get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc);
9644: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
9645: switch ( ord->id ) {
9646: case 1:
9647: if ( ord->nv != nvar )
9648: error("nd_check : invalid order specification");
9649: break;
9650: default:
9651: break;
9652: }
9653: nd_init_ord(ord);
9654: #if 0
1.6 noro 9655: nd_bpe = ZTOS((Q)ARG7(BDY(tlist)));
1.1 noro 9656: #else
9657: nd_bpe = 32;
9658: #endif
9659: nd_setup_parameters(nvar,0);
9660: permtrace = BDY((LIST)ARG2(BDY(tlist)));
9661: intred = BDY((LIST)ARG3(BDY(tlist)));
9662: ind = BDY((LIST)ARG4(BDY(tlist)));
9663: perm = BDY((LIST)BDY(permtrace)); trace =NEXT(permtrace);
9664: for ( i = length(perm)-1, t = trace; t; t = NEXT(t) ) {
1.6 noro 9665: j = ZTOS((Q)BDY(BDY((LIST)BDY(t))));
1.1 noro 9666: if ( j > i ) i = j;
9667: }
9668: n = i+1;
9669: nb = length(BDY(f));
9670: p = (ND **)MALLOC(n*sizeof(ND *));
9671: for ( t = perm, i = 0; t; t = NEXT(t), i++ ) {
9672: pi = BDY((LIST)BDY(t));
1.6 noro 9673: pi0 = ZTOS((Q)ARG0(pi)); pi1 = ZTOS((Q)ARG1(pi));
1.1 noro 9674: p[pi0] = c = (ND *)MALLOC(nb*sizeof(ND));
9675: simp_ff((Obj)ARG2(pi),(Obj *)&lm); lmtolf(lm,&lf); invz(lf,current_mod_lf,&inv);
9676: u = ptond(CO,vv,(P)ONE);
9677: HCZ(u) = inv;
9678: c[pi1] = u;
9679: }
9680: for ( t = trace,i=0; t; t = NEXT(t), i++ ) {
9681: printf("%d ",i); fflush(stdout);
9682: ti = BDY((LIST)BDY(t));
1.6 noro 9683: p[j=ZTOS((Q)ARG0(ti))] = btog_lf(BDY((LIST)ARG1(ti)),p,nb);
1.1 noro 9684: }
9685: for ( t = intred, i=0; t; t = NEXT(t), i++ ) {
9686: printf("%d ",i); fflush(stdout);
9687: ti = BDY((LIST)BDY(t));
1.6 noro 9688: p[j=ZTOS((Q)ARG0(ti))] = btog_lf(BDY((LIST)ARG1(ti)),p,nb);
1.1 noro 9689: }
9690: m = length(ind);
9691: MKMAT(mat,nb,m);
9692: for ( j = 0, t = ind; j < m; j++, t = NEXT(t) )
1.6 noro 9693: for ( i = 0, c = p[ZTOS((Q)BDY(t))]; i < nb; i++ )
1.1 noro 9694: BDY(mat)[i][j] = ndtodp(-2,c[i]);
9695: return mat;
9696: }
9697:
9698: VECT nd_btog_one(LIST f,LIST v,int mod,struct order_spec *ord,
9699: LIST tlist,int pos,MAT *rp)
9700: {
9701: int i,j,n,m,nb,pi0,pi1,nvar;
9702: VL fv,tv,vv;
9703: NODE permtrace,perm,trace,intred,ind,t,pi,ti;
9704: ND *p;
9705: ND *c;
9706: ND u;
9707: P inv;
9708: VECT vect;
9709:
9710: if ( mod == -2 )
9711: error("nd_btog_one : not implemented yet for a large finite field");
9712:
9713: parse_nd_option(current_option);
9714: get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc);
9715: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
9716: switch ( ord->id ) {
9717: case 1:
9718: if ( ord->nv != nvar )
9719: error("nd_check : invalid order specification");
9720: break;
9721: default:
9722: break;
9723: }
9724: nd_init_ord(ord);
9725: #if 0
1.6 noro 9726: nd_bpe = ZTOS((Q)ARG7(BDY(tlist)));
1.1 noro 9727: #else
9728: nd_bpe = 32;
9729: #endif
9730: nd_setup_parameters(nvar,0);
9731: permtrace = BDY((LIST)ARG2(BDY(tlist)));
9732: intred = BDY((LIST)ARG3(BDY(tlist)));
9733: ind = BDY((LIST)ARG4(BDY(tlist)));
9734: perm = BDY((LIST)BDY(permtrace)); trace =NEXT(permtrace);
9735: for ( i = length(perm)-1, t = trace; t; t = NEXT(t) ) {
1.6 noro 9736: j = ZTOS((Q)BDY(BDY((LIST)BDY(t))));
1.1 noro 9737: if ( j > i ) i = j;
9738: }
9739: n = i+1;
9740: nb = length(BDY(f));
9741: p = (ND *)MALLOC(n*sizeof(ND *));
9742: for ( t = perm, i = 0; t; t = NEXT(t), i++ ) {
9743: pi = BDY((LIST)BDY(t));
1.6 noro 9744: pi0 = ZTOS((Q)ARG0(pi)); pi1 = ZTOS((Q)ARG1(pi));
1.1 noro 9745: if ( pi1 == pos ) {
9746: ptomp(mod,(P)ARG2(pi),&inv);
9747: ((MQ)inv)->cont = invm(((MQ)inv)->cont,mod);
9748: u = ptond(CO,vv,(P)ONE);
9749: HCM(u) = ((MQ)inv)->cont;
9750: p[pi0] = u;
9751: }
9752: }
9753: for ( t = trace,i=0; t; t = NEXT(t), i++ ) {
9754: printf("%d ",i); fflush(stdout);
9755: ti = BDY((LIST)BDY(t));
1.6 noro 9756: p[j=ZTOS((Q)ARG0(ti))] = btog_one(BDY((LIST)ARG1(ti)),p,nb,mod);
1.1 noro 9757: if ( Demand ) {
9758: nd_save_mod(p[j],j); nd_free(p[j]); p[j] = 0;
9759: }
9760: }
9761: for ( t = intred, i=0; t; t = NEXT(t), i++ ) {
9762: printf("%d ",i); fflush(stdout);
9763: ti = BDY((LIST)BDY(t));
1.6 noro 9764: p[j=ZTOS((Q)ARG0(ti))] = btog_one(BDY((LIST)ARG1(ti)),p,nb,mod);
1.1 noro 9765: if ( Demand ) {
9766: nd_save_mod(p[j],j); nd_free(p[j]); p[j] = 0;
9767: }
9768: }
9769: m = length(ind);
9770: MKVECT(vect,m);
9771: for ( j = 0, t = ind; j < m; j++, t = NEXT(t) ) {
1.6 noro 9772: u = p[ZTOS((Q)BDY(t))];
1.1 noro 9773: if ( !u ) {
1.6 noro 9774: u = nd_load_mod(ZTOS((Q)BDY(t)));
1.1 noro 9775: BDY(vect)[j] = ndtodp(mod,u);
9776: nd_free(u);
9777: } else
9778: BDY(vect)[j] = ndtodp(mod,u);
9779: }
9780: return vect;
9781: }
9782:
9783: void ndv_print_lf(NDV p)
9784: {
9785: NMV m;
9786: int i,len;
9787:
9788: if ( !p ) printf("0\n");
9789: else {
9790: len = LEN(p);
9791: for ( m = BDY(p), i = 0; i < len; i++, NMV_ADV(m) ) {
9792: printf("+");
9793: mpz_out_str(asir_out,10,BDY(CZ(m)));
9794: printf("*");
9795: ndl_print(DL(m));
9796: }
9797: printf("\n");
9798: }
9799: }
9800:
9801: void nd_f4_lf_trace(LIST f,LIST v,int trace,int homo,struct order_spec *ord,LIST *rp)
9802: {
9803: VL tv,fv,vv,vc,av;
9804: NODE fd,fd0,in0,in,r,r0,t,s,cand,alist;
9805: int m,nocheck,nvar,mindex,e,max;
9806: NDV c;
9807: NMV a;
9808: P p,zp;
9809: Q dmy;
9810: EPOS oepos;
9811: int obpe,oadv,wmax,i,len,cbpe,ishomo,nalg,mrank,trank,ompos;
9812: Alg alpha,dp;
9813: P poly;
9814: LIST f1,f2,zpl;
9815: Obj obj;
9816: NumberField nf;
9817: struct order_spec *ord1;
9818: struct oEGT eg_check,eg0,eg1;
9819: NODE tr,tl1,tl2,tl3,tl4;
9820: LIST l1,l2,l3,l4,l5;
9821: int *perm;
9822: int j,ret;
9823: NODE retn;
9824: Q jq,bpe;
9825:
9826: nd_module = 0;
9827: parse_nd_option(current_option);
9828: get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc);
9829: if ( nd_vc )
9830: error("nd_f4_lf_trace : computation over a rational function field is not implemented");
9831: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
9832: switch ( ord->id ) {
9833: case 1:
9834: if ( ord->nv != nvar )
9835: error("nd_f4_lf_trace : invalid order specification");
9836: break;
9837: default:
9838: break;
9839: }
9840:
9841: nd_ntrans = nvar;
9842: nd_nalg = 0;
9843:
9844: nocheck = 0;
9845: mindex = 0;
9846:
9847: /* do not use on-demand load/save */
9848: nd_demand = 0;
9849: m = trace > 1 ? trace : get_lprime(mindex);
9850: nd_init_ord(ord);
9851: mrank = 0;
9852: for ( t = BDY(f), max = 1; t; t = NEXT(t) )
9853: for ( tv = vv; tv; tv = NEXT(tv) ) {
9854: if ( nd_module ) {
9855: s = BDY((LIST)BDY(t));
9856: trank = length(s);
9857: mrank = MAX(mrank,trank);
9858: for ( ; s; s = NEXT(s) ) {
9859: e = getdeg(tv->v,(P)BDY(s));
9860: max = MAX(e,max);
9861: }
9862: } else {
9863: e = getdeg(tv->v,(P)BDY(t));
9864: max = MAX(e,max);
9865: }
9866: }
9867: nd_setup_parameters(nvar,max);
9868: obpe = nd_bpe; oadv = nmv_adv; oepos = nd_epos; ompos = nd_mpos;
9869: ishomo = 1;
9870: /* XXX */
9871: for ( in0 = 0, fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
9872: if ( nd_module ) {
9873: c = (pointer)pltondv(CO,vv,(LIST)BDY(t));
9874: } else {
9875: c = (pointer)ptondv(CO,vv,(P)BDY(t));
9876: }
9877: if ( ishomo )
9878: ishomo = ishomo && ndv_ishomo(c);
9879: if ( c ) {
9880: NEXTNODE(fd0,fd); BDY(fd) = (pointer)ndv_dup(0,c);
9881: ndv_mod(-2,c);
9882: NEXTNODE(in0,in); BDY(in) = (pointer)c;
9883: }
9884: }
9885: if ( in0 ) NEXT(in) = 0;
9886: if ( fd0 ) NEXT(fd) = 0;
9887: if ( !ishomo && homo ) {
9888: for ( t = in0, wmax = max; t; t = NEXT(t) ) {
9889: c = (NDV)BDY(t); len = LEN(c);
9890: for ( a = BDY(c), i = 0; i < len; i++, NMV_ADV(a) )
9891: wmax = MAX(TD(DL(a)),wmax);
9892: }
9893: homogenize_order(ord,nvar,&ord1);
9894: nd_init_ord(ord1);
9895: nd_setup_parameters(nvar+1,wmax);
9896: for ( t = fd0; t; t = NEXT(t) )
9897: ndv_homogenize((NDV)BDY(t),obpe,oadv,oepos,ompos);
9898: }
9899: if ( MaxDeg > 0 ) nocheck = 1;
1.24 ! noro 9900: ret = ndv_setup(-2,m,fd0,nd_gbblock?1:0,0,0);
1.1 noro 9901: if ( ret )
9902: cand = nd_f4_lf_trace_main(m,&perm);
9903: if ( !ret || !cand ) {
9904: *rp = 0; return;
9905: }
9906: if ( !ishomo && homo ) {
9907: /* dehomogenization */
9908: for ( t = cand; t; t = NEXT(t) ) ndv_dehomogenize((NDV)BDY(t),ord);
9909: nd_init_ord(ord);
9910: nd_setup_parameters(nvar,0);
9911: }
9912: cand = ndv_reducebase(cand,perm);
9913: cand = ndv_reduceall(-2,cand);
9914: cbpe = nd_bpe;
9915: get_eg(&eg0);
9916: if ( (ret = ndv_check_membership(-2,in0,obpe,oadv,oepos,cand)) != 0 ) {
9917: /* gbcheck : cand is a GB of Id(cand) ? */
9918: retn = nd_f4(-2,0,0);
9919: }
9920: if ( !retn ) {
9921: /* failure */
9922: *rp = 0; return;
9923: }
9924: get_eg(&eg1); init_eg(&eg_check); add_eg(&eg_check,&eg0,&eg1);
9925: if ( DP_Print )
1.5 noro 9926: fprintf(asir_out,"check=%.3fsec\n",eg_check.exectime);
1.1 noro 9927: /* dp->p */
9928: nd_bpe = cbpe;
9929: nd_setup_parameters(nd_nvar,0);
9930: for ( r = cand; r; r = NEXT(r) ) {
9931: if ( nd_module ) BDY(r) = ndvtopl(-2,CO,vv,BDY(r),mrank);
9932: else BDY(r) = (pointer)ndvtop(-2,CO,vv,BDY(r));
9933: }
9934: MKLIST(*rp,cand);
9935: }
9936:
9937: NODE nd_f4_lf_trace_main(int m,int **indp)
9938: {
9939: int i,nh,stat,index;
9940: NODE r,rm,g;
9941: ND_pairs d,l,l0,t;
9942: ND spol,red;
9943: NDV nf,redv,nfqv,nfv;
9944: NM s0,s;
9945: NODE rp0,srp0,nflist,nflist_lf;
9946: int nsp,nred,col,rank,len,k,j,a;
9947: UINT c;
9948: UINT **spmat;
9949: UINT *s0vect,*svect,*p,*v;
9950: int *colstat;
9951: IndArray *imat;
9952: int *rhead;
9953: int spcol,sprow;
9954: int sugar;
9955: PGeoBucket bucket;
9956: struct oEGT eg0,eg1,eg_f4;
9957:
9958: g = 0; d = 0;
9959: for ( i = 0; i < nd_psn; i++ ) {
9960: d = update_pairs(d,g,i,0);
9961: g = update_base(g,i);
9962: }
9963: while ( d ) {
9964: get_eg(&eg0);
9965: l = nd_minsugarp(d,&d);
9966: sugar = SG(l);
9967: if ( MaxDeg > 0 && sugar > MaxDeg ) break;
9968: bucket = create_pbucket();
9969: stat = nd_sp_f4(m,0,l,bucket);
9970: if ( !stat ) {
9971: for ( t = l; NEXT(t); t = NEXT(t) );
9972: NEXT(t) = d; d = l;
9973: d = nd_reconstruct(1,d);
9974: continue;
9975: }
9976: if ( bucket->m < 0 ) continue;
9977: col = nd_symbolic_preproc(bucket,0,&s0vect,&rp0);
9978: if ( !col ) {
9979: for ( t = l; NEXT(t); t = NEXT(t) );
9980: NEXT(t) = d; d = l;
9981: d = nd_reconstruct(1,d);
9982: continue;
9983: }
9984: get_eg(&eg1); init_eg(&eg_f4); add_eg(&eg_f4,&eg0,&eg1);
9985: if ( DP_Print )
1.5 noro 9986: fprintf(asir_out,"\nsugar=%d,symb=%.3fsec,",sugar,eg_f4.exectime);
1.1 noro 9987: nflist = nd_f4_red(m,l,0,s0vect,col,rp0,&l0);
9988: if ( !l0 ) continue;
9989: l = l0;
9990:
9991: /* over LF */
9992: bucket = create_pbucket();
9993: stat = nd_sp_f4(-2,1,l,bucket);
9994: if ( !stat ) {
9995: for ( t = l; NEXT(t); t = NEXT(t) );
9996: NEXT(t) = d; d = l;
9997: d = nd_reconstruct(1,d);
9998: continue;
9999: }
10000: if ( bucket->m < 0 ) continue;
10001: col = nd_symbolic_preproc(bucket,1,&s0vect,&rp0);
10002: if ( !col ) {
10003: for ( t = l; NEXT(t); t = NEXT(t) );
10004: NEXT(t) = d; d = l;
10005: d = nd_reconstruct(1,d);
10006: continue;
10007: }
10008: nflist_lf = nd_f4_red(-2,l,1,s0vect,col,rp0,0);
10009: /* adding new bases */
10010: for ( rm = nflist, r = nflist_lf; r && rm; rm = NEXT(rm), r = NEXT(r) ) {
10011: nfv = (NDV)BDY(rm);
10012: nfqv = (NDV)BDY(r);
10013: if ( DL_COMPARE(HDL(nfv),HDL(nfqv)) ) return 0;
10014: ndv_removecont(m,nfv);
10015: ndv_removecont(-2,nfqv);
1.24 ! noro 10016: nh = ndv_newps(-2,nfv,nfqv);
1.1 noro 10017: d = update_pairs(d,g,nh,0);
10018: g = update_base(g,nh);
10019: }
10020: if ( r || rm ) return 0;
10021: }
10022: conv_ilist(nd_demand,1,g,indp);
10023: return g;
10024: }
10025:
1.7 noro 10026: #if SIZEOF_LONG==8
10027:
10028: NDV vect64_to_ndv(mp_limb_t *vect,int spcol,int col,int *rhead,UINT *s0vect)
10029: {
10030: int j,k,len;
10031: UINT *p;
10032: UINT c;
10033: NDV r;
10034: NMV mr0,mr;
10035:
10036: for ( j = 0, len = 0; j < spcol; j++ ) if ( vect[j] ) len++;
10037: if ( !len ) return 0;
10038: else {
10039: mr0 = (NMV)MALLOC_ATOMIC_IGNORE_OFF_PAGE(nmv_adv*len);
10040: #if 0
10041: ndv_alloc += nmv_adv*len;
10042: #endif
10043: mr = mr0;
10044: p = s0vect;
10045: for ( j = k = 0; j < col; j++, p += nd_wpd )
10046: if ( !rhead[j] ) {
10047: if ( (c = (UINT)vect[k++]) != 0 ) {
10048: ndl_copy(p,DL(mr)); CM(mr) = c; NMV_ADV(mr);
10049: }
10050: }
10051: MKNDV(nd_nvar,mr0,len,r);
10052: return r;
10053: }
10054: }
10055:
10056: int nd_to_vect64(int mod,UINT *s0,int n,ND d,mp_limb_t *r)
10057: {
10058: NM m;
1.11 noro 10059: UINT *t,*s,*u;
10060: int i,st,ed,md,prev,c;
1.7 noro 10061:
10062: for ( i = 0; i < n; i++ ) r[i] = 0;
1.11 noro 10063: prev = 0;
10064: for ( i = 0, m = BDY(d); m; m = NEXT(m) ) {
10065: t = DL(m);
10066: st = prev;
10067: ed = n;
10068: while ( ed > st ) {
10069: md = (st+ed)/2;
10070: u = s0+md*nd_wpd;
10071: c = DL_COMPARE(u,t);
10072: if ( c == 0 ) break;
10073: else if ( c > 0 ) st = md;
10074: else ed = md;
10075: }
10076: r[md] = (mp_limb_t)CM(m);
10077: prev = md;
1.7 noro 10078: }
10079: for ( i = 0; !r[i]; i++ );
10080: return i;
10081: }
10082:
10083: #define MOD128(a,c,m) ((a)=(((c)!=0||((a)>=(m)))?(((((U128)(c))<<64)+(a))%(m)):(a)))
10084:
10085: int ndv_reduce_vect64(int m,mp_limb_t *svect,mp_limb_t *cvect,int col,IndArray *imat,NM_ind_pair *rp0,int nred)
10086: {
10087: int i,j,k,len,pos,prev;
10088: mp_limb_t a,c,c1,c2;
10089: IndArray ivect;
10090: unsigned char *ivc;
10091: unsigned short *ivs;
10092: unsigned int *ivi;
10093: NDV redv;
10094: NMV mr;
10095: NODE rp;
10096: int maxrs;
10097:
10098: for ( i = 0; i < col; i++ ) cvect[i] = 0;
10099: maxrs = 0;
10100: for ( i = 0; i < nred; i++ ) {
10101: ivect = imat[i];
10102: k = ivect->head;
10103: a = svect[k]; c = cvect[k];
10104: MOD128(a,c,m);
10105: svect[k] = a; cvect[k] = 0;
10106: if ( (c = svect[k]) != 0 ) {
1.11 noro 10107: Nf4_red++;
1.7 noro 10108: maxrs = MAX(maxrs,rp0[i]->sugar);
10109: c = m-c; redv = nd_ps[rp0[i]->index];
10110: len = LEN(redv); mr = BDY(redv);
10111: svect[k] = 0; prev = k;
10112: switch ( ivect->width ) {
10113: case 1:
10114: ivc = ivect->index.c;
10115: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
10116: pos = prev+ivc[j]; c1 = CM(mr); prev = pos;
1.12 noro 10117: c2 = svect[pos]+c1*c;
10118: if ( c2 < svect[pos] ) cvect[pos]++;
10119: svect[pos] = c2;
1.7 noro 10120: }
10121: break;
10122: case 2:
10123: ivs = ivect->index.s;
10124: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
10125: pos = prev+ivs[j]; c1 = CM(mr); prev = pos;
1.12 noro 10126: c2 = svect[pos]+c1*c;
10127: if ( c2 < svect[pos] ) cvect[pos]++;
10128: svect[pos] = c2;
1.7 noro 10129: }
10130: break;
10131: case 4:
10132: ivi = ivect->index.i;
10133: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
10134: pos = prev+ivi[j]; c1 = CM(mr); prev = pos;
1.12 noro 10135: c2 = svect[pos]+c1*c;
10136: if ( c2 < svect[pos] ) cvect[pos]++;
10137: svect[pos] = c2;
1.7 noro 10138: }
10139: break;
10140: }
10141: }
10142: }
10143: for ( i = 0; i < col; i++ ) {
10144: a = svect[i]; c = cvect[i]; MOD128(a,c,m); svect[i] = a;
10145: }
10146: return maxrs;
10147: }
10148:
10149: /* for Fp, 2^15=<p<2^29 */
10150:
10151: NODE nd_f4_red_mod64_main(int m,ND_pairs sp0,int nsp,UINT *s0vect,int col,
10152: NM_ind_pair *rvect,int *rhead,IndArray *imat,int nred,ND_pairs *nz)
10153: {
10154: int spcol,sprow,a;
10155: int i,j,k,l,rank;
10156: NODE r0,r;
10157: ND_pairs sp;
10158: ND spol;
10159: mp_limb_t **spmat;
10160: mp_limb_t *svect,*cvect;
10161: mp_limb_t *v;
10162: int *colstat;
10163: struct oEGT eg0,eg1,eg2,eg_f4,eg_f4_1,eg_f4_2;
10164: int maxrs;
10165: int *spsugar;
10166: ND_pairs *spactive;
10167:
10168: spcol = col-nred;
10169: get_eg(&eg0);
10170: /* elimination (1st step) */
10171: spmat = (mp_limb_t **)MALLOC(nsp*sizeof(mp_limb_t *));
10172: svect = (mp_limb_t *)MALLOC(col*sizeof(mp_limb_t));
10173: cvect = (mp_limb_t *)MALLOC(col*sizeof(mp_limb_t));
10174: spsugar = (int *)MALLOC(nsp*sizeof(int));
10175: spactive = !nz?0:(ND_pairs *)MALLOC(nsp*sizeof(ND_pairs));
10176: for ( a = sprow = 0, sp = sp0; a < nsp; a++, sp = NEXT(sp) ) {
10177: nd_sp(m,0,sp,&spol);
10178: if ( !spol ) continue;
10179: nd_to_vect64(m,s0vect,col,spol,svect);
10180: maxrs = ndv_reduce_vect64(m,svect,cvect,col,imat,rvect,nred);
10181: for ( i = 0; i < col; i++ ) if ( svect[i] ) break;
10182: if ( i < col ) {
10183: spmat[sprow] = v = (mp_limb_t *)MALLOC_ATOMIC(spcol*sizeof(mp_limb_t));
10184: for ( j = k = 0; j < col; j++ )
10185: if ( !rhead[j] ) v[k++] = (UINT)svect[j];
10186: spsugar[sprow] = MAX(maxrs,SG(spol));
10187: if ( nz )
10188: spactive[sprow] = sp;
10189: sprow++;
10190: }
10191: nd_free(spol);
10192: }
1.12 noro 10193: get_eg(&eg1); init_eg(&eg_f4_1); add_eg(&eg_f4_1,&eg0,&eg1); add_eg(&f4_elim1,&eg0,&eg1);
1.7 noro 10194: if ( DP_Print ) {
10195: fprintf(asir_out,"elim1=%.3fsec,",eg_f4_1.exectime);
10196: fflush(asir_out);
10197: }
10198: /* free index arrays */
10199: for ( i = 0; i < nred; i++ ) GCFREE(imat[i]->index.c);
10200:
10201: /* elimination (2nd step) */
10202: colstat = (int *)MALLOC(spcol*sizeof(int));
10203: rank = nd_gauss_elim_mod64(spmat,spsugar,spactive,sprow,spcol,m,colstat);
10204: r0 = 0;
10205: for ( i = 0; i < rank; i++ ) {
10206: NEXTNODE(r0,r); BDY(r) =
10207: (pointer)vect64_to_ndv(spmat[i],spcol,col,rhead,s0vect);
10208: SG((NDV)BDY(r)) = spsugar[i];
10209: GCFREE(spmat[i]);
10210: }
10211: if ( r0 ) NEXT(r) = 0;
10212:
10213: for ( ; i < sprow; i++ ) GCFREE(spmat[i]);
1.12 noro 10214: get_eg(&eg2); init_eg(&eg_f4_2); add_eg(&eg_f4_2,&eg1,&eg2); add_eg(&f4_elim2,&eg1,&eg2);
1.7 noro 10215: init_eg(&eg_f4); add_eg(&eg_f4,&eg0,&eg2);
10216: if ( DP_Print ) {
10217: fprintf(asir_out,"elim2=%.3fsec,",eg_f4_2.exectime);
10218: fprintf(asir_out,"nsp=%d,nred=%d,spmat=(%d,%d),rank=%d ",
10219: nsp,nred,sprow,spcol,rank);
10220: fprintf(asir_out,"%.3fsec,",eg_f4.exectime);
10221: }
10222: if ( nz ) {
10223: for ( i = 0; i < rank-1; i++ ) NEXT(spactive[i]) = spactive[i+1];
10224: if ( rank > 0 ) {
10225: NEXT(spactive[rank-1]) = 0;
10226: *nz = spactive[0];
10227: } else
10228: *nz = 0;
10229: }
10230: return r0;
10231: }
10232:
10233: int nd_gauss_elim_mod64(mp_limb_t **mat,int *sugar,ND_pairs *spactive,int row,int col,int md,int *colstat)
10234: {
10235: int i,j,k,l,rank,s;
10236: mp_limb_t inv;
10237: mp_limb_t a;
10238: UINT c;
10239: mp_limb_t *t,*pivot,*pk;
10240: UINT *ck;
10241: UINT **cmat;
10242: UINT *ct;
10243: ND_pairs pair;
10244:
10245: cmat = (UINT **)MALLOC(row*sizeof(UINT *));
10246: for ( i = 0; i < row; i++ ) {
10247: cmat[i] = MALLOC_ATOMIC(col*sizeof(UINT));
10248: bzero(cmat[i],col*sizeof(UINT));
10249: }
10250:
10251: for ( rank = 0, j = 0; j < col; j++ ) {
10252: for ( i = rank; i < row; i++ ) {
10253: a = mat[i][j]; c = cmat[i][j];
10254: MOD128(a,c,md);
10255: mat[i][j] = a; cmat[i][j] = 0;
10256: }
10257: for ( i = rank; i < row; i++ )
10258: if ( mat[i][j] )
10259: break;
10260: if ( i == row ) {
10261: colstat[j] = 0;
10262: continue;
10263: } else
10264: colstat[j] = 1;
10265: if ( i != rank ) {
10266: t = mat[i]; mat[i] = mat[rank]; mat[rank] = t;
10267: ct = cmat[i]; cmat[i] = cmat[rank]; cmat[rank] = ct;
10268: s = sugar[i]; sugar[i] = sugar[rank]; sugar[rank] = s;
10269: if ( spactive ) {
10270: pair = spactive[i]; spactive[i] = spactive[rank];
10271: spactive[rank] = pair;
10272: }
10273: }
10274: /* column j is normalized */
10275: s = sugar[rank];
10276: inv = invm((UINT)mat[rank][j],md);
10277: /* normalize pivot row */
10278: for ( k = j, pk = mat[rank]+j, ck = cmat[rank]+j; k < col; k++, pk++, ck++ ) {
10279: a = *pk; c = *ck; MOD128(a,c,md); *pk = (a*inv)%md; *ck = 0;
10280: }
10281: for ( i = rank+1; i < row; i++ ) {
10282: if ( (a = mat[i][j]) != 0 ) {
10283: sugar[i] = MAX(sugar[i],s);
10284: red_by_vect64(md,mat[i]+j,cmat[i]+j,mat[rank]+j,(int)(md-a),col-j);
1.11 noro 10285: Nf4_red++;
1.7 noro 10286: }
10287: }
10288: rank++;
10289: }
10290: for ( j = col-1, l = rank-1; j >= 0; j-- )
10291: if ( colstat[j] ) {
10292: for ( k = j, pk = mat[l]+j, ck = cmat[l]+j; k < col; k++, pk++, ck++ ) {
10293: a = *pk; c = *ck; MOD128(a,c,md); *pk = a; *ck = 0;
10294: }
10295: s = sugar[l];
10296: for ( i = 0; i < l; i++ ) {
10297: a = mat[i][j]; c = cmat[i][j]; MOD128(a,c,md); mat[i][j] = a; cmat[i][j] = 0;
10298: if ( a ) {
10299: sugar[i] = MAX(sugar[i],s);
10300: red_by_vect64(md,mat[i]+j,cmat[i]+j,mat[l]+j,(int)(md-a),col-j);
1.11 noro 10301: Nf4_red++;
1.7 noro 10302: }
10303: }
10304: l--;
10305: }
10306: for ( i = 0; i < row; i++ ) GCFREE(cmat[i]);
10307: GCFREE(cmat);
10308: return rank;
10309: }
10310: #endif
10311:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>