258 lines
7.1 KiB
Ada
258 lines
7.1 KiB
Ada
----------------------------------------------------------------------
|
|
|
|
with Ada.Numerics.Float_Random;
|
|
with Ada.Text_IO;
|
|
|
|
procedure quickselect_task
|
|
is
|
|
|
|
use Ada.Numerics.Float_Random;
|
|
use Ada.Text_IO;
|
|
|
|
gen : Generator;
|
|
|
|
----------------------------------------------------------------------
|
|
--
|
|
-- procedure partition
|
|
--
|
|
-- Partitioning a subarray into two halves: one with elements less
|
|
-- than or equal to a pivot, the other with elements greater than or
|
|
-- equal to a pivot.
|
|
--
|
|
|
|
generic
|
|
type T is private;
|
|
type T_Array is array (Natural range <>) of T;
|
|
procedure partition
|
|
(less_than : access function
|
|
(x, y : T)
|
|
return Boolean;
|
|
pivot : in T;
|
|
i_first, i_last : in Natural;
|
|
arr : in out T_Array;
|
|
i_pivot : out Natural);
|
|
|
|
procedure partition
|
|
(less_than : access function
|
|
(x, y : T)
|
|
return Boolean;
|
|
pivot : in T;
|
|
i_first, i_last : in Natural;
|
|
arr : in out T_Array;
|
|
i_pivot : out Natural)
|
|
is
|
|
i, j : Integer;
|
|
temp : T;
|
|
begin
|
|
|
|
i := Integer (i_first) - 1;
|
|
j := i_last + 1;
|
|
|
|
while i /= j loop
|
|
-- Move i so everything to the left of i is less than or equal
|
|
-- to the pivot.
|
|
i := i + 1;
|
|
while i /= j and then not less_than (pivot, arr (i)) loop
|
|
i := i + 1;
|
|
end loop;
|
|
|
|
-- Move j so everything to the right of j is greater than or
|
|
-- equal to the pivot.
|
|
if i /= j then
|
|
j := j - 1;
|
|
while i /= j and then not less_than (arr (j), pivot) loop
|
|
j := j - 1;
|
|
end loop;
|
|
end if;
|
|
|
|
-- Swap entries.
|
|
temp := arr (i);
|
|
arr (i) := arr (j);
|
|
arr (j) := temp;
|
|
end loop;
|
|
|
|
i_pivot := i;
|
|
|
|
end partition;
|
|
|
|
----------------------------------------------------------------------
|
|
--
|
|
-- procedure quickselect
|
|
--
|
|
-- Quickselect with a random pivot. Returns the (k+1)st element of a
|
|
-- subarray, according to the given order predicate. Also rearranges
|
|
-- the subarray so that anything "less than" the (k+1)st element is to
|
|
-- the left of it, and anything "greater than" it is to its right.
|
|
--
|
|
-- I use a random pivot to get O(n) worst case *expected* running
|
|
-- time. Code using a random pivot is easy to write and read, and for
|
|
-- most purposes comes close enough to a criterion set by Scheme's
|
|
-- SRFI-132: "Runs in O(n) time." (See
|
|
-- https://srfi.schemers.org/srfi-132/srfi-132.html)
|
|
--
|
|
-- Of course we are not bound here by SRFI-132, but still I respect
|
|
-- it as a guide.
|
|
--
|
|
-- A "median of medians" pivot gives O(n) running time, but
|
|
-- quickselect with such a pivot is a complicated algorithm requiring
|
|
-- many comparisons of array elements. A random number generator, by
|
|
-- contrast, requires no comparisons of array elements.
|
|
--
|
|
|
|
generic
|
|
type T is private;
|
|
type T_Array is array (Natural range <>) of T;
|
|
procedure quickselect
|
|
(less_than : access function
|
|
(x, y : T)
|
|
return Boolean;
|
|
i_first, i_last : in Natural;
|
|
k : in Natural;
|
|
arr : in out T_Array;
|
|
the_element : out T;
|
|
the_elements_index : out Natural);
|
|
|
|
procedure quickselect
|
|
(less_than : access function
|
|
(x, y : T)
|
|
return Boolean;
|
|
i_first, i_last : in Natural;
|
|
k : in Natural;
|
|
arr : in out T_Array;
|
|
the_element : out T;
|
|
the_elements_index : out Natural)
|
|
is
|
|
procedure T_partition is new partition (T, T_Array);
|
|
|
|
procedure qselect
|
|
(less_than : access function
|
|
(x, y : T)
|
|
return Boolean;
|
|
i_first, i_last : in Natural;
|
|
k : in Natural;
|
|
arr : in out T_Array;
|
|
the_element : out T;
|
|
the_elements_index : out Natural)
|
|
is
|
|
i, j : Natural;
|
|
i_pivot : Natural;
|
|
i_final : Natural;
|
|
pivot : T;
|
|
begin
|
|
|
|
i := i_first;
|
|
j := i_last;
|
|
|
|
while i /= j loop
|
|
i_pivot :=
|
|
i + Natural (Float'Floor (Random (gen) * Float (j - i + 1)));
|
|
i_pivot := Natural'Min (j, i_pivot);
|
|
pivot := arr (i_pivot);
|
|
|
|
-- Move the last element to where the pivot had been. Perhaps
|
|
-- the pivot was already the last element, of course. In any
|
|
-- case, we shall partition only from i to j - 1.
|
|
arr (i_pivot) := arr (j);
|
|
|
|
-- Partition the array in the range i .. j - 1, leaving out
|
|
-- the last element (which now can be considered garbage).
|
|
T_partition (less_than, pivot, i, j - 1, arr, i_final);
|
|
|
|
-- Now everything that is less than the pivot is to the left
|
|
-- of I_final.
|
|
|
|
-- Put the pivot at i_final, moving the element that had been
|
|
-- there to the end. If i_final = j, then this element is
|
|
-- actually garbage and will be overwritten with the pivot,
|
|
-- which turns out to be the greatest element. Otherwise, the
|
|
-- moved element is not less than the pivot and so the
|
|
-- partitioning is preserved.
|
|
arr (j) := arr (i_final);
|
|
arr (i_final) := pivot;
|
|
|
|
-- Compare i_final and k, to see what to do next.
|
|
if i_final < k then
|
|
i := i_final + 1;
|
|
elsif k < i_final then
|
|
j := i_final - 1;
|
|
else
|
|
-- Exit the loop.
|
|
i := i_final;
|
|
j := i_final;
|
|
end if;
|
|
end loop;
|
|
|
|
the_element := arr (i);
|
|
the_elements_index := i;
|
|
|
|
end qselect;
|
|
begin
|
|
-- Adjust k for the subarray's position.
|
|
qselect
|
|
(less_than, i_first, i_last, k + i_first, arr, the_element,
|
|
the_elements_index);
|
|
end quickselect;
|
|
|
|
----------------------------------------------------------------------
|
|
|
|
type Integer_Array is array (Natural range <>) of Integer;
|
|
|
|
procedure integer_quickselect is new quickselect
|
|
(Integer, Integer_Array);
|
|
|
|
procedure print_kth
|
|
(less_than : access function
|
|
(x, y : Integer)
|
|
return Boolean;
|
|
k : in Positive;
|
|
i_first, i_last : in Integer;
|
|
arr : in out Integer_Array)
|
|
is
|
|
copy_of_arr : Integer_Array (0 .. i_last);
|
|
the_element : Integer;
|
|
the_elements_index : Natural;
|
|
begin
|
|
for j in 0 .. i_last loop
|
|
copy_of_arr (j) := arr (j);
|
|
end loop;
|
|
integer_quickselect
|
|
(less_than, i_first, i_last, k - 1, copy_of_arr, the_element,
|
|
the_elements_index);
|
|
Put (Integer'Image (the_element));
|
|
end print_kth;
|
|
|
|
----------------------------------------------------------------------
|
|
|
|
example_numbers : Integer_Array := (9, 8, 7, 6, 5, 0, 1, 2, 3, 4);
|
|
|
|
function lt
|
|
(x, y : Integer)
|
|
return Boolean
|
|
is
|
|
begin
|
|
return (x < y);
|
|
end lt;
|
|
|
|
function gt
|
|
(x, y : Integer)
|
|
return Boolean
|
|
is
|
|
begin
|
|
return (x > y);
|
|
end gt;
|
|
|
|
begin
|
|
Put ("With < as order predicate: ");
|
|
for k in 1 .. 10 loop
|
|
print_kth (lt'Access, k, 0, 9, example_numbers);
|
|
end loop;
|
|
Put_Line ("");
|
|
Put ("With > as order predicate: ");
|
|
for k in 1 .. 10 loop
|
|
print_kth (gt'Access, k, 0, 9, example_numbers);
|
|
end loop;
|
|
Put_Line ("");
|
|
end quickselect_task;
|
|
|
|
----------------------------------------------------------------------
|