Annotation of OpenXM_contrib/PHC/Ada/Math_Lib/Numbers/ts_cmpnum.adb, Revision 1.1.1.1
1.1 maekawa 1: with text_io,integer_io; use text_io,integer_io;
2: with Standard_Complex_Numbers; use Standard_Complex_Numbers;
3: with Standard_Complex_Numbers_io; use Standard_Complex_Numbers_io;
4: with Standard_Complex_Numbers_Polar; use Standard_Complex_Numbers_Polar;
5: with Multprec_Floating_Numbers; use Multprec_Floating_Numbers;
6: with Multprec_Floating_Numbers_io; use Multprec_Floating_Numbers_io;
7: with Multprec_Complex_Numbers; use Multprec_Complex_Numbers;
8: with Multprec_Complex_Numbers_io; use Multprec_Complex_Numbers_io;
9: with Standard_Random_Numbers; use Standard_Random_Numbers;
10: with Multprec_Random_Numbers; use Multprec_Random_Numbers;
11:
12: procedure ts_cmpnum is
13:
14: -- DESCRIPTION :
15: -- Interactive/Random testing on standard/multi-precision complex arithmetic.
16:
17: procedure Test_Standard_io is
18:
19: c : Standard_Complex_Numbers.Complex_Number;
20: use Standard_Complex_Numbers;
21:
22: begin
23: new_line;
24: put_line("Testing input/output for standard complex numbers.");
25: new_line;
26: put("Give a complex number c : "); get(c);
27: put("-> c : "); put(c); new_line;
28: put("-> 1/c : "); put(1.0/c); new_line;
29: put("-> 1/c : "); put(Create(1.0)/c); new_line;
30: end Test_Standard_io;
31:
32: procedure Test_Multprec_io is
33:
34: c : Multprec_Complex_Numbers.Complex_Number;
35:
36: begin
37: new_line;
38: put_line("Testing input/output for multi-precision complex numbers.");
39: new_line;
40: put("Give a complex number c : "); get(c);
41: put("-> c : "); put(c); new_line;
42: end Test_Multprec_io;
43:
44: procedure Test_Roots is
45:
46: d,k : natural;
47: a,c,prod : Standard_Complex_Numbers.Complex_Number;
48: ans : character;
49:
50: begin
51: new_line;
52: put_line("Solving x^d - c = 0, with c a standard complex number.");
53: new_line;
54: put("Give the degree d : "); get(d);
55: put("Give the constant c : "); get(c);
56: loop
57: put("Which root do you want ? "); get(k);
58: a := Root(c,d,k);
59: put("The root is "); put(a); new_line;
60: prod := a;
61: for j in 2..d loop
62: prod := prod*a;
63: end loop;
64: put("root^d = "); put(prod); new_line;
65: if Equal(prod,c)
66: then put_line("root^d = c, test is successful.");
67: else put_line("root^d /= c, bug detected? ");
68: put("Difference : "); put(prod-c); new_line;
69: end if;
70: put("Do you want other roots ? (y/n) "); get(ans);
71: exit when ans /= 'y';
72: end loop;
73: end Test_Roots;
74:
75: function Random ( sz : natural; low,upp : integer ) return Floating_Number is
76:
77: -- DESCRIPTION :
78: -- Generates a random number of the given size, with exponent between
79: -- the bounds low and upp.
80:
81: res : Floating_Number := Random(sz);
82: exp : integer := Random(low,upp);
83:
84: begin
85: if exp > 0
86: then for i in 1..exp loop
87: Mul(res,10.0);
88: end loop;
89: elsif exp < 0
90: then for i in 1..(-exp) loop
91: Div(res,10.0);
92: end loop;
93: end if;
94: return res;
95: end Random;
96:
97: function Random ( sz : natural; low,upp : integer )
98: return Multprec_Complex_Numbers.Complex_Number is
99:
100: -- DESCRIPTION :
101: -- Generates a random number of the given size, with exponents for real
102: -- and imaginary parts between low and upp.
103:
104: begin
105: return Create(Random(sz,low,upp),Random(sz,low,upp));
106: end Random;
107:
108: procedure Standard_Random_Addition_and_Subtraction is
109:
110: -- DESCRIPTION :
111: -- Three tests are performed:
112: -- 1) n1+n2-n2 = n1, with "+" and "-".
113: -- 2) Add(n1,n2) is the same as n1 := n1+n2?
114: -- 3) Sub(n1+n2,n1) leads to n2?
115:
116: n1,n2,sum1,sum2 : Standard_Complex_Numbers.Complex_Number;
117:
118: procedure Report_Bug is
119: begin
120: new_line;
121: put(" n1 : "); put(n1); new_line;
122: put(" n2 : "); put(n2); new_line;
123: end Report_Bug;
124:
125: begin
126: n1 := Random;
127: n2 := Random;
128: sum1 := n1+n2;
129: sum2 := sum1-n2;
130: if Equal(sum2,n1)
131: then put("n1+n2-n2 okay");
132: else put("n1+n2-n2 Bug?"); Report_Bug;
133: put("diff : "); put(sum2-n1); new_line;
134: end if;
135: Add(sum2,n2);
136: if Equal(sum2,sum1)
137: then put(" Add okay");
138: else put(" Add Bug?"); Report_Bug;
139: put("diff : "); put(sum2-sum1); new_line;
140: end if;
141: Sub(sum2,n1);
142: if Equal(sum2,n2)
143: then put(" Sub okay"); new_line;
144: else put(" Sub Bug?"); Report_Bug;
145: put("diff : "); put(sum2-n2); new_line;
146: end if;
147: exception
148: when CONSTRAINT_ERROR => put_line("input caused exception:");
149: Report_Bug; raise;
150: end Standard_Random_Addition_and_Subtraction;
151:
152: procedure Standard_Additions_and_Subtractions_on_Randoms is
153:
154: -- DESCRIPTION :
155: -- Generates a number of random floats and performs repeated
156: -- additions and subtractions with checks on consistencies.
157:
158: nb : natural;
159:
160: begin
161: put("Give the number of tests : "); get(nb);
162: for i in 1..nb loop
163: Standard_Random_Addition_and_Subtraction;
164: end loop;
165: end Standard_Additions_and_Subtractions_on_Randoms;
166:
167: procedure Multprec_Random_Addition_and_Subtraction
168: ( sz1,sz2 : in natural; low,upp : in integer ) is
169:
170: -- DESCRIPTION :
171: -- Three tests are performed:
172: -- 1) n1+n2-n2 = n1, with "+" and "-".
173: -- 2) Add(n1,n2) is the same as n1 := n1+n2?
174: -- 3) Sub(n1+n2,n1) leads to n2?
175:
176: n1,n2,sum1,sum2 : Multprec_Complex_Numbers.Complex_Number;
177:
178: procedure Report_Bug is
179: begin
180: new_line;
181: put(" n1 : "); put(n1); new_line;
182: put(" n2 : "); put(n2); new_line;
183: end Report_Bug;
184:
185: begin
186: n1 := Random(sz1,low,upp);
187: n2 := Random(sz2,low,upp);
188: sum1 := n1+n2;
189: sum2 := sum1-n2;
190: if Equal(sum2,n1)
191: then put("n1+n2-n2 okay");
192: else put("n1+n2-n2 Bug?"); Report_Bug;
193: put("diff : "); put(sum2-n1); new_line;
194: end if;
195: Add(sum2,n2);
196: if Equal(sum2,sum1)
197: then put(" Add okay");
198: else put(" Add Bug?"); Report_Bug;
199: put("diff : "); put(sum2-sum1); new_line;
200: end if;
201: Sub(sum2,n1);
202: if Equal(sum2,n2)
203: then put(" Sub okay"); new_line;
204: else put(" Sub Bug?"); Report_Bug;
205: put("diff : "); put(sum2-n2); new_line;
206: end if;
207: Clear(n1); Clear(n2);
208: Clear(sum1); Clear(sum2);
209: exception
210: when CONSTRAINT_ERROR => put_line("input caused exception:");
211: Report_Bug; raise;
212: end Multprec_Random_Addition_and_Subtraction;
213:
214: procedure Multprec_Additions_and_Subtractions_on_Randoms is
215:
216: -- DESCRIPTION :
217: -- Generates a number of random floats and performs repeated
218: -- additions and subtractions with checks on consistencies.
219:
220: nb,sz1,sz2 : natural;
221: low,upp : integer;
222:
223: begin
224: put("Give the number of tests : "); get(nb);
225: put("Give the size of the 1st number : "); get(sz1);
226: put("Give the size of the 2nd number : "); get(sz2);
227: put("Give lower bound on exponent : "); get(low);
228: put("Give upper bound on exponent : "); get(upp);
229: for i in 1..nb loop
230: Multprec_Random_Addition_and_Subtraction(sz1,sz2,low,upp);
231: end loop;
232: end Multprec_Additions_and_Subtractions_on_Randoms;
233:
234: procedure Interactive_Multiplication_and_Division is
235:
236: n1,n2,prod,quot : Multprec_Complex_Numbers.Complex_Number;
237: ans : character;
238:
239: begin
240: loop
241: put("Give 1st number : "); get(n1);
242: put("-> n1 : "); put(n1); new_line;
243: put("Give 2nd number : "); get(n2);
244: put("-> n2 : "); put(n2); new_line;
245: prod := n1*n2;
246: put("n1*n2 : "); put(prod); new_line;
247: quot := prod/n2;
248: put("(n1*n2)/n2 : "); put(quot); new_line;
249: Clear(n1); Clear(n2); Clear(prod); Clear(quot);
250: put("Do you want more tests ? (y/n) "); get(ans);
251: exit when (ans /= 'y');
252: end loop;
253: end Interactive_Multiplication_and_Division;
254:
255: procedure Random_Multiplication_and_Division
256: ( sz1,sz2 : in natural; low,upp : in integer ) is
257:
258: -- DESCRIPTION :
259: -- Three tests are performed :
260: -- 1) n1*n2/n2 = n1, with "*" and "/".
261: -- 2) Mul(n1,n2) is the same as n1 := n1*n2 ?
262: -- 3) Div(n1*n2,n1) leads to n2 ?
263:
264: n1,n2,prod,quot : Multprec_Complex_Numbers.Complex_Number;
265:
266: procedure Report_Bug is
267: begin
268: new_line;
269: put(" n1 : "); put(n1); new_line;
270: put(" n2 : "); put(n2); new_line;
271: end Report_Bug;
272:
273: begin
274: n1 := Random(sz1,low,upp);
275: n2 := Random(sz2,low,upp);
276: prod := n1*n2;
277: quot := prod/n2;
278: if Equal(quot,n1)
279: then put("n1*n2/n2 okay");
280: else put("n1*n2/n2 Bug?"); Report_Bug;
281: put("Diff : "); put(quot-n1); new_line;
282: end if;
283: Mul(quot,n2);
284: if Equal(prod,quot)
285: then put(" Mul okay");
286: else put(" Mul Bug?"); Report_Bug;
287: put("Diff : "); put(quot-prod); new_line;
288: end if;
289: Div(prod,n1);
290: if Equal(prod,n2)
291: then put(" Div okay"); new_line;
292: else put(" Div Bug?"); Report_Bug;
293: put("Diff : "); put(prod-n2); new_line;
294: end if;
295: Clear(n1); Clear(n2);
296: Clear(prod); Clear(quot);
297: exception
298: when CONSTRAINT_ERROR => put_line("input caused exception :");
299: Report_Bug; raise;
300: end Random_Multiplication_and_Division;
301:
302: procedure Multiplications_and_Divisions_on_Randoms is
303:
304: -- DESCRIPTION :
305: -- Generates a number of random floats and performs repeated
306: -- multiplications and divisions with checks on consistencies.
307:
308: nb,sz1,sz2 : natural;
309: low,upp : integer;
310:
311: begin
312: put("Give the number of tests : "); get(nb);
313: put("Give the size of the 1st number : "); get(sz1);
314: put("Give the size of the 2nd number : "); get(sz2);
315: put("Give lower bound on exponent : "); get(low);
316: put("Give upper bound on exponent : "); get(upp);
317: for i in 1..nb loop
318: Random_Multiplication_and_Division(sz1,sz2,low,upp);
319: end loop;
320: end Multiplications_and_Divisions_on_Randoms;
321:
322: procedure Main is
323:
324: ans : character;
325:
326: begin
327: new_line;
328: put_line("Interactive testing of standard and multi-precision "
329: & "complex numbers.");
330: loop
331: new_line;
332: put_line("Choose one of the following : ");
333: put_line(" 0. Exit this program. ");
334: put_line(" 1. Input/Output of standard complex numbers. ");
335: put_line(" 2. Addition/subtraction on random standard numbers. ");
336: put_line(" 3. Compute roots of unity of standard complex numbers. ");
337: put_line(" 4. Input/Output of multi-precision complex numbers. ");
338: put_line(" 5. Addition/subtraction on random multi-precision numbers.");
339: put_line(" 6. Multiplication/division/remainder on random "
340: & "multi-precision numbers. ");
341: put_line(" 7. Multiplication/division on user-given numbers. ");
342: put("Type in your choice (0,1,2,3,4,5,6, or 7) : "); get(ans);
343: exit when (ans = '0');
344: new_line;
345: case ans is
346: when '1' => Test_Standard_io;
347: when '2' => Standard_Additions_and_Subtractions_on_Randoms;
348: when '3' => Test_Roots;
349: when '4' => Test_Multprec_io;
350: when '5' => Multprec_Additions_and_Subtractions_on_Randoms;
351: when '6' => Multiplications_and_Divisions_on_Randoms;
352: when '7' => Interactive_Multiplication_and_Division;
353: when others => null;
354: end case;
355: end loop;
356: end Main;
357:
358: begin
359: Main;
360: end ts_cmpnum;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to ts_cmpnum.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 / Numbers