Programmer's ROM - The Computer Language Library/programmersrom.iso/ada/math/mathfun.src

Text File | 1988-05-03 | 27.9 KB | 1,203 lines

--::::::::::
--mathgeni.ada
--::::::::::
-- MATHGENI.ADA
----+----1----+----2----+----3----+----4----+----5----+----6----+----7--
-- Generic package of integer type functions
----+----1----+----2----+----3----+----4----+----5----+----6----+----7--
-- LOG OF CHANGES

--    1.    86 04 23: CODING BEGUN BY DAVID KWONG.

----+----1----+----2----+----3----+----4----+----5----+----6----+----7--
    WITH TEXT_IO;
GENERIC

    TYPE FLOATG IS DIGITS <>;
    TYPE INTEGERG IS RANGE <>;

PACKAGE MATH_FUNCTIONS_GENERIC_INTEGER  IS

    -- MAX function gives maximum of both arguments

    FUNCTION MAX(LEFT,RIGHT:INTEGERG) RETURN INTEGERG;

    -- MIN function gives minimum of both arguments

    FUNCTION MIN(LEFT,RIGHT:INTEGERG) RETURN INTEGERG;

    -- REMAINDER function gives signed remainder of left/right
    -- result is of type FLOATG

    FUNCTION REMAINDER(LEFT,RIGHT:INTEGERG)    RETURN FLOATG;

    -- Sign function = +1 when A>=0, -1 when A<0

    FUNCTION  SIGN(A:INTEGERG)  RETURN INTEGERG;

    -- SIGNUM function =+1 when A>0, 0 when A=0, -1 when A<0

    FUNCTION  SIGNUM(A:INTEGERG)  RETURN INTEGERG;

END MATH_FUNCTIONS_GENERIC_INTEGER;  -- End specification of package

----+----1----+----2----+----3----+----4----+----5----+----6----+----7--

PACKAGE BODY MATH_FUNCTIONS_GENERIC_INTEGER IS

    FUNCTION MAX(LEFT,RIGHT:INTEGERG) RETURN INTEGERG IS

    BEGIN

        IF LEFT < RIGHT THEN
            RETURN RIGHT;
        ELSE
            RETURN LEFT;
        END IF;

    EXCEPTION

        WHEN OTHERS =>
            TEXT_IO.PUT("MAX(INTEGERG) Unidentified error");
            RAISE;

    END MAX;

    FUNCTION MIN(LEFT,RIGHT:INTEGERG) RETURN INTEGERG IS

    BEGIN

        IF LEFT < RIGHT THEN
            RETURN LEFT;
        ELSE
            RETURN RIGHT ;
        END IF;

    EXCEPTION

        WHEN OTHERS =>
            TEXT_IO.PUT("MIN(INTEGERG) Unidentified error");
            RAISE;

    END MIN;

    FUNCTION REMAINDER(LEFT,RIGHT:INTEGERG) RETURN FLOATG IS

        A: FLOATG;

    BEGIN

        RETURN FLOATG(LEFT)/FLOATG(RIGHT)-FLOATG(LEFT/RIGHT);

    EXCEPTION

        WHEN OTHERS =>
            TEXT_IO.PUT("REMAINDER(INTEGERG) Unidentified error");
            RAISE;

    END REMAINDER;

    FUNCTION SIGN(A:INTEGERG) RETURN INTEGERG IS

    BEGIN

        IF A<0 THEN
            RETURN -1 ;
        ELSE
            RETURN 1;
        END IF;

    EXCEPTION

        WHEN OTHERS =>
            TEXT_IO.PUT("SIGN(INTEGERG): Unidentified error");
            RAISE;

    END SIGN;

    FUNCTION SIGNUM(A:INTEGERG) RETURN INTEGERG IS

    BEGIN

        IF A<0 THEN
            RETURN -1 ;
        ELSIF A=0 THEN
            RETURN 0;
        ELSE
            RETURN 1;
        END IF;

    EXCEPTION

        WHEN OTHERS =>
            TEXT_IO.PUT("SIGNUM(INTEGERG): Unidentified error");
            RAISE;

    END SIGNUM;

END MATH_FUNCTIONS_GENERIC_INTEGER;
--::::::::::
--mathgenf.ada
--::::::::::
-- MATHGENF.ADA
----+----1----+----2----+----3----+----4----+----5----+----6----+----7--
-- Generic package of float type math functions
----+----1----+----2----+----3----+----4----+----5----+----6----+----7--
--LOG OF CHANGES

--   1.   86 04 24: CODING BEGUN BY DAVID KWONG.

----+----1----+----2----+----3----+----4----+----5----+----6----+----7--

    WITH TEXT_IO;
GENERIC

    TYPE FLOATG IS DIGITS <>;
    TYPE INTEGERG IS RANGE <>;

PACKAGE MATH_FUNCTIONS_GENERIC_FLOAT IS

    -- Ceiling function returns smallest INTEGERG >= A

    FUNCTION CEILING(A:FLOATG)  RETURN FLOATG;

    -- Floor function rounds to largest INTEGERG <= A

    FUNCTION FLOOR(A:FLOATG)  RETURN FLOATG;

    -- MAX function gives maximum of both arguments

    FUNCTION MAX(LEFT,RIGHT:FLOATG) RETURN FLOATG;

    -- MIN function gives minimum of both arguments

    FUNCTION MIN(LEFT,RIGHT:FLOATG) RETURN FLOATG;

    -- MOD function for Floats follows the ADA convention for
    -- INTEGERGs

    FUNCTION "MOD"(LEFT,RIGHT:FLOATG) RETURN FLOATG;

    -- "REM" function for Floats follows the ADA convention for
    -- INTEGERGs

    FUNCTION "REM"(LEFT,RIGHT:FLOATG) RETURN FLOATG;

    -- REMAINDER function gives sign remainder of left/right

    FUNCTION REMAINDER(LEFT,RIGHT:FLOATG)  RETURN FLOATG;

    -- ROUND function rounds A to nearest INTEGERG

    FUNCTION ROUND(A:FLOATG)  RETURN FLOATG;

    -- Sign function = +1.0 when A<=0.0, -1.0 when A<0.0

    FUNCTION  SIGN(A:FLOATG)  RETURN FLOATG;

    -- SIGNUM function =+1.0 when A>0.0, 0.0 when A=0.0, -1.0 when A<0.0

    FUNCTION  SIGNUM(A:FLOATG)  RETURN FLOATG;

    -- Truncate function for Floats only =
    -- largest INTEGERG <= ABS(A) * SIGNUM(INTEGERGD(A))
    -- (INTEGERG type conversion will round to closest INTEGERG)

    FUNCTION  TRUNCATE(A:FLOATG)  RETURN FLOATG;

END MATH_FUNCTIONS_GENERIC_FLOAT;  -- End specification of package

----+----1----+----2----+----3----+----4----+----5----+----6----+----7--

PACKAGE BODY MATH_FUNCTIONS_GENERIC_FLOAT IS

    FUNCTION CEILING(A:FLOATG) RETURN FLOATG IS

        INTEGERGA: INTEGERG := INTEGERG(A);

    BEGIN

        IF(FLOATG(INTEGERGA) < A) THEN
            RETURN FLOATG(INTEGERGA+1);
        ELSE
            RETURN FLOATG(INTEGERGA);
        END IF;

    EXCEPTION

        WHEN OTHERS =>
            TEXT_IO.PUT("CEILING(FLOATG) Unidentified error");
            RAISE;

    END CEILING;

    FUNCTION FLOOR(A:FLOATG) RETURN FLOATG IS

        INTEGERGA: INTEGERG := INTEGERG(A);

    BEGIN

        IF(A < FLOATG(INTEGERGA)) THEN
            RETURN FLOATG(INTEGERGA-1);
        ELSE
            RETURN FLOATG(INTEGERGA);
        END IF;

    EXCEPTION

        WHEN OTHERS =>
            TEXT_IO.PUT("FLOOR(FLOATG) Unidentified error");
            RAISE;

    END FLOOR;

    FUNCTION MAX(LEFT,RIGHT:FLOATG) RETURN FLOATG IS

    BEGIN

        IF LEFT < RIGHT THEN
            RETURN RIGHT;
        ELSE
            RETURN LEFT;
        END IF;

    EXCEPTION

        WHEN OTHERS =>
            TEXT_IO.PUT("MAX(FLOATG) Unidentified error");
            RAISE;

    END MAX;

    FUNCTION MIN(LEFT,RIGHT:FLOATG) RETURN FLOATG IS

    BEGIN

        IF LEFT < RIGHT THEN
            RETURN LEFT;
        ELSE
            RETURN RIGHT ;
        END IF;

    EXCEPTION

        WHEN OTHERS =>
            TEXT_IO.PUT("MIN(FLOATG) Unidentified error");
            RAISE;


    END MIN;

    FUNCTION "MOD"(LEFT,RIGHT:FLOATG) RETURN FLOATG IS

    BEGIN

            RETURN ABS(RIGHT*FLOOR(LEFT/RIGHT)-LEFT)*SIGN(RIGHT);

    EXCEPTION

        WHEN OTHERS =>
            TEXT_IO.PUT("MOD(FLOAT): unidentified error");
            RAISE;

    END "MOD";

    FUNCTION "REM"(LEFT,RIGHT:FLOATG) RETURN FLOATG IS

    BEGIN

        RETURN LEFT-FLOOR(ABS(LEFT/RIGHT))*ABS(RIGHT)*SIGN(LEFT);

    EXCEPTION

        WHEN OTHERS =>
            TEXT_IO.PUT("REM(FLOAT): unidentified error");
            RAISE;

    END "REM";

    FUNCTION REMAINDER(LEFT,RIGHT:FLOATG) RETURN FLOATG IS

        A: FLOATG := LEFT/RIGHT;

    BEGIN

        RETURN A-TRUNCATE(A);

    EXCEPTION

        WHEN OTHERS =>
            TEXT_IO.PUT("REMAINDER(FLOATG) Unidentified error");
            RAISE;

    END REMAINDER;

    FUNCTION ROUND(A:FLOATG) RETURN FLOATG IS

    BEGIN

        RETURN FLOATG(INTEGERG(A));

    EXCEPTION

        WHEN OTHERS =>
            TEXT_IO.PUT("ROUND(FLOATG) Unidentified error");
            RAISE;

    END ROUND;

    FUNCTION SIGN(A:FLOATG) RETURN FLOATG IS

    BEGIN

        IF A<0.0 THEN
            RETURN -1.0;
        ELSE
            RETURN 1.0;
        END IF;

    EXCEPTION

        WHEN OTHERS =>
            TEXT_IO.PUT("SIGN(FLOATn): Unidentified error");
            RAISE;

    END SIGN;

    FUNCTION SIGNUM(A:FLOATG) RETURN FLOATG IS

    BEGIN

        IF A<0.0 THEN
            RETURN -1.0 ;
        ELSIF A=0.0 THEN
            RETURN 0.0;
        ELSE
            RETURN 1.0;
        END IF;

    EXCEPTION

        WHEN OTHERS =>
            TEXT_IO.PUT("SIGNUM(FLOATn): Unidentified error");
            RAISE;

    END SIGNUM;

    FUNCTION TRUNCATE(A:FLOATG) RETURN FLOATG  IS

    BEGIN

        RETURN SIGN(A)*FLOOR(ABS(A));

    EXCEPTION

        WHEN OTHERS =>
            TEXT_IO.PUT("TRUNCATE(FLOATn): Unidentified error");
            RAISE;

    END TRUNCATE;

END MATH_FUNCTIONS_GENERIC_FLOAT;
--::::::::::
--mathfung.ada
--::::::::::
-- MATHFUNG.ADA
-- This generic package can be instantiated with three different
-- user defined types(one integer and 2 floating point types)
-- The functions provided are:
-- FLOOR,REMAINDER,ROUND,SIGN,SIGNUM,TRUNCATE,REM,MODE
-- All functions are defined for FLOAT types, only REMAINDER,
-- SIGN and SIGNUM
-- are defined for INTEGER types.  The rest of the functions don't
-- make sense for INTEGER types or are inherent in the language.
----+----1----+----2----+----3----+----4----+----5----+----6----+----7--
--LOG OF CHANGES

-- 1.  86 04 24: CODING BEGUN BY DAVID KWONG.

----+----1----+----2----+----3----+----4----+----5----+----6----+----7--

    WITH MATH_FUNCTIONS_GENERIC_INTEGER;
    WITH MATH_FUNCTIONS_GENERIC_FLOAT;

GENERIC -- PACKAGE MATH FUNCTIONS

    TYPE FLOATS IS DIGITS <>;
    TYPE FLOATD IS DIGITS <>;
    TYPE INTEGERD IS RANGE <>;

PACKAGE MATH_FUNCTIONS_GENERIC IS

    PACKAGE MF_INTEGER IS NEW
         MATH_FUNCTIONS_GENERIC_INTEGER(FLOATD,INTEGERD);

    PACKAGE MF_FLOATS IS NEW
         MATH_FUNCTIONS_GENERIC_FLOAT(FLOATS,INTEGERD);

    PACKAGE MF_FLOATD IS NEW
         MATH_FUNCTIONS_GENERIC_FLOAT(FLOATD,INTEGERD);

-- All functions must be renamed if they are to be visible
-- with a use clause when this package is instantiated
-- The floating point renames are identical except for the types
--
-- DEFINITION OF FUNCTIONS
--
-- Ceiling function returns smallest INTEGERD >= A
-- Floor function returns largest INTEGERD <= A
-- MAX function returns the largest of 2 arguments
-- MIN function returns the smallest of 2 arguments
-- MOD function for FLOATs follows the ADA convention for INTEGERD
-- REM function for FLOATs follows the ADA convention for INTEGERD
-- REMAINDER function gives signed remainder of left/right
-- ROUND function rounds A to nearest INTEGERD
-- Sign function = +1.0 when A<=0.0, -1.0 when A<0.0
-- SIGNUM function =+1.0 when A>0.0, 0.0 when A=0.0, -1.0 when A<0.0
-- Truncate function for FLOATs only =
-- largest INTEGERD <= ABS(A) * SIGNUM(INTEGERDD(A))
--   (INTEGERD type conversion will round to closest INTEGERD)

---------- Integer functions ------------------------------------

    FUNCTION MAX(LEFT,RIGHT:INTEGERD) RETURN INTEGERD
        RENAMES MF_INTEGER.MAX;

    FUNCTION MIN(LEFT,RIGHT:INTEGERD) RETURN INTEGERD
        RENAMES MF_INTEGER.MIN;

    FUNCTION REMAINDER(LEFT,RIGHT:INTEGERD) RETURN FLOATD
        RENAMES MF_INTEGER.REMAINDER;

    FUNCTION SIGN(A:INTEGERD) RETURN INTEGERD RENAMES
        MF_INTEGER.SIGN;

    FUNCTION SIGNUM(A:INTEGERD) RETURN INTEGERD RENAMES
        MF_INTEGER.SIGNUM;

-------- FLOATING POINT SINGLE PRECISION FUNCTIONS --------------------

    FUNCTION MAX(LEFT,RIGHT:FLOATS) RETURN FLOATS
        RENAMES MF_FLOATS.MAX;

    FUNCTION MIN(LEFT,RIGHT:FLOATS) RETURN FLOATS
        RENAMES MF_FLOATS.MIN;

    FUNCTION CEILING(A:FLOATS) RETURN FLOATS RENAMES MF_FLOATS.CEILING;

    FUNCTION FLOOR(A:FLOATS) RETURN FLOATS RENAMES MF_FLOATS.FLOOR;

    FUNCTION REMAINDER(LEFT,RIGHT:FLOATS) RETURN FLOATS RENAMES
        MF_FLOATS.REMAINDER;

    FUNCTION ROUND(A:FLOATS) RETURN FLOATS RENAMES MF_FLOATS.ROUND;

    FUNCTION SIGN(A:FLOATS) RETURN FLOATS RENAMES MF_FLOATS.SIGN;

    FUNCTION SIGNUM(A:FLOATS) RETURN FLOATS RENAMES
        MF_FLOATS.SIGNUM;

    FUNCTION TRUNCATE(A:FLOATS) RETURN FLOATS RENAMES
        MF_FLOATS.TRUNCATE;

    FUNCTION "REM"(LEFT,RIGHT:FLOATS) RETURN FLOATS RENAMES
        MF_FLOATS."REM";

    FUNCTION "MOD"(LEFT,RIGHT:FLOATS) RETURN FLOATS RENAMES
        MF_FLOATS."MOD";

-------- FLOATING POINT DOUBLE PRECISION FUNCTIONS --------------------

    FUNCTION MAX(LEFT,RIGHT:FLOATD) RETURN FLOATD
        RENAMES MF_FLOATD.MAX;

    FUNCTION MIN(LEFT,RIGHT:FLOATD) RETURN FLOATD
        RENAMES MF_FLOATD.MIN;

    FUNCTION CEILING(A:FLOATD) RETURN FLOATD RENAMES
        MF_FLOATD.CEILING;

    FUNCTION FLOOR(A:FLOATD) RETURN FLOATD RENAMES MF_FLOATD.FLOOR;

    FUNCTION REMAINDER(LEFT,RIGHT:FLOATD) RETURN FLOATD RENAMES
        MF_FLOATD.REMAINDER;

    FUNCTION ROUND(A:FLOATD) RETURN FLOATD RENAMES MF_FLOATD.ROUND;

    FUNCTION SIGN(A:FLOATD) RETURN FLOATD RENAMES MF_FLOATD.SIGN;

    FUNCTION SIGNUM(A:FLOATD) RETURN FLOATD RENAMES
        MF_FLOATD.SIGNUM;

    FUNCTION TRUNCATE(A:FLOATD) RETURN FLOATD RENAMES
        MF_FLOATD.TRUNCATE;

    FUNCTION "REM"(LEFT,RIGHT:FLOATD) RETURN FLOATD RENAMES
        MF_FLOATD."REM";

    FUNCTION "MOD"(LEFT,RIGHT:FLOATD) RETURN FLOATD RENAMES
        MF_FLOATD."MOD";

END MATH_FUNCTIONS_GENERIC;
--::::::::::
--arrayfg1.ada
--::::::::::
-- ARRAYFG1.ADA
----+----1----+----2----+----3----+----4----+----5----+----6----+----7--
-- Generic package of one dimensional array type functions.
--    This is the generic package for ARRAY1D functions with private
--    type components.  The index is a discrete type.  This package can
--    be instantiated for one dimensional scalar arrays of either
--    float or integer type.
----+----1----+----2----+----3----+----4----+----5----+----6----+----7--
----- DEFINITION OF FUNCTIONS
-- MAX(A) returns the maximum of all the elements of A
-- MIN(A) returns the minimum of all the elements of A
-- PROD(A) returns the product of all the elements of A
-- SUM(A) returns the sum of all the elements of A
----+----1----+----2----+----3----+----4----+----5----+----6----+----7--
-- LOG OF CHANGES

--   1.   86 06 24: CODING BEGUN BY DAVID KWONG.

----+----1----+----2----+----3----+----4----+----5----+----6----+----7--
    WITH TEXT_IO;
GENERIC

    TYPE COMTYP IS PRIVATE;
    TYPE INDEX IS (<>);
    TYPE ARRAY1D IS ARRAY( INDEX RANGE <>) OF COMTYP;
    WITH FUNCTION "+"(LEFT,RIGHT:COMTYP) RETURN COMTYP IS <>;
    WITH FUNCTION "*"(LEFT,RIGHT:COMTYP) RETURN COMTYP IS <>;
    WITH FUNCTION ">"(LEFT,RIGHT:COMTYP) RETURN BOOLEAN IS <>;

PACKAGE ARRAY_FUNCTIONS_GENERIC_1D IS

    FUNCTION MAX(A:ARRAY1D) RETURN COMTYP;
    FUNCTION MIN(A:ARRAY1D) RETURN COMTYP;
    FUNCTION PROD(A:ARRAY1D) RETURN COMTYP;
    FUNCTION SUM(A:ARRAY1D) RETURN COMTYP;

-- Exceptions

END ARRAY_FUNCTIONS_GENERIC_1D;  -- End specification of package

----+----1----+----2----+----3----+----4----+----5----+----6----+----7--

PACKAGE BODY ARRAY_FUNCTIONS_GENERIC_1D IS

    FUNCTION MAX(A:ARRAY1D) RETURN COMTYP IS

        B:COMTYP:=A(A'FIRST);

    BEGIN

        FOR I IN A'RANGE LOOP
            IF (A(I)>B) THEN
               B:=A(I);
            END IF;

        END LOOP;

        RETURN B;

    EXCEPTION

        WHEN OTHERS =>
            TEXT_IO.PUT("MAX(ARRAY1D) Unidentified error");
            RAISE;

    END MAX;

    FUNCTION MIN(A:ARRAY1D) RETURN COMTYP IS

        B:COMTYP:=A(A'LAST);

    BEGIN

        FOR I IN A'RANGE LOOP
            IF (B > A(I)) THEN
               B:=A(I);
            END IF;
        END LOOP;

        RETURN B;

    EXCEPTION

        WHEN OTHERS =>
            TEXT_IO.PUT("MIN(ARRAY1D) Unidentified error");
            RAISE;

    END MIN;

    FUNCTION PROD(A:ARRAY1D) RETURN COMTYP IS

        B:COMTYP:=A(A'FIRST);

    BEGIN

        FOR I IN INDEX'SUCC(A'FIRST)..A'LAST LOOP
            B:=A(I)*B;
        END LOOP;

        RETURN B;

    EXCEPTION

        WHEN OTHERS =>
            TEXT_IO.PUT("PROD(ARRAY1D) Unidentified error");
            RAISE;

    END PROD;

    FUNCTION SUM(A:ARRAY1D) RETURN COMTYP IS

        B:COMTYP:=A(A'FIRST);

    BEGIN

        FOR I IN INDEX'SUCC(A'FIRST).. A'LAST LOOP
            B:=A(I)+B;
        END LOOP;

        RETURN B;

    EXCEPTION

        WHEN OTHERS =>
            TEXT_IO.PUT("SUM(ARRAY1D) Unidentified error");
            RAISE;

    END SUM;
END ARRAY_FUNCTIONS_GENERIC_1D;
--::::::::::
--arrayfg2.ada
--::::::::::
-- ARRAYFG2.ADA
----+----1----+----2----+----3----+----4----+----5----+----6----+----7--
-- Generic package of two dimensional array type functions.
--    This is the generic package for ARRAY2D functions with private
--    type components.  The index is a discrete type.  This package can
--    be instantiated for two dimensional scalar arrays of either
--    float or integer type.
--
-- The functions are implemented by taking 1 dimensional slices
-- of the two dimensional arrays and using the 1 dimensional
-- functions on them
--
----+----1----+----2----+----3----+----4----+----5----+----6----+----7--
----- DEFINITION OF FUNCTIONS
-- MAX(A) returns the maximum of all the elements of A
-- MIN(A) returns the minimum of all the elements of A
-- PROD(A) returns the product of all the elements of A
-- SUM(A) returns the sum of all the elements of A
----+----1----+----2----+----3----+----4----+----5----+----6----+----7--
-- LOG OF CHANGES

--   1.   86 06 25: CODING BEGUN BY DAVID KWONG.

----+----1----+----2----+----3----+----4----+----5----+----6----+----7--
    WITH TEXT_IO;
    WITH ARRAY_FUNCTIONS_GENERIC_1D;
GENERIC

    TYPE COMTYP IS PRIVATE;
    TYPE INDEX IS (<>);
    TYPE ARRAY2D IS ARRAY( INDEX RANGE <>, INDEX RANGE <>) OF COMTYP;
    WITH FUNCTION "+"(LEFT,RIGHT:COMTYP) RETURN COMTYP IS <>;
    WITH FUNCTION "*"(LEFT,RIGHT:COMTYP) RETURN COMTYP IS <>;
    WITH FUNCTION ">"(LEFT,RIGHT:COMTYP) RETURN BOOLEAN IS <>;

PACKAGE ARRAY_FUNCTIONS_GENERIC_2D IS

    FUNCTION MAX(A:ARRAY2D) RETURN COMTYP;
    FUNCTION MIN(A:ARRAY2D) RETURN COMTYP;
    FUNCTION PROD(A:ARRAY2D) RETURN COMTYP;
    FUNCTION SUM(A:ARRAY2D) RETURN COMTYP;

-- Exceptions

END ARRAY_FUNCTIONS_GENERIC_2D;  -- End specification of package

----+----1----+----2----+----3----+----4----+----5----+----6----+----7--

PACKAGE BODY ARRAY_FUNCTIONS_GENERIC_2D IS
-- Instantiate package with one dimensional array functions

    TYPE ARRAY1D IS ARRAY(INDEX RANGE <>) OF COMTYP;
    PACKAGE AF_1D IS NEW ARRAY_FUNCTIONS_GENERIC_1D(COMTYP,INDEX
        ,ARRAY1D);

    FUNCTION MAX(A:ARRAY2D) RETURN COMTYP IS

        COLA1D: ARRAY1D(A'RANGE(2));
        SUMA1D: ARRAY1D(A'RANGE(1));

    BEGIN

        FOR I IN A'RANGE(1) LOOP
            FOR J IN A'RANGE(2) LOOP
               COLA1D(J) := A(I,J);
            END LOOP;
            SUMA1D(I) := AF_1D.MAX(COLA1D);
        END LOOP;

        RETURN AF_1D.MAX(SUMA1D);

    EXCEPTION

        WHEN OTHERS =>
            TEXT_IO.PUT("MAX(ARRAY2D) Unidentified error");
            RAISE;

    END MAX;

    FUNCTION MIN(A:ARRAY2D) RETURN COMTYP IS

        COLA1D: ARRAY1D(A'RANGE(2));
        SUMA1D: ARRAY1D(A'RANGE(1));

    BEGIN

        FOR I IN A'RANGE(1) LOOP
            FOR J IN A'RANGE(2) LOOP
               COLA1D(J) := A(I,J);
            END LOOP;
            SUMA1D(I) := AF_1D.MIN(COLA1D);
        END LOOP;

        RETURN AF_1D.MIN(SUMA1D);

    EXCEPTION

        WHEN OTHERS =>
            TEXT_IO.PUT("MIN(ARRAY2D) Unidentified error");
            RAISE;

    END MIN;

    FUNCTION PROD(A:ARRAY2D) RETURN COMTYP IS

        COLA1D: ARRAY1D(A'RANGE(2));
        SUMA1D: ARRAY1D(A'RANGE(1));

    BEGIN

        FOR I IN A'RANGE(1) LOOP
            FOR J IN A'RANGE(2) LOOP
               COLA1D(J) := A(I,J);
            END LOOP;
            SUMA1D(I) := AF_1D.PROD(COLA1D);
        END LOOP;

        RETURN AF_1D.PROD(SUMA1D);

     EXCEPTION

        WHEN OTHERS =>
            TEXT_IO.PUT("PROD(ARRAY2D) Unidentified error");
            RAISE;

    END PROD;

    FUNCTION SUM(A:ARRAY2D) RETURN COMTYP IS

        COLA1D: ARRAY1D(A'RANGE(2));
        SUMA1D: ARRAY1D(A'RANGE(1));

    BEGIN

        FOR I IN A'RANGE(1) LOOP
            FOR J IN A'RANGE(2) LOOP
               COLA1D(J) := A(I,J);
            END LOOP;
            SUMA1D(I) := AF_1D.SUM(COLA1D);
        END LOOP;

        RETURN AF_1D.SUM(SUMA1D);

    EXCEPTION

        WHEN OTHERS =>
            TEXT_IO.PUT("SUM(ARRAY2D) Unidentified error");
            RAISE;

    END SUM;
END ARRAY_FUNCTIONS_GENERIC_2D;
--::::::::::
--arrayfg.ada
--::::::::::
-- ARRAYFG.ADA
-- This package defines the ARRAY functions that
-- are included in HAL/S for the ADA language.
-- The functions provided are:
-- MAX,MIN,PROD,SUM
-- for 1 dimensional(ARRAY1D) and 2 dimensional arrays(ARRAY2D).
-- All functions are defined for double precision integer, and
-- single and double
-- precision floating point component types.
--
----+----1----+----2----+----3----+----4----+----5----+----6----+----7--
--LOG OF CHANGES

--    1.    86 06 25: CODING BEGUN BY DAVID KWONG.

----+----1----+----2----+----3----+----4----+----5----+----6----+----7--

    WITH ARRAY_FUNCTIONS_GENERIC_1D;
    WITH ARRAY_FUNCTIONS_GENERIC_2D;
GENERIC
-- Generic scalar types
    TYPE FLOATS IS DIGITS <>;
    TYPE FLOATD IS DIGITS <>;
    TYPE INTEGERD IS RANGE <>;
-- Generic ARRAY1D types
    TYPE ARRAY1DS IS ARRAY (INTEGERD RANGE <>) OF FLOATS;
    TYPE ARRAY1DD IS ARRAY (INTEGERD RANGE <>) OF FLOATD;
    TYPE ARRAY1DI IS ARRAY (INTEGERD RANGE <>) OF INTEGERD;
-- Generic ARRAY2D types
    TYPE ARRAY2DS IS ARRAY (INTEGERD RANGE <>,INTEGERD RANGE <>)
        OF FLOATS;
    TYPE ARRAY2DD IS ARRAY (INTEGERD RANGE <>,INTEGERD RANGE <>)
        OF FLOATD;
    TYPE ARRAY2DI IS ARRAY (INTEGERD RANGE <>,INTEGERD RANGE <>)
        OF INTEGERD;

PACKAGE ARRAY_FUNCTIONS_GENERIC IS

-- Instantiate the one dimensional array functions
    PACKAGE ARRAY1D_FLOATS IS NEW
            ARRAY_FUNCTIONS_GENERIC_1D(FLOATS,INTEGERD,ARRAY1DS);

    PACKAGE ARRAY1D_FLOATD IS NEW
            ARRAY_FUNCTIONS_GENERIC_1D(FLOATD,INTEGERD,ARRAY1DD);

    PACKAGE ARRAY1D_INTEGER IS NEW
            ARRAY_FUNCTIONS_GENERIC_1D(INTEGERD,INTEGERD,ARRAY1DI);

-- Instantiate the two dimensional array functions
    PACKAGE ARRAY2D_FLOATS IS NEW
            ARRAY_FUNCTIONS_GENERIC_2D(FLOATS,INTEGERD,ARRAY2DS);

    PACKAGE ARRAY2D_FLOATD IS NEW
            ARRAY_FUNCTIONS_GENERIC_2D(FLOATD,INTEGERD,ARRAY2DD);

    PACKAGE ARRAY2D_INTEGER IS NEW
            ARRAY_FUNCTIONS_GENERIC_2D(INTEGERD,INTEGERD,ARRAY2DI);

-- All functions must be renamed if they are to be visible
-- with a use clause when this package is instantiated
--
-- DEFINITION OF FUNCTIONS
--
-------- Floating point single precision functions  --------------------

-- ARRAY1D types

    FUNCTION MAX(A:ARRAY1DS) RETURN FLOATS RENAMES
        ARRAY1D_FLOATS.MAX;
    FUNCTION MIN(A:ARRAY1DS) RETURN FLOATS RENAMES
        ARRAY1D_FLOATS.MIN;
    FUNCTION PROD(A:ARRAY1DS) RETURN FLOATS RENAMES
        ARRAY1D_FLOATS.PROD;
    FUNCTION SUM(A:ARRAY1DS) RETURN FLOATS RENAMES
        ARRAY1D_FLOATS.SUM;

-- ARRAY2D types

    FUNCTION MAX(A:ARRAY2DS) RETURN FLOATS RENAMES
        ARRAY2D_FLOATS.MAX;
    FUNCTION MIN(A:ARRAY2DS) RETURN FLOATS RENAMES
        ARRAY2D_FLOATS.MIN;
    FUNCTION PROD(A:ARRAY2DS) RETURN FLOATS RENAMES
        ARRAY2D_FLOATS.PROD;
    FUNCTION SUM(A:ARRAY2DS) RETURN FLOATS RENAMES
        ARRAY2D_FLOATS.SUM;

-------- Floating point double  precision functions  -------------------

-- ARRAY1D types

    FUNCTION MAX(A:ARRAY1DD) RETURN FLOATD RENAMES
        ARRAY1D_FLOATD.MAX;
    FUNCTION MIN(A:ARRAY1DD) RETURN FLOATD RENAMES
        ARRAY1D_FLOATD.MIN;
    FUNCTION PROD(A:ARRAY1DD) RETURN FLOATD RENAMES
        ARRAY1D_FLOATD.PROD;
    FUNCTION SUM(A:ARRAY1DD) RETURN FLOATD RENAMES
        ARRAY1D_FLOATD.SUM;

-- ARRAY2D types

    FUNCTION MAX(A:ARRAY2DD) RETURN FLOATD RENAMES
        ARRAY2D_FLOATD.MAX;
    FUNCTION MIN(A:ARRAY2DD) RETURN FLOATD RENAMES
        ARRAY2D_FLOATD.MIN;
    FUNCTION PROD(A:ARRAY2DD) RETURN FLOATD RENAMES
        ARRAY2D_FLOATD.PROD;
    FUNCTION SUM(A:ARRAY2DD) RETURN FLOATD RENAMES
        ARRAY2D_FLOATD.SUM;

---------- Integer functions -------------------------------------------

-- ARRAY1D types

    FUNCTION MAX(A:ARRAY1DI) RETURN INTEGERD RENAMES
        ARRAY1D_INTEGER.MAX;
    FUNCTION MIN(A:ARRAY1DI) RETURN INTEGERD RENAMES
        ARRAY1D_INTEGER.MIN;
    FUNCTION PROD(A:ARRAY1DI) RETURN INTEGERD RENAMES
        ARRAY1D_INTEGER.PROD;
    FUNCTION SUM(A:ARRAY1DI) RETURN INTEGERD RENAMES
        ARRAY1D_INTEGER.SUM;

-- ARRAY2D types

    FUNCTION MAX(A:ARRAY2DI) RETURN INTEGERD RENAMES
        ARRAY2D_INTEGER.MAX;
    FUNCTION MIN(A:ARRAY2DI) RETURN INTEGERD RENAMES
        ARRAY2D_INTEGER.MIN;
    FUNCTION PROD(A:ARRAY2DI) RETURN INTEGERD RENAMES
        ARRAY2D_INTEGER.PROD;
    FUNCTION SUM(A:ARRAY2DI) RETURN INTEGERD RENAMES
        ARRAY2D_INTEGER.SUM;

END ARRAY_FUNCTIONS_GENERIC;
--::::::::::
--mathtest.ada
--::::::::::
--- MATHTEST.ADA
-- This is a test procedure to use the math functions
----+----1----+----2----+----3----+----4----+----5----+----6----+----7--
--LOG OF CHANGES

--   1.   86 04 29: CODING BEGUN BY DAVID KWONG.

----+----1----+----2----+----3----+----4----+----5----+----6----+----7--
    WITH MATH_FUNCTIONS_GENERIC;
    WITH TEXT_IO; USE TEXT_IO;
    WITH FLOAT_TEXT_IO;
    USE FLOAT_TEXT_IO;
    WITH INTEGER_TEXT_IO; USE INTEGER_TEXT_IO;


PROCEDURE MATHTEST IS

    TYPE INTEGERD IS NEW INTEGER;
    TYPE FLOATS IS NEW FLOAT;
    TYPE FLOATD IS NEW LONG_FLOAT;

    PACKAGE MATH_FUNCTIONS IS NEW
        MATH_FUNCTIONS_GENERIC(FLOATS,FLOATD,INTEGERD);
    USE MATH_FUNCTIONS;

    X,Y,Z,A,B,C,F,F2 :FLOATD;
    I,J,K,L,M,N :INTEGERD;

    FNAME: STRING(1..30);
    OUTFILE: FILE_TYPE;
    NCHAR: INTEGER;


BEGIN

-- Open up output file
    NEW_LINE;
    PUT("PLEASE ENTER NAME OF OUTPUT FILE: ");
    GET_LINE(FNAME,NCHAR);
    NEW_LINE;
    CREATE(FILE=>OUTFILE, MODE=> OUT_FILE, NAME=> FNAME(1..NCHAR));
    SET_OUTPUT(OUTFILE);


    PUT("          I        SIGN(I)    SIGNUM(I)");
    PUT(" FLOAT(5.0/F) REMAINDER(5.0/F) ");
    PUT("INTEGER(F/2.0)  ROUND(F/2.0)");
    PUT("     F/2.0     TRUNCATE(F/2.0)");
    NEW_LINE;

    FOR II IN 1..21 LOOP

        I := INTEGERD(II - 11);
        F := FLOATD(I);
        F2 :=F/2.0;
        Y := ROUND(F2);
        C := TRUNCATE(F2);
        PUT(INTEGER(I));PUT(" "); PUT(INTEGER(SIGN(I)));
        PUT(INTEGER(SIGNUM(INTEGERD(I))));PUT("      ");
        IF(I /= 0 ) THEN
            X := REMAINDER(INTEGERD(5),INTEGERD(I));
            PUT(FLOAT(5.0/F));PUT(" ");PUT(FLOAT(X));PUT(" ");
        ELSE
        -- Divide by zero.. answer undefined make = 0
            PUT(FLOAT(0.0)); PUT(" ");PUT(FLOAT(0.0));PUT(" ");
        END IF;

        PUT(INTEGER(F2));PUT("         ");PUT(FLOAT(Y));PUT("  ");
        PUT(FLOAT(F2));PUT(" ");PUT(FLOAT(C));
        NEW_LINE;

    END LOOP;

    NEW_LINE(2);

    PUT("       F              I          I REM 5    F REM 5 ");
    PUT("         I MOD 5       F MOD 5");
    PUT("  CEILING(F)   FLOOR(F)");
    NEW_LINE;
    F :=-10.5;
    FOR II IN 1..41 LOOP

        F := 0.5 + F;
        I := INTEGERD(F);
        J := I REM 5;
        Z := F REM 5.0;
        K := I MOD 5;
        A := F MOD 5.0;
        PUT(FLOAT(F));PUT(" ");PUT(INTEGER(I));PUT(" ");
        PUT(INTEGER(J));PUT("     "); PUT(FLOAT(Z));PUT(" ");
        PUT(INTEGER(K));PUT("     "); PUT(FLOAT(A));PUT(" ");
        PUT(FLOAT(CEILING(F)));PUT(" ");PUT(FLOAT(FLOOR(F)));
        NEW_LINE;

    END LOOP;

    NEW_LINE(2);
    PUT("      F               I         I REM -5  F REM -5.0 ");
    PUT("        I MOD -5   F MOD -5.0");
    NEW_LINE;
    F :=-10.5;
    FOR II IN 1..41 LOOP

        F := 0.5 + F;
        I := INTEGERD(F);
        J := I REM (-5);
        Z := F REM (-5.0);
        K := I MOD (-5);
        A := F MOD (-5.0);
        PUT(FLOAT(F));PUT(" ");PUT(INTEGER(I));PUT(" ");
        PUT(INTEGER(J));PUT("     "); PUT(FLOAT(Z));PUT(" ");
        PUT(INTEGER(K));PUT("     "); PUT(FLOAT(A));
        NEW_LINE;

    END LOOP;

    NEW_LINE;
    PUT("TEST MAX AND MIN OF 4.0 AND 5.23");
    NEW_LINE;
    X := MAX(4.0,5.23);
    PUT(FLOAT(X));
    Y := MIN(4.0,5.23);
    PUT(FLOAT(Y));

    CLOSE(OUTFILE);

END MATHTEST;
--::::::::::
--testaf.ada
--::::::::::
-- TESTAF.ADA
-- This procedure will test the 1 and 2 dimensional array functions
-- of the package ARRAY_FUNCTIONS_GENERIC
--
----+----1----+----2----+----3----+----4----+----5----+----6----+----7--
--LOG OF CHANGES

--    1.    86 06 25: CODING BEGUN BY DAVID KWONG.

----+----1----+----2----+----3----+----4----+----5----+----6----+----7--

WITH ARRAY_FUNCTIONS_GENERIC;
WITH TEXT_IO; USE TEXT_IO;
WITH FLOAT_TEXT_IO;
USE FLOAT_TEXT_IO;
WITH INTEGER_TEXT_IO;
USE INTEGER_TEXT_IO;

PROCEDURE TESTAF IS

    TYPE INTEGERD IS NEW INTEGER;
    TYPE FLOATS IS NEW FLOAT;
    TYPE FLOATD IS NEW LONG_FLOAT;
    TYPE VECTORS IS ARRAY(INTEGERD RANGE <>) OF FLOATS;
    TYPE VECTORD IS ARRAY(INTEGERD RANGE <>) OF FLOATD;
    TYPE VECTORI IS ARRAY(INTEGERD RANGE <>) OF INTEGERD;
    TYPE MATRIXS IS ARRAY(INTEGERD RANGE <>,INTEGERD RANGE <>)
        OF FLOATS;
    TYPE MATRIXD IS ARRAY(INTEGERD RANGE <>,INTEGERD RANGE <>)
        OF FLOATD;
    TYPE MATRIXI IS ARRAY(INTEGERD RANGE <>,INTEGERD RANGE <>)
        OF INTEGERD;

    PACKAGE ARRAYF IS NEW ARRAY_FUNCTIONS_GENERIC(FLOATS,
        FLOATD,INTEGERD,VECTORS,VECTORD,VECTORI,MATRIXS,
        MATRIXD,MATRIXI);
    USE ARRAYF;

    X:VECTORS(1..3):=(1.0,2.0,3.0);
    Y:VECTORD(1..3):=(5.0,6.0,7.0);
    ANSS:FLOATS;
    ANSD:FLOATD;
-- TWO DIMENSIONAL ARRAYS
    N:MATRIXS(1..3,1..3):=((1.0,2.0,3.0),(4.0,5.0,6.0),(7.0,8.0,9.0));
    M:MATRIXI(1..2,1..2):=((3,4),(5,6));

BEGIN

    PUT("CHECK SINGLE DIMENSION ARRAYS or VECTORS");
    NEW_LINE;
    PUT ("X:");
    FOR I IN X'RANGE LOOP
        PUT(FLOAT(X(I)));
    END LOOP;
    NEW_LINE;
    PUT ("Y:");
    FOR I IN Y'RANGE LOOP
        PUT(FLOAT(Y(I)));
    END LOOP;

    NEW_LINE(2);
    ANSS:=PROD(X);
    PUT("PROD(X),MAX(X)=");
    PUT(FLOAT(ANSS));
    ANSS:=MAX(X);
    PUT(FLOAT(ANSS));
    NEW_LINE;
    PUT("MIN(X),SUM(Y)=");
    ANSS:=MIN(X);
    PUT(FLOAT(ANSS));
    ANSD:=SUM(Y);
    PUT(FLOAT(ANSD));
    NEW_LINE(2);
    PUT("2 DIMENSIONAL ARRAY FUNCTIONS or MATRICES");
    NEW_LINE;
    PUT("M:");
    NEW_LINE;
    FOR I IN M'RANGE(1) LOOP
        FOR J IN M'RANGE(2) LOOP
            PUT(INTEGER(M(I,J)));
        END LOOP;
        NEW_LINE;
    END LOOP;
    NEW_LINE;
    PUT("M:");
    NEW_LINE;
    FOR I IN N'RANGE(1) LOOP
        FOR J IN N'RANGE(2) LOOP
            PUT(FLOAT(N(I,J)));
        END LOOP;
        NEW_LINE;
    END LOOP;
    NEW_LINE(2);

    PUT(" PROD(N),SUM(M)=");
    PUT(FLOAT(PROD(N)));
    PUT(INTEGER(SUM(M)));
    NEW_LINE;
    PUT(" MAX(M),MIN(N)=");
    PUT(INTEGER(MAX(M)));
    PUT(FLOAT(MIN(N)));

END TESTAF;