Sorting algorithms/Patience sort: Difference between revisions

m
m (→‎{{header|Wren}}: Minor tidy)
 
(19 intermediate revisions by 3 users not shown)
Line 13:
{{trans|Kotlin}}
 
<langsyntaxhighlight lang="11l">F patience_sort(&arr)
I arr.len < 2 {R}
 
Line 48:
V sArr = [‘dog’, ‘cow’, ‘cat’, ‘ape’, ‘ant’, ‘man’, ‘pig’, ‘ass’, ‘gnu’]
patience_sort(&sArr)
print(sArr)</langsyntaxhighlight>
 
{{out}}
Line 59:
=={{header|AArch64 Assembly}}==
{{works with|as|Raspberry Pi 3B version Buster 64 bits}}
<syntaxhighlight lang="aarch64 assembly">
<lang AArch64 Assembly>
/* ARM assembly AARCH64 Raspberry PI 3B */
/* program patienceSort64.s */
Line 422:
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"
</syntaxhighlight>
</lang>
 
=={{header|Ada}}==
{{trans|Fortran}}
{{works with|Ada|GNAT Community 2021}}
 
 
The program implements a generic sort that produces a sorted array of indices. The original array is left untouched. The main program demonstrates an instantiation for arrays of integers.
 
 
<syntaxhighlight lang="ada">----------------------------------------------------------------------
 
with Ada.Text_IO;
 
procedure patience_sort_task is
use Ada.Text_IO;
 
function next_power_of_two
(n : in Natural)
return Positive is
-- This need not be a fast implementation.
pow2 : Positive;
begin
pow2 := 1;
while pow2 < n loop
pow2 := pow2 + pow2;
end loop;
return pow2;
end next_power_of_two;
 
generic
type t is private;
type t_array is array (Integer range <>) of t;
type sorted_t_indices is array (Integer range <>) of Integer;
procedure patience_sort
(less : access function
(x, y : t)
return Boolean;
ifirst : in Integer;
ilast : in Integer;
arr : in t_array;
sorted : out sorted_t_indices);
 
procedure patience_sort
(less : access function
(x, y : t)
return Boolean;
ifirst : in Integer;
ilast : in Integer;
arr : in t_array;
sorted : out sorted_t_indices) is
 
num_piles : Integer;
piles : array (1 .. ilast - ifirst + 1) of Integer :=
(others => 0);
links : array (1 .. ilast - ifirst + 1) of Integer :=
(others => 0);
 
function find_pile
(q : in Positive)
return Positive is
--
-- 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
--
index : Positive;
i, j, k : Natural;
begin
if num_piles = 0 then
index := 1;
else
j := 0;
k := num_piles - 1;
while j /= k loop
i := (j + k) / 2;
if less
(arr (piles (j + 1) + ifirst - 1), arr (q + ifirst - 1))
then
j := i + 1;
else
k := i;
end if;
end loop;
if j = num_piles - 1 then
if less
(arr (piles (j + 1) + ifirst - 1), arr (q + ifirst - 1))
then
-- A new pile is needed.
j := j + 1;
end if;
end if;
index := j + 1;
end if;
return index;
end find_pile;
 
procedure deal is
i : Positive;
begin
for q in links'range loop
i := find_pile (q);
links (q) := piles (i);
piles (i) := q;
num_piles := Integer'max (num_piles, i);
end loop;
end deal;
 
procedure k_way_merge is
--
-- 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.
--
total_external_nodes : Positive;
total_nodes : Positive;
begin
 
total_external_nodes := next_power_of_two (num_piles);
total_nodes := (2 * total_external_nodes) - 1;
 
declare
 
-- In Fortran I had the length-2 dimension come first, to
-- take some small advantage of column-major order. The
-- recommendation for Ada compilers, however, is to use
-- row-major order. So I have reversed the order.
winners : array (1 .. total_nodes, 1 .. 2) of Integer :=
(others => (0, 0));
 
function find_opponent
(i : Natural)
return Natural is
begin
return (if i rem 2 = 0 then i + 1 else i - 1);
end find_opponent;
 
function play_game
(i : Positive)
return Positive is
j, iwinner : Positive;
begin
j := find_opponent (i);
if winners (i, 1) = 0 then
iwinner := j;
elsif winners (j, 1) = 0 then
iwinner := i;
elsif less
(arr (winners (j, 1) + ifirst - 1),
arr (winners (i, 1) + ifirst - 1))
then
iwinner := j;
else
iwinner := i;
end if;
return iwinner;
end play_game;
 
procedure replay_games
(i : Positive) is
j, iwinner : Positive;
begin
j := i;
while j /= 1 loop
iwinner := play_game (j);
j := j / 2;
winners (j, 1) := winners (iwinner, 1);
winners (j, 2) := winners (iwinner, 2);
end loop;
end replay_games;
 
procedure build_tree is
istart, i, iwinner : Positive;
begin
for i in 1 .. total_external_nodes loop
-- Record which pile a winner will have come from.
winners (total_external_nodes - 1 + i, 2) := i;
end loop;
 
for i in 1 .. num_piles loop
-- The top of each pile becomes a starting competitor.
winners (total_external_nodes + i - 1, 1) := piles (i);
end loop;
 
for i in 1 .. num_piles loop
-- Discard the top of each pile
piles (i) := links (piles (i));
end loop;
 
istart := total_external_nodes;
while istart /= 1 loop
i := istart;
while i <= (2 * istart) - 1 loop
iwinner := play_game (i);
winners (i / 2, 1) := winners (iwinner, 1);
winners (i / 2, 2) := winners (iwinner, 2);
i := i + 2;
end loop;
istart := istart / 2;
end loop;
end build_tree;
 
isorted, i, next : Integer;
 
begin
build_tree;
isorted := 0;
while winners (1, 1) /= 0 loop
sorted (sorted'first + 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 if;
i := (total_nodes / 2) + i;
winners (i, 1) := next;
replay_games (i);
end loop;
end;
 
end k_way_merge;
 
begin
deal;
k_way_merge;
end patience_sort;
 
begin
 
-- A demonstration.
 
declare
 
type integer_array is array (Integer range <>) of Integer;
procedure integer_patience_sort is new patience_sort
(Integer, integer_array, integer_array);
 
subtype int25_array is integer_array (1 .. 25);
 
example_numbers : constant int25_array :=
(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);
 
sorted_numbers : int25_array := (others => 0);
 
function less
(x, y : Integer)
return Boolean is
begin
return (x < y);
end less;
 
begin
integer_patience_sort
(less'access, example_numbers'first, example_numbers'last,
example_numbers, sorted_numbers);
 
Put ("unsorted ");
for i of example_numbers loop
Put (Integer'image (i));
end loop;
Put_Line ("");
Put ("sorted ");
for i of sorted_numbers loop
Put (Integer'image (example_numbers (i)));
end loop;
Put_Line ("");
end;
 
end patience_sort_task;
 
----------------------------------------------------------------------</syntaxhighlight>
 
{{out}}
<pre>$ gnatmake -Wall -Wextra -q patience_sort_task.adb && ./patience_sort_task
unsorted 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
sorted 2 4 8 15 22 22 37 38 46 48 49 53 54 54 58 70 72 76 80 82 84 86 90 93 98</pre>
 
=={{header|AppleScript}}==
<langsyntaxhighlight lang="applescript">-- In-place patience sort.
on patienceSort(theList, l, r) -- Sort items l thru r of theList.
set listLen to (count theList)
Line 484 ⟶ 786:
set aList to {62, 86, 59, 65, 92, 85, 71, 71, 27, -52, 67, 59, 65, 80, 3, 65, 2, 46, 83, 72, 47, 5, 26, 18, 63}
sort(aList, 1, -1)
return aList</langsyntaxhighlight>
 
{{output}}
<langsyntaxhighlight lang="applescript">{-52, 2, 3, 5, 18, 26, 27, 46, 47, 59, 59, 62, 63, 65, 65, 65, 67, 71, 71, 72, 80, 83, 85, 86, 92}</langsyntaxhighlight>
 
=={{header|ARM Assembly}}==
{{works with|as|Raspberry Pi}}
<syntaxhighlight lang="arm assembly">
<lang ARM Assembly>
/* ARM assembly Raspberry PI */
/* program patienceSort.s */
Line 819 ⟶ 1,121:
/***************************************************/
.include "../affichage.inc"
</syntaxhighlight>
</lang>
 
=={{header|Arturo}}==
<syntaxhighlight lang="arturo">patienceSort: function [arr][
result: new arr
 
if 2 > size result -> return result
 
piles: []
 
loop result 'elem ->
'piles ++ @[@[elem]]
 
loop 0..dec size result 'i [
minP: last piles\0
minPileIndex: 0
 
if 2 =< size piles ->
loop 1..dec size piles 'j [
if minP > last piles\[j] [
minP: last piles\[j]
minPileIndex: j
]
]
 
result\[i]: minP
piles\[minPileIndex]: slice piles\[minPileIndex] 0 dec dec size piles\[minPileIndex]
if zero? size piles\[minPileIndex] ->
piles: remove.index piles minPileIndex
]
return result
]
 
print patienceSort [3 1 2 8 5 7 9 4 6]</syntaxhighlight>
 
{{out}}
 
<pre>1 2 3 4 5 6 7 8 9</pre>
 
=={{header|ATS}}==
 
===A patience sort for arrays of non-linear elements===
{{trans|Fortran}}
 
 
The sort routine returns an array of indices into the original array, which is left unmodified.
 
<syntaxhighlight lang="ats">(*------------------------------------------------------------------*)
 
#include "share/atspre_staload.hats"
 
vtypedef array_tup_vt (a : vt@ype+, p : addr, n : int) =
(* An array, without size information attached. *)
@(array_v (a, p, n),
mfree_gc_v p |
ptr p)
 
extern fn {a : t@ype}
patience_sort
{ifirst, len : int | 0 <= ifirst}
{n : int | ifirst + len <= n}
(arr : &RD(array (a, n)),
ifirst : size_t ifirst,
len : size_t len)
:<!wrt> (* Return an array of indices into arr. *)
[p : addr]
array_tup_vt
([i : int | len == 0 ||
(ifirst <= i && i < ifirst + len)] size_t i,
p, len)
 
(* patience_sort$lt : the order predicate. *)
extern fn {a : t@ype}
patience_sort$lt (x : a, y : a) :<> bool
 
(*------------------------------------------------------------------*)
(*
 
In the following implementation of next_power_of_two:
 
* I implement it as a template for all types of kind g1uint. This
includes dependent forms of uint, usint, ulint, ullint, size_t,
and yet more types in the prelude; also whatever others one may
create.
 
* I prove the result is not less than the input.
 
* I prove the result is less than twice the input.
 
* I prove the result is a power of two. This last proof is
provided in the form of an EXP2 prop.
 
* I do NOT return what number two is raised to (though I easily
could have). I leave that number "existentially defined". In
other words, I prove only that some such non-negative number
exists.
 
*)
 
fn {tk : tkind}
next_power_of_two
{i : pos}
(i : g1uint (tk, i))
:<> [k : int | i <= k; k < 2 * i]
[n : nat]
@(EXP2 (n, k) | g1uint (tk, k)) =
let
(* This need not be a fast implementation. *)
 
val one : g1uint (tk, 1) = g1u2u 1u
 
fun
loop {j : pos | j < i} .<i + i - j>.
(pf : [n : nat] EXP2 (n, j) |
j : g1uint (tk, j))
:<> [k : int | i <= k; k < 2 * i]
[n : nat]
@(EXP2 (n, k) | g1uint (tk, k)) =
let
val j2 = j + j
in
if i <= j2 then
@(EXP2ind pf | j2)
else
loop (EXP2ind pf | j2)
end
in
if i = one then
@(EXP2bas () | one)
else
loop (EXP2bas () | one)
end
 
(*------------------------------------------------------------------*)
 
stadef link (ifirst : int, ilast : int, i : int) : bool =
0 <= i && i <= ilast - ifirst + 1
 
typedef link_t (ifirst : int, ilast : int, i : int) =
(* A size_t within legal range for a normalized link, including the
"nil" link 0. *)
[link (ifirst, ilast, i)]
size_t i
typedef link_t (ifirst : int, ilast : int) =
[i : int]
link_t (ifirst, ilast, i)
 
fn {a : t@ype}
find_pile {ifirst, ilast : int | ifirst <= ilast}
{n : int | ilast < n}
{num_piles : nat | num_piles <= ilast - ifirst + 1}
{n_piles : int | ilast - ifirst + 1 <= n_piles}
{q : pos | q <= ilast - ifirst + 1}
(ifirst : size_t ifirst,
arr : &RD(array (a, n)),
num_piles : size_t num_piles,
piles : &RD(array (link_t (ifirst, ilast),
n_piles)),
q : size_t q)
:<> [i : pos | i <= num_piles + 1]
size_t i =
(*
Bottenbruch search for the leftmost pile whose top is greater than
or equal to the next value dealt by "deal".
 
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
*)
if num_piles = i2sz 0 then
i2sz 1
else
let
macdef lt = patience_sort$lt<a>
 
prval () = lemma_g1uint_param ifirst
prval () = prop_verify {0 <= ifirst} ()
 
fun
loop {j, k : nat | j <= k; k < num_piles}
.<k - j>.
(arr : &RD(array (a, n)),
piles : &array (link_t (ifirst, ilast), n_piles),
j : size_t j,
k : size_t k)
:<> [i : pos | i <= num_piles + 1]
size_t i =
if j = k then
begin
if succ j <> num_piles then
succ j
else
let
val piles_j = piles[j]
val () = $effmask_exn assertloc (piles_j <> g1u2u 0u)
 
val x1 = arr[pred q + ifirst]
and x2 = arr[pred piles_j + ifirst]
in
if x2 \lt x1 then
succ (succ j)
else
succ j
end
end
else
let
typedef index (i : int) = [0 <= i; i < n] size_t i
typedef index = [i : int] index i
 
stadef i = j + ((k - j) / 2)
val i : size_t i = j + ((k - j) / g1u2u 2u)
 
val piles_j = piles[j]
val () = $effmask_exn assertloc (piles_j <> g1u2u 0u)
 
val x1 = arr[pred q + ifirst]
and x2 = arr[pred piles_j + ifirst]
in
if x2 \lt x1 then
loop (arr, piles, i + 1, k)
else
loop (arr, piles, j, i)
end
in
loop (arr, piles, g1u2u 0u, pred num_piles)
end
 
fn {a : t@ype}
deal {ifirst, ilast : int | ifirst <= ilast}
{n : int | ilast < n}
(ifirst : size_t ifirst,
ilast : size_t ilast,
arr : &RD(array (a, n)))
:<!wrt> [num_piles : int | num_piles <= ilast - ifirst + 1]
[n_piles : int | ilast - ifirst + 1 <= n_piles]
[n_links : int | ilast - ifirst + 1 <= n_links]
[p_piles : addr]
[p_links : addr]
@(size_t num_piles,
array_tup_vt (link_t (ifirst, ilast),
p_piles, n_piles),
array_tup_vt (link_t (ifirst, ilast),
p_links, n_links)) =
let
prval () = prop_verify {0 < ilast - ifirst + 1} ()
 
stadef num_elems = ilast - ifirst + 1
val num_elems : size_t num_elems = succ (ilast - ifirst)
 
typedef link_t (i : int) = link_t (ifirst, ilast, i)
typedef link_t = link_t (ifirst, ilast)
 
val zero : size_t 0 = g1u2u 0u
val one : size_t 1 = g1u2u 1u
val link_nil : link_t 0 = g1u2u 0u
 
fun
loop {q : pos | q <= num_elems + 1}
{m : nat | m <= num_elems}
.<num_elems + 1 - q>.
(arr : &RD(array (a, n)),
q : size_t q,
piles : &array (link_t, num_elems),
links : &array (link_t, num_elems),
m : size_t m)
:<!wrt> [num_piles : nat | num_piles <= num_elems]
size_t num_piles =
if q = succ (num_elems) then
m
else
let
val i = find_pile {ifirst, ilast} (ifirst, arr, m, piles, q)
 
(* We have no proof the number of elements will not exceed
storage. However, we know it will not, because the number
of piles cannot exceed the size of the input. Let us get
a "proof" by runtime check. *)
val () = $effmask_exn assertloc (i <= num_elems)
in
links[pred q] := piles[pred i];
piles[pred i] := q;
if i = succ m then
loop {q + 1} (arr, succ q, piles, links, succ m)
else
loop {q + 1} (arr, succ q, piles, links, m)
end
 
val piles_tup = array_ptr_alloc<link_t> num_elems
macdef piles = !(piles_tup.2)
val () = array_initize_elt<link_t> (piles, num_elems, link_nil)
 
val links_tup = array_ptr_alloc<link_t> num_elems
macdef links = !(links_tup.2)
val () = array_initize_elt<link_t> (links, num_elems, link_nil)
 
val num_piles = loop (arr, one, piles, links, zero)
in
@(num_piles, piles_tup, links_tup)
end
 
fn {a : t@ype}
k_way_merge {ifirst, ilast : int | ifirst <= ilast}
{n : int | ilast < n}
{n_piles : int | ilast - ifirst + 1 <= n_piles}
{num_piles : pos | num_piles <= ilast - ifirst + 1}
{n_links : int | ilast - ifirst + 1 <= n_links}
(ifirst : size_t ifirst,
ilast : size_t ilast,
arr : &RD(array (a, n)),
num_piles : size_t num_piles,
piles : &array (link_t (ifirst, ilast), n_piles),
links : &array (link_t (ifirst, ilast), n_links))
:<!wrt> (* Return an array of indices into arr. *)
[p : addr]
array_tup_vt
([i : int | ifirst <= i; i <= ilast] size_t i,
p, ilast - ifirst + 1) =
(*
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.
*)
let
typedef link_t (i : int) = link_t (ifirst, ilast, i)
typedef link_t = [i : int] link_t i
 
val link_nil : link_t 0 = g1u2u 0u
 
typedef index_t (i : int) = [ifirst <= i; i <= ilast] size_t i
typedef index_t = [i : int] index_t i
 
val [total_external_nodes : int]
@(_ | total_external_nodes) = next_power_of_two num_piles
prval () = prop_verify {num_piles <= total_external_nodes} ()
 
stadef total_nodes = (2 * total_external_nodes) - 1
val total_nodes : size_t total_nodes =
pred (g1u2u 2u * total_external_nodes)
 
(* We will ignore index 0 of the winners tree arrays. *)
stadef winners_size = total_nodes + 1
val winners_size : size_t winners_size = succ total_nodes
 
val winners_values_tup = array_ptr_alloc<link_t> winners_size
macdef winners_values = !(winners_values_tup.2)
val () = array_initize_elt<link_t> (winners_values, winners_size,
link_nil)
 
val winners_links_tup = array_ptr_alloc<link_t> winners_size
macdef winners_links = !(winners_links_tup.2)
val () = array_initize_elt<link_t> (winners_links, winners_size,
link_nil)
 
(* - - - - - - - - - - - - - - - - - - - - - - - - - - *)
(* Record which pile a winner will have come from. *)
 
fun
init_pile_links
{i : nat | i <= num_piles}
.<num_piles - i>.
(winners_links : &array (link_t, winners_size),
i : size_t i)
:<!wrt> void =
if i <> num_piles then
begin
winners_links[total_external_nodes + i] := succ i;
init_pile_links (winners_links, succ i)
end
 
val () = init_pile_links (winners_links, g1u2u 0u)
 
(* - - - - - - - - - - - - - - - - - - - - - - - - - - *)
(* The top of each pile becomes a starting competitor. *)
 
fun
init_competitors
{i : nat | i <= num_piles}
.<num_piles - i>.
(winners_values : &array (link_t, winners_size),
piles : &array (link_t, n_piles),
i : size_t i)
:<!wrt> void =
if i <> num_piles then
begin
winners_values[total_external_nodes + i] := piles[i];
init_competitors (winners_values, piles, succ i)
end
val () = init_competitors (winners_values, piles, g1u2u 0u)
 
(* - - - - - - - - - - - - - - - - - - - - - - - - - - *)
(* Discard the top of each pile. *)
 
fun
discard_tops {i : nat | i <= num_piles}
.<num_piles - i>.
(piles : &array (link_t, n_piles),
links : &array (link_t, n_links),
i : size_t i)
:<!wrt> void =
if i <> num_piles then
let
val link = piles[i]
 
(* None of the piles should have been empty. *)
val () = $effmask_exn assertloc (link <> g1u2u 0u)
in
piles[i] := links[pred link];
discard_tops (piles, links, succ i)
end
 
val () = discard_tops (piles, links, g1u2u 0u)
 
(* - - - - - - - - - - - - - - - - - - - - - - - - - - *)
(* How to play a game. *)
fn
play_game {i : int | 2 <= i; i <= total_nodes}
(arr : &RD(array (a, n)),
winners_values : &array (link_t, winners_size),
i : size_t i)
:<> [iwinner : pos | iwinner <= total_nodes]
size_t iwinner =
let
macdef lt = patience_sort$lt<a>
 
fn
find_opponent {i : int | 2 <= i; i <= total_nodes}
(i : size_t i)
:<> [j : int | 2 <= j; j <= total_nodes]
size_t j =
let
(* The prelude contains bitwise operations only for
non-dependent unsigned integer. We will not bother to
add them ourselves, but instead go back and forth
between dependent and non-dependent. *)
val i0 = g0ofg1 i
val j0 = g0uint_lxor<size_kind> (i0, g0u2u 1u)
val j = g1ofg0 j0
 
(* We have no proof the opponent is in the proper
range. Create a "proof" by runtime checks. *)
val () = $effmask_exn assertloc (g1u2u 2u <= j)
val () = $effmask_exn assertloc (j <= total_nodes)
in
j
end
 
val j = find_opponent i
val winner_i = winners_values[i]
and winner_j = winners_values[j]
in
if winner_i = link_nil then
j
else if winner_j = link_nil then
i
else
let
val i1 = pred winner_i + ifirst
and i2 = pred winner_j + ifirst
prval () = lemma_g1uint_param i1
prval () = lemma_g1uint_param i2
in
if arr[i2] \lt arr[i1] then j else i
end
end
 
(* - - - - - - - - - - - - - - - - - - - - - - - - - - *)
 
fun
build_tree {istart : pos | istart <= total_external_nodes}
.<istart>.
(arr : &RD(array (a, n)),
winners_values : &array (link_t, winners_size),
winners_links : &array (link_t, winners_size),
istart : size_t istart)
:<!wrt> void =
if istart <> 1 then
let
fun
play_initial_games
{i : int | istart <= i; i <= (2 * istart) + 1}
.<(2 * istart) + 1 - i>.
(arr : &RD(array (a, n)),
winners_values : &array (link_t, winners_size),
winners_links : &array (link_t, winners_size),
i : size_t i)
:<!wrt> void =
if i <= pred (istart + istart) then
let
val iwinner = play_game (arr, winners_values, i)
and i2 = i / g1u2u 2u
in
winners_values[i2] := winners_values[iwinner];
winners_links[i2] := winners_links[iwinner];
play_initial_games (arr, winners_values,
winners_links, succ (succ i))
end
in
play_initial_games (arr, winners_values, winners_links,
istart);
build_tree (arr, winners_values, winners_links,
istart / g1u2u 2u)
end
 
val () = build_tree (arr, winners_values, winners_links,
total_external_nodes)
 
(* - - - - - - - - - - - - - - - - - - - - - - - - - - *)
 
fun
replay_games {i : pos | i <= total_nodes}
.<i>.
(arr : &RD(array (a, n)),
winners_values : &array (link_t, winners_size),
winners_links : &array (link_t, winners_size),
i : size_t i)
:<!wrt> void =
if i <> g1u2u 1u then
let
val iwinner = play_game (arr, winners_values, i)
and i2 = i / g1u2u 2u
in
winners_values[i2] := winners_values[iwinner];
winners_links[i2] := winners_links[iwinner];
replay_games (arr, winners_values, winners_links, i2)
end
 
stadef num_elems = ilast - ifirst + 1
val num_elems : size_t num_elems = succ (ilast - ifirst)
 
val sorted_tup = array_ptr_alloc<index_t> num_elems
 
fun
merge {isorted : nat | isorted <= num_elems}
{p_sorted : addr}
.<num_elems - isorted>.
(pf_sorted : !array_v (index_t?, p_sorted,
num_elems - isorted)
>> array_v (index_t, p_sorted,
num_elems - isorted) |
arr : &RD(array (a, n)),
piles : &array (link_t, n_piles),
links : &array (link_t, n_links),
winners_values : &array (link_t, winners_size),
winners_links : &array (link_t, winners_size),
p_sorted : ptr p_sorted,
isorted : size_t isorted)
:<!wrt> void =
(* This function not only fills in the "sorted_tup" array, but
transforms it from "uninitialized" to "initialized". *)
if isorted <> num_elems then
let
prval @(pf_elem, pf_rest) = array_v_uncons pf_sorted
val winner = winners_values[1]
val () = $effmask_exn assertloc (winner <> link_nil)
val () = !p_sorted := pred winner + ifirst
 
(* Move to the next element in the winner's pile. *)
val ilink = winners_links[1]
val () = $effmask_exn assertloc (ilink <> link_nil)
val inext = piles[pred ilink]
val () = (if inext <> link_nil then
piles[pred ilink] := links[pred inext])
 
(* Replay games, with the new element as a competitor. *)
val i = (total_nodes / g1u2u 2u) + ilink
val () = $effmask_exn assertloc (i <= total_nodes)
val () = winners_values[i] := inext
val () =
replay_games (arr, winners_values, winners_links, i)
 
val () = merge (pf_rest | arr, piles, links,
winners_values, winners_links,
ptr_succ<index_t> p_sorted,
succ isorted)
prval () = pf_sorted := array_v_cons (pf_elem, pf_rest)
in
end
else
let
prval () = pf_sorted :=
array_v_unnil_nil{index_t?, index_t} pf_sorted
in
end
 
val () = merge (sorted_tup.0 | arr, piles, links,
winners_values, winners_links,
sorted_tup.2, i2sz 0)
 
val () = array_ptr_free (winners_values_tup.0,
winners_values_tup.1 |
winners_values_tup.2)
val () = array_ptr_free (winners_links_tup.0,
winners_links_tup.1 |
winners_links_tup.2)
in
sorted_tup
end
 
implement {a}
patience_sort (arr, ifirst, len) =
let
prval () = lemma_g1uint_param ifirst
prval () = lemma_g1uint_param len
in
if len = i2sz 0 then
let
val sorted_tup = array_ptr_alloc<size_t 0> len
prval () = sorted_tup.0 :=
array_v_unnil_nil{Size_t?, Size_t} sorted_tup.0
in
sorted_tup
end
else
let
val ilast = ifirst + pred len
val @(num_piles, piles_tup, links_tup) =
deal<a> (ifirst, ilast, arr)
macdef piles = !(piles_tup.2)
macdef links = !(links_tup.2)
prval () = lemma_g1uint_param num_piles
val () = $effmask_exn assertloc (num_piles <> i2sz 0)
val sorted_tup = k_way_merge<a> (ifirst, ilast, arr,
num_piles, piles, links)
in
array_ptr_free (piles_tup.0, piles_tup.1 | piles_tup.2);
array_ptr_free (links_tup.0, links_tup.1 | links_tup.2);
sorted_tup
end
end
 
(*------------------------------------------------------------------*)
 
fn
int_patience_sort_ascending
{ifirst, len : int | 0 <= ifirst}
{n : int | ifirst + len <= n}
(arr : &RD(array (int, n)),
ifirst : size_t ifirst,
len : size_t len)
:<!wrt> [p : addr]
array_tup_vt
([i : int | len == 0 ||
(ifirst <= i && i < ifirst + len)] size_t i,
p, len) =
let
implement
patience_sort$lt<int> (x, y) =
x < y
in
patience_sort<int> (arr, ifirst, len)
end
 
fn {a : t@ype}
find_length {n : int}
(lst : list (a, n))
:<> [m : int | m == n] size_t m =
let
prval () = lemma_list_param lst
in
g1i2u (length lst)
end
 
implement
main0 () =
let
val example_list =
$list (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)
 
val ifirst = i2sz 10
val [len : int] len = find_length example_list
 
#define ARRSZ 100
val () = assertloc (i2sz 10 + len <= ARRSZ)
 
var arr : array (int, ARRSZ)
val () = array_initize_elt<int> (arr, i2sz ARRSZ, 0)
 
prval @(pf_left, pf_right) =
array_v_split {int} {..} {ARRSZ} {10} (view@ arr)
prval @(pf_middle, pf_right) =
array_v_split {int} {..} {90} {len} pf_right
 
val p = ptr_add<int> (addr@ arr, 10)
val () = array_copy_from_list<int> (!p, example_list)
 
prval pf_right = array_v_unsplit (pf_middle, pf_right)
prval () = view@ arr := array_v_unsplit (pf_left, pf_right)
 
val @(pf_sorted, pfgc_sorted | p_sorted) =
int_patience_sort_ascending (arr, i2sz 10, len)
 
macdef sorted = !p_sorted
 
var i : [i : nat | i <= len] size_t i
in
print! ("unsorted ");
for (i := i2sz 0; i <> len; i := succ i)
print! (" ", arr[i2sz 10 + i]);
println! ();
 
print! ("sorted ");
for (i := i2sz 0; i <> len; i := succ i)
print! (" ", arr[sorted[i]]);
println! ();
 
array_ptr_free (pf_sorted, pfgc_sorted | p_sorted)
end
 
(*------------------------------------------------------------------*)</syntaxhighlight>
 
{{out}}
<pre>$ patscc -O3 -DATS_MEMALLOC_LIBC patience_sort_task.dats && ./a.out
unsorted 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
sorted 2 4 8 15 22 22 37 38 46 48 49 53 54 54 58 70 72 76 80 82 84 86 90 93 98</pre>
 
===A patience sort for arrays of non-linear elements (second version)===
{{trans|Fortran}}
 
 
This version of the sort (which I derived from the first) has a more primitive "core" implementation, and a wrapper around that. The "core" requires that the user pass workspace to it (much as Fortran 77 procedures often do). The wrapper uses stack storage for the workspaces, if the sorted subarray is small; otherwise it uses malloc. One may be interested in contrasting the branch that uses stack storage with the branch that uses malloc.
 
<syntaxhighlight lang="ats">(* A version of the patience sort that uses arrays passed to it as its
workspace, and returns the results in an array passed to it.
 
This way, the arrays could be reused between calls, or easily put
on the stack if they are not too large, yet still allocated if they
are larger than that.
 
Notice that the work arrays both start *and finish* as
uninitialized storage. *)
 
(*------------------------------------------------------------------*)
 
#include "share/atspre_staload.hats"
 
(* ================================================================ *)
(* Interface declarations that really should be moved to a .sats *)
(* file. *)
 
stadef patience_sort_index (ifirst : int, len : int, i : int) =
len == 0 || (ifirst <= i && i < ifirst + len)
typedef patience_sort_index (ifirst : int, len : int, i : int) =
[patience_sort_index (ifirst, len, i)] size_t i
typedef patience_sort_index (ifirst : int, len : int) =
[i : int] patience_sort_index (ifirst, len, i)
 
stadef patience_sort_link (ifirst : int, len : int, i : int) =
0 <= i && i <= len
typedef patience_sort_link (ifirst : int, len : int, i : int) =
[patience_sort_link (ifirst, len, i)] size_t i
typedef patience_sort_link (ifirst : int, len : int) =
[i : int] patience_sort_link (ifirst, len, i)
 
(* patience_sort$lt : the order predicate for patience sort. *)
extern fn {a : t@ype}
patience_sort$lt (x : a, y : a) :<> bool
 
local
 
typedef index_t (ifirst : int, len : int) =
patience_sort_index (ifirst, len)
typedef link_t (ifirst : int, len : int) =
patience_sort_link (ifirst, len)
 
in
 
extern fn {a : t@ype}
patience_sort_given_workspaces
{ifirst, len : int | 0 <= ifirst}
{n : int | ifirst + len <= n}
{power : int | len <= power}
{n_piles : int | len <= n_piles}
{n_links : int | len <= n_links}
{n_winv : int | 2 * power <= n_winv}
{n_winl : int | 2 * power <= n_winl}
(pf_exp2 : [exponent : nat] EXP2 (exponent, power) |
arr : &RD(array (a, n)),
ifirst : size_t ifirst,
len : size_t len,
power : size_t power,
piles : &array (link_t (ifirst, len)?, n_piles) >> _,
links : &array (link_t (ifirst, len)?, n_links) >> _,
winvals : &array (link_t (ifirst, len)?, n_winv) >> _,
winlinks : &array (link_t (ifirst, len)?, n_winl) >> _,
sorted : &array (index_t (ifirst, len)?, len)
>> array (index_t (ifirst, len), len))
:<!wrt> void
 
extern fn {a : t@ype}
patience_sort_with_its_own_workspaces
{ifirst, len : int | 0 <= ifirst}
{n : int | ifirst + len <= n}
(arr : &RD(array (a, n)),
ifirst : size_t ifirst,
len : size_t len,
sorted : &array (index_t (ifirst, len)?, len)
>> array (index_t (ifirst, len), len))
:<!wrt> void
 
end
 
overload patience_sort with patience_sort_given_workspaces
overload patience_sort with patience_sort_with_its_own_workspaces
 
extern fn {tk : tkind}
next_power_of_two
{i : pos}
(i : g1uint (tk, i))
:<> [k : int | i <= k; k < 2 * i]
[n : nat]
@(EXP2 (n, k) | g1uint (tk, k))
 
(* ================================================================ *)
(* What follows is implementation and belongs in .dats files. *)
 
(*------------------------------------------------------------------*)
(*
 
In the following implementation of next_power_of_two:
 
* I implement it as a template for all types of kind g1uint. This
includes dependent forms of uint, usint, ulint, ullint, size_t,
and yet more types in the prelude; also whatever others one may
create.
 
* I prove the result is not less than the input.
 
* I prove the result is less than twice the input.
 
* I prove the result is a power of two. This last proof is
provided in the form of an EXP2 prop.
 
* I do NOT return what number two is raised to (though I easily
could have). I leave that number "existentially defined". In
other words, I prove only that some such non-negative number
exists.
 
*)
 
implement {tk}
next_power_of_two {i} (i) =
let
(* This is not the fastest implementation, although it does verify
its own correctness. *)
 
val one : g1uint (tk, 1) = g1u2u 1u
 
fun
loop {j : pos | j < i} .<i + i - j>.
(pf : [n : nat] EXP2 (n, j) |
j : g1uint (tk, j))
:<> [k : int | i <= k; k < 2 * i]
[n : nat]
@(EXP2 (n, k) | g1uint (tk, k)) =
let
val j2 = j + j
in
if i <= j2 then
@(EXP2ind pf | j2)
else
loop (EXP2ind pf | j2)
end
in
if i = one then
@(EXP2bas () | one)
else
loop (EXP2bas () | one)
end
 
(*------------------------------------------------------------------*)
 
extern praxi {a : vt@ype}
array_uninitize_without_doing_anything
{n : int}
(arr : &array (INV(a), n) >> array (a?, n),
asz : size_t n)
:<prf> void
 
(*------------------------------------------------------------------*)
 
stadef index_t (ifirst : int, len : int, i : int) =
patience_sort_index (ifirst, len, i)
typedef index_t (ifirst : int, len : int, i : int) =
patience_sort_index (ifirst, len, i)
typedef index_t (ifirst : int, len : int) =
patience_sort_index (ifirst, len)
 
stadef link_t (ifirst : int, len : int, i : int) =
patience_sort_link (ifirst, len, i)
typedef link_t (ifirst : int, len : int, i : int) =
patience_sort_link (ifirst, len, i)
typedef link_t (ifirst : int, len : int) =
patience_sort_link (ifirst, len)
 
fn {a : t@ype}
find_pile {ifirst, len : int}
{n : int | ifirst + len <= n}
{num_piles : nat | num_piles <= len}
{n_piles : int | len <= n_piles}
{q : pos | q <= len}
(ifirst : size_t ifirst,
arr : &RD(array (a, n)),
num_piles : size_t num_piles,
piles : &RD(array (link_t (ifirst, len), n_piles)),
q : size_t q)
:<> [i : pos | i <= num_piles + 1]
size_t i =
(*
Bottenbruch search for the leftmost pile whose top is greater than
or equal to the next value dealt by "deal".
 
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
*)
if num_piles = i2sz 0 then
i2sz 1
else
let
macdef lt = patience_sort$lt<a>
 
prval () = lemma_g1uint_param ifirst
prval () = prop_verify {0 <= ifirst} ()
 
fun
loop {j, k : nat | j <= k; k < num_piles}
.<k - j>.
(arr : &RD(array (a, n)),
piles : &array (link_t (ifirst, len), n_piles),
j : size_t j,
k : size_t k)
:<> [i : pos | i <= num_piles + 1]
size_t i =
if j = k then
begin
if succ j <> num_piles then
succ j
else
let
val piles_j = piles[j]
val () = $effmask_exn assertloc (piles_j <> g1u2u 0u)
 
val x1 = arr[pred q + ifirst]
and x2 = arr[pred piles_j + ifirst]
in
if x2 \lt x1 then
succ (succ j)
else
succ j
end
end
else
let
typedef index (i : int) = [0 <= i; i < n] size_t i
typedef index = [i : int] index i
 
stadef i = j + ((k - j) / 2)
val i : size_t i = j + ((k - j) / g1u2u 2u)
 
val piles_j = piles[j]
val () = $effmask_exn assertloc (piles_j <> g1u2u 0u)
 
val x1 = arr[pred q + ifirst]
and x2 = arr[pred piles_j + ifirst]
in
if x2 \lt x1 then
loop (arr, piles, i + 1, k)
else
loop (arr, piles, j, i)
end
in
loop (arr, piles, g1u2u 0u, pred num_piles)
end
 
fn {a : t@ype}
deal {ifirst, len : int}
{n : int | ifirst + len <= n}
(ifirst : size_t ifirst,
len : size_t len,
arr : &RD(array (a, n)),
piles : &array (link_t (ifirst, len)?, len)
>> array (link_t (ifirst, len), len),
links : &array (link_t (ifirst, len)?, len)
>> array (link_t (ifirst, len), len))
:<!wrt> [num_piles : int | num_piles <= len]
size_t num_piles =
let
prval () = lemma_g1uint_param ifirst
prval () = lemma_g1uint_param len
 
typedef link_t (i : int) = link_t (ifirst, len, i)
typedef link_t = link_t (ifirst, len)
 
val zero : size_t 0 = g1u2u 0u
val one : size_t 1 = g1u2u 1u
val link_nil : link_t 0 = g1u2u 0u
 
fun
loop {q : pos | q <= len + 1}
{m : nat | m <= len}
.<len + 1 - q>.
(arr : &RD(array (a, n)),
q : size_t q,
piles : &array (link_t, len) >> _,
links : &array (link_t, len) >> _,
m : size_t m)
:<!wrt> [num_piles : nat | num_piles <= len]
size_t num_piles =
if q = succ (len) then
m
else
let
val i = find_pile {ifirst, len} (ifirst, arr, m, piles, q)
 
(* We have no proof the number of elements will not exceed
storage. However, we know it will not, because the number
of piles cannot exceed the size of the input. Let us get
a "proof" by runtime check. *)
val () = $effmask_exn assertloc (i <= len)
in
links[pred q] := piles[pred i];
piles[pred i] := q;
if i = succ m then
loop {q + 1} (arr, succ q, piles, links, succ m)
else
loop {q + 1} (arr, succ q, piles, links, m)
end
in
array_initize_elt<link_t> (piles, len, link_nil);
array_initize_elt<link_t> (links, len, link_nil);
loop (arr, one, piles, links, zero)
end
 
fn {a : t@ype}
k_way_merge {ifirst, len : int}
{n : int | ifirst + len <= n}
{num_piles : pos | num_piles <= len}
{power : int | len <= power}
(pf_exp2 : [exponent : nat] EXP2 (exponent, power) |
arr : &RD(array (a, n)),
ifirst : size_t ifirst,
len : size_t len,
num_piles : size_t num_piles,
power : size_t power,
piles : &array (link_t (ifirst, len), len) >> _,
links : &RD(array (link_t (ifirst, len), len)),
winvals : &array (link_t (ifirst, len)?, 2 * power)
>> _,
winlinks : &array (link_t (ifirst, len)?, 2 * power)
>> _,
sorted : &array (index_t (ifirst, len)?, len)
>> array (index_t (ifirst, len), len))
:<!wrt> void =
(*
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.
*)
let
prval () = lemma_g1uint_param ifirst
prval () = lemma_g1uint_param len
 
typedef link_t (i : int) = link_t (ifirst, len, i)
typedef link_t = link_t (ifirst, len)
 
val link_nil : link_t 0 = g1u2u 0u
 
typedef index_t (i : int) = index_t (ifirst, len, i)
typedef index_t = index_t (ifirst, len)
 
val [total_external_nodes : int]
@(_ | total_external_nodes) = next_power_of_two num_piles
prval () = prop_verify {num_piles <= total_external_nodes} ()
 
stadef total_nodes = (2 * total_external_nodes) - 1
val total_nodes : size_t total_nodes =
pred (g1u2u 2u * total_external_nodes)
 
(* We will ignore index 0 of the winners tree arrays. *)
stadef winners_size = total_nodes + 1
val winners_size : size_t winners_size = succ total_nodes
 
(* An exercise for the reader is to write a proof that
winners_size <= 2 * power, so one can get rid of the
runtime assertion here: *)
val () = $effmask_exn assertloc (winners_size <= 2 * power)
 
prval @(winvals_left, winvals_right) =
array_v_split {link_t?} {..} {2 * power} {winners_size}
(view@ winvals)
prval () = view@ winvals := winvals_left
 
prval @(winlinks_left, winlinks_right) =
array_v_split {link_t?} {..} {2 * power} {winners_size}
(view@ winlinks)
prval () = view@ winlinks := winlinks_left
 
val () = array_initize_elt<link_t> (winvals, winners_size,
link_nil)
val () = array_initize_elt<link_t> (winlinks, winners_size,
link_nil)
 
 
(* - - - - - - - - - - - - - - - - - - - - - - - - - - *)
(* Record which pile a winner will have come from. *)
 
fun
init_pile_links
{i : nat | i <= num_piles}
.<num_piles - i>.
(winlinks : &array (link_t, winners_size),
i : size_t i)
:<!wrt> void =
if i <> num_piles then
begin
winlinks[total_external_nodes + i] := succ i;
init_pile_links (winlinks, succ i)
end
 
val () = init_pile_links (winlinks, g1u2u 0u)
 
(* - - - - - - - - - - - - - - - - - - - - - - - - - - *)
(* The top of each pile becomes a starting competitor. *)
 
fun
init_competitors
{i : nat | i <= num_piles}
.<num_piles - i>.
(winvals : &array (link_t, winners_size),
piles : &array (link_t, len),
i : size_t i)
:<!wrt> void =
if i <> num_piles then
begin
winvals[total_external_nodes + i] := piles[i];
init_competitors (winvals, piles, succ i)
end
val () = init_competitors (winvals, piles, g1u2u 0u)
 
(* - - - - - - - - - - - - - - - - - - - - - - - - - - *)
(* Discard the top of each pile. *)
 
fun
discard_tops {i : nat | i <= num_piles}
.<num_piles - i>.
(piles : &array (link_t, len),
links : &array (link_t, len),
i : size_t i)
:<!wrt> void =
if i <> num_piles then
let
val link = piles[i]
 
(* None of the piles should have been empty. *)
val () = $effmask_exn assertloc (link <> g1u2u 0u)
in
piles[i] := links[pred link];
discard_tops (piles, links, succ i)
end
 
val () = discard_tops (piles, links, g1u2u 0u)
 
(* - - - - - - - - - - - - - - - - - - - - - - - - - - *)
(* How to play a game. *)
fn
play_game {i : int | 2 <= i; i <= total_nodes}
(arr : &RD(array (a, n)),
winvals : &array (link_t, winners_size),
i : size_t i)
:<> [iwinner : pos | iwinner <= total_nodes]
size_t iwinner =
let
macdef lt = patience_sort$lt<a>
 
fn
find_opponent {i : int | 2 <= i; i <= total_nodes}
(i : size_t i)
:<> [j : int | 2 <= j; j <= total_nodes]
size_t j =
let
(* The prelude contains bitwise operations only for
non-dependent unsigned integer. We will not bother to
add them ourselves, but instead go back and forth
between dependent and non-dependent. *)
val i0 = g0ofg1 i
val j0 = g0uint_lxor<size_kind> (i0, g0u2u 1u)
val j = g1ofg0 j0
 
(* We have no proof the opponent is in the proper
range. Create a "proof" by runtime checks. *)
val () = $effmask_exn assertloc (g1u2u 2u <= j)
val () = $effmask_exn assertloc (j <= total_nodes)
in
j
end
 
val j = find_opponent i
val winner_i = winvals[i]
and winner_j = winvals[j]
in
if winner_i = link_nil then
j
else if winner_j = link_nil then
i
else
let
val i1 = pred winner_i + ifirst
and i2 = pred winner_j + ifirst
prval () = lemma_g1uint_param i1
prval () = lemma_g1uint_param i2
in
if arr[i2] \lt arr[i1] then j else i
end
end
 
(* - - - - - - - - - - - - - - - - - - - - - - - - - - *)
 
fun
build_tree {istart : pos | istart <= total_external_nodes}
.<istart>.
(arr : &RD(array (a, n)),
winvals : &array (link_t, winners_size),
winlinks : &array (link_t, winners_size),
istart : size_t istart)
:<!wrt> void =
if istart <> 1 then
let
fun
play_initial_games
{i : int | istart <= i; i <= (2 * istart) + 1}
.<(2 * istart) + 1 - i>.
(arr : &RD(array (a, n)),
winvals : &array (link_t, winners_size),
winlinks : &array (link_t, winners_size),
i : size_t i)
:<!wrt> void =
if i <= pred (istart + istart) then
let
val iwinner = play_game (arr, winvals, i)
and i2 = i / g1u2u 2u
in
winvals[i2] := winvals[iwinner];
winlinks[i2] := winlinks[iwinner];
play_initial_games (arr, winvals, winlinks,
succ (succ i))
end
in
play_initial_games (arr, winvals, winlinks, istart);
build_tree (arr, winvals, winlinks, istart / g1u2u 2u)
end
 
val () = build_tree (arr, winvals, winlinks, total_external_nodes)
 
(* - - - - - - - - - - - - - - - - - - - - - - - - - - *)
 
fun
replay_games {i : pos | i <= total_nodes}
.<i>.
(arr : &RD(array (a, n)),
winvals : &array (link_t, winners_size),
winlinks : &array (link_t, winners_size),
i : size_t i)
:<!wrt> void =
if i <> g1u2u 1u then
let
val iwinner = play_game (arr, winvals, i)
and i2 = i / g1u2u 2u
in
winvals[i2] := winvals[iwinner];
winlinks[i2] := winlinks[iwinner];
replay_games (arr, winvals, winlinks, i2)
end
 
fun
merge {isorted : nat | isorted <= len}
{p_sorted : addr}
.<len - isorted>.
(pf_sorted : !array_v (index_t?, p_sorted,
len - isorted)
>> array_v (index_t, p_sorted,
len - isorted) |
arr : &RD(array (a, n)),
piles : &array (link_t, len),
links : &array (link_t, len),
winvals : &array (link_t, winners_size),
winlinks : &array (link_t, winners_size),
p_sorted : ptr p_sorted,
isorted : size_t isorted)
:<!wrt> void =
(* This function not only fills in the "sorted" array, but
transforms it from "uninitialized" to "initialized". *)
if isorted <> len then
let
prval @(pf_elem, pf_rest) = array_v_uncons pf_sorted
val winner = winvals[1]
val () = $effmask_exn assertloc (winner <> link_nil)
val () = !p_sorted := pred winner + ifirst
 
(* Move to the next element in the winner's pile. *)
val ilink = winlinks[1]
val () = $effmask_exn assertloc (ilink <> link_nil)
val inext = piles[pred ilink]
val () = (if inext <> link_nil then
piles[pred ilink] := links[pred inext])
 
(* Replay games, with the new element as a competitor. *)
val i = (total_nodes / g1u2u 2u) + ilink
val () = $effmask_exn assertloc (i <= total_nodes)
val () = winvals[i] := inext
val () = replay_games (arr, winvals, winlinks, i)
 
val () = merge (pf_rest |
arr, piles, links, winvals, winlinks,
ptr_succ<index_t> p_sorted, succ isorted)
prval () = pf_sorted := array_v_cons (pf_elem, pf_rest)
in
end
else
let
prval () = pf_sorted :=
array_v_unnil_nil{index_t?, index_t} pf_sorted
in
end
 
val () = merge (view@ sorted |
arr, piles, links, winvals, winlinks,
addr@ sorted, i2sz 0)
 
prval () =
array_uninitize_without_doing_anything<link_t>
(winvals, winners_size)
prval () =
array_uninitize_without_doing_anything<link_t>
(winlinks, winners_size)
prval () = view@ winvals :=
array_v_unsplit (view@ winvals, winvals_right)
prval () = view@ winlinks :=
array_v_unsplit (view@ winlinks, winlinks_right)
in
end
 
implement {a}
patience_sort_given_workspaces
{ifirst, len} {n} {power}
{n_piles} {n_links} {n_winv} {n_winl}
(pf_exp2 | arr, ifirst, len, power,
piles, links, winvals, winlinks,
sorted) =
let
prval () = lemma_g1uint_param ifirst
prval () = lemma_g1uint_param len
 
typedef index_t = index_t (ifirst, len)
typedef link_t = link_t (ifirst, len)
in
if len = i2sz 0 then
let
prval () = view@ sorted :=
array_v_unnil_nil{index_t?, index_t} (view@ sorted)
in
end
else
let
prval @(piles_left, piles_right) =
array_v_split {link_t?} {..} {n_piles} {len} (view@ piles)
prval () = view@ piles := piles_left
 
prval @(links_left, links_right) =
array_v_split {link_t?} {..} {n_links} {len} (view@ links)
prval () = view@ links := links_left
 
prval @(winvals_left, winvals_right) =
array_v_split {link_t?} {..} {n_winv} {2 * power}
(view@ winvals)
prval () = view@ winvals := winvals_left
 
prval @(winlinks_left, winlinks_right) =
array_v_split {link_t?} {..} {n_winl} {2 * power}
(view@ winlinks)
prval () = view@ winlinks := winlinks_left
 
val num_piles =
deal {ifirst, len} {n} (ifirst, len, arr, piles, links)
prval () = lemma_g1uint_param num_piles
val () = $effmask_exn assertloc (num_piles <> i2sz 0)
 
val () =
k_way_merge {ifirst, len} {n} {..} {power}
(pf_exp2 | arr, ifirst, len, num_piles, power,
piles, links, winvals, winlinks,
sorted)
 
prval () =
array_uninitize_without_doing_anything<link_t>
(piles, len)
prval () =
array_uninitize_without_doing_anything<link_t>
(links, len)
 
prval () = view@ piles :=
array_v_unsplit (view@ piles, piles_right)
prval () = view@ links :=
array_v_unsplit (view@ links, links_right)
prval () = view@ winvals :=
array_v_unsplit (view@ winvals, winvals_right)
prval () = view@ winlinks :=
array_v_unsplit (view@ winlinks, winlinks_right)
in
end
end
 
(* ================================================================ *)
(* An interface that provides the workspaces. If the subarray to *)
(* be sorted is small enough, stack storage will be used. *)
 
#define LEN_THRESHOLD 128
#define WINNERS_SIZE 256
 
prval () = prop_verify {WINNERS_SIZE == 2 * LEN_THRESHOLD} ()
 
local
prval pf_exp2 = EXP2bas () (* 1*)
prval pf_exp2 = EXP2ind pf_exp2 (* 2 *)
prval pf_exp2 = EXP2ind pf_exp2 (* 4 *)
prval pf_exp2 = EXP2ind pf_exp2 (* 8 *)
prval pf_exp2 = EXP2ind pf_exp2 (* 16 *)
prval pf_exp2 = EXP2ind pf_exp2 (* 32 *)
prval pf_exp2 = EXP2ind pf_exp2 (* 64 *)
prval pf_exp2 = EXP2ind pf_exp2 (* 128 *)
in
prval pf_exp2_for_stack_storage = pf_exp2
end
 
implement {a}
patience_sort_with_its_own_workspaces
{ifirst, len} {n} (arr, ifirst, len, sorted) =
let
prval () = lemma_g1uint_param ifirst
prval () = lemma_g1uint_param len
 
typedef link_t = link_t (ifirst, len)
 
fn
sort {ifirst, len : int | 0 <= ifirst}
{n : int | ifirst + len <= n}
{power : int | len <= power}
{n_piles : int | len <= n_piles}
{n_links : int | len <= n_links}
{n_winv : int | 2 * power <= n_winv}
{n_winl : int | 2 * power <= n_winl}
(pf_exp2 : [exponent : nat] EXP2 (exponent, power) |
arr : &RD(array (a, n)),
ifirst : size_t ifirst,
len : size_t len,
power : size_t power,
piles : &array (link_t (ifirst, len)?, n_piles) >> _,
links : &array (link_t (ifirst, len)?, n_links) >> _,
winvals : &array (link_t (ifirst, len)?, n_winv) >> _,
winlinks : &array (link_t (ifirst, len)?, n_winl) >> _,
sorted : &array (index_t (ifirst, len)?, len)
>> array (index_t (ifirst, len), len))
:<!wrt> void =
patience_sort_given_workspaces<a>
{ifirst, len} {n} {power}
{n_piles} {n_links} {n_winv} {n_winl}
(pf_exp2 | arr, ifirst, len, power, piles, links,
winvals, winlinks, sorted)
in
if len <= i2sz LEN_THRESHOLD then
let
var piles : array (link_t?, LEN_THRESHOLD)
var links : array (link_t?, LEN_THRESHOLD)
var winvals : array (link_t?, WINNERS_SIZE)
var winlinks : array (link_t?, WINNERS_SIZE)
in
sort (pf_exp2_for_stack_storage |
arr, ifirst, len, i2sz LEN_THRESHOLD,
piles, links, winvals, winlinks, sorted)
end
else
let
val @(pf_piles, pfgc_piles | p_piles) =
array_ptr_alloc<link_t> len
val @(pf_links, pfgc_links | p_links) =
array_ptr_alloc<link_t> len
 
val @(pf_exp2 | power) = next_power_of_two<size_kind> len
 
val @(pf_winvals, pfgc_winvals | p_winvals) =
array_ptr_alloc<link_t> (power + power)
val @(pf_winlinks, pfgc_winlinks | p_winlinks) =
array_ptr_alloc<link_t> (power + power)
 
macdef piles = !p_piles
macdef links = !p_links
macdef winvals = !p_winvals
macdef winlinks = !p_winlinks
in
sort (pf_exp2 |
arr, ifirst, len, power, piles, links,
winvals, winlinks, sorted);
array_ptr_free (pf_piles, pfgc_piles | p_piles);
array_ptr_free (pf_links, pfgc_links | p_links);
array_ptr_free (pf_winvals, pfgc_winvals | p_winvals);
array_ptr_free (pf_winlinks, pfgc_winlinks | p_winlinks)
end
end
 
(* ================================================================ *)
(* A demonstration program. *)
 
fn {a : t@ype}
find_length {n : int}
(lst : list (a, n))
:<> [m : int | m == n] size_t m =
let
prval () = lemma_list_param lst
in
g1i2u (length lst)
end
 
implement
main0 () =
let
implement
patience_sort$lt<int> (x, y) =
x < y
 
val example_list =
$list (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)
 
val ifirst = i2sz 10
val [len : int] len = find_length example_list
 
#define ARRSZ 100
val () = assertloc (i2sz 10 + len <= ARRSZ)
 
var arr : array (int, ARRSZ)
val () = array_initize_elt<int> (arr, i2sz ARRSZ, 0)
 
prval @(pf_left, pf_right) =
array_v_split {int} {..} {ARRSZ} {10} (view@ arr)
prval @(pf_middle, pf_right) =
array_v_split {int} {..} {90} {len} pf_right
 
val p = ptr_add<int> (addr@ arr, 10)
val () = array_copy_from_list<int> (!p, example_list)
 
prval pf_right = array_v_unsplit (pf_middle, pf_right)
prval () = view@ arr := array_v_unsplit (pf_left, pf_right)
 
typedef index_t = patience_sort_index (10, len)
 
var sorted : array (index_t, ARRSZ)
val () = array_initize_elt<index_t> (sorted, i2sz ARRSZ,
g1u2u 10u)
prval @(sorted_left, sorted_right) =
array_v_split {index_t} {..} {ARRSZ} {len} (view@ sorted)
prval () = view@ sorted := sorted_left
 
val () = patience_sort<int> (arr, i2sz 10, len, sorted)
 
prval () = view@ sorted :=
array_v_unsplit (view@ sorted, sorted_right)
 
var i : [i : nat | i <= len] size_t i
in
print! ("unsorted ");
for (i := i2sz 0; i <> len; i := succ i)
print! (" ", arr[i2sz 10 + i]);
println! ();
 
print! ("sorted ");
for (i := i2sz 0; i <> len; i := succ i)
print! (" ", arr[sorted[i]]);
println! ()
end
 
(*------------------------------------------------------------------*)</syntaxhighlight>
 
{{out}}
<pre>$ patscc -O3 -DATS_MEMALLOC_LIBC patience_sort_task_provided_storage.dats && ./a.out
unsorted 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
sorted 2 4 8 15 22 22 37 38 46 48 49 53 54 54 58 70 72 76 80 82 84 86 90 93 98</pre>
 
===A patience sort for non-linear lists of integers, guaranteeing a sorted result===
 
This implementation borrows code from a [[Merge_sort#A_mergesort_for_non-linear_lists_of_integers.2C_guaranteeing_a_sorted_result|mergesort]] that also guarantees a sorted result.
 
The mergesort proves the result has the same length as the original, but this patience sort does not.
 
<syntaxhighlight lang="ats">//--------------------------------------------------------------------
//
// A patience sort for 32-bit signed integers.
//
// This implementation proves that result is sorted, though it
// does not prove that the result is of the same length as the
// original.
//
//--------------------------------------------------------------------
 
#include "share/atspre_staload.hats"
 
(*------------------------------------------------------------------*)
 
#define ENTIER_MAX 2147483647
 
(* We do not include the most negative two's-complement number. *)
stadef entier (i : int) = ~ENTIER_MAX <= i && i <= ENTIER_MAX
sortdef entier = {i : int | entier i}
 
typedef entier (i : int) = [entier i] int i
typedef entier = [i : entier] entier i
 
datatype sorted_entier_list (int, int) =
| sorted_entier_list_nil (0, ENTIER_MAX)
| {n : nat}
{i, j : entier | ~(j < i)}
sorted_entier_list_cons (n + 1, i) of
(entier i, sorted_entier_list (n, j))
typedef sorted_entier_list (n : int) =
[i : entier] sorted_entier_list (n, i)
typedef sorted_entier_list =
[n : int] sorted_entier_list n
 
infixr ( :: ) :::
#define NIL list_nil ()
#define :: list_cons
#define SNIL sorted_entier_list_nil ()
#define ::: sorted_entier_list_cons
 
(*------------------------------------------------------------------*)
 
extern prfn
lemma_sorted_entier_list_param
{n : int}
(lst : sorted_entier_list n)
:<prf> [0 <= n] void
 
extern fn
sorted_entier_list_merge
{m, n : int}
{i, j : entier}
(lst1 : sorted_entier_list (m, i),
lst2 : sorted_entier_list (n, j))
:<> sorted_entier_list (m + n, min (i, j))
 
extern fn
entier_list_patience_sort
{n : int}
(lst : list (entier, n)) (* An ordinary list. *)
:<!wrt> sorted_entier_list (* No proof of the length. *)
 
extern fn
sorted_entier_list2list
{n : int}
(lst : sorted_entier_list n)
:<> list (entier, n)
 
overload merge with sorted_entier_list_merge
overload patience_sort with entier_list_patience_sort
overload to_list with sorted_entier_list2list
 
(*------------------------------------------------------------------*)
 
primplement
lemma_sorted_entier_list_param {n} lst =
case+ lst of
| SNIL => ()
| _ ::: _ => ()
 
implement
sorted_entier_list_merge (lst1, lst2) =
(* This implementation is *NOT* tail recursive. It will use O(m+n)
stack space. *)
let
fun
recurs {m, n : nat}
{i, j : entier} .<m + n>.
(lst1 : sorted_entier_list (m, i),
lst2 : sorted_entier_list (n, j))
:<> sorted_entier_list (m + n, min (i, j)) =
case+ lst1 of
| SNIL => lst2
| i ::: tail1 =>
begin
case+ lst2 of
| SNIL => lst1
| j ::: tail2 =>
if ~(j < i) then
i ::: recurs (tail1, lst2)
else
j ::: recurs (lst1, tail2)
end
 
prval () = lemma_sorted_entier_list_param lst1
prval () = lemma_sorted_entier_list_param lst2
in
recurs (lst1, lst2)
end
 
implement
entier_list_patience_sort {n} lst =
let
prval () = lemma_list_param lst
val n : int n = length lst
in
if n = 0 then
SNIL
else if n = 1 then
let
val+ head :: NIL = lst
in
head ::: SNIL
end
else
let
val @(pf, pfgc | p) =
array_ptr_alloc<sorted_entier_list> (i2sz n)
macdef piles = !p
val () = array_initize_elt (piles, i2sz n, SNIL)
 
fn
find_pile {m : nat | m <= n}
{x : entier}
(num_piles : int m,
piles : &array (sorted_entier_list, n),
x : entier x)
:<> [i : nat | i < n]
[len : int]
[y : entier | ~(y < x)]
@(int i, sorted_entier_list (len, y)) =
//
// Bottenbruch search for the leftmost pile whose top is
// greater than or equal to some element x.
//
// 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
//
let
fun
loop {j, k : nat | j < k; k < m}
{x : entier} .<k - j>.
(piles : &array (sorted_entier_list, n),
j : int j,
k : int k,
x : entier x)
:<> [i : nat | i < n]
[len : int]
[y : entier | ~(y < x)]
@(int i, sorted_entier_list (len, y)) =
let
val i = j + g1int_ndiv (k - j, 2)
val pile = piles[i]
val- head ::: _ = pile
in
if head < x then
begin
if succ i <> k then
loop (piles, succ i, k, x)
else
let
val pile1 = piles[k]
in
case- pile1 of
| head1 ::: _ =>
if head1 < x then
let
(* Runtime check for buffer overrun. *)
val () =
$effmask_exn assertloc (k + 1 < n)
in
(* No pile satisfies the binary search.
Start a new pile. *)
@(k + 1, SNIL)
end
else
@(k, pile1)
end
end
else
begin
if j <> i then
loop (piles, j, i, x)
else
@(j, pile)
end
end
in
if 1 < num_piles then
let
prval () = prop_verify {m >= 1} ()
in
loop (piles, 0, pred num_piles, x)
end
else if num_piles = 1 then
let
prval () = prop_verify {m == 1} ()
val pile = piles[0]
in
case- pile of
| head ::: _ =>
if head < x then
@(1, SNIL)
else
@(0, pile)
end
else
let
prval () = prop_verify {m == 0} ()
in
@(0, SNIL)
end
end
 
fun
deal {m : nat | m <= n}
{j : nat | j <= n} .<m>.
(num_piles : &int j >> int k,
piles : &array (sorted_entier_list, n) >> _,
lst : list (entier, m))
:<!wrt> #[k : nat | j <= k; k <= n] void =
(* This implementation verifies at compile time that the
piles are sorted. *)
case+ lst of
| NIL => ()
| head :: tail =>
let
val @(i, pile) = find_pile (num_piles, piles, head)
prval () = lemma_sorted_entier_list_param pile
in
piles[i] := head ::: pile;
num_piles := max (num_piles, succ i);
deal (num_piles, piles, tail);
end
 
fun
make_list_of_piles
{num_piles, i : nat | num_piles <= n;
i <= num_piles}
.<num_piles - i>.
(num_piles : int num_piles,
piles : &array (sorted_entier_list, n),
i : int i)
:<> [m : nat] @(list (sorted_entier_list, m), int m) =
(* I do NOT bother to make this implementation tail
recursive. *)
if i = num_piles then
@(NIL, 0)
else
let
val @(lst, m) =
make_list_of_piles (num_piles, piles, succ i)
in
@(piles[i] :: lst, succ m)
end
 
var num_piles : Int = 0
val () = deal (num_piles, piles, lst)
val @(list_of_piles, m) =
make_list_of_piles (num_piles, piles, 0)
 
val () = array_ptr_free (pf, pfgc | p)
 
fun
merge_piles {m : nat} .<m>.
(list_of_piles : list (sorted_entier_list, m),
m : int m)
:<!wrt> sorted_entier_list =
(* This is essentially the same algorithm as a
NON-tail-recursive mergesort. *)
if m = 1 then
let
val+ sorted_lst :: NIL = list_of_piles
in
sorted_lst
end
else if m = 0 then
SNIL
else
let
val m_left = m \g1int_ndiv 2
val m_right = m - m_left
val @(left, right) =
list_split_at (list_of_piles, m_left)
val left = merge_piles (list_vt2t left, m_left)
and right = merge_piles (right, m_right)
in
left \merge right
end
in
merge_piles (list_of_piles, m)
end
end
 
implement
sorted_entier_list2list lst =
(* This implementation is *NOT* tail recursive. It will use O(n)
stack space. *)
let
fun
recurs {n : nat} .<n>.
(lst : sorted_entier_list n)
:<> list (entier, n) =
case+ lst of
| SNIL => NIL
| head ::: tail => head :: recurs tail
 
prval () = lemma_sorted_entier_list_param lst
in
recurs lst
end
 
(*------------------------------------------------------------------*)
 
fn
print_Int_list
{n : int}
(lst : list (Int, n))
: void =
let
fun
loop {n : nat} .<n>.
(lst : list (Int, n))
: void =
case+ lst of
| NIL => ()
| head :: tail =>
begin
print! (" ");
print! (head);
loop tail
end
prval () = lemma_list_param lst
in
loop lst
end
 
implement
main0 () =
let
val example_list =
$list (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)
val sorted_list = patience_sort example_list
in
print! ("unsorted ");
print_Int_list example_list;
println! ();
print! ("sorted ");
print_Int_list (to_list sorted_list);
println! ()
end
 
(*------------------------------------------------------------------*)</syntaxhighlight>
 
{{out}}
<pre>$ patscc -O3 -DATS_MEMALLOC_GCBDW patience_sort_task_verified.dats -lgc && ./a.out
unsorted 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
sorted 2 4 8 15 22 22 37 38 46 48 49 53 54 54 58 70 72 76 80 82 84 86 90 93 98</pre>
 
=={{header|AutoHotkey}}==
<langsyntaxhighlight AutoHotkeylang="autohotkey">PatienceSort(A){
P:=0, Pile:=[], Result:=[]
for k, v in A
Line 881 ⟶ 3,186:
}
return Result
}</langsyntaxhighlight>
Examples:<langsyntaxhighlight AutoHotkeylang="autohotkey">Test := [[4, 65, 2, -31, 0, 99, 83, 782, 1]
,["n", "o", "n", "z", "e", "r", "o", "s", "u", "m"]
,["dog", "cow", "cat", "ape", "ant", "man", "pig", "ass", "gnu"]]
Line 893 ⟶ 3,198:
MsgBox % "[" Trim(output, ", ") "]"
}
return</langsyntaxhighlight>
{{out}}
<pre>Pile1 = [-31, 2, 4]
Line 916 ⟶ 3,221:
=={{header|C}}==
Takes integers as input, prints out usage on incorrect invocation
<syntaxhighlight lang="c">
<lang C>
#include<stdlib.h>
#include<stdio.h>
Line 982 ⟶ 3,287:
return 0;
}
</syntaxhighlight>
</lang>
Invocation and output :
<pre>
Line 990 ⟶ 3,295:
 
=={{header|C++}}==
<langsyntaxhighlight lang="cpp">#include <iostream>
#include <vector>
#include <stack>
Line 1,053 ⟶ 3,358:
std::cout << std::endl;
return 0;
}</langsyntaxhighlight>
{{out}}
<pre>-31, 0, 1, 2, 4, 65, 83, 99, 782, </pre>
 
=={{header|Clojure}}==
<langsyntaxhighlight lang="clojure">
(defn patience-insert
"Inserts a value into the sequence where each element is a stack.
Line 1,124 ⟶ 3,429:
;; Sort the test sequence and print it
(println (patience-sort [4 65 2 -31 0 99 83 782 1]))
</syntaxhighlight>
</lang>
{{out}}
<pre>[-31 0 1 2 4 65 83 99 782]</pre>
Line 1,130 ⟶ 3,435:
=={{header|D}}==
{{trans|Python}}
<langsyntaxhighlight lang="d">import std.stdio, std.array, std.range, std.algorithm;
 
void patienceSort(T)(T[] items) /*pure nothrow @safe*/
Line 1,158 ⟶ 3,463:
assert(data.isSorted);
data.writeln;
}</langsyntaxhighlight>
{{out}}
<pre>[-31, 0, 1, 2, 4, 65, 83, 99, 782]</pre>
 
=={{header|Elixir}}==
<langsyntaxhighlight lang="elixir">defmodule Sort do
def patience_sort(list) do
piles = deal_pile(list, [])
Line 1,197 ⟶ 3,502:
end
 
IO.inspect Sort.patience_sort [4, 65, 2, -31, 0, 99, 83, 782, 1]</langsyntaxhighlight>
 
{{out}}
Line 1,218 ⟶ 3,523:
 
 
<langsyntaxhighlight lang="fortran">module rosetta_code_patience_sort
implicit none
private
Line 1,513 ⟶ 3,818:
end function less
 
end program patience_sort_task</langsyntaxhighlight>
 
{{out}}
Line 1,522 ⟶ 3,827:
=={{header|Go}}==
This version is written for int slices, but can be easily modified to sort other types.
<langsyntaxhighlight lang="go">package main
 
import (
Line 1,580 ⟶ 3,885:
patience_sort(a)
fmt.Println(a)
}</langsyntaxhighlight>
{{out}}
<pre>[-31 0 1 2 4 65 83 99 782]</pre>
 
=={{header|Haskell}}==
<langsyntaxhighlight lang="haskell">import Control.Monad.ST
import Control.Monad
import Data.Array.ST
Line 1,632 ⟶ 3,937:
 
main :: IO ()
main = print $ patienceSort [4, 65, 2, -31, 0, 99, 83, 782, 1]</langsyntaxhighlight>
{{out}}
<pre>[-31,0,1,2,4,65,83,99,782]</pre>
Line 1,640 ⟶ 3,945:
 
 
<langsyntaxhighlight lang="icon">#---------------------------------------------------------------------
#
# Patience sorting.
Line 1,874 ⟶ 4,179:
end
 
#---------------------------------------------------------------------</langsyntaxhighlight>
 
{{out}}
Line 1,883 ⟶ 4,188:
=={{header|J}}==
The data structure for append and transfer are as x argument a list with [[wp:CAR_and_CDR|cdr]] as the stacks and [[wp:CAR_and_CDR|car]] as the data to sort or growing sorted list; and the y argument being the index of pile to operate on. New piles are created by using the new value, accomplished by selecting the entire x argument as a result. Filtering removes empty stacks during unpiling.
<syntaxhighlight lang="j">
<lang J>
Until =: 2 :'u^:(0=v)^:_'
Filter =: (#~`)(`:6)
Line 1,910 ⟶ 4,215:
unpile_demo =: >@:{.@:((0<#S:0)Filter@:(transfer Show smallest)Until(1=#))@:(a:&,)
patience_sort_demo =: unpile_demo@:pile_demo
</syntaxhighlight>
</lang>
 
<pre>
Line 2,021 ⟶ 4,326:
 
=={{header|Java}}==
<langsyntaxhighlight lang="java">import java.util.*;
 
public class PatienceSort {
Line 2,058 ⟶ 4,363:
System.out.println(Arrays.toString(a));
}
}</langsyntaxhighlight>
{{out}}
<pre>[-31, 0, 1, 2, 4, 65, 83, 99, 782]</pre>
 
=={{header|Javascript}}==
<langsyntaxhighlight Javascriptlang="javascript">const patienceSort = (nums) => {
const piles = []
 
Line 2,096 ⟶ 4,401:
}
console.log(patienceSort([10,6,-30,9,18,1,-20]));
</syntaxhighlight>
</lang>
{{out}}
<pre>[-30, -20, 1, 6, 9, 10, 18]</pre>
Line 2,104 ⟶ 4,409:
{{works with|jq}}
'''Works with gojq, the Go implementation of jq'''
<langsyntaxhighlight lang="jq">def patienceSort:
length as $size
| if $size < 2 then .
Line 2,139 ⟶ 4,444:
["n", "o", "n", "z", "e", "r", "o", "s", "u", "m"],
["dog", "cow", "cat", "ape", "ant", "man", "pig", "ass", "gnu"]
| patienceSort</langsyntaxhighlight>
{{out}}
<pre>
Line 2,148 ⟶ 4,453:
 
=={{header|Julia}}==
<langsyntaxhighlight lang="julia">function patiencesort(list::Vector{T}) where T
piles = Vector{Vector{T}}()
for n in list
Line 2,176 ⟶ 4,481:
println(patiencesort(rand(collect(1:1000), 12)))
</langsyntaxhighlight>{{out}}
<pre>
[186, 243, 255, 257, 427, 486, 513, 613, 657, 734, 866, 907]
Line 2,182 ⟶ 4,487:
 
=={{header|Kotlin}}==
<langsyntaxhighlight lang="scala">// version 1.1.2
 
fun <T : Comparable<T>> patienceSort(arr: Array<T>) {
Line 2,223 ⟶ 4,528:
patienceSort(sArr)
println(sArr.contentToString())
}</langsyntaxhighlight>
 
{{out}}
Line 2,231 ⟶ 4,536:
[ant, ape, ass, cat, cow, dog, gnu, man, pig]
</pre>
 
=={{header|Mercury}}==
{{trans|Fortran}}
{{works with|Mercury|22.01.1}}
 
 
The Mercury standard library has binary search on arrays, and also a priority queue module, but I did not use these. Instead I translated the Fortran implementation entirely. The binary search and k-way merge for Fortran were known to work, and also are known to work in Ada. Also they are specialized for the patience sort task.
 
 
<syntaxhighlight lang="mercury">:- 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:</syntaxhighlight>
 
{{out}}
I thought to put the code through a bit of a stress test by running the optimizer on it.
<pre>$ mmc -O6 --intermod-opt --warn-non-tail-recursion=self-and-mutual --use-subdirs patience_sort_task.m && ./patience_sort_task
unsorted 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
sorted 2 4 8 15 22 22 37 38 46 48 49 53 54 54 58 70 72 76 80 82 84 86 90 93 98</pre>
 
=={{Header|Modula-2}}==
{{trans|Ada}}
{{works with|GNU Modula-2}}
 
 
Patience sort for ISO Modula-2. I tested it with the GNU Modula-2 that is in a development branch of GCC 12.
 
Unlike the Ada upon which it is based, this implementation of patience sort is specific to arrays of integers, rather than generic.
 
<syntaxhighlight lang="modula2">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.</syntaxhighlight>
 
{{out}}
<pre>$ gm2 -fiso PatienceSortTask.mod && ./a.out
unsorted +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
sorted +2 +4 +8 +15 +22 +22 +37 +38 +46 +48 +49 +53 +54 +54 +58 +70 +72 +76 +80 +82 +84 +86 +90 +93 +98</pre>
 
=={{header|Nim}}==
<langsyntaxhighlight Nimlang="nim">import std/decls
 
func patienceSort[T](a: var openArray[T]) =
Line 2,273 ⟶ 5,252:
var sArray = ["dog", "cow", "cat", "ape", "ant", "man", "pig", "ass", "gnu"]
sArray.patienceSort()
echo sArray</langsyntaxhighlight>
 
{{out}}
Line 2,281 ⟶ 5,260:
 
=={{header|OCaml}}==
<langsyntaxhighlight lang="ocaml">module PatienceSortFn (Ord : Set.OrderedType) : sig
val patience_sort : Ord.t list -> Ord.t list
end = struct
Line 2,331 ⟶ 5,310:
let patience_sort n =
merge_piles (sort_into_piles n)
end</langsyntaxhighlight>
Usage:
<pre># module IntPatienceSort = PatienceSortFn
Line 2,341 ⟶ 5,320:
# IntPatienceSort.patience_sort [4; 65; 2; -31; 0; 99; 83; 782; 1];;
- : int list = [-31; 0; 1; 2; 4; 65; 83; 99; 782]</pre>
 
=={{header|Pascal}}==
{{trans|Modula-2}}
{{works with|Free Pascal Compiler|3.2.2}}
 
<syntaxhighlight lang="pascal">PatienceSortTask (Output);
 
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;
 
FUNCTION NextPowerOfTwo (n : INTEGER) : INTEGER;
VAR Pow2 : INTEGER;
BEGIN
{ This need not be a fast implementation. }
Pow2 := 1;
WHILE Pow2 < n DO
Pow2 := Pow2 + Pow2;
NextPowerOfTwo := Pow2;
END;
 
PROCEDURE InitPilesArray (VAR Arr : PilesArrayType);
VAR i : INTEGER;
BEGIN
FOR i := 1 TO MaxSortSize DO
Arr[i] := 0;
END;
 
PROCEDURE InitWinnersArray (VAR Arr : WinnersArrayType);
VAR i : INTEGER;
BEGIN
FOR i := 1 TO MaxWinnersSize DO
BEGIN
Arr[i, 1] := 0;
Arr[i, 2] := 0;
END;
END;
 
PROCEDURE IntegerPatienceSort (iFirst, iLast : INTEGER;
Arr : ARRAY OF INTEGER;
VAR Sorted : ARRAY OF INTEGER);
VAR NumPiles : INTEGER;
Piles, Links : PilesArrayType;
Winners : WinnersArrayType;
 
FUNCTION 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
BEGIN
j := 0;
k := NumPiles - 1;
WHILE j <> k DO
BEGIN
i := (j + k) DIV 2;
IF Arr[Piles[j + 1] + iFirst - 1] < Arr[q + iFirst - 1] THEN
j := i + 1
ELSE
k := i
END;
IF j = NumPiles - 1 THEN
BEGIN
IF Arr[Piles[j + 1] + iFirst - 1] < Arr[q + iFirst - 1] THEN
{ A new pile is needed. }
j := j + 1
END;
Index := j + 1
END;
FindPile := Index
END;
 
PROCEDURE Deal;
VAR i, q : INTEGER;
BEGIN
FOR q := 1 TO iLast - iFirst + 1 DO
BEGIN
i := FindPile (q);
Links[q] := Piles[i];
Piles[i] := q;
IF i = NumPiles + 1 THEN
NumPiles := i
END
END;
 
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;
 
FUNCTION FindOpponent (i : INTEGER) : INTEGER;
VAR Opponent : INTEGER;
BEGIN
IF ODD (i) THEN
Opponent := i - 1
ELSE
Opponent := i + 1;
FindOpponent := Opponent
END;
 
FUNCTION PlayGame (i : INTEGER) : INTEGER;
VAR j, iWinner : INTEGER;
BEGIN
j := FindOpponent (i);
IF Winners[i, 1] = 0 THEN
iWinner := j
ELSE IF Winners[j, 1] = 0 THEN
iWinner := i
ELSE IF (Arr[Winners[j, 1] + iFirst - 1]
< Arr[Winners[i, 1] + iFirst - 1]) THEN
iWinner := j
ELSE
iWinner := i;
PlayGame := iWinner
END;
 
PROCEDURE ReplayGames (i : INTEGER);
VAR j, iWinner : INTEGER;
BEGIN
j := i;
WHILE j <> 1 DO
BEGIN
iWinner := PlayGame (j);
j := j DIV 2;
Winners[j, 1] := Winners[iWinner, 1];
Winners[j, 2] := Winners[iWinner, 2];
END
END;
 
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;
 
FOR i := 1 TO NumPiles DO
{ The top of each pile becomes a starting competitor. }
Winners[TotalExternalNodes + i - 1, 1] := Piles[i];
 
FOR i := 1 TO NumPiles DO
{ Discard the top of each pile. }
Piles[i] := Links[Piles[i]];
 
iStart := TotalExternalNodes;
WHILE iStart <> 1 DO
BEGIN
i := iStart;
WHILE i <= (2 * iStart) - 1 DO
BEGIN
iWinner := PlayGame (i);
Winners[i DIV 2, 1] := Winners[iWinner, 1];
Winners[i DIV 2, 2] := Winners[iWinner, 2];
i := i + 2
END;
iStart := iStart DIV 2
END
END;
 
BEGIN
TotalExternalNodes := NextPowerOfTwo (NumPiles);
TotalNodes := (2 * TotalExternalNodes) - 1;
BuildTree;
iSorted := 0;
WHILE Winners[1, 1] <> 0 DO
BEGIN
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. }
i := (TotalNodes DIV 2) + i;
Winners[i, 1] := Next;
ReplayGames (i)
END
END;
 
BEGIN
NumPiles := 0;
InitPilesArray (Piles);
InitPilesArray (Links);
InitWinnersArray (Winners);
 
IF MaxSortSize < iLast - iFirst + 1 THEN
BEGIN
Write ('This subarray is too large for the program.');
WriteLn;
HALT
END
ELSE
BEGIN
Deal;
KWayMerge
END
END;
 
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);
 
Write ('unsorted ');
FOR i := 10 TO 34 DO
BEGIN
Write (' ');
Write (ExampleNumbers[i])
END;
WriteLn;
Write ('sorted ');
FOR i := 0 TO 24 DO
BEGIN
Write (' ');
Write (ExampleNumbers[SortedIndices[i]]);
END;
WriteLn
END.</syntaxhighlight>
 
{{out}}
<pre>$ fpc PatienceSortTask.pas && ./PatienceSortTask
Free Pascal Compiler version 3.2.2 [2021/06/27] for x86_64
Copyright (c) 1993-2021 by Florian Klaempfl and others
Target OS: Linux for x86-64
Compiling PatienceSortTask.pas
Linking PatienceSortTask
278 lines compiled, 0.1 sec
unsorted 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
sorted 2 4 8 15 22 22 37 38 46 48 49 53 54 54 58 70 72 76 80 82 84 86 90 93 98</pre>
 
=={{header|Perl}}==
{{trans|Raku}}
<langsyntaxhighlight Perllang="perl">sub patience_sort {
my @s = [shift];
for my $card (@_) {
Line 2,364 ⟶ 5,637:
 
print join ' ', patience_sort qw(4 3 6 2 -1 13 12 9);
</syntaxhighlight>
</lang>
{{out}}
<pre>-1 2 3 4 6 9 12 13</pre>
 
=={{header|Phix}}==
<!--<langsyntaxhighlight Phixlang="phix">(phixonline)-->
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
Line 2,408 ⟶ 5,681:
<span style="color: #7060A8;">pp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">patience_sort</span><span style="color: #0000FF;">(</span><span style="color: #000000;">tests</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]),{</span><span style="color: #004600;">pp_IntCh</span><span style="color: #0000FF;">,</span><span style="color: #004600;">false</span><span style="color: #0000FF;">})</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<!--</langsyntaxhighlight>-->
{{out}}
<pre>
Line 2,418 ⟶ 5,691:
 
=={{header|PHP}}==
<langsyntaxhighlight lang="php"><?php
class PilesHeap extends SplMinHeap {
public function compare($pile1, $pile2) {
Line 2,460 ⟶ 5,733:
patience_sort($a);
print_r($a);
?></langsyntaxhighlight>
{{out}}
<pre>Array
Line 2,476 ⟶ 5,749:
 
=={{header|PicoLisp}}==
<langsyntaxhighlight PicoLisplang="picolisp">(de leftmost (Lst N H)
(let L 1
(while (<= L H)
Line 2,509 ⟶ 5,782:
(patience (4 65 2 -31 0 99 83 782 1)) )
(bye)</langsyntaxhighlight>
 
=={{header|Prolog}}==
<langsyntaxhighlight lang="prolog">patience_sort(UnSorted,Sorted) :-
make_piles(UnSorted,[],Piled),
merge_piles(Piled,[],Sorted).
Line 2,540 ⟶ 5,813:
merge_pile([N|T1],[P|T2],[N|R]) :-
N < P,
merge_pile(T1,[P|T2],R).</langsyntaxhighlight>
{{out}}
<pre>
Line 2,549 ⟶ 5,822:
=={{header|Python}}==
{{works with|Python|2.7+ and 3.2+}} (for <tt>functools.total_ordering</tt>)
<langsyntaxhighlight lang="python">from functools import total_ordering
from bisect import bisect_left
from heapq import merge
Line 2,575 ⟶ 5,848:
a = [4, 65, 2, -31, 0, 99, 83, 782, 1]
patience_sort(a)
print a</langsyntaxhighlight>
{{out}}
<pre>[-31, 0, 1, 2, 4, 65, 83, 99, 782]</pre>
Line 2,583 ⟶ 5,856:
uses <code>bsearchwith</code> from [[Binary search#Quackery]] and <code>merge</code> from [[Merge sort#Quackery]].
 
<langsyntaxhighlight Quackerylang="quackery"> [ dip [ 0 over size rot ]
nested bsearchwith
[ -1 peek
Line 2,612 ⟶ 5,885:
' [ 0 1 2 3 4 5 6 7 8 9 ]
shuffle dup echo cr
patience-sort echo</langsyntaxhighlight>
 
{{out}}
Line 2,621 ⟶ 5,894:
=={{header|Racket}}==
 
<langsyntaxhighlight lang="racket">#lang racket/base
(require racket/match racket/list)
 
Line 2,652 ⟶ 5,925:
[((cons ush ust) least) (scan ush (cons least seens) ust)]))])))
 
(patience-sort (shuffle (for/list ((_ 10)) (random 7))) <)</langsyntaxhighlight>
{{out}}
<pre>'(1 1 2 2 2 3 4 4 4 5)</pre>
Line 2,659 ⟶ 5,932:
(formerly Perl 6)
{{works with|rakudo|2015-10-22}}
<syntaxhighlight lang="raku" perl6line>multi patience(*@deck) {
my @stacks;
for @deck -> $card {
Line 2,675 ⟶ 5,948:
}
 
say ~patience ^10 . pick(*);</langsyntaxhighlight>
{{out}}
<pre>0 1 2 3 4 5 6 7 8 9</pre>
Line 2,683 ⟶ 5,956:
 
Duplicates are also sorted correctly.
<langsyntaxhighlight lang="rexx">/*REXX program sorts a list of things (or items) using the patience sort algorithm. */
parse arg xxx; say ' input: ' xxx /*obtain a list of things from the C.L.*/
n= words(xxx); #= 0; !.= 1 /*N: # of things; #: number of piles*/
Line 2,707 ⟶ 5,980:
end /*k*/ /* [↑] each iteration finds a low item*/
/* [↓] string $ has a leading blank.*/
say 'output: ' strip($) /*stick a fork in it, we're all done. */</langsyntaxhighlight>
{{out|output|text=&nbsp; when using the input of: &nbsp; <tt> 4 65 2 -31 0 99 83 782 7.88 1e1 1 </tt>}}
<pre>
Line 2,720 ⟶ 5,993:
 
=={{header|Ruby}}==
<langsyntaxhighlight lang="ruby">class Array
def patience_sort
piles = []
Line 2,743 ⟶ 6,016:
 
a = [4, 65, 2, -31, 0, 99, 83, 782, 1]
p a.patience_sort</langsyntaxhighlight>
 
{{out}}
Line 2,752 ⟶ 6,025:
{{libheader|Scala Time complexity O(n log n)}}
{{works with|Scala|2.13}}
<langsyntaxhighlight Scalalang="scala">import scala.collection.mutable
 
object PatienceSort extends App {
Line 2,788 ⟶ 6,061:
 
println(sort(List(4, 65, 2, -31, 0, 99, 83, 782, 1)))
}</langsyntaxhighlight>
 
=={{header|Scheme}}==
Line 2,799 ⟶ 6,072:
 
 
<langsyntaxhighlight lang="scheme">(define-library (rosetta-code k-way-merge)
 
(export k-way-merge)
Line 3,032 ⟶ 6,305:
(newline)
 
;;--------------------------------------------------------------------</langsyntaxhighlight>
 
{{out}}
Line 3,040 ⟶ 6,313:
 
=={{header|Sidef}}==
<langsyntaxhighlight lang="ruby">func patience(deck) {
var stacks = [];
deck.each { |card|
Line 3,062 ⟶ 6,335:
 
var a = [4, 65, 2, -31, 0, 99, 83, 782, 1]
say patience(a)</langsyntaxhighlight>
{{out}}
<pre>
Line 3,070 ⟶ 6,343:
=={{header|Standard ML}}==
{{works with|SML/NJ}}
<langsyntaxhighlight lang="sml">structure PilePriority = struct
type priority = int
fun compare (x, y) = Int.compare (y, x) (* we want min-heap *)
Line 3,124 ⟶ 6,397:
 
fun patience_sort n =
merge_piles (sort_into_piles n)</langsyntaxhighlight>
Usage:
<pre>- patience_sort [4, 65, 2, ~31, 0, 99, 83, 782, 1];
Line 3,132 ⟶ 6,405:
{{works with|Tcl|8.6}}
This uses the <code>-bisect</code> option to <code>lsearch</code> in order to do an efficient binary search (in combination with <code>-index end</code>, which means that the search is indexed by the end of the sublist).
<langsyntaxhighlight lang="tcl">package require Tcl 8.6
 
proc patienceSort {items} {
Line 3,165 ⟶ 6,438:
}
return $result
}</langsyntaxhighlight>
Demonstrating:
<langsyntaxhighlight lang="tcl">puts [patienceSort {4 65 2 -31 0 99 83 782 1}]</langsyntaxhighlight>
{{out}}
<pre>-31 0 1 2 4 65 83 99 782</pre>
Line 3,174 ⟶ 6,447:
{{trans|Kotlin}}
{{libheader|Wren-sort}}
<langsyntaxhighlight ecmascriptlang="wren">import "./sort" for Cmp
 
var patienceSort = Fn.new { |a|
Line 3,218 ⟶ 6,491:
var sa = ["dog", "cow", "cat", "ape", "ant", "man", "pig", "ass", "gnu"]
patienceSort.call(sa)
System.print(sa)</langsyntaxhighlight>
 
{{out}}
Line 3,228 ⟶ 6,501:
 
=={{header|zkl}}==
<langsyntaxhighlight lang="zkl">fcn patienceSort(ns){
piles:=L();
foreach n in (ns){ newPile:=True; // create list of sorted lists
Line 3,244 ⟶ 6,517:
}
r.close();
}</langsyntaxhighlight>
<langsyntaxhighlight lang="zkl">T(T(3,2,6,4,3,5,1),
T(4,65,2,-31,0,99,83,782,1),
T(0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15),
"foobar")
.pump(Console.println,patienceSort);</langsyntaxhighlight>
{{out}}
<pre>
9,485

edits