![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to faces_of_symmetric_polytopes.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 faces_of_symmetric_polytopes.adb CVS log | Up to [local] / OpenXM_contrib / PHC / Ada / Root_Counts / Symmetry |
1.1 maekawa 1: with Permutations,Permute_Operations; use Permutations,Permute_Operations;
2: with Lists_of_Integer_Vectors; use Lists_of_Integer_Vectors;
3: with Permutations_of_Faces; use Permutations_of_Faces;
4:
5: package body Faces_of_Symmetric_Polytopes is
6:
7: -- ON FACES : group * faces -> invariant subgroup
8:
9: function Stabilizer ( v : List_of_Permutations; f : Face )
10: return List_of_Permutations is
11:
12: tmp,res,res_last : List_of_Permutations;
13:
14: begin
15: tmp := v;
16: while not Is_Null(tmp) loop
17: declare
18: p : constant Permutation := Permutation(Head_Of(tmp).all);
19: pf : Face := Permute(f,p);
20: begin
21: if Is_Equal(f,pf)
22: then Append(res,res_last,p);
23: end if;
24: Deep_Clear(pf);
25: end;
26: tmp := Tail_Of(tmp);
27: end loop;
28: return res;
29: end Stabilizer;
30:
31: function Stabilizer_Lifted ( v : List_of_Permutations; f : Face )
32: return List_of_Permutations is
33:
34: tmp,res,res_last : List_of_Permutations;
35:
36: begin
37: tmp := v;
38: while not Is_Null(tmp) loop
39: declare
40: p : constant Permutation := Permutation(Head_Of(tmp).all);
41: pf : Face := Permute_Lifted(f,p);
42: begin
43: if Is_Equal(f,pf)
44: then Append(res,res_last,p);
45: end if;
46: Deep_Clear(pf);
47: end;
48: tmp := Tail_Of(tmp);
49: end loop;
50: return res;
51: end Stabilizer_Lifted;
52:
53: -- ON FACES : group * faces -> invariant faces
54:
55: function Invariant_Faces ( v : List_of_Permutations;
56: f : Faces ) return Faces is
57:
58: tmpf,res,res_last : Faces;
59: tmpv : List_of_Permutations;
60: inva : boolean;
61:
62: begin
63: tmpf := f;
64: while not Is_Null(tmpf) loop
65: inva := false;
66: declare
67: ff : Face := Head_Of(tmpf);
68: cf : Face;
69: begin
70: tmpv := v;
71: while not Is_Null(tmpv) loop
72: inva := Invariant(ff,Permutation(Head_Of(tmpv).all));
73: exit when not inva;
74: tmpv := Tail_Of(tmpv);
75: end loop;
76: if inva
77: then Copy(ff,cf); Append(res,res_last,cf);
78: end if;
79: end;
80: tmpf := Tail_Of(tmpf);
81: end loop;
82: return res;
83: end Invariant_Faces;
84:
85: function Invariant_Lifted_Faces ( v : List_of_Permutations;
86: f : Faces ) return Faces is
87:
88: tmpf,res,res_last : Faces;
89: tmpv : List_of_Permutations;
90: inva : boolean;
91:
92: begin
93: tmpf := f;
94: while not Is_Null(tmpf) loop
95: inva := false;
96: declare
97: ff : Face := Head_Of(tmpf);
98: cf : Face;
99: begin
100: tmpv := v;
101: while not Is_Null(tmpv) loop
102: inva := Invariant_Lifted(ff,Permutation(Head_Of(tmpv).all));
103: exit when not inva;
104: tmpv := Tail_Of(tmpv);
105: end loop;
106: if inva
107: then Copy(ff,cf); Append(res,res_last,cf);
108: end if;
109: end;
110: tmpf := Tail_Of(tmpf);
111: end loop;
112: return res;
113: end Invariant_Lifted_Faces;
114:
115: -- ON FACES : group * faces -> generated faces
116:
117: function Generated_Faces ( v : List_of_Permutations; f : Faces )
118: return Faces is
119:
120: tmp,res,res_last : Faces;
121:
122: begin
123: return res;
124: end Generated_Faces;
125:
126: function Generated_Lifted_Faces
127: ( v : List_of_Permutations; f : Faces )
128: return Faces is
129:
130: tmp,res,res_last : Faces;
131:
132: begin
133: return res;
134: end Generated_Lifted_Faces;
135:
136: -- ON FACES : group * faces -> generating faces
137:
138: function Generating_Faces ( f : Faces ) return Faces is
139:
140: tmp,res,res_last : Faces;
141: lf : Face;
142:
143: begin
144: tmp := f;
145: while not Is_Null(tmp) loop
146: lf := Head_Of(tmp);
147: if not Permutable(lf,res)
148: then Append(res,res_last,lf);
149: end if;
150: tmp := Tail_Of(tmp);
151: end loop;
152: return res;
153: end Generating_Faces;
154:
155: function Generating_Lifted_Faces ( f : Faces ) return Faces is
156:
157: tmp,res,res_last : Faces;
158: lf : Face;
159:
160: begin
161: tmp := f;
162: while not Is_Null(tmp) loop
163: lf := Head_Of(tmp);
164: if not Permutable_Lifted(lf,res)
165: then Append(res,res_last,lf);
166: end if;
167: tmp := Tail_Of(tmp);
168: end loop;
169: return res;
170: end Generating_Lifted_Faces;
171:
172: function Generating_Faces ( v : List_of_Permutations; f : Faces )
173: return Faces is
174:
175: tmp,res,res_last : Faces;
176: tmpv : List_of_Permutations;
177: found : boolean;
178: lf : Face;
179:
180: begin
181: tmp := f;
182: while not Is_Null(tmp) loop
183: lf := Head_Of(tmp);
184: tmpv := v;
185: while not Is_Null(tmpv) loop
186: declare
187: pv : constant Permutation := Permutation(Head_Of(tmpv).all);
188: begin
189: found := Is_In(res,Permute(lf,pv));
190: end;
191: exit when found;
192: tmpv := Tail_Of(tmpv);
193: end loop;
194: if not found
195: then Append(res,res_last,lf);
196: end if;
197: tmp := Tail_Of(tmp);
198: end loop;
199: return res;
200: end Generating_Faces;
201:
202: function Generating_Lifted_Faces ( v : List_of_Permutations; f : Faces )
203: return Faces is
204:
205: tmp,res,res_last : Faces;
206: tmpv : List_of_Permutations;
207: found : boolean;
208: lf : Face;
209:
210: begin
211: tmp := f;
212: while not Is_Null(tmp) loop
213: lf := Head_Of(tmp);
214: tmpv := v;
215: while not Is_Null(tmpv) loop
216: declare
217: pv : constant Permutation := Permutation(Head_Of(tmpv).all);
218: begin
219: found := Is_In(res,Permute_Lifted(lf,pv));
220: end;
221: exit when found;
222: tmpv := Tail_Of(tmpv);
223: end loop;
224: if not found
225: then Append(res,res_last,lf);
226: end if;
227: tmp := Tail_Of(tmp);
228: end loop;
229: return res;
230: end Generating_Lifted_Faces;
231:
232: -- ON TUPLES OF FACES : group * faces -> invariant faces
233:
234: function Invariant_Faces ( v : List_of_Permutations;
235: af : Array_of_Faces ) return Array_of_Faces is
236:
237: res : Array_of_Faces(af'range);
238:
239: begin
240: for i in res'range loop
241: res(i) := Invariant_Faces(v,af(i));
242: end loop;
243: return res;
244: end Invariant_Faces;
245:
246: function Invariant_Lifted_Faces
247: ( v : List_of_Permutations; af : Array_of_Faces )
248: return Array_of_Faces is
249:
250: res : Array_of_Faces(af'range);
251:
252: begin
253: for i in res'range loop
254: res(i) := Invariant_Lifted_Faces(v,af(i));
255: end loop;
256: return res;
257: end Invariant_Lifted_Faces;
258:
259: -- ON TUPLES OF FACES : group * faces -> generators of faces
260:
261: function Generating_Faces ( af : Array_of_Faces ) return Array_of_Faces is
262:
263: res,res_last : Array_of_Faces(af'range);
264: tmp : Faces;
265: lf : Face;
266: found : boolean;
267:
268: begin
269: for i in af'range loop
270: tmp := af(i);
271: while not Is_Null(tmp) loop
272: lf := Head_Of(tmp);
273: for j in res'range loop
274: found := Permutable(lf,res(j));
275: exit when found;
276: end loop;
277: if not found
278: then Append(res(i),res_last(i),lf);
279: end if;
280: tmp := Tail_Of(tmp);
281: end loop;
282: end loop;
283: return res;
284: end Generating_Faces;
285:
286: function Generating_Lifted_Faces
287: ( af : Array_of_Faces ) return Array_of_Faces is
288:
289: res,res_last : Array_of_Faces(af'range);
290: tmp : Faces;
291: lf : Face;
292: found : boolean;
293:
294: begin
295: for i in af'range loop
296: tmp := af(i);
297: while not Is_Null(tmp) loop
298: lf := Head_Of(tmp);
299: for j in res'range loop
300: found := Permutable_Lifted(lf,res(j));
301: exit when found;
302: end loop;
303: if not found
304: then Append(res(i),res_last(i),lf);
305: end if;
306: tmp := Tail_Of(tmp);
307: end loop;
308: end loop;
309: return res;
310: end Generating_Lifted_Faces;
311:
312: function Generating_Faces
313: ( v : List_of_Permutations; af : Array_of_Faces )
314: return Array_of_Faces is
315:
316: res : Array_of_Faces(af'range);
317:
318: begin
319: for i in res'range loop
320: res(i) := Generating_Faces(v,af(i));
321: end loop;
322: return res;
323: end Generating_Faces;
324:
325: function Generating_Lifted_Faces
326: ( v : List_of_Permutations; af : Array_of_Faces )
327: return Array_of_Faces is
328:
329: res : Array_of_Faces(af'range);
330:
331: begin
332: for i in res'range loop
333: res(i) := Generating_Lifted_Faces(v,af(i));
334: end loop;
335: return res;
336: end Generating_Lifted_Faces;
337:
338: function Generating_Faces
339: ( v,w : List_of_Permutations; af : Array_of_Faces )
340: return Array_of_Faces is
341:
342: res,res_last : Array_of_Faces(af'range);
343: tmp : Faces;
344: lf : Face;
345: found : boolean;
346: tmpv,tmpw : List_of_Permutations;
347:
348: begin
349: for i in af'range loop
350: tmp := af(i);
351: while not Is_Null(tmp) loop
352: lf := Head_Of(tmp);
353: tmpv := v; tmpw := w;
354: while not Is_Null(tmpv) loop
355: declare
356: pv : constant Permutation := Permutation(Head_Of(tmpv).all);
357: pw : constant Permutation := Permutation(Head_Of(tmpw).all);
358: begin
359: found := Is_In(res(pw(i)),Permute(lf,pv));
360: end;
361: exit when found;
362: tmpv := Tail_Of(tmpv); tmpw := Tail_Of(tmpw);
363: end loop;
364: if not found
365: then Append(res(i),res_last(i),lf);
366: end if;
367: tmp := Tail_Of(tmp);
368: end loop;
369: end loop;
370: return res;
371: end Generating_Faces;
372:
373: function Generating_Lifted_Faces
374: ( v,w : List_of_Permutations; af : Array_of_Faces )
375: return Array_of_Faces is
376:
377: res,res_last : Array_of_Faces(af'range);
378: tmp : Faces;
379: lf : Face;
380: found : boolean;
381: tmpv,tmpw : List_of_Permutations;
382:
383: begin
384: for i in af'range loop
385: tmp := af(i);
386: while not Is_Null(tmp) loop
387: lf := Head_Of(tmp);
388: tmpv := v; tmpw := w;
389: while not Is_Null(tmpv) loop
390: declare
391: pv : constant Permutation := Permutation(Head_Of(tmpv).all);
392: pw : constant Permutation := Permutation(Head_Of(tmpw).all);
393: begin
394: found := Is_In(res(pw(i)),Permute_Lifted(lf,pv));
395: end;
396: exit when found;
397: tmpv := Tail_Of(tmpv); tmpw := Tail_Of(tmpw);
398: end loop;
399: if not found
400: then Append(res(i),res_last(i),lf);
401: end if;
402: tmp := Tail_Of(tmp);
403: end loop;
404: end loop;
405: return res;
406: end Generating_Lifted_Faces;
407:
408: end Faces_of_Symmetric_Polytopes;