* Re: Scientific Unit Checking??
1997-04-07 0:00 Scientific Unit Checking?? Ron House
@ 1997-04-09 0:00 ` Michael Feldman
1997-04-10 0:00 ` Peter Hermann
1 sibling, 0 replies; 3+ messages in thread
From: Michael Feldman @ 1997-04-09 0:00 UTC (permalink / raw)
In article <334897B1.26258D03@usq.edu.au>, Ron House <house@usq.edu.au> wrote:
>Some time ago I read about a package for implementing
>scientific unit checks in Ada.
>
>Can anyone tell me where to locate this package or
>any information about it?
>
>Many thanks...
>
>--
>Ron House
Here is a relatively straightforward approach using discriminants
(taken from my data structures book, Chapter 6). You can use this
for educational purposes. If you modify it, you must leave my header
comments in place, adding your own if you wish.
Oh - UPPERCASE RESERVED WORD ALERT! :-)
Mike Feldman
--- cut here for code ---
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;
^ permalink raw reply [flat|nested] 3+ messages in thread