Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Stalift/integer_mixed_subdivisions.adb, Revision 1.1.1.1
1.1 maekawa 1: with unchecked_deallocation;
2: with Integer_Support_Functions; use Integer_Support_Functions;
3: with Standard_Integer_Norms; use Standard_Integer_Norms;
4: with Standard_Integer_Matrices; use Standard_Integer_Matrices;
5: with Standard_Integer_Linear_Solvers; use Standard_Integer_Linear_Solvers;
6:
7: package body Integer_Mixed_Subdivisions is
8:
9: -- CREATORS :
10:
11: procedure Compute_Inner_Normal ( mic : in out Mixed_Cell ) is
12:
13: len : constant natural := Length_Of(mic.pts.all) - mic.pts'length;
14: im : matrix(1..len,mic.nor'range);
15: tmp : List;
16: pt,first : Link_to_Vector;
17: cnt : natural := 0;
18:
19: begin
20: for i in mic.pts'range loop -- compute the inner normal
21: first := Head_Of(mic.pts(i));
22: tmp := Tail_Of(mic.pts(i));
23: while not Is_Null(tmp) loop
24: pt := Head_Of(tmp);
25: cnt := cnt + 1;
26: for j in im'range(2) loop
27: im(cnt,j) := pt(j) - first(j);
28: end loop;
29: tmp := Tail_Of(tmp);
30: end loop;
31: end loop;
32: Upper_Triangulate(im);
33: Scale(im);
34: Solve0(im,mic.nor.all);
35: Normalize(mic.nor.all);
36: if mic.nor(mic.nor'last) < 0 -- orientate the normal
37: then Min(mic.nor);
38: end if;
39: end Compute_Inner_Normal;
40:
41: function Create ( pts : Array_of_Lists; nor : Vector ) return Mixed_Cell is
42:
43: res : Mixed_Cell;
44: sup : integer;
45:
46: begin
47: res.nor := new Vector'(nor);
48: res.pts := new Array_of_Lists(pts'range);
49: for k in pts'range loop
50: sup := Minimal_Support(pts(k),nor);
51: res.pts(k) := Face(pts(k),nor,sup);
52: end loop;
53: return res;
54: end Create;
55:
56: function Create ( pts : Array_of_Lists; nors : List )
57: return Mixed_Subdivision is
58:
59: res,res_last : Mixed_Subdivision;
60: tmp : List := nors;
61:
62: begin
63: while not Is_Null(tmp) loop
64: Append(res,res_last,Create(pts,Head_Of(tmp).all));
65: tmp := Tail_Of(tmp);
66: end loop;
67: return res;
68: end Create;
69:
70: function Create ( pts : Array_of_Lists; mixsub : Mixed_Subdivision )
71: return Mixed_Subdivision is
72:
73: tmp,res,res_last : Mixed_Subdivision;
74:
75: begin
76: tmp := mixsub;
77: while not Is_Null(tmp) loop
78: Append(res,res_last,Create(pts,Head_Of(tmp).nor.all));
79: tmp := Tail_Of(tmp);
80: end loop;
81: return res;
82: end Create;
83:
84: procedure Update ( pts : in Array_of_Lists; nor : in Vector;
85: mixsub,mixsub_last : in out Mixed_Subdivision ) is
86:
87: -- DESCRIPTION :
88: -- Given a tuple of point sets and a normal,
89: -- the mixed subdivision will be updated.
90:
91: tmp : Mixed_Subdivision := mixsub;
92: done : boolean := false;
93:
94: begin
95: while not Is_Null(tmp) and not done loop
96: declare
97: mic : Mixed_Cell := Head_Of(tmp);
98: last : List;
99: begin
100: if Equal(mic.nor.all,nor)
101: then for k in mic.pts'range loop
102: last := mic.pts(k);
103: while not Is_Null(Tail_Of(last)) loop
104: last := Tail_Of(last);
105: end loop;
106: Deep_Concat_Diff(mic.pts(k),last,pts(k));
107: end loop;
108: Set_Head(tmp,mic);
109: done := true;
110: else tmp := Tail_Of(tmp);
111: end if;
112: end;
113: end loop;
114: if not done
115: then declare
116: mic : Mixed_Cell;
117: begin
118: mic.pts := new Array_of_Lists(pts'range);
119: Copy(pts,mic.pts.all);
120: mic.nor := new Standard_Integer_Vectors.Vector'(nor);
121: mic.sub := null;
122: Append(mixsub,mixsub_last,mic);
123: end;
124: end if;
125: end Update;
126:
127: procedure Update ( mixsub,mixsub_last : in out Mixed_Subdivision;
128: cells : in Mixed_Subdivision ) is
129:
130: tmp : Mixed_Subdivision := cells;
131: mic : Mixed_Cell;
132:
133: begin
134: while not Is_Null(tmp) loop
135: mic := Head_Of(tmp);
136: Update(mic.pts.all,mic.nor.all,mixsub,mixsub_last);
137: tmp := Tail_Of(tmp);
138: end loop;
139: end Update;
140:
141: -- CONSTRUCTORS :
142:
143: procedure Copy ( mic1 : in Mixed_Cell; mic2 : in out Mixed_Cell ) is
144: begin
145: Deep_Clear(mic2);
146: if mic1.nor /= null
147: then mic2.nor := new Standard_Integer_Vectors.Vector'(mic1.nor.all);
148: end if;
149: if mic1.pts /= null
150: then mic2.pts := new Array_of_Lists(mic1.pts'range);
151: Copy(mic1.pts.all,mic2.pts.all);
152: end if;
153: if mic1.sub /= null
154: then mic2.sub := new Mixed_Subdivision;
155: Copy(mic1.sub.all,mic2.sub.all);
156: end if;
157: end Copy;
158:
159: procedure Copy ( mixsub1 : in Mixed_Subdivision;
160: mixsub2 : in out Mixed_Subdivision ) is
161:
162: tmp : Mixed_Subdivision := mixsub1;
163: mixsub2_last : Mixed_Subdivision;
164:
165: begin
166: Deep_Clear(mixsub2);
167: while not Is_Null(tmp) loop
168: declare
169: mic1,mic2 : Mixed_Cell;
170: begin
171: mic1 := Head_Of(tmp);
172: Copy(mic1,mic2);
173: Append(mixsub2,mixsub2_last,mic2);
174: end;
175: tmp := Tail_Of(tmp);
176: end loop;
177: end Copy;
178:
179: procedure Append_Diff ( first,last : in out Mixed_Subdivision;
180: mic : in Mixed_Cell ) is
181: begin
182: if not Is_In(first,mic)
183: then Append(first,last,mic);
184: end if;
185: end Append_Diff;
186:
187: procedure Concat_Diff ( first,last : in out Mixed_Subdivision;
188: mixsub : in Mixed_Subdivision ) is
189:
190: tmp : Mixed_Subdivision := mixsub;
191:
192: begin
193: while not Is_Null(tmp) loop
194: declare
195: mic : Mixed_Cell := Head_Of(tmp);
196: begin
197: if not Is_In(first,mic)
198: then Append_Diff(first,last,mic);
199: end if;
200: end;
201: tmp := Tail_Of(tmp);
202: end loop;
203: end Concat_Diff;
204:
205: procedure Construct ( mixsub : in Mixed_Subdivision;
206: first : in out Mixed_Subdivision ) is
207:
208: tmp : Mixed_Subdivision := mixsub;
209:
210: begin
211: while not Is_Null(tmp) loop
212: declare
213: mic : Mixed_Cell := Head_Of(tmp);
214: begin
215: Construct(mic,first);
216: end;
217: tmp := Tail_Of(tmp);
218: end loop;
219: end Construct;
220:
221: procedure Construct_Diff ( mixsub : in Mixed_Subdivision;
222: first : in out Mixed_Subdivision ) is
223:
224: tmp : Mixed_Subdivision := mixsub;
225:
226: begin
227: while not Is_Null(tmp) loop
228: declare
229: mic : Mixed_Cell := Head_Of(tmp);
230: begin
231: if not Is_In(first,mic)
232: then Construct(mic,first);
233: end if;
234: end;
235: tmp := Tail_Of(tmp);
236: end loop;
237: end Construct_Diff;
238:
239: -- SELECTORS :
240:
241: function Equal ( mic1,mic2 : Mixed_Cell ) return boolean is
242: begin
243: if not Equal(mic1.nor,mic2.nor)
244: then return false;
245: elsif Equal(mic1.pts,mic2.pts)
246: then return Equal(mic1.sub,mic2.sub);
247: else return false;
248: end if;
249: end Equal;
250:
251: function Is_Sub ( mixsub1,mixsub2 : Mixed_Subdivision ) return boolean is
252:
253: -- DESCRIPTION :
254: -- Returns true when every cell in mixsub1 also belongs to mixsub2.
255:
256: tmp : Mixed_Subdivision := mixsub1;
257:
258: begin
259: while not Is_Null(tmp) loop
260: if not Is_In(mixsub2,Head_Of(tmp))
261: then return false;
262: else tmp := Tail_Of(tmp);
263: end if;
264: end loop;
265: return true;
266: end Is_Sub;
267:
268: function Equal ( mixsub1,mixsub2 : Mixed_Subdivision ) return boolean is
269: begin
270: if Is_Sub(mixsub1,mixsub2)
271: then return Is_Sub(mixsub2,mixsub1);
272: else return false;
273: end if;
274: end Equal;
275:
276: function Equal ( mixsub1,mixsub2 : Link_to_Mixed_Subdivision )
277: return boolean is
278: begin
279: if mixsub1 = null and then mixsub2 /= null
280: then return false;
281: elsif mixsub2 = null
282: then return true;
283: else return Equal(mixsub1.all,mixsub2.all);
284: end if;
285: end Equal;
286:
287: function Is_In ( mixsub : Mixed_Subdivision; normal : Vector )
288: return boolean is
289:
290: tmp : Mixed_Subdivision := mixsub;
291: c : Mixed_Cell;
292:
293: begin
294: while not Is_Null(tmp) loop
295: c := Head_Of(tmp);
296: if Equal(c.nor.all,normal)
297: then return true;
298: end if;
299: tmp := Tail_Of(tmp);
300: end loop;
301: return false;
302: end Is_In;
303:
304: function Is_In ( mixsub : Mixed_Subdivision; mic : Mixed_Cell )
305: return boolean is
306:
307: tmp : Mixed_Subdivision := mixsub;
308: mic1 : Mixed_Cell;
309:
310: begin
311: while not Is_Null(tmp) loop
312: mic1 := Head_Of(tmp);
313: if Equal(mic1,mic)
314: then return true;
315: else tmp := Tail_Of(tmp);
316: end if;
317: end loop;
318: return false;
319: end Is_In;
320:
321: -- DESTRUCTORS :
322:
323: procedure free is new unchecked_deallocation
324: (Mixed_Subdivision,Link_to_Mixed_Subdivision);
325:
326: procedure Deep_Clear ( mic : in out Mixed_Cell ) is
327: begin
328: Clear(mic.nor); Deep_Clear(mic.pts); Deep_Clear(mic.sub);
329: end Deep_Clear;
330:
331: procedure Shallow_Clear ( mic : in out Mixed_Cell ) is
332: begin
333: Clear(mic.nor); Shallow_Clear(mic.pts); Shallow_Clear(mic.sub);
334: end Shallow_Clear;
335:
336: procedure Deep_Clear ( mixsub : in out Mixed_Subdivision ) is
337:
338: tmp : Mixed_Subdivision;
339:
340: begin
341: tmp := mixsub;
342: while not Is_Null(tmp) loop
343: declare
344: mic : Mixed_Cell := Head_Of(tmp);
345: begin
346: Deep_Clear(mic);
347: end;
348: tmp := Tail_Of(tmp);
349: end loop;
350: Shallow_Clear(mixsub);
351: end Deep_Clear;
352:
353: procedure Deep_Clear ( mixsub : in out Link_to_Mixed_Subdivision ) is
354: begin
355: if mixsub /= null
356: then Deep_Clear(mixsub.all);
357: free(mixsub);
358: end if;
359: end Deep_Clear;
360:
361: procedure Shallow_Clear ( mixsub : in out Mixed_Subdivision ) is
362: begin
363: Lists_of_Mixed_Cells.Clear(Lists_of_Mixed_Cells.List(mixsub));
364: end Shallow_Clear;
365:
366: procedure Shallow_Clear ( mixsub : in out Link_to_Mixed_Subdivision ) is
367: begin
368: if mixsub /= null
369: then Shallow_Clear(mixsub.all);
370: free(mixsub);
371: end if;
372: end Shallow_Clear;
373:
374: end Integer_Mixed_Subdivisions;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to integer_mixed_subdivisions.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 / Stalift