path: root/src/rationals.adb

with Ada.Strings.Fixed;
with Multi_Precision_Integers.IO;
use Multi_Precision_Integers.IO;


--  This source is licensed under Creative Commons CC0 v1.0.
--
--  To read the full text, see license.txt in the main directory of this repository
--  or go to https://creativecommons.org/publicdomain/zero/1.0/legalcode.txt
--
--  For a human readable summary, go to https://creativecommons.org/publicdomain/zero/1.0/


package body Rationals is


    function Reduce
           (Numerator, Denominator : in Multi_Int)
        return Fraction
    is
        A, B, Temp : Multi_Int (M_Size);
        Ret_N, Ret_D : Multi_Int (M_Size);
    begin
        Fill (A, Numerator);
        Fill (B, Denominator);

        --  Euclid's algorithm
        loop
            Temp := A;
            A := B;
            Fill (B, Temp mod B);
            exit when Equal (B, 0);
        end loop;

        Fill (Ret_N, Numerator / A);
        Fill (Ret_D, Denominator / A);
        return (Num => Ret_N, Den => Ret_D);
    end Reduce;




    function "+"
           (Left, Right : in Fraction)
        return Fraction is
    begin
        return Reduce
               (Left.Num * Right.Den + Left.Den * Right.Num,
                Left.Den * Right.Den);
    end "+";

    function "+"
           (Left  : in Fraction;
            Right : in Integer)
        return Fraction is
    begin
        return Reduce
               (Left.Num + Left.Den * Multi (Right),
                Left.Den);
    end "+";

    function "+"
           (Left  : in Integer;
            Right : in Fraction)
        return Fraction is
    begin
        return Reduce
               (Multi (Left) * Right.Den + Right.Num,
                Right.Den);
    end "+";




    function "-"
           (Left, Right : in Fraction)
        return Fraction is
    begin
        return Reduce
               (Left.Num * Right.Den - Left.Den * Right.Num,
                Left.Den * Right.Den);
    end "-";

    function "-"
           (Left  : in Fraction;
            Right : in Integer)
        return Fraction is
    begin
        return Reduce
               (Left.Num - Left.Den * Multi (Right),
                Left.Den);
    end "-";

    function "-"
           (Left  : in Integer;
            Right : in Fraction)
        return Fraction is
    begin
        return Reduce
               (Multi (Left) * Right.Den - Right.Num,
                Right.Den);
    end "-";




    function "-"
           (Right : in Fraction)
        return Fraction is
    begin
        return (Num => - Right.Num, Den => Right.Den);
    end "-";




    function "*"
           (Left, Right : in Fraction)
        return Fraction is
    begin
        return Reduce
               (Left.Num * Right.Num,
                Left.Den * Right.Den);
    end "*";

    function "*"
           (Left  : in Fraction;
            Right : in Integer)
        return Fraction is
    begin
        return Reduce
               (Left.Num * Multi (Right),
                Left.Den);
    end "*";

    function "*"
           (Left  : in Integer;
            Right : in Fraction)
        return Fraction is
    begin
        return Reduce
               (Multi (Left) * Right.Num,
                Right.Den);
    end "*";




    function "/"
           (Left, Right : in Fraction)
        return Fraction is
    begin
        return Reduce
               (Left.Num * Right.Den,
                Left.Den * Right.Num);
    end "/";

    function "/"
           (Left  : in Fraction;
            Right : in Integer)
        return Fraction is
    begin
        return Reduce
               (Left.Num,
                Left.Den * Multi (Right));
    end "/";

    function "/"
           (Left  : in Integer;
            Right : in Fraction)
        return Fraction is
    begin
        return Reduce
               (Right.Num,
                Multi (Left) * Right.Den);
    end "/";

    function "/"
           (Left, Right : in Integer)
        return Fraction is
    begin
        return Reduce (Multi (Left), Multi (Right));
    end "/";




    function "="
           (Left, Right : in Fraction)
        return Boolean is
    begin
        return  Equal (Left.Num, Right.Num) and
                Equal (Left.Den, Right.Den);
    end "=";

    function "="
           (Left  : in Fraction;
            Right : in Integer)
        return Boolean is
    begin
        return Equal (Left.Num, Right) and Equal (Left.Den, 1);
    end "=";

    function "="
           (Left  : in Integer;
            Right : in Fraction)
        return Boolean is
    begin
        return Equal (Right.Num, Left) and Equal (Right.Den, 1);
    end "=";




    function "<="
           (Left, Right : in Fraction)
        return Boolean is
    begin
        return Left.Num * Right.Den <= Left.Den * Right.Num;
    end "<=";

    function "<="
           (Left  : in Fraction;
            Right : in Integer)
        return Boolean is
    begin
        return Left.Num <= Left.Den * Multi (Right);
    end "<=";

    function "<="
           (Left  : in Integer;
            Right : in Fraction)
        return Boolean is
    begin
        return Multi (Left) * Right.Den <= Right.Num;
    end "<=";




    function "<"
           (Left, Right : in Fraction)
        return Boolean is
    begin
        return Left.Num * Right.Den < Left.Den * Right.Num;
    end "<";

    function "<"
           (Left  : in Fraction;
            Right : in Integer)
        return Boolean is
    begin
        return Left.Num < Left.Den * Multi (Right);
    end "<";

    function "<"
           (Left  : in Integer;
            Right : in Fraction)
        return Boolean is
    begin
        return Multi (Left) * Right.Den < Right.Num;
    end "<";




    function ">="
           (Left, Right : in Fraction)
        return Boolean is
    begin
        return Left.Num * Right.Den >= Left.Den * Right.Num;
    end ">=";

    function ">="
           (Left  : in Fraction;
            Right : in Integer)
        return Boolean is
    begin
        return Left.Num >= Left.Den * Multi (Right);
    end ">=";

    function ">="
           (Left  : in Integer;
            Right : in Fraction)
        return Boolean is
    begin
        return Multi (Left) * Right.Den >= Right.Num;
    end ">=";




    function ">"
           (Left, Right : in Fraction)
        return Boolean is
    begin
        return Left.Num * Right.Den > Left.Den * Right.Num;
    end ">";

    function ">"
           (Left  : in Fraction;
            Right : in Integer)
        return Boolean is
    begin
        return Left.Num > Left.Den * Multi (Right);
    end ">";

    function ">"
           (Left  : in Integer;
            Right : in Fraction)
        return Boolean is
    begin
        return Multi (Left) * Right.Den > Right.Num;
    end ">";




    function Numerator
           (Item : in Fraction)
        return Integer is
    begin
        return Basic (Item.Num);
    end Numerator;

    function Denominator
           (Item : in Fraction)
        return Integer is
    begin
        return Basic (Item.Den);
    end Denominator;

    function Floor
           (Item : in Fraction)
        return Integer is
    begin
        return Basic (Item.Num / Item.Den);
    end Floor;

    function Ceiling
           (Item : in Fraction)
        return Integer is
    begin
        if Equal (Item.Num mod Item.Den, 0) then
            return Basic (Item.Num / Item.Den);
        else
            return 1 + Basic (Item.Num / Item.Den);
        end if;
    end Ceiling;

    function Round
           (Item : in Fraction)
        return Integer is
    begin
        if Item.Num mod Item.Den >= Item.Den / 2 then
            return 1 + Basic (Item.Num / Item.Den);
        else
            return Basic (Item.Num / Item.Den);
        end if;
    end Round;




    function Image
           (Item : in Fraction)
        return String is
    begin
        return Str (Item.Num) & '/' & Str (Item.Den);
    end Image;

    function Value
           (Item : in String)
        return Fraction
    is
        use Ada.Strings;
        use Ada.Strings.Fixed;
        A, B, S : Integer;
    begin
        S := Index (Item, "/");
        A := Integer'Value (Item (Item'First .. S - 1));
        B := Integer'Value (Item (S + 1 .. Item'Last));
        return Reduce (Multi (A), Multi (B));
    end Value;


end Rationals;