Annotation of OpenXM_contrib/PHC/Ada/Math_Lib/Numbers/ts_intnum.adb, Revision 1.1.1.1
1.1 maekawa 1: with text_io,integer_io; use text_io,integer_io;
2: with Multprec_Natural_Numbers; use Multprec_Natural_Numbers;
3: with Multprec_Natural_Numbers_io; use Multprec_Natural_Numbers_io;
4: with Multprec_Integer_Numbers; use Multprec_Integer_Numbers;
5: with Multprec_Integer_Numbers_io; use Multprec_Integer_Numbers_io;
6: with Multprec_Random_Numbers; use Multprec_Random_Numbers;
7:
8: procedure ts_intnum is
9:
10: -- DESCRIPTION :
11: -- This procedure offers interactive and random testers for the
12: -- operations with multi-precision natural numbers. See the menu below.
13:
14: procedure Test_Creation is
15:
16: i1 : integer;
17: i2 : Integer_Number;
18: ans : character;
19:
20: begin
21: put_line("Testing the creation of an integer number.");
22: loop
23: put("Give a standard integer number : "); get(i1);
24: i2 := Create(i1);
25: put("-> as integer number : "); put(i2); new_line;
26: put("Do you want more tests ? (y/n) "); get(ans);
27: exit when ans /= 'y';
28: end loop;
29: end Test_Creation;
30:
31: procedure Test_io is
32:
33: ans : character;
34: i : Integer_Number;
35:
36: begin
37: put_line("Testing the input/output operations.");
38: loop
39: put("Give a number : "); get(i);
40: put("-> your number : "); put(i); new_line;
41: put("#decimal places : "); put(Decimal_Places(i),1); new_line;
42: put("Do you want more tests ? (y/n) "); get(ans);
43: exit when ans /= 'y';
44: end loop;
45: end Test_io;
46:
47: procedure Test_Sign ( i : in Integer_Number ) is
48:
49: -- DESCRIPTION :
50: -- Applies the operations to determine the sign of a number.
51:
52: begin
53: if Multprec_Integer_Numbers.Positive(i)
54: then put("This number is positive,");
55: else put("This number is not positive,");
56: end if;
57: if Negative(i)
58: then put(" is negative ");
59: else put(" is not negative ");
60: end if;
61: put("and its sign is ");
62: if Sign(i) > 0
63: then put("+");
64: elsif Sign(i) < 0
65: then put("-");
66: else put("0");
67: end if;
68: put_line(".");
69: end Test_Sign;
70:
71: procedure Test_Compare ( i1,i2 : in Integer_Number ) is
72:
73: -- DESCRIPTION :
74: -- Compares the number i1 and i2.
75:
76: begin
77: if Equal(i1,i2)
78: then put_line("The numbers are equal.");
79: else put_line("The numbers are different.");
80: end if;
81: if i1 < i2
82: then put_line("First is less than second.");
83: else put_line("First not less than second.");
84: end if;
85: if i1 > i2
86: then put_line("First is greater than second.");
87: else put_line("First is not greater than second.");
88: end if;
89: end Test_Compare;
90:
91: procedure Zero_Test ( i : Integer_Number ) is
92: begin
93: if Equal(i,0)
94: then put_line(" equals zero");
95: else put_line(" is different from zero");
96: end if;
97: end Zero_Test;
98:
99: procedure Test_Comparison is
100:
101: -- DESCRIPTION :
102: -- Test of all comparison and copying operations.
103:
104: ans : character;
105: i1,i2 : Integer_Number;
106:
107: begin
108: put_line("Testing the comparison operations.");
109: loop
110: put("Give 1st number i1 : "); get(i1);
111: put("-> i1 : "); put(i1);
112: Zero_Test(i1);
113: Test_Sign(i1);
114: put("Give 2nd number i2 : "); get(i2);
115: put("-> i2 : "); put(i2);
116: Zero_Test(i2);
117: Test_Sign(i2);
118: Test_Compare(i1,i2);
119: Copy(i1,i2);
120: put_line("Tests after copying : ");
121: Test_Compare(i1,i2);
122: Div(i1,10);
123: put_line("After dividing i1 by 10 :");
124: put(" i1 : "); put(i1); new_line;
125: put(" i2 : "); put(i2); new_line;
126: put("Do you want more tests ? (y/n) "); get(ans);
127: exit when ans /= 'y';
128: end loop;
129: end Test_Comparison;
130:
131: procedure Test_Addition is
132:
133: -- NOTE : to test i1+i2 with i2 : integer, change the declaration of i2.
134:
135: ans : character;
136: i1,i2,sum1,sum2 : Integer_Number;
137:
138: begin
139: put_line("Testing the addition operations.");
140: loop
141: put("Give 1st number : "); get(i1);
142: put("-> your 1st number i1 : "); put(i1); new_line;
143: put("Give 2nd number : "); get(i2);
144: put("-> your 2nd number i2 : "); put(i2); new_line;
145: sum1 := i1+i2;
146: put("i1+i2 : "); put(sum1); new_line;
147: sum2 := i2+i1;
148: put("i2+i1 : "); put(sum2); new_line;
149: if Equal(sum1,sum2)
150: then put_line("Test on commutativity is successful.");
151: else put_line("Failure, bug detected.");
152: end if;
153: put("Do you want more tests ? (y/n) "); get(ans);
154: exit when ans /= 'y';
155: end loop;
156: end Test_Addition;
157:
158: function Mult_by_Add ( i1 : Integer_Number; i2 : integer )
159: return Integer_Number is
160:
161: -- DESCRIPTION :
162: -- Does the multiplication by adding up i1 to itself as many times
163: -- as the number i2. Only to be used as test of course.
164:
165: res : Integer_Number;
166: n : natural;
167:
168: begin
169: if i2 = 0
170: then return res;
171: else Copy(i1,res);
172: if i2 < 0
173: then n := -i2;
174: else n := i2;
175: end if;
176: for i in 1..n-1 loop
177: Add(res,i1);
178: end loop;
179: if i2 < 0
180: then Min(res);
181: end if;
182: return res;
183: end if;
184: end Mult_by_Add;
185:
186: function Mult_by_Add ( i1,i2 : Integer_Number ) return Integer_Number is
187:
188: -- DESCRIPTION :
189: -- Does the multiplication by adding up n1 to itself as many times
190: -- as the number i2. Only to be used as test of course.
191: -- This can be quite time consuming as i2 gets large.
192:
193: res : Integer_Number;
194: cnt,tot : Natural_Number;
195:
196: begin
197: if Equal(i2,0)
198: then return res;
199: else Copy(i1,res);
200: cnt := Create(1);
201: tot := Unsigned(i2);
202: while not Equal(cnt,tot) loop
203: Add(res,i1);
204: Add(cnt,1);
205: end loop;
206: Clear(cnt);
207: if Negative(i2)
208: then Min(res);
209: end if;
210: return res;
211: end if;
212: end Mult_by_Add;
213:
214: procedure Test_Multiplication is
215:
216: -- NOTE : to test i1*i2 with i2 : integer, change the declaration of i2.
217:
218: ans : character;
219: i1,i2,prod1,prod2,prod3 : Integer_Number;
220: -- i2 : integer;
221:
222: begin
223: put_line("Testing the multiplication operations.");
224: loop
225: put("Give 1st number : "); get(i1);
226: put("-> your 1st number i1 : "); put(i1); new_line;
227: put("Give 2nd number : "); get(i2);
228: put("-> your 2nd number i2 : "); put(i2); new_line;
229: prod1 := i1*i2;
230: put("Product i1*i2 : "); put(prod1); new_line;
231: prod2 := i2*i1;
232: put("Product i2*i1 : "); put(prod2); new_line;
233: if Equal(prod1,prod2)
234: then put_line("Test on commutativity is successful.");
235: else put_line("Failure, bug detected.");
236: end if;
237: put("Do you want multiplication by addition ? (y/n) "); get(ans);
238: if ans = 'y'
239: then put_line("Testing the multiplication by addition. Be patient...");
240: prod3 := Mult_by_Add(i1,i2);
241: put("After adding "); put(i2); put(" times : "); put(prod3);
242: new_line;
243: if Equal(prod1,prod3)
244: then put_line("Test of multiplication is successful.");
245: else put_line("Failure, bug detected.");
246: end if;
247: end if;
248: put("Do you want more tests ? (y/n) "); get(ans);
249: exit when ans /= 'y';
250: end loop;
251: end Test_Multiplication;
252:
253: procedure Test_Exponentiation is
254:
255: ans : character;
256: e1,e2 : Natural_Number;
257: i,exp1,exp2,prod,expo : Integer_Number;
258:
259: begin
260: put_line("Testing the exponentiation operations.");
261: loop
262: put("Give a number : "); get(i);
263: put("-> your number i : "); put(i); new_line;
264: put("Give 1st exponent : "); get(e1);
265: put("-> your 1st exponent e1 : "); put(e1); new_line;
266: exp1 := i**e1;
267: put("i**e1 : "); put(exp1); new_line;
268: put("Give 2nd exponent : "); get(e2);
269: put("-> your 2nd exponent e2 : "); put(e2); new_line;
270: exp2 := i**e2;
271: put("i**e2 : "); put(exp2); new_line;
272: prod := exp1*exp2;
273: put("(i**e1)*(i**e2) : "); put(prod); new_line;
274: expo := i**(e1+e2);
275: put("i**(e1+e2) : "); put(expo); new_line;
276: if Equal(prod,expo)
277: then put_line("Test of exponentiation is successful.");
278: else put_line("Failure, bug detected.");
279: end if;
280: put("Do you want more tests ? (y/n) "); get(ans);
281: exit when ans /= 'y';
282: end loop;
283: end Test_Exponentiation;
284:
285: procedure Test_Subtraction is
286:
287: ans : character;
288: i1,i2,diff : Integer_Number;
289: -- i2 : integer;
290:
291: begin
292: put_line("Testing the subtraction operations.");
293: loop
294: put("Give 1st number : "); get(i1);
295: put("-> your 1st number i1 : "); put(i1); new_line;
296: put("Give 2nd number : "); get(i2);
297: put("-> your 2nd number i2 : "); put(i2); new_line;
298: diff := i1-i2;
299: put("i1 - i2 : "); put(diff); new_line;
300: Add(diff,i2);
301: put("(i1-i2)+i2 : "); put(diff); new_line;
302: if Equal(diff,i1)
303: then put_line("Test of subtraction is successful.");
304: else put_line("Failure, bug detected.");
305: end if;
306: put("Do you want more tests ? (y/n) "); get(ans);
307: exit when ans /= 'y';
308: end loop;
309: end Test_Subtraction;
310:
311: procedure Divide10 ( i : in Integer_Number ) is
312:
313: -- DESCRIPTION :
314: -- Checks whether the number i is divisible by 1..10.
315:
316: quot,prod : Integer_Number;
317: rest : integer;
318:
319: begin
320: put("i : "); put(i); new_line;
321: for j in 1..10 loop
322: rest := Rmd(i,j);
323: quot := i/j;
324: if rest = 0
325: then put("Divisible by "); put(j,1);
326: else put("Not divisible by "); put(j,1);
327: end if;
328: put(" rest : "); put(rest,1); new_line;
329: put("quotient : "); put(quot); new_line;
330: prod := quot*j + rest;
331: if Equal(prod,i)
332: then put_line("Test on Remainder/Division is successful.");
333: else put_line("Failure, bug detected.");
334: end if;
335: end loop;
336: end Divide10;
337:
338: procedure Test_Division is
339:
340: ans : character;
341: i1,quot,prod : Integer_Number;
342: -- i2,rest : Integer_Number;
343: i2,rest : integer;
344:
345: begin
346: put_line("Testing the division operations.");
347: loop
348: put("Give 1st number : "); get(i1);
349: put("-> your 1st number i1 : "); put(i1); new_line;
350: put("Give 2nd number : "); get(i2);
351: put("-> your 2nd number i2 : "); put(i2); new_line;
352: prod := i1*i2;
353: put("i1*i2 : "); put(prod); new_line;
354: quot := prod/i2; rest := Rmd(prod,i2);
355: put("(i1*i2)/i2 : "); put(quot); new_line;
356: put("Remainder : "); put(rest); new_line;
357: if Equal(quot,i1) and rest = 0 -- Equal(rest,0)
358: then put_line("Test of division is successful.");
359: else put_line("Failure, bug detected.");
360: end if;
361: Div(i1,i2,quot,rest);
362: put("i1/i2 : "); put(quot); new_line;
363: put("rest : "); put(rest); new_line;
364: prod := quot*i2 + rest;
365: if Equal(prod,i1)
366: then put_line("Test of division/remainder computation is successful.");
367: else put_line("Failure, bug detected.");
368: end if;
369: if i2 <= 10
370: then Divide10(i1);
371: end if;
372: put("Do you want more tests ? (y/n) "); get(ans);
373: exit when ans /= 'y';
374: end loop;
375: end Test_Division;
376:
377: procedure Random_Addition_and_Subtraction ( sz1,sz2 : in natural ) is
378:
379: -- DESCRIPTION :
380: -- Three tests are performed:
381: -- 1) n1+n2-n2 = n1, with "+" and "-".
382: -- 2) Add(n1,n2) is the same as n1 := n1+n2?
383: -- 3) Sub(n1+n2,n1) leads to n2?
384:
385: n1,n2,sum1,sum2 : Integer_Number;
386:
387: procedure Report_Bug is
388: begin
389: new_line;
390: put(" n1 : "); put(n1); new_line;
391: put(" n2 : "); put(n2); new_line;
392: end Report_Bug;
393:
394: begin
395: n1 := Random(sz1);
396: n2 := Random(sz2);
397: sum1 := n1+n2;
398: sum2 := sum1-n2;
399: if Equal(sum2,n1)
400: then put("n1+n2-n2 okay");
401: else put("n1+n2-n2 Bug!"); Report_Bug;
402: end if;
403: Add(sum2,n2);
404: if Equal(sum2,sum1)
405: then put(" Add okay");
406: else put(" Add Bug!"); Report_Bug;
407: end if;
408: Sub(sum2,n1);
409: if Equal(sum2,n2)
410: then put(" Sub okay"); new_line;
411: else put(" Sub Bug!"); Report_Bug;
412: end if;
413: Clear(n1); Clear(n2);
414: Clear(sum1); Clear(sum2);
415: end Random_Addition_and_Subtraction;
416:
417: procedure Additions_and_Subtractions_on_Randoms is
418:
419: -- DESCRIPTION :
420: -- Generates a number of random integers and performs repeated
421: -- additions and subtractions with checks on consistencies.
422:
423: nb,sz1,sz2 : natural;
424:
425: begin
426: put("Give the number of tests : "); get(nb);
427: put("Give the size of the 1st number : "); get(sz1);
428: put("Give the size of the 2nd number : "); get(sz2);
429: for i in 1..nb loop
430: Random_Addition_and_Subtraction(sz1,sz2);
431: end loop;
432: end Additions_and_Subtractions_on_Randoms;
433:
434: procedure Random_Multiplication_and_Division ( sz1,sz2 : in natural ) is
435:
436: -- DESCRIPTION :
437: -- Four tests are performed :
438: -- 1) n1*n2/n2 = n1, with "*" and "/".
439: -- 2) Mul(n1,n2) is the same as n1 := n1*n2 ?
440: -- 3) Div(n1*n2,n1) leads to n2 ?
441: -- 4) n1 = (n1/n2)*n2 + Rmd(n1,n2) ?
442: -- 5) Div(n1,n2,q,r) satisfies n1 = q*n2 + r ?
443:
444: n1,n2,prod1,prod2,quot1,quot2,quot3,rest1,rest2 : Integer_Number;
445:
446: procedure Report_Bug is
447: begin
448: new_line;
449: put(" n1 : "); put(n1); new_line;
450: put(" n2 : "); put(n2); new_line;
451: end Report_Bug;
452:
453: begin
454: n1 := Random(sz1);
455: n2 := Random(sz2);
456: prod1 := n1*n2;
457: quot1 := prod1/n2;
458: if Equal(quot1,n1)
459: then put("n1*n2/n2 okay");
460: else put("n1*n2/n2 Bug!"); Report_Bug;
461: end if;
462: Mul(quot1,n2);
463: if Equal(prod1,quot1)
464: then put(" Mul okay");
465: else put(" Mul Bug!"); Report_Bug;
466: end if;
467: Div(prod1,n1);
468: if Equal(prod1,n2)
469: then put(" Div okay");
470: else put(" Div Bug!"); Report_Bug;
471: end if;
472: rest1 := Rmd(n1,n2);
473: quot2 := n1/n2;
474: prod2 := quot2*n2;
475: Add(prod2,rest1);
476: if Equal(prod2,n1)
477: then put(" Rmd okay");
478: else put(" Rmd Bug!"); Report_Bug;
479: end if;
480: Div(n1,n2,quot3,rest2);
481: Mul(quot3,n2);
482: Add(quot3,rest2);
483: if Equal(quot3,n1)
484: then put(" Div/Rmd okay"); new_line;
485: else put(" Div/Rmd Bug!"); Report_Bug;
486: end if;
487: Clear(n1); Clear(n2);
488: Clear(prod1); Clear(quot1);
489: Clear(prod2); Clear(quot2);
490: Clear(quot3); Clear(rest1); Clear(rest2);
491: end Random_Multiplication_and_Division;
492:
493: procedure Multiplications_and_Divisions_on_Randoms is
494:
495: -- DESCRIPTION :
496: -- Generates a number of random integers and performs repeated
497: -- multiplications and divisions with checks on consistencies.
498:
499: nb,sz1,sz2 : natural;
500:
501: begin
502: put("Give the number of tests : "); get(nb);
503: put("Give the size of the 1st number : "); get(sz1);
504: put("Give the size of the 2nd number : "); get(sz2);
505: for i in 1..nb loop
506: Random_Multiplication_and_Division(sz1,sz2);
507: end loop;
508: end Multiplications_and_Divisions_on_Randoms;
509:
510: procedure Main is
511:
512: ans : character;
513:
514: begin
515: new_line;
516: put_line("Interactive testing of multi-precision integer numbers.");
517: loop
518: new_line;
519: put_line("Choose one of the following : ");
520: put_line(" 0. exit program 1. Input/Output 2. Creation ");
521: put_line(" 3. Comparison/Copy 4. Addition 5. Subtraction ");
522: put_line(" 6. Multiplication 7. Exponentiation 8. Division ");
523: put_line(" 9. Addition/subtraction on randomly generated numbers. ");
524: put_line(" A. Multiplication/division/remainder on random numbers. ");
525: put("Type in your choice (0,1,2,3,4,5,6,7,8,9 or A) : "); get(ans);
526: exit when (ans = '0');
527: new_line;
528: case ans is
529: when '1' => Test_io;
530: when '2' => Test_Creation;
531: when '3' => Test_Comparison;
532: when '4' => Test_Addition;
533: when '5' => Test_Subtraction;
534: when '6' => Test_Multiplication;
535: when '7' => Test_Exponentiation;
536: when '8' => Test_Division;
537: when '9' => Additions_and_Subtractions_on_Randoms;
538: when 'A' => Multiplications_and_Divisions_on_Randoms;
539: when others => null;
540: end case;
541: end loop;
542: end Main;
543:
544: begin
545: Main;
546: end ts_intnum;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to ts_intnum.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