OpenXM_contrib2/asir2000/builtin/dp.c - diff

Return to dp.c CVS log

Up to [local] / OpenXM_contrib2 / asir2000 / builtin

Diff for /OpenXM_contrib2/asir2000/builtin/dp.c between version 1.8 and 1.13

version 1.8, 2000/12/05 06:59:15

version 1.13, 2000/12/13 05:37:30

Line 45

* DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,

* PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.

* $OpenXM: OpenXM_contrib2/asir2000/builtin/dp.c,v 1.7 2000/12/05 01:24:50 noro Exp $

* $OpenXM: OpenXM_contrib2/asir2000/builtin/dp.c,v 1.12 2000/12/11 02:00:40 noro Exp $

#include "ca.h"

#include "base.h"

Line 57 extern int dp_order_pair_length;

extern struct order_pair *dp_order_pair;

extern struct order_spec dp_current_spec;

int do_weyl;

void Pdp_ord(), Pdp_ptod(), Pdp_dtop();

void Pdp_ptozp(), Pdp_ptozp2(), Pdp_red(), Pdp_red2(), Pdp_lcm(), Pdp_redble();

void Pdp_sp(), Pdp_hm(), Pdp_ht(), Pdp_hc(), Pdp_rest(), Pdp_td(), Pdp_sugar();

void Pdp_cri1(),Pdp_cri2(),Pdp_subd(),Pdp_mod(),Pdp_red_mod(),Pdp_tdiv();

void Pdp_prim(),Pdp_red_coef(),Pdp_mag(),Pdp_set_kara(),Pdp_rat();

void Pdp_nf(),Pdp_true_nf(),Pdp_nf_ptozp();

void Pdp_nf(),Pdp_true_nf();

void Pdp_nf_mod(),Pdp_true_nf_mod();

void Pdp_criB(),Pdp_nelim();

void Pdp_minp(),Pdp_nf_demand(),Pdp_sp_mod();

void Pdp_minp(),Pdp_sp_mod();

void Pdp_homo(),Pdp_dehomo();

void Pdp_gr_mod_main();

void Pdp_gr_main(),Pdp_gr_hm_main(),Pdp_gr_d_main(),Pdp_gr_flags();

Line 76 void Pdp_mbase(),Pdp_lnf_mod(),Pdp_nf_tab_mod(),Pdp_md

Line 77 void Pdp_mbase(),Pdp_lnf_mod(),Pdp_nf_tab_mod(),Pdp_md

void Pdp_vtoe(), Pdp_etov(), Pdp_dtov(), Pdp_idiv(), Pdp_sep();

void Pdp_cont();

void Pdp_weyl_red();

void Pdp_weyl_sp();

void Pdp_weyl_nf(),Pdp_weyl_nf_mod();

void Pdp_weyl_gr_main(),Pdp_weyl_gr_mod_main();

void Pdp_weyl_f4_main(),Pdp_weyl_f4_mod_main();

void Pdp_weyl_mul(),Pdp_weyl_mul_mod();

struct ftab dp_tab[] = {

/* content reduction */

{"dp_ptozp",Pdp_ptozp,1},

Line 84 struct ftab dp_tab[] = {

Line 92 struct ftab dp_tab[] = {

{"dp_red_coef",Pdp_red_coef,2},

{"dp_cont",Pdp_cont,1},

/* polynomial ring */

/* s-poly */

{"dp_sp",Pdp_sp,2},

{"dp_sp_mod",Pdp_sp_mod,3},

Line 95 struct ftab dp_tab[] = {

Line 104 struct ftab dp_tab[] = {

/* normal form */

{"dp_nf",Pdp_nf,4},

{"dp_true_nf",Pdp_true_nf,4},

{"dp_nf_ptozp",Pdp_nf_ptozp,5},

{"dp_nf_demand",Pdp_nf_demand,5},

{"dp_nf_mod",Pdp_nf_mod,5},

{"dp_true_nf_mod",Pdp_true_nf_mod,5},

{"dp_lnf_mod",Pdp_lnf_mod,3},

Line 110 struct ftab dp_tab[] = {

Line 117 struct ftab dp_tab[] = {

{"dp_f4_main",Pdp_f4_main,3},

{"dp_f4_mod_main",Pdp_f4_mod_main,4},

/* weyl algebra */

/* multiplication */

{"dp_weyl_mul",Pdp_weyl_mul,2},

{"dp_weyl_mul_mod",Pdp_weyl_mul_mod,3},

/* s-poly */

{"dp_weyl_sp",Pdp_weyl_sp,2},

/* m-reduction */

{"dp_weyl_red",Pdp_weyl_red,3},

/* normal form */

{"dp_weyl_nf",Pdp_weyl_nf,4},

{"dp_weyl_nf_mod",Pdp_weyl_nf_mod,5},

/* Buchberger algorithm */

{"dp_weyl_gr_main",Pdp_weyl_gr_main,5},

{"dp_weyl_gr_mod_main",Pdp_weyl_gr_mod_main,5},

/* F4 algorithm */

{"dp_weyl_f4_main",Pdp_weyl_f4_main,3},

{"dp_weyl_f4_mod_main",Pdp_weyl_f4_mod_main,4},

{0,0,0},

};

Line 382 NODE arg;

Line 412 NODE arg;

DP *rp;

{

asir_assert(ARG0(arg),O_DP,"dp_ptozp");

if ( Dist )

dp_ptozp((DP)ARG0(arg),rp);

dp_ptozp_d(BDY(Dist),length(BDY(Dist)),(DP)ARG0(arg),rp);

else

dp_ptozp((DP)ARG0(arg),rp);

}

void Pdp_ptozp2(arg,rp)

Line 398 LIST *rp;

Line 425 LIST *rp;

p0 = (DP)ARG0(arg); p1 = (DP)ARG1(arg);

asir_assert(p0,O_DP,"dp_ptozp2");

asir_assert(p1,O_DP,"dp_ptozp2");

if ( Dist )

dp_ptozp2(p0,p1,&h,&r);

dp_ptozp2_d(BDY(Dist),length(BDY(Dist)),p0,p1,&h,&r);

else

dp_ptozp2(p0,p1,&h,&r);

NEWNODE(n0); BDY(n0) = (pointer)h;

NEWNODE(NEXT(n0)); BDY(NEXT(n0)) = (pointer)r;

NEXT(NEXT(n0)) = 0;

Line 442 DP *rp;

Line 466 DP *rp;

dp_rat((DP)ARG0(arg),rp);

}

extern int DP_Multiple;

void Pdp_nf(arg,rp)

NODE arg;

DP *rp;

Line 451 DP *rp;

Line 477 DP *rp;

DP g;

int full;

do_weyl = 0;

asir_assert(ARG0(arg),O_LIST,"dp_nf");

asir_assert(ARG1(arg),O_DP,"dp_nf");

asir_assert(ARG2(arg),O_VECT,"dp_nf");

Line 460 DP *rp;

Line 487 DP *rp;

}

b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));

full = (Q)ARG3(arg) ? 1 : 0;

dp_nf(b,g,ps,full,rp);

dp_nf_ptozp(b,g,ps,full,DP_Multiple,rp);

}

void Pdp_true_nf(arg,rp)

void Pdp_weyl_nf(arg,rp)

NODE arg;

LIST *rp;

DP *rp;

{

NODE b,n;

NODE b;

DP *ps;

DP g;

DP nm;

P dn;

int full;

asir_assert(ARG0(arg),O_LIST,"dp_true_nf");

asir_assert(ARG0(arg),O_LIST,"dp_weyl_nf");

asir_assert(ARG1(arg),O_DP,"dp_true_nf");

asir_assert(ARG1(arg),O_DP,"dp_weyl_nf");

asir_assert(ARG2(arg),O_VECT,"dp_true_nf");

asir_assert(ARG2(arg),O_VECT,"dp_weyl_nf");

asir_assert(ARG3(arg),O_N,"dp_nf");

asir_assert(ARG3(arg),O_N,"dp_weyl_nf");

if ( !(g = (DP)ARG1(arg)) ) {

nm = 0; dn = (P)ONE;

*rp = 0; return;

} else {

b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));

full = (Q)ARG3(arg) ? 1 : 0;

dp_true_nf(b,g,ps,full,&nm,&dn);

}

NEWNODE(n); BDY(n) = (pointer)nm;

b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));

NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)dn;

full = (Q)ARG3(arg) ? 1 : 0;

NEXT(NEXT(n)) = 0; MKLIST(*rp,n);

do_weyl = 1;

dp_nf_ptozp(b,g,ps,full,DP_Multiple,rp);

do_weyl = 0;

}

void Pdp_nf_ptozp(arg,rp)

void Pdp_nf_mod(arg,rp)

NODE arg;

DP *rp;

{

NODE b;

DP g;

DP *ps;

int full,multiple;

int mod,full,ac;

NODE n,n0;

asir_assert(ARG0(arg),O_LIST,"dp_nf_ptozp");

ac = argc(arg);

asir_assert(ARG1(arg),O_DP,"dp_nf_ptozp");

asir_assert(ARG0(arg),O_LIST,"dp_weyl_nf_mod");

asir_assert(ARG2(arg),O_VECT,"dp_nf_ptozp");

asir_assert(ARG1(arg),O_DP,"dp_weyl_nf_mod");

asir_assert(ARG3(arg),O_N,"dp_nf_ptozp");

asir_assert(ARG2(arg),O_VECT,"dp_weyl_nf_mod");

asir_assert(ARG4(arg),O_N,"dp_nf_ptozp");

asir_assert(ARG3(arg),O_N,"dp_weyl_nf_mod");

asir_assert(ARG4(arg),O_N,"dp_weyl_nf_mod");

if ( !(g = (DP)ARG1(arg)) ) {

*rp = 0; return;

}

b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));

full = (Q)ARG3(arg) ? 1 : 0;

full = QTOS((Q)ARG3(arg)); mod = QTOS((Q)ARG4(arg));

multiple = QTOS((Q)ARG4(arg));

for ( n0 = n = 0; b; b = NEXT(b) ) {

dp_nf_ptozp(b,g,ps,full,multiple,rp);

NEXTNODE(n0,n);

BDY(n) = (pointer)QTOS((Q)BDY(b));

}

if ( n0 )

NEXT(n) = 0;

do_weyl = 1;

dp_nf_mod(n0,g,ps,mod,full,rp);

do_weyl = 0;

}

void Pdp_nf_demand(arg,rp)

void Pdp_true_nf(arg,rp)

NODE arg;

DP *rp;

LIST *rp;

{

DP g,u,p,d,s,t,dmy1;

NODE b,n;

P dmy;

DP *ps;

NODE b,l;

DP g;

DP *hps;

DP nm;

MP m,mr;

P dn;

int i,n;

int *wb;

int full;

char *fprefix;

int sugar,psugar;

asir_assert(ARG0(arg),O_LIST,"dp_nf_demand");

do_weyl = 0;

asir_assert(ARG1(arg),O_DP,"dp_nf_demand");

asir_assert(ARG0(arg),O_LIST,"dp_true_nf");

asir_assert(ARG2(arg),O_N,"dp_nf_demand");

asir_assert(ARG1(arg),O_DP,"dp_true_nf");

asir_assert(ARG3(arg),O_VECT,"dp_nf_demand");

asir_assert(ARG2(arg),O_VECT,"dp_true_nf");

asir_assert(ARG4(arg),O_STR,"dp_nf_demand");

asir_assert(ARG3(arg),O_N,"dp_nf");

if ( !(g = (DP)ARG1(arg)) ) {

*rp = 0; return;

nm = 0; dn = (P)ONE;

} else {

b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));

full = (Q)ARG3(arg) ? 1 : 0;

dp_true_nf(b,g,ps,full,&nm,&dn);

}

b = BDY((LIST)ARG0(arg)); full = (Q)ARG2(arg) ? 1 : 0;

NEWNODE(n); BDY(n) = (pointer)nm;

hps = (DP *)BDY((VECT)ARG3(arg)); fprefix = BDY((STRING)ARG4(arg));

NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)dn;

for ( n = 0, l = b; l; l = NEXT(l), n++ );

NEXT(NEXT(n)) = 0; MKLIST(*rp,n);

wb = (int *)ALLOCA(n*sizeof(int));

for ( i = 0, l = b; i < n; l = NEXT(l), i++ )

wb[i] = QTOS((Q)BDY(l));

sugar = g->sugar;

for ( d = 0; g; ) {

for ( u = 0, i = 0; i < n; i++ ) {

if ( dp_redble(g,hps[wb[i]]) ) {

FILE *fp;

char fname[BUFSIZ];

sprintf(fname,"%s%d",fprefix,wb[i]);

fprintf(stderr,"loading %s\n",fname);

fp = fopen(fname,"r"); skipvl(fp);

loadobj(fp,(Obj *)&p); fclose(fp);

dp_red(d,g,p,&t,&u,&dmy,&dmy1);

psugar = (BDY(g)->dl->td - BDY(p)->dl->td) + p->sugar;

sugar = MAX(sugar,psugar);

if ( !u ) {

if ( d )

d->sugar = sugar;

*rp = d; return;

}

d = t;

break;

}

if ( u )

g = u;

else if ( !full ) {

if ( g ) {

MKDP(g->nv,BDY(g),t); t->sugar = sugar; g = t;

}

*rp = g; return;

} else {

m = BDY(g); NEWMP(mr); mr->dl = m->dl; mr->c = m->c;

NEXT(mr) = 0; MKDP(g->nv,mr,t); t->sugar = mr->dl->td;

addd(CO,d,t,&s); d = s;

dp_rest(g,&t); g = t;

}

if ( d )

d->sugar = sugar;

*rp = d;

}

void Pdp_nf_mod(arg,rp)

void Pdp_weyl_nf_mod(arg,rp)

NODE arg;

DP *rp;

{

Line 593 DP *rp;

Line 581 DP *rp;

DP g;

DP *ps;

int mod,full,ac;

NODE n,n0;

ac = argc(arg);

asir_assert(ARG0(arg),O_LIST,"dp_nf_mod");

Line 605 DP *rp;

Line 594 DP *rp;

}

b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));

full = QTOS((Q)ARG3(arg)); mod = QTOS((Q)ARG4(arg));

dp_nf_mod_qindex(b,g,ps,mod,full,rp);

for ( n0 = n = 0; b; b = NEXT(b) ) {

NEXTNODE(n0,n);

BDY(n) = (pointer)QTOS((Q)BDY(b));

}

if ( n0 )

NEXT(n) = 0;

do_weyl = 1;

dp_nf_mod(n0,g,ps,mod,full,rp);

do_weyl = 0;

}

void Pdp_true_nf_mod(arg,rp)

Line 619 LIST *rp;

Line 616 LIST *rp;

int mod,full;

NODE n;

do_weyl = 0;

asir_assert(ARG0(arg),O_LIST,"dp_nf_mod");

asir_assert(ARG1(arg),O_DP,"dp_nf_mod");

asir_assert(ARG2(arg),O_VECT,"dp_nf_mod");

Line 713 LIST *rp;

Line 711 LIST *rp;

P dmy;

NODE n;

do_weyl = 0;

asir_assert(ARG0(arg),O_DP,"dp_red_mod");

asir_assert(ARG1(arg),O_DP,"dp_red_mod");

asir_assert(ARG2(arg),O_DP,"dp_red_mod");

Line 723 LIST *rp;

Line 722 LIST *rp;

NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)r;

NEXT(NEXT(n)) = 0; MKLIST(*rp,n);

}

void Pdp_subd(arg,rp)

NODE arg;

DP *rp;

Line 735 DP *rp;

dp_subd(p1,p2,rp);

}

void Pdp_weyl_mul(arg,rp)

NODE arg;

DP *rp;

{

DP p1,p2;

p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);

asir_assert(p1,O_DP,"dp_weyl_mul"); asir_assert(p2,O_DP,"dp_mul");

do_weyl = 1;

muld(CO,p1,p2,rp);

do_weyl = 0;

}

void Pdp_weyl_mul_mod(arg,rp)

NODE arg;

DP *rp;

{

DP p1,p2;

Q m;

p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); m = (Q)ARG2(arg);

asir_assert(p1,O_DP,"dp_weyl_mul_mod");

asir_assert(p2,O_DP,"dp_mul_mod");

asir_assert(m,O_N,"dp_mul_mod");

do_weyl = 1;

mulmd(CO,QTOS(m),p1,p2,rp);

do_weyl = 0;

}

void Pdp_red(arg,rp)

NODE arg;

LIST *rp;

Line 743 LIST *rp;

Line 772 LIST *rp;

DP head,rest,dmy1;

P dmy;

do_weyl = 0;

asir_assert(ARG0(arg),O_DP,"dp_red");

asir_assert(ARG1(arg),O_DP,"dp_red");

asir_assert(ARG2(arg),O_DP,"dp_red");

Line 752 LIST *rp;

Line 782 LIST *rp;

NEXT(NEXT(n)) = 0; MKLIST(*rp,n);

}

void Pdp_weyl_red(arg,rp)

NODE arg;

LIST *rp;

{

NODE n;

DP head,rest,dmy1;

P dmy;

asir_assert(ARG0(arg),O_DP,"dp_weyl_red");

asir_assert(ARG1(arg),O_DP,"dp_weyl_red");

asir_assert(ARG2(arg),O_DP,"dp_weyl_red");

do_weyl = 1;

dp_red((DP)ARG0(arg),(DP)ARG1(arg),(DP)ARG2(arg),&head,&rest,&dmy,&dmy1);

do_weyl = 0;

NEWNODE(n); BDY(n) = (pointer)head;

NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)rest;

NEXT(NEXT(n)) = 0; MKLIST(*rp,n);

}

void Pdp_sp(arg,rp)

NODE arg;

DP *rp;

{

DP p1,p2;

do_weyl = 0;

p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);

asir_assert(p1,O_DP,"dp_sp"); asir_assert(p2,O_DP,"dp_sp");

dp_sp(p1,p2,rp);

}

void Pdp_weyl_sp(arg,rp)

NODE arg;

DP *rp;

{

DP p1,p2;

p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);

asir_assert(p1,O_DP,"dp_weyl_sp"); asir_assert(p2,O_DP,"dp_sp");

do_weyl = 1;

dp_sp(p1,p2,rp);

do_weyl = 0;

}

void Pdp_sp_mod(arg,rp)

NODE arg;

DP *rp;

Line 770 DP *rp;

Line 833 DP *rp;

DP p1,p2;

int mod;

do_weyl = 0;

p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);

asir_assert(p1,O_DP,"dp_sp_mod"); asir_assert(p2,O_DP,"dp_sp_mod");

asir_assert(ARG2(arg),O_N,"dp_sp_mod");

Line 1100 LIST *rp;

Line 1164 LIST *rp;

int modular;

struct order_spec ord;

do_weyl = 0;

asir_assert(ARG0(arg),O_LIST,"dp_gr_main");

asir_assert(ARG1(arg),O_LIST,"dp_gr_main");

asir_assert(ARG2(arg),O_N,"dp_gr_main");

Line 1124 LIST *rp;

Line 1189 LIST *rp;

LIST f,v;

struct order_spec ord;

do_weyl = 0;

asir_assert(ARG0(arg),O_LIST,"dp_f4_main");

asir_assert(ARG1(arg),O_LIST,"dp_f4_main");

f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);

Line 1139 LIST *rp;

Line 1205 LIST *rp;

int m;

struct order_spec ord;

do_weyl = 0;

asir_assert(ARG0(arg),O_LIST,"dp_f4_main");

asir_assert(ARG1(arg),O_LIST,"dp_f4_main");

asir_assert(ARG2(arg),O_N,"dp_f4_main");

Line 1156 LIST *rp;

Line 1223 LIST *rp;

int m;

struct order_spec ord;

do_weyl = 0;

asir_assert(ARG0(arg),O_LIST,"dp_gr_mod_main");

asir_assert(ARG1(arg),O_LIST,"dp_gr_mod_main");

asir_assert(ARG2(arg),O_N,"dp_gr_mod_main");

Line 1164 LIST *rp;

Line 1232 LIST *rp;

homo = (Num)ARG2(arg); m = QTOS((Q)ARG3(arg));

create_order_spec(ARG4(arg),&ord);

dp_gr_mod_main(f,v,homo,m,&ord,rp);

}

/* for Weyl algebra */

void Pdp_weyl_gr_main(arg,rp)

NODE arg;

LIST *rp;

{

LIST f,v;

Num homo;

Q m;

int modular;

struct order_spec ord;

asir_assert(ARG0(arg),O_LIST,"dp_weyl_gr_main");

asir_assert(ARG1(arg),O_LIST,"dp_weyl_gr_main");

asir_assert(ARG2(arg),O_N,"dp_weyl_gr_main");

asir_assert(ARG3(arg),O_N,"dp_weyl_gr_main");

f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);

homo = (Num)ARG2(arg);

m = (Q)ARG3(arg);

if ( !m )

modular = 0;

else if ( PL(NM(m))>1 || (PL(NM(m)) == 1 && BD(NM(m))[0] >= 0x80000000) )

error("dp_gr_main : too large modulus");

else

modular = QTOS(m);

create_order_spec(ARG4(arg),&ord);

do_weyl = 1;

dp_gr_main(f,v,homo,modular,&ord,rp);

do_weyl = 0;

}

void Pdp_weyl_f4_main(arg,rp)

NODE arg;

LIST *rp;

{

LIST f,v;

struct order_spec ord;

asir_assert(ARG0(arg),O_LIST,"dp_weyl_f4_main");

asir_assert(ARG1(arg),O_LIST,"dp_weyl_f4_main");

f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);

create_order_spec(ARG2(arg),&ord);

do_weyl = 1;

dp_f4_main(f,v,&ord,rp);

do_weyl = 0;

}

void Pdp_weyl_f4_mod_main(arg,rp)

NODE arg;

LIST *rp;

{

LIST f,v;

int m;

struct order_spec ord;

asir_assert(ARG0(arg),O_LIST,"dp_weyl_f4_main");

asir_assert(ARG1(arg),O_LIST,"dp_weyl_f4_main");

asir_assert(ARG2(arg),O_N,"dp_f4_main");

f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); m = QTOS((Q)ARG2(arg));

create_order_spec(ARG3(arg),&ord);

do_weyl = 1;

dp_f4_mod_main(f,v,m,&ord,rp);

do_weyl = 0;

}

void Pdp_weyl_gr_mod_main(arg,rp)

NODE arg;

LIST *rp;

{

LIST f,v;

Num homo;

int m;

struct order_spec ord;

asir_assert(ARG0(arg),O_LIST,"dp_weyl_gr_mod_main");

asir_assert(ARG1(arg),O_LIST,"dp_weyl_gr_mod_main");

asir_assert(ARG2(arg),O_N,"dp_weyl_gr_mod_main");

asir_assert(ARG3(arg),O_N,"dp_weyl_gr_mod_main");

f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);

homo = (Num)ARG2(arg); m = QTOS((Q)ARG3(arg));

create_order_spec(ARG4(arg),&ord);

do_weyl = 1;

dp_gr_mod_main(f,v,homo,m,&ord,rp);

do_weyl = 0;

}

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>