| version 1.29, 2004/02/09 08:23:29 | version 1.40, 2006/12/12 11:50:37 | 
|  |  | 
| * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, | * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, | 
| * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE. | * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE. | 
| * | * | 
| * $OpenXM: OpenXM_contrib2/asir2000/builtin/dp-supp.c,v 1.28 2004/02/05 08:28:53 noro Exp $ | * $OpenXM: OpenXM_contrib2/asir2000/builtin/dp-supp.c,v 1.39 2005/08/25 18:59:11 ohara Exp $ | 
| */ | */ | 
| #include "ca.h" | #include "ca.h" | 
| #include "base.h" | #include "base.h" | 
| 
| Line 62  extern int NoGCD; |  | 
| Line 62  extern int NoGCD; |  | 
| extern int GenTrace; | extern int GenTrace; | 
| extern NODE TraceList; | extern NODE TraceList; | 
|  |  | 
|  | int show_orderspec; | 
|  |  | 
|  | void print_composite_order_spec(struct order_spec *spec); | 
|  |  | 
| /* | /* | 
| * content reduction | * content reduction | 
| * | * | 
| 
| Line 118  void dp_ptozp2(DP p0,DP p1,DP *hp,DP *rp) |  | 
| Line 122  void dp_ptozp2(DP p0,DP p1,DP *hp,DP *rp) |  | 
| *hp = h; *rp = r; | *hp = h; *rp = r; | 
| } | } | 
|  |  | 
|  | void dp_ptozp3(DP p,Q *dvr,DP *rp) | 
|  | { | 
|  | MP m,mr,mr0; | 
|  | int i,n; | 
|  | Q *w; | 
|  | P t; | 
|  |  | 
|  | if ( !p ) { | 
|  | *rp = 0; *dvr = 0; | 
|  | }else { | 
|  | for ( m =BDY(p), n = 0; m; m = NEXT(m), n++ ); | 
|  | w = (Q *)ALLOCA(n*sizeof(Q)); | 
|  | for ( m =BDY(p), i = 0; i < n; m = NEXT(m), i++ ) | 
|  | if ( NUM(m->c) ) | 
|  | w[i] = (Q)m->c; | 
|  | else | 
|  | ptozp(m->c,1,&w[i],&t); | 
|  | sortbynm(w,n); | 
|  | qltozl(w,n,dvr); | 
|  | for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) { | 
|  | NEXTMP(mr0,mr); divsp(CO,m->c,(P)(*dvr),&mr->c); mr->dl = m->dl; | 
|  | } | 
|  | NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar; | 
|  | } | 
|  | } | 
|  |  | 
| void dp_idiv(DP p,Q c,DP *rp) | void dp_idiv(DP p,Q c,DP *rp) | 
| { | { | 
| Q t; | Q t; | 
| 
| Line 481  void heu_nezgcdnpz(VL vl,P *pl,int m,P *pr) |  | 
| Line 511  void heu_nezgcdnpz(VL vl,P *pl,int m,P *pr) |  | 
| int i,r; | int i,r; | 
| P gcd,t,s1,s2,u; | P gcd,t,s1,s2,u; | 
| Q rq; | Q rq; | 
|  | DCP dc; | 
|  | extern int DP_Print; | 
|  |  | 
| while ( 1 ) { | while ( 1 ) { | 
| for ( i = 0, s1 = 0; i < m; i++ ) { | for ( i = 0, s1 = 0; i < m; i++ ) { | 
| r = random(); UTOQ(r,rq); | r = random(); UTOQ(r,rq); | 
| 
| Line 492  void heu_nezgcdnpz(VL vl,P *pl,int m,P *pr) |  | 
| Line 524  void heu_nezgcdnpz(VL vl,P *pl,int m,P *pr) |  | 
| mulp(vl,pl[i],(P)rq,&t); addp(vl,s2,t,&u); s2 = u; | mulp(vl,pl[i],(P)rq,&t); addp(vl,s2,t,&u); s2 = u; | 
| } | } | 
| ezgcdp(vl,s1,s2,&gcd); | ezgcdp(vl,s1,s2,&gcd); | 
|  | if ( DP_Print > 2 ) | 
|  | { fprintf(asir_out,"(%d)",nmonop(gcd)); fflush(asir_out); } | 
| for ( i = 0; i < m; i++ ) { | for ( i = 0; i < m; i++ ) { | 
| if ( !divtpz(vl,pl[i],gcd,&t) ) | if ( !divtpz(vl,pl[i],gcd,&t) ) | 
| break; | break; | 
| 
| Line 1311  void dp_nf_tab_f(DP p,LIST *tab,DP *rp) |  | 
| Line 1345  void dp_nf_tab_f(DP p,LIST *tab,DP *rp) |  | 
|  |  | 
| /* | /* | 
| * setting flags | * setting flags | 
|  | * call create_order_spec with vl=0 to set old type order. | 
| * | * | 
| */ | */ | 
|  |  | 
| int create_order_spec(VL vl,Obj obj,struct order_spec **specp) | int create_order_spec(VL vl,Obj obj,struct order_spec **specp) | 
| { | { | 
| int i,j,n,s,row,col; | int i,j,n,s,row,col,ret; | 
| struct order_spec *spec; | struct order_spec *spec; | 
| struct order_pair *l; | struct order_pair *l; | 
| NODE node,t,tn; | NODE node,t,tn; | 
| 
| Line 1324  int create_order_spec(VL vl,Obj obj,struct order_spec |  | 
| Line 1359  int create_order_spec(VL vl,Obj obj,struct order_spec |  | 
| pointer **b; | pointer **b; | 
| int **w; | int **w; | 
|  |  | 
| if ( vl && obj && OID(obj) == O_LIST ) | if ( vl && obj && OID(obj) == O_LIST ) { | 
| return create_composite_order_spec(vl,(LIST)obj,specp); | ret = create_composite_order_spec(vl,(LIST)obj,specp); | 
|  | if ( show_orderspec ) | 
|  | print_composite_order_spec(*specp); | 
|  | return ret; | 
|  | } | 
|  |  | 
| *specp = spec = (struct order_spec *)MALLOC(sizeof(struct order_spec)); | *specp = spec = (struct order_spec *)MALLOC(sizeof(struct order_spec)); | 
| if ( !obj || NUM(obj) ) { | if ( !obj || NUM(obj) ) { | 
| 
| Line 1405  void print_composite_order_spec(struct order_spec *spe |  | 
| Line 1444  void print_composite_order_spec(struct order_spec *spe |  | 
| } | } | 
| } | } | 
|  |  | 
|  | struct order_spec *append_block(struct order_spec *spec, | 
|  | int nv,int nalg,int ord) | 
|  | { | 
|  | MAT m,mat; | 
|  | int i,j,row,col,n; | 
|  | Q **b,**wp; | 
|  | int **w; | 
|  | NODE t,s,s0; | 
|  | struct order_pair *l,*l0; | 
|  | int n0,nv0; | 
|  | LIST list0,list1,list; | 
|  | Q oq,nq; | 
|  | struct order_spec *r; | 
|  |  | 
|  | r = (struct order_spec *)MALLOC(sizeof(struct order_spec)); | 
|  | switch ( spec->id ) { | 
|  | case 0: | 
|  | STOQ(spec->ord.simple,oq); STOQ(nv,nq); | 
|  | t = mknode(2,oq,nq); MKLIST(list0,t); | 
|  | STOQ(ord,oq); STOQ(nalg,nq); | 
|  | t = mknode(2,oq,nq); MKLIST(list1,t); | 
|  | t = mknode(2,list0,list1); MKLIST(list,t); | 
|  | l = (struct order_pair *)MALLOC_ATOMIC(2*sizeof(struct order_pair)); | 
|  | l[0].order = spec->ord.simple; l[0].length = nv; | 
|  | l[1].order = ord; l[1].length = nalg; | 
|  | r->id = 1;  r->obj = (Obj)list; | 
|  | r->ord.block.order_pair = l; | 
|  | r->ord.block.length = 2; | 
|  | r->nv = nv+nalg; | 
|  | break; | 
|  | case 1: | 
|  | if ( spec->nv != nv ) | 
|  | error("append_block : number of variables mismatch"); | 
|  | l0 = spec->ord.block.order_pair; | 
|  | n0 = spec->ord.block.length; | 
|  | nv0 = spec->nv; | 
|  | list0 = (LIST)spec->obj; | 
|  | n = n0+1; | 
|  | l = (struct order_pair *)MALLOC_ATOMIC(n*sizeof(struct order_pair)); | 
|  | for ( i = 0; i < n0; i++ ) | 
|  | l[i] = l0[i]; | 
|  | l[i].order = ord; l[i].length = nalg; | 
|  | for ( t = BDY(list0), s0 = 0; t; t = NEXT(t) ) { | 
|  | NEXTNODE(s0,s); BDY(s) = BDY(t); | 
|  | } | 
|  | STOQ(ord,oq); STOQ(nalg,nq); | 
|  | t = mknode(2,oq,nq); MKLIST(list,t); | 
|  | NEXTNODE(s0,s); BDY(s) = (pointer)list; NEXT(s) = 0; | 
|  | MKLIST(list,s0); | 
|  | r->id = 1;  r->obj = (Obj)list; | 
|  | r->ord.block.order_pair = l; | 
|  | r->ord.block.length = n; | 
|  | r->nv = nv+nalg; | 
|  | break; | 
|  | case 2: | 
|  | if ( spec->nv != nv ) | 
|  | error("append_block : number of variables mismatch"); | 
|  | m = (MAT)spec->obj; | 
|  | row = m->row; col = m->col; b = (Q **)BDY(m); | 
|  | w = almat(row+nalg,col+nalg); | 
|  | MKMAT(mat,row+nalg,col+nalg); wp = (Q **)BDY(mat); | 
|  | for ( i = 0; i < row; i++ ) | 
|  | for ( j = 0; j < col; j++ ) { | 
|  | w[i][j] = QTOS(b[i][j]); | 
|  | wp[i][j] = b[i][j]; | 
|  | } | 
|  | for ( i = 0; i < nalg; i++ ) { | 
|  | w[i+row][i+col] = 1; | 
|  | wp[i+row][i+col] = ONE; | 
|  | } | 
|  | r->id = 2; r->obj = (Obj)mat; | 
|  | r->nv = col+nalg; r->ord.matrix.row = row+nalg; | 
|  | r->ord.matrix.matrix = w; | 
|  | break; | 
|  | case 3: | 
|  | default: | 
|  | /* XXX */ | 
|  | error("append_block : not implemented yet"); | 
|  | } | 
|  | return r; | 
|  | } | 
|  |  | 
|  | int comp_sw(struct sparse_weight *a, struct sparse_weight *b) | 
|  | { | 
|  | if ( a->pos > b->pos ) return 1; | 
|  | else if ( a->pos < b->pos ) return -1; | 
|  | else return 0; | 
|  | } | 
|  |  | 
| /* order = [w_or_b, w_or_b, ... ] */ | /* order = [w_or_b, w_or_b, ... ] */ | 
| /* w_or_b = w or b                */ | /* w_or_b = w or b                */ | 
| /* w = [1,2,...] or [x,1,y,2,...] */ | /* w = [1,2,...] or [x,1,y,2,...] */ | 
| 
| Line 1443  int create_composite_order_spec(VL vl,LIST order,struc |  | 
| Line 1571  int create_composite_order_spec(VL vl,LIST order,struc |  | 
| for ( i = 0; i < l; i++ ) top[i] = 0; | for ( i = 0; i < l; i++ ) top[i] = 0; | 
|  |  | 
| for ( t = wb, i = 0; t; t = NEXT(t), i++ ) { | for ( t = wb, i = 0; t; t = NEXT(t), i++ ) { | 
|  | if ( !BDY(t) || OID((Obj)BDY(t)) != O_LIST ) | 
|  | error("a list of lists must be specified for the key \"order\""); | 
| a = BDY((LIST)BDY(t)); | a = BDY((LIST)BDY(t)); | 
| len = length(a); | len = length(a); | 
| a0 = (Obj)BDY(a); | a0 = (Obj)BDY(a); | 
| if ( !a0 || OID(a0) == O_N ) { | if ( !a0 || OID(a0) == O_N ) { | 
| /* a is a dense weight vector */ | /* a is a dense weight vector */ | 
| dw = (int *)MALLOC(sizeof(int)*len); | dw = (int *)MALLOC(sizeof(int)*len); | 
| for ( j = 0, p = a; j < len; p = NEXT(p), j++ ) | for ( j = 0, p = a; j < len; p = NEXT(p), j++ ) { | 
|  | if ( !INT((Q)BDY(p)) ) | 
|  | error("a dense weight vector must be specified as a list of integers"); | 
| dw[j] = QTOS((Q)BDY(p)); | dw[j] = QTOS((Q)BDY(p)); | 
|  | } | 
| w_or_b[i].type = IS_DENSE_WEIGHT; | w_or_b[i].type = IS_DENSE_WEIGHT; | 
| w_or_b[i].length = len; | w_or_b[i].length = len; | 
| w_or_b[i].body.dense_weight = dw; | w_or_b[i].body.dense_weight = dw; | 
| 
| Line 1465  int create_composite_order_spec(VL vl,LIST order,struc |  | 
| Line 1598  int create_composite_order_spec(VL vl,LIST order,struc |  | 
| sw = (struct sparse_weight *) | sw = (struct sparse_weight *) | 
| MALLOC(sizeof(struct sparse_weight)*len); | MALLOC(sizeof(struct sparse_weight)*len); | 
| for ( j = 0, p = a; j < len; j++ ) { | for ( j = 0, p = a; j < len; j++ ) { | 
|  | if ( !BDY(p) || OID((P)BDY(p)) != O_P ) | 
|  | error("a sparse weight vector must be specified as [var1,weight1,...]"); | 
| v = VR((P)BDY(p)); p = NEXT(p); | v = VR((P)BDY(p)); p = NEXT(p); | 
| for ( tvl = vl, k = 0; tvl && tvl->v != v; | for ( tvl = vl, k = 0; tvl && tvl->v != v; | 
| k++, tvl = NEXT(tvl) ); | k++, tvl = NEXT(tvl) ); | 
| if ( !tvl ) | if ( !tvl ) | 
| error("invalid variable name"); | error("invalid variable name in a sparse weight vector"); | 
| sw[j].pos = k; | sw[j].pos = k; | 
|  | if ( !INT((Q)BDY(p)) ) | 
|  | error("a sparse weight vector must be specified as [var1,weight1,...]"); | 
| sw[j].value = QTOS((Q)BDY(p)); p = NEXT(p); | sw[j].value = QTOS((Q)BDY(p)); p = NEXT(p); | 
| } | } | 
|  | qsort(sw,len,sizeof(struct sparse_weight), | 
|  | (int (*)(const void *,const void *))comp_sw); | 
| w_or_b[i].type = IS_SPARSE_WEIGHT; | w_or_b[i].type = IS_SPARSE_WEIGHT; | 
| w_or_b[i].length = len; | w_or_b[i].length = len; | 
| w_or_b[i].body.sparse_weight = sw; | w_or_b[i].body.sparse_weight = sw; | 
| 
| Line 1522  int create_composite_order_spec(VL vl,LIST order,struc |  | 
| Line 1661  int create_composite_order_spec(VL vl,LIST order,struc |  | 
| for ( start = 0, tvl = vl; tvl->v != VR((P)BDY(a)); | for ( start = 0, tvl = vl; tvl->v != VR((P)BDY(a)); | 
| tvl = NEXT(tvl), start++ ); | tvl = NEXT(tvl), start++ ); | 
| for ( p = NEXT(a), tvl = NEXT(tvl); p; | for ( p = NEXT(a), tvl = NEXT(tvl); p; | 
| p = NEXT(p), tvl = NEXT(tvl) ) | p = NEXT(p), tvl = NEXT(tvl) ) { | 
|  | if ( !BDY(p) || OID((P)BDY(p)) != O_P ) | 
|  | error("a block must be specified as [ordsymbol,var1,var2,...]"); | 
| if ( tvl->v != VR((P)BDY(p)) ) break; | if ( tvl->v != VR((P)BDY(p)) ) break; | 
|  | } | 
| if ( p ) | if ( p ) | 
| error("a block must be contiguous"); | error("a block must be contiguous in the variable list"); | 
| } | } | 
| w_or_b[i].type = IS_BLOCK; | w_or_b[i].type = IS_BLOCK; | 
| w_or_b[i].length = len; | w_or_b[i].length = len; | 
| 
| Line 1552  int create_composite_order_spec(VL vl,LIST order,struc |  | 
| Line 1694  int create_composite_order_spec(VL vl,LIST order,struc |  | 
| w_or_b[n].body.block.order = 0; | w_or_b[n].body.block.order = 0; | 
| spec->ord.composite.length = n+1; | spec->ord.composite.length = n+1; | 
| } | } | 
| if ( 1 ) print_composite_order_spec(spec); |  | 
| } | } | 
|  |  | 
|  | /* module order spec */ | 
|  |  | 
|  | void create_modorder_spec(int id,LIST shift,struct modorder_spec **s) | 
|  | { | 
|  | struct modorder_spec *spec; | 
|  | NODE n,t; | 
|  | LIST list; | 
|  | int *ds; | 
|  | int i,l; | 
|  | Q q; | 
|  |  | 
|  | *s = spec = (struct modorder_spec *)MALLOC(sizeof(struct modorder_spec)); | 
|  | spec->id = id; | 
|  | if ( shift ) { | 
|  | n = BDY(shift); | 
|  | spec->len = l = length(n); | 
|  | spec->degree_shift = ds = (int *)MALLOC_ATOMIC(l*sizeof(int)); | 
|  | for ( t = n, i = 0; t; t = NEXT(t), i++ ) | 
|  | ds[i] = QTOS((Q)BDY(t)); | 
|  | } else { | 
|  | spec->len = 0; | 
|  | spec->degree_shift = 0; | 
|  | } | 
|  | STOQ(id,q); | 
|  | n = mknode(2,q,shift); | 
|  | MKLIST(list,n); | 
|  | spec->obj = (Obj)list; | 
|  | } | 
|  |  | 
| /* | /* | 
| * converters | * converters | 
| * | * | 
| 
| Line 1658  void homogenize_order(struct order_spec *old,int n,str |  | 
| Line 1828  void homogenize_order(struct order_spec *old,int n,str |  | 
| int length,nv,row,i,j; | int length,nv,row,i,j; | 
| int **newm,**oldm; | int **newm,**oldm; | 
| struct order_spec *new; | struct order_spec *new; | 
|  | int onv,nnv,nlen,olen,owlen; | 
|  | struct weight_or_block *owb,*nwb; | 
|  |  | 
| *newp = new = (struct order_spec *)MALLOC(sizeof(struct order_spec)); | *newp = new = (struct order_spec *)MALLOC(sizeof(struct order_spec)); | 
| switch ( old->id ) { | switch ( old->id ) { | 
| 
| Line 1708  void homogenize_order(struct order_spec *old,int n,str |  | 
| Line 1880  void homogenize_order(struct order_spec *old,int n,str |  | 
| new->id = 2; new->nv = nv+1; | new->id = 2; new->nv = nv+1; | 
| new->ord.matrix.row = row+1; new->ord.matrix.matrix = newm; | new->ord.matrix.row = row+1; new->ord.matrix.matrix = newm; | 
| break; | break; | 
|  | case 3: | 
|  | onv = old->nv; | 
|  | nnv = onv+1; | 
|  | olen = old->ord.composite.length; | 
|  | nlen = olen+1; | 
|  | owb = old->ord.composite.w_or_b; | 
|  | nwb = (struct weight_or_block *) | 
|  | MALLOC(nlen*sizeof(struct weight_or_block)); | 
|  | for ( i = 0; i < olen; i++ ) { | 
|  | nwb[i].type = owb[i].type; | 
|  | switch ( owb[i].type ) { | 
|  | case IS_DENSE_WEIGHT: | 
|  | owlen = owb[i].length; | 
|  | nwb[i].length = owlen+1; | 
|  | nwb[i].body.dense_weight = (int *)MALLOC((owlen+1)*sizeof(int)); | 
|  | for ( j = 0; j < owlen; j++ ) | 
|  | nwb[i].body.dense_weight[j] = owb[i].body.dense_weight[j]; | 
|  | nwb[i].body.dense_weight[owlen] = 0; | 
|  | break; | 
|  | case IS_SPARSE_WEIGHT: | 
|  | nwb[i].length = owb[i].length; | 
|  | nwb[i].body.sparse_weight = owb[i].body.sparse_weight; | 
|  | break; | 
|  | case IS_BLOCK: | 
|  | nwb[i].length = owb[i].length; | 
|  | nwb[i].body.block = owb[i].body.block; | 
|  | break; | 
|  | } | 
|  | } | 
|  | nwb[i].type = IS_SPARSE_WEIGHT; | 
|  | nwb[i].body.sparse_weight = | 
|  | (struct sparse_weight *)MALLOC(sizeof(struct sparse_weight)); | 
|  | nwb[i].body.sparse_weight[0].pos = onv; | 
|  | nwb[i].body.sparse_weight[0].value = 1; | 
|  | new->id = 3; | 
|  | new->nv = nnv; | 
|  | new->ord.composite.length = nlen; | 
|  | new->ord.composite.w_or_b = nwb; | 
|  | print_composite_order_spec(new); | 
|  | break; | 
| default: | default: | 
| error("homogenize_order : invalid input"); | error("homogenize_order : invalid input"); | 
| } | } | 
| 
| Line 1812  void dp_hm(DP p,DP *rp) |  | 
| Line 2024  void dp_hm(DP p,DP *rp) |  | 
| } | } | 
| } | } | 
|  |  | 
|  | void dp_ht(DP p,DP *rp) | 
|  | { | 
|  | MP m,mr; | 
|  |  | 
|  | if ( !p ) | 
|  | *rp = 0; | 
|  | else { | 
|  | m = BDY(p); | 
|  | NEWMP(mr); mr->dl = m->dl; mr->c = (P)ONE; NEXT(mr) = 0; | 
|  | MKDP(p->nv,mr,*rp); (*rp)->sugar = mr->dl->td;  /* XXX */ | 
|  | } | 
|  | } | 
|  |  | 
| void dp_rest(DP p,DP *rp) | void dp_rest(DP p,DP *rp) | 
| { | { | 
| MP m; | MP m; | 
| 
| Line 1934  void dp_sort(DP p,DP *rp) |  | 
| Line 2159  void dp_sort(DP p,DP *rp) |  | 
| *rp = r; | *rp = r; | 
| } | } | 
|  |  | 
|  | DP extract_initial_term_from_dp(DP p,int *weight,int n); | 
|  | LIST extract_initial_term(LIST f,int *weight,int n); | 
|  |  | 
|  | DP extract_initial_term_from_dp(DP p,int *weight,int n) | 
|  | { | 
|  | int w,t,i,top; | 
|  | MP m,r0,r; | 
|  | DP dp; | 
|  |  | 
|  | if ( !p ) return 0; | 
|  | top = 1; | 
|  | for ( m = BDY(p); m; m = NEXT(m) ) { | 
|  | for ( i = 0, t = 0; i < n; i++ ) | 
|  | t += weight[i]*m->dl->d[i]; | 
|  | if ( top || t > w ) { | 
|  | r0 = 0; | 
|  | w = t; | 
|  | top = 0; | 
|  | } | 
|  | if ( t == w ) { | 
|  | NEXTMP(r0,r); | 
|  | r->dl = m->dl; | 
|  | r->c = m->c; | 
|  | } | 
|  | } | 
|  | NEXT(r) = 0; | 
|  | MKDP(p->nv,r0,dp); | 
|  | return dp; | 
|  | } | 
|  |  | 
|  | LIST extract_initial_term(LIST f,int *weight,int n) | 
|  | { | 
|  | NODE nd,r0,r; | 
|  | Obj p; | 
|  | LIST l; | 
|  |  | 
|  | nd = BDY(f); | 
|  | for ( r0 = 0; nd; nd = NEXT(nd) ) { | 
|  | NEXTNODE(r0,r); | 
|  | p = (Obj)BDY(nd); | 
|  | BDY(r) = (pointer)extract_initial_term_from_dp((DP)p,weight,n); | 
|  | } | 
|  | if ( r0 ) NEXT(r) = 0; | 
|  | MKLIST(l,r0); | 
|  | return l; | 
|  | } | 
|  |  | 
|  | LIST dp_initial_term(LIST f,struct order_spec *ord) | 
|  | { | 
|  | int n,l,i; | 
|  | struct weight_or_block *worb; | 
|  | int *weight; | 
|  |  | 
|  | switch ( ord->id ) { | 
|  | case 2: /* matrix order */ | 
|  | /* extract the first row */ | 
|  | n = ord->nv; | 
|  | weight = ord->ord.matrix.matrix[0]; | 
|  | return extract_initial_term(f,weight,n); | 
|  | case 3: /* composite order */ | 
|  | /* the first w_or_b */ | 
|  | worb = ord->ord.composite.w_or_b; | 
|  | switch ( worb->type ) { | 
|  | case IS_DENSE_WEIGHT: | 
|  | n = worb->length; | 
|  | weight = worb->body.dense_weight; | 
|  | return extract_initial_term(f,weight,n); | 
|  | case IS_SPARSE_WEIGHT: | 
|  | n = ord->nv; | 
|  | weight = (int *)ALLOCA(n*sizeof(int)); | 
|  | for ( i = 0; i < n; i++ ) weight[i] = 0; | 
|  | l = worb->length; | 
|  | for ( i = 0; i < l; i++ ) | 
|  | weight[worb->body.sparse_weight[i].pos] | 
|  | =  worb->body.sparse_weight[i].value; | 
|  | return extract_initial_term(f,weight,n); | 
|  | default: | 
|  | error("dp_initial_term : unsupported order"); | 
|  | } | 
|  | default: | 
|  | error("dp_initial_term : unsupported order"); | 
|  | } | 
|  | } | 
|  |  | 
|  | int highest_order_dp(DP p,int *weight,int n); | 
|  | LIST highest_order(LIST f,int *weight,int n); | 
|  |  | 
|  | int highest_order_dp(DP p,int *weight,int n) | 
|  | { | 
|  | int w,t,i,top; | 
|  | MP m; | 
|  |  | 
|  | if ( !p ) return -1; | 
|  | top = 1; | 
|  | for ( m = BDY(p); m; m = NEXT(m) ) { | 
|  | for ( i = 0, t = 0; i < n; i++ ) | 
|  | t += weight[i]*m->dl->d[i]; | 
|  | if ( top || t > w ) { | 
|  | w = t; | 
|  | top = 0; | 
|  | } | 
|  | } | 
|  | return w; | 
|  | } | 
|  |  | 
|  | LIST highest_order(LIST f,int *weight,int n) | 
|  | { | 
|  | int h; | 
|  | NODE nd,r0,r; | 
|  | Obj p; | 
|  | LIST l; | 
|  | Q q; | 
|  |  | 
|  | nd = BDY(f); | 
|  | for ( r0 = 0; nd; nd = NEXT(nd) ) { | 
|  | NEXTNODE(r0,r); | 
|  | p = (Obj)BDY(nd); | 
|  | h = highest_order_dp((DP)p,weight,n); | 
|  | STOQ(h,q); | 
|  | BDY(r) = (pointer)q; | 
|  | } | 
|  | if ( r0 ) NEXT(r) = 0; | 
|  | MKLIST(l,r0); | 
|  | return l; | 
|  | } | 
|  |  | 
|  | LIST dp_order(LIST f,struct order_spec *ord) | 
|  | { | 
|  | int n,l,i; | 
|  | struct weight_or_block *worb; | 
|  | int *weight; | 
|  |  | 
|  | switch ( ord->id ) { | 
|  | case 2: /* matrix order */ | 
|  | /* extract the first row */ | 
|  | n = ord->nv; | 
|  | weight = ord->ord.matrix.matrix[0]; | 
|  | return highest_order(f,weight,n); | 
|  | case 3: /* composite order */ | 
|  | /* the first w_or_b */ | 
|  | worb = ord->ord.composite.w_or_b; | 
|  | switch ( worb->type ) { | 
|  | case IS_DENSE_WEIGHT: | 
|  | n = worb->length; | 
|  | weight = worb->body.dense_weight; | 
|  | return highest_order(f,weight,n); | 
|  | case IS_SPARSE_WEIGHT: | 
|  | n = ord->nv; | 
|  | weight = (int *)ALLOCA(n*sizeof(int)); | 
|  | for ( i = 0; i < n; i++ ) weight[i] = 0; | 
|  | l = worb->length; | 
|  | for ( i = 0; i < l; i++ ) | 
|  | weight[worb->body.sparse_weight[i].pos] | 
|  | =  worb->body.sparse_weight[i].value; | 
|  | return highest_order(f,weight,n); | 
|  | default: | 
|  | error("dp_initial_term : unsupported order"); | 
|  | } | 
|  | default: | 
|  | error("dp_initial_term : unsupported order"); | 
|  | } | 
|  | } | 
|  |  | 
|  | int dpv_ht(DPV p,DP *h) | 
|  | { | 
|  | int len,max,maxi,i,t; | 
|  | DP *e; | 
|  | MP m,mr; | 
|  |  | 
|  | len = p->len; | 
|  | e = p->body; | 
|  | max = -1; | 
|  | maxi = -1; | 
|  | for ( i = 0; i < len; i++ ) | 
|  | if ( e[i] && (t = BDY(e[i])->dl->td) > max ) { | 
|  | max = t; | 
|  | maxi = i; | 
|  | } | 
|  | if ( max < 0 ) { | 
|  | *h = 0; | 
|  | return -1; | 
|  | } else { | 
|  | m = BDY(e[maxi]); | 
|  | NEWMP(mr); mr->dl = m->dl; mr->c = (P)ONE; NEXT(mr) = 0; | 
|  | MKDP(e[maxi]->nv,mr,*h); (*h)->sugar = mr->dl->td;  /* XXX */ | 
|  | return maxi; | 
|  | } | 
|  | } |