=================================================================== RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/gr.c,v retrieving revision 1.1.1.1 retrieving revision 1.5 diff -u -p -r1.1.1.1 -r1.5 --- OpenXM_contrib2/asir2000/builtin/gr.c 1999/12/03 07:39:07 1.1.1.1 +++ OpenXM_contrib2/asir2000/builtin/gr.c 2000/05/29 08:54:45 1.5 @@ -1,4 +1,4 @@ -/* $OpenXM: OpenXM/src/asir99/builtin/gr.c,v 1.2 1999/11/18 05:42:01 noro Exp $ */ +/* $OpenXM: OpenXM_contrib2/asir2000/builtin/gr.c,v 1.4 2000/04/25 04:07:58 noro Exp $ */ #include "ca.h" #include "parse.h" #include "base.h" @@ -33,6 +33,7 @@ int TP,NBP,NMP,NFP,NDP,ZR,NZR; #define NEWDP_pairs ((DP_pairs)MALLOC(sizeof(struct dp_pairs))) extern int (*cmpdl)(); +extern int do_weyl; void Pdp_gr_flags(), Pdp_gr_print(); void Pdp_gr_main(),Pdp_gr_mod_main(),Pdp_f4_main(),Pdp_f4_mod_main(); @@ -93,9 +94,9 @@ void dp_gr_main(LIST,LIST,Num,int,struct order_spec *, void dp_f4_main(LIST,LIST,struct order_spec *,LIST *); void dp_f4_mod_main(LIST,LIST,int,struct order_spec *,LIST *); double get_rtime(); -void dp_symb(DP,DP *); void _dpmod_to_vect(DP,DL *,int *); void dp_to_vect(DP,DL *,Q *); +NODE dp_dllist(DP f),symb_merge(NODE,NODE,int); extern int dp_nelim; extern int dp_fcoeffs; @@ -259,6 +260,8 @@ DL dl1,dl2; return 0; } +/* b[] should be cleared */ + void _dpmod_to_vect(f,at,b) DP f; DL *at; @@ -289,25 +292,32 @@ Q *b; } } -void dp_symb(f,rp) +NODE dp_dllist(f) DP f; -DP *rp; { - MP mp,mp0,m; - DP r; + MP m; + NODE mp,mp0; - if ( !f ) { - *rp = 0; return; - } + if ( !f ) + return 0; mp0 = 0; for ( m = BDY(f); m; m = NEXT(m) ) { - NEXTMP(mp0,mp); mp->dl = m->dl; mp->c = (P)ONE; + NEXTNODE(mp0,mp); BDY(mp) = (pointer)m->dl; } NEXT(mp) = 0; - MKDP(f->nv,mp0,r); r->sugar = f->sugar; - *rp = r; + return mp0; } +void pdl(f) +NODE f; +{ + while ( f ) { + printdl(BDY(f)); f = NEXT(f); + } + fflush(stdout); + printf("\n"); +} + void dp_gr_main(f,v,homo,modular,ord,rp) LIST f,v; Num homo; @@ -503,7 +513,7 @@ LIST *rp; int i; struct order_spec ord1; VL fv,vv,vc; - DP b,c; + DP b,c,c1; NODE fd,fd0,fi,fi0,r,r0,t,subst,x,s,xx; dp_fcoeffs = 0; @@ -516,8 +526,9 @@ LIST *rp; for ( fd0 = 0, t = BDY(f); t; t = NEXT(t) ) { ptod(CO,vv,(P)BDY(t),&b); _dp_mod(b,m,0,&c); + _dp_monic(c,m,&c1); if ( c ) { - NEXTNODE(fd0,fd); BDY(fd) = (pointer)c; + NEXTNODE(fd0,fd); BDY(fd) = (pointer)c1; } } if ( fd0 ) NEXT(fd) = 0; @@ -536,8 +547,9 @@ NODE f; { int i,j,k,nh,row,col,nv; NODE r,g,gall; + NODE s,s0; DP_pairs d,dm,dr,t; - DP h,nf,nf1,s,s0,s1,f1,f2,f21,f21r,sp,sp1,sd,sdm; + DP h,nf,nf1,f1,f2,f21,f21r,sp,sp1,sd,sdm,tdp; MP mp,mp0; NODE blist,bt,nt; DL *ht,*at; @@ -572,27 +584,21 @@ NODE f; dp_sp(ps[t->dp1],ps[t->dp2],&sp); if ( sp ) { MKNODE(bt,sp,blist); blist = bt; - dp_symb(sp,&sp1); - symb_addd(s0,sp1,&s1); s0 = s1; + s0 = symb_merge(s0,dp_dllist(sp),nv); } } /* s0 : all the terms appeared in symbolic redunction */ - s = s0; - nred = 0; - while ( s ) { + for ( s = s0, nred = 0; s; s = NEXT(s) ) { for ( r = gall; r; r = NEXT(r) ) - if ( dp_redble(s,ps[(int)BDY(r)] ) ) + if ( _dl_redble(BDY(ps[(int)BDY(r)])->dl,BDY(s),nv) ) break; if ( r ) { - dp_subd(s,ps[(int)BDY(r)],&sd); + dltod(BDY(s),nv,&tdp); + dp_subd(tdp,ps[(int)BDY(r)],&sd); muld(CO,sd,ps[(int)BDY(r)],&f2); MKNODE(bt,f2,blist); blist = bt; - dp_symb(f2,&f21); symb_addd(s0,f21,&s1); s0 = s1; - dp_rest(f21,&f21r); - dp_rest(s,&s1); symb_addd(s1,f21r,&s); + s = symb_merge(s,dp_dllist(f2),nv); nred++; - } else { - dp_rest(s,&s1); s = s1; } } @@ -602,10 +608,10 @@ NODE f; ht = (DL *)MALLOC(nred*sizeof(DL)); for ( r = blist, i = 0; i < nred; r = NEXT(r), i++ ) ht[i] = BDY((DP)BDY(r))->dl; - for ( mp = BDY(s0), col = 0; mp; mp = NEXT(mp), col++ ); + for ( s = s0, col = 0; s; s = NEXT(s), col++ ); at = (DL *)MALLOC(col*sizeof(DL)); - for ( mp = BDY(s0), i = 0; i < col; mp = NEXT(mp), i++ ) - at[i] = mp->dl; + for ( s = s0, i = 0; i < col; s = NEXT(s), i++ ) + at[i] = (DL)BDY(s); MKMAT(mat,row,col); for ( i = 0, r = blist; i < row; r = NEXT(r), i++ ) dp_to_vect(BDY(r),at,(Q *)mat->body[i]); @@ -616,7 +622,11 @@ NODE f; fprintf(asir_out,"mat : %d x %d",row,col); fflush(asir_out); } +#if 0 + rank = generic_gauss_elim_hensel(mat,&nm,&dn,&rind,&cind); +#else rank = generic_gauss_elim(mat,&nm,&dn,&rind,&cind); +#endif if ( Print ) fprintf(asir_out,"done rank = %d\n",rank,row,col); for ( i = 0; i < rank; i++ ) { @@ -651,24 +661,28 @@ NODE f; return g; } +/* initial bases are monic */ + NODE gb_f4_mod(f,m) NODE f; int m; { int i,j,k,nh,row,col,nv; NODE r,g,gall; + NODE s,s0; DP_pairs d,dm,dr,t; - DP h,nf,s,s0,s1,f1,f2,f21,f21r,sp,sp1,sd,sdm; + DP h,nf,f1,f2,f21,f21r,sp,sp1,sd,sdm,tdp; MP mp,mp0; NODE blist,bt,nt; - DL *ht,*at; - int **mat; - int *colstat; - int rank,nred,nonzero; - struct oEGT tmp0,tmp1,tmp2,eg_split_symb,eg_split_elim; - extern struct oEGT eg_symb,eg_elim; + DL *ht,*at,*st; + int **spmat,**redmat; + int *colstat,*w; + int rank,nred,nsp,nonzero,spcol; + int *indred,*isred,*ri; + struct oEGT tmp0,tmp1,tmp2,eg_split_symb,eg_split_elim1,eg_split_elim2; + extern struct oEGT eg_symb,eg_elim1,eg_elim2; - init_eg(&eg_symb); init_eg(&eg_elim); + init_eg(&eg_symb); init_eg(&eg_elim1); init_eg(&eg_elim2); for ( gall = g = 0, d = 0, r = f; r; r = NEXT(r) ) { i = (int)BDY(r); d = updpairs(d,g,i); @@ -688,90 +702,130 @@ int m; _dp_sp_mod(ps[t->dp1],ps[t->dp2],m,&sp); if ( sp ) { MKNODE(bt,sp,blist); blist = bt; - dp_symb(sp,&sp1); - addd(CO,s0,sp1,&s1); s0 = s1; + s0 = symb_merge(s0,dp_dllist(sp),nv); } } /* s0 : all the terms appeared in symbolic redunction */ - s = s0; - nred = 0; - while ( s ) { + for ( s = s0, nred = 0; s; s = NEXT(s) ) { for ( r = gall; r; r = NEXT(r) ) - if ( dp_redble(s,ps[(int)BDY(r)] ) ) + if ( _dl_redble(BDY(ps[(int)BDY(r)])->dl,BDY(s),nv) ) break; if ( r ) { - dp_subd(s,ps[(int)BDY(r)],&sd); + dltod(BDY(s),nv,&tdp); + dp_subd(tdp,ps[(int)BDY(r)],&sd); _dp_mod(sd,m,0,&sdm); - _mulmd(CO,m,sdm,ps[(int)BDY(r)],&f2); + _mulmd(CO,m,ps[(int)BDY(r)],sdm,&f2); MKNODE(bt,f2,blist); blist = bt; - dp_symb(f2,&f21); addd(CO,s0,f21,&s1); s0 = s1; - dp_rest(f21,&f21r); - dp_rest(s,&s1); addd(CO,s1,f21r,&s); + s = symb_merge(s,dp_dllist(f2),nv); nred++; - } else { - dp_rest(s,&s1); s = s1; } } + + get_eg(&tmp1); add_eg(&eg_symb,&tmp0,&tmp1); + init_eg(&eg_split_symb); add_eg(&eg_split_symb,&tmp0,&tmp1); /* the first nred polys in blist are reducers */ /* row = the number of all the polys */ for ( r = blist, row = 0; r; r = NEXT(r), row++ ); + + /* head terms of reducers */ ht = (DL *)MALLOC(nred*sizeof(DL)); for ( r = blist, i = 0; i < nred; r = NEXT(r), i++ ) ht[i] = BDY((DP)BDY(r))->dl; - for ( mp = BDY(s0), col = 0; mp; mp = NEXT(mp), col++ ); + + /* col = number of all terms */ + for ( s = s0, col = 0; s; s = NEXT(s), col++ ); + + /* head terms of all terms */ at = (DL *)MALLOC(col*sizeof(DL)); - for ( mp = BDY(s0), i = 0; i < col; mp = NEXT(mp), i++ ) - at[i] = mp->dl; - mat = almat(row,col); - for ( i = 0, r = blist; i < row; r = NEXT(r), i++ ) - _dpmod_to_vect(BDY(r),at,mat[i]); - colstat = (int *)MALLOC_ATOMIC(col*sizeof(int)); - for ( i = 0, nonzero=0; i < row; i++ ) - for ( j = 0; j < col; j++ ) - if ( mat[i][j] ) + for ( s = s0, i = 0; i < col; s = NEXT(s), i++ ) + at[i] = (DL)BDY(s); + + /* store coefficients separately in spmat and redmat */ + nsp = row-nred; + + /* reducer matrix */ + redmat = (int **)almat(nred,col); + for ( i = 0, r = blist; i < nred; r = NEXT(r), i++ ) + _dpmod_to_vect(BDY(r),at,redmat[i]); + /* XXX */ +/* reduce_reducers_mod(redmat,nred,col,m); */ + /* register the position of the head term */ + indred = (int *)MALLOC(nred*sizeof(int)); + bzero(indred,nred*sizeof(int)); + isred = (int *)MALLOC(col*sizeof(int)); + bzero(isred,col*sizeof(int)); + for ( i = 0; i < nred; i++ ) { + ri = redmat[i]; + for ( j = 0; j < col && !ri[j]; j++ ); + indred[i] = j; + isred[j] = 1; + } + + spcol = col-nred; + /* head terms not in ht */ + st = (DL *)MALLOC(spcol*sizeof(DL)); + for ( j = 0, k = 0; j < col; j++ ) + if ( !isred[j] ) + st[k++] = at[j]; + + /* spoly matrix; stored in reduced form; terms in ht[] are omitted */ + spmat = almat(nsp,spcol); + w = (int *)MALLOC(col*sizeof(int)); + for ( ; i < row; r = NEXT(r), i++ ) { + bzero(w,col*sizeof(int)); + _dpmod_to_vect(BDY(r),at,w); + reduce_sp_by_red_mod(w,redmat,indred,nred,col,m); + for ( j = 0, k = 0; j < col; j++ ) + if ( !isred[j] ) + spmat[i-nred][k++] = w[j]; + } + + get_eg(&tmp0); add_eg(&eg_elim1,&tmp1,&tmp0); + init_eg(&eg_split_elim1); add_eg(&eg_split_elim1,&tmp1,&tmp0); + + colstat = (int *)MALLOC_ATOMIC(spcol*sizeof(int)); + for ( i = 0, nonzero=0; i < nsp; i++ ) + for ( j = 0; j < spcol; j++ ) + if ( spmat[i][j] ) nonzero++; if ( Print ) - fprintf(asir_out,"mat : %d x %d (nonzero=%f%%)...", - row,col,((double)nonzero*100)/(row*col)); - get_eg(&tmp1); add_eg(&eg_symb,&tmp0,&tmp1); - init_eg(&eg_split_symb); add_eg(&eg_split_symb,&tmp0,&tmp1); - rank = generic_gauss_elim_mod(mat,row,col,m,colstat); - get_eg(&tmp2); add_eg(&eg_elim,&tmp1,&tmp2); - init_eg(&eg_split_elim); add_eg(&eg_split_elim,&tmp1,&tmp2); + fprintf(asir_out,"spmat : %d x %d (nonzero=%f%%)...", + nsp,spcol,((double)nonzero*100)/(nsp*spcol)); + rank = generic_gauss_elim_mod(spmat,nsp,spcol,m,colstat); + + get_eg(&tmp1); add_eg(&eg_elim2,&tmp0,&tmp1); + init_eg(&eg_split_elim2); add_eg(&eg_split_elim2,&tmp0,&tmp1); + if ( Print ) { fprintf(asir_out,"done rank = %d\n",rank,row,col); print_eg("Symb",&eg_split_symb); - print_eg("Elim",&eg_split_elim); + print_eg("Elim1",&eg_split_elim1); + print_eg("Elim2",&eg_split_elim2); fprintf(asir_out,"\n"); } - for ( j = 0, i = 0; j < col; j++ ) + for ( j = 0, i = 0; j < spcol; j++ ) if ( colstat[j] ) { - for ( k = 0; k < nred; k++ ) - if ( !cmpdl(nv,at[j],ht[k]) ) - break; - if ( k == nred ) { - /* this is a new base */ - mp0 = 0; - NEXTMP(mp0,mp); mp->dl = at[j]; mp->c = STOI(1); - for ( k = j+1; k < col; k++ ) - if ( !colstat[k] && mat[i][k] ) { - NEXTMP(mp0,mp); mp->dl = at[k]; - mp->c = STOI(mat[i][k]); - } - NEXT(mp) = 0; - MKDP(nv,mp0,nf); nf->sugar = dm->sugar; - nh = newps_mod(nf,m); - d = updpairs(d,g,nh); - g = updbase(g,nh); - gall = append_one(gall,nh); + mp0 = 0; + NEXTMP(mp0,mp); mp->dl = st[j]; mp->c = STOI(1); + for ( k = j+1; k < spcol; k++ ) + if ( !colstat[k] && spmat[i][k] ) { + NEXTMP(mp0,mp); mp->dl = st[k]; + mp->c = STOI(spmat[i][k]); } + NEXT(mp) = 0; + MKDP(nv,mp0,nf); nf->sugar = dm->sugar; + nh = newps_mod(nf,m); + d = updpairs(d,g,nh); + g = updbase(g,nh); + gall = append_one(gall,nh); i++; } } if ( Print ) { print_eg("Symb",&eg_symb); - print_eg("Elim",&eg_elim); + print_eg("Elim1",&eg_elim1); + print_eg("Elim2",&eg_elim2); fflush(asir_out); } return g; @@ -2147,13 +2201,16 @@ int t; dl1 = DPPlength(d1); NFP += (dl-dl1); dl = dl1; } else dl = 1; - for ( dd = 0; d1; d1 = nd ) { - nd = NEXT(d1); - if ( !criterion_2( d1->dp1, d1->dp2 ) ) { - NEXT(d1) = dd; - dd = d1; + if ( !do_weyl ) + for ( dd = 0; d1; d1 = nd ) { + nd = NEXT(d1); + if ( !criterion_2( d1->dp1, d1->dp2 ) ) { + NEXT(d1) = dd; + dd = d1; + } } - } + else + dd = d1; dl1 = DPPlength(dd); NDP += (dl-dl1); get_eg(&tup1); add_eg(&eg_up,&tup0,&tup1); @@ -2181,7 +2238,12 @@ register int t; last = p; dp = p->dp1 = (int)BDY(r); p->dp2 = t; p->lcm = lcm_of_DL(CNVars, dl = psh[dp], tdl, (DL)0 ); - p->sugar = (ts > (s = pss[dp] - dl->td) ? ts : s) + p->lcm->td; +#if 0 + if ( do_weyl ) + p->sugar = dl_weight(p->lcm); + else +#endif + p->sugar = (ts > (s = pss[dp] - dl->td) ? ts : s) + p->lcm->td; } return last; } @@ -2354,6 +2416,17 @@ DL dl1, dl2; for ( d1 = dl1->d, d2 = dl2->d, n = CNVars; --n >= 0; d1++, d2++ ) if ( *d1 < *d2 ) return 0; return 1; +} + +int dl_weight(dl) +DL dl; +{ + int n,w,i; + + n = CNVars/2; + for ( i = 0, w = 0; i < n; i++ ) + w += (-dl->d[i]+dl->d[n+i]); + return w; } int gbcheck(f)