aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data update

Browse source
This commit is contained in:
Ingy döt Net 2026-02-01 16:33:20 -08:00
parent 5150844a7d
commit 4bb20c9b71
7735 changed files with 38060 additions and 199180 deletions
Download patch file Download diff file Expand all files Collapse all files

47
Task/Balanced-ternary/Ada/balanced-ternary-1.ada
View file

@ -1,47 +0,0 @@
with Ada.Finalization;
package BT is
type Balanced_Ternary is private;
-- conversions
function To_Balanced_Ternary (Num : Integer) return Balanced_Ternary;
function To_Balanced_Ternary (Str : String) return Balanced_Ternary;
function To_Integer (Num : Balanced_Ternary) return Integer;
function To_string (Num : Balanced_Ternary) return String;
-- Arithmetics
-- unary minus
function "-" (Left : in Balanced_Ternary)
return Balanced_Ternary;
-- subtraction
function "-" (Left, Right : in Balanced_Ternary)
return Balanced_Ternary;
-- addition
function "+" (Left, Right : in Balanced_Ternary)
return Balanced_Ternary;
-- multiplication
function "*" (Left, Right : in Balanced_Ternary)
return Balanced_Ternary;
private
-- a balanced ternary number is a unconstrained array of (1,0,-1)
-- dinamically allocated, least significant trit leftmost
type Trit is range -1..1;
type Trit_Array is array (Positive range <>) of Trit;
pragma Pack(Trit_Array);
type Trit_Access is access Trit_Array;
type Balanced_Ternary is new Ada.Finalization.Controlled
with record
Ref : Trit_access;
end record;
procedure Initialize (Object : in out Balanced_Ternary);
procedure Adjust (Object : in out Balanced_Ternary);
procedure Finalize (Object : in out Balanced_Ternary);
end BT;

181
Task/Balanced-ternary/Ada/balanced-ternary-2.ada
View file

@ -1,181 +0,0 @@
with Ada.Unchecked_Deallocation;
package body BT is
procedure Free is new Ada.Unchecked_Deallocation (Trit_Array, Trit_Access);
-- Conversions
-- String to BT
function To_Balanced_Ternary (Str: String) return Balanced_Ternary is
J : Positive := 1;
Tmp : Trit_Access;
begin
Tmp := new Trit_Array (1..Str'Last);
for I in reverse Str'Range loop
case Str(I) is
when '+' => Tmp (J) := 1;
when '-' => Tmp (J) := -1;
when '0' => Tmp (J) := 0;
when others => raise Constraint_Error;
end case;
J := J + 1;
end loop;
return (Ada.Finalization.Controlled with Ref => Tmp);
end To_Balanced_Ternary;
-- Integer to BT
function To_Balanced_Ternary (Num: Integer) return Balanced_Ternary is
K : Integer := 0;
D : Integer;
Value : Integer := Num;
Tmp : Trit_Array(1..19); -- 19 trits is enough to contain
-- a 32 bits signed integer
begin
loop
D := (Value mod 3**(K+1))/3**K;
if D = 2 then D := -1; end if;
Value := Value - D*3**K;
K := K + 1;
Tmp(K) := Trit(D);
exit when Value = 0;
end loop;
return (Ada.Finalization.Controlled
with Ref => new Trit_Array'(Tmp(1..K)));
end To_Balanced_Ternary;
-- BT to Integer --
-- If the BT number is too large Ada will raise CONSTRAINT ERROR
function To_Integer (Num : Balanced_Ternary) return Integer is
Value : Integer := 0;
Pos : Integer := 1;
begin
for I in Num.Ref.all'Range loop
Value := Value + Integer(Num.Ref(I)) * Pos;
Pos := Pos * 3;
end loop;
return Value;
end To_Integer;
-- BT to String --
function To_String (Num : Balanced_Ternary) return String is
I : constant Integer := Num.Ref.all'Last;
Result : String (1..I);
begin
for J in Result'Range loop
case Num.Ref(I-J+1) is
when 0 => Result(J) := '0';
when -1 => Result(J) := '-';
when 1 => Result(J) := '+';
end case;
end loop;
return Result;
end To_String;
-- unary minus --
function "-" (Left : in Balanced_Ternary)
return Balanced_Ternary is
Result : constant Balanced_Ternary := Left;
begin
for I in Result.Ref.all'Range loop
Result.Ref(I) := - Result.Ref(I);
end loop;
return Result;
end "-";
-- addition --
Carry : Trit;
function Add (Left, Right : in Trit)
return Trit is
begin
if Left /= Right then
Carry := 0;
return Left + Right;
else
Carry := Left;
return -Right;
end if;
end Add;
pragma Inline (Add);
function "+" (Left, Right : in Trit_Array)
return Balanced_Ternary is
Max_Size : constant Integer :=
Integer'Max(Left'Last, Right'Last);
Tmp_Left, Tmp_Right : Trit_Array(1..Max_Size) := (others => 0);
Result : Trit_Array(1..Max_Size+1) := (others => 0);
begin
Tmp_Left (1..Left'Last) := Left;
Tmp_Right(1..Right'Last) := Right;
for I in Tmp_Left'Range loop
Result(I) := Add (Result(I), Tmp_Left(I));
Result(I+1) := Carry;
Result(I) := Add(Result(I), Tmp_Right(I));
Result(I+1) := Add(Result(I+1), Carry);
end loop;
-- remove trailing zeros
for I in reverse Result'Range loop
if Result(I) /= 0 then
return (Ada.Finalization.Controlled
with Ref => new Trit_Array'(Result(1..I)));
end if;
end loop;
return (Ada.Finalization.Controlled
with Ref => new Trit_Array'(1 => 0));
end "+";
function "+" (Left, Right : in Balanced_Ternary)
return Balanced_Ternary is
begin
return Left.Ref.all + Right.Ref.all;
end "+";
-- Subtraction
function "-" (Left, Right : in Balanced_Ternary)
return Balanced_Ternary is
begin
return Left + (-Right);
end "-";
-- multiplication
function "*" (Left, Right : in Balanced_Ternary)
return Balanced_Ternary is
A, B : Trit_Access;
Result : Balanced_Ternary;
begin
if Left.Ref.all'Length > Right.Ref.all'Length then
A := Right.Ref; B := Left.Ref;
else
B := Right.Ref; A := Left.Ref;
end if;
for I in A.all'Range loop
if A(I) /= 0 then
declare
Tmp_Result : Trit_Array (1..I+B.all'Length-1) := (others => 0);
begin
for J in B.all'Range loop
Tmp_Result(I+J-1) := B(J) * A(I);
end loop;
Result := Result.Ref.all + Tmp_Result;
end;
end if;
end loop;
return Result;
end "*";
procedure Adjust (Object : in out Balanced_Ternary) is
begin
Object.Ref := new Trit_Array'(Object.Ref.all);
end Adjust;
procedure Finalize (Object : in out Balanced_Ternary) is
begin
Free (Object.Ref);
end Finalize;
procedure Initialize (Object : in out Balanced_Ternary) is
begin
Object.Ref := new Trit_Array'(1 => 0);
end Initialize;
end BT;

19
Task/Balanced-ternary/Ada/balanced-ternary-3.ada
View file

@ -1,19 +0,0 @@
with Ada.Text_Io; use Ada.Text_Io;
with Ada.Integer_Text_Io; use Ada.Integer_Text_Io;
with BT; use BT;
procedure TestBT is
Result, A, B, C : Balanced_Ternary;
begin
A := To_Balanced_Ternary("+-0++0+");
B := To_Balanced_Ternary(-436);
C := To_Balanced_Ternary("+-++-");
Result := A * (B - C);
Put("a = "); Put(To_integer(A), 4); New_Line;
Put("b = "); Put(To_integer(B), 4); New_Line;
Put("c = "); Put(To_integer(C), 4); New_Line;
Put("a * (b - c) = "); Put(To_integer(Result), 4);
Put_Line (" " & To_String(Result));
end TestBT;