Quickselect algorithm: Difference between revisions

m
(Quickselect algorithm en FreeBASIC)
m (→‎{{header|Wren}}: Minor tidy)
 
(25 intermediate revisions by 10 users not shown)
Line 12:
{{trans|Python}}
 
<langsyntaxhighlight lang="11l">F partition(&vector, left, right, pivotIndex)
V pivotValue = vector[pivotIndex]
swap(&vector[pivotIndex], &vector[right])
Line 51:
 
V v = [9, 8, 7, 6, 5, 0, 1, 2, 3, 4]
print((0.<10).map(i -> select(&:v, i)))</langsyntaxhighlight>
 
{{out}}
Line 57:
[0, 1, 2, 3, 4, 5, 6, 7, 8, 9]
</pre>
=={{header|AArch64 Assembly}}==
{{works with|as|Raspberry Pi 3B version Buster 64 bits <br> or android 64 bits with application Termux }}
<syntaxhighlight lang AArch64 Assembly>
/* ARM assembly AARCH64 Raspberry PI 3B */
/* program quickSelection64.s */
/* look pseudo code in wikipedia quickselect */
 
/*******************************************/
/* Constantes file */
/*******************************************/
/* for this file see task include a file in language AArch64 assembly*/
.include "../includeConstantesARM64.inc"
 
/*********************************/
/* Initialized data */
/*********************************/
.data
szMessResultIndex: .asciz "index : "
szMessResultValue: .asciz " value : "
szCarriageReturn: .asciz "\n"
szMessStart: .asciz "Program 64 bits start.\n"
.align 4
TableNumber: .quad 9, 8, 7, 6, 5, 0, 1, 2, 3, 4
.equ NBELEMENTS, (. - TableNumber) / 8
/*********************************/
/* UnInitialized data */
/*********************************/
.bss
sZoneConv: .skip 24
sZoneConv1: .skip 24
/*********************************/
/* code section */
/*********************************/
.text
.global main
main: // entry of program
ldr x0,qAdrszMessStart
bl affichageMess
mov x6,#0
1:
ldr x0,qAdrTableNumber // address number table
mov x1,#0 // index first item
mov x2,#NBELEMENTS -1 // index last item
mov x3,x6 // search index
bl select // call selection
ldr x1,qAdrsZoneConv
bl conversion10 // convert result to decimal
mov x0,x6
ldr x1,qAdrsZoneConv1
bl conversion10 // convert index to decimal
mov x0,#5 // and display result
ldr x1,qAdrszMessResultIndex
ldr x2,qAdrsZoneConv1
ldr x3,qAdrszMessResultValue
ldr x4,qAdrsZoneConv
ldr x5,qAdrszCarriageReturn
bl displayStrings
add x6,x6,#1
cmp x6,#NBELEMENTS
blt 1b
 
100: // standard end of the program
mov x0, #0 // return code
mov x8, #EXIT // request to exit program
svc #0 // perform the system call
qAdrszCarriageReturn: .quad szCarriageReturn
qAdrTableNumber: .quad TableNumber
qAdrsZoneConv: .quad sZoneConv
qAdrsZoneConv1: .quad sZoneConv1
qAdrszMessResultIndex: .quad szMessResultIndex
qAdrszMessResultValue: .quad szMessResultValue
qAdrszMessStart: .quad szMessStart
/***************************************************/
/* Appel récursif selection */
/***************************************************/
/* x0 contains the address of table */
/* x1 contains index of first item */
/* x2 contains index of last item */
/* x3 contains search index */
select:
stp x1,lr,[sp,-16]! // save registers
stp x2,x3,[sp,-16]! // save registers
stp x4,x5,[sp,-16]! // save registers
stp x6,x7,[sp,-16]! // save registers
mov x6,x3 // save search index
cmp x1,x2 // first = last ?
bne 1f
ldr x0,[x0,x1,lsl #3] // return value of first index
b 100f // yes -> end
1:
add x3,x1,x2
lsr x3,x3,#1 // compute median pivot
mov x4,x0 // save x0
mov x5,x2 // save x2
bl partition // cutting.quado 2 parts
cmp x6,x0 // pivot is ok ?
bne 2f
ldr x0,[x4,x0,lsl #3] // yes -> return value
b 100f
2:
bgt 3f
sub x2,x0,#1 // index partition - 1
mov x0,x4 // array address
mov x3,x6 // search index
bl select // select lower part
b 100f
3:
add x1,x0,#1 // index begin = index partition + 1
mov x0,x4 // array address
mov x2,x5 // last item
mov x3,x6 // search index
bl select // select higter part
100: // end function
ldp x6,x7,[sp],16 // restaur 2 registers
ldp x4,x5,[sp],16 // restaur 2 registers
ldp x2,x3,[sp],16 // restaur 2 registers
ldp x1,lr,[sp],16 // restaur 2 registers
ret // return to address lr x30
/******************************************************************/
/* Partition table elements */
/******************************************************************/
/* x0 contains the address of table */
/* x1 contains index of first item */
/* x2 contains index of last item */
/* x3 contains index of pivot */
partition:
stp x1,lr,[sp,-16]! // save registers
stp x2,x3,[sp,-16]! // save registers
stp x4,x5,[sp,-16]! // save registers
stp x6,x7,[sp,-16]! // save registers
ldr x4,[x0,x3,lsl #3] // load value of pivot
ldr x5,[x0,x2,lsl #3] // load value last index
str x5,[x0,x3,lsl #3] // swap value of pivot
str x4,[x0,x2,lsl #3] // and value last index
mov x3,x1 // init with first index
1: // begin loop
ldr x6,[x0,x3,lsl #3] // load value
cmp x6,x4 // compare loop value and pivot value
bge 2f
ldr x5,[x0,x1,lsl #3] // if < swap value table
str x6,[x0,x1,lsl #3]
str x5,[x0,x3,lsl #3]
add x1,x1,#1 // and increment index 1
2:
add x3,x3,#1 // increment index 2
cmp x3,x2 // end ?
blt 1b // no loop
ldr x5,[x0,x1,lsl #3] // swap value
str x4,[x0,x1,lsl #3]
str x5,[x0,x2,lsl #3]
mov x0,x1 // return index partition
100:
ldp x6,x7,[sp],16 // restaur 2 registers
ldp x4,x5,[sp],16 // restaur 2 registers
ldp x2,x3,[sp],16 // restaur 2 registers
ldp x1,lr,[sp],16 // restaur 2 registers
ret // return to address lr x30
/***************************************************/
/* display multi strings */
/* new version 24/05/2023 */
/***************************************************/
/* x0 contains number strings address */
/* x1 address string1 */
/* x2 address string2 */
/* x3 address string3 */
/* x4 address string4 */
/* x5 address string5 */
/* x6 address string5 */
/* x7 address string6 */
displayStrings: // INFO: displayStrings
stp x8,lr,[sp,-16]! // save registers
stp x2,fp,[sp,-16]! // save registers
add fp,sp,#32 // save paraméters address (4 registers saved * 8 bytes)
mov x8,x0 // save strings number
cmp x8,#0 // 0 string -> end
ble 100f
mov x0,x1 // string 1
bl affichageMess
cmp x8,#1 // number > 1
ble 100f
mov x0,x2
bl affichageMess
cmp x8,#2
ble 100f
mov x0,x3
bl affichageMess
cmp x8,#3
ble 100f
mov x0,x4
bl affichageMess
cmp x8,#4
ble 100f
mov x0,x5
bl affichageMess
cmp x8,#5
ble 100f
mov x0,x6
bl affichageMess
cmp x8,#6
ble 100f
mov x0,x7
bl affichageMess
100:
ldp x2,fp,[sp],16 // restaur registers
ldp x8,lr,[sp],16 // restaur registers
ret
/***************************************************/
/* ROUTINES INCLUDE */
/***************************************************/
/* for this file see task include a file in language AArch64 assembly*/
.include "../includeARM64.inc"
 
</syntaxhighlight>
{{Out}}
<pre>
Program 64 bits start.
index : 0 value : 0
index : 1 value : 1
index : 2 value : 2
index : 3 value : 3
index : 4 value : 4
index : 5 value : 5
index : 6 value : 6
index : 7 value : 7
index : 8 value : 8
index : 9 value : 9
</pre>
 
=={{header|Action!}}==
<syntaxhighlight lang="action!">PROC Swap(BYTE ARRAY tab INT i,j)
BYTE tmp
 
tmp=tab(i) tab(i)=tab(j) tab(j)=tmp
RETURN
 
BYTE FUNC QuickSelect(BYTE ARRAY tab INT count,index)
INT px,i,j,k
BYTE pv
 
DO
px=count/2
pv=tab(px)
Swap(tab,px,count-1)
i=0
FOR j=0 TO count-2
DO
IF tab(j)<pv THEN
Swap(tab,i,j)
i==+1
FI
OD
 
IF i=index THEN
RETURN (pv)
ELSEIF i>index THEN
;left part of tab from 0 to i-1
count=i
ELSE
Swap(tab,i,count-1)
;right part of tab from i+1 to count-1
tab==+(i+1)
count==-(i+1)
index==-(i+1)
FI
OD
RETURN (0)
 
PROC Main()
DEFINE COUNT="10"
BYTE ARRAY data=[9 8 7 6 5 0 1 2 3 4],tab(COUNT)
BYTE i,res
 
FOR i=0 TO COUNT-1
DO
MoveBlock(tab,data,COUNT)
res=QuickSelect(tab,COUNT,i)
PrintB(res) Put(32)
OD
RETURN</syntaxhighlight>
{{out}}
[https://gitlab.com/amarok8bit/action-rosetta-code/-/raw/master/images/Quickselect_algorithm.png Screenshot from Atari 8-bit computer]
<pre>
0 1 2 3 4 5 6 7 8 9
</pre>
 
=={{header|Ada}}==
{{trans|Mercury}}
{{works with|GNAT|Community 2021}}
 
 
I implement a generic partition and a generic quickselect and apply them to an array of integers. The order predicate is passed as a parameter, and I demonstrate both '''<''' and '''>''' as the predicate.
 
<syntaxhighlight lang="ada">----------------------------------------------------------------------
 
with Ada.Numerics.Float_Random;
with Ada.Text_IO;
 
procedure quickselect_task
is
 
use Ada.Numerics.Float_Random;
use Ada.Text_IO;
 
gen : Generator;
 
----------------------------------------------------------------------
--
-- procedure partition
--
-- Partitioning a subarray into two halves: one with elements less
-- than or equal to a pivot, the other with elements greater than or
-- equal to a pivot.
--
 
generic
type T is private;
type T_Array is array (Natural range <>) of T;
procedure partition
(less_than : access function
(x, y : T)
return Boolean;
pivot : in T;
i_first, i_last : in Natural;
arr : in out T_Array;
i_pivot : out Natural);
 
procedure partition
(less_than : access function
(x, y : T)
return Boolean;
pivot : in T;
i_first, i_last : in Natural;
arr : in out T_Array;
i_pivot : out Natural)
is
i, j : Integer;
temp : T;
begin
 
i := Integer (i_first) - 1;
j := i_last + 1;
 
while i /= j loop
-- Move i so everything to the left of i is less than or equal
-- to the pivot.
i := i + 1;
while i /= j and then not less_than (pivot, arr (i)) loop
i := i + 1;
end loop;
 
-- Move j so everything to the right of j is greater than or
-- equal to the pivot.
if i /= j then
j := j - 1;
while i /= j and then not less_than (arr (j), pivot) loop
j := j - 1;
end loop;
end if;
 
-- Swap entries.
temp := arr (i);
arr (i) := arr (j);
arr (j) := temp;
end loop;
 
i_pivot := i;
 
end partition;
 
----------------------------------------------------------------------
--
-- procedure quickselect
--
-- Quickselect with a random pivot. Returns the (k+1)st element of a
-- subarray, according to the given order predicate. Also rearranges
-- the subarray so that anything "less than" the (k+1)st element is to
-- the left of it, and anything "greater than" it is to its right.
--
-- I use a random pivot to get O(n) worst case *expected* running
-- time. Code using a random pivot is easy to write and read, and for
-- most purposes comes close enough to a criterion set by Scheme's
-- SRFI-132: "Runs in O(n) time." (See
-- https://srfi.schemers.org/srfi-132/srfi-132.html)
--
-- Of course we are not bound here by SRFI-132, but still I respect
-- it as a guide.
--
-- A "median of medians" pivot gives O(n) running time, but
-- quickselect with such a pivot is a complicated algorithm requiring
-- many comparisons of array elements. A random number generator, by
-- contrast, requires no comparisons of array elements.
--
 
generic
type T is private;
type T_Array is array (Natural range <>) of T;
procedure quickselect
(less_than : access function
(x, y : T)
return Boolean;
i_first, i_last : in Natural;
k : in Natural;
arr : in out T_Array;
the_element : out T;
the_elements_index : out Natural);
 
procedure quickselect
(less_than : access function
(x, y : T)
return Boolean;
i_first, i_last : in Natural;
k : in Natural;
arr : in out T_Array;
the_element : out T;
the_elements_index : out Natural)
is
procedure T_partition is new partition (T, T_Array);
 
procedure qselect
(less_than : access function
(x, y : T)
return Boolean;
i_first, i_last : in Natural;
k : in Natural;
arr : in out T_Array;
the_element : out T;
the_elements_index : out Natural)
is
i, j : Natural;
i_pivot : Natural;
i_final : Natural;
pivot : T;
begin
 
i := i_first;
j := i_last;
 
while i /= j loop
i_pivot :=
i + Natural (Float'Floor (Random (gen) * Float (j - i + 1)));
i_pivot := Natural'Min (j, i_pivot);
pivot := arr (i_pivot);
 
-- Move the last element to where the pivot had been. Perhaps
-- the pivot was already the last element, of course. In any
-- case, we shall partition only from i to j - 1.
arr (i_pivot) := arr (j);
 
-- Partition the array in the range i .. j - 1, leaving out
-- the last element (which now can be considered garbage).
T_partition (less_than, pivot, i, j - 1, arr, i_final);
 
-- Now everything that is less than the pivot is to the left
-- of I_final.
 
-- Put the pivot at i_final, moving the element that had been
-- there to the end. If i_final = j, then this element is
-- actually garbage and will be overwritten with the pivot,
-- which turns out to be the greatest element. Otherwise, the
-- moved element is not less than the pivot and so the
-- partitioning is preserved.
arr (j) := arr (i_final);
arr (i_final) := pivot;
 
-- Compare i_final and k, to see what to do next.
if i_final < k then
i := i_final + 1;
elsif k < i_final then
j := i_final - 1;
else
-- Exit the loop.
i := i_final;
j := i_final;
end if;
end loop;
 
the_element := arr (i);
the_elements_index := i;
 
end qselect;
begin
-- Adjust k for the subarray's position.
qselect
(less_than, i_first, i_last, k + i_first, arr, the_element,
the_elements_index);
end quickselect;
 
----------------------------------------------------------------------
 
type Integer_Array is array (Natural range <>) of Integer;
 
procedure integer_quickselect is new quickselect
(Integer, Integer_Array);
 
procedure print_kth
(less_than : access function
(x, y : Integer)
return Boolean;
k : in Positive;
i_first, i_last : in Integer;
arr : in out Integer_Array)
is
copy_of_arr : Integer_Array (0 .. i_last);
the_element : Integer;
the_elements_index : Natural;
begin
for j in 0 .. i_last loop
copy_of_arr (j) := arr (j);
end loop;
integer_quickselect
(less_than, i_first, i_last, k - 1, copy_of_arr, the_element,
the_elements_index);
Put (Integer'Image (the_element));
end print_kth;
 
----------------------------------------------------------------------
 
example_numbers : Integer_Array := (9, 8, 7, 6, 5, 0, 1, 2, 3, 4);
 
function lt
(x, y : Integer)
return Boolean
is
begin
return (x < y);
end lt;
 
function gt
(x, y : Integer)
return Boolean
is
begin
return (x > y);
end gt;
 
begin
Put ("With < as order predicate: ");
for k in 1 .. 10 loop
print_kth (lt'Access, k, 0, 9, example_numbers);
end loop;
Put_Line ("");
Put ("With > as order predicate: ");
for k in 1 .. 10 loop
print_kth (gt'Access, k, 0, 9, example_numbers);
end loop;
Put_Line ("");
end quickselect_task;
 
----------------------------------------------------------------------</syntaxhighlight>
 
{{out}}
<pre>$ gnatmake -q quickselect_task.adb && ./quickselect_task
With < as order predicate: 0 1 2 3 4 5 6 7 8 9
With > as order predicate: 9 8 7 6 5 4 3 2 1 0</pre>
 
=={{header|ALGOL 68}}==
<langsyntaxhighlight lang="algol68">BEGIN
# returns the kth lowest element of list using the quick select algorithm #
PRIO QSELECT = 1;
Line 115 ⟶ 674:
print( ( whole( i, -2 ), ": ", whole( i QSELECT test, -3 ), newline ) )
OD
END</langsyntaxhighlight>
{{out}}
<pre>
Line 133 ⟶ 692:
 
===Procedural===
<langsyntaxhighlight lang="applescript">on quickselect(theList, l, r, k)
script o
property lst : theList's items -- Shallow copy.
Line 254 ⟶ 813:
set end of selected to quickselect(theVector, 1, vectorLength, i)
end repeat
return selected</langsyntaxhighlight>
 
{{out}}
<langsyntaxhighlight lang="applescript">{0, 1, 2, 3, 4, 5, 6, 7, 8, 9}</langsyntaxhighlight>
 
===Functional===
<langsyntaxhighlight lang="applescript">----------------------- QUICKSELECT ------------------------
 
-- quickSelect :: Ord a => [a] -> Int -> a
Line 368 ⟶ 927:
end tell
{ys, zs}
end partition</langsyntaxhighlight>
{{Out}}
<pre>{0, 1, 2, 3, 4, 5, 6, 7, 8, 9}</pre>
=={{header|ARM Assembly}}==
{{works with|as|Raspberry Pi <br> or android 32 bits with application Termux}}
<syntaxhighlight lang ARM Assembly>
/* ARM assembly Raspberry PI */
/* program quickSelection.s */
/* look pseudo code in wikipedia quickselect */
 
/************************************/
/* Constantes */
/************************************/
/* for constantes see task include a file in arm assembly */
.include "../constantes.inc"
 
/*********************************/
/* Initialized data */
/*********************************/
.data
szMessResultIndex: .asciz "index : "
szMessResultValue: .asciz " value : "
szCarriageReturn: .asciz "\n"
.align 4
TableNumber: .int 9, 8, 7, 6, 5, 0, 1, 2, 3, 4
.equ NBELEMENTS, (. - TableNumber) / 4
/*********************************/
/* UnInitialized data */
/*********************************/
.bss
sZoneConv: .skip 24
sZoneConv1: .skip 24
/*********************************/
/* code section */
/*********************************/
.text
.global main
main: @ entry of program
mov r5,#0
1:
ldr r0,iAdrTableNumber @ address number table
mov r1,#0 @ index first item
mov r2,#NBELEMENTS -1 @ index last item
mov r3,r5 @ search index
bl select @ call selection
ldr r1,iAdrsZoneConv
bl conversion10 @ convert result to decimal
mov r0,r5
ldr r1,iAdrsZoneConv1
bl conversion10 @ convert index to decimal
mov r0,#5 @ and display result
ldr r1,iAdrszMessResultIndex
ldr r2,iAdrsZoneConv1
ldr r3,iAdrszMessResultValue
ldr r4,iAdrsZoneConv
push {r4}
ldr r4,iAdrszCarriageReturn
push {r4}
bl displayStrings
add sp,sp,#8 @ stack alignement (2 push)
add r5,r5,#1
cmp r5,#NBELEMENTS
blt 1b
 
100: @ standard end of the program
mov r0, #0 @ return code
mov r7, #EXIT @ request to exit program
svc #0 @ perform the system call
iAdrszCarriageReturn: .int szCarriageReturn
iAdrTableNumber: .int TableNumber
iAdrsZoneConv: .int sZoneConv
iAdrsZoneConv1: .int sZoneConv1
iAdrszMessResultIndex: .int szMessResultIndex
iAdrszMessResultValue: .int szMessResultValue
 
/***************************************************/
/* Appel récursif selection */
/***************************************************/
/* r0 contains the address of table */
/* r1 contains index of first item */
/* r2 contains index of last item */
/* r3 contains search index */
select:
push {r1-r6,lr} @ save registers
mov r6,r3 @ save search index
cmp r1,r2 @ first = last ?
ldreq r0,[r0,r1,lsl #2] @ return value of first index
beq 100f @ yes -> end
add r3,r1,r2
lsr r3,r3,#1 @ compute median pivot
mov r4,r0 @ save r0
mov r5,r2 @ save r2
bl partition @ cutting into 2 parts
cmp r6,r0 @ pivot is ok ?
ldreq r0,[r4,r0,lsl #2] @ return value
beq 100f
bgt 1f
sub r2,r0,#1 @ index partition - 1
mov r0,r4 @ array address
mov r3,r6 @ search index
bl select @ select lower part
b 100f
1:
add r1,r0,#1 @ index begin = index partition + 1
mov r0,r4 @ array address
mov r2,r5 @ last item
mov r3,r6 @ search index
bl select @ select higter part
100: @ end function
pop {r1-r6,pc} @ restaur register
/******************************************************************/
/* Partition table elements */
/******************************************************************/
/* r0 contains the address of table */
/* r1 contains index of first item */
/* r2 contains index of last item */
/* r3 contains index of pivot */
partition:
push {r1-r6,lr} @ save registers
ldr r4,[r0,r3,lsl #2] @ load value of pivot
ldr r5,[r0,r2,lsl #2] @ load value last index
str r5,[r0,r3,lsl #2] @ swap value of pivot
str r4,[r0,r2,lsl #2] @ and value last index
mov r3,r1 @ init with first index
1: @ begin loop
ldr r6,[r0,r3,lsl #2] @ load value
cmp r6,r4 @ compare loop value and pivot value
ldrlt r5,[r0,r1,lsl #2] @ if < swap value table
strlt r6,[r0,r1,lsl #2]
strlt r5,[r0,r3,lsl #2]
addlt r1,#1 @ and increment index 1
add r3,#1 @ increment index 2
cmp r3,r2 @ end ?
blt 1b @ no loop
ldr r5,[r0,r1,lsl #2] @ swap value
str r4,[r0,r1,lsl #2]
str r5,[r0,r2,lsl #2]
mov r0,r1 @ return index partition
100:
pop {r1-r6,pc}
/***************************************************/
/* display multi strings */
/***************************************************/
/* r0 contains number strings address */
/* r1 address string1 */
/* r2 address string2 */
/* r3 address string3 */
/* other address on the stack */
/* thinck to add number other address * 4 to add to the stack */
displayStrings: @ INFO: displayStrings
push {r1-r4,fp,lr} @ save des registres
add fp,sp,#24 @ save paraméters address (6 registers saved * 4 bytes)
mov r4,r0 @ save strings number
cmp r4,#0 @ 0 string -> end
ble 100f
mov r0,r1 @ string 1
bl affichageMess
cmp r4,#1 @ number > 1
ble 100f
mov r0,r2
bl affichageMess
cmp r4,#2
ble 100f
mov r0,r3
bl affichageMess
cmp r4,#3
ble 100f
mov r3,#3
sub r2,r4,#4
1: @ loop extract address string on stack
ldr r0,[fp,r2,lsl #2]
bl affichageMess
subs r2,#1
bge 1b
100:
pop {r1-r4,fp,pc}
/***************************************************/
/* ROUTINES INCLUDE */
/***************************************************/
/* for this file see task include a file in language ARM assembly*/
.include "../affichage.inc"
 
 
</syntaxhighlight>
{{Out}}
<pre>
index : 0 value : 0
index : 1 value : 1
index : 2 value : 2
index : 3 value : 3
index : 4 value : 4
index : 5 value : 5
index : 6 value : 6
index : 7 value : 7
index : 8 value : 8
index : 9 value : 9
 
</pre>
=={{header|Arturo}}==
 
<langsyntaxhighlight lang="rebol">quickselect: function [a k][
arr: new a
while ø [
Line 396 ⟶ 1,152:
 
print map 0..(size v)-1 'i ->
quickselect v i</langsyntaxhighlight>
 
{{out}}
 
<pre>0 1 2 3 4 5 6 7 8 9</pre>
 
=={{header|ATS}}==
 
=== Quickselect working on linear lists ===
 
There is also a stable quicksort here. See it demonstrated at [[Quicksort#A_stable_quicksort_working_on_linear_lists|the quicksort task]].
 
<syntaxhighlight lang="ats">(*------------------------------------------------------------------*)
(*
 
For linear linked lists, using a random pivot:
 
* stable three-way "separation" (a variant of quickselect)
* quickselect
* stable quicksort
 
Also a couple of routines for splitting lists according to a
predicate.
 
Linear list operations are destructive but may avoid doing many
unnecessary allocations. Also they do not require a garbage
collector.
 
*)
 
#include "share/atspre_staload.hats"
 
staload UN = "prelude/SATS/unsafe.sats"
 
#define NIL list_vt_nil ()
#define :: list_vt_cons
 
(*------------------------------------------------------------------*)
(* A simple linear congruential generator for pivot selection. *)
 
(* The multiplier lcg_a comes from Steele, Guy; Vigna, Sebastiano (28
September 2021). "Computationally easy, spectrally good multipliers
for congruential pseudorandom number generators".
arXiv:2001.05304v3 [cs.DS] *)
macdef lcg_a = $UN.cast{uint64} 0xf1357aea2e62a9c5LLU
 
(* lcg_c must be odd. *)
macdef lcg_c = $UN.cast{uint64} 0xbaceba11beefbeadLLU
 
var seed : uint64 = $UN.cast 0
val p_seed = addr@ seed
 
fn
random_double () :<!wrt> double =
let
val (pf, fpf | p_seed) = $UN.ptr0_vtake{uint64} p_seed
val old_seed = ptr_get<uint64> (pf | p_seed)
 
(* IEEE "binary64" or "double" has 52 bits of precision. We will
take the high 48 bits of the seed and divide it by 2**48, to
get a number 0.0 <= randnum < 1.0 *)
val high_48_bits = $UN.cast{double} (old_seed >> 16)
val divisor = $UN.cast{double} (1LLU << 48)
val randnum = high_48_bits / divisor
 
(* The following operation is modulo 2**64, by virtue of standard
C behavior for uint64_t. *)
val new_seed = (lcg_a * old_seed) + lcg_c
 
val () = ptr_set<uint64> (pf | p_seed, new_seed)
prval () = fpf pf
in
randnum
end
 
(*------------------------------------------------------------------*)
 
(* Destructive split into two lists: a list of leading elements that
satisfy a predicate, and the tail of that split. (This is similar
to "span!" in SRFI-1.) *)
extern fun {a : vt@ype}
list_vt_span {n : int}
(pred : &((&a) -<cloptr1> bool),
lst : list_vt (a, n))
: [n1, n2 : nat | n1 + n2 == n]
@(list_vt (a, n1),
list_vt (a, n2))
 
(* Destructive, stable partition into elements less than the pivot,
elements equal to the pivot, and elements greater than the
pivot. *)
extern fun {a : vt@ype}
list_vt_three_way_partition
{n : int}
(compare : &((&a, &a) -<cloptr1> int),
pivot : &a,
lst : list_vt (a, n))
: [n1, n2, n3 : nat | n1 + n2 + n3 == n]
@(list_vt (a, n1),
list_vt (a, n2),
list_vt (a, n3))
 
(* Destructive, stable partition into elements less than the kth least
element, elements equal to it, and elements greater than it. *)
extern fun {a : vt@ype}
list_vt_three_way_separation
{n, k : int | 0 <= k; k < n}
(compare : &((&a, &a) -<cloptr1> int),
k : int k,
lst : list_vt (a, n))
: [n1, n2, n3 : nat | n1 + n2 + n3 == n;
n1 <= k; k < n1 + n2]
@(int n1, list_vt (a, n1),
int n2, list_vt (a, n2),
int n3, list_vt (a, n3))
 
(* Destructive quickselect for linear elements. *)
extern fun {a : vt@ype}
list_vt_select_linear
{n, k : int | 0 <= k; k < n}
(compare : &((&a, &a) -<cloptr1> int),
k : int k,
lst : list_vt (a, n)) : a
extern fun {a : vt@ype}
list_vt_select_linear$clear (x : &a >> a?) : void
 
(* Destructive quickselect for non-linear elements. *)
extern fun {a : t@ype}
list_vt_select
{n, k : int | 0 <= k; k < n}
(compare : &((&a, &a) -<cloptr1> int),
k : int k,
lst : list_vt (a, n)) : a
 
(* Stable quicksort. Also returns the length. *)
extern fun {a : vt@ype}
list_vt_stable_sort
{n : int}
(compare : &((&a, &a) -<cloptr1> int),
lst : list_vt (a, n))
: @(int n, list_vt (a, n))
 
(*------------------------------------------------------------------*)
 
implement {a}
list_vt_span {n} (pred, lst) =
let
fun
loop {n : nat} .<n>.
(pred : &((&a) -<cloptr1> bool),
cursor : &list_vt (a, n) >> list_vt (a, m),
tail : &List_vt a? >> list_vt (a, n - m))
: #[m : nat | m <= n] void =
case+ cursor of
| NIL => tail := NIL
| @ elem :: rest =>
if pred (elem) then
(* elem satisfies the predicate. Move the cursor to the next
cons-pair in the list. *)
let
val () = loop {n - 1} (pred, rest, tail)
prval () = fold@ cursor
in
end
else
(* elem does not satisfy the predicate. Split the list at
the cursor. *)
let
prval () = fold@ cursor
val () = tail := cursor
val () = cursor := NIL
in
end
 
prval () = lemma_list_vt_param lst
 
var cursor = lst
var tail : List_vt a?
val () = loop {n} (pred, cursor, tail)
in
@(cursor, tail)
end
 
(*------------------------------------------------------------------*)
 
implement {a}
list_vt_three_way_partition {n} (compare, pivot, lst) =
//
// WARNING: This implementation is NOT tail-recursive.
//
let
var current_sign : int = 0
 
val p_compare = addr@ compare
val p_pivot = addr@ pivot
val p_current_sign = addr@ current_sign
 
var pred = (* A linear closure. *)
lam (elem : &a) : bool =<cloptr1>
(* Return true iff the sign of the comparison of elem with the
pivot matches the current_sign. *)
let
val @(pf_compare, fpf_compare | p_compare) =
$UN.ptr0_vtake{(&a, &a) -<cloptr1> int} p_compare
val @(pf_pivot, fpf_pivot | p_pivot) =
$UN.ptr0_vtake{a} p_pivot
val @(pf_current_sign, fpf_current_sign | p_current_sign) =
$UN.ptr0_vtake{int} p_current_sign
 
macdef compare = !p_compare
macdef pivot = !p_pivot
macdef current_sign = !p_current_sign
 
val sign = compare (elem, pivot)
val truth =
(sign < 0 && current_sign < 0) ||
(sign = 0 && current_sign = 0) ||
(sign > 0 && current_sign > 0)
 
prval () = fpf_compare pf_compare
prval () = fpf_pivot pf_pivot
prval () = fpf_current_sign pf_current_sign
in
truth
end
 
fun
recurs {n : nat}
(compare : &((&a, &a) -<cloptr1> int),
pred : &((&a) -<cloptr1> bool),
pivot : &a,
current_sign : &int,
lst : list_vt (a, n))
: [n1, n2, n3 : nat | n1 + n2 + n3 == n]
@(list_vt (a, n1),
list_vt (a, n2),
list_vt (a, n3)) =
case+ lst of
| ~ NIL => @(NIL, NIL, NIL)
| @ elem :: tail =>
let
macdef append = list_vt_append<a>
val cmp = compare (elem, pivot)
val () = current_sign := cmp
prval () = fold@ lst
val @(matches, rest) = list_vt_span<a> (pred, lst)
val @(left, middle, right) =
recurs (compare, pred, pivot, current_sign, rest)
in
if cmp < 0 then
@(matches \append left, middle, right)
else if cmp = 0 then
@(left, matches \append middle, right)
else
@(left, middle, matches \append right)
end
 
prval () = lemma_list_vt_param lst
val retvals = recurs (compare, pred, pivot, current_sign, lst)
 
val () = cloptr_free ($UN.castvwtp0{cloptr0} pred)
in
retvals
end
 
(*------------------------------------------------------------------*)
 
fn {a : vt@ype}
three_way_partition_with_random_pivot
{n : nat}
(compare : &((&a, &a) -<cloptr1> int),
n : int n,
lst : list_vt (a, n))
: [n1, n2, n3 : nat | n1 + n2 + n3 == n]
@(int n1, list_vt (a, n1),
int n2, list_vt (a, n2),
int n3, list_vt (a, n3)) =
let
macdef append = list_vt_append<a>
 
var pivot : a
 
val randnum = random_double ()
val i_pivot = $UN.cast{Size_t} (randnum * $UN.cast{double} n)
prval () = lemma_g1uint_param i_pivot
val () = assertloc (i_pivot < i2sz n)
val i_pivot = sz2i i_pivot
 
val @(left, right) = list_vt_split_at<a> (lst, i_pivot)
val+ ~ (pivot_val :: right) = right
val () = pivot := pivot_val
 
val @(left1, middle1, right1) =
list_vt_three_way_partition<a> (compare, pivot, left)
val @(left2, middle2, right2) =
list_vt_three_way_partition<a> (compare, pivot, right)
 
val left = left1 \append left2
val middle = middle1 \append (pivot :: middle2)
val right = right1 \append right2
 
val n1 = length<a> left
val n2 = length<a> middle
val n3 = n - n1 - n2
in
@(n1, left, n2, middle, n3, right)
end
 
(*------------------------------------------------------------------*)
 
implement {a}
list_vt_three_way_separation {n, k} (compare, k, lst) =
(* This is a quickselect with random pivot, returning a three-way
partition, in which the middle partition contains the (k+1)st
least element. *)
let
macdef append = list_vt_append<a>
 
fun
loop {n1, n2, n3, k : nat | 0 <= k; k < n;
n1 + n2 + n3 == n}
(compare : &((&a, &a) -<cloptr1> int),
k : int k,
n1 : int n1,
left : list_vt (a, n1),
n2 : int n2,
middle : list_vt (a, n2),
n3 : int n3,
right : list_vt (a, n3))
: [n1, n2, n3 : nat | n1 + n2 + n3 == n;
n1 <= k; k < n1 + n2]
@(int n1, list_vt (a, n1),
int n2, list_vt (a, n2),
int n3, list_vt (a, n3)) =
if k < n1 then
let
val @(m1, left1, m2, middle1, m3, right1) =
three_way_partition_with_random_pivot<a>
(compare, n1, left)
in
loop (compare, k, m1, left1, m2, middle1,
m3 + n2 + n3,
right1 \append (middle \append right))
end
else if n1 + n2 <= k then
let
val @(m1, left2, m2, middle2, m3, right2) =
three_way_partition_with_random_pivot<a>
(compare, n3, right)
in
loop (compare, k, n1 + n2 + m1,
left \append (middle \append left2),
m2, middle2, m3, right2)
end
else
@(n1, left, n2, middle, n3, right)
 
prval () = lemma_list_vt_param lst
 
val @(n1, left, n2, middle, n3, right) =
three_way_partition_with_random_pivot<a>
(compare, length<a> lst, lst)
in
loop (compare, k, n1, left, n2, middle, n3, right)
end
 
(*------------------------------------------------------------------*)
 
implement {a}
list_vt_select_linear {n, k} (compare, k, lst) =
(* This is a quickselect with random pivot. It is like
list_vt_three_way_separation, but throws away parts of the list that
will not be needed later on. *)
let
implement
list_vt_freelin$clear<a> (x) =
$effmask_all list_vt_select_linear$clear<a> (x)
 
macdef append = list_vt_append<a>
 
fun
loop {n1, n2, n3, k : nat | 0 <= k; k < n1 + n2 + n3}
(compare : &((&a, &a) -<cloptr1> int),
k : int k,
n1 : int n1,
left : list_vt (a, n1),
n2 : int n2,
middle : list_vt (a, n2),
n3 : int n3,
right : list_vt (a, n3)) : a =
if k < n1 then
let
val () = list_vt_freelin<a> middle
val () = list_vt_freelin<a> right
val @(m1, left1, m2, middle1, m3, right1) =
three_way_partition_with_random_pivot<a>
(compare, n1, left)
in
loop (compare, k, m1, left1, m2, middle1, m3, right1)
end
else if n1 + n2 <= k then
let
val () = list_vt_freelin<a> left
val () = list_vt_freelin<a> middle
val @(m1, left1, m2, middle1, m3, right1) =
three_way_partition_with_random_pivot<a>
(compare, n3, right)
in
loop (compare, k - n1 - n2,
m1, left1, m2, middle1, m3, right1)
end
else
let
val () = list_vt_freelin<a> left
val () = list_vt_freelin<a> right
val @(middle1, middle2) =
list_vt_split_at<a> (middle, k - n1)
val () = list_vt_freelin<a> middle1
val+ ~ (element :: middle2) = middle2
val () = list_vt_freelin<a> middle2
in
element
end
 
prval () = lemma_list_vt_param lst
 
val @(n1, left, n2, middle, n3, right) =
three_way_partition_with_random_pivot<a>
(compare, length<a> lst, lst)
in
loop (compare, k, n1, left, n2, middle, n3, right)
end
 
implement {a}
list_vt_select {n, k} (compare, k, lst) =
let
implement
list_vt_select_linear$clear<a> (x) = ()
in
list_vt_select_linear<a> {n, k} (compare, k, lst)
end
 
(*------------------------------------------------------------------*)
 
implement {a}
list_vt_stable_sort {n} (compare, lst) =
(* This is a stable quicksort with random pivot. *)
let
macdef append = list_vt_append<a>
 
fun
recurs {n : int}
{n1, n2, n3 : nat | n1 + n2 + n3 == n}
(compare : &((&a, &a) -<cloptr1> int),
n1 : int n1,
left : list_vt (a, n1),
n2 : int n2,
middle : list_vt (a, n2),
n3 : int n3,
right : list_vt (a, n3))
: @(int n, list_vt (a, n)) =
if 1 < n1 then
let
val @(m1, left1, m2, middle1, m3, right1) =
three_way_partition_with_random_pivot<a>
(compare, n1, left)
val @(_, left) =
recurs {n1} (compare, m1, left1, m2, middle1, m3, right1)
in
if 1 < n3 then
let
val @(m1, left1, m2, middle1, m3, right1) =
three_way_partition_with_random_pivot<a>
(compare, n3, right)
val @(_, right) =
recurs {n3} (compare, m1, left1, m2, middle1,
m3, right1)
in
@(n1 + n2 + n3, left \append (middle \append right))
end
else
@(n1 + n2 + n3, left \append (middle \append right))
end
else if 1 < n3 then
let
val @(m1, left1, m2, middle1, m3, right1) =
three_way_partition_with_random_pivot<a>
(compare, n3, right)
val @(_, right) =
recurs {n3} (compare, m1, left1, m2, middle1, m3, right1)
in
@(n1 + n2 + n3, left \append (middle \append right))
end
else
@(n1 + n2 + n3, left \append (middle \append right))
 
prval () = lemma_list_vt_param lst
 
val @(n1, left, n2, middle, n3, right) =
three_way_partition_with_random_pivot<a>
(compare, length<a> lst, lst)
in
recurs {n} (compare, n1, left, n2, middle, n3, right)
end
 
(*------------------------------------------------------------------*)
 
fn
print_kth (direction : int,
k : int,
lst : !List_vt int) : void =
let
var compare =
lam (x : &int, y : &int) : int =<cloptr1>
if x < y then
~direction
else if x = y then
0
else
direction
 
val lst = copy<int> lst
val n = length<int> lst
val k = g1ofg0 k
val () = assertloc (1 <= k)
val () = assertloc (k <= n)
val element = list_vt_select<int> (compare, k - 1, lst)
 
val () = cloptr_free ($UN.castvwtp0{cloptr0} compare)
in
print! (element)
end
 
fn
demonstrate_quickselect () : void =
let
var example_for_select = $list_vt (9, 8, 7, 6, 5, 0, 1, 2, 3, 4)
 
val () = print! ("With < as order predicate: ")
val () = print_kth (1, 1, example_for_select)
val () = print! (" ")
val () = print_kth (1, 2, example_for_select)
val () = print! (" ")
val () = print_kth (1, 3, example_for_select)
val () = print! (" ")
val () = print_kth (1, 4, example_for_select)
val () = print! (" ")
val () = print_kth (1, 5, example_for_select)
val () = print! (" ")
val () = print_kth (1, 6, example_for_select)
val () = print! (" ")
val () = print_kth (1, 7, example_for_select)
val () = print! (" ")
val () = print_kth (1, 8, example_for_select)
val () = print! (" ")
val () = print_kth (1, 9, example_for_select)
val () = print! (" ")
val () = print_kth (1, 10, example_for_select)
val () = println! ()
 
val () = print! ("With > as order predicate: ")
val () = print_kth (~1, 1, example_for_select)
val () = print! (" ")
val () = print_kth (~1, 2, example_for_select)
val () = print! (" ")
val () = print_kth (~1, 3, example_for_select)
val () = print! (" ")
val () = print_kth (~1, 4, example_for_select)
val () = print! (" ")
val () = print_kth (~1, 5, example_for_select)
val () = print! (" ")
val () = print_kth (~1, 6, example_for_select)
val () = print! (" ")
val () = print_kth (~1, 7, example_for_select)
val () = print! (" ")
val () = print_kth (~1, 8, example_for_select)
val () = print! (" ")
val () = print_kth (~1, 9, example_for_select)
val () = print! (" ")
val () = print_kth (~1, 10, example_for_select)
val () = println! ()
 
val () = list_vt_free<int> example_for_select
in
end
 
fn
demonstrate_quicksort () : void =
let
var example_for_sort =
$list_vt ("elephant", "duck", "giraffe", "deer",
"earwig", "dolphin", "wildebeest", "pronghorn",
"woodlouse", "whip-poor-will")
 
var compare =
lam (x : &stringGt 0,
y : &stringGt 0) : int =<cloptr1>
if x[0] < y[0] then
~1
else if x[0] = y[0] then
0
else
1
 
val () = println! ("stable sort by first character:")
val @(_, sorted_lst) =
list_vt_stable_sort<stringGt 0>
(compare, copy<stringGt 0> example_for_sort)
val () = println! ($UN.castvwtp1{List0 string} sorted_lst)
in
list_vt_free<string> sorted_lst;
list_vt_free<string> example_for_sort;
cloptr_free ($UN.castvwtp0{cloptr0} compare)
end
 
implement
main0 (argc, argv) =
let
 
(* Currently there is no demonstration of
list_vt_three_way_separation. *)
 
val demo_name =
begin
if 2 <= argc then
$UN.cast{string} argv[1]
else
begin
println!
("Please choose \"quickselect\" or \"quicksort\".");
exit (1)
end
end : string
 
in
 
if demo_name = "quickselect" then
demonstrate_quickselect ()
else if demo_name = "quicksort" then
demonstrate_quicksort ()
else
begin
println! ("Please choose \"quickselect\" or \"quicksort\".");
exit (1)
end
 
end
 
(*------------------------------------------------------------------*)</syntaxhighlight>
 
{{out}}
<pre>$ patscc -O3 -DATS_MEMALLOC_LIBC quickselect_task_for_list_vt.dats && ./a.out quickselect
With < as order predicate: 0 1 2 3 4 5 6 7 8 9
With > as order predicate: 9 8 7 6 5 4 3 2 1 0</pre>
 
=={{header|AutoHotkey}}==
{{works with|AutoHotkey_L}} (AutoHotkey1.1+)
A direct implementation of the Wikipedia pseudo-code.
<langsyntaxhighlight AutoHotkeylang="autohotkey">MyList := [9, 8, 7, 6, 5, 0, 1, 2, 3, 4]
Loop, 10
Out .= Select(MyList, 1, MyList.MaxIndex(), A_Index) (A_Index = MyList.MaxIndex() ? "" : ", ")
Line 443 ⟶ 1,848:
, List[i1] := List[i2]
, List[i2] := t
}</langsyntaxhighlight>
'''Output:'''
<pre>0, 1, 2, 3, 4, 5, 6, 7, 8, 9 </pre>
 
=={{header|C}}==
<langsyntaxhighlight lang="c">#include <stdio.h>
#include <string.h>
 
Line 482 ⟶ 1,887:
 
return 0;
}</langsyntaxhighlight>
{{out}}
<pre>
Line 501 ⟶ 1,906:
second implementation that returns IEnumnerable that enumerates through element until Nth smallest element.
<langsyntaxhighlight lang="csharp">// ----------------------------------------------------------------------------------------------
//
// Program.cs - QuickSelect
Line 673 ⟶ 2,078:
#endregion
}
}</langsyntaxhighlight>
{{out}}
<pre>Loop quick select 10 times.
Line 688 ⟶ 2,093:
 
It is already provided in the standard library as <code>std::nth_element()</code>. Although the standard does not explicitly mention what algorithm it must use, the algorithm partitions the sequence into those less than the nth element to the left, and those greater than the nth element to the right, like quickselect; the standard also guarantees that the complexity is "linear on average", which fits quickselect.
<langsyntaxhighlight lang="cpp">#include <algorithm>
#include <iostream>
 
Line 701 ⟶ 2,106:
 
return 0;
}</langsyntaxhighlight>
 
{{out}}
Line 709 ⟶ 2,114:
 
A more explicit implementation:
<langsyntaxhighlight lang="cpp">#include <iterator>
#include <algorithm>
#include <functional>
Line 745 ⟶ 2,150:
 
return 0;
}</langsyntaxhighlight>
 
{{out}}
<pre>0, 1, 2, 3, 4, 5, 6, 7, 8, 9</pre>
 
=={{header|CLU}}==
<syntaxhighlight lang="clu">quick = cluster [T: type] is select
where T has lt: proctype (T,T) returns (bool)
aT = array[T]
sT = sequence[T]
rep = null
swap = proc (list: aT, a, b: int)
temp: T := list[a]
list[a] := list[b]
list[b] := temp
end swap
partition = proc (list: aT, left, right, pivotIndex: int) returns (int)
pivotValue: T := list[pivotIndex]
swap(list, pivotIndex, right)
storeIndex: int := left
for i: int in int$from_to(left, right-1) do
if list[i] < pivotValue then
swap(list, storeIndex, i)
storeIndex := storeIndex + 1
end
end
swap(list, right, storeIndex)
return(storeIndex)
end partition
_select = proc (list: aT, left, right, k: int) returns (T)
if left = right then
return(list[left])
end
pivotIndex: int := left + (right - left + 1) / 2
pivotIndex := partition(list, left, right, pivotIndex)
if k = pivotIndex then
return(list[k])
elseif k < pivotIndex then
return(_select(list, left, pivotIndex-1, k))
else
return(_select(list, pivotIndex + 1, right, k))
end
end _select
select = proc (list: sT, k: int) returns (T)
return(_select(sT$s2a(list), 1, sT$size(list), k))
end select
end quick
 
start_up = proc ()
po: stream := stream$primary_output()
vec: sequence[int] := sequence[int]$[9,8,7,6,5,0,1,2,3,4]
for k: int in int$from_to(1, 10) do
item: int := quick[int]$select(vec, k)
stream$putl(po, int$unparse(k) || ": " || int$unparse(item))
end
end start_up</syntaxhighlight>
{{out}}
<pre>1: 0
2: 1
3: 2
4: 3
5: 4
6: 5
7: 6
8: 7
9: 8
10: 9</pre>
 
=={{header|COBOL}}==
The following is in the Managed COBOL dialect:
{{works with|Visual COBOL}}
<langsyntaxhighlight lang="cobol"> CLASS-ID MainProgram.
METHOD-ID Partition STATIC USING T.
Line 847 ⟶ 2,321:
DISPLAY SPACE
END METHOD.
END CLASS.</langsyntaxhighlight>
 
=={{header|Common Lisp}}==
{{trans|Haskell}}
<langsyntaxhighlight lang="lisp">
(defun quickselect (n _list)
(let* ((ys (remove-if (lambda (x) (< (car _list) x)) (cdr _list)))
Line 865 ⟶ 2,339:
(defparameter a '(9 8 7 6 5 0 1 2 3 4))
(format t "~a~&" (mapcar (lambda (x) (quickselect x a)) (loop for i from 0 below (length a) collect i)))
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 873 ⟶ 2,347:
=={{header|Crystal}}==
{{trans|Ruby}}
<langsyntaxhighlight lang="ruby">def quickselect(a, k)
arr = a.dup # we will be modifying it
loop do
Line 891 ⟶ 2,365:
v = [9, 8, 7, 6, 5, 0, 1, 2, 3, 4]
p v.each_index.map { |i| quickselect(v, i) }.to_a
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 900 ⟶ 2,374:
===Standard Version===
This could use a different algorithm:
<langsyntaxhighlight lang="d">void main() {
import std.stdio, std.algorithm;
 
Line 908 ⟶ 2,382:
write(a[i], " ");
}
}</langsyntaxhighlight>
{{out}}
<pre>0 1 2 3 4 5 6 7 8 9 </pre>
Line 914 ⟶ 2,388:
===Array Version===
{{trans|Java}}
<langsyntaxhighlight lang="d">import std.stdio, std.random, std.algorithm, std.range;
 
T quickSelect(T)(T[] arr, size_t n)
Line 961 ⟶ 2,435:
auto a = [9, 8, 7, 6, 5, 0, 1, 2, 3, 4];
a.length.iota.map!(i => a.quickSelect(i)).writeln;
}</langsyntaxhighlight>
{{out}}
<pre>[0, 1, 2, 3, 4, 5, 6, 7, 8, 9]</pre>
Line 967 ⟶ 2,441:
{{libheader| System.SysUtils}}
{{Trans|Go}}
<syntaxhighlight lang="delphi">
<lang Delphi>
program Quickselect_algorithm;
 
Line 1,027 ⟶ 2,501:
end;
Readln;
end.</langsyntaxhighlight>
 
=={{header|EasyLang}}==
<syntaxhighlight lang="text">
proc qselect k . list[] res .
#
subr partition
mid = left
for i = left + 1 to right
if list[i] < list[left]
mid += 1
swap list[i] list[mid]
.
.
swap list[left] list[mid]
.
left = 1
right = len list[]
while left < right
partition
if mid < k
left = mid + 1
elif mid > k
right = mid - 1
else
left = right
.
.
res = list[k]
.
d[] = [ 9 8 7 6 5 0 1 2 3 4 ]
for i = 1 to len d[]
qselect i d[] r
print r
.
</syntaxhighlight>
 
=={{header|Elixir}}==
{{trans|Erlang}}
<langsyntaxhighlight lang="elixir">defmodule Quick do
def select(k, [x|xs]) do
{ys, zs} = Enum.partition(xs, fn e -> e < x end)
Line 1,049 ⟶ 2,558:
end
 
Quick.test</langsyntaxhighlight>
 
{{out}}
Line 1,059 ⟶ 2,568:
{{trans|Haskell}}
 
<langsyntaxhighlight lang="erlang">
-module(quickselect).
 
Line 1,084 ⟶ 2,593:
X
end.
</syntaxhighlight>
</lang>
 
Output:
Line 1,093 ⟶ 2,602:
=={{header|F Sharp|F#}}==
{{trans|Haskell}}
<langsyntaxhighlight lang="fsharp">
let rec quickselect k list =
match list with
Line 1,111 ⟶ 2,620:
printfn "%A" [for i in 0..(List.length v - 1) -> quickselect i v]
0
</syntaxhighlight>
</lang>
{{out}}
<pre>[0; 1; 2; 3; 4; 5; 6; 7; 8; 9]</pre>
Line 1,117 ⟶ 2,626:
=={{header|Factor}}==
{{trans|Haskell}}
<langsyntaxhighlight lang="factor">USING: combinators kernel make math locals prettyprint sequences ;
IN: rosetta-code.quickselect
 
Line 1,134 ⟶ 2,643:
[ [ quickselect , ] curry each ] { } make . ;
 
MAIN: quickselect-demo</langsyntaxhighlight>
{{out}}
<pre>
Line 1,143 ⟶ 2,652:
Conveniently, a function was already to hand for floating-point numbers and changing the type was trivial - because the array and its associates were declared in the same statement to facilitate exactly that. The style is F77 (except for the A(1:N) usage in the DATA statement, and the END FUNCTION usage) and it did not seem worthwhile activating the MODULE protocol of F90 just to save the tedium of having to declare INTEGER FINDELEMENT in the calling routine - doing so would require four additional lines... On the other hand, a MODULE would enable the convenient development of a collection of near-clones, one for each type of array (INTEGER, REAL*4, REAL*8) which could then be collected via an INTERFACE statement into forming an apparently generic function so that one needn't have to remember FINDELEMENTI2, FINDELEMENTI4, FINDELEMENTF4, FINDELEMENTF8, and so on. With multiple parameters of various types, the combinations soon become tiresomely numerous.
 
Those of a delicate disposition may wish to avert their eyes from the three-way IF-statement... <langsyntaxhighlight Fortranlang="fortran"> INTEGER FUNCTION FINDELEMENT(K,A,N) !I know I can.
Chase an order statistic: FindElement(N/2,A,N) leads to the median, with some odd/even caution.
Careful! The array is shuffled: for i < K, A(i) <= A(K); for i > K, A(i) >= A(K).
Line 1,193 ⟶ 2,702:
END DO !On to the next trial.
 
END !That was easy.</langsyntaxhighlight>
 
To demonstrate that the array, if unsorted, will likely have elements re-positioned, the array's state after each call is shown.<pre>Selection of the i'th element in order from an array.
Line 1,216 ⟶ 2,725:
=={{header|FreeBASIC}}==
Una implementación directa del pseudocódigo de Wikipedia.
<langsyntaxhighlight lang="freebasic">
Dim Shared As Long array(9), pivote
 
Line 1,262 ⟶ 2,771:
Next i
Sleep
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 1,271 ⟶ 2,780:
 
=={{header|Go}}==
<langsyntaxhighlight lang="go">package main
 
import "fmt"
Line 1,311 ⟶ 2,820:
fmt.Println(quickselect(v, i))
}
}</langsyntaxhighlight>
{{out}}
<pre>
Line 1,328 ⟶ 2,837:
A more generic version that works for any container that conforms to <code>sort.Interface</code>:
 
<langsyntaxhighlight lang="go">package main
 
import (
Line 1,382 ⟶ 2,891:
fmt.Println(v[quickselect(sort.IntSlice(v), i)])
}
}</langsyntaxhighlight>
{{out}}
<pre>
Line 1,398 ⟶ 2,907:
 
=={{header|Haskell}}==
<langsyntaxhighlight lang="haskell">import Data.List (partition)
 
quickselect
Line 1,415 ⟶ 2,924:
print
((fmap . quickselect) <*> zipWith const [0 ..] $
[9, 8, 7, 6, 5, 0, 1, 2, 3, 4])</langsyntaxhighlight>
{{out}}
<pre>[0,1,2,3,4,5,6,7,8,9]</pre>
Line 1,422 ⟶ 2,931:
 
The following works in both languages.
<langsyntaxhighlight lang="unicon">procedure main(A)
every writes(" ",select(1 to *A, A, 1, *A)|"\n")
end
Line 1,442 ⟶ 2,951:
A[max] :=: A[sI]
return sI
end</langsyntaxhighlight>
 
Sample run:
Line 1,463 ⟶ 2,972:
With that out of the way, here's a pedantic (and laughably inefficient) implementation of quickselect:
 
<langsyntaxhighlight Jlang="j">quickselect=:4 :0
if. 0=#y do. _ return. end.
n=.?#y
Line 1,476 ⟶ 2,985:
end.
end.
)</langsyntaxhighlight>
 
"Proof" that it works:
 
<langsyntaxhighlight Jlang="j"> 8 quickselect 9, 8, 7, 6, 5, 0, 1, 2, 3, 4
8</langsyntaxhighlight>
 
And, the required task example:
 
<langsyntaxhighlight Jlang="j"> ((10 {./:~) quickselect"0 1 ]) 9, 8, 7, 6, 5, 0, 1, 2, 3, 4
0 1 2 3 4 5 6 7 8 9</langsyntaxhighlight>
 
(Insert here: puns involving greater transparency, the emperor's new clothes, burlesque and maybe the dance of the seven veils.)
 
=={{header|Java}}==
<langsyntaxhighlight lang="java">import java.util.Random;
 
public class QuickSelect {
Line 1,543 ⟶ 3,052:
}
 
}</langsyntaxhighlight>
 
{{out}}
Line 1,550 ⟶ 3,059:
=={{header|Javascript}}==
===ES5===
<langsyntaxhighlight lang="javascript">// this just helps make partition read better
function swap(items, firstIndex, secondIndex) {
var temp = items[firstIndex];
Line 1,620 ⟶ 3,129:
// return quickselectIterative(array, k);
}
}</langsyntaxhighlight>
 
'''Example''':
<syntaxhighlight lang="javascript">
<lang Javascript>
var array = [9, 8, 7, 6, 5, 0, 1, 2, 3, 4],
ks = Array.apply(null, {length: 10}).map(Number.call, Number);
ks.map(k => { KthElement.find(array, k) });</langsyntaxhighlight>
{{out}}
<langsyntaxhighlight JavaScriptlang="javascript">[0, 1, 2, 3, 4, 5, 6, 7, 8, 9];</langsyntaxhighlight>
 
===ES6===
{{Trans|Haskell}}
<langsyntaxhighlight JavaScriptlang="javascript">(() => {
'use strict';
 
Line 1,683 ⟶ 3,192:
 
return map(i => quickSelect(i, v), enumFromTo(0, length(v) - 1));
})();</langsyntaxhighlight>
{{Out}}
<langsyntaxhighlight JavaScriptlang="javascript">[0, 1, 2, 3, 4, 5, 6, 7, 8, 9]</langsyntaxhighlight>
 
=={{header|jq}}==
{{works with|jq|1.4}}
<langsyntaxhighlight lang="jq"># Emit the k-th smallest item in the input array,
# or nothing if k is too small or too large.
# The smallest corresponds to k==1.
Line 1,718 ⟶ 3,227:
end;
 
if length < k or k <= 0 then empty else [k-1, .] | qs end;</langsyntaxhighlight>
 
'''Example''':
Notice that values of k that are too large or too small generate nothing.
<langsyntaxhighlight lang="jq">(0, 12, range(1;11)) as $k
| [9, 8, 7, 6, 5, 0, 1, 2, 3, 4] | quickselect($k)
| "k=\($k) => \(.)"</langsyntaxhighlight>
{{out}}
<langsyntaxhighlight lang="sh">$ jq -n -r -f quickselect.jq
k=1 => 0
k=2 => 1
Line 1,737 ⟶ 3,246:
k=9 => 8
k=10 => 9
$</langsyntaxhighlight>
 
=={{header|Julia}}==
{{works with|Julia|0.6}}
 
Using builtin function <code>selectpartialsort</code>:
<langsyntaxhighlight lang="julia">v = [9, 8, 7, 6, 5, 0, 1, 2, 3, 4]
@show v selectpartialsort(v, 1:10)
</syntaxhighlight>
</lang>
 
{{out}}
<pre>v = [9, 8, 7, 6, 5, 0, 1, 2, 3, 4]
selectpartialsort(v, 1:10) = [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]</pre>
 
=={{header|Kotlin}}==
<langsyntaxhighlight lang="scala">// version 1.1.2
 
const val MAX = Int.MAX_VALUE
Line 1,796 ⟶ 3,304:
}
println()
}</langsyntaxhighlight>
 
{{out}}
Line 1,804 ⟶ 3,312:
 
=={{header|Lua}}==
<langsyntaxhighlight Lualang="lua">function partition (list, left, right, pivotIndex)
local pivotValue = list[pivotIndex]
list[pivotIndex], list[right] = list[right], list[pivotIndex]
Line 1,836 ⟶ 3,344:
math.randomseed(os.time())
local vec = {9, 8, 7, 6, 5, 0, 1, 2, 3, 4}
for i = 1, 10 do print(i, quickSelect(vec, 1, #vec, i) .. " ") end</langsyntaxhighlight>
{{out}}
<pre>1 0
Line 1,850 ⟶ 3,358:
 
=={{header|Maple}}==
<langsyntaxhighlight Maplelang="maple">part := proc(arr, left, right, pivot)
local val,safe,i:
val := arr[pivot]:
Line 1,885 ⟶ 3,393:
map(x->printf("%d ", x), demo):
print(quickselect(demo,7)):
print(quickselect(demo,14)):</langsyntaxhighlight>
{{Out|Example}}
<pre>5 4 2 1 3 6 8 11 11 11 8 11 9 11 16 20 20 18 17 16
Line 1,892 ⟶ 3,400:
 
=={{header|Mathematica}} / {{header|Wolfram Language}}==
<langsyntaxhighlight Mathematicalang="mathematica">Quickselect[ds : DataStructure["DynamicArray", _], k_] := QuickselectWorker[ds, 1, ds["Length"], k];
QuickselectWorker[ds_, low0_, high0_, k_] := Module[{pivotIdx, low = low0, high = high0},
While[True,
Line 1,921 ⟶ 3,429:
];
ds = CreateDataStructure["DynamicArray", {9, 8, 7, 6, 5, 0, 1, 2, 3, 4}];
Quickselect[ds, #] & /@ Range[10]</langsyntaxhighlight>
{{out}}
<pre>{0, 1, 2, 3, 4, 5, 6, 7, 8, 9}</pre>
 
=={{header|Mercury}}==
{{works with|Mercury|22.01.1}}
 
 
<syntaxhighlight lang="mercury">%%%-------------------------------------------------------------------
 
:- module quickselect_task.
 
:- interface.
:- import_module io.
:- pred main(io, io).
:- mode main(di, uo) is det.
 
:- implementation.
:- import_module array.
:- import_module exception.
:- import_module int.
:- import_module list.
:- import_module random.
:- import_module random.sfc64.
:- import_module string.
 
%%%-------------------------------------------------------------------
%%%
%%% Partitioning a subarray into two halves: one with elements less
%%% than or equal to a pivot, the other with elements greater than or
%%% equal to a pivot.
%%%
%%% The implementation is tail-recursive.
%%%
 
:- pred partition(pred(T, T), T, int, int, array(T), array(T), int).
:- mode partition(pred(in, in) is semidet, in, in, in,
array_di, array_uo, out).
partition(Less_than, Pivot, I_first, I_last, Arr0, Arr, I_pivot) :-
I = I_first - 1,
J = I_last + 1,
partition_loop(Less_than, Pivot, I, J, Arr0, Arr, I_pivot).
 
:- pred partition_loop(pred(T, T), T, int, int,
array(T), array(T), int).
:- mode partition_loop(pred(in, in) is semidet, in, in, in,
array_di, array_uo, out).
partition_loop(Less_than, Pivot, I, J, Arr0, Arr, Pivot_index) :-
if (I = J) then (Arr = Arr0,
Pivot_index = I)
else (I1 = I + 1,
I2 = search_right(Less_than, Pivot, I1, J, Arr0),
(if (I2 = J) then (Arr = Arr0,
Pivot_index = J)
else (J1 = J - 1,
J2 = search_left(Less_than, Pivot, I2, J1, Arr0),
swap(I2, J2, Arr0, Arr1),
partition_loop(Less_than, Pivot, I2, J2, Arr1, Arr,
Pivot_index)))).
 
:- func search_right(pred(T, T), T, int, int, array(T)) = int.
:- mode search_right(pred(in, in) is semidet,
in, in, in, in) = out is det.
search_right(Less_than, Pivot, I, J, Arr0) = K :-
if (I = J) then (I = K)
else if Less_than(Pivot, Arr0^elem(I)) then (I = K)
else (search_right(Less_than, Pivot, I + 1, J, Arr0) = K).
 
:- func search_left(pred(T, T), T, int, int, array(T)) = int.
:- mode search_left(pred(in, in) is semidet,
in, in, in, in) = out is det.
search_left(Less_than, Pivot, I, J, Arr0) = K :-
if (I = J) then (J = K)
else if Less_than(Arr0^elem(J), Pivot) then (J = K)
else (search_left(Less_than, Pivot, I, J - 1, Arr0) = K).
 
%%%-------------------------------------------------------------------
%%%
%%% Quickselect with a random pivot.
%%%
%%% The implementation is tail-recursive. One has to pass the routine
%%% a random number generator of type M, attached to the IO state.
%%%
%%% I use a random pivot to get O(n) worst case *expected* running
%%% time. Code using a random pivot is easy to write and read, and for
%%% most purposes comes close enough to a criterion set by Scheme's
%%% SRFI-132: "Runs in O(n) time." (See
%%% https://srfi.schemers.org/srfi-132/srfi-132.html)
%%%
%%% Of course we are not bound here by SRFI-132, but still I respect
%%% it as a guide.
%%%
%%% A "median of medians" pivot gives O(n) running time, but is more
%%% complicated. (That is, of course, assuming you are not writing
%%% your own random number generator and making it a complicated one.)
%%%
 
%% quickselect/8 selects the (K+1)th largest element of Arr.
:- pred quickselect(pred(T, T)::pred(in, in) is semidet, int::in,
array(T)::array_di, array(T)::array_uo,
T::out, M::in, io::di, io::uo)
is det <= urandom(M, io).
quickselect(Less_than, K, Arr0, Arr, Elem, M, !IO) :-
bounds(Arr0, I_first, I_last),
quickselect(Less_than, I_first, I_last, K, Arr0, Arr, Elem, M, !IO).
 
%% quickselect/10 selects the (K+1)th largest element of
%% Arr[I_first..I_last].
:- pred quickselect(pred(T, T)::pred(in, in) is semidet,
int::in, int::in, int::in,
array(T)::array_di, array(T)::array_uo,
T::out, M::in, io::di, io::uo)
is det <= urandom(M, io).
quickselect(Less_than, I_first, I_last, K, Arr0, Arr, Elem, M, !IO) :-
if (0 =< K, K =< I_last - I_first)
then (K_adjusted_for_range = K + I_first,
quickselect_loop(Less_than, I_first, I_last,
K_adjusted_for_range,
Arr0, Arr, Elem, M, !IO))
else throw("out of range").
 
:- pred quickselect_loop(pred(T, T)::pred(in, in) is semidet,
int::in, int::in, int::in,
array(T)::array_di, array(T)::array_uo,
T::out, M::in, io::di, io::uo)
is det <= urandom(M, io).
quickselect_loop(Less_than, I_first, I_last, K,
Arr0, Arr, Elem, M, !IO) :-
if (I_first = I_last) then (Arr = Arr0,
Elem = Arr0^elem(I_first))
else (uniform_int_in_range(M, I_first, I_last - I_first + 1,
I_pivot, !IO),
Pivot = Arr0^elem(I_pivot),
 
%% Move the last element to where the pivot had been. Perhaps
%% the pivot was already the last element, of course. In any
%% case, we shall partition only from I_first to I_last - 1.
Elem_last = Arr0^elem(I_last),
Arr1 = (Arr0^elem(I_pivot) := Elem_last),
 
%% Partition the array in the range I_first..I_last - 1,
%% leaving out the last element (which now can be considered
%% garbage).
partition(Less_than, Pivot, I_first, I_last - 1, Arr1, Arr2,
I_final),
 
%% Now everything that is less than the pivot is to the left
%% of I_final.
 
%% Put the pivot at I_final, moving the element that had been
%% there to the end. If I_final = I_last, then this element is
%% actually garbage and will be overwritten with the pivot,
%% which turns out to be the greatest element. Otherwise, the
%% moved element is not less than the pivot and so the
%% partitioning is preserved.
Elem_to_move = Arr2^elem(I_final),
Arr3 = (Arr2^elem(I_last) := Elem_to_move),
Arr4 = (Arr3^elem(I_final) := Pivot),
 
%% Compare I_final and K, to see what to do next.
(if (I_final < K)
then quickselect_loop(Less_than, I_final + 1, I_last, K,
Arr4, Arr, Elem, M, !IO)
else if (K < I_final)
then quickselect_loop(Less_than, I_first, I_final - 1, K,
Arr4, Arr, Elem, M, !IO)
else (Arr = Arr4,
Elem = Arr4^elem(I_final)))).
 
%%%-------------------------------------------------------------------
 
:- func example_numbers = list(int).
example_numbers = [9, 8, 7, 6, 5, 0, 1, 2, 3, 4].
 
main(!IO) :-
(sfc64.init(P, S)),
make_io_urandom(P, S, M, !IO),
Print_kth_greatest = (pred(K::in, di, uo) is det -->
print_kth_greatest(K, example_numbers, M)),
Print_kth_least = (pred(K::in, di, uo) is det -->
print_kth_least(K, example_numbers, M)),
print("With < as order predicate: ", !IO),
foldl(Print_kth_least, 1 `..` 10, !IO),
print_line("", !IO),
print("With > as order predicate: ", !IO),
foldl(Print_kth_greatest, 1 `..` 10, !IO),
print_line("", !IO).
 
:- pred print_kth_least(int::in, list(int)::in,
M::in, io::di, io::uo)
is det <= urandom(M, io).
print_kth_least(K, Numbers_list, M, !IO) :-
(array.from_list(Numbers_list, Arr0)),
quickselect(<, K - 1, Arr0, _, Elem, M, !IO),
print(" ", !IO),
print(Elem, !IO).
 
:- pred print_kth_greatest(int::in, list(int)::in,
M::in, io::di, io::uo)
is det <= urandom(M, io).
print_kth_greatest(K, Numbers_list, M, !IO) :-
(array.from_list(Numbers_list, Arr0)),
 
%% Notice that the "Less_than" predicate is actually "greater
%% than". :) One can think of this as meaning that a greater number
%% has an *ordinal* that is "less than"; that is, it "comes before"
%% in the order.
quickselect(>, K - 1, Arr0, _, Elem, M, !IO),
 
print(" ", !IO),
print(Elem, !IO).
 
 
%%%-------------------------------------------------------------------
%%% local variables:
%%% mode: mercury
%%% prolog-indent-width: 2
%%% end:</syntaxhighlight>
 
{{out}}
<pre>$ mmc quickselect_task.m && ./quickselect_task
With < as order predicate: 0 1 2 3 4 5 6 7 8 9
With > as order predicate: 9 8 7 6 5 4 3 2 1 0</pre>
 
=={{header|NetRexx}}==
<langsyntaxhighlight NetRexxlang="netrexx">/* NetRexx */
options replace format comments java crossref symbols nobinary
/** @see <a href="http://en.wikipedia.org/wiki/Quickselect">http://en.wikipedia.org/wiki/Quickselect</a> */
Line 2,023 ⟶ 3,751:
end k_
return list
</langsyntaxhighlight>
{{out}}
<pre>
Line 2,040 ⟶ 3,768:
 
=={{header|Nim}}==
<langsyntaxhighlight lang="nim">proc qselect[T](a: var openarray[T]; k: int, inl = 0, inr = -1): T =
var r = if inr >= 0: inr else: a.high
var st = 0
Line 2,058 ⟶ 3,786:
for i in 0..9:
var y = x
echo i, ": ", qselect(y, i)</langsyntaxhighlight>
Output:
<pre>0: 0
Line 2,072 ⟶ 3,800:
 
=={{header|OCaml}}==
<langsyntaxhighlight lang="ocaml">let rec quickselect k = function
[] -> failwith "empty"
| x :: xs -> let ys, zs = List.partition ((>) x) xs in
Line 2,081 ⟶ 3,809:
quickselect (k-l-1) zs
else
x</langsyntaxhighlight>
Usage:
<pre>
Line 2,091 ⟶ 3,819:
 
=={{header|PARI/GP}}==
<langsyntaxhighlight lang="parigp">part(list, left, right, pivotIndex)={
my(pivotValue=list[pivotIndex],storeIndex=left,t);
t=list[pivotIndex];
Line 2,118 ⟶ 3,846:
quickselect(list, pivotIndex + 1, right, n)
)
};</langsyntaxhighlight>
 
=={{header|Perl}}==
<langsyntaxhighlight Perllang="perl">my @list = qw(9 8 7 6 5 0 1 2 3 4);
print join ' ', map { qselect(\@list, $_) } 1 .. 10 and print "\n";
 
Line 2,139 ⟶ 3,867:
}
else { $pivot }
}</langsyntaxhighlight>
 
{{out}}
Line 2,145 ⟶ 3,873:
 
=={{header|Phix}}==
<!--<langsyntaxhighlight Phixlang="phix">(phixonline)-->
<span style="color: #004080;">sequence</span> <span style="color: #000000;">s</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">9</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">8</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">7</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">6</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">5</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">0</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">2</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">3</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">4</span><span style="color: #0000FF;">}</span>
Line 2,176 ⟶ 3,904:
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #0000FF;">{}</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">wait_key</span><span style="color: #0000FF;">()</span>
<!--</langsyntaxhighlight>-->
{{out}}
<pre>
0 1 2 3 4 5 6 7 8 9
</pre>
 
=={{header|Picat}}==
From the Wikipedia algorithm.
<syntaxhighlight lang="picat">main =>
L = [9,8,7,6,5,0,1,2,3,4],
Len = L.len,
println([select(L,1,Len,I) : I in 1..Len]),
nl.
 
select(List, Left, Right, K) = Select =>
if Left = Right then
Select = List[Left]
else
PivotIndex = partition(List, Left, Right, random(Left,Right)),
if K == PivotIndex then
Select = List[K]
elseif K < PivotIndex then
Select = select(List, Left, PivotIndex-1, K)
else
Select = select(List, PivotIndex+1, Right, K)
end
end.
 
partition(List, Left, Right, PivotIndex) = StoreIndex =>
PivotValue = List[PivotIndex],
swap(List,PivotIndex,Right),
StoreIndex = Left,
foreach(I in Left..Right-1)
if List[I] @< PivotValue then
swap(List,StoreIndex,I),
StoreIndex := StoreIndex+1
end
end,
swap(List,Right,StoreIndex).
 
% swap L[I] <=> L[J]
swap(L,I,J) =>
T = L[I],
L[I] := L[J],
L[J] := T.</syntaxhighlight>
 
{{out}}
<pre>[0,1,2,3,4,5,6,7,8,9]</pre>
 
=={{header|PicoLisp}}==
<langsyntaxhighlight PicoLisplang="picolisp">(seed (in "/dev/urandom" (rd 8)))
(de swapL (Lst X Y)
(let L (nth Lst Y)
Line 2,212 ⟶ 3,983:
(mapcar
'((N) (quick Lst N))
(range 0 9) ) ) )</langsyntaxhighlight>
{{out}}
<pre>(0 1 2 3 4 5 6 7 8 9)</pre>
 
=={{header|PL/I}}==
<syntaxhighlight lang="pl/i">
<lang PL/I>
quick: procedure options (main); /* 4 April 2014 */
 
Line 2,276 ⟶ 4,047:
end;
 
end quick;</langsyntaxhighlight>
Output:
<pre>
Line 2,292 ⟶ 4,063:
 
=={{header|PowerShell}}==
<syntaxhighlight lang="powershell">
<lang PowerShell>
function partition($list, $left, $right, $pivotIndex) {
$pivotValue = $list[$pivotIndex]
Line 2,324 ⟶ 4,095:
$arr = @(9, 8, 7, 6, 5, 0, 1, 2, 3, 4)
"$(quickselect $arr)"
</syntaxhighlight>
</lang>
<b>Output:</b>
<pre>
Line 2,332 ⟶ 4,103:
=={{header|PureBasic}}==
A direct implementation of the Wikipedia pseudo-code.
<syntaxhighlight lang="purebasic">
<lang PureBasic>
Procedure QuickPartition (Array L(1), left, right, pivotIndex)
pivotValue = L(pivotIndex)
Line 2,369 ⟶ 4,140:
For i=0 To 9
Debug QuickSelect(L(),0,9,i)
Next i</langsyntaxhighlight>
{{out}}
<pre>0 1 2 3 4 5 6 7 8 9</pre>
Line 2,376 ⟶ 4,147:
===Procedural===
A direct implementation of the Wikipedia pseudo-code, using a random initial pivot. I added some input flexibility allowing sensible defaults for left and right function arguments.
<langsyntaxhighlight lang="python">import random
 
def partition(vector, left, right, pivotIndex):
Line 2,420 ⟶ 4,191:
if __name__ == '__main__':
v = [9, 8, 7, 6, 5, 0, 1, 2, 3, 4]
print([select(v, i) for i in range(10)])</langsyntaxhighlight>
 
{{out}}
Line 2,428 ⟶ 4,199:
{{Trans|Haskell}}
{{Works with|Python|3}}
<langsyntaxhighlight lang="python">'''Quick select'''
 
from functools import reduce
Line 2,485 ⟶ 4,256:
# MAIN ---
if __name__ == '__main__':
main()</langsyntaxhighlight>
{{Out}}
<pre>[0, 1, 2, 3, 4, 5, 6, 7, 8, 9]</pre>
 
=={{header|Racket}}==
<langsyntaxhighlight lang="racket">(define (quickselect A k)
(define pivot (list-ref A (random (length A))))
(define A1 (filter (curry > pivot) A))
Line 2,501 ⟶ 4,272:
(define a '(9 8 7 6 5 0 1 2 3 4))
(display (string-join (map number->string (for/list ([k 10]) (quickselect a (+ 1 k)))) ", "))
</syntaxhighlight>
</lang>
{{out}}
<pre>0, 1, 2, 3, 4, 5, 6, 7, 8, 9</pre>
Line 2,509 ⟶ 4,280:
{{trans|Python}}
{{works with|rakudo|2015-10-20}}
<syntaxhighlight lang="raku" perl6line>my @v = <9 8 7 6 5 0 1 2 3 4>;
say map { select(@v, $_) }, 1 .. 10;
Line 2,550 ⟶ 4,321:
}
}
}</langsyntaxhighlight>
{{out}}
<pre>0 1 2 3 4 5 6 7 8 9</pre>
Line 2,556 ⟶ 4,327:
=={{header|REXX}}==
===uses in-line swap===
<langsyntaxhighlight lang="rexx">/*REXX program sorts a list (which may be numbers) by using the quick select algorithm.*/
parse arg list; if list='' then list= 9 8 7 6 5 0 1 2 3 4 /*Not given? Use default.*/
say right('list: ', 22) list
Line 2,587 ⟶ 4,358:
L= new+1 /*increase the left half *f the array.*/
end
end /*forever*/</langsyntaxhighlight>
{{out|output|text=&nbsp; when using the default input:}}
<pre>
Line 2,605 ⟶ 4,376:
 
===uses swap subroutine===
<langsyntaxhighlight lang="rexx">/*REXX program sorts a list (which may be numbers) by using the quick select algorithm. */
parse arg list; if list='' then list= 9 8 7 6 5 0 1 2 3 4 /*Not given? Use default.*/
say right('list: ', 22) list
Line 2,638 ⟶ 4,409:
end /*forever*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
swap: parse arg _1,_2; parse value @._1 @._2 with @._2 @._1; return /*swap 2 items.*/</langsyntaxhighlight>
{{out|output|text=&nbsp; is the identical to the 1<sup>st</sup> REXX version.}} <br><br>
 
=={{header|Ring}}==
<langsyntaxhighlight lang="ring">
aList = [9, 8, 7, 6, 5, 0, 1, 2, 3, 4]
see partition(aList, 9, 4, 2) + nl
Line 2,663 ⟶ 4,434:
next
return storeIndex
</syntaxhighlight>
</lang>
 
=={{header|Ruby}}==
<langsyntaxhighlight lang="ruby">def quickselect(a, k)
arr = a.dup # we will be modifying it
loop do
Line 2,683 ⟶ 4,454:
 
v = [9, 8, 7, 6, 5, 0, 1, 2, 3, 4]
p v.each_index.map { |i| quickselect(v, i) }</langsyntaxhighlight>
 
{{out}}
Line 2,689 ⟶ 4,460:
 
=={{header|Rust}}==
<langsyntaxhighlight lang="rust">// See https://en.wikipedia.org/wiki/Quickselect
 
fn partition<T: PartialOrd>(a: &mut [T], left: usize, right: usize, pivot: usize) -> usize {
Line 2,739 ⟶ 4,510:
println!("n = {}, nth element = {}", n + 1, b[n]);
}
}</langsyntaxhighlight>
 
{{out}}
Line 2,756 ⟶ 4,527:
 
=={{header|Scala}}==
<langsyntaxhighlight lang="scala">import scala.util.Random
 
object QuickSelect {
Line 2,775 ⟶ 4,546:
println((0 until v.length).map(quickSelect(v, _)).mkString(", "))
}
}</langsyntaxhighlight>
 
{{out}}
<pre>0, 1, 2, 3, 4, 5, 6, 7, 8, 9</pre>
 
=={{header|Scheme}}==
{{trans|Mercury}}
{{works with|Gauche Scheme|0.9.11-p1}}
{{works with|Chibi Scheme|0.10.0 "neon"}}
 
 
The program is written in R7RS-small Scheme. It will run on CHICKEN 5 Scheme if you have the necessary eggs installed and use the "-R r7rs" option.
 
<syntaxhighlight lang="scheme">;;
;; Quickselect with random pivot.
;;
;; Such a pivot provides O(n) worst-case *expected* time.
;;
;; One can get true O(n) time by using "median of medians" to choose
;; the pivot, but quickselect with a median of medians pivot is a
;; complicated algorithm. See
;; https://en.wikipedia.org/w/index.php?title=Median_of_medians&oldid=1082505985
;;
;; Random pivot has the further advantage that it does not require any
;; comparisons of array elements.
;;
;; By the way, SRFI-132 specifies that vector-select! have O(n)
;; running time, and yet the reference implementation (as of 21 May
;; 2022) uses random pivot. I am pretty sure you cannot count on an
;; implementation having "true" O(n) behavior.
;;
 
(import (scheme base))
(import (scheme case-lambda))
(import (scheme write))
(import (only (scheme process-context) exit))
(import (only (srfi 27) random-integer))
 
(define (vector-swap! vec i j)
(let ((xi (vector-ref vec i))
(xj (vector-ref vec j)))
(vector-set! vec i xj)
(vector-set! vec j xi)))
 
(define (search-right <? pivot i j vec)
(let loop ((i i))
(cond ((= i j) i)
((<? pivot (vector-ref vec i)) i)
(else (loop (+ i 1))))))
 
(define (search-left <? pivot i j vec)
(let loop ((j j))
(cond ((= i j) j)
((<? (vector-ref vec j) pivot) j)
(else (loop (- j 1))))))
 
(define (partition <? pivot i-first i-last vec)
;; Partition a subvector into two halves: one with elements less
;; than or equal to a pivot, the other with elements greater than or
;; equal to a pivot. Returns an index where anything less than the
;; pivot is to the left of the index, and anything greater than the
;; pivot is either at the index or to its right. The implementation
;; is tail-recursive.
(let loop ((i (- i-first 1))
(j (+ i-last 1)))
(if (= i j)
i
(let ((i (search-right <? pivot (+ i 1) j vec)))
(if (= i j)
i
(let ((j (search-left <? pivot i (- j 1) vec)))
(vector-swap! vec i j)
(loop i j)))))))
 
(define (partition-around-random-pivot <? i-first i-last vec)
(let* ((i-pivot (+ i-first (random-integer (- i-last i-first -1))))
(pivot (vector-ref vec i-pivot)))
 
;; Move the last element to where the pivot had been. Perhaps the
;; pivot was already the last element, of course. In any case, we
;; shall partition only from I_first to I_last - 1.
(vector-set! vec i-pivot (vector-ref vec i-last))
 
;; Partition the array in the range I_first..I_last - 1, leaving
;; out the last element (which now can be considered garbage).
(let ((i-final (partition <? pivot i-first (- i-last 1) vec)))
 
;; Now everything that is less than the pivot is to the left of
;; I_final.
 
;; Put the pivot at I_final, moving the element that had been
;; there to the end. If I_final = I_last, then this element is
;; actually garbage and will be overwritten with the pivot,
;; which turns out to be the greatest element. Otherwise, the
;; moved element is not less than the pivot and so the
;; partitioning is preserved.
(vector-set! vec i-last (vector-ref vec i-final))
(vector-set! vec i-final pivot)
 
;; Return i-final, the final position of the pivot element.
i-final)))
 
(define quickselect!
(case-lambda
 
((<? vec k)
;; Select the (k+1)st least element of vec.
(quickselect! <? 0 (- (vector-length vec) 1) vec k))
 
((<? i-first i-last vec k)
;; Select the (k+1)st least element of vec[i-first..i-last].
(unless (and (<= 0 k) (<= k (- i-last i-first)))
;; Here you more likely want to raise an exception, but how to
;; do so is not specified in R7RS small. (It *is* specified in
;; R6RS, but R6RS features are widely unsupported by Schemes.)
(display "out of range" (current-error-port))
(exit 1))
(let ((k (+ k i-first))) ; Adjust k for index range.
(let loop ((i-first i-first)
(i-last i-last))
(if (= i-first i-last)
(vector-ref vec i-first)
(let ((i-final (partition-around-random-pivot
<? i-first i-last vec)))
;; Compare i-final and k, to see what to do next.
(cond ((< i-final k) (loop (+ i-final 1) i-last))
((< k i-final) (loop i-first (- i-final 1)))
(else (vector-ref vec i-final))))))))))
 
(define (print-kth <? k numbers-vector)
(let* ((vec (vector-copy numbers-vector))
(elem (quickselect! <? vec (- k 1))))
(display " ")
(display elem)))
 
(define example-numbers #(9 8 7 6 5 0 1 2 3 4))
 
(display "With < as order predicate: ")
(do ((k 1 (+ k 1)))
((= k 11))
(print-kth < k example-numbers))
(newline)
(display "With > as order predicate: ")
(do ((k 1 (+ k 1)))
((= k 11))
(print-kth > k example-numbers))
(newline)</syntaxhighlight>
 
{{out}}
<pre>$ gosh quickselect_task.scm
With < as order predicate: 0 1 2 3 4 5 6 7 8 9
With > as order predicate: 9 8 7 6 5 4 3 2 1 0</pre>
 
=={{header|Sidef}}==
<langsyntaxhighlight lang="ruby">func quickselect(a, k) {
var pivot = a.pick;
var left = a.grep{|i| i < pivot};
var right = a.grep{|i| i > pivot};
 
given(var l = left.len) { |l|
when (k) { pivot }
case (k < l) { __FUNC__(left, k) }
default { __FUNC__(right, k - l - 1) }
}
}
 
var v = [9, 8, 7, 6, 5, 0, 1, 2, 3, 4];
say v.range.map{|i| quickselect(v, i)};</langsyntaxhighlight>
{{out}}
<pre>[0, 1, 2, 3, 4, 5, 6, 7, 8, 9]</pre>
 
=={{header|Standard ML}}==
<langsyntaxhighlight lang="sml">fun quickselect (_, _, []) = raise Fail "empty"
| quickselect (k, cmp, x :: xs) = let
val (ys, zs) = List.partition (fn y => cmp (y, x) = LESS) xs
Line 2,810 ⟶ 4,729:
else
x
end</langsyntaxhighlight>
Usage:
<pre>
Line 2,820 ⟶ 4,739:
 
=={{header|Swift}}==
<langsyntaxhighlight lang="swift">func select<T where T : Comparable>(var elements: [T], n: Int) -> T {
var r = indices(elements)
while true {
Line 2,839 ⟶ 4,758:
if i < 9 { print(", ") }
}
println()</langsyntaxhighlight>
 
{{out}}
Line 2,846 ⟶ 4,765:
=={{header|Tcl}}==
{{trans|Python}}
<langsyntaxhighlight lang="tcl"># Swap the values at two indices of a list
proc swap {list i j} {
upvar 1 $list l
Line 2,895 ⟶ 4,814:
}
}
}</langsyntaxhighlight>
Demonstrating:
<langsyntaxhighlight lang="tcl">set v {9 8 7 6 5 0 1 2 3 4}
foreach i {1 2 3 4 5 6 7 8 9 10} {
puts "$i => [quickselect $v $i]"
}</langsyntaxhighlight>
{{out}}
<pre>
Line 2,916 ⟶ 4,835:
 
=={{header|VBA}}==
{{trans|Phix}}<langsyntaxhighlight lang="vb">Dim s As Variant
Private Function quick_select(ByRef s As Variant, k As Integer) As Integer
Dim left As Integer, right As Integer, pos As Integer
Line 2,957 ⟶ 4,876:
Next i
End Sub
</langsyntaxhighlight>{{out}}
<pre>0, 1, 2, 3, 4, 5, 6, 7, 8, 9</pre>
 
Line 2,963 ⟶ 4,882:
{{libheader|Wren-sort}}
The Find.quick method in the above module implements the quickselect algorithm.
<langsyntaxhighlight ecmascriptlang="wren">import "./sort" for Find
 
var a = [9, 8, 7, 6, 5, 0, 1, 2, 3, 4]
Line 2,970 ⟶ 4,889:
if (k < 9) System.write(", ")
}
System.print()</langsyntaxhighlight>
 
{{out}}
Line 2,976 ⟶ 4,895:
0, 1, 2, 3, 4, 5, 6, 7, 8, 9
</pre>
 
=={{header|XPL0}}==
{{trans|Go}}
<syntaxhighlight lang "XPL0">func QuickSelect(List, Len, K);
int List, Len, K;
int Px, Pv, Last, I, J, T;
[loop [\\partition
Px:= Len/2;
Pv:= List(Px);
Last:= Len-1;
T:= List(Px); List(Px):= List(Last); List(Last):= T;
I:= 0;
for J:= 0 to Last-1 do
[if List(J) < Pv then
[T:= List(I); List(I):= List(J); List(J):= T;
I:= I+1;
];
];
\\select
if I = K then return Pv;
 
if K < I then Len:= I
else [T:= List(I); List(I):= List(Last); List(Last):= T;
List:= @List(I+1);
Len:= Last - I;
K:= K - (I+1);
];
];
];
 
int V, K;
[V:= [9, 8, 7, 6, 5, 0, 1, 2, 3, 4];
for K:= 0 to 10-1 do
[IntOut(0, QuickSelect(V, 10, K));
ChOut(0, ^ );
];
]</syntaxhighlight>
{{out}}
<pre>
0 1 2 3 4 5 6 7 8 9 </pre>
 
=={{header|zkl}}==
{{trans|Wikipedia}}
This is the in place version rather than the much more concise copy-partition functional method. A copy of the input list is made to cover the case it is immutable (or the input shouldn't be changed)
<langsyntaxhighlight lang="zkl">fcn qselect(list,nth){ // in place quick select
fcn(list,left,right,nth){
if (left==right) return(list[left]);
Line 3,002 ⟶ 4,961:
return(self.fcn(list,pivotIndex+1,right,nth));
}(list.copy(),0,list.len()-1,nth);
}</langsyntaxhighlight>
<langsyntaxhighlight lang="zkl">list:=T(10, 9, 8, 7, 6, 1, 2, 3, 4, 5);
foreach nth in (list.len()){ println(nth,": ",qselect(list,nth)) }</langsyntaxhighlight>
{{out}}
<pre>
9,476

edits