Data update

This commit is contained in:
Ingy döt Net 2026-04-30 12:34:36 -04:00
parent 4bb20c9b71
commit cbaf4c4b64
12390 changed files with 318560 additions and 27248 deletions

View file

@ -0,0 +1,257 @@
----------------------------------------------------------------------
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;
----------------------------------------------------------------------

View file

@ -0,0 +1,95 @@
CLASS-ID MainProgram.
METHOD-ID Partition STATIC USING T.
CONSTRAINTS.
CONSTRAIN T IMPLEMENTS type IComparable.
DATA DIVISION.
LOCAL-STORAGE SECTION.
01 pivot-val T.
PROCEDURE DIVISION USING VALUE arr AS T OCCURS ANY,
left-idx AS BINARY-LONG, right-idx AS BINARY-LONG,
pivot-idx AS BINARY-LONG
RETURNING ret AS BINARY-LONG.
MOVE arr (pivot-idx) TO pivot-val
INVOKE self::Swap(arr, pivot-idx, right-idx)
DECLARE store-idx AS BINARY-LONG = left-idx
PERFORM VARYING i AS BINARY-LONG FROM left-idx BY 1
UNTIL i > right-idx
IF arr (i) < pivot-val
INVOKE self::Swap(arr, i, store-idx)
ADD 1 TO store-idx
END-IF
END-PERFORM
INVOKE self::Swap(arr, right-idx, store-idx)
MOVE store-idx TO ret
END METHOD.
METHOD-ID Quickselect STATIC USING T.
CONSTRAINTS.
CONSTRAIN T IMPLEMENTS type IComparable.
PROCEDURE DIVISION USING VALUE arr AS T OCCURS ANY,
left-idx AS BINARY-LONG, right-idx AS BINARY-LONG,
n AS BINARY-LONG
RETURNING ret AS T.
IF left-idx = right-idx
MOVE arr (left-idx) TO ret
GOBACK
END-IF
DECLARE rand AS TYPE Random = NEW Random()
DECLARE pivot-idx AS BINARY-LONG = rand::Next(left-idx, right-idx)
DECLARE pivot-new-idx AS BINARY-LONG
= self::Partition(arr, left-idx, right-idx, pivot-idx)
DECLARE pivot-dist AS BINARY-LONG = pivot-new-idx - left-idx + 1
EVALUATE TRUE
WHEN pivot-dist = n
MOVE arr (pivot-new-idx) TO ret
WHEN n < pivot-dist
INVOKE self::Quickselect(arr, left-idx, pivot-new-idx - 1, n)
RETURNING ret
WHEN OTHER
INVOKE self::Quickselect(arr, pivot-new-idx + 1, right-idx,
n - pivot-dist) RETURNING ret
END-EVALUATE
END METHOD.
METHOD-ID Swap STATIC USING T.
CONSTRAINTS.
CONSTRAIN T IMPLEMENTS type IComparable.
DATA DIVISION.
LOCAL-STORAGE SECTION.
01 temp T.
PROCEDURE DIVISION USING arr AS T OCCURS ANY,
VALUE idx-1 AS BINARY-LONG, idx-2 AS BINARY-LONG.
IF idx-1 <> idx-2
MOVE arr (idx-1) TO temp
MOVE arr (idx-2) TO arr (idx-1)
MOVE temp TO arr (idx-2)
END-IF
END METHOD.
METHOD-ID Main STATIC.
PROCEDURE DIVISION.
DECLARE input-array AS BINARY-LONG OCCURS ANY
= TABLE OF BINARY-LONG(9, 8, 7, 6, 5, 0, 1, 2, 3, 4)
DISPLAY "Loop quick select 10 times."
PERFORM VARYING i AS BINARY-LONG FROM 1 BY 1 UNTIL i > 10
DISPLAY self::Quickselect(input-array, 1, input-array::Length, i)
NO ADVANCING
IF i < 10
DISPLAY ", " NO ADVANCING
END-IF
END-PERFORM
DISPLAY SPACE
END METHOD.
END CLASS.

View file

@ -1,51 +1,123 @@
INTEGER FUNCTION FINDELEMENT(K,A,N) !I know I can.
Chase an order statistic: FindElement(N/2,A,N) leads to the median, with some odd/even caution.
Careful! The array is shuffled: for i < K, A(i) <= A(K); for i > K, A(i) >= A(K).
Charles Anthony Richard Hoare devised this method, as related to his famous QuickSort.
INTEGER K,N !Find the K'th element in order of an array of N elements, not necessarily in order.
INTEGER A(N),HOPE,PESTY !The array, and like associates.
INTEGER L,R,L2,R2 !Fingers.
L = 1 !Here we go.
R = N !The bounds of the work area within which the K'th element lurks.
DO WHILE (L .LT. R) !So, keep going until it is clamped.
HOPE = A(K) !If array A is sorted, this will be rewarded.
L2 = L !But it probably isn't sorted.
R2 = R !So prepare a scan.
DO WHILE (L2 .LE. R2) !Keep squeezing until the inner teeth meet.
DO WHILE (A(L2) .LT. HOPE) !Pass elements less than HOPE.
L2 = L2 + 1 !Note that at least element A(K) equals HOPE.
END DO !Raising the lower jaw.
DO WHILE (HOPE .LT. A(R2)) !Elements higher than HOPE
R2 = R2 - 1 !Are in the desired place.
END DO !And so we speed past them.
IF (L2 - R2) 1,2,3 !How have the teeth paused?
1 PESTY = A(L2) !On grit. A(L2) > HOPE and A(R2) < HOPE.
A(L2) = A(R2) !So swap the two troublemakers.
A(R2) = PESTY !To be as if they had been in the desired order all along.
2 L2 = L2 + 1 !Advance my teeth.
R2 = R2 - 1 !As if they hadn't paused on this pest.
3 END DO !And resume the squeeze, hopefully closing in K.
IF (R2 .LT. K) L = L2 !The end point gives the order position of value HOPE.
IF (K .LT. L2) R = R2 !But we want the value of order position K.
END DO !Have my teeth met yet?
FINDELEMENT = A(K) !Yes. A(K) now has the K'th element in order.
END FUNCTION FINDELEMENT !Remember! Array A has likely had some elements moved!
!------------------------------------------------------------------------------
! Module: quickselect_mod
!
! Description:
! Hoare's QuickSelect algorithm: find the K-th smallest element in an
! unsorted integer array in average O(N) time.
!
! The array is partially sorted as a side effect: on return,
! A(i) <= A(K) for all i < K
! A(i) >= A(K) for all i > K
! so A(K) holds the K-th order statistic.
!
! Useful special cases:
! K = 1 : minimum element
! K = N : maximum element
! K = (N+1)/2 : lower median
!
! The pivot at each step is A(K) itself. Because K lies within the search
! window [L,R] at every iteration, A(K) is always a valid partition value
! and the window narrows by at least one element per pass.
!
! Average time: O(N). Worst case: O(N^2) when the pivot is always extreme
! (e.g., already-sorted input). For robust median finding on large arrays
! consider Introselect (median-of-medians pivot selection).
!
! Reference:
! C.A.R. Hoare, "Algorithm 65: Find", Communications of the ACM, 1961.
!
! Authors:
! Original algorithm: C.A.R. Hoare
!
!------------------------------------------------------------------------------
PROGRAM POKE
INTEGER FINDELEMENT !Not the default type for F.
INTEGER N !The number of elements.
PARAMETER (N = 10) !Fixed for the test problem.
INTEGER A(66) !An array of integers.
DATA A(1:N)/9, 8, 7, 6, 5, 0, 1, 2, 3, 4/ !The specified values.
module quickselect_mod
implicit none
private
public :: quickselect
WRITE (6,1) A(1:N) !Announce, and add a heading.
1 FORMAT ("Selection of the i'th element in order from an array.",/
1 "The array need not be in order, and may be reordered.",/
2 " i Val:Array elements...",/,8X,666I2)
contains
DO I = 1,N !One by one,
WRITE (6,2) I,FINDELEMENT(I,A,N),A(1:N) !Request the i'th element.
2 FORMAT (I3,I4,":",666I2) !Match FORMAT 1.
END DO !On to the next trial.
!---------------------------------------------------------------------------
! quickselect -- return the K-th smallest element of A(1:N).
!
! The array A is partially rearranged in place; see module header.
!---------------------------------------------------------------------------
integer function quickselect(k, a, n)
integer, intent(in) :: k ! order position wanted (1-based)
integer, intent(in) :: n ! number of elements
integer, intent(inout) :: a(n) ! array; partially sorted on exit
END !That was easy.
integer :: l, r, l2, r2 ! outer and inner scan fingers
integer :: pivot ! partition value (= A(K) each pass)
integer :: tmp ! swap temporary
l = 1
r = n
do while (l < r)
pivot = a(k) ! A(K) lies in [L,R], so this is always valid.
l2 = l
r2 = r
! Partition loop: squeeze l2 and r2 inward until they cross.
! Invariant: A(L..l2-1) < pivot, A(r2+1..R) > pivot.
do while (l2 <= r2)
! Advance left finger past elements already in the right place.
do while (a(l2) < pivot)
l2 = l2 + 1
end do
! Retreat right finger past elements already in the right place.
do while (pivot < a(r2))
r2 = r2 - 1
end do
! l2 and r2 have stalled on out-of-order elements (or met).
if (l2 <= r2) then
if (l2 < r2) then ! stalled on two elements: swap them
tmp = a(l2)
a(l2) = a(r2)
a(r2) = tmp
end if
l2 = l2 + 1 ! advance past the (now correct) pair
r2 = r2 - 1
end if
end do
! After partition, r2 < l2.
! r2 is the final position of the last element <= pivot.
! l2 is the final position of the first element >= pivot.
! Narrow the outer window to the side that contains K.
if (r2 < k) l = l2
if (k < l2) r = r2
end do
quickselect = a(k)
end function quickselect
end module quickselect_mod
program poke
use quickselect_mod
implicit none
integer :: i
integer, parameter :: n = 10 !Fixed for the test problem.
integer :: a(66) !An array of integers.
data a(1:n)/9, 8, 7, 6, 5, 0, 1, 2, 3, 4/ !The specified values.
write(6, 1) a(1:n) !Announce, and add a heading.
1 format("Selection of the i'th element in order from an array.", /, "The array need not be in order, and may be reordered.", & /, (*(i0, 1x)))
2 format(t11, "i Val:Array elements...")
3 format(t8, I3, I4, ":", (*(I0, 1x)))
write(6, 2)
do i = 1, n !One by one,
write(6, 3) i, quickselect(i, a, n), a(1:n) !Request the i'th element.
end do
end program poke

View file

@ -0,0 +1,31 @@
function partition($list, $left, $right, $pivotIndex) {
$pivotValue = $list[$pivotIndex]
$list[$pivotIndex], $list[$right] = $list[$right], $list[$pivotIndex]
$storeIndex = $left
foreach ($i in $left..($right-1)) {
if ($list[$i] -lt $pivotValue) {
$list[$storeIndex],$list[$i] = $list[$i], $list[$storeIndex]
$storeIndex += 1
}
}
$list[$right],$list[$storeIndex] = $list[$storeIndex], $list[$right]
$storeIndex
}
function rank($list, $left, $right, $n) {
if ($left -eq $right) {$list[$left]}
else {
$pivotIndex = Get-Random -Minimum $left -Maximum $right
$pivotIndex = partition $list $left $right $pivotIndex
if ($n -eq $pivotIndex) {$list[$n]}
elseif ($n -lt $pivotIndex) {(rank $list $left ($pivotIndex - 1) $n)}
else {(rank $list ($pivotIndex+1) $right $n)}
}
}
function quickselect($list) {
$right = $list.count-1
foreach($left in 0..$right) {rank $list $left $right $left}
}
$arr = @(9, 8, 7, 6, 5, 0, 1, 2, 3, 4)
"$(quickselect $arr)"