Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Dynlift/cayley_trick.adb, Revision 1.1.1.1
1.1 maekawa 1: with Lists_of_Integer_Vectors; use Lists_of_Integer_Vectors;
2: with Simplices; use Simplices;
3: with Dynamic_Triangulations; use Dynamic_Triangulations;
4: with Cayley_Embedding; use Cayley_Embedding;
5: with Flatten_Mixed_Subdivisions; use Flatten_Mixed_Subdivisions;
6:
7: package body Cayley_Trick is
8:
9: -- UTILITIES :
10:
11: function Extract ( n : natural; mix : Vector; lifted : in List )
12: return Array_of_Lists is
13:
14: -- DESCRIPTION :
15: -- Extracts from the list of lifted points to compute the Cayley
16: -- triangulation, the tuple of lifted points.
17:
18: res : Array_of_Lists(mix'range);
19:
20: begin
21: for k in res'range loop
22: res(k) := Extract(k-1,n,lifted);
23: Deflate(n,res(k));
24: end loop;
25: return res;
26: end Extract;
27:
28: procedure Extract ( n : in natural; mix : in Vector;
29: t : in Triangulation; liftedt : in List;
30: mixsub : out Mixed_Subdivision;
31: lifted : out Array_of_Lists ) is
32:
33: -- DESCRIPTION :
34: -- Extracts the useful information from the Cayley polytope.
35:
36: res : Mixed_Subdivision;
37:
38: begin
39: lifted := Extract(n,mix,liftedt);
40: res := Extract_Mixed_Cells(n,mix,t);
41: Deflate(n,res);
42: mixsub := res;
43: end Extract;
44:
45: procedure Extract_and_Clear
46: ( n : in natural; mix : in Vector;
47: t : in out Triangulation; liftedt : in out List;
48: lent : out natural; mixsub : out Mixed_Subdivision;
49: lifted : out Array_of_Lists ) is
50:
51: -- DESCRIPTION :
52: -- Extracts the useful information from the Cayley polytope.
53: -- All intermediate data structures will be cleared.
54:
55: begin
56: lent := Length_Of(t);
57: Extract(n,mix,t,liftedt,mixsub,lifted);
58: Clear(t); Clear(liftedt);
59: end Extract_and_Clear;
60:
61: -- BASIC VERSION :
62:
63: procedure Dynamic_Cayley
64: ( n : in natural; mix : in Vector;
65: supports : in Array_of_Lists; order,inter : in boolean;
66: maxli : in natural; lifted : out Array_of_Lists;
67: mixsub : out Mixed_Subdivision; numtri : out natural ) is
68:
69: tmpsub,lastcells : Mixed_Subdivision;
70: l,liftedl,liftedl_last : list;
71: t : Triangulation;
72:
73: procedure Col_Flat ( nt : in Triangulation; l : List ) is
74:
75: -- DESCRIPTION :
76: -- Updates the subdivision mixsub with the flattened cells.
77: -- The triangulation on entry contains the whole triangulation,
78: -- not just the new cells.
79:
80: cells : Mixed_Subdivision;
81:
82: begin
83: if Is_Null(tmpsub)
84: then cells := Extract_Mixed_Cells(n,mix,nt);
85: Deflate(n,cells);
86: else cells := Extract_non_Flat_Mixed_Cells(n,mix,nt);
87: Deflate(n,cells);
88: Construct(Head_Of(tmpsub),cells);
89: end if;
90: Flatten(cells);
91: tmpsub := cells;
92: end Col_Flat;
93: procedure C_Dynamic_Lifting is new Dynamic_Lifting_with_Flat(Col_Flat);
94:
95: begin
96: l := Embedding_before_Lifting(supports);
97: C_Dynamic_Lifting(l,order,inter,maxli,liftedl,liftedl_last,t);
98: if Is_Null(tmpsub)
99: then Extract_and_Clear(n,mix,t,liftedl,numtri,mixsub,lifted);
100: else lastcells := Extract_non_Flat_Mixed_Cells(n,mix,t);
101: Deflate(n,lastcells);
102: Construct(Head_Of(tmpsub),lastcells);
103: mixsub := lastcells;
104: lifted := Extract(n,mix,liftedl);
105: numtri := Length_Of(t);
106: end if;
107: end Dynamic_Cayley;
108:
109: procedure Dynamic_Cayley
110: ( n : in natural; mix : in Vector;
111: supports : in Array_of_Lists; order,inter : in boolean;
112: maxli : in natural; lifted : out Array_of_Lists;
113: t : in out Triangulation ) is
114:
115: l,liftedl,liftedl_last : list;
116:
117: begin
118: l := Embedding_before_Lifting(supports);
119: Dynamic_Lifting(l,order,inter,maxli,liftedl,liftedl_last,t);
120: lifted := Extract(n,mix,liftedl); Clear(liftedl);
121: end Dynamic_Cayley;
122:
123: -- EXTENDED VERSIONS :
124:
125: procedure Dynamic_Cayley_with_Flat
126: ( n : in natural; mix : in Vector;
127: supports : in Array_of_Lists; order,inter : in boolean;
128: maxli : in natural; lifted : out Array_of_Lists;
129: mixsub : out Mixed_Subdivision; numtri : out natural ) is
130:
131: l,liftedl,liftedl_last : list;
132: t : Triangulation;
133: tmpsub,lastcells : Mixed_Subdivision;
134:
135: procedure Bef_Flat ( tt : in Triangulation; lft : in List ) is
136:
137: cells,cells1 : Mixed_Subdivision;
138: lftpts : Array_of_Lists(mix'range);
139:
140: begin
141: Extract(n,mix,tt,lft,cells,lftpts);
142: Before_Flattening(cells,lftpts);
143: if Is_Null(tmpsub)
144: then cells := Extract_Mixed_Cells(n,mix,tt);
145: Deflate(n,cells);
146: else cells := Extract_non_Flat_Mixed_Cells(n,mix,tt);
147: Deflate(n,cells);
148: Construct(Head_Of(tmpsub),cells);
149: end if;
150: Flatten(cells);
151: tmpsub := cells;
152: end Bef_Flat;
153: procedure C_Dynamic_Lifting is new Dynamic_Lifting_with_Flat (Bef_Flat);
154:
155: begin
156: l := Embedding_before_Lifting(supports);
157: C_Dynamic_Lifting(l,order,inter,maxli,liftedl,liftedl_last,t);
158: if Is_Null(tmpsub)
159: then Extract_and_Clear(n,mix,t,liftedl,numtri,mixsub,lifted);
160: else lastcells := Extract_non_Flat_Mixed_Cells(n,mix,t);
161: Deflate(n,lastcells);
162: Construct(Head_Of(tmpsub),lastcells);
163: mixsub := lastcells;
164: lifted := Extract(n,mix,liftedl);
165: numtri := Length_Of(t);
166: end if;
167: end Dynamic_Cayley_with_Flat;
168:
169: procedure Dynamic_Cayley_with_Flatt
170: ( n : in natural; mix : in Vector;
171: supports : in Array_of_Lists; order,inter : in boolean;
172: maxli : in natural; lifted : out Array_of_Lists;
173: t : in out Triangulation ) is
174:
175: l,liftedl,liftedl_last : list;
176:
177: procedure Bef_Flat ( tt : in Triangulation; lft : in List ) is
178:
179: cells : Mixed_Subdivision;
180: lftpts : Array_of_Lists(supports'range);
181:
182: begin
183: Extract(n,mix,tt,lft,cells,lftpts);
184: Before_Flattening(cells,lftpts);
185: end Bef_Flat;
186: procedure C_Dynamic_Lifting is new Dynamic_Lifting_with_Flat (Bef_Flat);
187:
188: begin
189: l := Embedding_before_Lifting(supports);
190: C_Dynamic_Lifting(l,order,inter,maxli,liftedl,liftedl_last,t);
191: lifted := Extract(n,mix,liftedl); Clear(liftedl);
192: end Dynamic_Cayley_with_Flatt;
193:
194: procedure Dynamic_Cayley_with_New
195: ( n : in natural; mix : in Vector;
196: supports : in Array_of_Lists; order,inter : in boolean;
197: maxli : in natural; lifted : out Array_of_Lists;
198: mixsub : out Mixed_Subdivision; numtri : out natural ) is
199:
200: l,liftedl,liftedl_last : list;
201: t : Triangulation;
202: tmpsub,lastcells : Mixed_Subdivision;
203:
204: procedure Col_Flat ( nt : in Triangulation; l : List ) is
205:
206: -- DESCRIPTION :
207: -- Updates the subdivision mixsub with the flattened cells.
208: -- The triangulation on entry contains the whole triangulation,
209: -- not just the new cells.
210:
211: cells : Mixed_Subdivision;
212:
213: begin
214: if Is_Null(tmpsub)
215: then cells := Extract_Mixed_Cells(n,mix,nt);
216: Deflate(n,cells);
217: else cells := Extract_non_Flat_Mixed_Cells(n,mix,nt);
218: Deflate(n,cells);
219: Construct(Head_Of(tmpsub),cells);
220: end if;
221: Flatten(cells);
222: tmpsub := cells;
223: end Col_Flat;
224:
225: procedure New_Cell ( tt : in Triangulation; pt : in vector ) is
226:
227: cells : Mixed_Subdivision := Extract_Mixed_Cells(n,mix,tt);
228: index : natural := 1;
229:
230: begin
231: Deflate(n,cells);
232: for i in 1..mix'last-1 loop
233: if pt(i+n) /= 0
234: then index := i+1;
235: end if;
236: exit when index > 1;
237: end loop;
238: Process_New_Cells(cells,index,pt);
239: end New_Cell;
240: procedure C_Dynamic_Lifting is new Dynamic_Lifting_with_Flat_and_New
241: (Before_Flattening => Col_Flat, Process_New_Simplices => New_Cell);
242:
243: begin
244: l := Embedding_before_Lifting(supports);
245: C_Dynamic_Lifting(l,order,inter,maxli,liftedl,liftedl_last,t);
246: if Is_Null(tmpsub)
247: then Extract_and_Clear(n,mix,t,liftedl,numtri,mixsub,lifted);
248: else lastcells := Extract_non_Flat_Mixed_Cells(n,mix,t);
249: Deflate(n,lastcells);
250: Construct(Head_Of(tmpsub),lastcells);
251: mixsub := lastcells;
252: lifted := Extract(n,mix,liftedl);
253: numtri := Length_Of(t);
254: end if;
255: end Dynamic_Cayley_with_New;
256:
257: procedure Dynamic_Cayley_with_Newt
258: ( n : in natural; mix : in Vector;
259: supports : in Array_of_Lists; order,inter : in boolean;
260: maxli : in natural; lifted : out Array_of_Lists;
261: t : in out Triangulation ) is
262:
263: l,liftedl,liftedl_last : list;
264:
265: procedure New_Cell ( tt : in Triangulation; pt : in vector ) is
266:
267: cells : Mixed_Subdivision := Extract_Mixed_Cells(n,mix,tt);
268: index : natural := 1;
269:
270: begin
271: Deflate(n,cells);
272: for i in 1..mix'last-1 loop
273: if pt(i+n) /= 0
274: then index := i+1;
275: end if;
276: exit when index > 1;
277: end loop;
278: Process_New_Cells(cells,index,pt);
279: end New_Cell;
280: procedure C_Dynamic_Lifting is new Dynamic_Lifting_with_New(New_Cell);
281:
282: begin
283: l := Embedding_before_Lifting(supports);
284: C_Dynamic_Lifting(l,order,inter,maxli,liftedl,liftedl_last,t);
285: lifted := Extract(n,mix,liftedl); Clear(liftedl);
286: end Dynamic_Cayley_with_Newt;
287:
288: procedure Dynamic_Cayley_with_Flat_and_New
289: ( n : in natural; mix : in Vector;
290: supports : in Array_of_Lists; order,inter : in boolean;
291: maxli : in natural; lifted : out Array_of_Lists;
292: mixsub : out Mixed_Subdivision; numtri : out natural ) is
293:
294: l,liftedl,liftedl_last : list;
295: t : Triangulation;
296: tmpsub,lastcells : Mixed_Subdivision;
297:
298: procedure Bef_Flat ( tt : in Triangulation; lft : in List ) is
299:
300: cells,cells1 : Mixed_Subdivision;
301: lftpts : Array_of_Lists(mix'range);
302:
303: begin
304: Extract(n,mix,tt,lft,cells,lftpts);
305: Before_Flattening(cells,lftpts);
306: if Is_Null(tmpsub)
307: then cells := Extract_Mixed_Cells(n,mix,tt);
308: Deflate(n,cells);
309: else cells := Extract_non_Flat_Mixed_Cells(n,mix,tt);
310: Deflate(n,cells);
311: Construct(Head_Of(tmpsub),cells);
312: end if;
313: Flatten(cells);
314: tmpsub := cells;
315: end Bef_Flat;
316:
317: procedure New_Cell ( tt : in Triangulation; pt : in vector ) is
318:
319: cells : Mixed_Subdivision := Extract_Mixed_Cells(n,mix,tt);
320: index : natural := 1;
321:
322: begin
323: Deflate(n,cells);
324: for i in 1..mix'last-1 loop
325: if pt(i+n) /= 0
326: then index := i+1;
327: end if;
328: exit when index > 1;
329: end loop;
330: Process_New_Cells(cells,index,pt);
331: end New_Cell;
332:
333: procedure C_Dynamic_Lifting is new Dynamic_Lifting_with_Flat_and_New
334: (Before_Flattening => Bef_Flat, Process_New_Simplices => New_Cell);
335:
336: begin
337: l := Embedding_before_Lifting(supports);
338: C_Dynamic_Lifting(l,order,inter,maxli,liftedl,liftedl_last,t);
339: if Is_Null(tmpsub)
340: then Extract_and_Clear(n,mix,t,liftedl,numtri,mixsub,lifted);
341: else lastcells := Extract_non_Flat_Mixed_Cells(n,mix,t);
342: Deflate(n,lastcells);
343: Construct(Head_Of(tmpsub),lastcells);
344: mixsub := lastcells;
345: numtri := Length_Of(t);
346: end if;
347: end Dynamic_Cayley_with_Flat_and_New;
348:
349: procedure Dynamic_Cayley_with_Flat_and_Newt
350: ( n : in natural; mix : in Vector;
351: supports : in Array_of_Lists; order,inter : in boolean;
352: maxli : in natural; lifted : out Array_of_Lists;
353: t : in out Triangulation ) is
354:
355: l,liftedl,liftedl_last : list;
356:
357: procedure Bef_Flat ( tt : in Triangulation; lft : in List ) is
358:
359: cells : Mixed_Subdivision;
360: lftpts : Array_of_Lists(supports'range);
361:
362: begin
363: Extract(n,mix,tt,lft,cells,lftpts);
364: Before_Flattening(cells,lftpts);
365: end Bef_Flat;
366:
367: procedure New_Cell ( tt : in Triangulation; pt : in vector ) is
368:
369: cells : Mixed_Subdivision := Extract_Mixed_Cells(n,mix,tt);
370: index : natural := 1;
371:
372: begin
373: Deflate(n,cells);
374: for i in 1..mix'last-1 loop
375: if pt(i+n) /= 0
376: then index := i+1;
377: end if;
378: exit when index > 1;
379: end loop;
380: Process_New_Cells(cells,index,pt);
381: end New_Cell;
382:
383: procedure C_Dynamic_Lifting is new Dynamic_Lifting_with_Flat_and_New
384: (Before_Flattening => Bef_Flat, Process_New_Simplices => New_Cell);
385:
386: begin
387: l := Embedding_before_Lifting(supports);
388: C_Dynamic_Lifting(l,order,inter,maxli,liftedl,liftedl_last,t);
389: lifted := Extract(n,mix,liftedl); Clear(liftedl);
390: end Dynamic_Cayley_with_Flat_and_Newt;
391:
392: end Cayley_Trick;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>