summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJed Barber <jjbarber@y7mail.com>2017-07-03 16:06:15 +1000
committerJed Barber <jjbarber@y7mail.com>2017-07-03 16:06:15 +1000
commit90c915c23bb7f80b7f3336a5051a27c0fd3f333f (patch)
tree2209ae0cea9d26fba7863e05fb8e3ac0ac654b02
parent45c752c00a8befa4041b4dcd8243b0563779c573 (diff)
Fixed Rationals Rounding function
-rw-r--r--src/rationals.adb87
-rw-r--r--src/rationals.ads18
2 files changed, 77 insertions, 28 deletions
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");