=================================================================== RCS file: /home/cvs/OpenXM_contrib2/asir2018/builtin/gr.c,v retrieving revision 1.3 retrieving revision 1.8 diff -u -p -r1.3 -r1.8 --- OpenXM_contrib2/asir2018/builtin/gr.c 2020/02/03 05:51:52 1.3 +++ OpenXM_contrib2/asir2018/builtin/gr.c 2021/02/17 22:18:39 1.8 @@ -45,7 +45,7 @@ * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE. * - * $OpenXM: OpenXM_contrib2/asir2018/builtin/gr.c,v 1.2 2018/09/28 08:20:27 noro Exp $ + * $OpenXM: OpenXM_contrib2/asir2018/builtin/gr.c,v 1.7 2021/01/11 08:37:43 noro Exp $ */ #include "ca.h" #include "parse.h" @@ -84,7 +84,8 @@ static P *psc; static int *pss; static int psn,pslen; -static int NVars,CNVars; +static int NVars; +int CNVars; static VL VC; int PCoeffs; @@ -115,6 +116,7 @@ static int Max_mag = 0; static int Max_coef = 0; char *Demand = 0; static int PtozpRA = 0; +int ReversePOT = 0; int doing_f4; NODE TraceList; @@ -304,6 +306,8 @@ void dp_gr_main(LIST f,LIST v,Num homo,int modular,int int i,mindex,m,nochk; struct order_spec *ord1; Z q; + Q cont; + P pp; VL fv,vv,vc; NODE fd,fd0,fi,fi0,r,r0,t,subst,x,s,xx; NODE ind,ind0; @@ -317,6 +321,15 @@ void dp_gr_main(LIST f,LIST v,Num homo,int modular,int if ( ord->id && NVars != ord->nv ) error("dp_gr_main : invalid order specification"); initd(ord); + // clear denominators if the ground field is Q + if ( field == 0 ) { + for ( r0 = 0, t = BDY(f); t; t = NEXT(t) ) { + ptozp((P)BDY(t),1,&cont,&pp); + NEXTNODE(r0,r); BDY(r) = (pointer)pp; + } + if ( r0 ) NEXT(r) = 0; + MKLIST(f,r0); + } if ( homo ) { homogenize_order(ord,NVars,&ord1); for ( fd0 = fi0 = 0, t = BDY(f); t; t = NEXT(t) ) { @@ -371,11 +384,12 @@ void dp_gr_main(LIST f,LIST v,Num homo,int modular,int } else break; } - if ( modular ) + if ( modular ) { if ( modular > 1 ) { *rp = 0; return; } else m = get_lprime(++mindex); + } makesubst(vc,&subst); psn = length(s); for ( i = psn; i < pslen; i++ ) { @@ -712,7 +726,7 @@ NODE gb_f4(NODE f) rank = generic_gauss_elim(mat,&nm,&dn,&rind,&cind); #endif if ( DP_Print ) - fprintf(asir_out,"done rank = %d\n",rank,row,col); + fprintf(asir_out,"done rank = %d\n",rank); for ( i = 0; i < rank; i++ ) { for ( k = 0; k < nred; k++ ) if ( !cmpdl(nv,at[rind[i]],ht[k]) ) @@ -937,7 +951,7 @@ NODE gb_f4_mod(NODE f,int m) init_eg(&eg_split_elim2); add_eg(&eg_split_elim2,&tmp0,&tmp1); if ( DP_Print ) { - fprintf(asir_out,"done rank = %d\n",rank,row,col); + fprintf(asir_out,"done rank = %d\n",rank); print_eg("Symb",&eg_split_symb); print_eg("Conv",&eg_split_conv); print_eg("Elim1",&eg_split_elim1); @@ -1125,7 +1139,7 @@ NODE gb_f4_mod_old(NODE f,int m) init_eg(&eg_split_elim2); add_eg(&eg_split_elim2,&tmp0,&tmp1); if ( DP_Print ) { - fprintf(asir_out,"done rank = %d\n",rank,row,col); + fprintf(asir_out,"done rank = %d\n",rank); print_eg("Symb",&eg_split_symb); print_eg("Elim1",&eg_split_elim1); print_eg("Elim2",&eg_split_elim2); @@ -1227,7 +1241,7 @@ void printsubst(NODE s) fputc('[',asir_out); while ( s ) { printv(CO,(V)BDY(s)); s = NEXT(s); - fprintf(asir_out,"->%d",ZTOS((Q)BDY(s))); + fprintf(asir_out,"->%ld",ZTOS((Q)BDY(s))); if ( NEXT(s) ) { fputc(',',asir_out); s = NEXT(s); } else @@ -1370,7 +1384,7 @@ NODE /* of DP */ NODE_sortb_insert( DP newdp, NODE /* NEXT(newnd) = last; return newnd; } - for ( ; p = NEXT(last); last = p ) + for ( ; (p = NEXT(last)) != 0; last = p ) if ( sgn*(*cmpfun)( nv, newdl, BDY((DP) BDY(p))->dl ) > 0 ) break; if ( p ) NEXT(NEXT(last) = newnd) = p; else NEXT(last) = newnd; @@ -1398,7 +1412,7 @@ NODE /* of index */ NODE_sortbi_insert( int newdpi, NO NEXT(newnd) = last; return newnd; } - for ( ; p = NEXT(last); last = p ) + for ( ; (p = NEXT(last)) != 0; last = p ) if ( sgn*(*cmpfun)( nv, newdl, psh[(long)BDY(p)] ) > 0 ) break; if ( p ) NEXT(NEXT(last) = newnd) = p; else NEXT(last) = newnd; @@ -1696,7 +1710,7 @@ DP_pairs minp( DP_pairs d, DP_pairs *prest ) } for ( lcm = m->lcm, s = m->sugar, ml = 0, l = m; p; p = NEXT(l = p) ) if ( NoSugar ? (*cmpfun)( nv, lcm, p->lcm ) >= 0 : - (s > p->sugar || s == p->sugar && (*cmpfun)( nv, lcm, p->lcm ) >= 0) ) + (s > p->sugar || (s == p->sugar && (*cmpfun)( nv, lcm, p->lcm ) >= 0)) ) ml = l, lcm = (m = p)->lcm, s = p->sugar; if ( !ml ) *prest = NEXT(m); else { @@ -1960,7 +1974,7 @@ DP_pairs updpairs( DP_pairs d, NODE /* of index */ g, dd = d1; dl1 = DPPlength(dd); NDP += (dl-dl1); if ( !(nd = d) ) return dd; - while ( nd = NEXT(d1 = nd) ) ; + while ( (nd = NEXT(d1 = nd)) != 0 ) ; NEXT(d1) = dd; return d; } @@ -2098,7 +2112,7 @@ DP_pairs criterion_F( DP_pairs d1 ) for ( head = last = 0, p = d1; NEXT(p); ) { s = (r = w = collect_pairs_of_hdlcm( p, &rest ))->sugar; - while ( w = NEXT(w) ) + while ( (w = NEXT(w)) != 0 ) if ( !do_weyl && criterion_2( w->dp1, w->dp2 ) ) { r = w; break; @@ -2336,6 +2350,8 @@ void dp_set_flag(Obj name,Obj value) MaxDeg = v; else if ( !strcmp(n,"NaiveSchreyer") ) NaiveSchreyer = v; + else if ( !strcmp(n,"ReversePOT") ) + ReversePOT = v; } void dp_make_flaglist(LIST *list) @@ -2376,6 +2392,7 @@ void dp_make_flaglist(LIST *list) STOZ(NoGC,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"NoGC"); MKNODE(n1,name,n); n = n1; STOZ(NoCriB,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"NoCriB"); MKNODE(n1,name,n); n = n1; STOZ(NoSugar,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"NoSugar"); MKNODE(n1,name,n); n = n1; + STOZ(ReversePOT,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"ReversePOT"); MKNODE(n1,name,n); n = n1; if ( Demand ) MKSTR(path,Demand); else