TEAM-ADA Archives

Team Ada: Ada Programming Language Advocacy


Options: Use Forum View

Use Monospaced Font
Show Text Part by Default
Show All Mail Headers

Message: [<< First] [< Prev] [Next >] [Last >>]
Topic: [<< First] [< Prev] [Next >] [Last >>]
Author: [<< First] [< Prev] [Next >] [Last >>]

Print Reply
"Robert I. Eachus" <[log in to unmask]>
Reply To:
Robert I. Eachus
Wed, 12 Feb 1997 17:00:39 -0500
text/plain (125 lines)
   Lamar Harris ([log in to unmask]) asked:

  > What is causing this and how do I fix it? Please don't tell me I have to do
  > this all in Lisp or, Heaven forbid, C because of a fluke in Ada!

  First, and most important, why are you using floating point?

  This is an application where the use of floating point leads only to
sorrow and misery--as you noticed.  The problem is that the result of
the distance function is almost surely guarenteed to set some of the
hardware guard bits during calculations.  Now if you use the attribute
function My_Float'Model (and if the numerics annex is supported):

     function Distance(Point1, Point2: in Point_Type) return My_Float is
       return My_Float'Model
          (Sqrt((Point1.X - Point2.X)**2 + (Point1.Y - Point2.Y)**2));
     end Distance;

  Now you don't have to worry about when registers get stored.  (If
you are really careful you will convert all calculation results to
model numbers including the initial values for the points.

   But the real solution is to convert to using fixed point.  THIS IS
WHAT IT IS FOR.  Try the version below.  The lines marked demo repeat
the program 100 times, and each time it should print out:

Path 1 is the same length as Path 2

   Boring, but it is what you want.

   Notice that Text_IO.Fixed_IO loses accuracy.  (I'm sure this is
a low priority bug for ACT.  It is for all the other vendors...)

with Ada.Text_IO, Ada.Integer_Text_IO, Ada.Numerics.Float_Random;
with Ada.Numerics.Generic_Elementary_Functions;
use Ada.Text_IO, Ada.Integer_Text_IO, Ada.Numerics.Float_Random;

procedure Fixed_Test is

  type My_Fixed is delta 0.00000000000000001 range 0.0..8.0;
  package My_Fixed_IO is new Ada.Text_IO.Fixed_IO(My_Fixed);
  package Float_Functions
     is new Ada.Numerics.Generic_Elementary_Functions(Float);
  use My_Fixed_IO, Float_Functions;

  type Point_Type is record
     X: My_Fixed;
     Y: My_Fixed;
  end record;

  function Distance(Point1, Point2: in Point_Type) return My_Fixed is
     return My_Fixed(Sqrt(Float((Point1.X - Point2.X))**2 +
                          Float((Point1.Y - Point2.Y))**2));
  end Distance;

  Float_Generator: Ada.Numerics.Float_Random.Generator;

  function Random_Point return Point_Type is
     New_Point: Point_Type;
     New_Point.X := My_Fixed(Random(Float_Generator));
     New_Point.Y := My_Fixed(Random(Float_Generator));
     return New_Point;
  end Random_Point;

  Point_A, Point_B, Point_C, Point_D, Point_E: Point_Type;

  Path_A_Length, Path_B_Length: My_Fixed;



  for I in 1..100 loop -- demo

  Point_A := Random_Point; Point_B := Random_Point;
  Point_C := Random_Point; Point_D := Random_Point;
  Point_E := Random_Point;

    := Distance(Point_A, Point_B)+Distance(Point_B, Point_C)+
       Distance(Point_C, Point_D)+Distance(Point_D, Point_E)+
       Distance(Point_E, Point_A);

    := Distance(Point_C, Point_B)+Distance(Point_B, Point_A)+
       Distance(Point_A, Point_E)+Distance(Point_E, Point_D)+
       Distance(Point_D, Point_C);

  if Path_A_Length /= Path_B_Length then -- demo

  Put("Point A: "); Put(Point_A.X,0,16,0);Put(", "); Put(Point_A.Y,0,16,0);
  Put("Point B: "); Put(Point_B.X,0,16,0);Put(", "); Put(Point_B.Y,0,16,0);
  Put("Point C: "); Put(Point_C.X,0,16,0);Put(", "); Put(Point_C.Y,0,16,0);
  Put("Point D: "); Put(Point_D.X,0,16,0);Put(", "); Put(Point_D.Y,0,16,0);
  Put("Point E: "); Put(Point_E.X,0,16,0);Put(", "); Put(Point_E.Y,0,16,0);
  Put("Path 1 Length (ABCDEA) = "); Put(Path_A_Length,0,16,0);
  Put("Path 2 Length (CBAEDC) = "); Put(Path_B_Length,0,16,0);

  end if; -- demo

  if Path_A_Length < Path_B_Length then
     Put_Line("Path 1 is shorter than Path 2");
  elsif Path_A_Length > Path_B_Length then
     Put_Line("Path 1 is longer than Path 2");
  elsif Path_A_Length = Path_B_Length then
     Put_Line("Path 1 is the same length as Path 2");
     Put_Line("Comparison Error!");
  end if;

  end loop; -- demo

end Fixed_Test;