![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to bracket_polynomials.adb CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib / PHC / Ada / Schubert|
Return to bracket_polynomials.adb CVS log | Up to [local] / OpenXM_contrib / PHC / Ada / Schubert |
1.1 maekawa 1: package body Bracket_Polynomials is
2:
3: -- CONSTRUCTORS :
4:
5: function Create ( m : Bracket_Monomial ) return Bracket_Polynomial is
6:
7: t : Bracket_Term;
8:
9: begin
10: t.coeff := Create(1.0);
11: t.monom := m;
12: return Create(t);
13: end Create;
14:
15: function Create ( t : Bracket_Term ) return Bracket_Polynomial is
16:
17: p : Bracket_Polynomial;
18:
19: begin
20: Construct(t,p);
21: return p;
22: end Create;
23:
24: procedure Copy ( t1 : in Bracket_Term; t2 : in out Bracket_Term ) is
25: begin
26: t2.coeff := t1.coeff;
27: Copy(t1.monom,t2.monom);
28: end Copy;
29:
30: procedure Copy ( p : in Bracket_Polynomial; q : in out Bracket_Polynomial ) is
31:
32: tmp : Bracket_Polynomial := p;
33:
34: begin
35: Clear(q);
36: while not Is_Null(tmp) loop
37: Add(q,Head_Of(tmp));
38: end loop;
39: end Copy;
40:
41: -- COMPARISON OPERATIONS :
42:
43: function Is_Equal ( t1,t2 : Bracket_Term ) return boolean is
44: begin
45: return (t1.coeff = t2.coeff and then Is_Equal(t1.monom,t2.monom));
46: end Is_Equal;
47:
48: function Is_Equal ( p,q : Bracket_Polynomial ) return boolean is
49:
50: tmp1 : Bracket_Polynomial := p;
51: tmp2 : Bracket_Polynomial := q;
52:
53: begin
54: while not Is_Null(tmp1) and not Is_Null(tmp2) loop
55: if not Is_Equal(Head_Of(tmp1),Head_Of(tmp2))
56: then return false;
57: else tmp1 := Tail_Of(tmp1); tmp2 := Tail_Of(tmp2);
58: end if;
59: end loop;
60: if Is_Null(tmp1) and Is_Null(tmp2)
61: then return true;
62: else return false;
63: end if;
64: end Is_Equal;
65:
66: function "<" ( t1,t2 : Bracket_Term ) return boolean is
67: begin
68: return t1.monom < t2.monom;
69: end "<";
70:
71: function ">" ( t1,t2 : Bracket_Term ) return boolean is
72: begin
73: return t1.monom > t2.monom;
74: end ">";
75:
76: -- ARITHMETIC OPERATIONS :
77:
78: function "+" ( t : Bracket_Term; p : Bracket_Polynomial )
79: return Bracket_Polynomial is
80:
81: res : Bracket_Polynomial;
82:
83: begin
84: Copy(p,res);
85: Add(res,t);
86: return res;
87: end "+";
88:
89: function "+" ( p : Bracket_Polynomial; t : Bracket_Term )
90: return Bracket_Polynomial is
91:
92: res : Bracket_Polynomial;
93:
94: begin
95: Copy(p,res);
96: Add(res,t);
97: return res;
98: end "+";
99:
100: procedure Add ( p : in out Bracket_Polynomial; t : in Bracket_Term ) is
101:
102: tt : Bracket_Term;
103:
104: begin
105: Copy(t,tt);
106: if Is_Null(p)
107: then p := Create(tt);
108: else declare
109: first,second : Bracket_Polynomial;
110: t1,t2 : Bracket_Term;
111: begin
112: first := p; second := Tail_Of(p);
113: t1 := Head_Of(first);
114: if t > t1
115: then Construct(tt,p);
116: elsif Is_Equal(t.monom,t1.monom)
117: then t1.coeff := t1.coeff + t.coeff;
118: if t1.coeff = Create(0.0)
119: then Clear(t1);
120: p := Tail_Of(p);
121: else Set_Head(p,t1);
122: end if;
123: else while not Is_Null(second) loop -- merge term in list
124: t1 := Head_Of(second);
125: if t > t1
126: then Construct(tt,second);
127: Swap_Tail(first,second);
128: exit;
129: elsif Is_Equal(t.monom,t1.monom)
130: then t1.coeff := t1.coeff + t.coeff;
131: if t1.coeff = Create(0.0)
132: then Clear(t1);
133: Swap_Tail(first,second);
134: else Set_Head(second,t1);
135: end if;
136: exit;
137: end if;
138: first := Tail_Of(first);
139: second := Tail_Of(second);
140: end loop;
141: if Is_Null(second) -- then first points to last
142: then Append(p,first,tt); -- element of the list p
143: end if;
144: end if;
145: end;
146: end if;
147: end Add;
148:
149: procedure Frontal_Add ( p : in out Bracket_Polynomial;
150: t : in Bracket_Term ) is
151:
152: tt : Bracket_Term;
153:
154: begin
155: Copy(t,tt);
156: Construct(tt,p);
157: end Frontal_Add;
158:
159: procedure Frontal_Min ( p : in out Bracket_Polynomial;
160: t : in Bracket_Term ) is
161:
162: mt : Bracket_Term := -t;
163:
164: begin
165: Construct(mt,p);
166: end Frontal_Min;
167:
168: function "+" ( p,q : Bracket_Polynomial ) return Bracket_Polynomial is
169:
170: res : Bracket_Polynomial;
171:
172: begin
173: Copy(p,res);
174: Add(res,q);
175: return res;
176: end "+";
177:
178: procedure Add ( p : in out Bracket_Polynomial; q : in Bracket_Polynomial ) is
179:
180: tmp : Bracket_Polynomial := q;
181:
182: begin
183: while not Is_Null(tmp) loop
184: Add(p,Head_Of(tmp));
185: tmp := Tail_Of(tmp);
186: end loop;
187: end Add;
188:
189: function "-" ( t : Bracket_Term ) return Bracket_Term is
190:
191: res : Bracket_Term;
192:
193: begin
194: Copy(t.monom,res.monom);
195: res.coeff := -t.coeff;
196: return res;
197: end "-";
198:
199: procedure Min ( t : in out Bracket_Term ) is
200: begin
201: t.coeff := -t.coeff;
202: end Min;
203:
204: function "-" ( p : Bracket_Polynomial ) return Bracket_Polynomial is
205:
206: res : Bracket_Polynomial;
207:
208: begin
209: Copy(p,res);
210: Min(res);
211: return res;
212: end "-";
213:
214: procedure Min ( p : in out Bracket_Polynomial ) is
215:
216: tmp : Bracket_Polynomial := p;
217:
218: begin
219: while not Is_Null(tmp) loop
220: declare
221: bt : Bracket_Term := Head_Of(tmp);
222: begin
223: Min(bt);
224: Set_Head(tmp,bt);
225: end;
226: tmp := Tail_Of(tmp);
227: end loop;
228: end Min;
229:
230: function "-" ( t : Bracket_Term; p : Bracket_Polynomial )
231: return Bracket_Polynomial is
232:
233: mp : Bracket_Polynomial := -p;
234: res : Bracket_Polynomial := t+mp;
235:
236: begin
237: Clear(mp);
238: return res;
239: end "-";
240:
241: function "-" ( p : Bracket_Polynomial; t : Bracket_Term )
242: return Bracket_Polynomial is
243:
244: mt : Bracket_Term := -t;
245: res : Bracket_Polynomial := p+mt;
246:
247: begin
248: Clear(mt);
249: return res;
250: end "-";
251:
252: procedure Min ( p : in out Bracket_Polynomial; t : in Bracket_Term ) is
253:
254: mt : Bracket_Term := -t;
255:
256: begin
257: Add(p,mt);
258: end Min;
259:
260: function "-" ( p,q : Bracket_Polynomial ) return Bracket_Polynomial is
261:
262: mq : Bracket_Polynomial := -q;
263: res : Bracket_Polynomial := p+mq;
264:
265: begin
266: Clear(mq);
267: return res;
268: end "-";
269:
270: procedure Min ( p : in out Bracket_Polynomial; q : in Bracket_Polynomial ) is
271:
272: mq : Bracket_Polynomial := -q;
273:
274: begin
275: Add(p,mq);
276: end Min;
277:
278: -- ITERATORS OVER MONOMIALS :
279:
280: function Number_of_Monomials ( p : Bracket_Polynomial ) return natural is
281: begin
282: return Length_Of(p);
283: end Number_of_Monomials;
284:
285: procedure Enumerate_Terms ( p : in Bracket_Polynomial ) is
286:
287: tmp : Bracket_Polynomial := p;
288: continue : boolean := true;
289:
290: begin
291: while not Is_Null(tmp) loop
292: Process(Head_Of(tmp),continue);
293: exit when not continue;
294: tmp := Tail_Of(tmp);
295: end loop;
296: end Enumerate_Terms;
297:
298: -- DESTRUCTOR :
299:
300: procedure Clear ( t : in out Bracket_Term ) is
301: begin
302: Clear(t.monom);
303: end Clear;
304:
305: procedure Clear ( p : in out Bracket_Polynomial ) is
306:
307: tmp : Bracket_Polynomial := p;
308:
309: begin
310: while not Is_Null(tmp) loop
311: declare
312: t : Bracket_Term := Head_Of(tmp);
313: begin
314: Clear(t);
315: end;
316: tmp := Tail_Of(tmp);
317: end loop;
318: Lists_of_Bracket_Terms.Clear(Lists_of_Bracket_Terms.List(p));
319: end Clear;
320:
321: end Bracket_Polynomials;