![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to normal_cone_intersections.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|
Return to normal_cone_intersections.adb CVS log | Up to [local] / OpenXM_contrib / PHC / Ada / Root_Counts / Stalift |
1.1 maekawa 1: with Inner_Normal_Cones; use Inner_Normal_Cones;
2:
3: package body Normal_Cone_Intersections is
4:
5: -- AUXILIARY :
6:
7: function Get ( l : List; i : natural ) return Vector is
8:
9: -- DESCRIPTION :
10: -- Returns the ith point vector in the list.
11:
12: tmp : List := l;
13: cnt : natural := 0;
14: nll : Vector(0..0) := (0..0 => 0);
15:
16: begin
17: while not Is_Null(tmp) loop
18: cnt := cnt + 1;
19: if cnt = i
20: then return Head_Of(tmp).all;
21: end if;
22: tmp := Tail_Of(tmp);
23: end loop;
24: return nll;
25: end Get;
26:
27: -- CONSTRUCTORS :
28:
29: function Number_of_Cones ( l : Array_of_Lists; i : natural )
30: return natural is
31:
32: res : natural := 0;
33:
34: begin
35: for j in l'range loop
36: if j /= i
37: then res := res + Length_Of(l(j));
38: end if;
39: end loop;
40: return res;
41: end Number_of_Cones;
42:
43: function Lengths ( l : Array_of_Lists; i : natural ) return Vector is
44:
45: res : Vector(l'range);
46:
47: begin
48: res(res'first) := 1;
49: for j in l'first..(i-1) loop
50: res(j+1) := res(j) + Length_Of(l(j));
51: end loop;
52: for j in (i+1)..l'last loop
53: res(j) := res(j-1) + Length_Of(l(j));
54: end loop;
55: return res;
56: end Lengths;
57:
58: function Create ( l : Array_of_Lists; g : List; i : natural )
59: return Intersection_Matrix is
60:
61: n : constant natural := l'length - 1;
62: m : constant natural := Length_Of(g);
63: ll : constant Vector := Lengths(l,i);
64: nc : constant natural := ll(ll'last)-1;
65: res : Intersection_Matrix(n,m,nc);
66:
67: begin
68: res.sv := ll(ll'first..ll'last-1);
69: for j in l'range loop
70: if j /= i
71: then
72: declare
73: ind : natural := j;
74: tmpl : List := l(j);
75: cntl : natural := 0;
76: begin
77: if ind > i
78: then ind := ind - 1;
79: end if;
80: while not Is_Null(tmpl) loop
81: declare
82: cone : constant Matrix
83: := Inner_Normal_Cone(l(j),Head_Of(tmpl).all);
84: tmpg : List := g;
85: cntg,sum : natural := 0;
86: begin
87: -- put_line("The inequalities of the normal cone : "); put(cone);
88: while not Is_Null(tmpg) loop
89: cntg := cntg + 1;
90: -- put(" "); put(Head_Of(tmpg).all);
91: if Satisfies(cone,Head_Of(tmpg).all)
92: then res.im(cntg,res.sv(ind)+cntl) := 1; sum := sum + 1;
93: -- put_line(" satisfies.");
94: else res.im(cntg,res.sv(ind)+cntl) := 0;
95: -- put_line(" does not satisfy.");
96: end if;
97: tmpg := Tail_Of(tmpg);
98: end loop;
99: res.im(0,res.sv(ind)+cntl) := sum;
100: end;
101: tmpl := Tail_Of(tmpl);
102: cntl := cntl + 1;
103: end loop;
104: end;
105: end if;
106: end loop;
107: return res;
108: end Create;
109:
110: -- ELEMENTARY SELECTORS :
111:
112: function Is_In ( ima : Intersection_Matrix; i,j,k : natural )
113: return boolean is
114: begin
115: if ima.im(i,ima.sv(j)+k-1) = 1
116: then return true;
117: else return false;
118: end if;
119: end Is_In;
120:
121: function Maximal_Column ( ima : Intersection_Matrix ) return natural is
122:
123: res : natural := ima.im'first(2);
124: max : natural := ima.im(0,ima.im'first(2));
125:
126: begin
127: for j in ima.im'first(2)+1..ima.im'last(2) loop
128: if ima.im(0,j) > max
129: then max := ima.im(0,j); res := j;
130: end if;
131: end loop;
132: return res;
133: end Maximal_Column;
134:
135: function Component ( ima : Intersection_Matrix; column : natural )
136: return natural is
137: begin
138: for i in ima.sv'range loop
139: if ima.sv(i) > column
140: then return i-1;
141: end if;
142: end loop;
143: return ima.sv'last;
144: end Component;
145:
146: function Length ( ima : Intersection_Matrix; i : natural ) return natural is
147: begin
148: if i < ima.sv'last
149: then return (ima.sv(i+1) - ima.sv(i));
150: else return (ima.im'last(2) - ima.sv(i) + 1);
151: end if;
152: end Length;
153:
154: function Row_Sum ( ima : Intersection_Matrix; i,j : natural )
155: return natural is
156:
157: res : natural := 0;
158: lst : natural;
159:
160: begin
161: if j < ima.sv'last
162: then lst := ima.sv(j+1)-1;
163: else lst := ima.im'last(2);
164: end if;
165: for k in ima.sv(j)..lst loop
166: res := res + ima.im(i,k);
167: end loop;
168: return res;
169: end Row_Sum;
170:
171: -- ENUMERATING COMPLEMENTARY COLUMNS :
172:
173: procedure Complementary_Columns ( ima : in Intersection_Matrix ) is
174:
175: acc : Standard_Integer_Vectors.Vector(ima.sv'range) := (ima.sv'range => 0);
176: -- acc(j) = 0 if no cone from jth component has been chosen yet,
177: -- = k if kth cone from jth component is selected.
178:
179: continue : boolean := true;
180:
181: function Is_In ( acc : in Vector; i : in natural ) return boolean is
182:
183: -- DESCRIPTION :
184: -- Returns true if the ith generator already belongs to one of the
185: -- chosen cones in acc.
186:
187: begin
188: for j in acc'range loop -- enumerate the components
189: if acc(j) /= 0 -- acc(j) = cone selected
190: then if Is_In(ima,i,j,acc(j)) -- is in selected cone ?
191: then return true;
192: end if;
193: end if;
194: end loop;
195: return false;
196: end Is_In;
197:
198: procedure Select_Columns ( i : in natural ) is
199:
200: -- DESCRIPTION :
201: -- Selects all columns such that the ith generator belongs to the
202: -- collection of columns.
203:
204: lst : natural;
205:
206: begin
207: if i > ima.im'last(1)
208: then Process(acc,continue);
209: else if Is_In(acc,i)
210: then Select_Columns(i+1);
211: else for j in acc'range loop
212: if acc(j) = 0
213: then if j < ima.sv'last
214: then lst := ima.sv(j+1)-1;
215: else lst := ima.im'last(2);
216: end if;
217: for k in ima.sv(j)..lst loop
218: if ima.im(i,k) = 1
219: then acc(j) := k-ima.sv(j)+1;
220: Select_Columns(i+1);
221: acc(j) := 0;
222: end if;
223: exit when not continue;
224: end loop;
225: end if;
226: exit when not continue;
227: end loop;
228: end if;
229: end if;
230: end Select_Columns;
231:
232: begin
233: Select_Columns(1);
234: end Complementary_Columns;
235:
236: function Partition ( ima : Intersection_Matrix; cols : Vector; g : List )
237: return Array_of_Lists is
238:
239: res,res_last : Array_of_Lists(cols'range);
240: tmp : List := g;
241:
242: procedure Search_and_Update ( v : in Vector; i : in natural ) is
243:
244: -- DESCRIPTION :
245: -- Given the ith generator v from the list g, this procedures searches
246: -- for the first cone that contains it and updates the partition.
247:
248: found : boolean := false;
249:
250: begin
251: for j in cols'range loop
252: if (cols(j) /= 0) and then Is_In(ima,i,j,cols(j))
253: then found := true;
254: Append(res(j),res_last(j),v);
255: end if;
256: exit when found;
257: end loop;
258: end Search_and_Update;
259:
260: begin
261: for i in ima.im'first(1)+1..ima.im'last(1) loop
262: Search_and_Update(Head_Of(tmp).all,i);
263: tmp := Tail_Of(tmp);
264: end loop;
265: return res;
266: end Partition;
267:
268: function Partition_in_Union ( partg,points : Array_of_Lists; i : natural;
269: cols : Vector ) return boolean is
270:
271: -- ALGORITHM : lexicographic enumeration of all couples of lists in partg,
272: -- with each time a check whether it belongs to the union of
273: -- the normal cones as given by the set of complementary columns.
274:
275: function Index ( j : natural ) return natural is
276: begin
277: if j < i
278: then return j;
279: else return j+1;
280: end if;
281: end Index;
282:
283: begin
284: for k1 in partg'range loop
285: if not Is_Null(partg(k1))
286: then
287: for k2 in (k1+1)..partg'last loop
288: if not Is_Null(partg(k2))
289: then
290: declare
291: ind1 : constant natural := Index(k1);
292: ind2 : constant natural := Index(k2);
293: x1 : constant Vector := Get(points(ind1),cols(k1));
294: x2 : constant Vector := Get(points(ind2),cols(k2));
295: ic1 : constant Matrix := Inner_Normal_Cone(points(ind1),x1);
296: ic2 : constant Matrix := Inner_Normal_Cone(points(ind2),x2);
297: begin
298: if not In_Union(partg(k1),partg(k2),ic1,ic2)
299: then return false;
300: end if;
301: end;
302: end if;
303: end loop;
304: end if;
305: end loop;
306: return true;
307: end Partition_in_Union;
308:
309: function Contained_in_Union
310: ( l : Array_of_Lists; i : natural; g : List;
311: ima : Intersection_Matrix; cols : Vector ) return boolean is
312:
313: p : Array_of_Lists(cols'range) := Partition(ima,cols,g);
314: res : boolean := Partition_in_Union(p,l,i,cols);
315:
316: begin
317: Deep_Clear(p);
318: return res;
319: end Contained_in_Union;
320:
321: -- FINAL TARGET ROUTINE :
322:
323: function Contained_in_Union
324: ( l : Array_of_Lists; i : natural; g : List;
325: ima : Intersection_Matrix ) return boolean is
326:
327: res : boolean := false;
328: continue : boolean := true;
329:
330: procedure Examin_Selection ( cols : in Vector; continue : out boolean ) is
331: begin
332: res := Contained_in_Union(l,i,g,ima,cols);
333: continue := not res;
334: end Examin_Selection;
335: procedure Enumerate_Complementary_Columns is
336: new Complementary_Columns(Examin_Selection);
337:
338: begin
339: Enumerate_Complementary_Columns(ima);
340: return res;
341: end Contained_in_Union;
342:
343: end Normal_Cone_Intersections;