Annotation of OpenXM_contrib2/asir2000/engine/dalg.c, Revision 1.2
1.1 noro 1: /*
1.2 ! noro 2: * $OpenXM: OpenXM_contrib2/asir2000/engine/dalg.c,v 1.1 2004/12/02 08:23:25 noro Exp $
1.1 noro 3: */
4:
5: #include "ca.h"
6: #include "base.h"
7:
8: typedef struct oNumberField {
9: int n;
10: int dim;
11: VL vl;
12: P *defpoly;
13: DP *mb;
14: DP *ps;
15: NODE ind;
16: struct order_spec *spec;
17: } *NumberField;
18:
19: typedef struct oDAlg {
20: short id;
21: char nid;
22: char pad;
23: DP nm;
24: Q dn;
25: } *DAlg;
26:
27: #define N_DA 11
28: #define NEWDAlg(r) ((r)=(DAlg)MALLOC(sizeof(struct oDAlg)),OID(r)=O_N,NID(r)=N_DA)
1.2 ! noro 29: #define MKDAlg(dp,den,r) (NEWDAlg(r),(r)->nm = (dp),(r)->dn=(den))
1.1 noro 30:
31: static NumberField current_numberfield;
32: extern struct order_spec *dp_current_spec;
1.2 ! noro 33: void simpdalg(DAlg da,DAlg *r);
1.1 noro 34:
35: void setfield_dalg(NODE alist)
36: {
37: NumberField nf;
38: VL vl,vl1,vl2;
39: int n,i,dim;
40: Alg *gen;
41: P *defpoly;
42: P p;
43: Q c,iq,two;
44: DP *ps,*mb;
45: NODE t,b,b1,b2,hlist,mblist;
46: struct order_spec *current_spec;
47:
48: nf = (NumberField)MALLOC(sizeof(struct oNumberField));
49: current_numberfield = nf;
50: vl = 0;
51: for ( t = alist; t; t = NEXT(t) ) {
52: clctalg(BDY((Alg)BDY(t)),&vl1);
53: mergev(ALG,vl,vl1,&vl2); vl = vl2;
54: }
55: for ( n = 0, vl1 = vl; vl1; vl1 = NEXT(vl1), n++ );
56: nf->n = n;
57: nf->vl = vl;
58: nf->defpoly = defpoly = (P *)MALLOC(n*sizeof(P));
59: nf->ps = ps = (DP *)MALLOC(n*sizeof(DP));
60: current_spec = dp_current_spec;
61: STOQ(2,two);
62: create_order_spec(0,(Obj)two,&nf->spec);
63: initd(nf->spec);
64: for ( b = hlist = 0, i = 0, vl1 = vl; i < n; vl1 = NEXT(vl1), i++ ) {
65: ptozp(vl1->v->attr,1,&c,&defpoly[i]);
66: ptod(ALG,vl,defpoly[i],&ps[i]);
67: STOQ(i,iq); MKNODE(b1,(pointer)iq,b); b = b1;
68: MKNODE(b2,(pointer)ps[i],&hlist); hlist = b2;
69: }
70: initd(current_spec);
71: nf->ind = b;
72: dp_base(hlist,&mblist);
73: nf->dim = dim = length(mblist);
74: nf->mb = mb = (DP *)MALLOC(dim*sizeof(DP));
75: for ( i = 0, t = mblist; t; t = NEXT(t), i++ )
76: mb[i] = (DP)BDY(mblist);
77: }
78:
79: void algtodalg(Alg a,DAlg *r)
80: {
81: P ap,p,p1;
82: Q c,dn,nm;
83: DP dp;
84: DAlg da;
85: NumberField nf;
86: struct order_spec *current_spec;
87:
88: if ( !(nf=current_numberfield) )
89: error("algtodalg : current_numberfield is not set");
90: ap = (P)BDY(a);
91: ptozp(ap,1,&c,&p);
92: if ( INT(c) ) {
93: p = ap;
94: dn = ONE;
95: } else {
96: NTOQ(NM(c),SGN(c),nm);
97: NTOQ(DN(c),1,dn);
98: mulpq(p,(P)nm,&p1); p = p1;
99: }
100: current_spec = dp_current_spec;
101: initd(nf->spec);
102: ptod(ALG,nf->vl,p,&dp);
103: MKDAlg(dp,dn,da);
1.2 ! noro 104: simpdalg(da,r);
1.1 noro 105: }
106:
1.2 ! noro 107: void dalgtoalg(DAlg da,Alg *r)
1.1 noro 108: {
1.2 ! noro 109: NumberField nf;
! 110: P p,p1;
! 111: Q inv;
! 112:
! 113: if ( !(nf=current_numberfield) )
1.1 noro 114: error("algtodalg : current_numberfield is not set");
1.2 ! noro 115: dtop(ALG,nf->vl,da->nm,&p);
! 116: invq(da->dn,&inv);
! 117: mulpq(p,(P)inv,&p1);
! 118: MKAlg(p1,*r);
1.1 noro 119: }
120:
121: void simpdalg(DAlg da,DAlg *r)
122: {
1.2 ! noro 123: NumberField nf;
! 124: DP nm;
! 125: Q dn,dn1;
! 126:
! 127: if ( !(nf=current_numberfield) )
1.1 noro 128: error("algtodalg : current_numberfield is not set");
1.2 ! noro 129: dp_true_nf(nf->ind,da->nm,nf->ps,1,&nm,&dn);
! 130: mulq(da->dn,dn,&dn1);
! 131: MKDAlg(nm,dn1,*r);
1.1 noro 132: }
133:
134: void adddalg(DAlg a,DAlg b,DAlg *c)
135: {
136: if ( !current_numberfield )
137: error("algtodalg : current_numberfield is not set");
138: }
139:
140: void subdalg(DAlg a,DAlg b,DAlg *c)
141: {
142: if ( !current_numberfield )
143: error("algtodalg : current_numberfield is not set");
144: }
145:
1.2 ! noro 146: void muldalg(DAlg a,DAlg b,DAlg *c)
! 147: {
! 148: if ( !current_numberfield )
! 149: error("algtodalg : current_numberfield is not set");
! 150: }
! 151:
! 152:
1.1 noro 153: void divdalg(DAlg a,DAlg b,DAlg *c)
154: {
155: if ( !current_numberfield )
156: error("algtodalg : current_numberfield is not set");
157: }
158:
159: void invdalg(DAlg a,DAlg *c)
160: {
161: if ( !current_numberfield )
162: error("algtodalg : current_numberfield is not set");
163: }
164:
165: void chsgndalg(DAlg a,DAlg *c)
166: {
167: }
168:
169: void pwrdalg(DAlg a,Q b,DAlg *c)
170: {
171: if ( !current_numberfield )
172: error("algtodalg : current_numberfield is not set");
173: }
174:
175: int cmpgdalg(DAlg a,DAlg b)
176: {
177: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>