⚠️ Warning: This is a draft ⚠️
This means it might contain formatting issues, incorrect code, conceptual problems, or other severe issues.
If you want to help to improve and eventually enable this page, please fork RosettaGit's repository and open a merge request on GitHub.
generic
type Number is range <>;
package Generic_Rational is
type Rational is private;
function "abs" (A : Rational) return Rational;
function "+" (A : Rational) return Rational;
function "-" (A : Rational) return Rational;
function Inverse (A : Rational) return Rational;
function "+" (A : Rational; B : Rational) return Rational;
function "+" (A : Rational; B : Number ) return Rational;
function "+" (A : Number; B : Rational) return Rational;
function "-" (A : Rational; B : Rational) return Rational;
function "-" (A : Rational; B : Number ) return Rational;
function "-" (A : Number; B : Rational) return Rational;
function "*" (A : Rational; B : Rational) return Rational;
function "*" (A : Rational; B : Number ) return Rational;
function "*" (A : Number; B : Rational) return Rational;
function "/" (A : Rational; B : Rational) return Rational;
function "/" (A : Rational; B : Number ) return Rational;
function "/" (A : Number; B : Rational) return Rational;
function "/" (A : Number; B : Number) return Rational;
function ">" (A : Rational; B : Rational) return Boolean;
function ">" (A : Number; B : Rational) return Boolean;
function ">" (A : Rational; B : Number) return Boolean;
function "<" (A : Rational; B : Rational) return Boolean;
function "<" (A : Number; B : Rational) return Boolean;
function "<" (A : Rational; B : Number) return Boolean;
function ">=" (A : Rational; B : Rational) return Boolean;
function ">=" (A : Number; B : Rational) return Boolean;
function ">=" (A : Rational; B : Number) return Boolean;
function "<=" (A : Rational; B : Rational) return Boolean;
function "<=" (A : Number; B : Rational) return Boolean;
function "<=" (A : Rational; B : Number) return Boolean;
function "=" (A : Number; B : Rational) return Boolean;
function "=" (A : Rational; B : Number) return Boolean;
function Numerator (A : Rational) return Number;
function Denominator (A : Rational) return Number;
Zero : constant Rational;
One : constant Rational;
private
type Rational is record
Numerator : Number;
Denominator : Number;
end record;
Zero : constant Rational := (0, 1);
One : constant Rational := (1, 1);
end Generic_Rational;
The package can be instantiated with any integer type. It provides rational numbers represented by a numerator and denominator cleaned from the common divisors. Mixed arithmetic of the base integer type and the rational type is supported. Division to zero raises Constraint_Error. The implementation of the specification above is as follows:
package body Generic_Rational is
function GCD (A, B : Number) return Number is
begin
if A = 0 then
return B;
end if;
if B = 0 then
return A;
end if;
if A > B then
return GCD (B, A mod B);
else
return GCD (A, B mod A);
end if;
end GCD;
function Inverse (A : Rational) return Rational is
begin
if A.Numerator > 0 then
return (A.Denominator, A.Numerator);
elsif A.Numerator < 0 then
return (-A.Denominator, -A.Numerator);
else
raise Constraint_Error;
end if;
end Inverse;
function "abs" (A : Rational) return Rational is
begin
return (abs A.Numerator, A.Denominator);
end "abs";
function "+" (A : Rational) return Rational is
begin
return A;
end "+";
function "-" (A : Rational) return Rational is
begin
return (-A.Numerator, A.Denominator);
end "-";
function "+" (A : Rational; B : Rational) return Rational is
Common : constant Number := GCD (A.Denominator, B.Denominator);
A_Denominator : constant Number := A.Denominator / Common;
B_Denominator : constant Number := B.Denominator / Common;
begin
return (A.Numerator * B_Denominator + B.Numerator * A_Denominator) /
(A_Denominator * B.Denominator);
end "+";
function "+" (A : Rational; B : Number) return Rational is
begin
return (A.Numerator + B * A.Denominator) / A.Denominator;
end "+";
function "+" (A : Number; B : Rational) return Rational is
begin
return B + A;
end "+";
function "-" (A : Rational; B : Rational) return Rational is
begin
return A + (-B);
end "-";
function "-" (A : Rational; B : Number) return Rational is
begin
return A + (-B);
end "-";
function "-" (A : Number; B : Rational) return Rational is
begin
return A + (-B);
end "-";
function "*" (A : Rational; B : Rational) return Rational is
begin
return (A.Numerator * B.Numerator) / (A.Denominator * B.Denominator);
end "*";
function "*" (A : Rational; B : Number) return Rational is
Common : constant Number := GCD (A.Denominator, abs B);
begin
return (A.Numerator * B / Common, A.Denominator / Common);
end "*";
function "*" (A : Number; B : Rational) return Rational is
begin
return B * A;
end "*";
function "/" (A : Rational; B : Rational) return Rational is
begin
return A * Inverse (B);
end "/";
function "/" (A : Rational; B : Number) return Rational is
Common : constant Number := GCD (abs A.Numerator, abs B);
begin
if B > 0 then
return (A.Numerator / Common, A.Denominator * (B / Common));
else
return ((-A.Numerator) / Common, A.Denominator * ((-B) / Common));
end if;
end "/";
function "/" (A : Number; B : Rational) return Rational is
begin
return Inverse (B) * A;
end "/";
function "/" (A : Number; B : Number) return Rational is
Common : constant Number := GCD (abs A, abs B);
begin
if B = 0 then
raise Constraint_Error;
elsif A = 0 then
return (0, 1);
elsif A > 0 xor B > 0 then
return (-(abs A / Common), abs B / Common);
else
return (abs A / Common, abs B / Common);
end if;
end "/";
function ">" (A, B : Rational) return Boolean is
Diff : constant Rational := A - B;
begin
return Diff.Numerator > 0;
end ">";
function ">" (A : Number; B : Rational) return Boolean is
Diff : constant Rational := A - B;
begin
return Diff.Numerator > 0;
end ">";
function ">" (A : Rational; B : Number) return Boolean is
Diff : constant Rational := A - B;
begin
return Diff.Numerator > 0;
end ">";
function "<" (A, B : Rational) return Boolean is
Diff : constant Rational := A - B;
begin
return Diff.Numerator < 0;
end "<";
function "<" (A : Number; B : Rational) return Boolean is
Diff : constant Rational := A - B;
begin
return Diff.Numerator < 0;
end "<";
function "<" (A : Rational; B : Number) return Boolean is
Diff : constant Rational := A - B;
begin
return Diff.Numerator < 0;
end "<";
function ">=" (A, B : Rational) return Boolean is
Diff : constant Rational := A - B;
begin
return Diff.Numerator >= 0;
end ">=";
function ">=" (A : Number; B : Rational) return Boolean is
Diff : constant Rational := A - B;
begin
return Diff.Numerator >= 0;
end ">=";
function ">=" (A : Rational; B : Number) return Boolean is
Diff : constant Rational := A - B;
begin
return Diff.Numerator >= 0;
end ">=";
function "<=" (A, B : Rational) return Boolean is
Diff : constant Rational := A - B;
begin
return Diff.Numerator <= 0;
end "<=";
function "<=" (A : Number; B : Rational) return Boolean is
Diff : constant Rational := A - B;
begin
return Diff.Numerator <= 0;
end "<=";
function "<=" (A : Rational; B : Number) return Boolean is
Diff : constant Rational := A - B;
begin
return Diff.Numerator <= 0;
end "<=";
function "=" (A : Number; B : Rational) return Boolean is
Diff : constant Rational := A - B;
begin
return Diff.Numerator = 0;
end "=";
function "=" (A : Rational; B : Number) return Boolean is
Diff : constant Rational := A - B;
begin
return Diff.Numerator = 0;
end "=";
function Numerator (A : Rational) return Number is
begin
return A.Numerator;
end Numerator;
function Denominator (A : Rational) return Number is
begin
return A.Denominator;
end Denominator;
end Generic_Rational;
The implementation uses solution of the [[greatest common divisor]] task. Here is the implementation of the test:
with Ada.Numerics.Elementary_Functions; use Ada.Numerics.Elementary_Functions;
with Ada.Text_IO; use Ada.Text_IO;
with Generic_Rational;
procedure Test_Rational is
package Integer_Rational is new Generic_Rational (Integer);
use Integer_Rational;
begin
for Candidate in 2..2**15 loop
declare
Sum : Rational := 1 / Candidate;
begin
for Divisor in 2..Integer (Sqrt (Float (Candidate))) loop
if Candidate mod Divisor = 0 then -- Factor is a divisor of Candidate
Sum := Sum + One / Divisor + Rational'(Divisor / Candidate);
end if;
end loop;
if Sum = 1 then
Put_Line (Integer'Image (Candidate) & " is perfect");
end if;
end;
end loop;
end Test_Rational;
The perfect numbers are searched by summing of the reciprocal of each of the divisors of a candidate except 1. This sum must be 1 for a perfect number. {{out}}
6 is perfect
28 is perfect
496 is perfect
8128 is perfect