Annotation of OpenXM_contrib/PHC/Ada/Math_Lib/Numbers/ts_natnum.adb, Revision 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