Annotation of OpenXM_contrib/PHC/Ada/Math_Lib/Supports/ts_fvector.adb, Revision 1.1.1.1
1.1 maekawa 1: with text_io,integer_io; use text_io,integer_io;
2: with Standard_Floating_Numbers; use Standard_Floating_Numbers;
3: with Standard_Random_Numbers; use Standard_Random_Numbers;
4: with Standard_Integer_Vectors;
5: with Standard_Floating_Vectors;
6: with Standard_Integer_VecVecs;
7: with Standard_Integer_VecVecs_io; use Standard_Integer_VecVecs_io;
8: with Standard_Floating_VecVecs;
9: with Standard_Floating_VecVecs_io; use Standard_Floating_VecVecs_io;
10: with Standard_Random_VecVecs; use Standard_Random_VecVecs;
11: with Face_Cardinalities; use Face_Cardinalities;
12:
13: procedure ts_fvector is
14:
15: -- DESCRIPTION :
16: -- Computes the f-vector of a polytope and checks the Euler-Poincare formula.
17:
18: procedure Write ( f : in Standard_Integer_Vectors.Vector ) is
19:
20: -- DESCRIPTION :
21: -- Writes the f-vector on screen.
22:
23: n : constant natural := f'last;
24:
25: begin
26: put_line("The f-vector : ");
27: put(" f(-1) : "); put(f(-1)); new_line;
28: put(" #vertices : "); put(f(0)); new_line;
29: put(" #edges : "); put(f(1)); new_line;
30: for i in 2..(n-1) loop
31: put(" #"); put(i,1); put("-faces : "); put(f(i)); new_line;
32: end loop;
33: put(" f("); put(n,1); put(") : "); put(f(n)); new_line;
34: end Write;
35:
36: function Euler_Poincare ( f : Standard_Integer_Vectors.Vector )
37: return integer is
38:
39: -- DESCRIPTION :
40: -- Computes the alternating sum: sum_{i in f'range} (-1)^(i) f(i).
41:
42: sum : integer := 0;
43: pos : boolean := false;
44:
45: begin
46: for i in f'range loop
47: if pos
48: then sum := sum + f(i);
49: else sum := sum - f(i);
50: end if;
51: pos := not pos;
52: end loop;
53: return sum;
54: end Euler_Poincare;
55:
56: procedure Integer_Interactive_Testing is
57:
58: n,m : natural;
59: tol : constant double_float := 10.0**(-12);
60: sum : integer;
61:
62: begin
63: put("Give the dimension n : "); get(n);
64: put("Give the number of points that span the polytope : "); get(m);
65: declare
66: pts : Standard_Integer_VecVecs.VecVec(1..m);
67: f : Standard_Integer_Vectors.Vector(-1..n);
68: begin
69: put("Give "); put(m,1); put(" "); put(n,1);
70: put_line("-dimensional integer vectors :");
71: get(n,pts);
72: put_line("Counting vertices, edges , .., facets, ...");
73: f := fvector(pts); sum := Euler_Poincare(f);
74: Write(f);
75: put("The result of the Euler-Poincare formula : "); put(sum,1);
76: if sum /= 0
77: then put_line(" BUG DISCOVERED !!!");
78: else put_line(" OK.");
79: end if;
80: end;
81: end Integer_Interactive_Testing;
82:
83: procedure Floating_Interactive_Testing is
84:
85: n,m : natural;
86: tol : constant double_float := 10.0**(-12);
87: sum : integer;
88:
89: begin
90: put("Give the dimension n : "); get(n);
91: put("Give the number of points that span the polytope : "); get(m);
92: declare
93: pts : Standard_Floating_VecVecs.VecVec(1..m);
94: f : Standard_Integer_Vectors.Vector(-1..n);
95: begin
96: put("Give "); put(m,1); put(" "); put(n,1);
97: put_line("-dimensional floating point vectors :");
98: get(n,pts);
99: put_line("Counting vertices, edges , .., facets, ...");
100: f := fvector(pts); sum := Euler_Poincare(f);
101: Write(f);
102: put("The result of the Euler-Poincare formula : "); put(sum,1);
103: if sum /= 0
104: then put_line(" BUG DISCOVERED !!!");
105: else put_line(" OK.");
106: end if;
107: end;
108: end Floating_Interactive_Testing;
109:
110: function Floating_Random_Polytope
111: ( n,m : natural ) return Standard_Floating_VecVecs.VecVec is
112:
113: -- DESCRIPTION :
114: -- Returns m randomly chosen n-dimensional floating-point vectors.
115:
116: res : Standard_Floating_VecVecs.VecVec(1..m) := Random_VecVec(n,m);
117:
118: begin
119: return res;
120: end Floating_Random_Polytope;
121:
122: function Integer_Random_Polytope
123: ( n,m : natural; lower,upper : integer )
124: return Standard_Integer_VecVecs.VecVec is
125:
126: -- DESCRIPTION :
127: -- Returns m randomly chosen n-dimensional vectors,
128: -- with integer entries between lower and upper.
129:
130: res : Standard_Integer_VecVecs.VecVec(1..m);
131: done : boolean;
132:
133: function Is_In ( i : integer ) return boolean is
134:
135: -- DESCRIPTION :
136: -- Returns true if the ith vector already occurs in res(1..i-1).
137:
138: use Standard_Integer_Vectors;
139:
140: begin
141: for j in 1..i-1 loop
142: if Equal(res(j).all,res(i).all)
143: then return true;
144: end if;
145: end loop;
146: return false;
147: end Is_In;
148:
149: begin
150: for i in 1..m loop
151: res(i) := new Standard_Integer_Vectors.Vector(1..n);
152: done := false;
153: while not done loop
154: for j in 1..n loop
155: res(i)(j) := Random(lower,upper);
156: end loop;
157: done := not Is_In(i);
158: end loop;
159: end loop;
160: return res;
161: end Integer_Random_Polytope;
162:
163: procedure Floating_Automatic_Testing is
164:
165: n,m,times,cnt : natural;
166: tol : constant double_float := 10.0**(-12);
167: sum : integer;
168: bug : boolean := false;
169:
170: begin
171: put("Give the dimension n : "); get(n);
172: put("Give the number of points that span the polytope : "); get(m);
173: put("Give the number of testing cycles : "); get(times);
174: declare
175: pts : Standard_Floating_VecVecs.VecVec(1..m);
176: f : Standard_Integer_Vectors.Vector(-1..n);
177: begin
178: for i in 1..times loop
179: cnt := i;
180: pts := Floating_Random_Polytope(n,m);
181: f := fvector(pts); sum := Euler_Poincare(f);
182: Write(f);
183: put("The result of the Euler-Poincare formula : "); put(sum,1);
184: if sum /= 0
185: then put_line(" BUG DISCOVERED !!!"); bug := true;
186: put_line("The generated random configuration is");
187: put(pts);
188: else put_line(" OK."); bug := false;
189: end if;
190: Standard_Floating_VecVecs.Clear(pts);
191: exit when bug;
192: end loop;
193: end;
194: if not bug
195: then put("No bugs found, with "); put(times,1);
196: put_line(" generated cases tested.");
197: put("Dimension : "); put(n,1);
198: put(" and #points : "); put(m,1); put_line(".");
199: else put("Bug found at case "); put(cnt,1); put_line(".");
200: end if;
201: end Floating_Automatic_Testing;
202:
203: procedure Integer_Automatic_Testing is
204:
205: n,m,times,cnt : natural;
206: tol : constant double_float := 10.0**(-12);
207: sum : integer;
208: bug : boolean := false;
209: lower,upper : integer;
210:
211: begin
212: put("Give the dimension n : "); get(n);
213: put("Give the number of points that span the polytope : "); get(m);
214: put("Give lower bound on the entries : "); get(lower);
215: put("Give upper bound on the entries : "); get(upper);
216: put("Give the number of testing cycles : "); get(times);
217: declare
218: pts : Standard_Integer_VecVecs.VecVec(1..m);
219: f : Standard_Integer_Vectors.Vector(-1..n);
220: begin
221: for i in 1..times loop
222: cnt := i;
223: pts := Integer_Random_Polytope(n,m,lower,upper);
224: f := fvector(pts); sum := Euler_Poincare(f);
225: Write(f);
226: put("The result of the Euler-Poincare formula : "); put(sum,1);
227: if sum /= 0
228: then put_line(" BUG DISCOVERED !!!"); bug := true;
229: put_line("The generated random configuration is");
230: put(pts);
231: else put_line(" OK."); bug := false;
232: end if;
233: Standard_Integer_VecVecs.Clear(pts);
234: exit when bug;
235: end loop;
236: end;
237: if not bug
238: then put("No bugs found, with "); put(times,1);
239: put_line(" generated cases tested.");
240: put("Dimension : "); put(n,1);
241: put(" and #points : "); put(m,1); put_line(".");
242: else put("Bug found at case "); put(cnt,1); put_line(".");
243: end if;
244: end Integer_Automatic_Testing;
245:
246: procedure Main is
247:
248: ans : character;
249:
250: begin
251: new_line;
252: put_line("Testing the face enumerators by computing f-vectors.");
253: loop
254: new_line;
255: put_line("Choose one of the following : ");
256: put_line(" 0. Exit this program. ");
257: put_line(" 1. f-vector of given integer polytope. ");
258: put_line(" 2. f-vector of given floating polytope. ");
259: put_line(" 3. f-vector of random integer polytope. ");
260: put_line(" 4. f-vector of random floating polytope. ");
261: put("Type 0,1,2,3, or 4 to select : "); get(ans);
262: exit when (ans = '0');
263: case ans is
264: when '1' => Integer_Interactive_Testing;
265: when '2' => Floating_Interactive_Testing;
266: when '3' => Integer_Automatic_Testing;
267: when '4' => Floating_Automatic_Testing;
268: when others => null;
269: end case;
270: end loop;
271: end Main;
272:
273: begin
274: Main;
275: end ts_fvector;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to ts_fvector.adb CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib / PHC / Ada / Math_Lib / Supports