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