[BACK]Return to ts_fltnum.adb CVS log [TXT][DIR] Up to [local] / OpenXM_contrib / PHC / Ada / Math_Lib / Numbers

Annotation of OpenXM_contrib/PHC/Ada/Math_Lib/Numbers/ts_fltnum.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 Standard_Floating_Numbers;          use Standard_Floating_Numbers;
        !             7: with Standard_Floating_Numbers_io;       use Standard_Floating_Numbers_io;
        !             8: with Standard_Mathematical_Functions;    use Standard_Mathematical_Functions;
        !             9: with Multprec_Floating_Numbers;          use Multprec_Floating_Numbers;
        !            10: with Multprec_Floating_Numbers_io;       use Multprec_Floating_Numbers_io;
        !            11: with Standard_Random_Numbers;            use Standard_Random_Numbers;
        !            12: with Multprec_Random_Numbers;            use Multprec_Random_Numbers;
        !            13:
        !            14: procedure ts_fltnum is
        !            15:
        !            16:   tol : constant double_float := 10.0**(-8);
        !            17:
        !            18:   procedure Read ( f : in out Floating_Number; name : in string ) is
        !            19:
        !            20:     n : natural;
        !            21:
        !            22:   begin
        !            23:     put("Give " & name & " : "); get(f);
        !            24:     put("Current size is "); put(Size_Fraction(f),1);
        !            25:     put(".  Give expansion factor : "); get(n);
        !            26:     if n > 0
        !            27:      then Expand(f,n);
        !            28:     end if;
        !            29:   end Read;
        !            30:
        !            31:   procedure Formatted_Output ( f : in Floating_Number ) is
        !            32:
        !            33:   -- DESCRIPTION :
        !            34:   --   Reads the format parameters and writes the floating-point number
        !            35:   --   accordingly.
        !            36:
        !            37:     fore,aft,exp : natural;
        !            38:
        !            39:   begin
        !            40:     put("Give the number of places before the decimal point : "); get(fore);
        !            41:     put("Give the number of places after the decimal point : ");  get(aft);
        !            42:     put("Give the number of places of the exponent : ");          get(exp);
        !            43:     put("-> formatted : "); put(f,fore,aft,exp); new_line;
        !            44:   end Formatted_Output;
        !            45:
        !            46:   procedure Test_io is
        !            47:
        !            48:   -- DESCRIPTION :
        !            49:   --   Reads and writes a floating-point number.
        !            50:
        !            51:     f,abf : Floating_Number;
        !            52:     ans : character;
        !            53:
        !            54:   begin
        !            55:     put_line("Testing input/output for multi-precision floating numbers.");
        !            56:     loop
        !            57:       put("Give a floating number : "); get(f);
        !            58:       put("-> your floating : "); put(f); new_line;
        !            59:       abf := AbsVal(f);
        !            60:       put("-> its absolute value : "); put(abf); new_line;
        !            61:       put("-> #decimal places in fraction : ");
        !            62:       put(Decimal_Places_Fraction(f),1); new_line;
        !            63:       put("-> #decimal places in exponent : ");
        !            64:       put(Decimal_Places_Exponent(f),1); new_line;
        !            65:       put("Do you want formatted output ? (y/n) "); get(ans);
        !            66:       if ans = 'y'
        !            67:        then Formatted_Output(f);
        !            68:       end if;
        !            69:       Clear(f); Clear(abf);
        !            70:       put("Do you want more tests ? (y/n) "); get(ans);
        !            71:       exit when (ans /= 'y');
        !            72:     end loop;
        !            73:   end Test_io;
        !            74:
        !            75:   function Truncate ( f : in double_float ) return integer is
        !            76:
        !            77:     i : integer := integer(f);
        !            78:
        !            79:   begin
        !            80:     if i >= 0
        !            81:      then if double_float(i) > f + tol
        !            82:            then i := i-1;
        !            83:           end if;
        !            84:      else if double_float(i) < f - tol
        !            85:            then i := i+1;
        !            86:           end if;
        !            87:     end if;
        !            88:     return i;
        !            89:   end Truncate;
        !            90:
        !            91:   procedure Test_Creation is
        !            92:
        !            93:     f : Floating_Number;
        !            94:     d,fd : double_float;
        !            95:     i : integer;
        !            96:     ans : character;
        !            97:
        !            98:   begin
        !            99:     put_line("Testing the creation of multi-precision floating numbers.");
        !           100:     loop
        !           101:       put("Give an integer : "); get(i);
        !           102:       put("-> your integer : "); put(i,1); new_line;
        !           103:       f := Create(i);
        !           104:       put("-> as floating number : "); put(f); new_line;
        !           105:       put("Give a standard float : "); get(d);
        !           106:       put("-> your float : "); put(d); new_line;
        !           107:       f := Create(d);
        !           108:       put("-> as floating number : "); put(f); new_line;
        !           109:       fd := Round(f);
        !           110:       put("-> rounded as standard float : "); put(fd); new_line;
        !           111:       if d = fd
        !           112:        then put_line("Creation/Rounding test is successful.");
        !           113:        else put_line("Difference up to working precision ?");
        !           114:             put("d - Round(Create(d)) : "); put(f-fd); new_line;
        !           115:       end if;
        !           116:       put("Give a floating number : "); get(f);
        !           117:       put("-> your floating number : "); put(f); new_line;
        !           118:       d := Round(f);
        !           119:       put("-> rounded as float     :"); put(d); new_line;
        !           120:       put("Do you want more tests ? (y/n) "); get(ans);
        !           121:       exit when (ans /= 'y');
        !           122:     end loop;
        !           123:   end Test_Creation;
        !           124:
        !           125:   procedure Test_Compare ( f1 : in Floating_Number; f2 : in double_float ) is
        !           126:   begin
        !           127:     if Equal(f1,f2)
        !           128:      then put_line("The numbers are equal.");
        !           129:      else put_line("The numbers are different.");
        !           130:     end if;
        !           131:     if f1 < f2
        !           132:      then put_line("First number is less than second number.");
        !           133:      else put_line("First number is not less than second number.");
        !           134:     end if;
        !           135:     if f1 > f2
        !           136:      then put_line("First number is greater than second number.");
        !           137:      else put_line("First number is not greater than second number.");
        !           138:     end if;
        !           139:   end Test_Compare;
        !           140:
        !           141:   procedure Test_Compare ( f1,f2 : in Floating_Number ) is
        !           142:   begin
        !           143:     if Equal(f1,f2)
        !           144:      then put_line("The numbers are equal.");
        !           145:      else put_line("The numbers are different.");
        !           146:     end if;
        !           147:     if f1 < f2
        !           148:      then put_line("First number is less than second number.");
        !           149:      else put_line("First number is not less than second number.");
        !           150:     end if;
        !           151:     if f1 > f2
        !           152:      then put_line("First number is greater than second number.");
        !           153:      else put_line("First number is not greater than second number.");
        !           154:     end if;
        !           155:   end Test_Compare;
        !           156:
        !           157:   procedure Zero_Test ( f : in Floating_Number ) is
        !           158:   begin
        !           159:     if Equal(f,0.0)
        !           160:      then put_line(" equals zero.");
        !           161:      else put_line(" is different from zero.");
        !           162:     end if;
        !           163:   end Zero_Test;
        !           164:
        !           165:   procedure Test_Comparison is
        !           166:
        !           167:     f1,f2 : Floating_Number;
        !           168:    -- f2 : double_float;
        !           169:     ans : character;
        !           170:
        !           171:   begin
        !           172:     put_line("Testing comparison/copying for multi-precision floats.");
        !           173:     loop
        !           174:       put("Give 1st number f1 : "); get(f1);
        !           175:       put(" f1 : "); put(f1);
        !           176:       Zero_Test(f1);
        !           177:       put("Give 2nd number f2 : "); get(f2);
        !           178:       put(" f2 : "); put(f2);
        !           179:       Zero_Test(f2);
        !           180:       Test_Compare(f1,f2);
        !           181:      -- Copy(f1,f2);
        !           182:      -- put_line("After copy :");
        !           183:      -- Test_Compare(f1,f2);
        !           184:       put("Do you want more tests ? (y/n) "); get(ans);
        !           185:       exit when ans /= 'y';
        !           186:     end loop;
        !           187:   end Test_Comparison;
        !           188:
        !           189:   procedure Test_Size is
        !           190:
        !           191:     f,mf : Floating_Number;
        !           192:     ans : character;
        !           193:     factor : integer;
        !           194:     rnd : boolean;
        !           195:
        !           196:   begin
        !           197:     put_line("Testing trunc/round/expand for multi-precision floats");
        !           198:     loop
        !           199:       put("Give a floating number : "); get(f);
        !           200:       put("-> your floating : "); put(f); new_line;
        !           201:       put("The size of the fraction : "); put(Size_Fraction(f),1); new_line;
        !           202:       loop
        !           203:         put("Give size modificator : "); get(factor);
        !           204:         if factor <= 0
        !           205:          then put("Do you want to truncate or to round ? (t/r) "); get(ans);
        !           206:               rnd := (ans = 'r');
        !           207:         end if;
        !           208:         if factor > 0
        !           209:          then -- mf := Expand(f,factor);
        !           210:               Expand(f,factor);
        !           211:               put("expanded : "); put(f); -- put(mf);
        !           212:               new_line;
        !           213:          elsif factor < 0
        !           214:              then if rnd
        !           215:                    then -- mf := Round(f,-factor);
        !           216:                         Round(f,-factor); put("rounded : ");
        !           217:                    else -- mf := Trunc(f,-factor);
        !           218:                         Trunc(f,-factor); put("truncated : ");
        !           219:                   end if;
        !           220:                   put(f); -- put(mf);
        !           221:                   new_line;
        !           222:              else if rnd
        !           223:                    then -- mf := Round(f,factor);
        !           224:                         Round(f,factor); put("rounded : ");
        !           225:                    else -- mf := Trunc(f,factor);
        !           226:                         Trunc(f,factor); put("truncated : ");
        !           227:                   end if;
        !           228:                   put(f); -- put(mf);
        !           229:                   new_line;
        !           230:                   -- mf := Expand(f,factor);
        !           231:                   Expand(f,factor);
        !           232:                   put("expanded : "); put(f); -- put(mf);
        !           233:                   new_line;
        !           234:         end if;
        !           235:         put("Do you want other size modificators ? (y/n) "); get(ans);
        !           236:         exit when (ans /= 'y');
        !           237:       end loop;
        !           238:       put("Do you want more tests ? (y/n) "); get(ans);
        !           239:       exit when (ans /= 'y');
        !           240:     end loop;
        !           241:   end Test_Size;
        !           242:
        !           243:   procedure Test_Addition is
        !           244:
        !           245:     ans : character;
        !           246:     f1,f2,sum1,sum2 : Floating_Number;
        !           247:
        !           248:   begin
        !           249:     put_line("Testing the addition operations.");
        !           250:     loop
        !           251:       Read(f1,"f1");
        !           252:      -- put("Give 1st number f1 : "); get(f1);
        !           253:       put("-> f1 : "); put(f1); new_line;
        !           254:       Read(f2,"f2");
        !           255:      -- put("Give 2nd number f2 : "); get(f2);
        !           256:       put("-> f2 : "); put(f2); new_line;
        !           257:       sum1 := f1+f2;
        !           258:       put("f1+f2 : "); put(sum1); new_line;
        !           259:       sum2 := f2+f1;
        !           260:       put("f2+f1 : "); put(sum2); new_line;
        !           261:       if Equal(sum1,sum2)
        !           262:        then put_line("Test on commutativity is successful.");
        !           263:        else put_line("Failure, bug detected.");
        !           264:       end if;
        !           265:       put("Do you want more tests ? (y/n) "); get(ans);
        !           266:       exit when ans /= 'y';
        !           267:     end loop;
        !           268:   end Test_Addition;
        !           269:
        !           270:   procedure Test_Subtraction is
        !           271:
        !           272:     ans : character;
        !           273:     f1,f2,diff : Floating_Number;
        !           274:
        !           275:   begin
        !           276:     put_line("Testing the subtraction operations.");
        !           277:     loop
        !           278:       Read(f1,"f1");
        !           279:      -- put("Give 1st number f1 : "); get(f1);
        !           280:       put("-> f1 : "); put(f1); new_line;
        !           281:       Read(f2,"f2");
        !           282:      -- put("Give 2nd number f2 : "); get(f2);
        !           283:       put("-> f2 : "); put(f2); new_line;
        !           284:       diff := f1-f2;
        !           285:       put("f1 - f2 : "); put(diff); new_line;
        !           286:       Add(diff,f2);
        !           287:       put("(f1-f2)+f2 : "); put(diff); new_line;
        !           288:       if Equal(diff,f1)
        !           289:        then put_line("Test of subtraction is successful.");
        !           290:        else put_line("Failure, bug detected.");
        !           291:       end if;
        !           292:       put("Do you want more tests ? (y/n) "); get(ans);
        !           293:       exit when ans /= 'y';
        !           294:     end loop;
        !           295:   end Test_Subtraction;
        !           296:
        !           297:   procedure Test_Multiplication is
        !           298:
        !           299:     ans : character;
        !           300:     f1,f2,prod1,prod2 : Floating_Number;
        !           301:
        !           302:   begin
        !           303:     put_line("Testing the multiplication operations.");
        !           304:     loop
        !           305:       Read(f1,"f1");
        !           306:      -- put("Give 1st number : "); get(f1);
        !           307:       put("-> f1 : "); put(f1); new_line;
        !           308:       Read(f2,"f2");
        !           309:      -- put("Give 2nd number : "); get(f2);
        !           310:       put("-> f2 : "); put(f2); new_line;
        !           311:       prod1 := f1*f2;
        !           312:       put("Product f1*f2 : "); put(prod1); new_line;
        !           313:       prod2 := f2*f1;
        !           314:       put("Product f2*f1 : "); put(prod2); new_line;
        !           315:       if Equal(prod1,prod2)
        !           316:        then put_line("Test on commutativity is successful.");
        !           317:        else put_line("Failure, product not commutative: bug!");
        !           318:       end if;
        !           319:       put("Do you want more tests ? (y/n) "); get(ans);
        !           320:       exit when ans /= 'y';
        !           321:     end loop;
        !           322:   end Test_Multiplication;
        !           323:
        !           324:   procedure Test_Exponentiation is
        !           325:
        !           326:     ans : character;
        !           327:     e1,e2 : Integer_Number;
        !           328:     f,exp1,exp2,prod,expo : Floating_Number;
        !           329:
        !           330:   begin
        !           331:     put_line("Testing the exponentiation operations.");
        !           332:     loop
        !           333:       Read(f,"f");
        !           334:      -- put("Give a number : "); get(f);
        !           335:       put("-> your number f : "); put(f); new_line;
        !           336:       put("Give 1st exponent : "); get(e1);
        !           337:       put("-> your 1st exponent e1 : "); put(e1); new_line;
        !           338:       exp1 := f**e1;
        !           339:       put("f**e1 : "); put(exp1); new_line;
        !           340:       put("Give 2nd exponent : "); get(e2);
        !           341:       put("-> your 2nd exponent e2 : "); put(e2); new_line;
        !           342:       exp2 := f**e2;
        !           343:       put("f**e2 : "); put(exp2); new_line;
        !           344:       prod := exp1*exp2;
        !           345:       put("(f**e1)*(f**e2) : "); put(prod); new_line;
        !           346:       expo := f**(e1+e2);
        !           347:       put("f**(e1+e2)      : "); put(expo); new_line;
        !           348:       if Equal(prod,expo)
        !           349:        then put_line("Test of exponentiation is successful.");
        !           350:        else put_line("Failure, bug detected.");
        !           351:       end if;
        !           352:       put("Do you want more tests ? (y/n) "); get(ans);
        !           353:       exit when ans /= 'y';
        !           354:     end loop;
        !           355:   end Test_Exponentiation;
        !           356:
        !           357:   procedure Test_Division is
        !           358:
        !           359:     ans : character;
        !           360:     f1,f2,quot,prod,diff : Floating_Number;
        !           361:
        !           362:   begin
        !           363:     put_line("Testing the division operations.");
        !           364:     loop
        !           365:       Read(f1,"f1");
        !           366:      -- put("Give 1st number f1 : "); get(f1);
        !           367:       put("-> f1 : "); put(f1); new_line;
        !           368:       Read(f2,"f2");
        !           369:      -- put("Give 2nd number f2 : "); get(f2);
        !           370:       put("-> f2 : "); put(f2); new_line;
        !           371:       prod := f1*f2;
        !           372:       put("f1*f2 : "); put(prod); new_line;
        !           373:       quot := prod/f2;
        !           374:       put("(f1*f2)/f2 : "); put(quot); new_line;
        !           375:       if Equal(quot,f1)
        !           376:        then put_line("Test of division is successful.");
        !           377:        else put("Failure, bug detected?");
        !           378:             put_line("  Difference up to working precision?");
        !           379:             diff := quot - f1;
        !           380:             put("(f1*f2)/f2 - f1 : "); put(diff); new_line;
        !           381:       end if;
        !           382:       Copy(f1,quot);
        !           383:       Div(quot,f2);    put("f1/f2 : "); put(quot); new_line;
        !           384:       prod := quot*f2; put("(f1/f2)*f2 : "); put(prod); new_line;
        !           385:                        put(" f1        : "); put(f1); new_line;
        !           386:       if Equal(prod,f1)
        !           387:        then put_line("Test of division/remainder computation is successful.");
        !           388:        else put("Failure, bug detected?");
        !           389:             put_line("  Difference up to working precision?");
        !           390:             if prod > f1
        !           391:              then diff := prod - f1;
        !           392:              else diff := f1 - prod;
        !           393:             end if;
        !           394:             put("(f1/f2)*f2 - f1 : "); put(diff); new_line;
        !           395:       end if;
        !           396:       put("Do you want more tests ? (y/n) "); get(ans);
        !           397:       exit when ans /= 'y';
        !           398:     end loop;
        !           399:   end Test_Division;
        !           400:
        !           401:   function Random ( sz : natural; low,upp : integer ) return Floating_Number is
        !           402:
        !           403:   -- DESCRIPTION :
        !           404:   --   Generates a random number of the given size, with exponent between
        !           405:   --   the bounds low and upp.
        !           406:
        !           407:     res : Floating_Number := Random(sz);
        !           408:     exp : integer := Random(low,upp);
        !           409:
        !           410:   begin
        !           411:     if exp > 0
        !           412:      then for i in 1..exp loop
        !           413:             Mul(res,10.0);
        !           414:           end loop;
        !           415:      elsif exp < 0
        !           416:          then for i in 1..(-exp) loop
        !           417:                 Div(res,10.0);
        !           418:               end loop;
        !           419:     end if;
        !           420:     return res;
        !           421:   end Random;
        !           422:
        !           423:   procedure Random_Addition_and_Subtraction
        !           424:               ( sz1,sz2 : in natural; low,upp : in integer ) is
        !           425:
        !           426:   -- DESCRIPTION :
        !           427:   --   Three tests are performed:
        !           428:   --   1) n1+n2-n2 = n1, with "+" and "-".
        !           429:   --   2) Add(n1,n2) is the same as n1 := n1+n2?
        !           430:   --   3) Sub(n1+n2,n1) leads to n2?
        !           431:
        !           432:     n1,n2,sum1,sum2,tmp : Floating_Number;
        !           433:
        !           434:     procedure Report_Bug is
        !           435:     begin
        !           436:       new_line;
        !           437:       put("  n1 : "); put(n1); new_line;
        !           438:       put("  n2 : "); put(n2); new_line;
        !           439:     end Report_Bug;
        !           440:
        !           441:   begin
        !           442:     n1 := Random(sz1,low,upp);
        !           443:     n2 := Random(sz2,low,upp);
        !           444:     sum1 := n1+n2;
        !           445:     sum2 := sum1-n2;
        !           446:     if Equal(sum2,n1)
        !           447:      then put("n1+n2-n2 okay");
        !           448:      else put("n1+n2-n2 Bug?"); Report_Bug;
        !           449:           put("diff : "); tmp := sum2-n1; put(tmp); new_line;
        !           450:           Clear(tmp);
        !           451:     end if;
        !           452:     Add(sum2,n2);
        !           453:     if Equal(sum2,sum1)
        !           454:      then put("  Add okay");
        !           455:      else put("  Add Bug?"); Report_Bug;
        !           456:           put("diff : "); tmp := sum2-sum1; put(tmp); new_line;
        !           457:           Clear(tmp);
        !           458:     end if;
        !           459:     Sub(sum2,n1);
        !           460:     if Equal(sum2,n2)
        !           461:      then put("  Sub okay"); new_line;
        !           462:      else put("  Sub Bug?"); Report_Bug;
        !           463:           put("diff : "); tmp := sum2-n2; put(tmp); new_line;
        !           464:           Clear(tmp);
        !           465:     end if;
        !           466:     Clear(n1); Clear(n2);
        !           467:     Clear(sum1); Clear(sum2);
        !           468:   exception
        !           469:     when others => put_line("input caused exception:"); Report_Bug; raise;
        !           470:   end Random_Addition_and_Subtraction;
        !           471:
        !           472:   procedure Additions_and_Subtractions_on_Randoms is
        !           473:
        !           474:   -- DESCRIPTION :
        !           475:   --   Generates a number of random floats and performs repeated
        !           476:   --   additions and subtractions with checks on consistencies.
        !           477:
        !           478:     nb,sz1,sz2 : natural;
        !           479:     low,upp : integer;
        !           480:
        !           481:   begin
        !           482:     put("Give the number of tests : "); get(nb);
        !           483:     put("Give the size of the 1st number : "); get(sz1);
        !           484:     put("Give the size of the 2nd number : "); get(sz2);
        !           485:     put("Give lower bound on exponent : "); get(low);
        !           486:     put("Give upper bound on exponent : "); get(upp);
        !           487:     for i in 1..nb loop
        !           488:       Random_Addition_and_Subtraction(sz1,sz2,low,upp);
        !           489:     end loop;
        !           490:   end Additions_and_Subtractions_on_Randoms;
        !           491:
        !           492:   procedure Random_Multiplication_and_Division
        !           493:                ( sz1,sz2 : in natural; low,upp : in integer ) is
        !           494:
        !           495:   -- DESCRIPTION :
        !           496:   --   Three tests are performed :
        !           497:   --   1) n1*n2/n2 = n1, with "*" and "/".
        !           498:   --   2) Mul(n1,n2) is the same as n1 := n1*n2 ?
        !           499:   --   3) Div(n1*n2,n1) leads to n2 ?
        !           500:
        !           501:     n1,n2,prod,quot,tmp : Floating_Number;
        !           502:
        !           503:     procedure Report_Bug is
        !           504:     begin
        !           505:       new_line;
        !           506:       put("  n1 : "); put(n1); new_line;
        !           507:       put("  n2 : "); put(n2); new_line;
        !           508:     end Report_Bug;
        !           509:
        !           510:   begin
        !           511:     n1 := Random(sz1,low,upp);
        !           512:     n2 := Random(sz2,low,upp);
        !           513:     prod := n1*n2;
        !           514:     quot := prod/n2;
        !           515:     if Equal(quot,n1)
        !           516:      then put("n1*n2/n2 okay");
        !           517:      else put("n1*n2/n2 Bug?"); Report_Bug;
        !           518:           put("Diff : "); tmp := quot-n1; put(tmp); new_line;
        !           519:           Clear(tmp);
        !           520:     end if;
        !           521:     Mul(quot,n2);
        !           522:     if Equal(prod,quot)
        !           523:      then put("  Mul okay");
        !           524:      else put("  Mul Bug?"); Report_Bug;
        !           525:           put("Diff : "); tmp := quot-prod; put(tmp); new_line;
        !           526:           Clear(tmp);
        !           527:     end if;
        !           528:     Div(prod,n1);
        !           529:     if Equal(prod,n2)
        !           530:      then put("  Div okay"); new_line;
        !           531:      else put("  Div Bug?"); Report_Bug;
        !           532:           put("Diff : "); tmp := prod-n2; put(tmp); new_line;
        !           533:           Clear(tmp);
        !           534:     end if;
        !           535:     Clear(n1); Clear(n2);
        !           536:     Clear(prod); Clear(quot);
        !           537:   exception
        !           538:     when others => put_line("input caused exception :"); Report_Bug; raise;
        !           539:   end Random_Multiplication_and_Division;
        !           540:
        !           541:   procedure Multiplications_and_Divisions_on_Randoms is
        !           542:
        !           543:   -- DESCRIPTION :
        !           544:   --   Generates a number of random floats and performs repeated
        !           545:   --   multiplications and divisions with checks on consistencies.
        !           546:
        !           547:     nb,sz1,sz2 : natural;
        !           548:     low,upp : integer;
        !           549:
        !           550:   begin
        !           551:     put("Give the number of tests : "); get(nb);
        !           552:     put("Give the size of the 1st number : "); get(sz1);
        !           553:     put("Give the size of the 2nd number : "); get(sz2);
        !           554:     put("Give lower bound on exponent : "); get(low);
        !           555:     put("Give upper bound on exponent : "); get(upp);
        !           556:     for i in 1..nb loop
        !           557:       Random_Multiplication_and_Division(sz1,sz2,low,upp);
        !           558:     end loop;
        !           559:   end Multiplications_and_Divisions_on_Randoms;
        !           560:
        !           561:   procedure Main is
        !           562:
        !           563:     ans : character;
        !           564:
        !           565:   begin
        !           566:     new_line;
        !           567:     put_line("Interactive testing of multi-precision floating numbers.");
        !           568:     loop
        !           569:       new_line;
        !           570:       put_line("Choose one of the following : ");
        !           571:       put_line("  0. exit program      1. Input/Output     2. Creation      ");
        !           572:       put_line("  3. Comparison/Copy   4. Addition         5. Subtraction   ");
        !           573:       put_line("  6. Multiplication    7. Exponentiation   8. Division      ");
        !           574:       put_line("  9. Truncate/Round/Expand                                  ");
        !           575:       put_line("  A. Addition/subtraction on randomly generated numbers.    ");
        !           576:       put_line("  B. Multiplication/division/remainder on random numbers.   ");
        !           577:       put("Type in your choice (0,1,2,3,4,5,6,7,8,9,A, or B) : "); get(ans);
        !           578:       exit when (ans = '0');
        !           579:       new_line;
        !           580:       case ans is
        !           581:         when '1' => Test_io;
        !           582:         when '2' => Test_Creation;
        !           583:         when '3' => Test_Comparison;
        !           584:         when '4' => Test_Addition;
        !           585:         when '5' => Test_Subtraction;
        !           586:         when '6' => Test_Multiplication;
        !           587:         when '7' => Test_Exponentiation;
        !           588:         when '8' => Test_Division;
        !           589:         when '9' => Test_Size;
        !           590:         when 'A' => Additions_and_Subtractions_on_Randoms;
        !           591:         when 'B' => Multiplications_and_Divisions_on_Randoms;
        !           592:         when others => null;
        !           593:       end case;
        !           594:     end loop;
        !           595:   end Main;
        !           596:
        !           597: begin
        !           598:   Main;
        !           599: end ts_fltnum;

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>