=================================================================== RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/dp-supp.c,v retrieving revision 1.55 retrieving revision 1.62 diff -u -p -r1.55 -r1.62 --- OpenXM_contrib2/asir2000/builtin/dp-supp.c 2009/10/09 04:02:11 1.55 +++ OpenXM_contrib2/asir2000/builtin/dp-supp.c 2016/03/31 01:40:10 1.62 @@ -45,7 +45,7 @@ * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE. * - * $OpenXM: OpenXM_contrib2/asir2000/builtin/dp-supp.c,v 1.54 2009/06/01 07:31:54 noro Exp $ + * $OpenXM: OpenXM_contrib2/asir2000/builtin/dp-supp.c,v 1.61 2015/08/14 13:51:54 fujimoto Exp $ */ #include "ca.h" #include "base.h" @@ -651,11 +651,11 @@ void dp_sp(DP p1,DP p2,DP *rp) LIST hist; NODE node; - node = mknode(4,ONE,0,s1,ONE); + node = mknode(4,ONE,NULLP,s1,ONE); MKLIST(hist,node); MKNODE(TraceList,hist,0); - node = mknode(4,ONE,0,0,ONE); + node = mknode(4,ONE,NULLP,NULLP,ONE); chsgnd(s2,(DP *)&ARG2(node)); MKLIST(hist,node); MKNODE(node,hist,TraceList); TraceList = node; @@ -704,11 +704,11 @@ void _dp_sp_dup(DP p1,DP p2,DP *rp) LIST hist; NODE node; - node = mknode(4,ONE,0,s1,ONE); + node = mknode(4,ONE,NULLP,s1,ONE); MKLIST(hist,node); MKNODE(TraceList,hist,0); - node = mknode(4,ONE,0,0,ONE); + node = mknode(4,ONE,NULLP,NULLP,ONE); chsgnd(s2,(DP *)&ARG2(node)); MKLIST(hist,node); MKNODE(node,hist,TraceList); TraceList = node; @@ -1249,7 +1249,7 @@ DP *dp_true_nf_and_quotient_marked (NODE b,DP g,DP *ps dn = (P)ONE; if ( !g ) { - *rp = 0; *dnp = dn; return; + *rp = 0; *dnp = dn; return 0; } for ( n = 0, l = b; l; l = NEXT(l), n++ ); wb = (int *)ALLOCA(n*sizeof(int)); @@ -1306,7 +1306,7 @@ DP *dp_true_nf_and_quotient_marked_mod(NODE b,DP g,DP for ( i = 0; i < n; i++ ) q[i] = 0; dn = (P)ONEM; if ( !g ) { - *rp = 0; *dnp = dn; return; + *rp = 0; *dnp = dn; return 0; } wb = (int *)ALLOCA(n*sizeof(int)); for ( i = 0, l = b; i < n; l = NEXT(l), i++ ) @@ -1735,10 +1735,11 @@ void dp_nf_tab_f(DP p,LIST *tab,DP *rp) int create_order_spec(VL vl,Obj obj,struct order_spec **specp) { - int i,j,n,s,row,col,ret; + int i,j,n,s,row,col,ret,wlen; struct order_spec *spec; struct order_pair *l; - NODE node,t,tn; + Obj wp,wm; + NODE node,t,tn,wpair; MAT m; VECT v; pointer **b,*bv; @@ -1757,35 +1758,71 @@ int create_order_spec(VL vl,Obj obj,struct order_spec spec->ord.simple = QTOS((Q)obj); return 1; } else if ( OID(obj) == O_LIST ) { + /* module order; obj = [0|1,w,ord] or [0|1,ord] */ node = BDY((LIST)obj); if ( !BDY(node) || NUM(BDY(node)) ) { - if ( length(node) < 2 ) - error("create_order_spec : invalid argument"); - create_order_spec(0,(Obj)BDY(NEXT(node)),&spec); - spec->id += 256; spec->obj = obj; - spec->ispot = (BDY(node)!=0); - if ( spec->ispot ) { - n = QTOS((Q)BDY(node)); - if ( n < 0 ) - spec->pot_nelim = -n; - else - spec->pot_nelim = 0; - } + switch ( length(node) ) { + case 2: + create_order_spec(0,(Obj)BDY(NEXT(node)),&spec); + spec->id += 256; spec->obj = obj; + spec->top_weight = 0; + spec->module_rank = 0; + spec->module_top_weight = 0; + spec->ispot = (BDY(node)!=0); + if ( spec->ispot ) { + n = QTOS((Q)BDY(node)); + if ( n < 0 ) + spec->pot_nelim = -n; + else + spec->pot_nelim = 0; + } + break; + + case 3: + create_order_spec(0,(Obj)BDY(NEXT(NEXT(node))),&spec); + spec->id += 256; spec->obj = obj; + spec->ispot = (BDY(node)!=0); + node = NEXT(node); + if ( !BDY(node) || OID(BDY(node)) != O_LIST ) + error("create_order_spec : [weight_for_poly,weight_for_modlue] must be specified as a module topweight"); + wpair = BDY((LIST)BDY(node)); + if ( length(wpair) != 2 ) + error("create_order_spec : [weight_for_poly,weight_for_modlue] must be specified as a module topweight"); + + wp = BDY(wpair); + wm = BDY(NEXT(wpair)); + if ( !wp || OID(wp) != O_LIST || !wm || OID(wm) != O_LIST ) + error("create_order_spec : [weight_for_poly,weight_for_modlue] must be specified as a module topweight"); + spec->nv = length(BDY((LIST)wp)); + spec->top_weight = (int *)MALLOC_ATOMIC(spec->nv*sizeof(int)); + for ( i = 0, t = BDY((LIST)wp); i < spec->nv; t = NEXT(t), i++ ) + spec->top_weight[i] = QTOS((Q)BDY(t)); + + spec->module_rank = length(BDY((LIST)wm)); + spec->module_top_weight = (int *)MALLOC_ATOMIC(spec->module_rank*sizeof(int)); + for ( i = 0, t = BDY((LIST)wm); i < spec->module_rank; t = NEXT(t), i++ ) + spec->module_top_weight[i] = QTOS((Q)BDY(t)); + break; + default: + error("create_order_spec : invalid arguments for module order"); + } + *specp = spec; return 1; - } - - for ( n = 0, t = node; t; t = NEXT(t), n++ ); - l = (struct order_pair *)MALLOC_ATOMIC(n*sizeof(struct order_pair)); - for ( i = 0, t = node, s = 0; i < n; t = NEXT(t), i++ ) { - tn = BDY((LIST)BDY(t)); l[i].order = QTOS((Q)BDY(tn)); - tn = NEXT(tn); l[i].length = QTOS((Q)BDY(tn)); - s += l[i].length; - } - spec->id = 1; spec->obj = obj; - spec->ord.block.order_pair = l; - spec->ord.block.length = n; spec->nv = s; - return 1; + } else { + /* block order in polynomial ring */ + for ( n = 0, t = node; t; t = NEXT(t), n++ ); + l = (struct order_pair *)MALLOC_ATOMIC(n*sizeof(struct order_pair)); + for ( i = 0, t = node, s = 0; i < n; t = NEXT(t), i++ ) { + tn = BDY((LIST)BDY(t)); l[i].order = QTOS((Q)BDY(tn)); + tn = NEXT(tn); l[i].length = QTOS((Q)BDY(tn)); + s += l[i].length; + } + spec->id = 1; spec->obj = obj; + spec->ord.block.order_pair = l; + spec->ord.block.length = n; spec->nv = s; + return 1; + } } else if ( OID(obj) == O_MAT ) { m = (MAT)obj; row = m->row; col = m->col; b = BDY(m); w = almat(row,col); @@ -2365,9 +2402,12 @@ void qltozl(Q *w,int n,Q *dvr) v.id = O_VECT; v.len = n; v.body = (pointer *)w; igcdv(&v,dvr); return; } - c = w[0]; nm = NM(c); dn = INT(c) ? ONEN : DN(c); - for ( i = 1; i < n; i++ ) { - c = w[i]; l1 = INT(c) ? ONEN : DN(c); + for ( i = 0; !w[i]; i++ ); + c = w[i]; nm = NM(c); dn = INT(c) ? ONEN : DN(c); + for ( i++; i < n; i++ ) { + c = w[i]; + if ( !c ) continue; + l1 = INT(c) ? ONEN : DN(c); gcdn(nm,NM(c),&g); nm = g; gcdn(dn,l1,&l2); muln(dn,l1,&l3); divsn(l3,l2,&dn); } @@ -3040,6 +3080,90 @@ NODE compute_essential_df(DP *g,DP *gh,int ng) } MKNODE(r1,0,ri); MKLIST(l,r1); BDY(rt) = (pointer)l; + } + return r; +} + +int comp_bits_divisible(int *a,int *b,int n) +{ + int bpi,i,wi,bi; + + bpi = (sizeof(int)/sizeof(char))*8; + for ( i = 0; i < n; i++ ) { + wi = i/bpi; bi = i%bpi; + if ( !(a[wi]&(1< bb ) return 1; + else if ( ba < bb ) return -1; + } + return 0; +} + +NODE mono_raddec(NODE ideal) +{ + DP p; + int nv,w,i,bpi,di,c,len; + int *d,*s,*u,*new; + NODE t,t1,v,r,rem,prev; + + if( !ideal ) return 0; + p = (DP)BDY(ideal); + nv = NV(p); + bpi = (sizeof(int)/sizeof(char))*8; + w = (nv+(bpi-1))/bpi; + d = p->body->dl->d; + if ( !NEXT(ideal) ) { + for ( t = 0, i = nv-1; i >= 0; i-- ) { + if ( d[i] ) { + s = (int *)CALLOC(w,sizeof(int)); + s[i/bpi] |= 1<<(i%bpi); + MKNODE(t1,s,t); + t = t1; + } + } + return t; + } + rem = mono_raddec(NEXT(ideal)); + r = 0; + len = w*sizeof(int); + u = (int *)CALLOC(w,sizeof(int)); + for ( i = nv-1; i >= 0; i-- ) { + if ( d[i] ) { + for ( t = rem; t; t = NEXT(t) ) { + bcopy((char *)BDY(t),(char *)u,len); + u[i/bpi] |= 1<<(i%bpi); + for ( v = r; v; v = NEXT(v) ) { + if ( comp_bits_divisible(u,(int *)BDY(v),nv) ) break; + } + if ( v ) continue; + for ( v = r, prev = 0; v; v = NEXT(v) ) { + if ( comp_bits_divisible((int *)BDY(v),u,nv) ) { + if ( prev ) NEXT(prev) = NEXT(v); + else r = NEXT(r); + } else prev =v; + } + for ( v = r, prev = 0; v; prev = v, v = NEXT(v) ) { + if ( comp_bits_lex(u,(int *)BDY(v),nv) < 0 ) break; + } + new = (int *)CALLOC(w,sizeof(int)); + bcopy((char *)u,(char *)new,len); + MKNODE(t1,new,v); + if ( prev ) NEXT(prev) = t1; + else r = t1; + } + } } return r; }