![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to permute_operations.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 / Symmetry|
Return to permute_operations.adb CVS log | Up to [local] / OpenXM_contrib / PHC / Ada / Root_Counts / Symmetry |
1.1 maekawa 1: with Standard_Complex_Numbers; use Standard_Complex_Numbers;
2:
3: package body Permute_Operations is
4:
5: function "*" ( p : Permutation; v : Standard_Natural_Vectors.Vector )
6: return Standard_Natural_Vectors.Vector is
7:
8: r : Standard_Natural_Vectors.Vector(v'range);
9:
10: begin
11: for i in p'range loop
12: if p(i) >= 0
13: then r(i) := v(p(i));
14: else r(i) := -v(-p(i));
15: end if;
16: end loop;
17: return r;
18: end "*";
19:
20: function "*" ( p : Permutation; v : Standard_Integer_Vectors.Vector )
21: return Standard_Integer_Vectors.Vector is
22:
23: r : Standard_Integer_Vectors.Vector(v'range);
24:
25: begin
26: for i in p'range loop
27: if p(i) >= 0
28: then r(i) := v(p(i));
29: else r(i) := -v(-p(i));
30: end if;
31: end loop;
32: return r;
33: end "*";
34:
35: function "*" ( p : Permutation; v : Standard_Floating_Vectors.Vector )
36: return Standard_Floating_Vectors.Vector is
37:
38: r : Standard_Floating_Vectors.Vector(v'range);
39:
40: begin
41: for i in p'range loop
42: if p(i) >= 0
43: then r(i) := v(p(i));
44: else r(i) := -v(-p(i));
45: end if;
46: end loop;
47: return r;
48: end "*";
49:
50: function "*" ( p : Permutation; v : Standard_Complex_Vectors.Vector )
51: return Standard_Complex_Vectors.Vector is
52:
53: r : Standard_Complex_Vectors.Vector(v'range);
54:
55: begin
56: for i in p'range loop
57: if p(i) >= 0
58: then r(i) := v(p(i));
59: else r(i) := -v(-p(i));
60: end if;
61: end loop;
62: return r;
63: end "*";
64:
65: function Permutable ( v1,v2 : Standard_Natural_Vectors.Vector )
66: return boolean is
67: begin
68: if v1'first /= v2'first or else v1'last /= v2'last
69: then return false; -- the dimensions must correspond !
70: else declare
71: p : Permutation(v1'first..v1'last);
72: begin
73: for k in p'range loop
74: p(k) := 0;
75: for l in v2'range loop
76: if v2(l) = v1(k)
77: then p(k) := l;
78: for j in 1..(k-1) loop
79: if p(j) = l
80: then p(k) := 0;
81: end if;
82: end loop;
83: end if;
84: exit when p(k) /= 0;
85: end loop;
86: if p(k) = 0
87: then return false;
88: end if;
89: end loop;
90: end;
91: return true;
92: end if;
93: end Permutable;
94:
95: function Permutable ( v1,v2 : Standard_Integer_Vectors.Vector )
96: return boolean is
97: begin
98: if v1'first /= v2'first or else v1'last /= v2'last
99: then return false; -- the dimensions must correspond !
100: else declare
101: p : Permutation(v1'first..v1'last);
102: begin
103: for k in p'range loop
104: p(k) := 0;
105: for l in v2'range loop
106: if v2(l) = v1(k)
107: then p(k) := l;
108: for j in 1..(k-1) loop
109: if p(j) = l
110: then p(k) := 0;
111: end if;
112: end loop;
113: end if;
114: exit when p(k) /= 0;
115: end loop;
116: if p(k) = 0
117: then return false;
118: end if;
119: end loop;
120: end;
121: return true;
122: end if;
123: end Permutable;
124:
125: function Permutable ( v1,v2 : Standard_Floating_Vectors.Vector )
126: return boolean is
127: begin
128: if v1'first /= v2'first or else v1'last /= v2'last
129: then return false; -- the dimensions must correspond !
130: else declare
131: p : Permutation(v1'first..v1'last);
132: begin
133: for k in p'range loop
134: p(k) := 0;
135: for l in v2'range loop
136: if v2(l) = v1(k)
137: then p(k) := l;
138: for j in 1..(k-1) loop
139: if p(j) = l
140: then p(k) := 0;
141: end if;
142: end loop;
143: end if;
144: exit when p(k) /= 0;
145: end loop;
146: if p(k) = 0
147: then return false;
148: end if;
149: end loop;
150: end;
151: return true;
152: end if;
153: end Permutable;
154:
155: function Permutable ( v1,v2 : Standard_Complex_Vectors.Vector )
156: return boolean is
157: begin
158: if v1'first /= v2'first or else v1'last /= v2'last
159: then return false; -- the dimensions must correspond !
160: else declare
161: p : Permutation(v1'first..v1'last);
162: begin
163: for k in p'range loop
164: p(k) := 0;
165: for l in v2'range loop
166: if v2(l) = v1(k)
167: then p(k) := l;
168: for j in 1..(k-1) loop
169: if p(j) = l
170: then p(k) := 0;
171: end if;
172: end loop;
173: end if;
174: exit when p(k) /= 0;
175: end loop;
176: if p(k) = 0
177: then return false;
178: end if;
179: end loop;
180: end;
181: return true;
182: end if;
183: end Permutable;
184:
185: function Permutable ( v1,v2 : Standard_Floating_Vectors.Vector;
186: tol : double_float ) return boolean is
187: begin
188: if v1'first /= v2'first or else v1'last /= v2'last
189: then return false; -- the dimensions must correspond !
190: else declare
191: p : Permutation(v1'first..v1'last);
192: begin
193: for k in p'range loop
194: p(k) := 0;
195: for l in v2'range loop
196: if ABS(v2(l) - v1(k)) <= tol
197: then p(k) := l;
198: for j in 1..(k-1) loop
199: if p(j) = l
200: then p(k) := 0;
201: end if;
202: end loop;
203: end if;
204: exit when p(k) /= 0;
205: end loop;
206: if p(k) = 0
207: then return false;
208: end if;
209: end loop;
210: end;
211: return true;
212: end if;
213: end Permutable;
214:
215: function Permutable ( v1,v2 : Standard_Complex_Vectors.Vector;
216: tol : double_float ) return boolean is
217: begin
218: if v1'first /= v2'first or else v1'last /= v2'last
219: then return false; -- the dimensions must correspond !
220: else declare
221: p : Permutation(v1'first..v1'last);
222: begin
223: for k in p'range loop
224: p(k) := 0;
225: for l in v2'range loop
226: if (ABS(REAL_PART(v2(l)) - REAL_PART(v1(k))) <= tol)
227: and then (ABS(IMAG_PART(v2(l)) - IMAG_PART(v1(k))) <= tol)
228: then p(k) := l;
229: for j in 1..(k-1) loop
230: if p(j) = l
231: then p(k) := 0;
232: end if;
233: end loop;
234: end if;
235: exit when p(k) /= 0;
236: end loop;
237: if p(k) = 0
238: then return false;
239: end if;
240: end loop;
241: end;
242: return true;
243: end if;
244: end Permutable;
245:
246: function Sign_Permutable ( v1,v2 : Standard_Natural_Vectors.Vector )
247: return boolean is
248: begin
249: if v1'first /= v2'first or else v1'last /= v2'last
250: then return false; -- the dimensions must correspond !
251: else declare
252: p : Permutation(v1'first..v1'last);
253: begin
254: for k in p'range loop
255: p(k) := 0;
256: for l in v2'range loop
257: if v2(l) = v1(k) or else v2(l) = -v1(k)
258: then p(k) := l;
259: for j in 1..(k-1) loop
260: if p(j) = l
261: then p(k) := 0;
262: end if;
263: end loop;
264: end if;
265: exit when p(k) /= 0;
266: end loop;
267: if p(k) = 0
268: then return false;
269: end if;
270: end loop;
271: end;
272: return true;
273: end if;
274: end Sign_Permutable;
275:
276: function Sign_Permutable ( v1,v2 : Standard_Integer_Vectors.Vector )
277: return boolean is
278: begin
279: if v1'first /= v2'first or else v1'last /= v2'last
280: then return false; -- the dimensions must correspond !
281: else declare
282: p : Permutation(v1'first..v1'last);
283: begin
284: for k in p'range loop
285: p(k) := 0;
286: for l in v2'range loop
287: if v2(l) = v1(k) or else v2(l) = -v1(k)
288: then p(k) := l;
289: for j in 1..(k-1) loop
290: if p(j) = l
291: then p(k) := 0;
292: end if;
293: end loop;
294: end if;
295: exit when p(k) /= 0;
296: end loop;
297: if p(k) = 0
298: then return false;
299: end if;
300: end loop;
301: end;
302: return true;
303: end if;
304: end Sign_Permutable;
305:
306: function Sign_Permutable ( v1,v2 : Standard_Floating_Vectors.Vector )
307: return boolean is
308: begin
309: if v1'first /= v2'first or else v1'last /= v2'last
310: then return false; -- the dimensions must correspond !
311: else declare
312: p : Permutation(v1'first..v1'last);
313: begin
314: for k in p'range loop
315: p(k) := 0;
316: for l in v2'range loop
317: if v2(l) = v1(k) or else v2(l) = -v1(k)
318: then p(k) := l;
319: for j in 1..(k-1) loop
320: if p(j) = l
321: then p(k) := 0;
322: end if;
323: end loop;
324: end if;
325: exit when p(k) /= 0;
326: end loop;
327: if p(k) = 0
328: then return false;
329: end if;
330: end loop;
331: end;
332: return true;
333: end if;
334: end Sign_Permutable;
335:
336: function Sign_Permutable ( v1,v2 : Standard_Complex_Vectors.Vector )
337: return boolean is
338: begin
339: if v1'first /= v2'first or else v1'last /= v2'last
340: then return false; -- the dimensions must correspond !
341: else declare
342: p : Permutation(v1'first..v1'last);
343: begin
344: for k in p'range loop
345: p(k) := 0;
346: for l in v2'range loop
347: if v2(l) = v1(k) or else v2(l) = -v1(k)
348: then p(k) := l;
349: for j in 1..(k-1) loop
350: if p(j) = l
351: then p(k) := 0;
352: end if;
353: end loop;
354: end if;
355: exit when p(k) /= 0;
356: end loop;
357: if p(k) = 0
358: then return false;
359: end if;
360: end loop;
361: end;
362: return true;
363: end if;
364: end Sign_Permutable;
365:
366: function Sign_Permutable ( v1,v2 : Standard_Floating_Vectors.Vector;
367: tol : double_float ) return boolean is
368: begin
369: if v1'first /= v2'first or else v1'last /= v2'last
370: then return false; -- the dimensions must correspond !
371: else declare
372: p : Permutation(v1'first..v1'last);
373: begin
374: for k in p'range loop
375: p(k) := 0;
376: for l in v2'range loop
377: if (ABS(v2(l) - v1(k)) <= tol)
378: or else (ABS(v2(l) + v1(k)) <= tol)
379: then p(k) := l;
380: for j in 1..(k-1) loop
381: if p(j) = l
382: then p(k) := 0;
383: end if;
384: end loop;
385: end if;
386: exit when p(k) /= 0;
387: end loop;
388: if p(k) = 0
389: then return false;
390: end if;
391: end loop;
392: end;
393: return true;
394: end if;
395: end Sign_Permutable;
396:
397: function Sign_Permutable ( v1,v2 : Standard_Complex_Vectors.Vector;
398: tol : double_float ) return boolean is
399: begin
400: if v1'first /= v2'first or else v1'last /= v2'last
401: then return false; -- the dimensions must correspond !
402: else declare
403: p : Permutation(v1'first..v1'last);
404: begin
405: for k in p'range loop
406: p(k) := 0;
407: for l in v2'range loop
408: if ((ABS(REAL_PART(v2(l)) - REAL_PART(v1(k))) <= tol)
409: and then (ABS(IMAG_PART(v2(l)) - IMAG_PART(v1(k))) <= tol))
410: or else ((ABS(REAL_PART(v2(l)) + REAL_PART(v1(k))) <= tol)
411: and then (ABS(IMAG_PART(v2(l)) + IMAG_PART(v1(k))) <= tol))
412: then p(k) := l;
413: for j in 1..(k-1) loop
414: if p(j) = l
415: then p(k) := 0;
416: end if;
417: end loop;
418: end if;
419: exit when p(k) /= 0;
420: end loop;
421: if p(k) = 0
422: then return false;
423: end if;
424: end loop;
425: end;
426: return true;
427: end if;
428: end Sign_Permutable;
429:
430: function "*" ( p : Permutation; t : Standard_Complex_Polynomials.Term )
431: return Standard_Complex_Polynomials.Term is
432:
433: res : Standard_Complex_Polynomials.Term;
434:
435: begin
436: res.cf := t.cf;
437: res.dg := new Standard_Natural_Vectors.Vector(t.dg'range);
438: for i in p'range loop
439: if p(i) >= 0
440: then res.dg(i) := t.dg(p(i));
441: else res.dg(i) := t.dg(-p(i));
442: res.cf := -res.cf;
443: end if;
444: end loop;
445: return res;
446: end "*";
447:
448: function "*" ( p : Permutation; s : Standard_Complex_Polynomials.Poly )
449: return Standard_Complex_Polynomials.Poly is
450:
451: use Standard_Complex_Polynomials;
452: res : Poly := Null_Poly;
453:
454: procedure Permute_Term ( t : in Term; continue : out boolean ) is
455: tt : Term := p*t;
456: begin
457: Add(res,tt);
458: Clear(tt);
459: continue := true;
460: end Permute_Term;
461: procedure Permute_Terms is new Visiting_Iterator(Permute_Term);
462:
463: begin
464: Permute_Terms(s);
465: return res;
466: end "*";
467:
468: function "*" ( p : Permutation; t : Standard_Complex_Laur_Polys.Term )
469: return Standard_Complex_Laur_Polys.Term is
470:
471: res : Standard_Complex_Laur_Polys.Term;
472:
473: begin
474: res.cf := t.cf;
475: res.dg := new Standard_Integer_Vectors.Vector(t.dg'range);
476: for i in p'range loop
477: if p(i) >= 0
478: then res.dg(i) := t.dg(p(i));
479: else res.dg(i) := t.dg(-p(i));
480: res.cf := -res.cf;
481: end if;
482: end loop;
483: return res;
484: end "*";
485:
486: function "*" ( p : Permutation; s : Standard_Complex_Laur_Polys.Poly )
487: return Standard_Complex_Laur_Polys.Poly is
488:
489: use Standard_Complex_Laur_Polys;
490: res : Poly := Null_Poly;
491:
492: procedure Permute_Term ( t : in Term; continue : out boolean ) is
493:
494: tt : Term := p*t;
495:
496: begin
497: Add(res,tt);
498: Clear(tt);
499: continue := true;
500: end Permute_Term;
501: procedure Permute_Terms is new Visiting_Iterator(Permute_Term);
502:
503: begin
504: Permute_Terms(s);
505: return res;
506: end "*";
507:
508: function "*" ( s : Poly_Sys; p : Permutation ) return Poly_Sys is
509:
510: res : Poly_Sys(s'range);
511:
512: begin
513: for k in res'range loop
514: res(k) := p*s(k);
515: end loop;
516: return res;
517: end "*";
518:
519: function "*" ( s : Laur_Sys; p : Permutation ) return Laur_Sys is
520:
521: res : Laur_Sys(s'range);
522:
523: begin
524: for k in res'range loop
525: res(k) := p*s(k);
526: end loop;
527: return res;
528: end "*";
529:
530: function "*" ( p : Permutation; s : Poly_Sys ) return Poly_Sys is
531:
532: r : Poly_Sys(s'range);
533: use Standard_Complex_Polynomials;
534:
535: begin
536: for i in p'range loop
537: if p(i) >= 0
538: then Copy(s(p(i)),r(i));
539: else r(i) := -s(-p(i));
540: end if;
541: end loop;
542: return r;
543: end "*";
544:
545: function "*" ( p : Permutation; s : Laur_Sys ) return Laur_Sys is
546:
547: r : Laur_Sys(s'range);
548: use Standard_Complex_Laur_Polys;
549:
550: begin
551: for i in p'range loop
552: if p(i) >= 0
553: then Copy(s(p(i)),r(i));
554: else r(i) := -s(-p(i));
555: end if;
556: end loop;
557: return r;
558: end "*";
559:
560: end Permute_Operations;