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

13
Task/Ordered-partitions/Ada/ordered-partitions-1.ada
View file

@ -1,13 +0,0 @@
with Ada.Containers.Indefinite_Ordered_Sets;
with Ada.Containers.Ordered_Sets;
package Partitions is
-- Argument type for Create_Partitions: Array of Numbers
type Arguments is array (Positive range <>) of Natural;
package Number_Sets is new Ada.Containers.Ordered_Sets
(Natural);
type Partition is array (Positive range <>) of Number_Sets.Set;
function "<" (Left, Right : Partition) return Boolean;
package Partition_Sets is new Ada.Containers.Indefinite_Ordered_Sets
(Partition);
function Create_Partitions (Args : Arguments) return Partition_Sets.Set;
end Partitions;

148
Task/Ordered-partitions/Ada/ordered-partitions-2.ada
View file

@ -1,148 +0,0 @@
package body Partitions is
-- compare number sets (not provided)
function "<" (Left, Right : Number_Sets.Set) return Boolean is
use type Ada.Containers.Count_Type;
use Number_Sets;
Left_Pos : Cursor := Left.First;
Right_Pos : Cursor := Right.First;
begin
-- compare each element, until one or both lists finishes
while Left_Pos /= No_Element and then Right_Pos /= No_Element loop
-- compare elements
if Element (Left_Pos) < Element (Right_Pos) then
return True;
elsif Element (Left_Pos) > Element (Right_Pos) then
return False;
end if;
-- increase iterator
Next (Left_Pos);
Next (Right_Pos);
end loop;
-- Right is longer
if Right_Pos /= No_Element then
return True;
else
-- Left is longer, or Left and Right are identical.
return False;
end if;
end "<";
-- compare two Partitions
function "<" (Left, Right : Partition) return Boolean is
use type Ada.Containers.Count_Type;
use type Number_Sets.Set;
begin
-- check length
if Left'Length < Right'Length then
return True;
elsif Left'Length > Right'Length then
return False;
end if;
-- same length
if Left'Length > 0 then
for I in Left'Range loop
if Left (I) < Right (I) then
return True;
elsif Left (I) /= Right (I) then
return False;
end if;
end loop;
end if;
-- length = 0 are always smallest
return False;
end "<";
-- create partitions (as the task describes)
function Create_Partitions (Args : Arguments) return Partition_Sets.Set is
-- permutations needed
type Permutation is array (Positive range <>) of Natural;
-- exception to be thrown after last permutation reached
No_More_Permutations : exception;
-- get initial permutation (ordered small->big)
function Initial_Permutation (Max : Natural) return Permutation is
Result : Permutation (1 .. Max);
begin
for I in 1 .. Max loop
Result (I) := I;
end loop;
return Result;
end Initial_Permutation;
-- get next permutation
function Next_Permutation (Current : Permutation) return Permutation is
K : Natural := Current'Last - 1;
L : Positive := Current'Last;
Result : Permutation := Current;
begin
-- 1. Find the largest index k such that a[k] < a[k + 1].
while K /= 0 and then Current (K) > Current (K + 1) loop
K := K - 1;
end loop;
-- If no such index exists, the permutation is the last permutation.
if K = 0 then
raise No_More_Permutations;
end if;
-- 2. Find the largest index l such that a[k] < a[l].
-- Since k + 1 is such an index, l is well defined
-- and satisfies k < l.
while Current (K) > Current (L) loop
L := L - 1;
end loop;
-- 3. Swap a[k] with a[l].
Result (K) := Current (L);
Result (L) := Current (K);
-- 4. Reverse the sequence from a[k + 1] up to and including the
-- final element a[n].
for I in 1 .. (Result'Last - K) / 2 loop
declare
Temp : constant Natural := Result (K + I);
begin
Result (K + I) := Result (Result'Last - I + 1);
Result (Result'Last - I + 1) := Temp;
end;
end loop;
return Result;
end Next_Permutation;
Result : Partition_Sets.Set;
Sum : Natural := 0;
begin
-- get number of elements
for I in Args'Range loop
Sum := Sum + Args (I);
end loop;
declare
-- initial permutation
Current_Permutation : Permutation := Initial_Permutation (Sum);
begin
-- loop through permutations
loop
-- create Partition (same count of Number_Sets.Set as Args)
declare
Item : Natural := Current_Permutation'First;
Current_Partition : Partition (Args'Range);
begin
-- loop each partition
for I in Args'Range loop
-- fill in the number of elements requested
for J in 1 .. Args (I) loop
Current_Partition (I).Insert
(New_Item => Current_Permutation (Item));
Item := Item + 1;
end loop;
end loop;
-- insert partition into result set
Result.Insert (New_Item => Current_Partition);
exception
when Constraint_Error =>
-- partition was already inserted, ignore it.
-- this happens when one of the args > 1.
null;
end;
-- create next permutation
Current_Permutation := Next_Permutation (Current_Permutation);
end loop;
exception
when No_More_Permutations =>
-- no more permutations, we are finished
null;
end;
return Result;
end Create_Partitions;
end Partitions;

61
Task/Ordered-partitions/Ada/ordered-partitions-3.ada
View file

@ -1,61 +0,0 @@
with Ada.Text_IO;
with Partitions;
procedure Main is
package Natural_IO is new Ada.Text_IO.Integer_IO (Natural);
Example_Partitions : Partitions.Partition_Sets.Set;
begin
Ada.Text_IO.Put_Line ("Partitions for (2, 0, 2):");
-- create partition
Example_Partitions := Partitions.Create_Partitions (Args => (2, 0, 2));
-- pretty print the result
declare
use type Partitions.Partition_Sets.Cursor;
Position : Partitions.Partition_Sets.Cursor := Example_Partitions.First;
begin
Ada.Text_IO.Put ('{');
while Position /= Partitions.Partition_Sets.No_Element loop
if Position /= Example_Partitions.First then
Ada.Text_IO.Put (' ');
end if;
declare
Current_Partition : constant Partitions.Partition :=
Partitions.Partition_Sets.Element (Position);
begin
Ada.Text_IO.Put ('(');
for I in Current_Partition'Range loop
Ada.Text_IO.Put ('{');
declare
use type Partitions.Number_Sets.Cursor;
Current_Number : Partitions.Number_Sets.Cursor :=
Current_Partition (I).First;
begin
while Current_Number /= Partitions.Number_Sets.No_Element
loop
Natural_IO.Put
(Item =>
Partitions.Number_Sets.Element (Current_Number),
Width => 1);
Partitions.Number_Sets.Next (Current_Number);
if Current_Number /=
Partitions.Number_Sets.No_Element then
Ada.Text_IO.Put (',');
end if;
end loop;
end;
Ada.Text_IO.Put ('}');
if I /= Current_Partition'Last then
Ada.Text_IO.Put (", ");
end if;
end loop;
end;
Ada.Text_IO.Put (')');
Partitions.Partition_Sets.Next (Position);
if Position /= Partitions.Partition_Sets.No_Element then
Ada.Text_IO.Put (',');
Ada.Text_IO.New_Line;
end if;
end loop;
Ada.Text_IO.Put ('}');
Ada.Text_IO.New_Line;
end;
end Main;