libgmpada4-dev 0.0.20131223-1 / usr / share / ada / adainclude / gmpada / gnu_multiple_precision-big_rationals.adb

--    GMPAda, binding to the Ada Language for the GNU MultiPrecision library.
--    Copyright (C) 2007-2013 Nicolas Boulenguez <nicolas.boulenguez@free.fr>
--
--    This program is free software: you can redistribute it and/or modify
--    it under the terms of the GNU General Public License as published by
--    the Free Software Foundation, either version 3 of the License, or
--    (at your option) any later version.
--
--    This program is distributed in the hope that it will be useful,
--    but WITHOUT ANY WARRANTY; without even the implied warranty of
--    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--    GNU General Public License for more details.
--
--    You should have received a copy of the GNU General Public License
--    along with this program.  If not, see <http://www.gnu.org/licenses/>.

with Ada.Characters.Conversions;
with Interfaces.C; use Interfaces.C;
with GMP.Binding; use GMP.Binding;
with GNU_Multiple_Precision.Aux;

package body GNU_Multiple_Precision.Big_Rationals is

   procedure Canonicalize (Op : in out Big_Rational)
   is
   begin
      Mpq_Canonicalize (Op.Value);
   end Canonicalize;

   procedure Set
     (Rop : in out Big_Rational;
      Op  : in     Big_Rational)
   is
   begin
      Mpq_Set (Rop.Value, Op.Value);
   end Set;

   function "+" (Right : Big_Rational) return Big_Rational
   is
   begin
      return Result : Big_Rational do
         Set (Result, Right);
      end return;
   end "+";

   procedure Swap (Rop1, Rop2 : in out Big_Rational)
   is
   begin
      Mpq_Swap (Rop1.Value, Rop2.Value);
   end Swap;

   function Image (Arg : Big_Rational) return String
   is
      Result : String
        (1 .. Integer (Mpz_Sizeinbase (Mpq_Numref (Arg.Value).all, 10)
         + Mpz_Sizeinbase (Mpq_Denref (Arg.Value).all, 10) + 2));
      Last   : Natural := Result'First - 1;
      procedure Put_Character (C : in Character);
      procedure Put_Character (C : in Character) is
      begin
         Last := Last + 1;
         Result (Last) := C;
      end Put_Character;
   begin
      if Mpq_Sgn (Arg.Value) >= 0 then
         Put_Character (' ');
      end if;
      GNU_Multiple_Precision.Aux.Put (Put_Character'Access, Arg.Value, 0, 10);
      return Result (Result'First .. Last);
   end Image;

   function Wide_Image (Arg : Big_Rational) return Wide_String
   is
   begin
      return Ada.Characters.Conversions.To_Wide_String (Image (Arg));
   end Wide_Image;

   function Wide_Wide_Image (Arg : Big_Rational) return Wide_Wide_String
   is
   begin
      return Ada.Characters.Conversions.To_Wide_Wide_String (Image (Arg));
   end Wide_Wide_Image;

   procedure Add
     (Sum              : in out Big_Rational;
      Addend1, Addend2 : in     Big_Rational)
   is
   begin
      Mpq_Add (Sum.Value, Addend1.Value, Addend2.Value);
   end Add;

   function "+" (Left, Right : Big_Rational) return Big_Rational
   is
   begin
      return Result : Big_Rational do
         Add (Result, Left, Right);
      end return;
   end "+";

   procedure Subtract
     (Difference          : in out Big_Rational;
      Minuend, Subtrahend : in     Big_Rational)
   is
   begin
      Mpq_Sub (Difference.Value, Minuend.Value, Subtrahend.Value);
   end Subtract;

   function "-" (Left, Right : Big_Rational) return Big_Rational
   is
   begin
      return Result : Big_Rational do
         Subtract (Result, Left, Right);
      end return;
   end "-";

   procedure Multiply
     (Product                  : in out Big_Rational;
      Multiplier, Multiplicand : in     Big_Rational)
   is
   begin
      Mpq_Mul (Product.Value, Multiplier.Value, Multiplicand.Value);
   end Multiply;

   function "*" (Left, Right : Big_Rational) return Big_Rational
   is
   begin
      return Result : Big_Rational do
         Multiply (Result, Left, Right);
      end return;
   end "*";

   procedure Multiply_2exp
     (Rop : in out Big_Rational;
      Op1 : in     Big_Rational;
      Op2 : in     Bit_Count)
   is
   begin
      Mpq_Mul_2exp (Rop.Value, Op1.Value, Op2);
   end Multiply_2exp;

   procedure Divide
     (Quotient          : in out Big_Rational;
      Dividend, Divisor : in     Big_Rational)
   is
   begin
      Mpq_Div (Quotient.Value, Dividend.Value, Divisor.Value);
   end Divide;

   function "/" (Left, Right : Big_Rational) return Big_Rational
   is
   begin
      return Result : Big_Rational do
         Divide (Result, Left, Right);
      end return;
   end "/";

   procedure Negate
     (Negated_Operand : in out Big_Rational;
      Operand         : in     Big_Rational)
   is
   begin
      Mpq_Neg (Negated_Operand.Value, Operand.Value);
   end Negate;

   function "-" (Right : Big_Rational) return Big_Rational
   is
   begin
      return Result : Big_Rational do
         Negate (Result, Right);
      end return;
   end "-";

   procedure Absolute_Value
     (Rop : in out Big_Rational;
      Op  : in     Big_Rational)
   is
   begin
      Mpq_Abs (Rop.Value, Op.Value);
   end Absolute_Value;

   function "abs" (Right : Big_Rational) return Big_Rational
   is
   begin
      return Result : Big_Rational do
         Absolute_Value (Result, Right);
      end return;
   end "abs";

   procedure Invert
     (Inverted_Number : in out Big_Rational;
      Number          : in     Big_Rational)
   is
   begin
      Mpq_Inv (Inverted_Number.Value, Number.Value);
   end Invert;

   procedure Exponentiate
     (Rop      : in out Big_Rational;
      Op       : in     Big_Rational;
      Exponent : in     Integer'Base)
   is
   begin
      Mpz_Pow_Ui (Mpq_Numref (Rop.Value).all, Mpq_Numref (Op.Value).all,
                  unsigned_long (abs Exponent));
      Mpz_Pow_Ui (Mpq_Denref (Rop.Value).all, Mpq_Denref (Op.Value).all,
                  unsigned_long (abs Exponent));
      if Exponent < 0 then
         Mpq_Inv (Rop.Value, Rop.Value);
      end if;
   end Exponentiate;

   function "**"  (Left  : Big_Rational;
                   Right : Integer'Base) return Big_Rational
   is
   begin
      return Result : Big_Rational do
         Exponentiate (Result, Left, Right);
      end return;
   end "**";

   function "<"  (Left, Right : Big_Rational) return Boolean
   is
   begin
      return Mpq_Cmp (Left.Value, Right.Value) < 0;
   end "<";

   function "<=" (Left, Right : Big_Rational) return Boolean
   is
   begin
      return Mpq_Cmp (Left.Value, Right.Value) <= 0;
   end "<=";

   function ">"  (Left, Right : Big_Rational) return Boolean
   is
   begin
      return Mpq_Cmp (Left.Value, Right.Value) > 0;
   end ">";

   function ">=" (Left, Right : Big_Rational) return Boolean
   is
   begin
      return Mpq_Cmp (Left.Value, Right.Value) >= 0;
   end ">=";

   function Sign (Item : Big_Rational) return A_Sign
   is
   begin
      return A_Sign (Mpq_Sgn (Item.Value));
   end Sign;

   package body Integer_Conversions is
      procedure Set
        (Rop          : in out Big_Rational;
         Numerator    : in     Num;
         Denominator  : in     Positive_Num;
         Canonicalize : in     Boolean      := True)
      is
      begin
         Mpq_Set_Si (Rop.Value, long (Numerator), unsigned_long (Denominator));
         if Canonicalize then
            Mpq_Canonicalize (Rop.Value);
         end if;
      end Set;

      function To_Big_Rational (Item : Num) return Big_Rational
      is
      begin
         return Result : Big_Rational do
            Mpq_Set_Si (Result.Value, long (Item), 1);
         end return;
      end To_Big_Rational;

      function Fits_In_Num (Item : Big_Rational) return Boolean
      is
      begin
         return Mpq_Cmp_Si (Item.Value, long (Num'First), 1) >= 0
           and Mpq_Cmp_Si (Item.Value, long (Num'Last), 1) <= 0;
      end Fits_In_Num;

      function To_Num (Item : Big_Rational) return Num
      is
      begin
         return Num (Mpq_Get_D (Item.Value));
      end To_Num;

      function "="  (Left : Big_Rational; Right : Num) return Boolean
      is
      begin
         return Mpq_Cmp_Si (Left.Value, long (Right), 1) = 0;
      end "=";
      function "="  (Left : Num; Right : Big_Rational) return Boolean
      is
      begin
         return Mpq_Cmp_Si (Right.Value, long (Left), 1) = 0;
      end "=";
      function "<"  (Left : Big_Rational; Right : Num) return Boolean
      is
      begin
         return Mpq_Cmp_Si (Left.Value, long (Right), 1) < 0;
      end "<";
      function "<"  (Left : Num; Right : Big_Rational) return Boolean
      is
      begin
         return Mpq_Cmp_Si (Right.Value, long (Left), 1) > 0;
      end "<";
      function "<="  (Left : Big_Rational; Right : Num) return Boolean
      is
      begin
         return Mpq_Cmp_Si (Left.Value, long (Right), 1) <= 0;
      end "<=";
      function "<="  (Left : Num; Right : Big_Rational) return Boolean
      is
      begin
         return Mpq_Cmp_Si (Right.Value, long (Left), 1) >= 0;
      end "<=";
      function ">"  (Left : Big_Rational; Right : Num) return Boolean
      is
      begin
         return Mpq_Cmp_Si (Left.Value, long (Right), 1) > 0;
      end ">";
      function ">"  (Left : Num; Right : Big_Rational) return Boolean
      is
      begin
         return Mpq_Cmp_Si (Right.Value, long (Left), 1) < 0;
      end ">";
      function ">="  (Left : Big_Rational; Right : Num) return Boolean
      is
      begin
         return Mpq_Cmp_Si (Left.Value, long (Right), 1) >= 0;
      end ">=";
      function ">="  (Left : Num; Right : Big_Rational) return Boolean
      is
      begin
         return Mpq_Cmp_Si (Right.Value, long (Left), 1) <= 0;
      end ">=";

      function Compare
        (Left              : Big_Rational;
         Right_Numerator   : Num;
         Right_Denominator : Positive_Num)
        return A_Comparison
      is
      begin
         return Mpq_Cmp_Si (Left.Value,
                            long (Right_Numerator),
                            unsigned_long (Right_Denominator));
      end Compare;
   end Integer_Conversions;

   package body Float_Conversions is
      procedure Set
        (Rop : in out Big_Rational;
         Op  : in     Num)
      is
      begin
         Mpq_Set_D (Rop.Value, double (Op));
      end Set;

      function To_Big_Rational (Item : Num) return Big_Rational
      is
      begin
         return Result : Big_Rational do
            Set (Result, Item);
         end return;
      end To_Big_Rational;

      function To_Num (Item : Big_Rational) return Num
      is
      begin
         return Num (Mpq_Get_D (Item.Value));
      end To_Num;
   end Float_Conversions;

   procedure Set (Rop : in out Big_Integer;
                  Op  : in     Big_Rational)
   is
   begin
      Mpz_Set_Q (Rop.Value, Op.Value);
   end Set;

   procedure Set (Rop : in out Big_Rational;
                  Op  : in     Big_Integer)
   is
   begin
      Mpq_Set_Z (Rop.Value, Op.Value);
   end Set;

   procedure Set_Numerator
     (Item         : in out Big_Rational;
      New_Value    : in     Big_Integer;
      Canonicalize : in     Boolean      := True)
   is
   begin
      Mpz_Set (Mpq_Numref (Item.Value).all, New_Value.Value);
      if Canonicalize then
         Mpq_Canonicalize (Item.Value);
      end if;
   end Set_Numerator;

   procedure Set_Denominator
     (Item         : in out Big_Rational;
      New_Value    : in     Big_Integer;
      Canonicalize : in     Boolean      := True)
   is
   begin
      Mpz_Set (Mpq_Denref (Item.Value).all, New_Value.Value);
      if Canonicalize then
         Mpq_Canonicalize (Item.Value);
      end if;
   end Set_Denominator;

   function To_Big_Integer (Item : Big_Rational) return Big_Integer
   is
   begin
      return Result : Big_Integer do
         Set (Result, Item);
      end return;
   end To_Big_Integer;

   function To_Big_Rational (Item : Big_Integer) return Big_Rational
   is
   begin
      return Result : Big_Rational do
         Set (Result, Item);
      end return;
   end To_Big_Rational;

   procedure Get_Numerator
     (Value : in out Big_Integer;
      Item  : in     Big_Rational)
   is
   begin
      Mpz_Set (Value.Value, Mpq_Numref (Item.Value).all);
   end Get_Numerator;

   function Numerator (Item : Big_Rational) return Big_Integer
   is
   begin
      return Result : Big_Integer do
         Get_Numerator (Result, Item);
      end return;
   end Numerator;

   procedure Get_Denominator
     (Value : in out Big_Integer;
      Item  : in     Big_Rational)
   is
   begin
      Mpz_Set (Value.Value, Mpq_Denref (Item.Value).all);
   end Get_Denominator;
   function Denominator (Item : Big_Rational) return Big_Integer
   is
   begin
      return Result : Big_Integer do
         Get_Denominator (Result, Item);
      end return;
   end Denominator;

   procedure Set (Rop : in out Big_Rational;
                  Op  : in     Big_Float)
   is
   begin
      Mpq_Set_F (Rop.Value, Op.Value);
   end Set;

   procedure Set (Rop : in out Big_Float;
                  Op  : in     Big_Rational)
   is
   begin
      Mpf_Set_Q (Rop.Value, Op.Value);
   end Set;

end GNU_Multiple_Precision.Big_Rationals;