From 90c915c23bb7f80b7f3336a5051a27c0fd3f333f Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Mon, 3 Jul 2017 16:06:15 +1000 Subject: Fixed Rationals Rounding function --- src/rationals.adb | 87 +++++++++++++++++++++++++++++++++++++------------------ src/rationals.ads | 18 ++++++++++++ 2 files changed, 77 insertions(+), 28 deletions(-) (limited to 'src') diff --git a/src/rationals.adb b/src/rationals.adb index 80e070a..c50c479 100644 --- a/src/rationals.adb +++ b/src/rationals.adb @@ -109,6 +109,12 @@ package body Rationals is with Inline => True; pragma Import (C, mpz_clear, "__gmpz_clear"); + procedure mpz_set + (Rop : in out mpz_t; + Op : in mpz_t) + with Inline => True; + pragma Import (C, mpz_set, "__gmpz_set"); + function mpz_get_si (Op : in mpz_t) return Interfaces.C.long @@ -124,6 +130,16 @@ package body Rationals is + procedure mpz_add_ui + (Rop : in out mpz_t; + Op1 : in mpz_t; + Op2 : in Interfaces.C.unsigned_long) + with Inline => True; + pragma Import (C, mpz_add_ui, "__gmpz_add_ui"); + + + + procedure mpz_cdiv_q (Q : in out mpz_t; N, R : in mpz_t) @@ -179,6 +195,31 @@ package body Rationals is + procedure Initialize + (This : in out Bignum) is + begin + mpz_init (This.Data); + end Initialize; + + procedure Adjust + (This : in out Bignum) + is + Temp : mpz_t; + begin + mpz_init (Temp); + mpz_set (Temp, This.Data); + This.Data := Temp; + end Adjust; + + procedure Finalize + (This : in out Bignum) is + begin + mpz_clear (This.Data); + end Finalize; + + + + function "+" (Left, Right : in Fraction) return Fraction is @@ -533,14 +574,10 @@ package body Rationals is (Item : in Fraction) return Long_Integer is - Temp : mpz_t; - Result : Long_Integer; + Temp : Bignum; begin - mpz_init (Temp); - mpz_fdiv_q (Temp, Item.Data.mp_num, Item.Data.mp_den); - Result := Long_Integer (mpz_get_si (Temp)); - mpz_clear (Temp); - return Result; + mpz_fdiv_q (Temp.Data, Item.Data.mp_num, Item.Data.mp_den); + return Long_Integer (mpz_get_si (Temp.Data)); end Floor; @@ -548,14 +585,10 @@ package body Rationals is (Item : in Fraction) return Long_Integer is - Temp : mpz_t; - Result : Long_Integer; + Temp : Bignum; begin - mpz_init (Temp); - mpz_cdiv_q (Temp, Item.Data.mp_num, Item.Data.mp_den); - Result := Long_Integer (mpz_get_si (Temp)); - mpz_clear (Temp); - return Result; + mpz_cdiv_q (Temp.Data, Item.Data.mp_num, Item.Data.mp_den); + return Long_Integer (mpz_get_si (Temp.Data)); end Ceiling; @@ -563,22 +596,20 @@ package body Rationals is (Item : in Fraction) return Long_Integer is - Temp1, Temp2, Temp3 : mpz_t; - Result : Long_Integer; - begin - mpz_init (Temp1); mpz_init (Temp2); mpz_init (Temp3); - -- This method of calculating whether Num mod Den >= Den / 2 is messy - mpz_mod (Temp1, Item.Data.mp_num, Item.Data.mp_den); - mpz_set_si (Temp3, 2); - mpz_fdiv_q (Temp2, Item.Data.mp_den, Temp3); + Num_Mod_Den, Den_Div_2, Temp, Result : Bignum; + begin + -- Precalculate Num mod Den and Den / 2 + mpz_mod (Num_Mod_Den.Data, Item.Data.mp_num, Item.Data.mp_den); + mpz_set_si (Temp.Data, 2); + mpz_cdiv_q (Den_Div_2.Data, Item.Data.mp_den, Temp.Data); -- Here the actual Num / Den division takes place - mpz_fdiv_q (Temp3, Item.Data.mp_num, Item.Data.mp_den); - Result := Long_Integer (mpz_get_si (Temp3)); - if mpz_cmp (Temp1, Temp2) >= 0 then - Result := Result + 1; + mpz_fdiv_q (Temp.Data, Item.Data.mp_num, Item.Data.mp_den); + if mpz_cmp (Num_Mod_Den.Data, Den_Div_2.Data) >= 0 then + mpz_add_ui (Result.Data, Temp.Data, 1); + else + mpz_set (Result.Data, Temp.Data); end if; - mpz_clear (Temp1); mpz_clear (Temp2); mpz_clear (Temp3); - return Result; + return Long_Integer (mpz_get_si (Result.Data)); end Round; diff --git a/src/rationals.ads b/src/rationals.ads index f907633..fb7c5b5 100644 --- a/src/rationals.ads +++ b/src/rationals.ads @@ -244,6 +244,24 @@ private + -- Internal type for temporary data to make some Fraction + -- functions easier to show as correct + type Bignum is new Ada.Finalization.Controlled with record + Data : mpz_t; + end record; + + overriding procedure Initialize + (This : in out Bignum); + + overriding procedure Adjust + (This : in out Bignum); + + overriding procedure Finalize + (This : in out Bignum); + + + + pragma Linker_Options ("-lgmp"); -- cgit