From: mfeldman@seas.gwu.edu
Subject: Operators -> Unit Analysis
Date: 2000/01/08
Date: 2000-01-08T18:44:36+00:00 [thread overview]
Message-ID: <8580ik$o60$1@news.netmar.com> (raw)
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
next reply other threads:[~2000-01-08 0:00 UTC|newest]
Thread overview: 28+ messages / expand[flat|nested] mbox.gz Atom feed top
2000-01-08 0:00 mfeldman [this message]
-- strict thread matches above, loose matches on Subject: below --
1999-12-23 0:00 Ada Brijesh
1999-12-23 0:00 ` Ada Robert Dewar
2000-01-03 0:00 ` Ada Terry Sikes
2000-01-03 0:00 ` Ada Hyman Rosen
2000-01-04 0:00 ` Ada Terry Sikes
2000-01-05 0:00 ` Operators -> unit analysis Charles Hixson
2000-01-05 0:00 ` Matthew Heaney
2000-01-05 0:00 ` Charles Hixson
2000-01-05 0:00 ` Ted Dennison
2000-01-06 0:00 ` Samuel T. Harris
2000-01-07 0:00 ` Robert Dewar
2000-01-07 0:00 ` Ted Dennison
2000-01-07 0:00 ` Brian Rogoff
2000-01-07 0:00 ` Robert A Duff
2000-01-07 0:00 ` Matthew Heaney
2000-01-08 0:00 ` Robert Dewar
2000-01-08 0:00 ` Robert A Duff
2000-01-06 0:00 ` Charles Hixson
2000-01-05 0:00 ` Pat Rogers
2000-01-05 0:00 ` Charles Hixson
2000-01-05 0:00 ` Hyman Rosen
2000-01-05 0:00 ` Matthew Heaney
2000-01-06 0:00 ` Robert Dewar
2000-01-06 0:00 ` Terry Sikes
2000-01-06 0:00 ` Robert A Duff
2000-01-07 0:00 ` Terry Sikes
2000-01-07 0:00 ` Brian Rogoff
2000-01-07 0:00 ` Ted Dennison
2000-01-07 0:00 ` Tucker Taft
2000-01-08 0:00 ` Robert Dewar
2000-01-10 0:00 ` Tucker Taft
2000-01-10 0:00 ` Florian Weimer
replies disabled
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox