aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data update

Browse source
This commit is contained in:
Ingy döt Net 2026-02-01 16:33:20 -08:00
parent 5150844a7d
commit 4bb20c9b71
7735 changed files with 38060 additions and 199180 deletions
Download patch file Download diff file Expand all files Collapse all files

288
Task/Sorting-algorithms-Patience-sort/Ada/sorting-algorithms-patience-sort.ada
View file

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

72
Task/Sorting-algorithms-Patience-sort/Phix/sorting-algorithms-patience-sort.phix
View file

@ -1,40 +1,38 @@
(phixonline)-->
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
with javascript_semantics
<span style="color: #008080;">function</span> <span style="color: #000000;">patience_sort</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">)</span>
<span style="color: #000080;font-style:italic;">-- create list of sorted lists</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">piles</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{}</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
<span style="color: #004080;">object</span> <span style="color: #000000;">n</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">p</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">piles</span><span style="color: #0000FF;">)+</span><span style="color: #000000;">1</span> <span style="color: #008080;">do</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">p</span><span style="color: #0000FF;">></span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">piles</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">piles</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">piles</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">n</span><span style="color: #0000FF;">})</span>
<span style="color: #008080;">elsif</span> <span style="color: #000000;">n</span><span style="color: #0000FF;">>=</span><span style="color: #000000;">piles</span><span style="color: #0000FF;">[</span><span style="color: #000000;">p</span><span style="color: #0000FF;">][$]</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">piles</span><span style="color: #0000FF;">[</span><span style="color: #000000;">p</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">deep_copy</span><span style="color: #0000FF;">(</span><span style="color: #000000;">piles</span><span style="color: #0000FF;">[</span><span style="color: #000000;">p</span><span style="color: #0000FF;">]),</span><span style="color: #000000;">n</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">exit</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #000080;font-style:italic;">-- merge sort the piles</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">""</span>
<span style="color: #008080;">while</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">piles</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">idx</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">smallest</span><span style="color: #0000FF;">(</span><span style="color: #000000;">piles</span><span style="color: #0000FF;">,</span><span style="color: #000000;">return_index</span><span style="color: #0000FF;">:=</span><span style="color: #004600;">true</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">res</span><span style="color: #0000FF;">,</span><span style="color: #000000;">piles</span><span style="color: #0000FF;">[</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">][</span><span style="color: #000000;">1</span><span style="color: #0000FF;">])</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">piles</span><span style="color: #0000FF;">[</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">])=</span><span style="color: #000000;">1</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">piles</span><span style="color: #0000FF;">[</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">..</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{}</span>
<span style="color: #008080;">else</span>
<span style="color: #000000;">piles</span><span style="color: #0000FF;">[</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">piles</span><span style="color: #0000FF;">[</span><span style="color: #000000;">idx</span><span style="color: #0000FF;">][</span><span style="color: #000000;">2</span><span style="color: #0000FF;">..$]</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">res</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
function patience_sort(sequence s)
-- create list of sorted lists
sequence piles = {}
for i,n in s do
for p=length(piles) to 0 by -1 do
if p=0 then
piles = append(piles,{n})
elsif n>=piles[p][$] then
piles[p] = append(piles[p],n)
exit
end if
end for
end for
-- merge sort the piles
sequence res = ""
while length(piles)>1 do
integer idx = smallest(piles,return_index:=true)
res = append(res,piles[idx][1])
if length(piles[idx])=1 then
piles[idx..idx] = {}
else
piles[idx] = piles[idx][2..$]
end if
end while
if length(piles)=1 then res &= piles[1] end if
return res
end function
<span style="color: #008080;">constant</span> <span style="color: #000000;">tests</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{{</span><span style="color: #000000;">4</span><span style="color: #0000FF;">,</span><span style="color: #000000;">65</span><span style="color: #0000FF;">,</span><span style="color: #000000;">2</span><span style="color: #0000FF;">,-</span><span style="color: #000000;">31</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">99</span><span style="color: #0000FF;">,</span><span style="color: #000000;">83</span><span style="color: #0000FF;">,</span><span style="color: #000000;">782</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">},</span>
<span style="color: #0000FF;">{</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">8</span><span style="color: #0000FF;">,</span><span style="color: #000000;">4</span><span style="color: #0000FF;">,</span><span style="color: #000000;">12</span><span style="color: #0000FF;">,</span><span style="color: #000000;">2</span><span style="color: #0000FF;">,</span><span style="color: #000000;">10</span><span style="color: #0000FF;">,</span><span style="color: #000000;">6</span><span style="color: #0000FF;">,</span><span style="color: #000000;">14</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">9</span><span style="color: #0000FF;">,</span><span style="color: #000000;">5</span><span style="color: #0000FF;">,</span><span style="color: #000000;">13</span><span style="color: #0000FF;">,</span><span style="color: #000000;">3</span><span style="color: #0000FF;">,</span><span style="color: #000000;">11</span><span style="color: #0000FF;">,</span><span style="color: #000000;">7</span><span style="color: #0000FF;">,</span><span style="color: #000000;">15</span><span style="color: #0000FF;">},</span>
<span style="color: #008000;">"nonzerosum"</span><span style="color: #0000FF;">,</span>
<span style="color: #0000FF;">{</span><span style="color: #008000;">"dog"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"cow"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"cat"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"ape"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"ant"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"man"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"pig"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"ass"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"gnu"</span><span style="color: #0000FF;">}}</span>
constant tests = {{4,65,2,-31,0,99,83,782,1},
{0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15},
"nonzerosum",
{"dog", "cow", "cat", "ape", "ant", "man", "pig", "ass", "gnu"}}
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">tests</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
<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>
<!--
for t in tests do
pp(patience_sort(t),{pp_IntCh,false})
end for

92
Task/Sorting-algorithms-Patience-sort/REXX/sorting-algorithms-patience-sort.rexx
View file

@ -1,25 +1,69 @@
/*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*/
@.= /* [↓] append or create a pile (@.j) */
do i=1 for n; q= word(xxx, i) /* [↓] construct the piles of things. */
do j=1 for # /*add the Q thing (item) to a pile.*/
if q>word(@.j,1) then iterate /*Is this item greater? Then skip it.*/
@.j= q @.j; iterate i /*add this item to the top of the pile.*/
end /*j*/ /* [↑] find a pile, or make a new pile*/
#= # + 1 /*increase the pile count. */
@.#= q /*define a new pile. */
end /*i*/ /*we are done with creating the piles. */
$= /* [↓] build a thingy list from piles*/
do k=1 until words($)==n /*pick off the smallest from the piles.*/
_= /*this is the smallest thingy so far···*/
do m=1 for #; z= word(@.m, !.m) /*traipse through many piles of items. */
if z=='' then iterate /*Is this pile null? Then skip pile.*/
if _=='' then _= z /*assume this one is the low pile value*/
if _>=z then do; _= z; p= m; end /*found a low value in a pile of items.*/
end /*m*/ /*the traipsing is done, we found a low*/
$= $ _ /*add to the output thingy ($) list. */
!.p= !.p + 1 /*bump the thingy pointer in pile P. */
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. */
Parse Arg list /*obtain a list of things from the C.L .*/
debug=0
lex=0 /* lex=1 to sort alphabetically */
If list='' Then /* nothing specified */
list='4 65 2 -31 0 99 83 782 7.88 1e1 1' /* take this as default */
Say ' Input:' list
n=words(list) /* number of things */
np=0 /* number of piles */
pi.=1 /* index into pile */
pile.='' /* all piles are empty */
Do i=1 To n
w=word(list,i) /* nex Item */
If lex Then
w='$'w
Do j=1 To np /* loop through piles */
If w<word(pile.j,1) Then Do
pile.j=w pile.j /* add It on top of the pile */
Iterate i /* and proceed with next item */
End
Else
Iterate /* try next pile */
End
np+=1 /* increase the pile count. */
pile.np=w /* first item on new pile */
End
If debug=1 Then Do
Do i=1 To np
Call debug i pi.i pile.i
End
End
sorted=''
Do k=1 To n /* pick off the smallest from the piles. */
v='' /* this is the spiallest thingy so far···*/
Call show 'vorher'
Do p=1 To np /* loop over piles */
z=word(pile.p,pi.p) /* top element on pile p or empty */
Call debug p '-' pile.p '-' pi.p '->' z
If z>'' Then Do /* a new candidate */
If v=='' Then v=z /* the first in this try */
If z<=v Then Do /* It's smaller than the previous */
Call debug z '<=' v
v=z /* so take this value */
pu=p /* and this pile is used */
Call debug 'v='v 'pu='pu
End
End /*found a low value in a pile of Items. */
End
If lex Then
vo=substr(v,2)
sorted=sorted vo /* add To the output thingy (sorted) list*/
Call debug '-->'sorted
pi.pu+=1 /* bump the thingy index in pile pu */
Call show 'nachher'
End
Say 'Output:' strip(sorted) /*stick a fork in It, we're all Done. */
show:
Call debug arg(1)
Call debug '------------------------>'sorted
Do o=1 To np
Call debug o pi.o pile.o
End
Return
debug:
If debug Then Say arg(1)
Return