Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Dynlift/triangulations_and_subdivisions.adb, Revision 1.1.1.1
1.1 maekawa 1: with Standard_Integer_VecVecs; use Standard_Integer_VecVecs;
2: with Lists_of_Integer_Vectors; use Lists_of_Integer_Vectors;
3: with Transforming_Integer_Vector_Lists; use Transforming_Integer_Vector_Lists;
4: with Arrays_of_Integer_Vector_Lists; use Arrays_of_Integer_Vector_Lists;
5: with Dynamic_Triangulations; use Dynamic_Triangulations;
6: with Unfolding_Subdivisions; use Unfolding_Subdivisions;
7:
8: package body Triangulations_and_Subdivisions is
9:
10: -- REFINEMENT ROUTINES :
11:
12: procedure Refine ( n : in natural; mic : in out Mixed_Cell ) is
13:
14: -- NOTE :
15: -- Dynamic lifting will be applied with standard settings,
16: -- under the assumption that there are only few points in the cell.
17:
18: support : List := Reduce(mic.pts(1),n+1);
19: t : Triangulation;
20: lifted,lifted_last : List;
21:
22: begin
23: Dynamic_Lifting(support,false,true,0,lifted,lifted_last,t);
24: mic.sub := new Mixed_Subdivision'(Deep_Create(n,t));
25: Deep_Clear(lifted); Clear(t);
26: -- pity that Shallow_Clear(t) is not yet possible ...
27: end Refine;
28:
29: procedure Refine ( n : in natural; mixsub : in out Mixed_Subdivision ) is
30:
31: -- NOTE :
32: -- Refines the mixed subdivision, under the safe assumption that
33: -- there is only one support set to deal with.
34:
35: res,res_last : Mixed_Subdivision;
36: tmp : Mixed_Subdivision := mixsub;
37: mic : Mixed_Cell;
38:
39: begin
40: while not Is_Null(tmp) loop
41: mic := Head_Of(tmp);
42: if Length_Of(mic.pts(1)) > n+1
43: then Refine(n,mic);
44: end if;
45: Append(res,res_last,mic);
46: tmp := Tail_Of(tmp);
47: end loop;
48: mixsub := res;
49: end Refine;
50:
51: -- TARGET PROCEDURES :
52:
53: function Deep_Create ( n : natural; s : Simplex ) return Mixed_Cell is
54:
55: res : Mixed_Cell;
56: ver : constant VecVec := Vertices(s);
57:
58: begin
59: res.nor := new Standard_Integer_Vectors.Vector'(Normal(s));
60: res.pts := new Array_of_Lists(1..1);
61: res.pts(1) := Deep_Create(ver);
62: return res;
63: end Deep_Create;
64:
65: function Shallow_Create ( n : natural; s : Simplex ) return Mixed_Cell is
66:
67: res : Mixed_Cell;
68: ver : constant VecVec := Vertices(s);
69:
70: begin
71: res.nor := new Standard_Integer_Vectors.Vector'(Normal(s));
72: res.pts := new Array_of_Lists(1..1);
73: res.pts(1) := Shallow_Create(ver);
74: return res;
75: end Shallow_Create;
76:
77: function Deep_Create ( n : natural; t : Triangulation )
78: return Mixed_Subdivision is
79:
80: res,res_last : Mixed_Subdivision;
81: tmp : Triangulation := t;
82:
83: begin
84: while not Is_Null(tmp) loop
85: Append(res,res_last,Deep_Create(n,Head_Of(tmp)));
86: tmp := Tail_Of(tmp);
87: end loop;
88: return res;
89: end Deep_Create;
90:
91: function Shallow_Create ( n : natural; t : Triangulation )
92: return Mixed_Subdivision is
93:
94: res,res_last : Mixed_Subdivision;
95: tmp : Triangulation := t;
96:
97: begin
98: while not Is_Null(tmp) loop
99: Append(res,res_last,Shallow_Create(n,Head_Of(tmp)));
100: tmp := Tail_Of(tmp);
101: end loop;
102: return res;
103: end Shallow_Create;
104:
105: function Deep_Create ( n : natural; flatnor : Vector; t : Triangulation )
106: return Mixed_Subdivision is
107:
108: res,res_last : Mixed_Subdivision;
109: tmp : Triangulation := t;
110: s : Simplex;
111:
112: begin
113: while not Is_Null(tmp) loop
114: s := Head_Of(tmp);
115: exit when (flatnor = Normal(s));
116: Append(res,res_last,Deep_Create(n,s));
117: tmp := Tail_Of(tmp);
118: end loop;
119: res := Merge(res); -- merge cells with same inner normal
120: Refine(n,res); -- refine the non-fine cells
121: return res;
122: end Deep_Create;
123:
124: function Shallow_Create ( n : natural; flatnor : Vector; t : Triangulation )
125: return Mixed_Subdivision is
126:
127: res,res_last : Mixed_Subdivision;
128: tmp : Triangulation := t;
129: s : Simplex;
130:
131: begin
132: while not Is_Null(tmp) loop
133: s := Head_Of(tmp);
134: exit when (flatnor = Normal(s));
135: Append(res,res_last,Shallow_Create(n,s));
136: tmp := Tail_Of(tmp);
137: end loop;
138: res := Merge(res); -- merge cells with same inner normal
139: Refine(n,res); -- refine the non-fine cells
140: return res;
141: end Shallow_Create;
142:
143: function Non_Flat_Deep_Create ( n : natural; t : Triangulation )
144: return Mixed_Subdivision is
145:
146: flatnor : Vector(1..n+1) := (1..n+1 => 0);
147:
148: begin
149: flatnor(n+1) := 1;
150: return Deep_Create(n,flatnor,t);
151: end Non_Flat_Deep_Create;
152:
153: function Non_Flat_Shallow_Create ( n : natural; t : Triangulation )
154: return Mixed_Subdivision is
155:
156: flatnor : Vector(1..n+1) := (1..n+1 => 0);
157:
158: begin
159: flatnor(n+1) := 1;
160: return Shallow_Create(n,flatnor,t);
161: end Non_Flat_Shallow_Create;
162:
163: function Deep_Create ( n : natural; mixsub : Mixed_Subdivision )
164: return Triangulation is
165:
166: res : Triangulation;
167: tmp : Mixed_Subdivision := mixsub;
168: mic : Mixed_Cell;
169:
170: begin
171: while not Is_Null(tmp) loop
172: mic := Head_Of(tmp);
173: declare
174: v : VecVec(0..n);
175: tmppts : List := mic.pts(mic.pts'first);
176: s : Simplex;
177: begin
178: for i in v'range loop
179: v(i) := new Standard_Integer_Vectors.Vector'(Head_Of(tmppts).all);
180: tmppts := Tail_Of(tmppts);
181: exit when Is_Null(tmppts);
182: end loop;
183: s := Create(v);
184: Construct(s,res);
185: end;
186: tmp := Tail_Of(tmp);
187: end loop;
188: Connect(res);
189: return res;
190: end Deep_Create;
191:
192: function Shallow_Create ( n : natural; mixsub : Mixed_Subdivision )
193: return Triangulation is
194:
195: res : Triangulation;
196: tmp : Mixed_Subdivision := mixsub;
197: mic : Mixed_Cell;
198:
199: begin
200: while not Is_Null(tmp) loop
201: mic := Head_Of(tmp);
202: declare
203: v : VecVec(0..n);
204: tmppts : List := mic.pts(mic.pts'first);
205: s : Simplex;
206: begin
207: for i in v'range loop
208: v(i) := Head_Of(tmppts);
209: tmppts := Tail_Of(tmppts);
210: exit when Is_Null(tmppts);
211: end loop;
212: s := Create(v);
213: Construct(s,res);
214: end;
215: tmp := Tail_Of(tmp);
216: end loop;
217: Connect(res);
218: return res;
219: end Shallow_Create;
220:
221: end Triangulations_and_Subdivisions;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to triangulations_and_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 / Dynlift