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.50 and 1.60

version 1.50, 2004/04/15 08:27:42

version 1.60, 2005/08/25 18:59:11

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.49 2004/04/15 08:14:13 noro Exp $

* $OpenXM: OpenXM_contrib2/asir2000/builtin/dp.c,v 1.59 2005/08/24 06:28:39 noro Exp $

#include "ca.h"

#include "base.h"

Line 55 extern int dp_nelim;

extern int dp_order_pair_length;

extern struct order_pair *dp_order_pair;

extern struct order_spec *dp_current_spec;

extern struct modorder_spec *dp_current_modspec;

int do_weyl;

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

Line 80 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_gr_checklist();

void Pdp_ltod(),Pdpv_ord(),Pdpv_ht(),Pdpv_hm(),Pdpv_hc();

void Pdp_weyl_red();

void Pdp_weyl_sp();

Line 91 void Pdp_set_weight();

Line 93 void Pdp_set_weight();

void Pdp_nf_f(),Pdp_weyl_nf_f();

void Pdp_lnf_f();

void Pnd_gr(),Pnd_gr_trace(),Pnd_f4();

void Pnd_gr_postproc();

void Pnd_weyl_gr(),Pnd_weyl_gr_trace();

void Pnd_nf();

void Pdp_initial_term();

Line 143 struct ftab dp_tab[] = {

Line 146 struct ftab dp_tab[] = {

{"nd_f4",Pnd_f4,4},

{"nd_gr",Pnd_gr,4},

{"nd_gr_trace",Pnd_gr_trace,5},

{"nd_gr_postproc",Pnd_gr_postproc,5},

{"nd_weyl_gr",Pnd_weyl_gr,4},

{"nd_weyl_gr_trace",Pnd_weyl_gr_trace,5},

{"nd_nf",Pnd_nf,5},

Line 186 struct ftab dp_supp_tab[] = {

Line 190 struct ftab dp_supp_tab[] = {

/* setting flags */

{"dp_sort",Pdp_sort,1},

{"dp_ord",Pdp_ord,-1},

{"dpv_ord",Pdpv_ord,-2},

{"dp_set_kara",Pdp_set_kara,-1},

{"dp_nelim",Pdp_nelim,-1},

{"dp_gr_flags",Pdp_gr_flags,-1},

{"dp_gr_print",Pdp_gr_print,-1},

/* converters */

{"dp_ptod",Pdp_ptod,2},

{"dp_ptod",Pdp_ptod,-2},

{"dp_dtop",Pdp_dtop,2},

{"dp_homo",Pdp_homo,1},

{"dp_dehomo",Pdp_dehomo,1},

Line 202 struct ftab dp_supp_tab[] = {

Line 207 struct ftab dp_supp_tab[] = {

{"dp_mdtod",Pdp_mdtod,1},

{"dp_mod",Pdp_mod,3},

{"dp_rat",Pdp_rat,1},

{"dp_ltod",Pdp_ltod,-2},

/* criteria */

{"dp_cri1",Pdp_cri1,2},

Line 214 struct ftab dp_supp_tab[] = {

Line 220 struct ftab dp_supp_tab[] = {

{"dp_hm",Pdp_hm,1},

{"dp_ht",Pdp_ht,1},

{"dp_hc",Pdp_hc,1},

{"dpv_hm",Pdpv_hm,1},

{"dpv_ht",Pdpv_ht,1},

{"dpv_hc",Pdpv_hc,1},

{"dp_rest",Pdp_rest,1},

{"dp_initial_term",Pdp_initial_term,1},

{"dp_order",Pdp_order,1},

Line 426 NODE arg;

Line 435 NODE arg;

Obj *rp;

{

struct order_spec *spec;

LIST v;

if ( !arg )

struct oLIST f;

Num homo;

int modular;

f.id = O_LIST; f.body = 0;

if ( !arg && !current_option )

*rp = dp_current_spec->obj;

else if ( !create_order_spec(0,(Obj)ARG0(arg),&spec) )

error("dp_ord : invalid order specification");

else {

if ( current_option )

parse_gr_option(&f,current_option,&v,&homo,&modular,&spec);

else if ( !create_order_spec(0,(Obj)ARG0(arg),&spec) )

error("dp_ord : invalid order specification");

initd(spec); *rp = spec->obj;

}

Line 440 void Pdp_ptod(arg,rp)

Line 456 void Pdp_ptod(arg,rp)

NODE arg;

DP *rp;

{

P p;

NODE n;

VL vl,tvl;

struct oLIST f;

int ac;

LIST v;

Num homo;

int modular;

struct order_spec *ord;

asir_assert(ARG0(arg),O_P,"dp_ptod");

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

p = (P)ARG0(arg);

for ( vl = 0, n = BDY((LIST)ARG1(arg)); n; n = NEXT(n) ) {

ac = argc(arg);

if ( ac == 1 ) {

if ( current_option ) {

f.id = O_LIST; f.body = mknode(1,p);

parse_gr_option(&f,current_option,&v,&homo,&modular,&ord);

initd(ord);

} else

error("dp_ptod : invalid argument");

} else {

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

v = (LIST)ARG1(arg);

}

for ( vl = 0, n = BDY(v); n; n = NEXT(n) ) {

if ( !vl ) {

NEWVL(vl); tvl = vl;

} else {

Line 455 DP *rp;

Line 490 DP *rp;

}

if ( vl )

NEXT(tvl) = 0;

ptod(CO,vl,(P)ARG0(arg),rp);

ptod(CO,vl,p,rp);

}

void Pdp_ltod(arg,rp)

NODE arg;

DPV *rp;

{

NODE n;

VL vl,tvl;

LIST f,v;

int sugar,i,len,ac,modular;

Num homo;

struct order_spec *ord;

DP *e;

NODE nd,t;

ac = argc(arg);

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

f = (LIST)ARG0(arg);

if ( ac == 1 ) {

if ( current_option ) {

parse_gr_option(f,current_option,&v,&homo,&modular,&ord);

initd(ord);

} else

error("dp_ltod : invalid argument");

} else {

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

v = (LIST)ARG1(arg);

}

for ( vl = 0, n = BDY(v); n; n = NEXT(n) ) {

if ( !vl ) {

NEWVL(vl); tvl = vl;

} else {

NEWVL(NEXT(tvl)); tvl = NEXT(tvl);

}

VR(tvl) = VR((P)BDY(n));

}

if ( vl )

NEXT(tvl) = 0;

nd = BDY(f);

len = length(nd);

e = (DP *)MALLOC(len*sizeof(DP));

sugar = 0;

for ( i = 0, t = nd; i < len; i++, t = NEXT(t) ) {

ptod(CO,vl,(P)BDY(t),&e[i]);

if ( e[i] )

sugar = MAX(sugar,e[i]->sugar);

}

MKDPV(len,e,*rp);

}

void Pdp_dtop(arg,rp)

NODE arg;

P *rp;

Line 484 extern LIST Dist;

Line 568 extern LIST Dist;

void Pdp_ptozp(arg,rp)

NODE arg;

DP *rp;

Obj *rp;

{

Q t;

NODE tt,p;

NODE n,n0;

char *key;

DP pp;

LIST list;

int get_factor=0;

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

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

/* analyze the option */

if ( current_option ) {

for ( tt = current_option; tt; tt = NEXT(tt) ) {

p = BDY((LIST)BDY(tt));

key = BDY((STRING)BDY(p));

/* value = (Obj)BDY(NEXT(p)); */

if ( !strcmp(key,"factor") ) get_factor=1;

else {

error("ptozp: unknown option.");

}

dp_ptozp3((DP)ARG0(arg),&t,&pp);

/* printexpr(NULL,t); */

/* if the option factor is given, then it returns the answer

in the format [zpoly, num] where num*zpoly is equal to the argument.*/

if (get_factor) {

n0 = mknode(2,pp,t);

MKLIST(list,n0);

*rp = (Obj)list;

} else

*rp = (Obj)pp;

}

void Pdp_ptozp2(arg,rp)

Line 1026 DP *rp;

Line 1142 DP *rp;

MP m,mr;

p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_ht");

if ( !p )

dp_ht(p,rp);

*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 Pdp_hc(arg,rp)

Line 1100 Obj *rp;

Line 1210 Obj *rp;

n = mknode(1,f); MKLIST(l,n); f = l;

is_list = 0;

}

if ( argc(arg) == 2 && OID(ARG1(arg)) == O_OPTLIST )

if ( current_option ) {

parse_gr_option(f,BDY((OPTLIST)ARG1(arg)),&v,&homo,&modular,&ord);

parse_gr_option(f,current_option,&v,&homo,&modular,&ord);

else

initd(ord);

} else

ord = dp_current_spec;

initiallist = dp_initial_term(f,ord);

if ( !is_list )

Line 1128 Obj *rp;

Line 1239 Obj *rp;

n = mknode(1,f); MKLIST(l,n); f = l;

is_list = 0;

}

if ( argc(arg) == 2 && OID(ARG1(arg)) == O_OPTLIST )

if ( current_option ) {

parse_gr_option(f,BDY((OPTLIST)ARG1(arg)),&v,&homo,&modular,&ord);

parse_gr_option(f,current_option,&v,&homo,&modular,&ord);

else

initd(ord);

} else

ord = dp_current_spec;

ordlist = dp_order(f,ord);

if ( !is_list )

Line 1468 void parse_gr_option(LIST f,NODE opt,LIST *v,Num *homo

Line 1580 void parse_gr_option(LIST f,NODE opt,LIST *v,Num *homo

/* variable list; ignore */

} else if ( !strcmp(key,"order") ) {

/* order spec */

if ( !vl )

error("parse_gr_option : variables must be specified");

create_order_spec(vl,value,ord);

ord_is_set = 1;

} else if ( !strcmp(key,"block") ) {

create_order_spec(0,value,ord);

ord_is_set = 1;

} else if ( !strcmp(key,"matrix") ) {

create_order_spec(0,value,ord);

ord_is_set = 1;

} else if ( !strcmp(key,"sugarweight") ) {

/* weight */

Pdp_set_weight(NEXT(p),&dmy);

ord_is_set = 1;

} else if ( !strcmp(key,"homo") ) {

*homo = (Num)value;

homo_is_set = 1;

Line 1517 LIST *rp;

Line 1632 LIST *rp;

if ( !BDY(f) ) {

*rp = f; return;

}

if ( argc(arg) == 5 ) {

if ( (ac = argc(arg)) == 5 ) {

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

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

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

Line 1531 LIST *rp;

Line 1646 LIST *rp;

else

modular = QTOS(m);

create_order_spec(0,ARG4(arg),&ord);

} else if ( (ac=argc(arg)) == 2 && OID(ARG1(arg)) == O_OPTLIST )

} else if ( current_option )

parse_gr_option(f,BDY((OPTLIST)ARG1(arg)),&v,&homo,&modular,&ord);

parse_gr_option(f,current_option,&v,&homo,&modular,&ord);

else if ( ac == 1 )

parse_gr_option(f,0,&v,&homo,&modular,&ord);

else

Line 1717 LIST *rp;

Line 1832 LIST *rp;

nd_gr(f,v,m,0,ord,rp);

}

void Pnd_gr_postproc(arg,rp)

NODE arg;

LIST *rp;

{

LIST f,v;

int m,do_check;

struct order_spec *ord;

do_weyl = 0;

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

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

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

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

f = remove_zero_from_list(f);

if ( !BDY(f) ) {

*rp = f; return;

}

m = QTOS((Q)ARG2(arg));

create_order_spec(0,ARG3(arg),&ord);

do_check = ARG4(arg) ? 1 : 0;

nd_gr_postproc(f,v,m,ord,do_check,rp);

}

void Pnd_gr_trace(arg,rp)

NODE arg;

LIST *rp;

Line 1829 LIST *rp;

Line 1967 LIST *rp;

if ( !BDY(f) ) {

*rp = f; return;

}

if ( argc(arg) == 5 ) {

if ( (ac = argc(arg)) == 5 ) {

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");

Line 1843 LIST *rp;

Line 1981 LIST *rp;

else

modular = QTOS(m);

create_order_spec(0,ARG4(arg),&ord);

} else if ( (ac=argc(arg)) == 2 && OID(ARG1(arg)) == O_OPTLIST )

} else if ( current_option )

parse_gr_option(f,BDY((OPTLIST)ARG1(arg)),&v,&homo,&modular,&ord);

parse_gr_option(f,current_option,&v,&homo,&modular,&ord);

else if ( ac == 1 )

parse_gr_option(f,0,&v,&homo,&modular,&ord);

else

Line 1949 LIST *rp;

Line 2087 LIST *rp;

do_weyl = 0;

}

static VECT current_dl_weight_vector_obj;

VECT current_dl_weight_vector_obj;

int *current_dl_weight_vector;

void Pdp_set_weight(arg,rp)

Line 2052 int get_field_type(P p)

Line 2190 int get_field_type(P p)

return -1;

}

return type;

}

void Pdpv_ord(NODE arg,Obj *rp)

{

int ac,id;

LIST shift;

ac = argc(arg);

if ( ac ) {

id = QTOS((Q)ARG0(arg));

if ( ac > 1 && ARG1(arg) && OID((Obj)ARG1(arg))==O_LIST )

shift = (LIST)ARG1(arg);

else

shift = 0;

create_modorder_spec(id,shift,&dp_current_modspec);

}

*rp = dp_current_modspec->obj;

}

void Pdpv_ht(NODE arg,LIST *rp)

{

NODE n;

DP ht;

int pos;

DPV p;

Q q;

asir_assert(ARG0(arg),O_DPV,"dpv_ht");

p = (DPV)ARG0(arg);

pos = dpv_hp(p);

if ( pos < 0 )

ht = 0;

else

dp_ht(BDY(p)[pos],&ht);

STOQ(pos,q);

n = mknode(2,q,ht);

MKLIST(*rp,n);

}

void Pdpv_hm(NODE arg,LIST *rp)

{

NODE n;

DP ht;

int pos;

DPV p;

Q q;

asir_assert(ARG0(arg),O_DPV,"dpv_hm");

p = (DPV)ARG0(arg);

pos = dpv_hp(p);

if ( pos < 0 )

ht = 0;

else

dp_hm(BDY(p)[pos],&ht);

STOQ(pos,q);

n = mknode(2,q,ht);

MKLIST(*rp,n);

}

void Pdpv_hc(NODE arg,LIST *rp)

{

NODE n;

P hc;

int pos;

DPV p;

Q q;

asir_assert(ARG0(arg),O_DPV,"dpv_hc");

p = (DPV)ARG0(arg);

pos = dpv_hp(p);

if ( pos < 0 )

hc = 0;

else

hc = BDY(BDY(p)[pos])->c;

STOQ(pos,q);

n = mknode(2,q,hc);

MKLIST(*rp,n);

}

int dpv_hp(DPV p)

{

int len,i,maxp,maxw,w,slen;

int *shift;

DP *e;

len = p->len;

e = p->body;

slen = dp_current_modspec->len;

shift = dp_current_modspec->degree_shift;

switch ( dp_current_modspec->id ) {

case ORD_REVGRADLEX:

for ( maxp = -1, i = 0; i < len; i++ )

if ( !e[i] ) continue;

else if ( maxp < 0 ) {

maxw = BDY(e[i])->dl->td+(i<slen?shift[i]:0); maxp = i;

} else {

w = BDY(e[i])->dl->td+(i<slen?shift[i]:0);

if ( w >= maxw ) {

maxw = w; maxp = i;

}

return maxp;

case ORD_GRADLEX:

for ( maxp = -1, i = 0; i < len; i++ )

if ( !e[i] ) continue;

else if ( maxp < 0 ) {

maxw = BDY(e[i])->dl->td+(i<slen?shift[i]:0); maxp = i;

} else {

w = BDY(e[i])->dl->td+(i<slen?shift[i]:0);

if ( w > maxw ) {

maxw = w; maxp = i;

}

return maxp;

break;

case ORD_LEX:

for ( i = 0; i < len; i++ )

if ( e[i] ) return i;

return -1;

break;

}

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