Initial data commit
This commit is contained in:
Ingy döt Net
parent
72d218235f
commit
f23f22d71c
199087 changed files with 3378941 additions and 0 deletions
|
|
@ -0,0 +1,364 @@
|
|||
:- module patience_sort_task.
|
||||
|
||||
:- interface.
|
||||
:- import_module io.
|
||||
:- pred main(io::di, io::uo) is det.
|
||||
|
||||
:- implementation.
|
||||
:- import_module array.
|
||||
:- import_module int.
|
||||
:- import_module list.
|
||||
:- import_module string.
|
||||
|
||||
%%%-------------------------------------------------------------------
|
||||
%%%
|
||||
%%% patience_sort/5 -- sorts Array[Ifirst..Ilast] out of place,
|
||||
%%% returning indices in Sorted[0..Ilast-Ifirst].
|
||||
%%%
|
||||
|
||||
:- pred patience_sort(pred(T, T), int, int, array(T), array(int)).
|
||||
:- mode patience_sort(pred(in, in) is semidet,
|
||||
in, in, in, out) is det.
|
||||
patience_sort(Less, Ifirst, Ilast, Array, Sorted) :-
|
||||
deal(Less, Ifirst, Ilast, Array, Num_piles, Piles, Links),
|
||||
k_way_merge(Less, Ifirst, Ilast, Array,
|
||||
Num_piles, Piles, Links, Sorted).
|
||||
|
||||
%%%-------------------------------------------------------------------
|
||||
%%%
|
||||
%%% deal/7 -- deals array elements into piles.
|
||||
%%%
|
||||
|
||||
:- pred deal(pred(T, T), int, int, array(T),
|
||||
int, array(int), array(int)).
|
||||
:- mode deal(pred(in, in) is semidet, in, in, in,
|
||||
out, array_uo, array_uo).
|
||||
deal(Less, Ifirst, Ilast, Array, Num_piles, Piles, Links) :-
|
||||
Piles_last = Ilast - Ifirst + 1,
|
||||
%% I do not use index zero of arrays, so must allocate one extra
|
||||
%% entry per array.
|
||||
init(Piles_last + 1, 0, Piles0),
|
||||
init(Piles_last + 1, 0, Links0),
|
||||
deal_loop(Less, Ifirst, Ilast, Array, 1,
|
||||
0, Num_piles,
|
||||
Piles0, Piles,
|
||||
Links0, Links).
|
||||
|
||||
:- pred deal_loop(pred(T, T), int, int, array(T),
|
||||
int, int, int,
|
||||
array(int), array(int),
|
||||
array(int), array(int)).
|
||||
:- mode deal_loop(pred(in, in) is semidet, in, in, in,
|
||||
in, in, out,
|
||||
array_di, array_uo,
|
||||
array_di, array_uo) is det.
|
||||
deal_loop(Less, Ifirst, Ilast, Array, Q,
|
||||
!Num_piles, !Piles, !Links) :-
|
||||
Piles_last = Ilast - Ifirst + 1,
|
||||
(if (Q =< Piles_last)
|
||||
then (find_pile(Less, Ifirst, Array, !.Num_piles, !.Piles, Q) = I,
|
||||
(!.Piles^elem(I)) = L1,
|
||||
(!.Piles^elem(I) := Q) = !:Piles,
|
||||
(!.Links^elem(Q) := L1) = !:Links,
|
||||
max(!.Num_piles, I) = !:Num_piles,
|
||||
deal_loop(Less, Ifirst, Ilast, Array, Q + 1,
|
||||
!Num_piles, !Piles, !Links))
|
||||
else true).
|
||||
|
||||
:- func find_pile(pred(T, T), int, array(T),
|
||||
int, array(int), int) = int.
|
||||
:- mode find_pile(pred(in, in) is semidet,
|
||||
in, in, in, in, in) = out is det.
|
||||
find_pile(Less, Ifirst, Array, Num_piles, Piles, Q) = Index :-
|
||||
%%
|
||||
%% Bottenbruch search for the leftmost pile whose top is greater
|
||||
%% than or equal to x. Return an index such that:
|
||||
%%
|
||||
%% * if x is greater than the top element at the far right, then
|
||||
%% the index returned will be num-piles.
|
||||
%%
|
||||
%% * otherwise, x is greater than every top element to the left of
|
||||
%% index, and less than or equal to the top elements at index
|
||||
%% and to the right of index.
|
||||
%%
|
||||
%% References:
|
||||
%%
|
||||
%% * H. Bottenbruch, "Structure and use of ALGOL 60", Journal of
|
||||
%% the ACM, Volume 9, Issue 2, April 1962, pp.161-221.
|
||||
%% https://doi.org/10.1145/321119.321120
|
||||
%%
|
||||
%% The general algorithm is described on pages 214 and 215.
|
||||
%%
|
||||
%% * https://en.wikipedia.org/w/index.php?title=Binary_search_algorithm&oldid=1062988272#Alternative_procedure
|
||||
%%
|
||||
%% Note:
|
||||
%%
|
||||
%% * There is a binary search in the array module of the standard
|
||||
%% library, but our search algorithm is known to work in other
|
||||
%% programming languages and is written specifically for the
|
||||
%% situation.
|
||||
%%
|
||||
(if (Num_piles = 0) then (Index = 1)
|
||||
else (find_pile_loop(Less, Ifirst, Array, Piles, Q,
|
||||
0, Num_piles - 1, J),
|
||||
(if (J = Num_piles - 1)
|
||||
then (I1 = Piles^elem(J + 1) + Ifirst - 1,
|
||||
I2 = Q + Ifirst - 1,
|
||||
(if Less(Array^elem(I1), Array^elem(I2))
|
||||
then (Index = J + 2)
|
||||
else (Index = J + 1)))
|
||||
else (Index = J + 1)))).
|
||||
|
||||
:- pred find_pile_loop(pred(T, T), int, array(T), array(int),
|
||||
int, int, int, int).
|
||||
:- mode find_pile_loop(pred(in, in) is semidet,
|
||||
in, in, in, in, in, in, out) is det.
|
||||
find_pile_loop(Less, Ifirst, Array, Piles, Q, J, K, J1) :-
|
||||
(if (J = K) then (J1 = J)
|
||||
else ((J + K) // 2 = I,
|
||||
I1 = Piles^elem(J + 1) + Ifirst - 1,
|
||||
I2 = Q + Ifirst - 1,
|
||||
(if Less(Array^elem(I1), Array^elem(I2))
|
||||
then find_pile_loop(Less, Ifirst, Array, Piles, Q,
|
||||
I + 1, K, J1)
|
||||
else find_pile_loop(Less, Ifirst, Array, Piles, Q,
|
||||
J, I, J1)))).
|
||||
|
||||
%%%-------------------------------------------------------------------
|
||||
%%%
|
||||
%%% k_way_merge/8 --
|
||||
%%%
|
||||
%%% k-way merge by tournament tree (specific to this patience sort).
|
||||
%%%
|
||||
%%% See Knuth, volume 3, and also
|
||||
%%% https://en.wikipedia.org/w/index.php?title=K-way_merge_algorithm&oldid=1047851465#Tournament_Tree
|
||||
%%%
|
||||
%%% However, I store a winners tree instead of the recommended losers
|
||||
%%% tree. If the tree were stored as linked nodes, it would probably
|
||||
%%% be more efficient to store a losers tree. However, I am storing
|
||||
%%% the tree as an array, and one can find an opponent quickly by
|
||||
%%% simply toggling the least significant bit of a competitor's array
|
||||
%%% index.
|
||||
%%%
|
||||
|
||||
:- pred k_way_merge(pred(T, T), int, int, array(T), int,
|
||||
array(int), array(int), array(int)).
|
||||
:- mode k_way_merge(pred(in, in) is semidet,
|
||||
in, in, in, in, array_di, in, out) is det.
|
||||
%% Contrary to the arrays used internally, the Sorted array is indexed
|
||||
%% starting at zero.
|
||||
k_way_merge(Less, Ifirst, Ilast, Array,
|
||||
Num_piles, Piles, Links, Sorted) :-
|
||||
init(Ilast - Ifirst + 1, 0, Sorted0),
|
||||
build_tree(Less, Ifirst, Array, Num_piles, Links, Piles, Piles1,
|
||||
Total_external_nodes, Winners_values, Winners_indices),
|
||||
k_way_merge_(Less, Ifirst, Array, Piles1, Links,
|
||||
Total_external_nodes, Winners_values, Winners_indices,
|
||||
0, Sorted0, Sorted).
|
||||
|
||||
:- pred k_way_merge_(pred(T, T), int, array(T),
|
||||
array(int), array(int), int,
|
||||
array(int), array(int), int,
|
||||
array(int), array(int)).
|
||||
:- mode k_way_merge_(pred(in, in) is semidet, in, in, array_di,
|
||||
in, in, array_di, array_di,
|
||||
in, array_di, array_uo) is det.
|
||||
%% Contrary to the arrays used internally, the Sorted array is indexed
|
||||
%% starting at zero.
|
||||
k_way_merge_(Less, Ifirst, Array, Piles, Links, Total_external_nodes,
|
||||
Winners_values, Winners_indices, Isorted, !Sorted) :-
|
||||
Total_nodes = (2 * Total_external_nodes) - 1,
|
||||
(Winners_values^elem(1)) = Value,
|
||||
(if (Value = 0) then true
|
||||
else (set(Isorted, Value + Ifirst - 1, !Sorted),
|
||||
(Winners_indices^elem(1)) = Index,
|
||||
(Piles^elem(Index)) = Next, % The next top of pile Index.
|
||||
(if (Next \= 0) % Drop that top of pile.
|
||||
then (Links^elem(Next) = Link,
|
||||
set(Index, Link, Piles, Piles1))
|
||||
else (Piles = Piles1)),
|
||||
(Total_nodes // 2) + Index = I,
|
||||
(Winners_values^elem(I) := Next) = Winners_values1,
|
||||
replay_games(Less, Ifirst, Array, I,
|
||||
Winners_values1, Winners_values2,
|
||||
Winners_indices, Winners_indices1),
|
||||
k_way_merge_(Less, Ifirst, Array, Piles1, Links,
|
||||
Total_external_nodes, Winners_values2,
|
||||
Winners_indices1, Isorted + 1, !Sorted))).
|
||||
|
||||
:- pred build_tree(pred(T, T), int, array(T), int, array(int),
|
||||
array(int), array(int), int, array(int),
|
||||
array(int)).
|
||||
:- mode build_tree(pred(in, in) is semidet, in, in, in, in,
|
||||
array_di, array_uo, out, out, out) is det.
|
||||
build_tree(Less, Ifirst, Array, Num_piles, Links, !Piles,
|
||||
Total_external_nodes, Winners_values, Winners_indices) :-
|
||||
Total_external_nodes = next_power_of_two(Num_piles),
|
||||
Total_nodes = (2 * Total_external_nodes) - 1,
|
||||
%% I do not use index zero of arrays, so must allocate one extra
|
||||
%% entry per array.
|
||||
init(Total_nodes + 1, 0, Winners_values0),
|
||||
init(Total_nodes + 1, 0, Winners_indices0),
|
||||
init_winners_pile_indices(Total_external_nodes, 1,
|
||||
Winners_indices0, Winners_indices1),
|
||||
init_starting_competitors(Total_external_nodes, Num_piles,
|
||||
(!.Piles), 1, Winners_values0,
|
||||
Winners_values1),
|
||||
discard_initial_tops_of_piles(Num_piles, Links, 1, !Piles),
|
||||
play_initial_games(Less, Ifirst, Array,
|
||||
Total_external_nodes,
|
||||
Winners_values1, Winners_values,
|
||||
Winners_indices1, Winners_indices).
|
||||
|
||||
:- pred init_winners_pile_indices(int::in, int::in,
|
||||
array(int)::array_di,
|
||||
array(int)::array_uo) is det.
|
||||
init_winners_pile_indices(Total_external_nodes, I,
|
||||
!Winners_indices) :-
|
||||
(if (I = Total_external_nodes + 1) then true
|
||||
else (set(Total_external_nodes - 1 + I, I, !Winners_indices),
|
||||
init_winners_pile_indices(Total_external_nodes, I + 1,
|
||||
!Winners_indices))).
|
||||
|
||||
:- pred init_starting_competitors(int::in, int::in,
|
||||
array(int)::in, int::in,
|
||||
array(int)::array_di,
|
||||
array(int)::array_uo) is det.
|
||||
init_starting_competitors(Total_external_nodes, Num_piles,
|
||||
Piles, I, !Winners_values) :-
|
||||
(if (I = Num_piles + 1) then true
|
||||
else (Piles^elem(I) = Value,
|
||||
set(Total_external_nodes - 1 + I, Value, !Winners_values),
|
||||
init_starting_competitors(Total_external_nodes, Num_piles,
|
||||
Piles, I + 1, !Winners_values))).
|
||||
|
||||
:- pred discard_initial_tops_of_piles(int::in, array(int)::in,
|
||||
int::in, array(int)::array_di,
|
||||
array(int)::array_uo) is det.
|
||||
discard_initial_tops_of_piles(Num_piles, Links, I, !Piles) :-
|
||||
(if (I = Num_piles + 1) then true
|
||||
else ((!.Piles^elem(I)) = Old_value,
|
||||
Links^elem(Old_value) = New_value,
|
||||
set(I, New_value, !Piles),
|
||||
discard_initial_tops_of_piles(Num_piles, Links, I + 1,
|
||||
!Piles))).
|
||||
|
||||
:- pred play_initial_games(pred(T, T), int, array(T), int,
|
||||
array(int), array(int),
|
||||
array(int), array(int)).
|
||||
:- mode play_initial_games(pred(in, in) is semidet,
|
||||
in, in, in,
|
||||
array_di, array_uo,
|
||||
array_di, array_uo) is det.
|
||||
play_initial_games(Less, Ifirst, Array, Istart,
|
||||
!Winners_values, !Winners_indices) :-
|
||||
(if (Istart = 1) then true
|
||||
else (play_an_initial_round(Less, Ifirst, Array, Istart, Istart,
|
||||
!Winners_values, !Winners_indices),
|
||||
play_initial_games(Less, Ifirst, Array, Istart // 2,
|
||||
!Winners_values, !Winners_indices))).
|
||||
|
||||
:- pred play_an_initial_round(pred(T, T), int, array(T), int, int,
|
||||
array(int), array(int),
|
||||
array(int), array(int)).
|
||||
:- mode play_an_initial_round(pred(in, in) is semidet,
|
||||
in, in, in, in,
|
||||
array_di, array_uo,
|
||||
array_di, array_uo) is det.
|
||||
play_an_initial_round(Less, Ifirst, Array, Istart, I,
|
||||
!Winners_values, !Winners_indices) :-
|
||||
(if ((2 * Istart) - 1 < I) then true
|
||||
else (play_game(Less, Ifirst, Array,
|
||||
!.Winners_values, I) = Iwinner,
|
||||
(!.Winners_values^elem(Iwinner)) = Value,
|
||||
(!.Winners_indices^elem(Iwinner)) = Index,
|
||||
I // 2 = Iparent,
|
||||
set(Iparent, Value, !Winners_values),
|
||||
set(Iparent, Index, !Winners_indices),
|
||||
play_an_initial_round(Less, Ifirst, Array, Istart, I + 2,
|
||||
!Winners_values, !Winners_indices))).
|
||||
|
||||
:- pred replay_games(pred(T, T), int, array(T), int,
|
||||
array(int), array(int),
|
||||
array(int), array(int)).
|
||||
:- mode replay_games(pred(in, in) is semidet, in, in, in,
|
||||
array_di, array_uo,
|
||||
array_di, array_uo) is det.
|
||||
replay_games(Less, Ifirst, Array, I,
|
||||
!Winners_values, !Winners_indices) :-
|
||||
(if (I = 1) then true
|
||||
else (Iwinner = play_game(Less, Ifirst, Array,
|
||||
!.Winners_values, I),
|
||||
(!.Winners_values^elem(Iwinner)) = Value,
|
||||
(!.Winners_indices^elem(Iwinner)) = Index,
|
||||
I // 2 = Iparent,
|
||||
set(Iparent, Value, !Winners_values),
|
||||
set(Iparent, Index, !Winners_indices),
|
||||
replay_games(Less, Ifirst, Array, Iparent,
|
||||
!Winners_values, !Winners_indices))).
|
||||
|
||||
:- func play_game(pred(T, T), int, array(T), array(int), int) = int.
|
||||
:- mode play_game(pred(in, in) is semidet,
|
||||
in, in, in, in) = out is det.
|
||||
play_game(Less, Ifirst, Array, Winners_values, I) = Iwinner :-
|
||||
J = xor(I, 1), % Find an opponent.
|
||||
Winners_values^elem(I) = Value_I,
|
||||
(if (Value_I = 0) then (Iwinner = J)
|
||||
else (Winners_values^elem(J) = Value_J,
|
||||
(if (Value_J = 0) then (Iwinner = I)
|
||||
else (AJ = Array^elem(Value_J + Ifirst - 1),
|
||||
AI = Array^elem(Value_I + Ifirst - 1),
|
||||
(if Less(AJ, AI) then (Iwinner = J)
|
||||
else (Iwinner = I)))))).
|
||||
|
||||
%%%-------------------------------------------------------------------
|
||||
|
||||
:- func next_power_of_two(int) = int.
|
||||
%% This need not be a fast implemention.
|
||||
next_power_of_two(N) = next_power_of_two_(N, 1).
|
||||
|
||||
:- func next_power_of_two_(int, int) = int.
|
||||
next_power_of_two_(N, I) = Pow2 :-
|
||||
if (I < N) then (Pow2 = next_power_of_two_(N, I + I))
|
||||
else (Pow2 = I).
|
||||
|
||||
%%%-------------------------------------------------------------------
|
||||
|
||||
:- func example_numbers = list(int).
|
||||
example_numbers = [22, 15, 98, 82, 22, 4, 58, 70, 80, 38, 49, 48, 46,
|
||||
54, 93, 8, 54, 2, 72, 84, 86, 76, 53, 37, 90].
|
||||
|
||||
main(!IO) :-
|
||||
from_list(example_numbers, Array),
|
||||
bounds(Array, Ifirst, Ilast),
|
||||
patience_sort(<, Ifirst, Ilast, Array, Sorted),
|
||||
print("unsorted ", !IO),
|
||||
print_int_array(Array, Ifirst, !IO),
|
||||
print_line("", !IO),
|
||||
print("sorted ", !IO),
|
||||
print_indirect_array(Sorted, Array, 0, !IO),
|
||||
print_line("", !IO).
|
||||
|
||||
:- pred print_int_array(array(int)::in, int::in,
|
||||
io::di, io::uo) is det.
|
||||
print_int_array(Array, I, !IO) :-
|
||||
bounds(Array, _, Ilast),
|
||||
(if (I = Ilast + 1) then true
|
||||
else (print(" ", !IO),
|
||||
print(from_int(Array^elem(I)), !IO),
|
||||
print_int_array(Array, I + 1, !IO))).
|
||||
|
||||
:- pred print_indirect_array(array(int)::in, array(int)::in,
|
||||
int::in, io::di, io::uo) is det.
|
||||
print_indirect_array(Sorted, Array, I, !IO) :-
|
||||
bounds(Sorted, _, Ilast),
|
||||
(if (I = Ilast + 1) then true
|
||||
else (print(" ", !IO),
|
||||
print(from_int(Array^elem(Sorted^elem(I))), !IO),
|
||||
print_indirect_array(Sorted, Array, I + 1, !IO))).
|
||||
|
||||
%%%-------------------------------------------------------------------
|
||||
%%% local variables:
|
||||
%%% mode: mercury
|
||||
%%% prolog-indent-width: 2
|
||||
%%% end:
|
||||
|
|
@ -0,0 +1,280 @@
|
|||
MODULE PatienceSortTask;
|
||||
|
||||
FROM STextIO IMPORT WriteString;
|
||||
FROM STextIO IMPORT WriteLn;
|
||||
FROM WholeStr IMPORT IntToStr;
|
||||
|
||||
CONST MaxSortSize = 1024; (* A power of two. *)
|
||||
MaxWinnersSize = (2 * MaxSortSize) - 1;
|
||||
|
||||
TYPE PilesArrayType = ARRAY [1 .. MaxSortSize] OF INTEGER;
|
||||
WinnersArrayType = ARRAY [1 .. MaxWinnersSize],
|
||||
[1 .. 2] OF INTEGER;
|
||||
|
||||
VAR ExampleNumbers : ARRAY [0 .. 35] OF INTEGER;
|
||||
SortedIndices : ARRAY [0 .. 25] OF INTEGER;
|
||||
i : INTEGER;
|
||||
NumStr : ARRAY [0 .. 2] OF CHAR;
|
||||
|
||||
PROCEDURE NextPowerOfTwo (n : INTEGER) : INTEGER;
|
||||
VAR Pow2 : INTEGER;
|
||||
BEGIN
|
||||
(* This need not be a fast implementation. *)
|
||||
Pow2 := 1;
|
||||
WHILE Pow2 < n DO
|
||||
Pow2 := Pow2 + Pow2;
|
||||
END;
|
||||
RETURN Pow2;
|
||||
END NextPowerOfTwo;
|
||||
|
||||
PROCEDURE InitPilesArray (VAR Arr : PilesArrayType);
|
||||
VAR i : INTEGER;
|
||||
BEGIN
|
||||
FOR i := 1 TO MaxSortSize DO
|
||||
Arr[i] := 0;
|
||||
END;
|
||||
END InitPilesArray;
|
||||
|
||||
PROCEDURE InitWinnersArray (VAR Arr : WinnersArrayType);
|
||||
VAR i : INTEGER;
|
||||
BEGIN
|
||||
FOR i := 1 TO MaxWinnersSize DO
|
||||
Arr[i, 1] := 0;
|
||||
Arr[i, 2] := 0;
|
||||
END;
|
||||
END InitWinnersArray;
|
||||
|
||||
PROCEDURE IntegerPatienceSort (iFirst, iLast : INTEGER;
|
||||
Arr : ARRAY OF INTEGER;
|
||||
VAR Sorted : ARRAY OF INTEGER);
|
||||
VAR NumPiles : INTEGER;
|
||||
Piles, Links : PilesArrayType;
|
||||
Winners : WinnersArrayType;
|
||||
|
||||
PROCEDURE FindPile (q : INTEGER) : INTEGER;
|
||||
(*
|
||||
Bottenbruch search for the leftmost pile whose top is greater
|
||||
than or equal to some element x. Return an index such that:
|
||||
|
||||
* if x is greater than the top element at the far right, then
|
||||
the index returned will be num-piles.
|
||||
|
||||
* otherwise, x is greater than every top element to the left of
|
||||
index, and less than or equal to the top elements at index
|
||||
and to the right of index.
|
||||
|
||||
References:
|
||||
|
||||
* H. Bottenbruch, "Structure and use of ALGOL 60", Journal of
|
||||
the ACM, Volume 9, Issue 2, April 1962, pp.161-221.
|
||||
https://doi.org/10.1145/321119.321120
|
||||
|
||||
The general algorithm is described on pages 214 and 215.
|
||||
|
||||
* https://en.wikipedia.org/w/index.php?title=Binary_search_algorithm&oldid=1062988272#Alternative_procedure
|
||||
*)
|
||||
VAR i, j, k, Index : INTEGER;
|
||||
BEGIN
|
||||
IF NumPiles = 0 THEN
|
||||
Index := 1;
|
||||
ELSE
|
||||
j := 0;
|
||||
k := NumPiles - 1;
|
||||
WHILE j <> k DO
|
||||
i := (j + k) DIV 2;
|
||||
IF Arr[Piles[j + 1] + iFirst - 1] < Arr[q + iFirst - 1] THEN
|
||||
j := i + 1;
|
||||
ELSE
|
||||
k := i;
|
||||
END;
|
||||
END;
|
||||
IF j = NumPiles - 1 THEN
|
||||
IF Arr[Piles[j + 1] + iFirst - 1] < Arr[q + iFirst - 1] THEN
|
||||
(* A new pile is needed. *)
|
||||
j := j + 1;
|
||||
END;
|
||||
END;
|
||||
Index := j + 1;
|
||||
END;
|
||||
RETURN Index;
|
||||
END FindPile;
|
||||
|
||||
PROCEDURE Deal;
|
||||
VAR i, q : INTEGER;
|
||||
BEGIN
|
||||
FOR q := 1 TO iLast - iFirst + 1 DO
|
||||
i := FindPile (q);
|
||||
Links[q] := Piles[i];
|
||||
Piles[i] := q;
|
||||
IF i = NumPiles + 1 THEN
|
||||
NumPiles := i;
|
||||
END;
|
||||
END;
|
||||
END Deal;
|
||||
|
||||
PROCEDURE KWayMerge;
|
||||
(*
|
||||
k-way merge by tournament tree.
|
||||
|
||||
See Knuth, volume 3, and also
|
||||
https://en.wikipedia.org/w/index.php?title=K-way_merge_algorithm&oldid=1047851465#Tournament_Tree
|
||||
|
||||
However, I store a winners tree instead of the recommended
|
||||
losers tree. If the tree were stored as linked nodes, it would
|
||||
probably be more efficient to store a losers tree. However, I
|
||||
am storing the tree as an array, and one can find an opponent
|
||||
quickly by simply toggling the least significant bit of a
|
||||
competitor's array index.
|
||||
*)
|
||||
VAR TotalExternalNodes : INTEGER;
|
||||
TotalNodes : INTEGER;
|
||||
iSorted, i, Next : INTEGER;
|
||||
|
||||
PROCEDURE FindOpponent (i : INTEGER) : INTEGER;
|
||||
VAR Opponent : INTEGER;
|
||||
BEGIN
|
||||
IF ODD (i) THEN
|
||||
Opponent := i - 1;
|
||||
ELSE
|
||||
Opponent := i + 1;
|
||||
END;
|
||||
RETURN Opponent;
|
||||
END FindOpponent;
|
||||
|
||||
PROCEDURE PlayGame (i : INTEGER) : INTEGER;
|
||||
VAR j, iWinner : INTEGER;
|
||||
BEGIN
|
||||
j := FindOpponent (i);
|
||||
IF Winners[i, 1] = 0 THEN
|
||||
iWinner := j;
|
||||
ELSIF Winners[j, 1] = 0 THEN
|
||||
iWinner := i;
|
||||
ELSIF Arr[Winners[j, 1] + iFirst - 1]
|
||||
< Arr[Winners[i, 1] + iFirst - 1] THEN
|
||||
iWinner := j;
|
||||
ELSE
|
||||
iWinner := i;
|
||||
END;
|
||||
RETURN iWinner;
|
||||
END PlayGame;
|
||||
|
||||
PROCEDURE ReplayGames (i : INTEGER);
|
||||
VAR j, iWinner : INTEGER;
|
||||
BEGIN
|
||||
j := i;
|
||||
WHILE j <> 1 DO
|
||||
iWinner := PlayGame (j);
|
||||
j := j DIV 2;
|
||||
Winners[j, 1] := Winners[iWinner, 1];
|
||||
Winners[j, 2] := Winners[iWinner, 2];
|
||||
END;
|
||||
END ReplayGames;
|
||||
|
||||
PROCEDURE BuildTree;
|
||||
VAR iStart, i, iWinner : INTEGER;
|
||||
BEGIN
|
||||
FOR i := 1 TO TotalExternalNodes DO
|
||||
(* Record which pile a winner will have come from. *)
|
||||
Winners[TotalExternalNodes - 1 + i, 2] := i;
|
||||
END;
|
||||
|
||||
FOR i := 1 TO NumPiles DO
|
||||
(* The top of each pile becomes a starting competitor. *)
|
||||
Winners[TotalExternalNodes + i - 1, 1] := Piles[i];
|
||||
END;
|
||||
|
||||
FOR i := 1 TO NumPiles DO
|
||||
(* Discard the top of each pile. *)
|
||||
Piles[i] := Links[Piles[i]];
|
||||
END;
|
||||
|
||||
iStart := TotalExternalNodes;
|
||||
WHILE iStart <> 1 DO
|
||||
FOR i := iStart TO (2 * iStart) - 1 BY 2 DO
|
||||
iWinner := PlayGame (i);
|
||||
Winners[i DIV 2, 1] := Winners[iWinner, 1];
|
||||
Winners[i DIV 2, 2] := Winners[iWinner, 2];
|
||||
END;
|
||||
iStart := iStart DIV 2;
|
||||
END;
|
||||
END BuildTree;
|
||||
|
||||
BEGIN
|
||||
TotalExternalNodes := NextPowerOfTwo (NumPiles);
|
||||
TotalNodes := (2 * TotalExternalNodes) - 1;
|
||||
BuildTree;
|
||||
iSorted := 0;
|
||||
WHILE Winners[1, 1] <> 0 DO
|
||||
Sorted[iSorted] := Winners[1, 1] + iFirst - 1;
|
||||
iSorted := iSorted + 1;
|
||||
i := Winners[1, 2];
|
||||
Next := Piles[i]; (* The next top of pile i. *)
|
||||
IF Next <> 0 THEN
|
||||
Piles[i] := Links[Next]; (* Drop that top. *)
|
||||
END;
|
||||
i := (TotalNodes DIV 2) + i;
|
||||
Winners[i, 1] := Next;
|
||||
ReplayGames (i);
|
||||
END;
|
||||
END KWayMerge;
|
||||
|
||||
BEGIN
|
||||
NumPiles := 0;
|
||||
InitPilesArray (Piles);
|
||||
InitPilesArray (Links);
|
||||
InitWinnersArray (Winners);
|
||||
|
||||
IF MaxSortSize < iLast - iFirst + 1 THEN
|
||||
WriteString ('This subarray is too large for the program.');
|
||||
WriteLn;
|
||||
HALT;
|
||||
ELSE
|
||||
Deal;
|
||||
KWayMerge;
|
||||
END;
|
||||
END IntegerPatienceSort;
|
||||
|
||||
BEGIN
|
||||
ExampleNumbers[10] := 22;
|
||||
ExampleNumbers[11] := 15;
|
||||
ExampleNumbers[12] := 98;
|
||||
ExampleNumbers[13] := 82;
|
||||
ExampleNumbers[14] := 22;
|
||||
ExampleNumbers[15] := 4;
|
||||
ExampleNumbers[16] := 58;
|
||||
ExampleNumbers[17] := 70;
|
||||
ExampleNumbers[18] := 80;
|
||||
ExampleNumbers[19] := 38;
|
||||
ExampleNumbers[20] := 49;
|
||||
ExampleNumbers[21] := 48;
|
||||
ExampleNumbers[22] := 46;
|
||||
ExampleNumbers[23] := 54;
|
||||
ExampleNumbers[24] := 93;
|
||||
ExampleNumbers[25] := 8;
|
||||
ExampleNumbers[26] := 54;
|
||||
ExampleNumbers[27] := 2;
|
||||
ExampleNumbers[28] := 72;
|
||||
ExampleNumbers[29] := 84;
|
||||
ExampleNumbers[30] := 86;
|
||||
ExampleNumbers[31] := 76;
|
||||
ExampleNumbers[32] := 53;
|
||||
ExampleNumbers[33] := 37;
|
||||
ExampleNumbers[34] := 90;
|
||||
|
||||
IntegerPatienceSort (10, 34, ExampleNumbers, SortedIndices);
|
||||
|
||||
WriteString ("unsorted ");
|
||||
FOR i := 10 TO 34 DO
|
||||
WriteString (" ");
|
||||
IntToStr (ExampleNumbers[i], NumStr);
|
||||
WriteString (NumStr);
|
||||
END;
|
||||
WriteLn;
|
||||
WriteString ("sorted ");
|
||||
FOR i := 0 TO 24 DO
|
||||
WriteString (" ");
|
||||
IntToStr (ExampleNumbers[SortedIndices[i]], NumStr);
|
||||
WriteString (NumStr);
|
||||
END;
|
||||
WriteLn;
|
||||
END PatienceSortTask.
|
||||
Loading…
Add table
Add a link
Reference in a new issue