From mboxrd@z Thu Jan  1 00:00:00 1970
X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me
X-Spam-Level: 
X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00 autolearn=ham
	autolearn_force=no version=3.4.4
X-Google-Language: ENGLISH,ASCII-7-bit
X-Google-Thread: 103376,f874248afede03ca,start
X-Google-Attributes: gid103376,public
From: mfeldman@seas.gwu.edu
Subject: Operators -> Unit Analysis
Date: 2000/01/08
Message-ID: <8580ik$o60$1@news.netmar.com>
X-Deja-AN: 570058309
X-PNG: comp.lang.ada
X-Complaints-To: abuse@newsone.net
X-Trace: news.netmar.com 947357076 24768 205.139.138.14 (8 Jan 2000 18:44:36
 GMT)
Organization: NewsOne.Net - Free Usenet News via the Web - http://newsone.net/
NNTP-Posting-Date: 8 Jan 2000 18:44:36 GMT
Newsgroups: comp.lang.ada
Date: 2000-01-08T18:44:36+00:00
List-Id: <comp.lang.ada>

Hi all,

I thought I'd jump in and contribute a unit-analysis solution that doesn't use
generics or require the client to define any new operators. Nothing is free,
and this solution uses discriminants to carry the dimensions. Naturally this
uses extra run-time storage, but I think it's a good program model of the
physical
world, in which each physical quantity can be reduced to a scalar value and a
set of physical dimensions (mass/length/time/charge). The various physical
units are declared as subtypes of the resulting variant record type; a client
can,
for convenience, add units just by delcaring new subtypes. The additive and
multiplicative operators are defined in such a way that checking is done at
compilation time where possible, else at run time.

This package is based on a discussion in the Ada 83 Rationale, and is taken
from Chap. 6 in my data structures book. Please excuse the uppercase reserved
words. 
This version uses mass/length/time dimensions; as an exercise one could add a
charge dimension or make it generic. The spec, body, and a test program
follow.

Mike Feldman

PACKAGE Metric_System IS
------------------------------------------------------------------
--| Specification for Metric System Package
--| Author: Michael B. Feldman, The George Washington University 
--| Last Modified: September 1995                                     
------------------------------------------------------------------
 
--  Type definition
 
  TYPE    Metric(Mass, Length, Time : Integer) IS PRIVATE;

  -- constrained subtypes

  SUBTYPE Scalar   IS Metric(0, 0, 0);
 
  SUBTYPE Accel    IS Metric(0, 1, -2);
  SUBTYPE Area     IS Metric(0, 2, 0);
  SUBTYPE Length   IS Metric(0, 1, 0);
  SUBTYPE Distance IS Metric(0, 1, 0);
  SUBTYPE Mass     IS Metric(1, 0, 0);
  SUBTYPE Time     IS Metric(0, 0, 1);
  SUBTYPE Velocity IS Metric(0, 1, -1);
  SUBTYPE Volume   IS Metric(0, 3, 0);

  -- exported exception

  Dimension_Error : EXCEPTION;

  -- exported unit constants; these will be defined in full below

  Gram       : CONSTANT Metric;
  METER      : CONSTANT Metric;
  SEC        : CONSTANT Metric;
  Square_M   : CONSTANT Metric;
  Cubic_M    : CONSTANT Metric;
  M_per_Sec  : CONSTANT Metric;
  M_per_Sec2 : CONSTANT Metric;
 
  FUNCTION "*" (Left : Float; Right : Metric) RETURN Metric;
  -- Pre:  Left and Right are defined
  -- Post: constructor: produces a metric quantity from a Float one

  FUNCTION Value(Left : Metric) RETURN Float;
  -- Pre:  Left is defined
  -- Post: selector: returns the Float (dimensionless) part
  --   of a metric quantity

  FUNCTION "<"  (Left, Right : Metric) RETURN Boolean;
  FUNCTION "<=" (Left, Right : Metric) RETURN Boolean;
  FUNCTION ">"  (Left, Right : Metric) RETURN Boolean;
  FUNCTION ">=" (Left, Right : Metric) RETURN Boolean;
  -- Pre:    Left and Right are defined
  -- Post:   the usual comparison operations
  -- Raises: Dimension_Error if Left and Right 
  --   have different dimensions

  FUNCTION "+" (Right : Metric) RETURN Metric;
  FUNCTION "-" (Right : Metric) RETURN Metric;
  FUNCTION "abs" (Right : Metric) RETURN Metric;
  -- Pre:  Right is defined
  -- Post: the usual monadic arithmetic operations;
  --   the dimensions of Right are, of course, preserved
 
  FUNCTION "+" (Left, Right : Metric) RETURN Metric;
  FUNCTION "-" (Left, Right : Metric) RETURN Metric;
  -- Pre:    Left and Right are defined
  -- Post:   the usual additive operations are performed on the
  --   numeric parts of Left and Right; the dimensions are preserved
  -- Raises: Dimension_Error if Left and Right
  --   have different dimensions

  FUNCTION "*" (Left, Right : Metric) RETURN Metric;
  FUNCTION "/" (Left, Right : Metric) RETURN Metric;
  -- Pre:    Left and Right are defined
  -- Post:   the usual multiplication and division operations 
  --   are performed on the numeric parts of Left and Right; 
  --   the dimensions are added pairwise (multiplication)
  --   or subtracted pairwise (division)
  --   Left and Right need not have the same dimensions.
  
PRIVATE

  -- A Metric quantity is a 3-discriminant variant record,
  -- with no default values. Each object of the type must
  -- therefore be constrained to a subtype, that is, to a
  -- fixed set of dimensions. This is physically realistic.

  TYPE Metric(Mass, Length, Time : Integer) IS RECORD
    Value : Float := 0.0;
  END RECORD;
 
  Gram       : CONSTANT Metric := (1, 0, 0, 1.0);
  Meter      : CONSTANT Metric := (0, 1, 0, 1.0);
  Sec        : CONSTANT Metric := (0, 0, 1, 1.0);
  Square_M   : CONSTANT Metric := (0, 2, 0, 1.0);
  Cubic_M    : CONSTANT Metric := (0, 3, 0, 1.0);
  M_per_Sec  : CONSTANT Metric := (0, 1, -1, 1.0);
  M_per_Sec2 : CONSTANT Metric := (0, 1, -2, 1.0);
 
END Metric_System;

PACKAGE BODY Metric_System IS
------------------------------------------------------------------
--| This is the implementation of the package Metric_System.
--| Author: Michael B. Feldman, The George Washington University 
--| Last Modified: September 1995                                     
------------------------------------------------------------------
 
  -- local function to check whether its arguments have the same dimensions

  FUNCTION SameDimensions(Left, Right :Metric) RETURN Boolean IS
  BEGIN
    RETURN (Left.Length = Right.Length) AND
           (Left.Mass = Right.Mass)     AND
           (Left.Time = Right.Time);
  END SameDimensions;

  FUNCTION "*" (Left : Float; Right : Metric) RETURN Metric IS
  BEGIN
    RETURN (Right.Mass, Right.Length, Right.Time, Left * Right.Value);
  END "*";
 
  FUNCTION Value(Left : Metric) RETURN Float IS
  BEGIN
    RETURN Left.Value;
  END Value;

  -- comparison operators

  FUNCTION "<" (Left, Right : Metric) RETURN Boolean IS
  BEGIN
    IF SameDimensions(Left, Right) THEN
      RETURN Left.Value < Right.Value;
    ELSE
      RAISE Dimension_Error;
    END IF;
  END "<";

  FUNCTION "<=" (Left, Right : Metric) RETURN Boolean IS
  BEGIN
    IF SameDimensions(Left, Right) THEN
      RETURN Left.Value <= Right.Value;
    ELSE
      RAISE Dimension_Error;
    END IF;
  END "<=";

  FUNCTION ">" (Left, Right : Metric) RETURN Boolean IS
  BEGIN
    IF SameDimensions(Left, Right) THEN
      RETURN Left.Value > Right.Value;
    ELSE
      RAISE Dimension_Error;
    END IF;
  END ">";

  FUNCTION ">=" (Left, Right : Metric) RETURN Boolean IS
  BEGIN
    IF SameDimensions(Left, Right) THEN
      RETURN Left.Value >= Right.Value;
    ELSE
      RAISE Dimension_Error;
    END IF;
  END ">=";

  --  monadic arithmetic operators
 
  FUNCTION "+" (Right : Metric) RETURN Metric IS
  BEGIN
    RETURN Right;
  END "+";
 
  FUNCTION "-" (Right : Metric) RETURN Metric IS
  BEGIN
    RETURN (Right.Mass, Right.Length, Right.Time, -Right.Value);
  END "-";
 
  FUNCTION "ABS" (Right : Metric) RETURN Metric IS
  BEGIN
    RETURN (Right.Mass, Right.Length, Right.Time, ABS(Right.Value));
  END "ABS";
 
  --  dyadic arithmetic operators
 
  --  "+" and "-" require two variables of the same subtype,
  --  they return a variable of the same subtype passed
 
  FUNCTION "+" (Left, Right : Metric) RETURN Metric IS
  BEGIN
    IF SameDimensions(Left, Right) THEN
      RETURN (Left.Mass, Left.Length, Left.Time, Left.Value + Right.Value);
    ELSE
      RAISE Dimension_Error;
    END IF;
  END "+";
 
  FUNCTION "-" (Left, Right : Metric) RETURN Metric IS
  BEGIN
    IF SameDimensions(Left, Right) THEN
      RETURN (Left.Mass, Left.Length, Left.Time, Left.Value - Right.Value);
    ELSE
      RAISE Dimension_Error;
    END IF;
  END "-";

  --  "*" and "/" require variables of any subtype
  --  of Metric.  The subtype of the variable returned depends on
  --  the types passed and how the operation combines the units.
 
  FUNCTION "*" (Left, Right : Metric) RETURN Metric IS
  BEGIN
    RETURN (Left.Mass + Right.Mass, Left.Length + Right.Length, 
            Left.Time + Right.Time, Left.Value * Right.Value);
  END "*";
 
  FUNCTION "/" (Left, Right : Metric) RETURN Metric IS
  BEGIN
    RETURN (Left.Mass - Right.Mass, Left.Length - Right.Length, 
            Left.Time - Right.Time, Left.Value / Right.Value);
  END "/";
 
END Metric_System;


WITH Ada.Text_IO;
WITH Ada.Float_Text_IO;
WITH Metric_System; USE Metric_System;
PROCEDURE Test_Metric IS
------------------------------------------------------------------
--| Test some of the operations of the metric system package
--| Author: Michael B. Feldman, The George Washington University 
--| Last Modified: September 1995                                     
------------------------------------------------------------------

  V   : Velocity;
  T   : Time;
  D   : Length;
  A   : Area;
  Vol : Volume;

BEGIN -- Test_Metric

  -- these operations should all work correctly

  V := 23.0 * M_per_Sec;
  T := 3600.0 * Sec;

  D := V * T;

  Ada.Text_IO.Put("Distance = Rate * Time works as advertised");
  Ada.Text_IO.New_Line;
  Ada.Text_IO.Put("Distance is ");
  Ada.Float_Text_IO.Put(Item => Value(D), Fore => 1, Aft => 2, Exp => 0);
  Ada.Text_IO.Put(" meters.");
  Ada.Text_IO.New_Line;
  Ada.Text_IO.New_Line;

  D := 3.0 * Meter;
  A := D * D;

  Ada.Text_IO.Put("Area = Distance * Distance works as advertised");
  Ada.Text_IO.New_Line;
  Ada.Text_IO.Put("Area is ");
  Ada.Float_Text_IO.Put(Item => Value(A), Fore => 1, Aft => 2, Exp => 0);
  Ada.Text_IO.Put(" square meters.");
  Ada.Text_IO.New_Line;
  Ada.Text_IO.New_Line;

  Vol := A * D;

  Ada.Text_IO.Put("Volume = Area * Distance works as advertised");
  Ada.Text_IO.New_Line;
  Ada.Text_IO.Put("Volume is ");
  Ada.Float_Text_IO.Put(Item => Value(Vol), Fore => 1, Aft => 2, Exp => 0);
  Ada.Text_IO.Put(" cubic meters.");
  Ada.Text_IO.New_Line;
  Ada.Text_IO.New_Line;

  D := D + D;

  Ada.Text_IO.Put("Distance = Distance + Distance works as advertised");
  Ada.Text_IO.New_Line;
  Ada.Text_IO.Put("Distance is ");
  Ada.Float_Text_IO.Put(Item => Value(D), Fore => 1, Aft => 2, Exp => 0);
  Ada.Text_IO.Put(" meters.");
  Ada.Text_IO.New_Line;
  Ada.Text_IO.New_Line;

  BEGIN -- block for exception handler
    D := D * D;
    Ada.Text_IO.Put("Distance = Distance * Distance worked, but should not");
    Ada.Text_IO.New_Line;
  EXCEPTION
    WHEN Constraint_Error =>
      Ada.Text_IO.Put
        ("Constraint Error Raised on Distance = Distance * Distance");
      Ada.Text_IO.New_Line;
    WHEN Dimension_Error =>
      Ada.Text_IO.Put
        ("Dimension Error Raised on Distance = Distance * Distance");
      Ada.Text_IO.New_Line;
  END; -- exception block

  BEGIN -- block for exception handler
    D := T + D;
    Ada.Text_IO.Put("Distance = Time + Distance worked, but should not");
    Ada.Text_IO.New_Line;
  EXCEPTION
    WHEN Constraint_Error =>
      Ada.Text_IO.Put("Constraint Error Raised on Distance = Time +
Distance");
      Ada.Text_IO.New_Line;
    WHEN Dimension_Error =>
      Ada.Text_IO.Put("Dimension Error Raised on Distance = Time +
Distance");
      Ada.Text_IO.New_Line;
  END; -- exception block

END Test_Metric;
 


     -----  Posted via NewsOne.Net: Free Usenet News via the Web  -----
     -----  http://newsone.net/ --  Discussions on every subject. -----
   NewsOne.Net prohibits users from posting spam.  If this or other posts
made through NewsOne.Net violate posting guidelines, email abuse@newsone.net