Annotation of OpenXM_contrib/PHC/Ada/Math_Lib/Numbers/ts_intnum.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_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