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.57 and 1.68

version 1.57, 2004/12/09 08:56:43

version 1.68, 2007/09/06 02:23:40

Line 6

* non-exclusive and royalty-free license to use, copy, modify and

* redistribute, solely for non-commercial and non-profit purposes, the

* computer program, "Risa/Asir" ("SOFTWARE"), subject to the terms and

* conditions of this Agreement. For the avoidance of doubt, you acquire

* conditions of this Agreement. For the avoidance of doubt, you acquire * only a limited right to use the SOFTWARE hereunder, and FLL or any

* only a limited right to use the SOFTWARE hereunder, and FLL or any

* third party developer retains all rights, including but not limited to

* copyrights, in and to the SOFTWARE.

Line 45

Line 44

* 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.56 2004/12/06 09:29:34 noro Exp $

* $OpenXM: OpenXM_contrib2/asir2000/builtin/dp.c,v 1.67 2007/08/21 23:53:00 noro Exp $

#include "ca.h"

#include "base.h"

#include "parse.h"

extern int dp_fcoeffs;

extern int dp_nelim;

extern int dp_order_pair_length;

extern struct order_pair *dp_order_pair;

Line 61 int do_weyl;

void Pdp_sort();

void Pdp_mul_trunc(),Pdp_quo();

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

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

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_set_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();

void Pdp_nf(),Pdp_true_nf(),Pdp_true_nf_marked();

void Pdp_nf_mod(),Pdp_true_nf_mod();

void Pdp_criB(),Pdp_nelim();

void Pdp_minp(),Pdp_sp_mod();

void Pdp_homo(),Pdp_dehomo();

void Pdp_gr_mod_main(),Pdp_gr_f_main();

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

void Pdp_interreduce();

void Pdp_f4_main(),Pdp_f4_mod_main(),Pdp_f4_f_main();

void Pdp_gr_print();

void Pdp_mbase(),Pdp_lnf_mod(),Pdp_nf_tab_mod(),Pdp_mdtod(), Pdp_nf_tab_f();

Line 92 void Pdp_weyl_set_weight();

Line 93 void Pdp_weyl_set_weight();

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(),Pnd_gr_trace(),Pnd_f4(),Pnd_f4_trace();

void Pnd_gr_postproc();

void Pnd_weyl_gr(),Pnd_weyl_gr_trace();

void Pnd_nf();

void Pdp_initial_term();

void Pdp_order();

void Pdp_inv_or_split();

void Pdp_compute_last_w();

LIST dp_initial_term();

LIST dp_order();

Line 130 struct ftab dp_tab[] = {

Line 134 struct ftab dp_tab[] = {

{"dp_nf",Pdp_nf,4},

{"dp_nf_f",Pdp_nf_f,4},

{"dp_true_nf",Pdp_true_nf,4},

{"dp_true_nf_marked",Pdp_true_nf_marked,4},

{"dp_nf_mod",Pdp_nf_mod,5},

{"dp_true_nf_mod",Pdp_true_nf_mod,5},

{"dp_lnf_mod",Pdp_lnf_mod,3},

Line 139 struct ftab dp_tab[] = {

Line 144 struct ftab dp_tab[] = {

/* Buchberger algorithm */

{"dp_gr_main",Pdp_gr_main,-5},

{"dp_interreduce",Pdp_interreduce,3},

{"dp_gr_mod_main",Pdp_gr_mod_main,5},

{"dp_gr_f_main",Pdp_gr_f_main,4},

{"dp_gr_checklist",Pdp_gr_checklist,2},

{"nd_f4",Pnd_f4,4},

{"nd_gr",Pnd_gr,4},

{"nd_gr_trace",Pnd_gr_trace,5},

{"nd_f4_trace",Pnd_f4_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 179 struct ftab dp_tab[] = {

Line 187 struct ftab dp_tab[] = {

{"dp_weyl_f4_mod_main",Pdp_weyl_f4_mod_main,4},

/* misc */

{"dp_inv_or_split",Pdp_inv_or_split,3},

{"dp_set_weight",Pdp_set_weight,-1},

{"dp_weyl_set_weight",Pdp_weyl_set_weight,-1},

{0,0,0},

Line 195 struct ftab dp_supp_tab[] = {

Line 204 struct ftab dp_supp_tab[] = {

{"dp_gr_print",Pdp_gr_print,-1},

/* converters */

{"homogenize",Phomogenize,3},

{"dp_ptod",Pdp_ptod,-2},

{"dp_dtop",Pdp_dtop,2},

{"dp_homo",Pdp_homo,1},

Line 238 struct ftab dp_supp_tab[] = {

Line 248 struct ftab dp_supp_tab[] = {

{"dp_idiv",Pdp_idiv,2},

{"dp_tdiv",Pdp_tdiv,2},

{"dp_minp",Pdp_minp,2},

{"dp_compute_last_w",Pdp_compute_last_w,5},

{0,0,0}

};

NODE compute_last_w(NODE g,NODE gh,int n,int **v,int row1,int **m1,int row2,int **m2);

void Pdp_compute_last_w(NODE arg,LIST *rp)

{

NODE g,gh,r;

VECT w,rv;

LIST l;

MAT w1,w2;

int row1,row2,i,j,n;

int *v;

int **m1,**m2;

Q q;

g = (NODE)BDY((LIST)ARG0(arg));

gh = (NODE)BDY((LIST)ARG1(arg));

w = (VECT)ARG2(arg);

w1 = (MAT)ARG3(arg);

w2 = (MAT)ARG4(arg);

n = w1->col;

row1 = w1->row;

row2 = w2->row;

if ( w ) {

v = W_ALLOC(n);

for ( i = 0; i < n; i++ ) v[i] = QTOS((Q)w->body[i]);

} else v = 0;

m1 = almat(row1,n);

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

for ( j = 0; j < n; j++ ) m1[i][j] = QTOS((Q)w1->body[i][j]);

m2 = almat(row2,n);

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

for ( j = 0; j < n; j++ ) m2[i][j] = QTOS((Q)w2->body[i][j]);

r = compute_last_w(g,gh,n,&v,row1,m1,row2,m2);

if ( !r ) *rp = 0;

else {

MKVECT(rv,n);

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

STOQ(v[i],q); rv->body[i] = (pointer)q;

}

MKLIST(l,r);

r = mknode(2,rv,l);

MKLIST(*rp,r);

}

void Pdp_inv_or_split(arg,rp)

NODE arg;

Obj *rp;

{

NODE gb,newgb;

DP f,inv;

struct order_spec *spec;

LIST list;

do_weyl = 0; dp_fcoeffs = 0;

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

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

if ( !create_order_spec(0,(Obj)ARG2(arg),&spec) )

error("dp_inv_or_split : invalid order specification");

gb = BDY((LIST)ARG0(arg));

f = (DP)ARG1(arg);

newgb = (NODE)dp_inv_or_split(gb,f,spec,&inv);

if ( !newgb ) {

/* invertible */

*rp = (Obj)inv;

} else {

MKLIST(list,newgb);

*rp = (Obj)list;

}

void Pdp_sort(arg,rp)

NODE arg;

DP *rp;

Line 439 Obj *rp;

Line 520 Obj *rp;

int modular;

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

if ( !arg )

if ( !arg && !current_option )

*rp = dp_current_spec->obj;

else {

if ( current_option )

Line 491 DP *rp;

Line 572 DP *rp;

ptod(CO,vl,p,rp);

}

void Phomogenize(arg,rp)

NODE arg;

P *rp;

{

P p;

DP d,h;

NODE n;

V hv;

VL vl,tvl,last;

struct oLIST f;

LIST v;

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

p = (P)ARG0(arg);

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

v = (LIST)ARG1(arg);

asir_assert(ARG2(arg),O_P,"homogenize");

hv = VR((P)ARG2(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 ) {

last = tvl;

NEXT(tvl) = 0;

}

ptod(CO,vl,p,&d);

dp_homo(d,&h);

NEWVL(NEXT(last)); last = NEXT(last);

VR(last) = hv; NEXT(last) = 0;

dtop(CO,vl,h,rp);

}

void Pdp_ltod(arg,rp)

NODE arg;

DPV *rp;

Line 566 extern LIST Dist;

Line 684 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 634 DP *rp;

Line 784 DP *rp;

DP g;

int full;

do_weyl = 0;

do_weyl = 0; dp_fcoeffs = 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 759 LIST *rp;

Line 909 LIST *rp;

P dn;

int full;

do_weyl = 0;

do_weyl = 0; dp_fcoeffs = 0;

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

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

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

Line 776 LIST *rp;

Line 926 LIST *rp;

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

}

void Pdp_true_nf_marked(arg,rp)

NODE arg;

LIST *rp;

{

NODE b,n;

DP *ps,*hps;

DP g;

DP nm;

P dn;

int full;

do_weyl = 0; dp_fcoeffs = 0;

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

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

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

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

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

nm = 0; dn = (P)ONE;

} else {

b = BDY((LIST)ARG0(arg));

ps = (DP *)BDY((VECT)ARG2(arg));

hps = (DP *)BDY((VECT)ARG3(arg));

dp_true_nf_marked(b,g,ps,hps,&nm,&dn);

}

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

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

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

}

void Pdp_weyl_nf_mod(arg,rp)

NODE arg;

DP *rp;

Line 1621 LIST *rp;

Line 1800 LIST *rp;

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

}

void Pdp_interreduce(arg,rp)

NODE arg;

LIST *rp;

{

LIST f,v;

VL vl;

int ac;

struct order_spec *ord;

do_weyl = 0;

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

f = (LIST)ARG0(arg);

f = remove_zero_from_list(f);

if ( !BDY(f) ) {

*rp = f; return;

}

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

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

v = (LIST)ARG1(arg);

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

}

dp_interreduce(f,v,0,ord,rp);

}

void Pdp_gr_f_main(arg,rp)

NODE arg;

LIST *rp;

Line 1798 LIST *rp;

Line 2001 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 1819 LIST *rp;

Line 2045 LIST *rp;

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

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

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

nd_gr_trace(f,v,m,homo,ord,rp);

nd_gr_trace(f,v,m,homo,0,ord,rp);

}

void Pnd_f4_trace(arg,rp)

NODE arg;

LIST *rp;

{

LIST f,v;

int m,homo;

struct order_spec *ord;

do_weyl = 0;

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

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

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

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

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

f = remove_zero_from_list(f);

if ( !BDY(f) ) {

*rp = f; return;

}

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

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

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

nd_gr_trace(f,v,m,homo,1,ord,rp);

}

void Pnd_weyl_gr(arg,rp)

NODE arg;

LIST *rp;

Line 1865 LIST *rp;

Line 2115 LIST *rp;

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

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

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

nd_gr_trace(f,v,m,homo,ord,rp);

nd_gr_trace(f,v,m,homo,0,ord,rp);

}

void Pnd_nf(arg,rp)

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