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