DataMuseum.dk

top - metrics - download

    Length: 4908 (0x132c)
    Types: TextFile
    Names: »B«

└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
    └─⟦5cb1d1d7f⟧ »DATA« 
        └─⟦3b1ee7bd8⟧ 
            └─⟦this⟧ 

TextFile

with Universal_Integer_Arithmetic;
use Universal_Integer_Arithmetic;
pragma Elaborate (Universal_Integer_Arithmetic);
package body Universal_Real_Arithmetic is

    I_Zero : constant Universal_Integer := Ui (0);
    I_One : constant Universal_Integer := Ui (1);
    I_Two : constant Universal_Integer := Ui (2);
    I_Ten : constant Universal_Integer := Ui (10);

    R_Zero : constant Universal_Real := (I_Zero, I_One);
    R_One : constant Universal_Real := (I_One, I_One);


    function Ur (N, D : Universal_Integer) return Universal_Real is

        -- Constructs a universal real as the ratio of two universal integers.
        -- The value of d must not be ZERO; if it is, NUMERIC_ERROR is raised.

        -- Every real number produced as a result of an operation defined in
        -- this package must have a positive denominator and the numerator and
        -- denominator must be reduced to lowest terms.  This ensures uniqueness
        -- of the representation.

        R : Universal_Integer;
        Y : Universal_Integer;
        Z : Universal_Integer;

    begin
        if Eql (D, I_Zero) then
            raise Numeric_Error;
        elsif Eql (N, I_Zero) then
            return R_Zero;
        end if;

        -- Now reduce to lowest terms; that is, find the gcd of n and d.

        Y := abs N;
        Z := abs D;

        loop
            R := Y rem Z;
            exit when Eql (R, I_Zero);
            Y := Z;
            Z := R;
        end loop;

        if D >= I_Zero then
            return (N / Z, D / Z);
        else
            return (-N / Z, -D / Z);
        end if;

    end Ur;


    function Ui (X : Universal_Real) return Universal_Integer is

        I : Universal_Integer := X.Num / X.Den;
        R : Universal_Real := (I, I_One);
        H : Universal_Real := (I_Two, I_One);

    begin
        if Eql (X.Num, I_Zero) then
            return I_Zero;
        elsif X.Num < I_Zero and then X - R <= -H then
            return I - I_One;
        elsif X.Num > I_Zero and then X - R >= H then
            return I + I_One;
        else
            return I;
        end if;
    end Ui;


    function Ur (X : Universal_Integer) return Universal_Real is
    begin
        return (X, I_One);
    end Ur;


    function Numerator (X : Universal_Real) return Universal_Integer is
    begin
        return X.Num;
    end Numerator;

    function Denominator (X : Universal_Real) return Universal_Integer is
    begin
        return X.Den;
    end Denominator;


    function "-" (X : Universal_Real) return Universal_Real is
    begin
        return (-X.Num, X.Den);
    end "-";


    function "abs" (X : Universal_Real) return Universal_Real is
    begin
        return (abs X.Num, X.Den);
    end "abs";

    function "*" (X : Universal_Integer; Y : Universal_Real)
                 return Universal_Real is
    begin
        return Ur (Y.Num * X, Y.Den);
    end "*";


    function "*" (X : Universal_Real; Y : Universal_Integer)
                 return Universal_Real is
    begin
        return Ur (X.Num * Y, X.Den);
    end "*";


    function "/" (X : Universal_Real; Y : Universal_Integer)
                 return Universal_Real is
    begin
        return Ur (X.Num, X.Den * Y);
    end "/";


    function "+" (X, Y : Universal_Real) return Universal_Real is
    begin
        return Ur (X.Num * Y.Den + Y.Num * X.Den, X.Den * Y.Den);
    end "+";


    function "-" (X, Y : Universal_Real) return Universal_Real is
    begin
        return X + (-Y);
    end "-";


    function "*" (X, Y : Universal_Real) return Universal_Real is
    begin
        return Ur (X.Num * Y.Num, X.Den * Y.Den);
    end "*";


    function "/" (X, Y : Universal_Real) return Universal_Real is
    begin
        return Ur (X.Num * Y.Den, X.Den * Y.Num);
    end "/";

    function "**" (X : Universal_Real; Y : Integer) return Universal_Real is
    begin
        if Y = 0 then
            return R_One;
        elsif Y > 0 then
            return Ur (X.Num ** Y, X.Den ** Y);
        else
            return Ur (X.Den ** (-Y), X.Num ** (-Y));
        end if;
    end "**";


    function ">=" (X, Y : Universal_Real) return Boolean is
        Z : Universal_Real := X - Y;
    begin
        return Z.Num >= I_Zero;
    end ">=";


    function "<=" (X, Y : Universal_Real) return Boolean is
        Z : Universal_Real := X - Y;
    begin
        return Z.Num <= I_Zero;
    end "<=";


    function "<" (X, Y : Universal_Real) return Boolean is
        Z : Universal_Real := X - Y;
    begin
        return Z.Num < I_Zero;
    end "<";


    function ">" (X, Y : Universal_Real) return Boolean is
        Z : Universal_Real := X - Y;
    begin
        return Z.Num > I_Zero;
    end ">";


    function Eql (X, Y : Universal_Real) return Boolean is
        Z : Universal_Real := X - Y;
    begin
        return Eql (Z.Num, I_Zero);
    end Eql;

end Universal_Real_Arithmetic;