Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Implift/transforming_laurent_systems.adb, Revision 1.1.1.1
1.1 maekawa 1: with Standard_Complex_Numbers; use Standard_Complex_Numbers;
2: with Integer_Vectors_Utilities; use Integer_Vectors_Utilities;
3:
4: package body Transforming_Laurent_Systems is
5:
6: function Initial_Link_to_Vector ( p : Poly ) return Link_to_Vector is
7:
8: -- DESCRIPTION :
9: -- Returns the initial degrees of the polynomial p.
10:
11: init : Link_to_Vector;
12:
13: procedure Init_Term ( t : in Term; cont : out boolean ) is
14: begin
15: init := new Standard_Integer_Vectors.Vector'(t.dg.all);
16: cont := false;
17: end Init_Term;
18: procedure Initial_Term is new Visiting_Iterator (Init_Term);
19:
20: begin
21: Initial_Term(p);
22: return init;
23: end Initial_Link_to_Vector;
24:
25: procedure Shift ( p : in out Poly ) is
26:
27: init : Link_to_Vector := Initial_Link_to_Vector(p);
28:
29: procedure Shift_Term ( t : in out Term; cont : out boolean ) is
30: begin
31: Sub(Link_to_Vector(t.dg),init);
32: cont := true;
33: end Shift_Term;
34: procedure Shift_Terms is new Changing_Iterator (Shift_Term);
35:
36: begin
37: if p /= Null_Poly
38: then Shift_Terms(p);
39: end if;
40: Clear(init);
41: end Shift;
42:
43: function Shift ( p : Poly ) return Poly is
44:
45: res : Poly := Null_Poly;
46: init : Link_to_Vector := Initial_Link_to_Vector(p);
47:
48: procedure Shift_Term ( t : in Term; cont : out boolean ) is
49: rt : Term;
50: begin
51: rt.cf := t.cf;
52: rt.dg := t.dg - Degrees(init);
53: Add(res,rt);
54: Clear(rt);
55: cont := true;
56: end Shift_Term;
57: procedure Shift_Terms is new Visiting_Iterator (Shift_Term);
58:
59: begin
60: if p /= Null_Poly
61: then Shift_Terms(p);
62: end if;
63: Clear(init);
64: return res;
65: end Shift;
66:
67: procedure Shift ( l : in out Laur_Sys ) is
68: begin
69: for k in l'range loop
70: Shift(l(k));
71: end loop;
72: end Shift;
73:
74: function Shift ( l : Laur_Sys ) return Laur_Sys is
75:
76: res : Laur_Sys (l'range);
77:
78: begin
79: for k in l'range loop
80: res(k) := Shift(l(k));
81: end loop;
82: return res;
83: end Shift;
84:
85: procedure Transform ( t : in Transfo; p : in out Poly ) is
86:
87: procedure Transform_Term ( tt : in out Term; cont : out boolean ) is
88: begin
89: Apply(t,Link_to_Vector(tt.dg));
90: cont := true;
91: end Transform_Term;
92: procedure Transform_Terms is new Changing_Iterator (Transform_Term);
93:
94: begin
95: Transform_Terms(p);
96: end Transform;
97:
98: function Transform ( t : Transfo; p : Poly ) return Poly is
99:
100: res : Poly;
101:
102: begin
103: Copy(p,res);
104: Transform(t,res);
105: return res;
106: end Transform;
107:
108: function Transform2 ( t : Transfo; p : Poly ) return Poly is
109:
110: -- IMPORTANT : This function might change the term order !
111:
112: res : Poly := Null_Poly;
113:
114: procedure Transform_Term ( tt : in Term; cont : out boolean ) is
115: rt : Term;
116: begin
117: rt.cf := tt.cf;
118: rt.dg := Degrees(t*Link_to_Vector(tt.dg));
119: Add(res,rt);
120: Clear(rt);
121: cont := true;
122: end Transform_Term;
123: procedure Transform_Terms is new Visiting_Iterator (Transform_Term);
124:
125: begin
126: Transform_Terms(p);
127: return res;
128: end Transform2;
129:
130: procedure Transform ( t : in Transfo; l : in out Laur_Sys ) is
131: begin
132: for i in l'range loop
133: Transform(t,l(i));
134: end loop;
135: end Transform;
136:
137: function Transform ( t : Transfo; l : Laur_Sys ) return Laur_Sys is
138:
139: res : Laur_Sys(l'range);
140:
141: begin
142: for i in l'range loop
143: res(i) := Transform(t,l(i));
144: end loop;
145: return res;
146: end Transform;
147:
148: function Maximal_Support ( p : Poly; v : Vector ) return integer is
149:
150: res : integer;
151: first : boolean := true;
152:
153: procedure Scan_Term ( t : in Term; cont : out boolean ) is
154:
155: sp : integer := t.dg.all*v;
156:
157: begin
158: if first
159: then res := sp; first := false;
160: elsif sp > res
161: then res := sp;
162: end if;
163: cont := true;
164: end Scan_Term;
165: procedure Scan_Terms is new Visiting_Iterator (Scan_Term);
166:
167: begin
168: Scan_Terms(p);
169: return res;
170: end Maximal_Support;
171:
172: function Maximal_Support ( p : Poly; v : Link_to_Vector ) return integer is
173: begin
174: return Maximal_Support(p,v.all);
175: end Maximal_Support;
176:
177: procedure Face ( i,m : in integer; p : in out Poly ) is
178:
179: procedure Face_Term ( t : in out Term; cont : out boolean ) is
180: begin
181: if t.dg(i) /= m
182: then t.cf := Create(0.0);
183: end if;
184: cont := true;
185: end Face_Term;
186: procedure Face_Terms is new Changing_Iterator(Face_Term);
187:
188: begin
189: Face_Terms(p);
190: end Face;
191:
192: function Face ( i,m : integer; p : Poly ) return Poly is
193:
194: res : Poly;
195:
196: begin
197: Copy(p,res);
198: Face(i,m,res);
199: return res;
200: end Face;
201:
202: function Face2 ( i,m : integer; p : Poly ) return Poly is
203:
204: -- IMPORTANT : This function might change the term order !
205:
206: res : Poly := Null_Poly;
207:
208: procedure Face_Term ( t : in Term; cont : out boolean ) is
209: begin
210: if t.dg(i) = m
211: then Add(res,t);
212: end if;
213: cont := true;
214: end Face_Term;
215: procedure Face_Terms is new Visiting_Iterator(Face_Term);
216:
217: begin
218: Face_Terms(p);
219: return res;
220: end Face2;
221:
222: procedure Face ( i,m : in integer; l : in out Laur_Sys ) is
223: begin
224: for j in l'range loop
225: Face(i,m,l(j));
226: end loop;
227: end Face;
228:
229: function Face ( i,m : integer; l : Laur_Sys ) return Laur_Sys is
230:
231: res : Laur_Sys(l'range);
232:
233: begin
234: for j in l'range loop
235: res(j) := Face(i,m,l(j));
236: end loop;
237: return res;
238: end Face;
239:
240: procedure Face ( v : in Vector; m : in integer; p : in out Poly ) is
241:
242: procedure Face_Term ( t : in out Term; cont : out boolean ) is
243: begin
244: if t.dg.all*v /= m
245: then t.cf := Create(0.0);
246: end if;
247: cont := true;
248: end Face_Term;
249: procedure Face_Terms is new Changing_Iterator(Face_Term);
250:
251: begin
252: Face_Terms(p);
253: end Face;
254:
255: function Face ( v : Vector; m : integer; p : Poly ) return Poly is
256:
257: res : Poly;
258:
259: begin
260: Copy(p,res);
261: Face(v,m,res);
262: return res;
263: end Face;
264:
265: function Face2 ( v : Vector; m : integer; p : Poly ) return Poly is
266:
267: -- IMPORTANT : This procedure might change the term order !
268:
269: res : Poly := Null_Poly;
270:
271: procedure Face_Term ( t : in Term; cont : out boolean ) is
272: begin
273: if t.dg.all*v = m
274: then Add(res,t);
275: end if;
276: cont := true;
277: end Face_Term;
278: procedure Face_Terms is new Visiting_Iterator(Face_Term);
279:
280: begin
281: Face_Terms(p);
282: return res;
283: end Face2;
284:
285: procedure Face ( v,m : in Vector; l : in out Laur_Sys ) is
286: begin
287: for i in l'range loop
288: Face(v,m(i),l(i));
289: end loop;
290: end Face;
291:
292: function Face ( v,m : Vector; l : Laur_Sys ) return Laur_Sys is
293:
294: res : Laur_Sys(l'range);
295:
296: begin
297: for i in l'range loop
298: res(i) := Face(v,m(i),l(i));
299: end loop;
300: return res;
301: end Face;
302:
303: procedure Reduce ( i : in integer; p : in out Poly ) is
304:
305: procedure Reduce_Term ( t : in out Term; cont : out boolean ) is
306: begin
307: Reduce(Link_to_Vector(t.dg),i);
308: cont := true;
309: end Reduce_Term;
310: procedure Reduce_Terms is new Changing_Iterator (Reduce_Term);
311:
312: begin
313: Reduce_Terms(p);
314: end Reduce;
315:
316: function Reduce ( i : integer; p : Poly ) return Poly is
317: res : Poly;
318: begin
319: Copy(p,res);
320: Reduce(i,res);
321: return res;
322: end Reduce;
323:
324: function Reduce2 ( i : integer; p : Poly ) return Poly is
325:
326: -- IMPORTANT : This function might change the term order !
327:
328: res : Poly := Null_Poly;
329:
330: procedure Reduce_Term ( t : in Term; cont : out boolean ) is
331: rt : Term;
332: begin
333: rt.cf := t.cf;
334: rt.dg := Degrees(Reduce(Link_to_Vector(t.dg),i));
335: Add(res,rt);
336: Clear(rt);
337: cont := true;
338: end Reduce_Term;
339: procedure Reduce_Terms is new Visiting_Iterator (Reduce_Term);
340:
341: begin
342: Reduce_Terms(p);
343: return res;
344: end Reduce2;
345:
346: procedure Reduce ( i : in integer; l : in out Laur_Sys ) is
347: begin
348: for j in l'range loop
349: Reduce(i,l(j));
350: end loop;
351: end Reduce;
352:
353: function Reduce ( i : integer; l : Laur_Sys ) return Laur_Sys is
354: res : Laur_Sys(l'range);
355: begin
356: for j in l'range loop
357: res(j) := Reduce(i,l(j));
358: end loop;
359: return res;
360: end Reduce;
361:
362: procedure Insert ( i,d : in integer; p : in out Poly ) is
363:
364: procedure Insert_Term ( t : in out Term; cont : out boolean ) is
365: begin
366: Insert(Link_to_Vector(t.dg),i,d);
367: cont := true;
368: end Insert_Term;
369: procedure Insert_Terms is new Changing_Iterator (Insert_Term);
370:
371: begin
372: Insert_Terms(p);
373: end Insert;
374:
375: function Insert ( i,d : integer; p : Poly ) return Poly is
376: res : Poly;
377: begin
378: Copy(p,res);
379: Insert(i,d,res);
380: return res;
381: end Insert;
382:
383: function Insert2 ( i,d : integer; p : Poly ) return Poly is
384:
385: -- IMPORTANT : This function might change the term order !
386:
387: res : Poly := Null_Poly;
388:
389: procedure Insert_Term ( t : in Term; cont : out boolean ) is
390: rt : Term;
391: begin
392: rt.cf := t.cf;
393: rt.dg := Degrees(Insert(Link_to_Vector(t.dg),i,d));
394: Add(res,rt);
395: Clear(rt);
396: cont := true;
397: end Insert_Term;
398: procedure Insert_Terms is new Visiting_Iterator (Insert_Term);
399:
400: begin
401: Insert_Terms(p);
402: return res;
403: end Insert2;
404:
405: procedure Insert ( i,d : in integer; l : in out Laur_Sys ) is
406: begin
407: for j in l'range loop
408: Insert(i,d,l(j));
409: end loop;
410: end Insert;
411:
412: function Insert ( i,d : integer; l : Laur_Sys ) return Laur_Sys is
413: res : Laur_Sys(l'range);
414: begin
415: for j in l'range loop
416: res(j) := Insert(i,d,l(j));
417: end loop;
418: return res;
419: end Insert;
420:
421: end Transforming_Laurent_Systems;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to transforming_laurent_systems.adb CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib / PHC / Ada / Root_Counts / Implift