Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Symmetry/generating_mixed_cells.adb, Revision 1.1.1.1
1.1 maekawa 1: with Standard_Floating_Numbers; use Standard_Floating_Numbers;
2: with Standard_Floating_Vectors;
3: with Lists_of_Integer_Vectors;
4: with Lists_of_Floating_Vectors;
5: with Arrays_of_Integer_Vector_Lists;
6: with Arrays_of_Floating_Vector_Lists;
7: with Mixed_Volume_Computation; use Mixed_Volume_Computation;
8: with Permutations; use Permutations;
9: with Permute_Operations; use Permute_Operations;
10:
11: package body Generating_Mixed_Cells is
12:
13: -- FIRST TARGET ROUTINE :
14:
15: function Permute ( l : Lists_of_Integer_Vectors.List; p : Permutation )
16: return Lists_of_Integer_Vectors.List is
17:
18: -- DESCRIPTION :
19: -- Applies the permutation p to all elements in the list l.
20:
21: use Lists_of_Integer_Vectors;
22:
23: tmp,res,res_last : List;
24:
25: begin
26: tmp := l;
27: while not Is_Null(tmp) loop
28: declare
29: plv,lv : Standard_Integer_Vectors.Link_to_Vector;
30: begin
31: lv := Head_Of(tmp);
32: plv := new Standard_Integer_Vectors.Vector'(p*lv.all);
33: plv(plv'last) := lv(lv'last); -- same lifting !
34: Append(res,res_last,plv.all);
35: Standard_Integer_Vectors.Clear(plv);
36: end;
37: tmp := Tail_Of(tmp);
38: end loop;
39: return res;
40: end Permute;
41:
42: function Permute ( p : Permutation; mix : Vector;
43: mic : Integer_Mixed_Subdivisions.Mixed_Cell )
44: return Integer_Mixed_Subdivisions.Mixed_Cell is
45:
46: -- DESCRIPTION :
47: -- Permutes the components of mic.pts according to the permutation p.
48:
49: use Lists_of_Integer_Vectors;
50: use Arrays_of_Integer_Vector_Lists;
51: use Integer_Mixed_Subdivisions;
52:
53: res : Mixed_Cell;
54: index : natural;
55:
56: begin
57: res.nor := new Standard_Integer_Vectors.Vector'(mic.nor.all);
58: res.pts := new Array_of_Lists(mic.pts'range);
59: for k in res.pts'range loop
60: index := Compute_Index(p(k),mix);
61: Copy(mic.pts(index),res.pts(k));
62: end loop;
63: return res;
64: end Permute;
65:
66: function Permute ( mic : Integer_Mixed_Subdivisions.Mixed_Cell;
67: p : Permutation )
68: return Integer_Mixed_Subdivisions.Mixed_Cell is
69:
70: -- DESCRIPTION :
71: -- Applies permutation p on the mixed cell mic.
72:
73: use Arrays_of_Integer_Vector_Lists;
74: use Integer_Mixed_Subdivisions;
75:
76: res : Mixed_Cell;
77:
78: begin
79: res.nor := new Standard_Integer_Vectors.Vector'(p*mic.nor.all);
80: res.nor(res.nor'last) := mic.nor(mic.nor'last);
81: res.pts := new Array_of_Lists(mic.pts'range);
82: for k in mic.pts'range loop
83: res.pts(k) := Permute(mic.pts(k),p);
84: end loop;
85: return res;
86: end Permute;
87:
88: procedure Permute_and_Append
89: ( v,w : in List_of_Permutations;
90: mic : in Integer_Mixed_Subdivisions.Mixed_Cell;
91: mix : in Vector;
92: mixsub,mixsub_last
93: : in out Integer_Mixed_Subdivisions.Mixed_Subdivision ) is
94:
95: -- DESCRIPTION :
96: -- Applies all permutations to the mixed cell and appends the results.
97:
98: use Integer_Mixed_Subdivisions;
99:
100: lv,lw : List_of_Permutations;
101:
102: begin
103: lv := v; lw := w;
104: while not Is_Null(lv) loop
105: declare
106: vmic,wmic : Mixed_Cell;
107: begin
108: vmic := Permute(mic,Permutation(Head_Of(lv).all));
109: wmic := Permute(Permutation(Head_Of(lw).all),mix,vmic);
110: Deep_Clear(vmic);
111: if not Is_In(mixsub,wmic.nor.all)
112: then Append(mixsub,mixsub_last,wmic);
113: end if;
114: end;
115: lv := Tail_Of(lv);
116: lw := Tail_Of(lw);
117: end loop;
118: end Permute_and_Append;
119:
120: function Generating_Cells
121: ( v,w : List_of_Permutations; mix : Vector;
122: mixsub : Integer_Mixed_Subdivisions.Mixed_Subdivision )
123: return Integer_Mixed_Subdivisions.Mixed_Subdivision is
124:
125: use Integer_Mixed_Subdivisions;
126:
127: tmp,res,res_last,done,done_last : Mixed_Subdivision;
128:
129: begin
130: tmp := mixsub;
131: while not Is_Null(tmp) loop
132: declare
133: mic : Mixed_Cell := Head_Of(tmp);
134: begin
135: if not Is_In(done,mic.nor.all)
136: then Append(res,res_last,mic);
137: Permute_and_Append(v,w,mic,mix,done,done_last);
138: end if;
139: end;
140: tmp := Tail_Of(tmp);
141: end loop;
142: Clear(done);
143: return res;
144: end Generating_Cells;
145:
146: -- SECOND TARGET ROUTINE :
147:
148: function Permute ( l : Lists_of_Floating_Vectors.List; p : Permutation )
149: return Lists_of_Floating_Vectors.List is
150:
151: -- DESCRIPTION :
152: -- Applies the permutation p to all elements in the list l.
153:
154: use Lists_of_Floating_Vectors;
155:
156: tmp,res,res_last : List;
157:
158: begin
159: tmp := l;
160: while not Is_Null(tmp) loop
161: declare
162: plv,lv : Standard_Floating_Vectors.Link_to_Vector;
163: begin
164: lv := Head_Of(tmp);
165: plv := new Standard_Floating_Vectors.Vector'(p*lv.all);
166: plv(plv'last) := lv(lv'last); -- same lifting !
167: Append(res,res_last,plv.all);
168: Standard_Floating_Vectors.Clear(plv);
169: end;
170: tmp := Tail_Of(tmp);
171: end loop;
172: return res;
173: end Permute;
174:
175: function Permute ( p : Permutation; mix : Vector;
176: mic : Floating_Mixed_Subdivisions.Mixed_Cell )
177: return Floating_Mixed_Subdivisions.Mixed_Cell is
178:
179: -- DESCRIPTION :
180: -- Permutes the components of mic.pts according to the permutation p.
181:
182: use Lists_of_Floating_Vectors;
183: use Arrays_of_Floating_Vector_Lists;
184: use Floating_Mixed_Subdivisions;
185:
186: res : Mixed_Cell;
187: index : natural;
188:
189: begin
190: res.nor := new Standard_Floating_Vectors.Vector'(mic.nor.all);
191: res.pts := new Array_of_Lists(mic.pts'range);
192: for k in res.pts'range loop
193: index := Compute_Index(p(k),mix);
194: Copy(mic.pts(index),res.pts(k));
195: end loop;
196: return res;
197: end Permute;
198:
199: function Permute ( mic : Floating_Mixed_Subdivisions.Mixed_Cell;
200: p : Permutation )
201: return Floating_Mixed_Subdivisions.Mixed_Cell is
202:
203: -- DESCRIPTION :
204: -- Applies permutation p on the mixed cell mic.
205:
206: use Arrays_of_Floating_Vector_Lists;
207: use Floating_Mixed_Subdivisions;
208:
209: res : Mixed_Cell;
210:
211: begin
212: res.nor := new Standard_Floating_Vectors.Vector'(p*mic.nor.all);
213: res.nor(res.nor'last) := mic.nor(mic.nor'last);
214: res.pts := new Array_of_Lists(mic.pts'range);
215: for k in mic.pts'range loop
216: res.pts(k) := Permute(mic.pts(k),p);
217: end loop;
218: return res;
219: end Permute;
220:
221: procedure Permute_and_Append
222: ( v,w : in List_of_Permutations;
223: mic : in Floating_Mixed_Subdivisions.Mixed_Cell;
224: mix : in Vector;
225: mixsub,mixsub_last
226: : in out Floating_Mixed_Subdivisions.Mixed_Subdivision ) is
227:
228: -- DESCRIPTION :
229: -- Applies all permutations to the mixed cell and appends the results.
230:
231: use Floating_Mixed_Subdivisions;
232:
233: lv,lw : List_of_Permutations;
234:
235: begin
236: lv := v; lw := w;
237: while not Is_Null(lv) loop
238: declare
239: vmic,wmic : Mixed_Cell;
240: begin
241: vmic := Permute(mic,Permutation(Head_Of(lv).all));
242: wmic := Permute(Permutation(Head_Of(lw).all),mix,vmic);
243: Deep_Clear(vmic);
244: if not Is_In(mixsub,wmic.nor.all)
245: then Append(mixsub,mixsub_last,wmic);
246: end if;
247: end;
248: lv := Tail_Of(lv);
249: lw := Tail_Of(lw);
250: end loop;
251: end Permute_and_Append;
252:
253: function Generating_Cells
254: ( v,w : List_of_Permutations; mix : Vector;
255: mixsub : Floating_Mixed_Subdivisions.Mixed_Subdivision )
256: return Floating_Mixed_Subdivisions.Mixed_Subdivision is
257:
258: use Floating_Mixed_Subdivisions;
259:
260: tmp,res,res_last,done,done_last : Mixed_Subdivision;
261:
262: begin
263: tmp := mixsub;
264: while not Is_Null(tmp) loop
265: declare
266: mic : Mixed_Cell := Head_Of(tmp);
267: begin
268: if not Is_In(done,mic.nor.all)
269: then Append(res,res_last,mic);
270: Permute_and_Append(v,w,mic,mix,done,done_last);
271: end if;
272: end;
273: tmp := Tail_Of(tmp);
274: end loop;
275: Clear(done);
276: return res;
277: end Generating_Cells;
278:
279: -- THIRD TARGET ROUTINE :
280:
281: function Generate_Cells
282: ( v,w : List_of_Permutations; mix : Vector;
283: mixsub : Integer_Mixed_Subdivisions.Mixed_Subdivision )
284: return Integer_Mixed_Subdivisions.Mixed_Subdivision is
285:
286: use Integer_Mixed_Subdivisions;
287:
288: tmp,res,res_last : Mixed_Subdivision;
289:
290: begin
291: tmp := mixsub;
292: while not Is_Null(tmp) loop
293: declare
294: mic : Mixed_Cell := Head_Of(tmp);
295: begin
296: Permute_and_Append(v,w,mic,mix,res,res_last);
297: end;
298: tmp := Tail_Of(tmp);
299: end loop;
300: return res;
301: end Generate_Cells;
302:
303: function Exists_Permutation
304: ( v1,v2 : Standard_Integer_Vectors.Link_to_Vector )
305: return boolean is
306:
307: -- DESCRIPTION :
308: -- Returns true if there exists a permutation p: v1 = p*v1.
309:
310: begin
311: if v1(v1'last) /= v2(v2'last)
312: then return false; -- they must have the same lifted component !
313: else return Permutable(v1(v1'first..v1'last-1),v2(v2'first..v2'last-1));
314: end if;
315: end Exists_Permutation;
316:
317: function Permutable ( mic : Integer_Mixed_Subdivisions.Mixed_Cell;
318: mixsub : Integer_Mixed_Subdivisions.Mixed_Subdivision )
319: return boolean is
320:
321: use Integer_Mixed_Subdivisions;
322: tmp : Mixed_Subdivision := mixsub;
323: mic2 : Mixed_Cell;
324:
325: begin
326: while not Is_Null(tmp) loop
327: mic2 := Head_Of(tmp);
328: if Exists_Permutation(mic.nor,mic2.nor)
329: then return true;
330: else tmp := Tail_Of(tmp);
331: end if;
332: end loop;
333: return false;
334: end Permutable;
335:
336: function Generating_Cells
337: ( mixsub : Integer_Mixed_Subdivisions.Mixed_Subdivision )
338: return Integer_Mixed_Subdivisions.Mixed_Subdivision is
339:
340: use Integer_Mixed_Subdivisions;
341:
342: tmp,res,res_last : Mixed_Subdivision;
343: mic : Mixed_Cell;
344:
345: begin
346: tmp := mixsub;
347: while not Is_Null(tmp) loop
348: mic := Head_Of(tmp);
349: if not Permutable(mic,res)
350: then Append(res,res_last,mic);
351: end if;
352: tmp := Tail_Of(tmp);
353: end loop;
354: return res;
355: end Generating_Cells;
356:
357: -- FOURTH TARGET ROUTINE :
358:
359: function Exists_Permutation
360: ( v1,v2 : Standard_Floating_Vectors.Link_to_Vector )
361: return boolean is
362:
363: -- DESCRIPTION :
364: -- Returns true if there exists a permutation p: v1 = p*v1.
365:
366: begin
367: if v1(v1'last) /= v2(v2'last)
368: then return false; -- they must have the same lifted component !
369: else return Permutable(v1(v1'first..v1'last-1),v2(v2'first..v2'last-1));
370: end if;
371: end Exists_Permutation;
372:
373: function Permutable ( mic : Floating_Mixed_Subdivisions.Mixed_Cell;
374: mixsub : Floating_Mixed_Subdivisions.Mixed_Subdivision )
375: return boolean is
376:
377: use Floating_Mixed_Subdivisions;
378:
379: tmp : Mixed_Subdivision := mixsub;
380: mic2 : Mixed_Cell;
381:
382: begin
383: while not Is_Null(tmp) loop
384: mic2 := Head_Of(tmp);
385: if Exists_Permutation(mic.nor,mic2.nor)
386: then return true;
387: else tmp := Tail_Of(tmp);
388: end if;
389: end loop;
390: return false;
391: end Permutable;
392:
393: function Generating_Cells
394: ( mixsub : Floating_Mixed_Subdivisions.Mixed_Subdivision )
395: return Floating_Mixed_Subdivisions.Mixed_Subdivision is
396:
397: use Floating_Mixed_Subdivisions;
398:
399: tmp,res,res_last : Mixed_Subdivision;
400: mic : Mixed_Cell;
401:
402: begin
403: tmp := mixsub;
404: while not Is_Null(tmp) loop
405: mic := Head_Of(tmp);
406: if not Permutable(mic,res)
407: then Append(res,res_last,mic);
408: end if;
409: tmp := Tail_Of(tmp);
410: end loop;
411: return res;
412: end Generating_Cells;
413:
414: end Generating_Mixed_Cells;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to generating_mixed_cells.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