You are encouraged to
solve this taskaccording to the task description, using any language you may know.
Sort an array (or list) elements using the quicksort algorithm.
The elements must have a strict weak order and the index of the array can be of any discrete type.
For languages where this is not possible, sort an array of integers.
Quicksort, also known as partition-exchange sort, uses these steps.
The best pivot creates partitions of equal length (or lengths differing by 1).
The worst pivot creates an empty partition (for example, if the pivot is the first or last element of a sorted array).
The run-time of Quicksort ranges from O(n log n) with the best pivots, to O(n2) with the worst pivots, where n is the number of elements in the array.
This is a simple quicksort algorithm, adapted from Wikipedia.
function quicksort(array) less, equal, greater := three empty arrays if length(array) > 1 pivot := select any element of array for each x in array if x < pivot then add x to less if x = pivot then add x to equal if x > pivot then add x to greater quicksort(less) quicksort(greater) array := concatenate(less, equal, greater)
A better quicksort algorithm works in place, by swapping elements within the array, to avoid the memory allocation of more arrays.
function quicksort(array) if length(array) > 1 pivot := select any element of array left := first index of array right := last index of array while left ≤ right while array[left] < pivot left := left + 1 while array[right] > pivot right := right - 1 if left ≤ right swap array[left] with array[right] left := left + 1 right := right - 1 quicksort(array from first index to right) quicksort(array from left to last index)
Quicksort has a reputation as the fastest sort. Optimized variants of quicksort are common features of many languages and libraries. One often contrasts quicksort with merge sort, because both sorts have an average time of O(n log n).
Quicksort is at one end of the spectrum of divide-and-conquer algorithms, with merge sort at the opposite end.
With quicksort, every element in the first partition is less than or equal to every element in the second partition. Therefore, the merge phase of quicksort is so trivial that it needs no mention!
This task has not specified whether to allocate new arrays, or sort in place. This task also has not specified how to choose the pivot element. (Common ways to are to choose the first element, the middle element, or the median of three elements.) Thus there is a variety among the following implementations.
11lF _quicksort(&array, start, stop) -> Void I stop - start > 0 V pivot = array[start] V left = start V right = stop L left <= right L array[left] < pivot left++ L array[right] > pivot right-- I left <= right swap(&array[left], &array[right]) left++ right-- _quicksort(&array, start, right) _quicksort(&array, left, stop) F quicksort(&array) _quicksort(&array, 0, array.len - 1) V arr = [7, 6, 5, 9, 8, 4, 3, 1, 2, 0] quicksort(&arr) print(arr)
[0, 1, 2, 3, 4, 5, 6, 7, 8, 9]360 Assembly
Structured version with ASM & ASSIST macros.
* Quicksort 14/09/2015 & 23/06/2016 QUICKSOR CSECT USING QUICKSOR,R13 base register B 72(R15) skip savearea DC 17F'0' savearea STM R14,R12,12(R13) prolog ST R13,4(R15) " ST R15,8(R13) " LR R13,R15 " MVC A,=A(1) a(1)=1 MVC B,=A(NN) b(1)=hbound(t) L R6,=F'1' k=1 DO WHILE=(LTR,R6,NZ,R6) do while k<>0 ================== LR R1,R6 k SLA R1,2 ~ L R10,A-4(R1) l=a(k) LR R1,R6 k SLA R1,2 ~ L R11,B-4(R1) m=b(k) BCTR R6,0 k=k-1 LR R4,R11 m C R4,=F'2' if m<2 BL ITERATE then iterate LR R2,R10 l AR R2,R11 +m BCTR R2,0 -1 ST R2,X x=l+m-1 LR R2,R11 m SRA R2,1 m/2 AR R2,R10 +l ST R2,Y y=l+m/2 L R1,X x SLA R1,2 ~ L R4,T-4(R1) r4=t(x) L R1,Y y SLA R1,2 ~ L R5,T-4(R1) r5=t(y) LR R1,R10 l SLA R1,2 ~ L R3,T-4(R1) r3=t(l) IF CR,R4,LT,R3 if t(x)<t(l) ---+ IF CR,R5,LT,R4 if t(y)<t(x) | LR R7,R4 p=t(x) | L R1,X x | SLA R1,2 ~ | ST R3,T-4(R1) t(x)=t(l) | ELSEIF CR,R5,GT,R3 elseif t(y)>t(l) | LR R7,R3 p=t(l) | ELSE , else | LR R7,R5 p=t(y) | L R1,Y y | SLA R1,2 ~ | ST R3,T-4(R1) t(y)=t(l) | ENDIF , end if | ELSE , else | IF CR,R5,LT,R3 if t(y)<t(l) | LR R7,R3 p=t(l) | ELSEIF CR,R5,GT,R4 elseif t(y)>t(x) | LR R7,R4 p=t(x) | L R1,X x | SLA R1,2 ~ | ST R3,T-4(R1) t(x)=t(l) | ELSE , else | LR R7,R5 p=t(y) | L R1,Y y | SLA R1,2 ~ | ST R3,T-4(R1) t(y)=t(l) | ENDIF , end if | ENDIF , end if ---+ LA R8,1(R10) i=l+1 L R9,X j=x FOREVER EQU * do forever --------------------+ LR R1,R8 i | SLA R1,2 ~ | LA R2,T-4(R1) @t(i) | L R0,0(R2) t(i) | DO WHILE=(CR,R8,LE,R9,AND, while i<=j and ---+ | X CR,R0,LE,R7) t(i)<=p | | AH R8,=H'1' i=i+1 | | AH R2,=H'4' @t(i) | | L R0,0(R2) t(i) | | ENDDO , end while ---+ | LR R1,R9 j | SLA R1,2 ~ | LA R2,T-4(R1) @t(j) | L R0,0(R2) t(j) | DO WHILE=(CR,R8,LT,R9,AND, while i<j and ---+ | X CR,R0,GE,R7) t(j)>=p | | SH R9,=H'1' j=j-1 | | SH R2,=H'4' @t(j) | | L R0,0(R2) t(j) | | ENDDO , end while ---+ | CR R8,R9 if i>=j | BNL LEAVE then leave (segment finished) | LR R1,R8 i | SLA R1,2 ~ | LA R2,T-4(R1) @t(i) | LR R1,R9 j | SLA R1,2 ~ | LA R3,T-4(R1) @t(j) | L R0,0(R2) w=t(i) + | MVC 0(4,R2),0(R3) t(i)=t(j) |swap t(i),t(j) | ST R0,0(R3) t(j)=w + | B FOREVER end do forever ----------------+ LEAVE EQU * LR R9,R8 j=i BCTR R9,0 j=i-1 LR R1,R9 j SLA R1,2 ~ LA R3,T-4(R1) @t(j) L R2,0(R3) t(j) LR R1,R10 l SLA R1,2 ~ ST R2,T-4(R1) t(l)=t(j) ST R7,0(R3) t(j)=p LA R6,1(R6) k=k+1 LR R1,R6 k SLA R1,2 ~ LA R4,A-4(R1) r4=@a(k) LA R5,B-4(R1) r5=@b(k) IF C,R8,LE,Y if i<=y ----+ ST R8,0(R4) a(k)=i | L R2,X x | SR R2,R8 -i | LA R2,1(R2) +1 | ST R2,0(R5) b(k)=x-i+1 | LA R6,1(R6) k=k+1 | ST R10,4(R4) a(k)=l | LR R2,R9 j | SR R2,R10 -l | ST R2,4(R5) b(k)=j-l | ELSE , else | ST R10,4(R4) a(k)=l | LR R2,R9 j | SR R2,R10 -l | ST R2,0(R5) b(k)=j-l | LA R6,1(R6) k=k+1 | ST R8,4(R4) a(k)=i | L R2,X x | SR R2,R8 -i | LA R2,1(R2) +1 | ST R2,4(R5) b(k)=x-i+1 | ENDIF , end if ----+ ITERATE EQU * ENDDO , end while ===================== * *** ********* print sorted table LA R3,PG ibuffer LA R4,T @t(i) DO WHILE=(C,R4,LE,=A(TEND)) do i=1 to hbound(t) L R2,0(R4) t(i) XDECO R2,XD edit t(i) MVC 0(4,R3),XD+8 put in buffer LA R3,4(R3) ibuffer=ibuffer+1 LA R4,4(R4) i=i+1 ENDDO , end do XPRNT PG,80 print buffer L R13,4(0,R13) epilog LM R14,R12,12(R13) " XR R15,R15 " BR R14 exit T DC F'10',F'9',F'9',F'6',F'7',F'16',F'1',F'16',F'17',F'15' DC F'1',F'9',F'18',F'16',F'8',F'20',F'18',F'2',F'19',F'8' TEND DS 0F NN EQU (TEND-T)/4) A DS (NN)F same size as T B DS (NN)F same size as T X DS F Y DS F PG DS CL80 XD DS CL12 YREGS END QUICKSOR
1 1 2 6 7 8 8 9 9 9 10 15 16 16 16 17 18 18 19 20AArch64 Assembly
/* ARM assembly AARCH64 Raspberry PI 3B */ /* program quickSort64.s */ /*******************************************/ /* Constantes file */ /*******************************************/ /* for this file see task include a file in language AArch64 assembly */ .include "../includeConstantesARM64.inc" /*********************************/ /* Initialized data */ /*********************************/ .data szMessSortOk: .asciz "Table sorted.\n" szMessSortNok: .asciz "Table not sorted !!!!!.\n" sMessResult: .asciz "Value : @ \n" szCarriageReturn: .asciz "\n" .align 4 TableNumber: .quad 1,3,6,2,5,9,10,8,4,7,11 #TableNumber: .quad 10,9,8,7,6,-5,4,3,2,1 .equ NBELEMENTS, (. - TableNumber) / 8 /*********************************/ /* UnInitialized data */ /*********************************/ .bss sZoneConv: .skip 24 /*********************************/ /* code section */ /*********************************/ .text .global main main: // entry of program ldr x0,qAdrTableNumber // address number table mov x1,0 // first element mov x2,NBELEMENTS // number of élements bl quickSort ldr x0,qAdrTableNumber // address number table bl displayTable ldr x0,qAdrTableNumber // address number table mov x1,NBELEMENTS // number of élements bl isSorted // control sort cmp x0,1 // sorted ? beq 1f ldr x0,qAdrszMessSortNok // no !! error sort bl affichageMess b 100f 1: // yes ldr x0,qAdrszMessSortOk bl affichageMess 100: // standard end of the program mov x0,0 // return code mov x8,EXIT // request to exit program svc 0 // perform the system call qAdrsZoneConv: .quad sZoneConv qAdrszCarriageReturn: .quad szCarriageReturn qAdrsMessResult: .quad sMessResult qAdrTableNumber: .quad TableNumber qAdrszMessSortOk: .quad szMessSortOk qAdrszMessSortNok: .quad szMessSortNok /******************************************************************/ /* control sorted table */ /******************************************************************/ /* x0 contains the address of table */ /* x1 contains the number of elements > 0 */ /* x0 return 0 if not sorted 1 if sorted */ isSorted: stp x2,lr,[sp,-16]! // save registers stp x3,x4,[sp,-16]! // save registers mov x2,0 ldr x4,[x0,x2,lsl 3] 1: add x2,x2,1 cmp x2,x1 bge 99f ldr x3,[x0,x2, lsl 3] cmp x3,x4 blt 98f mov x4,x3 b 1b 98: mov x0,0 // not sorted b 100f 99: mov x0,1 // sorted 100: ldp x3,x4,[sp],16 // restaur 2 registers ldp x2,lr,[sp],16 // restaur 2 registers ret // return to address lr x30 /***************************************************/ /* Appel récursif Tri Rapide quicksort */ /***************************************************/ /* x0 contains the address of table */ /* x1 contains index of first item */ /* x2 contains the number of elements > 0 */ quickSort: stp x2,lr,[sp,-16]! // save registers stp x3,x4,[sp,-16]! // save registers str x5, [sp,-16]! // save registers sub x2,x2,1 // last item index cmp x1,x2 // first > last ? bge 100f // yes -> end mov x4,x0 // save x0 mov x5,x2 // save x2 bl partition1 // cutting into 2 parts mov x2,x0 // index partition mov x0,x4 // table address bl quickSort // sort lower part add x1,x2,1 // index begin = index partition + 1 add x2,x5,1 // number of elements bl quickSort // sort higter part 100: // end function ldr x5, [sp],16 // restaur 1 register ldp x3,x4,[sp],16 // restaur 2 registers ldp x2,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 */ partition1: 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 x3,[x0,x2,lsl 3] // load value last index mov x4,x1 // init with first index mov x5,x1 // init with first index 1: // begin loop ldr x6,[x0,x5,lsl 3] // load value cmp x6,x3 // compare value bge 2f ldr x7,[x0,x4,lsl 3] // if < swap value table str x6,[x0,x4,lsl 3] str x7,[x0,x5,lsl 3] add x4,x4,1 // and increment index 1 2: add x5,x5,1 // increment index 2 cmp x5,x2 // end ? blt 1b // no loop ldr x7,[x0,x4,lsl 3] // swap value str x3,[x0,x4,lsl 3] str x7,[x0,x2,lsl 3] mov x0,x4 // 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 table elements */ /******************************************************************/ /* x0 contains the address of table */ displayTable: stp x1,lr,[sp,-16]! // save registers stp x2,x3,[sp,-16]! // save registers mov x2,x0 // table address mov x3,0 1: // loop display table ldr x0,[x2,x3,lsl 3] ldr x1,qAdrsZoneConv bl conversion10S // décimal conversion ldr x0,qAdrsMessResult ldr x1,qAdrsZoneConv bl strInsertAtCharInc // insert result at // character bl affichageMess // display message add x3,x3,1 cmp x3,NBELEMENTS - 1 ble 1b ldr x0,qAdrszCarriageReturn bl affichageMess mov x0,x2 100: ldp x2,x3,[sp],16 // restaur 2 registers ldp x1,lr,[sp],16 // restaur 2 registers ret // return to address lr x30 /********************************************************/ /* File Include fonctions */ /********************************************************/ /* for this file see task include a file in language AArch64 assembly */ .include "../includeARM64.inc"
Value : +1 Value : +2 Value : +3 Value : +4 Value : +5 Value : +6 Value : +7 Value : +8 Value : +9 Value : +10 Value : +11 Table sorted.ABAP
This works for ABAP Version 7.40 and above
report z_quicksort. data(numbers) = value int4_table( ( 4 ) ( 65 ) ( 2 ) ( -31 ) ( 0 ) ( 99 ) ( 2 ) ( 83 ) ( 782 ) ( 1 ) ). perform quicksort changing numbers. write `[`. loop at numbers assigning field-symbol(<numbers>). write <numbers>. endloop. write `]`. form quicksort changing numbers type int4_table. data(less) = value int4_table( ). data(equal) = value int4_table( ). data(greater) = value int4_table( ). if lines( numbers ) > 1. data(pivot) = numbers[ lines( numbers ) / 2 ]. loop at numbers assigning field-symbol(<number>). if <number> < pivot. append <number> to less. elseif <number> = pivot. append <number> to equal. elseif <number> > pivot. append <number> to greater. endif. endloop. perform quicksort changing less. perform quicksort changing greater. clear numbers. append lines of less to numbers. append lines of equal to numbers. append lines of greater to numbers. endif. endform.
[ 31- 0 1 2 2 4 65 83 99 782 ]ACL2
(defun partition (p xs) (if (endp xs) (mv nil nil) (mv-let (less more) (partition p (rest xs)) (if (< (first xs) p) (mv (cons (first xs) less) more) (mv less (cons (first xs) more)))))) (defun qsort (xs) (if (endp xs) nil (mv-let (less more) (partition (first xs) (rest xs)) (append (qsort less) (list (first xs)) (qsort more)))))
Usage:
> (qsort '(8 6 7 5 3 0 9)) (0 3 5 6 7 8 9)Action!
Action! language does not support recursion. Therefore an iterative approach with a stack has been proposed.
DEFINE MAX_COUNT="100" INT ARRAY stack(MAX_COUNT) INT stackSize PROC PrintArray(INT ARRAY a INT size) INT i Put('[) FOR i=0 TO size-1 DO IF i>0 THEN Put(' ) FI PrintI(a(i)) OD Put(']) PutE() RETURN PROC InitStack() stackSize=0 RETURN BYTE FUNC IsEmpty() IF stackSize=0 THEN RETURN (1) FI RETURN (0) PROC Push(INT low,high) stack(stackSize)=low stackSize==+1 stack(stackSize)=high stackSize==+1 RETURN PROC Pop(INT POINTER low,high) stackSize==-1 high^=stack(stackSize) stackSize==-1 low^=stack(stackSize) RETURN INT FUNC Partition(INT ARRAY a INT low,high) INT part,v,i,tmp v=a(high) part=low-1 FOR i=low TO high-1 DO IF a(i)<=v THEN part==+1 tmp=a(part) a(part)=a(i) a(i)=tmp FI OD part==+1 tmp=a(part) a(part)=a(high) a(high)=tmp RETURN (part) PROC QuickSort(INT ARRAY a INT size) INT low,high,part InitStack() Push(0,size-1) WHILE IsEmpty()=0 DO Pop(@low,@high) part=Partition(a,low,high) IF part-1>low THEN Push(low,part-1) FI IF part+1<high THEN Push(part+1,high) FI OD RETURN PROC Test(INT ARRAY a INT size) PrintE("Array before sort:") PrintArray(a,size) QuickSort(a,size) PrintE("Array after sort:") PrintArray(a,size) PutE() RETURN PROC Main() INT ARRAY a(10)=[1 4 65535 0 3 7 4 8 20 65530], b(21)=[10 9 8 7 6 5 4 3 2 1 0 65535 65534 65533 65532 65531 65530 65529 65528 65527 65526], c(8)=[101 102 103 104 105 106 107 108], d(12)=[1 65535 1 65535 1 65535 1 65535 1 65535 1 65535] Test(a,10) Test(b,21) Test(c,8) Test(d,12) RETURN
Screenshot from Atari 8-bit computer
Array before sort: [1 4 -1 0 3 7 4 8 20 -6] Array after sort: [-6 -1 0 1 3 4 4 7 8 20] Array before sort: [10 9 8 7 6 5 4 3 2 1 0 -1 -2 -3 -4 -5 -6 -7 -8 -9 -10] Array after sort: [-10 -9 -8 -7 -6 -5 -4 -3 -2 -1 0 1 2 3 4 5 6 7 8 9 10] Array before sort: [101 102 103 104 105 106 107 108] Array after sort: [101 102 103 104 105 106 107 108] Array before sort: [1 -1 1 -1 1 -1 1 -1 1 -1 1 -1] Array after sort: [-1 -1 -1 -1 -1 -1 1 1 1 1 1 1]ActionScript
The functional programming way
function quickSort (array:Array):Array { if (array.length <= 1) return array; var pivot:Number = array[Math.round(array.length / 2)]; return quickSort(array.filter(function (x:Number, index:int, array:Array):Boolean { return x < pivot; })).concat( array.filter(function (x:Number, index:int, array:Array):Boolean { return x == pivot; })).concat( quickSort(array.filter(function (x:Number, index:int, array:Array):Boolean { return x > pivot; }))); }
The faster way
function quickSort (array:Array):Array { if (array.length <= 1) return array; var pivot:Number = array[Math.round(array.length / 2)]; var less:Array = []; var equal:Array = []; var greater:Array = []; for each (var x:Number in array) { if (x < pivot) less.push(x); if (x == pivot) equal.push(x); if (x > pivot) greater.push(x); } return quickSort(less).concat( equal).concat( quickSort(greater)); }Ada
This example is implemented as a generic procedure.
The procedure specification is:
----------------------------------------------------------------------- -- Generic Quick_Sort procedure ----------------------------------------------------------------------- generic type Element is private; type Index is (<>); type Element_Array is array(Index range <>) of Element; with function "<" (Left, Right : Element) return Boolean is <>; procedure Quick_Sort(A : in out Element_Array);
The procedure body deals with any discrete index type, either an integer type or an enumerated type.
----------------------------------------------------------------------- -- Generic Quick_Sort procedure ----------------------------------------------------------------------- procedure Quick_Sort (A : in out Element_Array) is procedure Swap(Left, Right : Index) is Temp : Element := A (Left); begin A (Left) := A (Right); A (Right) := Temp; end Swap; begin if A'Length > 1 then declare Pivot_Value : Element := A (A'First); Right : Index := A'Last; Left : Index := A'First; begin loop while Left < Right and not (Pivot_Value < A (Left)) loop Left := Index'Succ (Left); end loop; while Pivot_Value < A (Right) loop Right := Index'Pred (Right); end loop; exit when Right <= Left; Swap (Left, Right); Left := Index'Succ (Left); Right := Index'Pred (Right); end loop; if Right = A'Last then Right := Index'Pred (Right); Swap (A'First, A'Last); end if; if Left = A'First then Left := Index'Succ (Left); end if; Quick_Sort (A (A'First .. Right)); Quick_Sort (A (Left .. A'Last)); end; end if; end Quick_Sort;
An example of how this procedure may be used is:
with Ada.Text_Io; with Ada.Float_Text_IO; use Ada.Float_Text_IO; with Quick_Sort; procedure Sort_Test is type Days is (Mon, Tue, Wed, Thu, Fri, Sat, Sun); type Sales is array (Days range <>) of Float; procedure Sort_Days is new Quick_Sort(Float, Days, Sales); procedure Print (Item : Sales) is begin for I in Item'range loop Put(Item => Item(I), Fore => 5, Aft => 2, Exp => 0); end loop; end Print; Weekly_Sales : Sales := (Mon => 300.0, Tue => 700.0, Wed => 800.0, Thu => 500.0, Fri => 200.0, Sat => 100.0, Sun => 900.0); begin Print(Weekly_Sales); Ada.Text_Io.New_Line(2); Sort_Days(Weekly_Sales); Print(Weekly_Sales); end Sort_Test;ALGOL 68
#--- Swap function ---# PROC swap = (REF []INT array, INT first, INT second) VOID: ( INT temp := array[first]; array[first] := array[second]; array[second]:= temp ); #--- Quick sort 3 arg function ---# PROC quick = (REF [] INT array, INT first, INT last) VOID: ( INT smaller := first + 1, larger := last, pivot := array[first]; WHILE smaller <= larger DO WHILE array[smaller] < pivot AND smaller < last DO smaller +:= 1 OD; WHILE array[larger] > pivot AND larger > first DO larger -:= 1 OD; IF smaller < larger THEN swap(array, smaller, larger); smaller +:= 1; larger -:= 1 ELSE smaller +:= 1 FI OD; swap(array, first, larger); IF first < larger-1 THEN quick(array, first, larger-1) FI; IF last > larger +1 THEN quick(array, larger+1, last) FI ); #--- Quick sort 1 arg function ---# PROC quicksort = (REF []INT array) VOID: ( IF UPB array > 1 THEN quick(array, 1, UPB array) FI ); #***************************************************************# main: ( [10]INT a; FOR i FROM 1 TO UPB a DO a[i] := ROUND(random*1000) OD; print(("Before:", a)); quicksort(a); print((newline, newline)); print(("After: ", a)) )
Before: +73 +921 +179 +961 +50 +324 +82 +178 +243 +458 After: +50 +73 +82 +178 +179 +243 +324 +458 +921 +961ALGOL W
% Quicksorts in-place the array of integers v, from lb to ub % procedure quicksort ( integer array v( * ) ; integer value lb, ub ) ; if ub > lb then begin % more than one element, so must sort % integer left, right, pivot; left := lb; right := ub; % choosing the middle element of the array as the pivot % pivot := v( left + ( ( right + 1 ) - left ) div 2 ); while begin while left <= ub and v( left ) < pivot do left := left + 1; while right >= lb and v( right ) > pivot do right := right - 1; left <= right end do begin integer swap; swap := v( left ); v( left ) := v( right ); v( right ) := swap; left := left + 1; right := right - 1 end while_left_le_right ; quicksort( v, lb, right ); quicksort( v, left, ub ) end quicksort ;APL
qsort ← {1≥≢∪⍵:⍵ ⋄ p←⍵[?≢⍵] ⋄ (∇(⍵≤p)/⍵) , ∇(⍵>p)/⍵} qsort 31 4 1 5 9 2 6 5 3 5 8 1 2 3 4 5 5 5 6 8 9 31
Of course, in real APL applications, one would use ⍋ (Grade Up) to sort (which will pick a sorting algorithm suited to the argument):
sort ← {⍵[⍋⍵]} sort 31 4 1 5 9 2 6 5 3 5 8 1 2 3 4 5 5 5 6 8 9 31AppleScript Functional
Emphasising clarity and simplicity more than run-time performance. (Practical scripts will often delegate sorting to the OS X shell, or, since OS X Yosemite, to Foundation classes through the ObjC interface).
(Functional ES5 version)
-- quickSort :: (Ord a) => [a] -> [a] on quickSort(xs) if length of xs > 1 then set {h, t} to uncons(xs) -- lessOrEqual :: a -> Bool script lessOrEqual on |λ|(x) x ≤ h end |λ| end script set {less, more} to partition(lessOrEqual, t) quickSort(less) & h & quickSort(more) else xs end if end quickSort -- TEST ----------------------------------------------------------------------- on run quickSort([11.8, 14.1, 21.3, 8.5, 16.7, 5.7]) --> {5.7, 8.5, 11.8, 14.1, 16.7, 21.3} end run -- GENERIC FUNCTIONS ---------------------------------------------------------- -- partition :: predicate -> List -> (Matches, nonMatches) -- partition :: (a -> Bool) -> [a] -> ([a], [a]) on partition(f, xs) tell mReturn(f) set lst to {{}, {}} repeat with x in xs set v to contents of x set end of item ((|λ|(v) as integer) + 1) of lst to v end repeat return {item 2 of lst, item 1 of lst} end tell end partition -- uncons :: [a] -> Maybe (a, [a]) on uncons(xs) if length of xs > 0 then {item 1 of xs, rest of xs} else missing value end if end uncons -- Lift 2nd class handler function into 1st class script wrapper -- mReturn :: Handler -> Script on mReturn(f) if class of f is script then f else script property |λ| : f end script end if end mReturn
{5.7, 8.5, 11.8, 14.1, 16.7, 21.3}Straightforward
Emphasising clarity, quick sorting, and correct AppleScript:
-- In-place Quicksort (basic algorithm). -- Algorithm: S.A.R. (Tony) Hoare, 1960. on quicksort(theList, l, r) -- Sort items l thru r of theList. set listLength to (count theList) if (listLength < 2) then return -- Convert negative and/or transposed range indices. if (l < 0) then set l to listLength + l + 1 if (r < 0) then set r to listLength + r + 1 if (l > r) then set {l, r} to {r, l} -- Script object containing the list as a property (to allow faster references to its items) -- and the recursive subhandler. script o property lst : theList on qsrt(l, r) set pivot to my lst's item ((l + r) div 2) set i to l set j to r repeat until (i > j) set lv to my lst's item i repeat while (pivot > lv) set i to i + 1 set lv to my lst's item i end repeat set rv to my lst's item j repeat while (rv > pivot) set j to j - 1 set rv to my lst's item j end repeat if (j > i) then set my lst's item i to rv set my lst's item j to lv else if (i > j) then exit repeat end if set i to i + 1 set j to j - 1 end repeat if (j > l) then qsrt(l, j) if (i < r) then qsrt(i, r) end qsrt end script tell o to qsrt(l, r) return -- nothing. end quicksort property sort : quicksort -- Demo: local aList set aList to {28, 9, 95, 22, 67, 55, 20, 41, 60, 53, 100, 72, 19, 67, 14, 42, 29, 20, 74, 39} sort(aList, 1, -1) -- Sort items 1 thru -1 of aList. return aList
{9, 14, 19, 20, 20, 22, 28, 29, 39, 41, 42, 53, 55, 60, 67, 67, 72, 74, 95, 100}Arc
(def qs (seq) (if (empty seq) nil (let pivot (car seq) (join (qs (keep [< _ pivot] (cdr seq))) (list pivot) (qs (keep [>= _ pivot] (cdr seq)))))))ArkScript
(import std.List :filter) (let quicksort (fun (array) { (if (empty? array) # if the given list is empty, return it [] # otherwise, sort it { # the pivot will be the first element (let pivot (head array)) # call quicksort on a smaller array containing all the elements less than the pivot (mut less (quicksort (filter (tail array) (fun (e) (< e pivot))))) # and after that, call quicksort on a smaller array containing all the elements greater or equal to the pivot (let more (quicksort (filter (tail array) (fun (e) (>= e pivot))))) (concat! less [pivot] more) # return a concatenation of arrays less }) })) # an unsorted list to sort (let a [3 6 1 5 1 65 324 765 1 6 3 0 6 9 6 5 3 2 5 6 7 64 645 7 345 432 432 4 324 23]) (assert (= (quicksort a) [0 1 1 1 2 3 3 3 4 5 5 5 6 6 6 6 6 7 7 9 23 64 65 324 324 345 432 432 645 765]) "(quicksort a) is sorted")ARM Assembly
/* ARM assembly Raspberry PI */ /* program quickSort.s */ /* look pseudo code in wikipedia quicksort */ /************************************/ /* Constantes */ /************************************/ .equ STDOUT, 1 @ Linux output console .equ EXIT, 1 @ Linux syscall .equ WRITE, 4 @ Linux syscall /*********************************/ /* Initialized data */ /*********************************/ .data szMessSortOk: .asciz "Table sorted.\n" szMessSortNok: .asciz "Table not sorted !!!!!.\n" sMessResult: .ascii "Value : " sMessValeur: .fill 11, 1, ' ' @ size => 11 szCarriageReturn: .asciz "\n" .align 4 iGraine: .int 123456 .equ NBELEMENTS, 10 #TableNumber: .int 9,5,6,1,2,3,10,8,4,7 #TableNumber: .int 1,3,5,2,4,6,10,8,4,7 #TableNumber: .int 1,3,5,2,4,6,10,8,4,7 #TableNumber: .int 1,2,3,4,5,6,10,8,4,7 TableNumber: .int 10,9,8,7,6,5,4,3,2,1 #TableNumber: .int 13,12,11,10,9,8,7,6,5,4,3,2,1 /*********************************/ /* UnInitialized data */ /*********************************/ .bss /*********************************/ /* code section */ /*********************************/ .text .global main main: @ entry of program 1: ldr r0,iAdrTableNumber @ address number table mov r1,#0 @ indice first item mov r2,#NBELEMENTS @ number of élements bl triRapide @ call quicksort ldr r0,iAdrTableNumber @ address number table bl displayTable ldr r0,iAdrTableNumber @ address number table mov r1,#NBELEMENTS @ number of élements bl isSorted @ control sort cmp r0,#1 @ sorted ? beq 2f ldr r0,iAdrszMessSortNok @ no !! error sort bl affichageMess b 100f 2: @ yes ldr r0,iAdrszMessSortOk bl affichageMess 100: @ standard end of the program mov r0, #0 @ return code mov r7, #EXIT @ request to exit program svc #0 @ perform the system call iAdrsMessValeur: .int sMessValeur iAdrszCarriageReturn: .int szCarriageReturn iAdrsMessResult: .int sMessResult iAdrTableNumber: .int TableNumber iAdrszMessSortOk: .int szMessSortOk iAdrszMessSortNok: .int szMessSortNok /******************************************************************/ /* control sorted table */ /******************************************************************/ /* r0 contains the address of table */ /* r1 contains the number of elements > 0 */ /* r0 return 0 if not sorted 1 if sorted */ isSorted: push {r2-r4,lr} @ save registers mov r2,#0 ldr r4,[r0,r2,lsl #2] 1: add r2,#1 cmp r2,r1 movge r0,#1 bge 100f ldr r3,[r0,r2, lsl #2] cmp r3,r4 movlt r0,#0 blt 100f mov r4,r3 b 1b 100: pop {r2-r4,lr} bx lr @ return /***************************************************/ /* Appel récursif Tri Rapide quicksort */ /***************************************************/ /* r0 contains the address of table */ /* r1 contains index of first item */ /* r2 contains the number of elements > 0 */ triRapide: push {r2-r5,lr} @ save registers sub r2,#1 @ last item index cmp r1,r2 @ first > last ? bge 100f @ yes -> end mov r4,r0 @ save r0 mov r5,r2 @ save r2 bl partition1 @ cutting into 2 parts mov r2,r0 @ index partition mov r0,r4 @ table address bl triRapide @ sort lower part add r1,r2,#1 @ index begin = index partition + 1 add r2,r5,#1 @ number of elements bl triRapide @ sort higter part 100: @ end function pop {r2-r5,lr} @ restaur registers bx lr @ return /******************************************************************/ /* Partition table elements */ /******************************************************************/ /* r0 contains the address of table */ /* r1 contains index of first item */ /* r2 contains index of last item */ partition1: push {r1-r7,lr} @ save registers ldr r3,[r0,r2,lsl #2] @ load value last index mov r4,r1 @ init with first index mov r5,r1 @ init with first index 1: @ begin loop ldr r6,[r0,r5,lsl #2] @ load value cmp r6,r3 @ compare value ldrlt r7,[r0,r4,lsl #2] @ if < swap value table strlt r6,[r0,r4,lsl #2] strlt r7,[r0,r5,lsl #2] addlt r4,#1 @ and increment index 1 add r5,#1 @ increment index 2 cmp r5,r2 @ end ? blt 1b @ no loop ldr r7,[r0,r4,lsl #2] @ swap value str r3,[r0,r4,lsl #2] str r7,[r0,r2,lsl #2] mov r0,r4 @ return index partition 100: pop {r1-r7,lr} bx lr /******************************************************************/ /* Display table elements */ /******************************************************************/ /* r0 contains the address of table */ displayTable: push {r0-r3,lr} @ save registers mov r2,r0 @ table address mov r3,#0 1: @ loop display table ldr r0,[r2,r3,lsl #2] ldr r1,iAdrsMessValeur @ display value bl conversion10 @ call function ldr r0,iAdrsMessResult bl affichageMess @ display message add r3,#1 cmp r3,#NBELEMENTS - 1 ble 1b ldr r0,iAdrszCarriageReturn bl affichageMess 100: pop {r0-r3,lr} bx lr /******************************************************************/ /* display text with size calculation */ /******************************************************************/ /* r0 contains the address of the message */ affichageMess: push {r0,r1,r2,r7,lr} @ save registres mov r2,#0 @ counter length 1: @ loop length calculation ldrb r1,[r0,r2] @ read octet start position + index cmp r1,#0 @ if 0 its over addne r2,r2,#1 @ else add 1 in the length bne 1b @ and loop @ so here r2 contains the length of the message mov r1,r0 @ address message in r1 mov r0,#STDOUT @ code to write to the standard output Linux mov r7, #WRITE @ code call system "write" svc #0 @ call systeme pop {r0,r1,r2,r7,lr} @ restaur des 2 registres */ bx lr @ return /******************************************************************/ /* Converting a register to a decimal unsigned */ /******************************************************************/ /* r0 contains value and r1 address area */ /* r0 return size of result (no zero final in area) */ /* area size => 11 bytes */ .equ LGZONECAL, 10 conversion10: push {r1-r4,lr} @ save registers mov r3,r1 mov r2,#LGZONECAL 1: @ start loop bl divisionpar10U @ unsigned r0 <- dividende. quotient ->r0 reste -> r1 add r1,#48 @ digit strb r1,[r3,r2] @ store digit on area cmp r0,#0 @ stop if quotient = 0 subne r2,#1 @ else previous position bne 1b @ and loop @ and move digit from left of area mov r4,#0 2: ldrb r1,[r3,r2] strb r1,[r3,r4] add r2,#1 add r4,#1 cmp r2,#LGZONECAL ble 2b @ and move spaces in end on area mov r0,r4 @ result length mov r1,#' ' @ space 3: strb r1,[r3,r4] @ store space in area add r4,#1 @ next position cmp r4,#LGZONECAL ble 3b @ loop if r4 <= area size 100: pop {r1-r4,lr} @ restaur registres bx lr @return /***************************************************/ /* division par 10 unsigned */ /***************************************************/ /* r0 dividende */ /* r0 quotient */ /* r1 remainder */ divisionpar10U: push {r2,r3,r4, lr} mov r4,r0 @ save value //mov r3,#0xCCCD @ r3 <- magic_number lower raspberry 3 //movt r3,#0xCCCC @ r3 <- magic_number higter raspberry 3 ldr r3,iMagicNumber @ r3 <- magic_number raspberry 1 2 umull r1, r2, r3, r0 @ r1<- Lower32Bits(r1*r0) r2<- Upper32Bits(r1*r0) mov r0, r2, LSR #3 @ r2 <- r2 >> shift 3 add r2,r0,r0, lsl #2 @ r2 <- r0 * 5 sub r1,r4,r2, lsl #1 @ r1 <- r4 - (r2 * 2) = r4 - (r0 * 10) pop {r2,r3,r4,lr} bx lr @ leave function iMagicNumber: .int 0xCCCCCCCDArturo
quickSort: function [items][ if 2 > size items -> return items pivot: first items left: select slice items 1 (size items)-1 'x -> x < pivot right: select slice items 1 (size items)-1 'x -> x >= pivot ((quickSort left) ++ pivot) ++ quickSort right ] print quickSort [3 1 2 8 5 7 9 4 6]
1 2 3 4 5 6 7 8 9ATS A quicksort working on non-linear linked lists
(*------------------------------------------------------------------*) (* Quicksort in ATS2, for non-linear lists. *) (*------------------------------------------------------------------*) #include "share/atspre_staload.hats" #define NIL list_nil () #define :: list_cons (*------------------------------------------------------------------*) (* A simple quicksort working on "garbage-collected" linked lists, with first element as pivot. This is meant as a demonstration, not as a superior sort algorithm. It is based on the "not-in-place" task pseudocode. *) datatype comparison_result = | first_is_less_than_second of () | first_is_equal_to_second of () | first_is_greater_than_second of () extern fun {a : t@ype} list_quicksort$comparison (x : a, y : a) :<> comparison_result extern fun {a : t@ype} list_quicksort {n : int} (lst : list (a, n)) :<> list (a, n) (* - - - - - - - - - - - - - - - - - - - - - - *) implement {a} list_quicksort {n} (lst) = let fun partition {n : nat} .<n>. (* Proof of termination. *) (lst : list (a, n), pivot : a) :<> [n1, n2, n3 : int | n1 + n2 + n3 == n] @(list (a, n1), list (a, n2), list (a, n3)) = (* This implementation is *not* tail recursive. I may get a scolding for using ATS to risk stack overflow! However, I need more practice writing non-tail routines. :) Also, a lot of programmers in other languages would do it this way--especially if the lists are evaluated lazily. *) case+ lst of | NIL => @(NIL, NIL, NIL) | head :: tail => let val @(lt, eq, gt) = partition (tail, pivot) prval () = lemma_list_param lt prval () = lemma_list_param eq prval () = lemma_list_param gt in case+ list_quicksort$comparison<a> (head, pivot) of | first_is_less_than_second () => @(head :: lt, eq, gt) | first_is_equal_to_second () => @(lt, head :: eq, gt) | first_is_greater_than_second () => @(lt, eq, head :: gt) end fun quicksort {n : nat} .<n>. (* Proof of termination. *) (lst : list (a, n)) :<> list (a, n) = case+ lst of | NIL => lst | _ :: NIL => lst | head :: tail => let (* We are careful here to run "partition" on "tail" rather than "lst", so the termination metric will be provably decreasing. (Really the compiler *forces* us to take such care, or else to change :<> to :<!ntm>) *) val pivot = head prval () = lemma_list_param tail val @(lt, eq, gt) = partition {n - 1} (tail, pivot) prval () = lemma_list_param lt prval () = lemma_list_param eq prval () = lemma_list_param gt val eq = pivot :: eq and lt = quicksort lt and gt = quicksort gt in lt + (eq + gt) end prval () = lemma_list_param lst in quicksort {n} lst end (*------------------------------------------------------------------*) val example_strings = $list ("choose", "any", "element", "of", "the", "array", "to", "be", "the", "pivot", "divide", "all", "other", "elements", "except", "the", "pivot", "into", "two", "partitions", "all", "elements", "less", "than", "the", "pivot", "must", "be", "in", "the", "first", "partition", "all", "elements", "greater", "than", "the", "pivot", "must", "be", "in", "the", "second", "partition", "use", "recursion", "to", "sort", "both", "partitions", "join", "the", "first", "sorted", "partition", "the", "pivot", "and", "the", "second", "sorted", "partition") implement list_quicksort$comparison<string> (x, y) = let val i = strcmp (x, y) in if i < 0 then first_is_less_than_second else if i = 0 then first_is_equal_to_second else first_is_greater_than_second end implement main0 () = let val sorted_strings = list_quicksort<string> example_strings fun print_strings {n : nat} .<n>. (strings : list (string, n), i : int) : void = case+ strings of | NIL => if i <> 1 then println! () else () | head :: tail => begin print! head; if i = 8 then begin println! (); print_strings (tail, 1) end else begin print! " "; print_strings (tail, succ i) end end in println! (length example_strings); println! (length sorted_strings); print_strings (sorted_strings, 1) end (*------------------------------------------------------------------*)
$ patscc -O3 -DATS_MEMALLOC_GCBDW quicksort_task_for_lists.dats -lgc && ./a.out 62 62 all all all and any array be be be both choose divide element elements elements elements except first first greater in in into join less must must of other partition partition partition partition partitions partitions pivot pivot pivot pivot pivot recursion second second sort sorted sorted than than the the the the the the the the the the to to two useA quicksort working on linear linked lists
This program was derived from the quicksort for non-linear linked lists.
(*------------------------------------------------------------------*) (* Quicksort in ATS2, for linear lists. *) (*------------------------------------------------------------------*) #include "share/atspre_staload.hats" #define NIL list_vt_nil () #define :: list_vt_cons (*------------------------------------------------------------------*) (* A simple quicksort working on linear linked lists, with first element as pivot. This is meant as a demonstration, not as a superior sort algorithm. It is based on the "not-in-place" task pseudocode. *) #define FIRST_IS_LESS_THAN_SECOND 1 #define FIRST_IS_EQUAL_TO_SECOND 2 #define FIRST_IS_GREATER_THAN_SECOND 3 typedef comparison_result = [i : int | (i == FIRST_IS_LESS_THAN_SECOND || i == FIRST_IS_EQUAL_TO_SECOND || i == FIRST_IS_GREATER_THAN_SECOND)] int i extern fun {a : vt@ype} list_vt_quicksort$comparison (x : !a, y : !a) :<> comparison_result extern fun {a : vt@ype} list_vt_quicksort {n : int} (lst : list_vt (a, n)) :<!wrt> list_vt (a, n) (* - - - - - - - - - - - - - - - - - - - - - - *) implement {a} list_vt_quicksort {n} (lst) = let fun partition {n : nat} .<n>. (* Proof of termination. *) (lst : list_vt (a, n), pivot : !a) :<> [n1, n2, n3 : int | n1 + n2 + n3 == n] @(list_vt (a, n1), list_vt (a, n2), list_vt (a, n3)) = (* This implementation is *not* tail recursive. I may get a scolding for using ATS to risk stack overflow! However, I need more practice writing non-tail routines. :) Also, a lot of programmers in other languages would do it this way--especially if the lists are evaluated lazily. *) case+ lst of | ~ NIL => @(NIL, NIL, NIL) | ~ head :: tail => let val @(lt, eq, gt) = partition (tail, pivot) prval () = lemma_list_vt_param lt prval () = lemma_list_vt_param eq prval () = lemma_list_vt_param gt in case+ list_vt_quicksort$comparison<a> (head, pivot) of | FIRST_IS_LESS_THAN_SECOND => @(head :: lt, eq, gt) | FIRST_IS_EQUAL_TO_SECOND => @(lt, head :: eq, gt) | FIRST_IS_GREATER_THAN_SECOND => @(lt, eq, head :: gt) end fun quicksort {n : nat} .<n>. (* Proof of termination. *) (lst : list_vt (a, n)) :<!wrt> list_vt (a, n) = case+ lst of | NIL => lst | _ :: NIL => lst | ~ head :: tail => let (* We are careful here to run "partition" on "tail" rather than "lst", so the termination metric will be provably decreasing. (Really the compiler *forces* us to take such care, or else to add !ntm to the effects.) *) val pivot = head prval () = lemma_list_vt_param tail val @(lt, eq, gt) = partition {n - 1} (tail, pivot) prval () = lemma_list_vt_param lt prval () = lemma_list_vt_param eq prval () = lemma_list_vt_param gt val eq = pivot :: eq and lt = quicksort lt and gt = quicksort gt in list_vt_append (lt, list_vt_append (eq, gt)) end prval () = lemma_list_vt_param lst in quicksort {n} lst end (*------------------------------------------------------------------*) implement list_vt_quicksort$comparison<Strptr1> (x, y) = let val i = compare (x, y) in if i < 0 then FIRST_IS_LESS_THAN_SECOND else if i = 0 then FIRST_IS_EQUAL_TO_SECOND else FIRST_IS_GREATER_THAN_SECOND end implement list_vt_map$fopr<string><Strptr1> (s) = string0_copy s implement list_vt_freelin$clear<Strptr1> (x) = strptr_free x implement main0 () = let val example_strings = $list_vt ("choose", "any", "element", "of", "the", "array", "to", "be", "the", "pivot", "divide", "all", "other", "elements", "except", "the", "pivot", "into", "two", "partitions", "all", "elements", "less", "than", "the", "pivot", "must", "be", "in", "the", "first", "partition", "all", "elements", "greater", "than", "the", "pivot", "must", "be", "in", "the", "second", "partition", "use", "recursion", "to", "sort", "both", "partitions", "join", "the", "first", "sorted", "partition", "the", "pivot", "and", "the", "second", "sorted", "partition") val example_strptrs = list_vt_map<string><Strptr1> (example_strings) val sorted_strptrs = list_vt_quicksort<Strptr1> example_strptrs fun print_strptrs {n : nat} .<n>. (strptrs : !list_vt (Strptr1, n), i : int) : void = case+ strptrs of | NIL => if i <> 1 then println! () else () | @ head :: tail => begin print! head; if i = 8 then begin println! (); print_strptrs (tail, 1) end else begin print! " "; print_strptrs (tail, succ i) end; fold@ strptrs end in println! (length example_strings); println! (length sorted_strptrs); print_strptrs (sorted_strptrs, 1); list_vt_freelin<Strptr1> sorted_strptrs; list_vt_free<string> example_strings end (*------------------------------------------------------------------*)
$ patscc -O3 -DATS_MEMALLOC_LIBC quicksort_task_for_list_vt.dats && ./a.out 62 62 all all all and any array be be be both choose divide element elements elements elements except first first greater in in into join less must must of other partition partition partition partition partitions partitions pivot pivot pivot pivot pivot recursion second second sort sorted sorted than than the the the the the the the the the the to to two useA quicksort working on arrays of non-linear elements
(*------------------------------------------------------------------*) (* Quicksort in ATS2, for arrays of non-linear values. *) (*------------------------------------------------------------------*) #include "share/atspre_staload.hats" #define NIL list_nil () #define :: list_cons (*------------------------------------------------------------------*) (* A simple quicksort working on arrays of non-linear values, using a programmer-selectible pivot. It is based on the "in-place" task pseudocode. *) extern fun {a : t@ype} (* A "less-than" predicate. *) array_quicksort$lt (x : a, y : a) : bool extern fun {a : t@ype} array_quicksort$select_pivot {n : int} {i, j : nat | i < j; j < n} (arr : &array (a, n) >> _, first : size_t i, last : size_t j) : a extern fun {a : t@ype} array_quicksort {n : int} (arr : &array (a, n) >> _, n : size_t n) : void (* - - - - - - - - - - - - - - - - - - - - - - *) fn {a : t@ype} swap {n : int} {i, j : nat | i < n; j < n} (arr : &array(a, n) >> _, i : size_t i, j : size_t j) : void = { val x = arr[i] and y = arr[j] val () = (arr[i] := y) and () = (arr[j] := x) } implement {a} array_quicksort {n} (arr, n) = let sortdef index = {i : nat | i < n} typedef index (i : int) = [0 <= i; i < n] size_t i typedef index = [i : index] index i macdef lt = array_quicksort$lt<a> fun quicksort {i, j : index} (arr : &array(a, n) >> _, first : index i, last : index j) : void = if first < last then { val pivot : a = array_quicksort$select_pivot<a> (arr, first, last) fun search_rightwards (arr : &array (a, n), left : index) : index = if arr[left] \lt pivot then let val () = assertloc (succ left <> n) in search_rightwards (arr, succ left) end else left fun search_leftwards (arr : &array (a, n), left : index, right : index) : index = if right < left then right else if pivot \lt arr[right] then let val () = assertloc (right <> i2sz 0) in search_leftwards (arr, left, pred right) end else right fun partition (arr : &array (a, n) >> _, left0 : index, right0 : index) : @(index, index) = let val left = search_rightwards (arr, left0) val right = search_leftwards (arr, left, right0) in if left <= right then let val () = assertloc (succ left <> n) and () = assertloc (right <> i2sz 0) in swap (arr, left, right); partition (arr, succ left, pred right) end else @(left, right) end val @(left, right) = partition (arr, first, last) val () = quicksort (arr, first, right) and () = quicksort (arr, left, last) } in if i2sz 2 <= n then quicksort {0, n - 1} (arr, i2sz 0, pred n) end (*------------------------------------------------------------------*) val example_strings = $list ("choose", "any", "element", "of", "the", "array", "to", "be", "the", "pivot", "divide", "all", "other", "elements", "except", "the", "pivot", "into", "two", "partitions", "all", "elements", "less", "than", "the", "pivot", "must", "be", "in", "the", "first", "partition", "all", "elements", "greater", "than", "the", "pivot", "must", "be", "in", "the", "second", "partition", "use", "recursion", "to", "sort", "both", "partitions", "join", "the", "first", "sorted", "partition", "the", "pivot", "and", "the", "second", "sorted", "partition") implement array_quicksort$lt<string> (x, y) = strcmp (x, y) < 0 implement array_quicksort$select_pivot<string> {n} (arr, first, last) = (* Median of three, with swapping around of elements during pivot selection. See https://archive.ph/oYENx *) let macdef lt = array_quicksort$lt<string> val middle = first + ((last - first) / i2sz 2) val xfirst = arr[first] and xmiddle = arr[middle] and xlast = arr[last] in if (xmiddle \lt xfirst) xor (xlast \lt xfirst) then begin swap (arr, first, middle); if xlast \lt xmiddle then swap (arr, first, last); xfirst end else if (xmiddle \lt xfirst) xor (xmiddle \lt xlast) then begin if xlast \lt xfirst then swap (arr, first, last); xmiddle end else begin swap (arr, middle, last); if xmiddle \lt xfirst then swap (arr, first, last); xlast end end implement main0 () = let prval () = lemma_list_param example_strings val n = length example_strings val @(pf, pfgc | p) = array_ptr_alloc<string> (i2sz n) macdef arr = !p val () = array_initize_list (arr, n, example_strings) val () = array_quicksort<string> (arr, i2sz n) val sorted_strings = list_vt2t (array2list (arr, i2sz n)) val () = array_ptr_free (pf, pfgc | p) fun print_strings {n : nat} .<n>. (strings : list (string, n), i : int) : void = case+ strings of | NIL => if i <> 1 then println! () else () | head :: tail => begin print! head; if i = 8 then begin println! (); print_strings (tail, 1) end else begin print! " "; print_strings (tail, succ i) end end in println! (length example_strings); println! (length sorted_strings); print_strings (sorted_strings, 1) end (*------------------------------------------------------------------*)
$ patscc -O3 -DATS_MEMALLOC_GCBDW quicksort_task_for_arrays.dats -lgc && ./a.out 62 62 all all all and any array be be be both choose divide element elements elements elements except first first greater in in into join less must must of other partition partition partition partition partitions partitions pivot pivot pivot pivot pivot recursion second second sort sorted sorted than than the the the the the the the the the the to to two useA quicksort working on arrays of linear elements
The quicksort for arrays of non-linear elements makes a copy of the pivot value, and compares this copy with array elements by value. Here, however, the array elements are linear values. They cannot be copied, unless a special "copy" procedure is provided. We do not want to require such a procedure. So we must do something else.
What we do is move the pivot to the last element of the array, by safely swapping it with the original last element. We partition the array to the left of the last element, comparing array elements with the pivot (that is, the last element) by reference.
(*------------------------------------------------------------------*) (* Quicksort in ATS2, for arrays of (possibly) linear values. *) (*------------------------------------------------------------------*) #include "share/atspre_staload.hats" #define NIL list_vt_nil () #define :: list_vt_cons (*------------------------------------------------------------------*) (* A simple quicksort working on arrays of non-linear values, using a programmer-selectible pivot. It is based on the "in-place" task pseudocode. *) extern fun {a : vt@ype} (* A "less-than" predicate. *) array_quicksort$lt {px, py : addr} (pfx : !(a @ px), pfy : !(a @ py) | px : ptr px, py : ptr py) : bool extern fun {a : vt@ype} array_quicksort$select_pivot_index {n : int} {i, j : nat | i < j; j < n} (arr : &array (a, n), first : size_t i, last : size_t j) : [k : int | i <= k; k <= j] size_t k extern fun {a : vt@ype} array_quicksort {n : int} (arr : &array (a, n) >> _, n : size_t n) : void (* - - - - - - - - - - - - - - - - - - - - - - *) prfn (* Subdivide an array view into three views. *) array_v_subdivide3 {a : vt@ype} {p : addr} {n1, n2, n3 : nat} (pf : @[a][n1 + n2 + n3] @ p) :<prf> @(@[a][n1] @ p, @[a][n2] @ (p + n1 * sizeof a), @[a][n3] @ (p + (n1 + n2) * sizeof a)) = let prval (pf1, pf23) = array_v_split {a} {p} {n1 + n2 + n3} {n1} pf prval (pf2, pf3) = array_v_split {a} {p + n1 * sizeof a} {n2 + n3} {n2} pf23 in @(pf1, pf2, pf3) end prfn (* Join three contiguous array views into one view. *) array_v_join3 {a : vt@ype} {p : addr} {n1, n2, n3 : nat} (pf1 : @[a][n1] @ p, pf2 : @[a][n2] @ (p + n1 * sizeof a), pf3 : @[a][n3] @ (p + (n1 + n2) * sizeof a)) :<prf> @[a][n1 + n2 + n3] @ p = let prval pf23 = array_v_unsplit {a} {p + n1 * sizeof a} {n2, n3} (pf2, pf3) prval pf = array_v_unsplit {a} {p} {n1, n2 + n3} (pf1, pf23) in pf end fn {a : vt@ype} (* Safely swap two elements of an array. *) swap_elems_1 {n : int} {i, j : nat | i <= j; j < n} {p : addr} (pfarr : !array_v(a, p, n) >> _ | p : ptr p, i : size_t i, j : size_t j) : void = let fn {a : vt@ype} swap {n : int} {i, j : nat | i < j; j < n} {p : addr} (pfarr : !array_v(a, p, n) >> _ | p : ptr p, i : size_t i, j : size_t j) : void = { (* Safely swapping linear elements requires that views of those elements be split off from the rest of the array. Why? Because those elements will temporarily be in an uninitialized state. (Actually they will be "?!", but the difference is unimportant here.) Remember, a linear value is consumed by using it. The view for the whole array can be reassembled only after new values have been stored, making the entire array once again initialized. *) prval @(pf1, pf2, pf3) = array_v_subdivide3 {a} {p} {i, j - i, n - j} pfarr prval @(pfi, pf2_) = array_v_uncons pf2 prval @(pfj, pf3_) = array_v_uncons pf3 val pi = ptr_add<a> (p, i) and pj = ptr_add<a> (p, j) val xi = ptr_get<a> (pfi | pi) and xj = ptr_get<a> (pfj | pj) val () = ptr_set<a> (pfi | pi, xj) and () = ptr_set<a> (pfj | pj, xi) prval pf2 = array_v_cons (pfi, pf2_) prval pf3 = array_v_cons (pfj, pf3_) prval () = pfarr := array_v_join3 (pf1, pf2, pf3) } in if i < j then swap {n} {i, j} {p} (pfarr | p, i, j) else () (* i = j must be handled specially, due to linear typing.*) end fn {a : vt@ype} (* Safely swap two elements of an array. *) swap_elems_2 {n : int} {i, j : nat | i <= j; j < n} (arr : &array(a, n) >> _, i : size_t i, j : size_t j) : void = swap_elems_1 (view@ arr | addr@ arr, i, j) overload swap_elems with swap_elems_1 overload swap_elems with swap_elems_2 overload swap with swap_elems fn {a : vt@ype} (* Safely compare two elements of an array. *) lt_elems_1 {n : int} {i, j : nat | i < n; j < n} {p : addr} (pfarr : !array_v(a, p, n) | p : ptr p, i : size_t i, j : size_t j) : bool = let fn compare {n : int} {i, j : nat | i < j; j < n} {p : addr} (pfarr : !array_v(a, p, n) | p : ptr p, i : size_t i, j : size_t j, gt : bool) : bool = let prval @(pf1, pf2, pf3) = array_v_subdivide3 {a} {p} {i, j - i, n - j} pfarr prval @(pfi, pf2_) = array_v_uncons pf2 prval @(pfj, pf3_) = array_v_uncons pf3 val pi = ptr_add<a> (p, i) and pj = ptr_add<a> (p, j) val retval = if gt then array_quicksort$lt<a> (pfj, pfi | pj, pi) else array_quicksort$lt<a> (pfi, pfj | pi, pj) prval pf2 = array_v_cons (pfi, pf2_) prval pf3 = array_v_cons (pfj, pf3_) prval () = pfarr := array_v_join3 (pf1, pf2, pf3) in retval end in if i < j then compare {n} {i, j} {p} (pfarr | p, i, j, false) else if j < i then compare {n} {j, i} {p} (pfarr | p, j, i, true) else false end fn {a : vt@ype} (* Safely compare two elements of an array. *) lt_elems_2 {n : int} {i, j : nat | i < n; j < n} (arr : &array (a, n), i : size_t i, j : size_t j) : bool = lt_elems_1 (view@ arr | addr@ arr, i, j) overload lt_elems with lt_elems_1 overload lt_elems with lt_elems_2 implement {a} array_quicksort {n} (arr, n) = let sortdef index = {i : nat | i < n} typedef index (i : int) = [0 <= i; i < n] size_t i typedef index = [i : index] index i macdef lt = array_quicksort$lt<a> fun quicksort {i, j : index} (arr : &array(a, n) >> _, first : index i, last : index j) : void = if first < last then { val pivot = array_quicksort$select_pivot_index<a> (arr, first, last) (* Swap the pivot with the last element. *) val () = swap (arr, pivot, last) val pivot = last fun search_rightwards (arr : &array (a, n), left : index) : index = if lt_elems<a> (arr, left, pivot) then let val () = assertloc (succ left <> n) in search_rightwards (arr, succ left) end else left fun search_leftwards (arr : &array (a, n), left : index, right : index) : index = if right < left then right else if lt_elems<a> (arr, pivot, right) then let val () = assertloc (right <> i2sz 0) in search_leftwards (arr, left, pred right) end else right fun partition (arr : &array (a, n) >> _, left0 : index, right0 : index) : @(index, index) = let val left = search_rightwards (arr, left0) val right = search_leftwards (arr, left, right0) in if left <= right then let val () = assertloc (succ left <> n) and () = assertloc (right <> i2sz 0) in swap (arr, left, right); partition (arr, succ left, pred right) end else @(left, right) end val @(left, right) = partition (arr, first, pred last) val () = quicksort (arr, first, right) and () = quicksort (arr, left, last) } in if i2sz 2 <= n then quicksort {0, n - 1} (arr, i2sz 0, pred n) end (*------------------------------------------------------------------*) implement array_quicksort$lt<Strptr1> (pfx, pfy | px, py) = compare (!px, !py) < 0 implement array_quicksort$select_pivot_index<Strptr1> {n} (arr, first, last) = (* Median of three. *) let val middle = first + ((last - first) / i2sz 2) in if lt_elems<Strptr1> (arr, middle, first) xor lt_elems<Strptr1> (arr, last, first) then first else if lt_elems<Strptr1> (arr, middle, first) xor lt_elems<Strptr1> (arr, middle, last) then middle else last end implement list_vt_map$fopr<string><Strptr1> (s) = string0_copy s implement list_vt_freelin$clear<Strptr1> (x) = strptr_free x implement main0 () = let val example_strings = $list_vt ("choose", "any", "element", "of", "the", "array", "to", "be", "the", "pivot", "divide", "all", "other", "elements", "except", "the", "pivot", "into", "two", "partitions", "all", "elements", "less", "than", "the", "pivot", "must", "be", "in", "the", "first", "partition", "all", "elements", "greater", "than", "the", "pivot", "must", "be", "in", "the", "second", "partition", "use", "recursion", "to", "sort", "both", "partitions", "join", "the", "first", "sorted", "partition", "the", "pivot", "and", "the", "second", "sorted", "partition") val example_strptrs = list_vt_map<string><Strptr1> (example_strings) prval () = lemma_list_vt_param example_strptrs val n = length example_strptrs val @(pf, pfgc | p) = array_ptr_alloc<Strptr1> (i2sz n) macdef arr = !p val () = array_initize_list_vt<Strptr1> (arr, n, example_strptrs) val () = array_quicksort<Strptr1> (arr, i2sz n) val sorted_strptrs = array2list (arr, i2sz n) fun print_strptrs {n : nat} .<n>. (strptrs : !list_vt (Strptr1, n), i : int) : void = case+ strptrs of | NIL => if i <> 1 then println! () else () | @ head :: tail => begin print! head; if i = 8 then begin println! (); print_strptrs (tail, 1) end else begin print! " "; print_strptrs (tail, succ i) end; fold@ strptrs end in println! (length example_strings); println! (length sorted_strptrs); print_strptrs (sorted_strptrs, 1); list_vt_freelin<Strptr1> sorted_strptrs; array_ptr_free (pf, pfgc | p); list_vt_free<string> example_strings end (*------------------------------------------------------------------*)
$ patscc -O3 -DATS_MEMALLOC_LIBC quicksort_task_for_arrays_2.dats 62 62 all all all and any array be be be both choose divide element elements elements elements except first first greater in in into join less must must of other partition partition partition partition partitions partitions pivot pivot pivot pivot pivot recursion second second sort sorted sorted than than the the the the the the the the the the to to two useA stable quicksort working on linear lists
See the code at the quickselect task.
$ patscc -O3 -DATS_MEMALLOC_LIBC quickselect_task_for_list_vt.dats && ./a.out quicksort stable sort by first character: duck, deer, dolphin, elephant, earwig, giraffe, pronghorn, wildebeest, woodlouse, whip-poor-willAutoHotkey
Translated from the python example:
a := [4, 65, 2, -31, 0, 99, 83, 782, 7] for k, v in QuickSort(a) Out .= "," v MsgBox, % SubStr(Out, 2) return QuickSort(a) { if (a.MaxIndex() <= 1) return a Less := [], Same := [], More := [] Pivot := a[1] for k, v in a { if (v < Pivot) less.Insert(v) else if (v > Pivot) more.Insert(v) else same.Insert(v) } Less := QuickSort(Less) Out := QuickSort(More) if (Same.MaxIndex()) Out.Insert(1, Same*) ; insert all values of same at index 1 if (Less.MaxIndex()) Out.Insert(1, Less*) ; insert all values of less at index 1 return Out }
Old implementation for AutoHotkey 1.0:
MsgBox % quicksort("8,4,9,2,1") quicksort(list) { StringSplit, list, list, `, If (list0 <= 1) Return list pivot := list1 Loop, Parse, list, `, { If (A_LoopField < pivot) less = %less%,%A_LoopField% Else If (A_LoopField > pivot) more = %more%,%A_LoopField% Else pivotlist = %pivotlist%,%A_LoopField% } StringTrimLeft, less, less, 1 StringTrimLeft, more, more, 1 StringTrimLeft, pivotList, pivotList, 1 less := quicksort(less) more := quicksort(more) Return less . pivotList . more }AWK
# the following qsort implementation extracted from: # # ftp://ftp.armory.com/pub/lib/awk/qsort # # Copyleft GPLv2 John DuBois # # @(#) qsort 1.2.1 2005-10-21 # 1990 john h. dubois iii (john@armory.com) # # qsortArbIndByValue(): Sort an array according to the values of its elements. # # Input variables: # # Arr[] is an array of values with arbitrary (associative) indices. # # Output variables: # # k[] is returned with numeric indices 1..n. The values assigned to these # indices are the indices of Arr[], ordered so that if Arr[] is stepped # through in the order Arr[k[1]] .. Arr[k[n]], it will be stepped through in # order of the values of its elements. # # Return value: The number of elements in the arrays (n). # # NOTES: # # Full example for accessing results: # # foolist["second"] = 2; # foolist["zero"] = 0; # foolist["third"] = 3; # foolist["first"] = 1; # # outlist[1] = 0; # n = qsortArbIndByValue(foolist, outlist) # # for (i = 1; i <= n; i++) { # printf("item at %s has value %d\n", outlist[i], foolist[outlist[i]]); # } # delete outlist; # function qsortArbIndByValue(Arr, k, ArrInd, ElNum) { ElNum = 0; for (ArrInd in Arr) { k[++ElNum] = ArrInd; } qsortSegment(Arr, k, 1, ElNum); return ElNum; } # # qsortSegment(): Sort a segment of an array. # # Input variables: # # Arr[] contains data with arbitrary indices. # # k[] has indices 1..nelem, with the indices of Arr[] as values. # # Output variables: # # k[] is modified by this function. The elements of Arr[] that are pointed to # by k[start..end] are sorted, with the values of elements of k[] swapped # so that when this function returns, Arr[k[start..end]] will be in order. # # Return value: None. # function qsortSegment(Arr, k, start, end, left, right, sepval, tmp, tmpe, tmps) { if ((end - start) < 1) { # 0 or 1 elements return; } # handle two-element case explicitly for a tiny speedup if ((end - start) == 1) { if (Arr[tmps = k[start]] > Arr[tmpe = k[end]]) { k[start] = tmpe; k[end] = tmps; } return; } # Make sure comparisons act on these as numbers left = start + 0; right = end + 0; sepval = Arr[k[int((left + right) / 2)]]; # Make every element <= sepval be to the left of every element > sepval while (left < right) { while (Arr[k[left]] < sepval) { left++; } while (Arr[k[right]] > sepval) { right--; } if (left < right) { tmp = k[left]; k[left++] = k[right]; k[right--] = tmp; } } if (left == right) if (Arr[k[left]] < sepval) { left++; } else { right--; } if (start < right) { qsortSegment(Arr, k, start, right); } if (left < end) { qsortSegment(Arr, k, left, end); } }BASIC ANSI BASIC
100 REM Sorting algorithms/Quicksort 110 DECLARE EXTERNAL SUB QuickSort 120 DIM Arr(0 TO 19) 130 LET A = LBOUND(Arr) 140 LET B = UBOUND(Arr) 150 RANDOMIZE 160 FOR I = A TO B 170 LET Arr(I) = ROUND(INT(RND * 99)) 180 NEXT I 190 PRINT "Unsorted:" 200 FOR I = A TO B 210 PRINT USING "## ": Arr(I); 220 NEXT I 230 PRINT 240 PRINT "Sorted:" 250 CALL QuickSort(Arr, A, B) 260 FOR I = A TO B 270 PRINT USING "## ": Arr(I); 280 NEXT I 290 PRINT 300 END 310 REM ** 320 EXTERNAL SUB QuickSort (Arr(), L, R) 330 LET LIndex = L 340 LET RIndex = R 350 IF R > L THEN 360 LET Pivot = INT((L + R) / 2) 370 DO WHILE (LIndex <= Pivot) AND (RIndex >= Pivot) 380 DO WHILE (Arr(LIndex) < Arr(Pivot)) AND (LIndex <= Pivot) 390 LET LIndex = LIndex + 1 400 LOOP 410 DO WHILE (Arr(RIndex) > Arr(Pivot)) AND (RIndex >= Pivot) 420 LET RIndex = RIndex - 1 430 LOOP 440 LET Temp = Arr(LIndex) 450 LET Arr(LIndex) = Arr(RIndex) 460 LET Arr(RIndex) = Temp 470 LET LIndex = LIndex + 1 480 LET RIndex = RIndex - 1 490 IF (LIndex - 1) = Pivot THEN 500 LET RIndex = RIndex + 1 510 LET Pivot = RIndex 520 ELSEIF (RIndex + 1) = Pivot THEN 530 LET LIndex = LIndex - 1 540 LET Pivot = LIndex 550 END IF 560 LOOP 570 CALL QuickSort (Arr, L, Pivot - 1) 580 CALL QuickSort (Arr, Pivot + 1, R) 590 END IF 600 END SUB
(example)
Unsorted: 17 79 23 91 28 91 29 58 47 59 8 35 93 23 34 28 35 31 7 25 Sorted: 7 8 17 23 23 25 28 28 29 31 34 35 35 47 58 59 79 91 91 93BBC BASIC
DIM test(9) test() = 4, 65, 2, -31, 0, 99, 2, 83, 782, 1 PROCquicksort(test(), 0, 10) FOR i% = 0 TO 9 PRINT test(i%) ; NEXT PRINT END DEF PROCquicksort(a(), s%, n%) LOCAL l%, p, r%, t% IF n% < 2 THEN ENDPROC t% = s% + n% - 1 l% = s% r% = t% p = a((l% + r%) DIV 2) REPEAT WHILE a(l%) < p l% += 1 : ENDWHILE WHILE a(r%) > p r% -= 1 : ENDWHILE IF l% <= r% THEN SWAP a(l%), a(r%) l% += 1 r% -= 1 ENDIF UNTIL l% > r% IF s% < r% PROCquicksort(a(), s%, r% - s% + 1) IF l% < t% PROCquicksort(a(), l%, t% - l% + 1 ) ENDPROC
-31 0 1 2 2 4 65 83 99 782Chipmunk Basic
100 dim array(15) 110 a = 0 120 b = ubound(array) 130 randomize timer 140 for i = a to b 150 array(i) = rnd(1)*1000 160 next i 170 print "unsort "; 180 for i = a to b 190 print using "####";array(i); 200 if i = b then print ""; else print ", "; 210 next i 220 quicksort(array(),a,b) 230 print : print " sort "; 240 for i = a to b 250 print using "####";array(i); 260 if i = b then print ""; else print ", "; 270 next i 280 print 290 end 300 sub quicksort(array(),l,r) 310 size = r-l+1 320 if size < 2 then return 330 i = l 340 j = r 350 pivot = array(l+int(size/2)) 360 rem repeat 370 while array(i) < pivot 380 i = i+1 390 wend 400 while pivot < array(j) 410 j = j-1 420 wend 430 if i <= j then temp = array(i) : array(i) = array(j) : array(j) = temp : i = i+1 : j = j-1 440 if i <= j then goto 360 450 if l < j then quicksort(array(),l,j) 460 if i < r then quicksort(array(),i,r) 470 end subCraft Basic
define size = 10, point = 0, top = 0 define high = 0, low = 0, pivot = 0 dim list[size] dim stack[size] gosub fill gosub sort gosub show end sub fill for i = 0 to size - 1 let list[i] = int(rnd * 100) next i return sub sort let low = 0 let high = size - 1 let top = -1 let top = top + 1 let stack[top] = low let top = top + 1 let stack[top] = high do if top < 0 then break endif let high = stack[top] let top = top - 1 let low = stack[top] let top = top - 1 let i = low - 1 for j = low to high - 1 if list[j] <= list[high] then let i = i + 1 let t = list[i] let list[i] = list[j] let list[j] = t endif next j let point = i + 1 let t = list[point] let list[point] = list[high] let list[high] = t let pivot = i + 1 if pivot - 1 > low then let top = top + 1 let stack[top] = low let top = top + 1 let stack[top] = pivot - 1 endif if pivot + 1 < high then let top = top + 1 let stack[top] = pivot + 1 let top = top + 1 let stack[top] = high endif wait loop top >= 0 return sub show for i = 0 to size - 1 print i, ": ", list[i] next i returnFreeBASIC
' version 23-10-2016 ' compile with: fbc -s console ' sort from lower bound to the highter bound ' array's can have subscript range from -2147483648 to +2147483647 Sub quicksort(qs() As Long, l As Long, r As Long) Dim As ULong size = r - l +1 If size < 2 Then Exit Sub Dim As Long i = l, j = r Dim As Long pivot = qs(l + size \ 2) Do While qs(i) < pivot i += 1 Wend While pivot < qs(j) j -= 1 Wend If i <= j Then Swap qs(i), qs(j) i += 1 j -= 1 End If Loop Until i > j If l < j Then quicksort(qs(), l, j) If i < r Then quicksort(qs(), i, r) End Sub ' ------=< MAIN >=------ Dim As Long i, array(-7 To 7) Dim As Long a = LBound(array), b = UBound(array) Randomize Timer For i = a To b : array(i) = i : Next For i = a To b ' little shuffle Swap array(i), array(Int(Rnd * (b - a +1)) + a) Next Print "unsorted "; For i = a To b : Print Using "####"; array(i); : Next : Print quicksort(array(), LBound(array), UBound(array)) Print " sorted "; For i = a To b : Print Using "####"; array(i); : Next : Print ' empty keyboard buffer While Inkey <> "" : Wend Print : Print "hit any key to end program" Sleep End
unsorted -5 -6 -1 0 2 -4 -7 6 -2 -3 4 7 5 1 3 sorted -7 -6 -5 -4 -3 -2 -1 0 1 2 3 4 5 6 7FutureBasic
include "NSLog.incl" local fn Quicksort( qs as CFMutableArrayRef, l as NSInteger, r as NSInteger ) UInt64 size = r - l + 1 if size < 2 then exit fn NSinteger i = l, j = r NSinteger pivot = fn NumberIntegerValue( qs[l+size / 2] ) do while fn NumberIntegerValue( qs[i] ) < pivot i++ wend while pivot < fn NumberIntegerValue( qs[j] ) j-- wend if ( i <= j ) MutableArrayExchangeObjects( qs, i, j ) i++ j-- end if until i > j if l < j then fn Quicksort( qs, l, j ) if i < r then fn Quicksort( qs, i, r ) end fn CFMutableArrayRef qs CFArrayRef unsorted NSUInteger i, amount qs = fn MutableArrayWithCapacity(0) for i = 0 to 25 if i mod 2 == 0 then amount = 100 else amount = 10000 MutableArrayInsertObjectAtIndex( qs, fn NumberWithInteger( rnd(amount) ), i ) next unsorted = fn ArrayWithArray( qs ) fn QuickSort( qs, 0, len(qs) - 1 ) NSLog( @"\n-----------------\nUnsorted : Sorted\n-----------------" ) for i = 0 to 25 NSLog( @"%8ld : %-8ld", fn NumberIntegerValue( unsorted[i] ), fn NumberIntegerValue( qs[i] ) ) next randomize HandleEvents
----------------- Unsorted : Sorted ----------------- 97 : 5 6168 : 30 61 : 34 8847 : 40 55 : 46 2570 : 49 40 : 55 4676 : 61 94 : 62 693 : 67 62 : 79 3419 : 94 30 : 97 936 : 693 5 : 733 9910 : 936 67 : 1395 8460 : 1796 79 : 2570 9352 : 3419 49 : 4676 1395 : 6168 34 : 8460 733 : 8847 46 : 9352 1796 : 9910IS-BASIC
100 PROGRAM "QuickSrt.bas" 110 RANDOMIZE 120 NUMERIC A(5 TO 19) 130 CALL INIT(A) 140 CALL WRITE(A) 150 CALL QSORT(LBOUND(A),UBOUND(A)) 160 CALL WRITE(A) 170 DEF INIT(REF A) 180 FOR I=LBOUND(A) TO UBOUND(A) 190 LET A(I)=RND(98)+1 200 NEXT 210 END DEF 220 DEF WRITE(REF A) 230 FOR I=LBOUND(A) TO UBOUND(A) 240 PRINT A(I); 250 NEXT 260 PRINT 270 END DEF 280 DEF QSORT(AH,FH) 290 NUMERIC E 300 LET E=AH:LET U=FH:LET K=A(E) 310 DO UNTIL E=U 320 DO UNTIL E=U OR A(U)<K 330 LET U=U-1 340 LOOP 350 IF E<U THEN 360 LET A(E)=A(U):LET E=E+1 370 DO UNTIL E=U OR A(E)>K 380 LET E=E+1 390 LOOP 400 IF E<U THEN LET A(U)=A(E):LET U=U-1 410 END IF 420 LOOP 430 LET A(E)=K 440 IF AH<E-1 THEN CALL QSORT(AH,E-1) 450 IF E+1<FH THEN CALL QSORT(E+1,FH) 460 END DEFPureBasic
Procedure qSort(Array a(1), firstIndex, lastIndex) Protected low, high, pivotValue low = firstIndex high = lastIndex pivotValue = a((firstIndex + lastIndex) / 2) Repeat While a(low) < pivotValue low + 1 Wend While a(high) > pivotValue high - 1 Wend If low <= high Swap a(low), a(high) low + 1 high - 1 EndIf Until low > high If firstIndex < high qSort(a(), firstIndex, high) EndIf If low < lastIndex qSort(a(), low, lastIndex) EndIf EndProcedure Procedure quickSort(Array a(1)) qSort(a(),0,ArraySize(a())) EndProcedureQB64
' Written by Sanmayce, 2021-Oct-29 ' The indexes are signed, but the elements are unsigned. _Define A-Z As _INTEGER64 Sub Quicksort_QB64 (QWORDS~&&()) Left = LBound(QWORDS~&&) Right = UBound(QWORDS~&&) LeftMargin = Left ReDim Stack&&(Left To Right) StackPtr = 0 StackPtr = StackPtr + 1 Stack&&(StackPtr + LeftMargin) = Left StackPtr = StackPtr + 1 Stack&&(StackPtr + LeftMargin) = Right Do 'Until StackPtr = 0 Right = Stack&&(StackPtr + LeftMargin) StackPtr = StackPtr - 1 Left = Stack&&(StackPtr + LeftMargin) StackPtr = StackPtr - 1 Do 'Until Left >= Right Pivot~&& = QWORDS~&&((Left + Right) \ 2) Indx = Left Jndx = Right Do Do While (QWORDS~&&(Indx) < Pivot~&&) Indx = Indx + 1 Loop Do While (QWORDS~&&(Jndx) > Pivot~&&) Jndx = Jndx - 1 Loop If Indx <= Jndx Then If Indx < Jndx Then Swap QWORDS~&&(Indx), QWORDS~&&(Jndx) Indx = Indx + 1 Jndx = Jndx - 1 End If Loop While Indx <= Jndx If Indx < Right Then StackPtr = StackPtr + 1 Stack&&(StackPtr + LeftMargin) = Indx StackPtr = StackPtr + 1 Stack&&(StackPtr + LeftMargin) = Right End If Right = Jndx Loop Until Left >= Right Loop Until StackPtr = 0 End SubQuickBASIC
This is specifically for INTEGER
s, but can be modified for any data type by changing arr()
's type.
DECLARE SUB quicksort (arr() AS INTEGER, leftN AS INTEGER, rightN AS INTEGER) DIM q(99) AS INTEGER DIM n AS INTEGER RANDOMIZE TIMER FOR n = 0 TO 99 q(n) = INT(RND * 9999) NEXT OPEN "output.txt" FOR OUTPUT AS 1 FOR n = 0 TO 99 PRINT #1, q(n), NEXT PRINT #1, quicksort q(), 0, 99 FOR n = 0 TO 99 PRINT #1, q(n), NEXT CLOSE SUB quicksort (arr() AS INTEGER, leftN AS INTEGER, rightN AS INTEGER) DIM pivot AS INTEGER, leftNIdx AS INTEGER, rightNIdx AS INTEGER leftNIdx = leftN rightNIdx = rightN IF (rightN - leftN) > 0 THEN pivot = (leftN + rightN) / 2 WHILE (leftNIdx <= pivot) AND (rightNIdx >= pivot) WHILE (arr(leftNIdx) < arr(pivot)) AND (leftNIdx <= pivot) leftNIdx = leftNIdx + 1 WEND WHILE (arr(rightNIdx) > arr(pivot)) AND (rightNIdx >= pivot) rightNIdx = rightNIdx - 1 WEND SWAP arr(leftNIdx), arr(rightNIdx) leftNIdx = leftNIdx + 1 rightNIdx = rightNIdx - 1 IF (leftNIdx - 1) = pivot THEN rightNIdx = rightNIdx + 1 pivot = rightNIdx ELSEIF (rightNIdx + 1) = pivot THEN leftNIdx = leftNIdx - 1 pivot = leftNIdx END IF WEND quicksort arr(), leftN, pivot - 1 quicksort arr(), pivot + 1, rightN END IF END SUBRun BASIC
' ------------------------------- ' quick sort ' ------------------------------- size = 50 dim s(size) ' array to sort for i = 1 to size ' fill it with some random numbers s(i) = rnd(0) * 100 next i lft = 1 rht = size [qSort] lftHold = lft rhtHold = rht pivot = s(lft) while lft < rht while (s(rht) >= pivot) and (lft < rht) : rht = rht - 1 :wend if lft <> rht then s(lft) = s(rht) lft = lft + 1 end if while (s(lft) <= pivot) and (lft < rht) : lft = lft + 1 :wend if lft <> rht then s(rht) = s(lft) rht = rht - 1 end if wend s(lft) = pivot pivot = lft lft = lftHold rht = rhtHold if lft < pivot then rht = pivot - 1 goto [qSort] end if if rht > pivot then lft = pivot + 1 goto [qSort] end if for i = 1 to size print i;"-->";s(i) next iTrue BASIC
SUB quicksort (arr(), l, r) LET lidx = round(l) LET ridx = round(r) IF (r-l) > 0 THEN LET pivot = round((l+r)/2) DO WHILE (lidx <= pivot) AND (ridx >= pivot) DO WHILE (arr(lidx) < arr(pivot)) AND (lidx <= pivot) LET lidx = lidx+1 LOOP DO WHILE (arr(ridx) > arr(pivot)) AND (ridx >= pivot) LET ridx = ridx-1 LOOP LET temp = arr(lidx) LET arr(lidx) = arr(ridx) LET arr(ridx) = temp LET lidx = lidx+1 LET ridx = ridx-1 IF (lidx-1) = pivot THEN LET ridx = ridx+1 LET pivot = ridx ELSEIF (ridx+1) = pivot THEN LET lidx = lidx-1 LET pivot = lidx END IF LOOP CALL quicksort (arr(), l, pivot-1) CALL quicksort (arr(), pivot+1, r) END IF END SUB DIM arr(15) LET a = round(LBOUND(arr)) LET b = round(UBOUND(arr)) RANDOMIZE FOR n = a TO b LET arr(n) = round(INT(RND*99)) NEXT n PRINT "unsort "; FOR n = a TO b PRINT arr(n); " "; NEXT n PRINT PRINT " sort "; CALL quicksort (arr(), a, b) FOR n = a TO b PRINT arr(n); " "; NEXT n ENDuBasic/4tH
PRINT "Quick sort:" n = FUNC (_InitArray) PROC _ShowArray (n) PROC _Quicksort (n) PROC _ShowArray (n) PRINT END _InnerQuick PARAM(2) LOCAL(4) IF b@ < 2 THEN RETURN f@ = a@ + b@ - 1 c@ = a@ e@ = f@ d@ = @((c@ + e@) / 2) DO DO WHILE @(c@) < d@ c@ = c@ + 1 LOOP DO WHILE @(e@) > d@ e@ = e@ - 1 LOOP IF c@ - 1 < e@ THEN PROC _Swap (c@, e@) c@ = c@ + 1 e@ = e@ - 1 ENDIF UNTIL c@ > e@ LOOP IF a@ < e@ THEN PROC _InnerQuick (a@, e@ - a@ + 1) IF c@ < f@ THEN PROC _InnerQuick (c@, f@ - c@ + 1) RETURN _Quicksort PARAM(1) ' Quick sort PROC _InnerQuick (0, a@) RETURN _Swap PARAM(2) ' Swap two array elements PUSH @(a@) @(a@) = @(b@) @(b@) = POP() RETURN _InitArray ' Init example array PUSH 4, 65, 2, -31, 0, 99, 2, 83, 782, 1 FOR i = 0 TO 9 @(i) = POP() NEXT RETURN (i) _ShowArray PARAM (1) ' Show array subroutine FOR i = 0 TO a@-1 PRINT @(i), NEXT PRINT RETURNVBA
This is the "simple" quicksort, using temporary arrays.
Public Sub Quick(a() As Variant, last As Integer) ' quicksort a Variant array (1-based, numbers or strings) Dim aLess() As Variant Dim aEq() As Variant Dim aGreater() As Variant Dim pivot As Variant Dim naLess As Integer Dim naEq As Integer Dim naGreater As Integer If last > 1 Then 'choose pivot in the middle of the array pivot = a(Int((last + 1) / 2)) 'construct arrays naLess = 0 naEq = 0 naGreater = 0 For Each el In a() If el > pivot Then naGreater = naGreater + 1 ReDim Preserve aGreater(1 To naGreater) aGreater(naGreater) = el ElseIf el < pivot Then naLess = naLess + 1 ReDim Preserve aLess(1 To naLess) aLess(naLess) = el Else naEq = naEq + 1 ReDim Preserve aEq(1 To naEq) aEq(naEq) = el End If Next 'sort arrays "less" and "greater" Quick aLess(), naLess Quick aGreater(), naGreater 'concatenate P = 1 For i = 1 To naLess a(P) = aLess(i): P = P + 1 Next For i = 1 To naEq a(P) = aEq(i): P = P + 1 Next For i = 1 To naGreater a(P) = aGreater(i): P = P + 1 Next End If End Sub Public Sub QuicksortTest() Dim a(1 To 26) As Variant 'populate a with numbers in descending order, then sort For i = 1 To 26: a(i) = 26 - i: Next Quick a(), 26 For i = 1 To 26: Debug.Print a(i);: Next Debug.Print 'now populate a with strings in descending order, then sort For i = 1 To 26: a(i) = Chr$(Asc("z") + 1 - i) & "-stuff": Next Quick a(), 26 For i = 1 To 26: Debug.Print a(i); " ";: Next Debug.Print End Sub
quicksorttest 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 a-stuff b-stuff c-stuff d-stuff e-stuff f-stuff g-stuff h-stuff i-stuff j-stuff k-stuff l-stuff m-stuff n-stuff o-stuff p-stuff q-stuff r-stuff s-stuff t-stuff u-stuff v-stuff w-stuff x-stuff y-stuff z-stuff
Note: the "quicksort in place"
VBScriptFunction quicksort(arr,s,n) If n < 2 Then Exit Function End If t = s + n - 1 l = s r = t p = arr(Int((l + r)/2)) Do Until l > r Do While arr(l) < p l = l + 1 Loop Do While arr(r) > p r = r -1 Loop If l <= r Then tmp = arr(l) arr(l) = arr(r) arr(r) = tmp l = l + 1 r = r - 1 End If Loop If s < r Then Call quicksort(arr,s,r-s+1) End If If l < t Then Call quicksort(arr,l,t-l+1) End If quicksort = arr End Function myarray=Array(9,8,7,6,5,5,4,3,2,1,0,-1) m = quicksort(myarray,0,12) WScript.Echo Join(m,",")
-1,0,1,2,3,4,5,5,6,7,8,9Visual Basic
QuickSort without swapping
Sub QuickSort(arr() As Integer, ByVal f As Integer, ByVal l As Integer) i = f 'First j = l 'Last Key = arr(i) 'Pivot Do While i < j Do While i < j And Key < arr(j) j = j - 1 Loop If i < j Then arr(i) = arr(j): i = i + 1 Do While i < j And Key > arr(i) i = i + 1 Loop If i < j Then arr(j) = arr(i): j = j - 1 Loop arr(i) = Key If i - 1 > f Then QuickSort arr(), f, i - 1 If j + 1 < l Then QuickSort arr(), j + 1, l End SubXBasic
Note. XBasic has also a standard function XstQuickSort
in the xst library.
' Sorting algorithms/Quicksort PROGRAM "quicksort" VERSION "1.0" IMPORT "xst" DECLARE FUNCTION Entry () DECLARE FUNCTION QuickSort (@arr%[], l%%, r%%) ' Pseudo-random number generator ' Based on the rand, srand functions from Kernighan & Ritchie's book ' 'The C Programming Language' DECLARE FUNCTION Rand() DECLARE FUNCTION SRand(seed%%) FUNCTION Entry () DIM arr%[19] a%% = 0 b%% = UBOUND(arr%[]) XstGetSystemTime (@msec) SRand(INT(msec) MOD 32768) FOR i%% = a%% TO b%% arr%[i%%] = INT(Rand() / 32768.0 * 99.0) NEXT i%% PRINT "Unsorted:" FOR i%% = a%% TO b%% PRINT FORMAT$("## ", arr%[i%%]); NEXT i%% PRINT PRINT "Sorted:" QuickSort(@arr%[], a%%, b%%) FOR i%% = a%% TO b%% PRINT FORMAT$("## ", arr%[i%%]); NEXT i%% PRINT END FUNCTION FUNCTION QuickSort (@arr%[], l%%, r%%) leftIndex%% = l%% rightIndex%% = r%% IF r%% > l%% THEN pivot%% = (l%% + r%%) \ 2 DO WHILE (leftIndex%% <= pivot%%) AND (rightIndex%% >= pivot%%) DO WHILE (arr%[leftIndex%%] < arr%[pivot%%]) AND (leftIndex%% <= pivot%%) INC leftIndex%% LOOP DO WHILE (arr%[rightIndex%%] > arr%[pivot%%]) AND (rightIndex%% >= pivot%%) DEC rightIndex%% LOOP SWAP arr%[leftIndex%%], arr%[rightIndex%%] INC leftIndex%% DEC rightIndex%% SELECT CASE TRUE CASE leftIndex%% - 1 = pivot%%: INC rightIndex%% pivot%% = rightIndex%% CASE rightIndex%% + 1 = pivot%%: DEC leftIndex%% pivot%% = leftIndex%% END SELECT LOOP QuickSort (@arr%[], l%%, pivot%% - 1) QuickSort (@arr%[], pivot%% + 1, r%%) END IF END FUNCTION ' Return pseudo-random integer on 0..32767 FUNCTION Rand() #next&& = #next&& * 1103515245 + 12345 END FUNCTION USHORT(#next&& / 65536) MOD 32768 ' Set seed for Rand() FUNCTION SRand(seed%%) #next&& = seed%% END FUNCTION END PROGRAM
(example)
Unsorted: 18 37 79 14 23 13 64 37 84 37 22 64 25 43 26 13 12 83 21 41 Sorted: 12 13 13 14 18 21 22 23 25 26 37 37 37 41 43 64 64 79 83 84Yabasic
Rosetta Code problem: https://rosettacode.org/wiki/Sorting_algorithms/Quicksort
by Jjuanhdez, 03/2023
dim array(15) a = 0 b = arraysize(array(),1) for i = a to b array(i) = ran(1000) next i print "unsort "; for i = a to b print array(i) using("####"); if i = b then print ""; else print ", "; : fi next i quickSort(array(), a, b) print "\n sort "; for i = a to b print array(i) using("####"); if i = b then print ""; else print ", "; : fi next i print end sub quickSort(array(), l, r) local asize, i, j, pivot size = r - l +1 if size < 2 return i = l j = r pivot = array(l + int(size / 2)) repeat while array(i) < pivot i = i + 1 wend while pivot < array(j) j = j - 1 wend if i <= j then temp = array(i) array(i) = array(j) array(j) = temp i = i + 1 j = j - 1 fi until i > j if l < j quickSort(array(), l, j) if i < r quickSort(array(), i, r) end sub
unsort 582, 796, 598, 478, 27, 125, 477, 679, 133, 513, 154, 93, 451, 463, 20 sort 20, 27, 93, 125, 133, 154, 451, 463, 477, 478, 513, 582, 598, 679, 796BCPL
// This can be run using Cintcode BCPL freely available from www.cl.cam.ac.uk/users/mr10. GET "libhdr.h" LET quicksort(v, n) BE qsort(v+1, v+n) AND qsort(l, r) BE { WHILE l+8<r DO { LET midpt = (l+r)/2 // Select a good(ish) median value. LET val = middle(!l, !midpt, !r) LET i = partition(val, l, r) // Only use recursion on the smaller partition. TEST i>midpt THEN { qsort(i, r); r := i-1 } ELSE { qsort(l, i-1); l := i } } FOR p = l+1 TO r DO // Now perform insertion sort. FOR q = p-1 TO l BY -1 TEST q!0<=q!1 THEN BREAK ELSE { LET t = q!0 q!0 := q!1 q!1 := t } } AND middle(a, b, c) = a<b -> b<c -> b, a<c -> c, a, b<c -> a<c -> a, c, b AND partition(median, p, q) = VALOF { LET t = ? WHILE !p < median DO p := p+1 WHILE !q > median DO q := q-1 IF p>=q RESULTIS p t := !p !p := !q !q := t p, q := p+1, q-1 } REPEAT LET start() = VALOF { LET v = VEC 1000 FOR i = 1 TO 1000 DO v!i := randno(1_000_000) quicksort(v, 1000) FOR i = 1 TO 1000 DO { IF i MOD 10 = 0 DO newline() writef(" %i6", v!i) } newline() }Beads
beads 1 program Quicksort calc main_init var arr = [1, 3, 5, 1, 7, 9, 8, 6, 4, 2] var arr2 = arr quicksort(arr, 1, tree_count(arr)) var tempStr : str loop across:arr index:ix tempStr = tempStr & ' ' & to_str(arr[ix]) log tempStr calc quicksort( arr:array of num startIndex highIndex ) if (startIndex < highIndex) var partitionIndex = partition(arr, startIndex, highIndex) quicksort(arr, startIndex, partitionIndex - 1) quicksort(arr, partitionIndex+1, highIndex) calc partition( arr:array of num startIndex highIndex ):num var pivot = arr[highIndex] var i = startIndex - 1 var j = startIndex loop while:(j <= highIndex - 1) if arr[j] < pivot inc i swap arr[i] <=> arr[j] inc j swap arr[i+1] <=> arr[highIndex] return (i+1)
1 1 2 3 4 5 6 7 8 9Bracmat
Instead of comparing elements explicitly, this solution puts the two elements-to-compare in a sum. After evaluating the sum its terms are sorted. Numbers are sorted numerically, strings alphabetically and compound expressions by comparing nodes and leafs in a left-to right order. Now there are three cases: either the terms stayed put, or they were swapped, or they were equal and were combined into one term with a factor 2
in front. To not let the evaluator add numbers together, each term is constructed as a dotted list.
( ( Q = Less Greater Equal pivot element . !arg:%(?pivot:?Equal) %?arg & :?Less:?Greater & whl ' ( !arg:%?element ?arg & (.!element)+(.!pivot) { BAD: 1900+90 adds to 1990, GOOD: (.1900)+(.90) is sorted to (.90)+(.1900) } : ( (.!element)+(.!pivot) & !element !Less:?Less | (.!pivot)+(.!element) & !element !Greater:?Greater | ?&!element !Equal:?Equal ) ) & Q$!Less !Equal Q$!Greater | !arg ) & out$Q$(1900 optimized variants of 4001/2 Quicksort (quick,sort) are (quick,sober) features of 90 languages) );
90 1900 4001/2 Quicksort are features languages of of optimized variants (quick,sober) (quick,sort)Bruijn
:import std/Combinator . :import std/Number . :import std/List . sort y [[0 [[[case-sort]]] case-end]] case-sort (4 lesser) ++ (2 : (4 greater)) lesser (\lt? 2) <#> 1 greater (\ge? 2) <#> 1 case-end empty :test (sort ((+3) : ((+2) : {}(+1)))) ((+1) : ((+2) : {}(+3)))C
#include <stdio.h> void quicksort(int *A, int len); int main (void) { int a[] = {4, 65, 2, -31, 0, 99, 2, 83, 782, 1}; int n = sizeof a / sizeof a[0]; int i; for (i = 0; i < n; i++) { printf("%d ", a[i]); } printf("\n"); quicksort(a, n); for (i = 0; i < n; i++) { printf("%d ", a[i]); } printf("\n"); return 0; } void quicksort(int *A, int len) { if (len < 2) return; int pivot = A[len / 2]; int i, j; for (i = 0, j = len - 1; ; i++, j--) { while (A[i] < pivot) i++; while (A[j] > pivot) j--; if (i >= j) break; int temp = A[i]; A[i] = A[j]; A[j] = temp; } quicksort(A, i); quicksort(A + i, len - i); }
4 65 2 -31 0 99 2 83 782 1 -31 0 1 2 2 4 65 83 99 782
Randomized sort with separated components.
#include <stdlib.h> // REQ: rand() void swap(int *a, int *b) { int c = *a; *a = *b; *b = c; } int partition(int A[], int p, int q) { swap(&A[p + (rand() % (q - p + 1))], &A[q]); // PIVOT = A[q] int i = p - 1; for(int j = p; j <= q; j++) { if(A[j] <= A[q]) { swap(&A[++i], &A[j]); } } return i; } void quicksort(int A[], int p, int q) { if(p < q) { int pivotIndx = partition(A, p, q); quicksort(A, p, pivotIndx - 1); quicksort(A, pivotIndx + 1, q); } }C#
// // The Tripartite conditional enables Bentley-McIlroy 3-way Partitioning. // This performs additional compares to isolate islands of keys equal to // the pivot value. Use unless key-equivalent classes are of small size. // #define Tripartite namespace RosettaCode { using System; using System.Diagnostics; public class QuickSort<T> where T : IComparable { #region Constants public const UInt32 INSERTION_LIMIT_DEFAULT = 12; private const Int32 SAMPLES_MAX = 19; #endregion #region Properties public UInt32 InsertionLimit { get; } private T[] Samples { get; } private Int32 Left { get; set; } private Int32 Right { get; set; } private Int32 LeftMedian { get; set; } private Int32 RightMedian { get; set; } #endregion #region Constructors public QuickSort(UInt32 insertionLimit = INSERTION_LIMIT_DEFAULT) { this.InsertionLimit = insertionLimit; this.Samples = new T[SAMPLES_MAX]; } #endregion #region Sort Methods public void Sort(T[] entries) { Sort(entries, 0, entries.Length - 1); } public void Sort(T[] entries, Int32 first, Int32 last) { var length = last + 1 - first; while (length > 1) { if (length < InsertionLimit) { InsertionSort<T>.Sort(entries, first, last); return; } Left = first; Right = last; var median = pivot(entries); partition(median, entries); //[Note]Right < Left var leftLength = Right + 1 - first; var rightLength = last + 1 - Left; // // First recurse over shorter partition, then loop // on the longer partition to elide tail recursion. // if (leftLength < rightLength) { Sort(entries, first, Right); first = Left; length = rightLength; } else { Sort(entries, Left, last); last = Right; length = leftLength; } } } /// <summary>Return an odd sample size proportional to the log of a large interval size.</summary> private static Int32 sampleSize(Int32 length, Int32 max = SAMPLES_MAX) { var logLen = (Int32)Math.Log10(length); var samples = Math.Min(2 * logLen + 1, max); return Math.Min(samples, length); } /// <summary>Estimate the median value of entries[Left:Right]</summary> /// <remarks>A sample median is used as an estimate the true median.</remarks> private T pivot(T[] entries) { var length = Right + 1 - Left; var samples = sampleSize(length); // Sample Linearly: for (var sample = 0; sample < samples; sample++) { // Guard against Arithmetic Overflow: var index = (Int64)length * sample / samples + Left; Samples[sample] = entries[index]; } InsertionSort<T>.Sort(Samples, 0, samples - 1); return Samples[samples / 2]; } private void partition(T median, T[] entries) { var first = Left; var last = Right; #if Tripartite LeftMedian = first; RightMedian = last; #endif while (true) { //[Assert]There exists some index >= Left where entries[index] >= median //[Assert]There exists some index <= Right where entries[index] <= median // So, there is no need for Left or Right bound checks while (median.CompareTo(entries[Left]) > 0) Left++; while (median.CompareTo(entries[Right]) < 0) Right--; //[Assert]entries[Right] <= median <= entries[Left] if (Right <= Left) break; Swap(entries, Left, Right); swapOut(median, entries); Left++; Right--; //[Assert]entries[first:Left - 1] <= median <= entries[Right + 1:last] } if (Left == Right) { Left++; Right--; } //[Assert]Right < Left swapIn(entries, first, last); //[Assert]entries[first:Right] <= median <= entries[Left:last] //[Assert]entries[Right + 1:Left - 1] == median when non-empty } #endregion #region Swap Methods [Conditional("Tripartite")] private void swapOut(T median, T[] entries) { if (median.CompareTo(entries[Left]) == 0) Swap(entries, LeftMedian++, Left); if (median.CompareTo(entries[Right]) == 0) Swap(entries, Right, RightMedian--); } [Conditional("Tripartite")] private void swapIn(T[] entries, Int32 first, Int32 last) { // Restore Median entries while (first < LeftMedian) Swap(entries, first++, Right--); while (RightMedian < last) Swap(entries, Left++, last--); } /// <summary>Swap entries at the left and right indicies.</summary> public void Swap(T[] entries, Int32 left, Int32 right) { Swap(ref entries[left], ref entries[right]); } /// <summary>Swap two entities of type T.</summary> public static void Swap(ref T e1, ref T e2) { var e = e1; e1 = e2; e2 = e; } #endregion } #region Insertion Sort static class InsertionSort<T> where T : IComparable { public static void Sort(T[] entries, Int32 first, Int32 last) { for (var next = first + 1; next <= last; next++) insert(entries, first, next); } /// <summary>Bubble next entry up to its sorted location, assuming entries[first:next - 1] are already sorted.</summary> private static void insert(T[] entries, Int32 first, Int32 next) { var entry = entries[next]; while (next > first && entries[next - 1].CompareTo(entry) > 0) entries[next] = entries[--next]; entries[next] = entry; } } #endregion }
Example:
using Sort; using System; class Program { static void Main(String[] args) { var entries = new Int32[] { 1, 3, 5, 7, 9, 8, 6, 4, 2 }; var sorter = new QuickSort<Int32>(); sorter.Sort(entries); Console.WriteLine(String.Join(" ", entries)); } }
1 2 3 4 5 6 7 8 9
A very inefficient way to do qsort in C# to prove C# code can be just as compact and readable as any dynamic code
using System; using System.Collections.Generic; using System.Linq; namespace QSort { class QSorter { private static IEnumerable<IComparable> empty = new List<IComparable>(); public static IEnumerable<IComparable> QSort(IEnumerable<IComparable> iEnumerable) { if(iEnumerable.Any()) { var pivot = iEnumerable.First(); return QSort(iEnumerable.Where((anItem) => pivot.CompareTo(anItem) > 0)). Concat(iEnumerable.Where((anItem) => pivot.CompareTo(anItem) == 0)). Concat(QSort(iEnumerable.Where((anItem) => pivot.CompareTo(anItem) < 0))); } return empty; } } }CafeOBJ
There is no builtin list type in CafeOBJ, so a user written list module is included.
mod! SIMPLE-LIST(X :: TRIV){ [NeList < List ] op [] : -> List op [_] : Elt -> List op (_:_) : Elt List -> NeList -- consr op _++_ : List List -> List {assoc} -- concatenate var E : Elt vars L L' : List eq [ E ] = E : [] . eq [] ++ L = L . eq (E : L) ++ L' = E : (L ++ L') . } mod! QUICKSORT{ pr(SIMPLE-LIST(NAT)) op qsort_ : List -> List op smaller__ : List Nat -> List op larger__ : List Nat -> List vars x y : Nat vars xs ys : List eq qsort [] = [] . eq qsort (x : xs) = (qsort (smaller xs x)) ++ [ x ] ++ (qsort (larger xs x)) . eq smaller [] x = [] . eq smaller (x : xs) y = if x <= y then (x : (smaller xs y)) else (smaller xs y) fi . eq larger [] x = [] . eq larger (x : xs) y = if x <= y then (larger xs y) else (x : (larger xs y)) fi . } open QUICKSORT . red qsort(5 : 4 : 3 : 2 : 1 : 0 : []) . red qsort(5 : 5 : 4 : 3 : 5 : 2 : 1 : 1 : 0 : []) . eofC++
The following implements quicksort with a median-of-three pivot. As idiomatic in C++, the argument last is a one-past-end iterator. Note that this code takes advantage of std::partition, which is O(n). Also note that it needs a random-access iterator for efficient calculation of the median-of-three pivot (more exactly, for O(1) calculation of the iterator mid).
#include <iterator> #include <algorithm> // for std::partition #include <functional> // for std::less // helper function for median of three template<typename T> T median(T t1, T t2, T t3) { if (t1 < t2) { if (t2 < t3) return t2; else if (t1 < t3) return t3; else return t1; } else { if (t1 < t3) return t1; else if (t2 < t3) return t3; else return t2; } } // helper object to get <= from < template<typename Order> struct non_strict_op: public std::binary_function<typename Order::second_argument_type, typename Order::first_argument_type, bool> { non_strict_op(Order o): order(o) {} bool operator()(typename Order::second_argument_type arg1, typename Order::first_argument_type arg2) const { return !order(arg2, arg1); } private: Order order; }; template<typename Order> non_strict_op<Order> non_strict(Order o) { return non_strict_op<Order>(o); } template<typename RandomAccessIterator, typename Order> void quicksort(RandomAccessIterator first, RandomAccessIterator last, Order order) { if (first != last && first+1 != last) { typedef typename std::iterator_traits<RandomAccessIterator>::value_type value_type; RandomAccessIterator mid = first + (last - first)/2; value_type pivot = median(*first, *mid, *(last-1)); RandomAccessIterator split1 = std::partition(first, last, std::bind2nd(order, pivot)); RandomAccessIterator split2 = std::partition(split1, last, std::bind2nd(non_strict(order), pivot)); quicksort(first, split1, order); quicksort(split2, last, order); } } template<typename RandomAccessIterator> void quicksort(RandomAccessIterator first, RandomAccessIterator last) { quicksort(first, last, std::less<typename std::iterator_traits<RandomAccessIterator>::value_type>()); }
A simpler version of the above that just uses the first element as the pivot and only does one "partition".
#include <iterator> #include <algorithm> // for std::partition #include <functional> // for std::less template<typename RandomAccessIterator, typename Order> void quicksort(RandomAccessIterator first, RandomAccessIterator last, Order order) { if (last - first > 1) { RandomAccessIterator split = std::partition(first+1, last, std::bind2nd(order, *first)); std::iter_swap(first, split-1); quicksort(first, split-1, order); quicksort(split, last, order); } } template<typename RandomAccessIterator> void quicksort(RandomAccessIterator first, RandomAccessIterator last) { quicksort(first, last, std::less<typename std::iterator_traits<RandomAccessIterator>::value_type>()); }Clojure
A very Haskell-like solution using list comprehensions and lazy evaluation.
(defn qsort [L] (if (empty? L) '() (let [[pivot & L2] L] (lazy-cat (qsort (for [y L2 :when (< y pivot)] y)) (list pivot) (qsort (for [y L2 :when (>= y pivot)] y))))))
Another short version (using quasiquote):
(defn qsort [[pvt & rs]] (if pvt `(~@(qsort (filter #(< % pvt) rs)) ~pvt ~@(qsort (filter #(>= % pvt) rs)))))
Another, more readable version (no macros):
(defn qsort [[pivot & xs]] (when pivot (let [smaller #(< % pivot)] (lazy-cat (qsort (filter smaller xs)) [pivot] (qsort (remove smaller xs))))))
A 3-group quicksort (fast when many values are equal):
(defn qsort3 [[pvt :as coll]] (when pvt (let [{left -1 mid 0 right 1} (group-by #(compare % pvt) coll)] (lazy-cat (qsort3 left) mid (qsort3 right)))))
A lazier version of above (unlike group-by, filter returns (and reads) a lazy sequence)
(defn qsort3 [[pivot :as coll]] (when pivot (lazy-cat (qsort (filter #(< % pivot) coll)) (filter #{pivot} coll) (qsort (filter #(> % pivot) coll)))))COBOL
IDENTIFICATION DIVISION. PROGRAM-ID. quicksort RECURSIVE. DATA DIVISION. LOCAL-STORAGE SECTION. 01 temp PIC S9(8). 01 pivot PIC S9(8). 01 left-most-idx PIC 9(5). 01 right-most-idx PIC 9(5). 01 left-idx PIC 9(5). 01 right-idx PIC 9(5). LINKAGE SECTION. 78 Arr-Length VALUE 50. 01 arr-area. 03 arr PIC S9(8) OCCURS Arr-Length TIMES. 01 left-val PIC 9(5). 01 right-val PIC 9(5). PROCEDURE DIVISION USING REFERENCE arr-area, OPTIONAL left-val, OPTIONAL right-val. IF left-val IS OMITTED OR right-val IS OMITTED MOVE 1 TO left-most-idx, left-idx MOVE Arr-Length TO right-most-idx, right-idx ELSE MOVE left-val TO left-most-idx, left-idx MOVE right-val TO right-most-idx, right-idx END-IF IF right-most-idx - left-most-idx < 1 GOBACK END-IF COMPUTE pivot = arr ((left-most-idx + right-most-idx) / 2) PERFORM UNTIL left-idx > right-idx PERFORM VARYING left-idx FROM left-idx BY 1 UNTIL arr (left-idx) >= pivot END-PERFORM PERFORM VARYING right-idx FROM right-idx BY -1 UNTIL arr (right-idx) <= pivot END-PERFORM IF left-idx <= right-idx MOVE arr (left-idx) TO temp MOVE arr (right-idx) TO arr (left-idx) MOVE temp TO arr (right-idx) ADD 1 TO left-idx SUBTRACT 1 FROM right-idx END-IF END-PERFORM CALL "quicksort" USING REFERENCE arr-area, CONTENT left-most-idx, right-idx CALL "quicksort" USING REFERENCE arr-area, CONTENT left-idx, right-most-idx GOBACK .CoffeeScript
quicksort = ([x, xs...]) -> return [] unless x? smallerOrEqual = (a for a in xs when a <= x) larger = (a for a in xs when a > x) (quicksort smallerOrEqual).concat(x).concat(quicksort larger)Common Lisp
The functional programming way
(defun quicksort (list &aux (pivot (car list)) ) (if (cdr list) (nconc (quicksort (remove-if-not #'(lambda (x) (< x pivot)) list)) (remove-if-not #'(lambda (x) (= x pivot)) list) (quicksort (remove-if-not #'(lambda (x) (> x pivot)) list))) list))
With flet
(defun qs (list) (if (cdr list) (flet ((pivot (test) (remove (car list) list :test-not test))) (nconc (qs (pivot #'>)) (pivot #'=) (qs (pivot #'<)))) list))
In-place non-functional
(defun quicksort (sequence) (labels ((swap (a b) (rotatef (elt sequence a) (elt sequence b))) (sub-sort (left right) (when (< left right) (let ((pivot (elt sequence right)) (index left)) (loop for i from left below right when (<= (elt sequence i) pivot) do (swap i (prog1 index (incf index)))) (swap right index) (sub-sort left (1- index)) (sub-sort (1+ index) right))))) (sub-sort 0 (1- (length sequence))) sequence))
Functional with destructuring
(defun quicksort (list) (when list (destructuring-bind (x . xs) list (nconc (quicksort (remove-if (lambda (a) (> a x)) xs)) `(,x) (quicksort (remove-if (lambda (a) (<= a x)) xs))))))Cowgol
include "cowgol.coh"; # Comparator interface, on the model of C, i.e: # foo < bar => -1, foo == bar => 0, foo > bar => 1 typedef CompRslt is int(-1, 1); interface Comparator(foo: intptr, bar: intptr): (rslt: CompRslt); # Quicksort an array of pointer-sized integers given a comparator function # (This is the closest you can get to polymorphism in Cowgol). # Because Cowgol does not support recursion, a pointer to free memory # for a stack must also be given. sub qsort(A: [intptr], len: intptr, comp: Comparator, stack: [intptr]) is # The partition function can be taken almost verbatim from Wikipedia sub partition(lo: intptr, hi: intptr): (p: intptr) is # This is not quite as bad as it looks: /2 compiles into a single shift # and "@bytesof intptr" is always power of 2 so compiles into shift(s). var pivot := [A + (hi/2 + lo/2) * @bytesof intptr]; var i := lo - 1; var j := hi + 1; loop loop i := i + 1; if comp([A + i*@bytesof intptr], pivot) != -1 then break; end if; end loop; loop j := j - 1; if comp([A + j*@bytesof intptr], pivot) != 1 then break; end if; end loop; if i >= j then p := j; return; end if; var ii := i * @bytesof intptr; var jj := j * @bytesof intptr; var t := [A+ii]; [A+ii] := [A+jj]; [A+jj] := t; end loop; end sub; # Cowgol lacks recursion, so we'll have to solve it by implementing # the stack ourselves. var sp: intptr := 0; # stack index sub push(n: intptr) is sp := sp + 1; [stack] := n; stack := @next stack; end sub; sub pop(): (n: intptr) is sp := sp - 1; stack := @prev stack; n := [stack]; end sub; # start by sorting [0..length-1] push(len-1); push(0); while sp != 0 loop var lo := pop(); var hi := pop(); if lo < hi then var p := partition(lo, hi); push(hi); # note the order - we need to push the high pair push(p+1); # first for it to be done last push(p); push(lo); end if; end loop; end sub; # Test: sort a list of numbers sub NumComp implements Comparator is # Compare the inputs as numbers if foo < bar then rslt := -1; elseif foo > bar then rslt := 1; else rslt := 0; end if; end sub; # Numbers var numbers: intptr[] := { 65,13,4,84,29,5,96,73,5,11,17,76,38,26,44,20,36,12,44,51,79,8,99,7,19,95,26 }; # Room for the stack var stackbuf: intptr[256]; # Sort the numbers in place qsort(&numbers as [intptr], @sizeof numbers, NumComp, &stackbuf as [intptr]); # Print the numbers (hopefully in order) var i: @indexof numbers := 0; while i < @sizeof numbers loop print_i32(numbers[i] as uint32); print_char(' '); i := i + 1; end loop; print_nl();
4 5 5 7 8 11 12 13 17 19 20 26 26 29 36 38 44 44 51 65 73 76 79 84 95 96 99Crystal
def quick_sort(a : Array(Int32)) : Array(Int32) return a if a.size <= 1 p = a[0] lt, rt = a[1 .. -1].partition { |x| x < p } return quick_sort(lt) + [p] + quick_sort(rt) end a = [7, 6, 5, 9, 8, 4, 3, 1, 2, 0] puts quick_sort(a) # => [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]Curry
Copied from Curry: Example Programs.
-- quicksort using higher-order functions: qsort :: [Int] -> [Int] qsort [] = [] qsort (x:l) = qsort (filter (<x) l) ++ x : qsort (filter (>=x) l) goal = qsort [2,3,1,0]D
A Functional version
import std.stdio : writefln, writeln; import std.algorithm: filter; import std.array; T[] quickSort(T)(T[] xs) => xs.length == 0 ? [] : xs[1 .. $].filter!(x => x< xs[0]).array.quickSort ~ xs[0 .. 1] ~ xs[1 .. $].filter!(x => x>=xs[0]).array.quickSort; void main() => [4, 65, 2, -31, 0, 99, 2, 83, 782, 1].quickSort.writeln;
[-31, 0, 1, 2, 2, 4, 65, 83, 99, 782]
A simple high-level version (same output):
import std.stdio, std.array; T[] quickSort(T)(T[] items) pure nothrow { if (items.empty) return items; T[] less, notLess; foreach (x; items[1 .. $]) (x < items[0] ? less : notLess) ~= x; return less.quickSort ~ items[0] ~ notLess.quickSort; } void main() { [4, 65, 2, -31, 0, 99, 2, 83, 782, 1].quickSort.writeln; }
Often short functional sieves are not a true implementations of the Sieve of Eratosthenes: http://www.cs.hmc.edu/~oneill/papers/Sieve-JFP.pdf
Similarly, one could argue that a true QuickSort is in-place, as this more efficient version (same output):
import std.stdio, std.algorithm; void quickSort(T)(T[] items) pure nothrow @safe @nogc { if (items.length >= 2) { auto parts = partition3(items, items[$ / 2]); parts[0].quickSort; parts[2].quickSort; } } void main() { auto items = [4, 65, 2, -31, 0, 99, 2, 83, 782, 1]; items.quickSort; items.writeln; }Delphi
This quick sort routine is infinitely versatile. It sorts an array of pointers. The advantage of this is that pointers can contain anything, ranging from integers, to strings, to floating point numbers to objects. The way each pointer is interpreted is through the compare routine, which is customized for the particular situation. The compare routine can interpret each pointer as a string, an integer, a float or an object and it can treat those items in different ways. For example, the order in which it compares strings controls whether the sort is alphabetical or reverse alphabetical. In this case, I show an integer sort, an alphabetic string sort, a reverse alphabetical string sort and a string sort by length.
{Dynamic array of pointers} type TPointerArray = array of Pointer; procedure QuickSort(SortList: TPointerArray; L, R: Integer; SCompare: TListSortCompare); {Do quick sort on items held in TPointerArray} {SCompare controls how the pointers are interpreted} var I, J: Integer; var P,T: Pointer; begin repeat begin I := L; J := R; P := SortList[(L + R) shr 1]; repeat begin while SCompare(SortList[I], P) < 0 do Inc(I); while SCompare(SortList[J], P) > 0 do Dec(J); if I <= J then begin {Exchange itesm} T:=SortList[I]; SortList[I]:=SortList[J]; SortList[J]:=T; if P = SortList[I] then P := SortList[J] else if P = SortList[J] then P := SortList[I]; Inc(I); Dec(J); end; end until I > J; if L < J then QuickSort(SortList, L, J, SCompare); L := I; end until I >= R; end; procedure DisplayStrings(Memo: TMemo; PA: TPointerArray); {Display pointers as strings} var I: integer; var S: string; begin S:='['; for I:=0 to High(PA) do begin if I>0 then S:=S+' '; S:=S+string(PA[I]^); end; S:=S+']'; Memo.Lines.Add(S); end; procedure DisplayIntegers(Memo: TMemo; PA: TPointerArray); {Display pointer array as integers} var I: integer; var S: string; begin S:='['; for I:=0 to High(PA) do begin if I>0 then S:=S+' '; S:=S+IntToStr(Integer(PA[I])); end; S:=S+']'; Memo.Lines.Add(S); end; function IntCompare(Item1, Item2: Pointer): Integer; {Compare for integer sort} begin Result:=Integer(Item1)-Integer(Item2); end; function StringCompare(Item1, Item2: Pointer): Integer; {Compare for alphabetical string sort} begin Result:=AnsiCompareText(string(Item1^),string(Item2^)); end; function StringRevCompare(Item1, Item2: Pointer): Integer; {Compare for reverse alphabetical order} begin Result:=AnsiCompareText(string(Item2^),string(Item1^)); end; function StringLenCompare(Item1, Item2: Pointer): Integer; {Compare for string length sort} begin Result:=Length(string(Item1^))-Length(string(Item2^)); end; {Arrays of strings and integers} var IA: array [0..9] of integer = (23, 14, 62, 28, 56, 91, 33, 30, 75, 5); var SA: array [0..15] of string = ('Now','is','the','time','for','all','good','men','to','come','to','the','aid','of','the','party.'); procedure ShowQuickSort(Memo: TMemo); var L: TStringList; var PA: TPointerArray; var I: integer; begin Memo.Lines.Add('Integer Sort'); SetLength(PA,Length(IA)); for I:=0 to High(IA) do PA[I]:=Pointer(IA[I]); Memo.Lines.Add('Before Sorting'); DisplayIntegers(Memo,PA); QuickSort(PA,0,High(PA),IntCompare); Memo.Lines.Add('After Sorting'); DisplayIntegers(Memo,PA); Memo.Lines.Add(''); Memo.Lines.Add('String Sort - Alphabetical'); SetLength(PA,Length(SA)); for I:=0 to High(SA) do PA[I]:=Pointer(@SA[I]); Memo.Lines.Add('Before Sorting'); DisplayStrings(Memo,PA); QuickSort(PA,0,High(PA),StringCompare); Memo.Lines.Add('After Sorting'); DisplayStrings(Memo,PA); Memo.Lines.Add(''); Memo.Lines.Add('String Sort - Reverse Alphabetical'); QuickSort(PA,0,High(PA),StringRevCompare); Memo.Lines.Add('After Sorting'); DisplayStrings(Memo,PA); Memo.Lines.Add(''); Memo.Lines.Add('String Sort - By Length'); QuickSort(PA,0,High(PA),StringLenCompare); Memo.Lines.Add('After Sorting'); DisplayStrings(Memo,PA); end;
Integer Sort Before Sorting [23 14 62 28 56 91 33 30 75 5] After Sorting [5 14 23 28 30 33 56 62 75 91] String Sort - Alphabetical Before Sorting [Now is the time for all good men to come to the aid of the party.] After Sorting [aid all come for good is men Now party. of the the the time to to] String Sort - Reverse Alphabetical After Sorting [to to time the the the party. of Now men is good for come all aid] String Sort - By Length After Sorting [of is to to men aid all for Now the the the time come good party.] Elapsed Time: 16.478 ms.Dart
quickSort(List a) { if (a.length <= 1) { return a; } var pivot = a[0]; var less = []; var more = []; var pivotList = []; // Partition a.forEach((var i){ if (i.compareTo(pivot) < 0) { less.add(i); } else if (i.compareTo(pivot) > 0) { more.add(i); } else { pivotList.add(i); } }); // Recursively sort sublists less = quickSort(less); more = quickSort(more); // Concatenate results less.addAll(pivotList); less.addAll(more); return less; } void main() { var arr=[1,5,2,7,3,9,4,6,8]; print("Before sort"); arr.forEach((var i)=>print("$i")); arr = quickSort(arr); print("After sort"); arr.forEach((var i)=>print("$i")); }E
def quicksort := { def swap(container, ixA, ixB) { def temp := container[ixA] container[ixA] := container[ixB] container[ixB] := temp } def partition(array, var first :int, var last :int) { if (last <= first) { return } # Choose a pivot def pivot := array[def pivotIndex := (first + last) // 2] # Move pivot to end temporarily swap(array, pivotIndex, last) var swapWith := first # Scan array except for pivot, and... for i in first..!last { if (array[i] <= pivot) { # items ≤ the pivot swap(array, i, swapWith) # are moved to consecutive positions on the left swapWith += 1 } } # Swap pivot into between-partition position. # Because of the swapping we know that everything before swapWith is less # than or equal to the pivot, and the item at swapWith (since it was not # swapped) is greater than the pivot, so inserting the pivot at swapWith # will preserve the partition. swap(array, swapWith, last) return swapWith } def quicksortR(array, first :int, last :int) { if (last <= first) { return } def pivot := partition(array, first, last) quicksortR(array, first, pivot - 1) quicksortR(array, pivot + 1, last) } def quicksort(array) { # returned from block quicksortR(array, 0, array.size() - 1) } }EasyLang
proc qsort left right &d[] . if left < right piv = d[left] mid = left for i = left + 1 to right if d[i] < piv mid += 1 swap d[i] d[mid] . . swap d[left] d[mid] qsort left mid - 1 d[] qsort mid + 1 right d[] . . proc sort &d[] . qsort 1 len d[] d[] . d[] = [ 29 4 72 44 55 26 27 77 92 5 ] sort d[] print d[]
[ 4 5 26 27 29 44 55 72 77 92 ]EchoLisp
(lib 'list) ;; list-partition (define compare 0) ;; counter (define (quicksort L compare-predicate: proc aux: (part null)) (if (<= (length L) 1) L (begin ;; counting the number of comparisons (set! compare (+ compare (length (rest L)))) ;; pivot = first element of list (set! part (list-partition (rest L) proc (first L))) (append (quicksort (first part) proc ) (list (first L)) (quicksort (second part) proc)))))
(shuffle (iota 15)) → (10 0 14 11 13 9 2 5 4 8 1 7 12 3 6) (quicksort (shuffle (iota 15)) <) → (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14) ;; random list of numbers in [0 .. n[ ;; count number of comparisons (define (qtest (n 10000)) (set! compare 0) (quicksort (shuffle (iota n)) >) (writeln 'n n 'compare# compare )) (qtest 1000) n 1000 compare# 12764 (qtest 10000) n 10000 compare# 277868 (qtest 100000) n 100000 compare# 6198601Eero
Translated from Objective-C example on this page.
#import <Foundation/Foundation.h> void quicksortInPlace(MutableArray array, const long first, const long last) if first >= last return Value pivot = array[(first + last) / 2] left := first right := last while left <= right while array[left] < pivot left++ while array[right] > pivot right-- if left <= right array.exchangeObjectAtIndex: left++, withObjectAtIndex: right-- quicksortInPlace(array, first, right) quicksortInPlace(array, left, last) Array quicksort(Array unsorted) a := [] a.addObjectsFromArray: unsorted quicksortInPlace(a, 0, a.count - 1) return a int main(int argc, const char * argv[]) autoreleasepool a := [1, 3, 5, 7, 9, 8, 6, 4, 2] Log( 'Unsorted: %@', a) Log( 'Sorted: %@', quicksort(a) ) b := ['Emil', 'Peg', 'Helen', 'Juergen', 'David', 'Rick', 'Barb', 'Mike', 'Tom'] Log( 'Unsorted: %@', b) Log( 'Sorted: %@', quicksort(b) ) return 0
Alternative implementation (not necessarily as efficient, but very readable)
#import <Foundation/Foundation.h> implementation Array (Quicksort) plus: Array array, return Array = self.arrayByAddingObjectsFromArray: array filter: BOOL (^)(id) predicate, return Array array := [] for id item in self if predicate(item) array.addObject: item return array.copy quicksort, return Array = self if self.count > 1 id x = self[self.count / 2] lesser := self.filter: (id y | return y < x) greater := self.filter: (id y | return y > x) return lesser.quicksort + [x] + greater.quicksort end int main() autoreleasepool a := [1, 3, 5, 7, 9, 8, 6, 4, 2] Log( 'Unsorted: %@', a) Log( 'Sorted: %@', a.quicksort ) b := ['Emil', 'Peg', 'Helen', 'Juergen', 'David', 'Rick', 'Barb', 'Mike', 'Tom'] Log( 'Unsorted: %@', b) Log( 'Sorted: %@', b.quicksort ) return 0
2013-09-04 16:54:31.780 a.out[2201:507] Unsorted: ( 1, 3, 5, 7, 9, 8, 6, 4, 2 ) 2013-09-04 16:54:31.781 a.out[2201:507] Sorted: ( 1, 2, 3, 4, 5, 6, 7, 8, 9 ) 2013-09-04 16:54:31.781 a.out[2201:507] Unsorted: ( Emil, Peg, Helen, Juergen, David, Rick, Barb, Mike, Tom ) 2013-09-04 16:54:31.782 a.out[2201:507] Sorted: ( Barb, David, Emil, Helen, Juergen, Mike, Peg, Rick, Tom )Eiffel
The
class:
class QUICKSORT [G -> COMPARABLE] create make feature {NONE} --Implementation is_sorted (list: ARRAY [G]): BOOLEAN require not_void: list /= Void local i: INTEGER do Result := True from i := list.lower + 1 invariant i >= list.lower + 1 and i <= list.upper + 1 until i > list.upper loop Result := Result and list [i - 1] <= list [i] i := i + 1 variant list.upper + 1 - i end end concatenate_array (a: ARRAY [G] b: ARRAY [G]): ARRAY [G] require not_void: a /= Void and b /= Void do create Result.make_from_array (a) across b as t loop Result.force (t.item, Result.upper + 1) end ensure same_size: a.count + b.count = Result.count end quicksort_array (list: ARRAY [G]): ARRAY [G] require not_void: list /= Void local less_a: ARRAY [G] equal_a: ARRAY [G] more_a: ARRAY [G] pivot: G do create less_a.make_empty create more_a.make_empty create equal_a.make_empty create Result.make_empty if list.count <= 1 then Result := list else pivot := list [list.lower] across list as li invariant less_a.count + equal_a.count + more_a.count <= list.count loop if li.item < pivot then less_a.force (li.item, less_a.upper + 1) elseif li.item = pivot then equal_a.force (li.item, equal_a.upper + 1) elseif li.item > pivot then more_a.force (li.item, more_a.upper + 1) end end Result := concatenate_array (Result, quicksort_array (less_a)) Result := concatenate_array (Result, equal_a) Result := concatenate_array (Result, quicksort_array (more_a)) end ensure same_size: list.count = Result.count sorted: is_sorted (Result) end feature -- Initialization make do end quicksort (a: ARRAY [G]): ARRAY [G] do Result := quicksort_array (a) end end
A test application:
class APPLICATION create make feature {NONE} -- Initialization make -- Run application. local test: ARRAY [INTEGER] sorted: ARRAY [INTEGER] sorter: QUICKSORT [INTEGER] do create sorter.make test := <<1, 3, 2, 4, 5, 5, 7, -1>> sorted := sorter.quicksort (test) across sorted as s loop print (s.item) print (" ") end print ("%N") end endElena
ELENA 6.x :
import extensions; import system'routines; import system'collections; extension op { quickSort() { if (self.isEmpty()) { ^ self }; var pivot := self[0]; auto less := new ArrayList(); auto pivotList := new ArrayList(); auto more := new ArrayList(); self.forEach::(item) { if (item < pivot) { less.append(item) } else if (item > pivot) { more.append(item) } else { pivotList.append(item) } }; less := less.quickSort(); more := more.quickSort(); less.appendRange(pivotList); less.appendRange(more); ^ less } } public program() { var list := new int[]{3, 14, 1, 5, 9, 2, 6, 3}; console.printLine("before:", list.asEnumerable()); console.printLine("after :", list.quickSort().asEnumerable()); }
before:3,14,1,5,9,2,6,3 after :1,2,3,3,5,6,9,14Elixir
defmodule Sort do def qsort([]), do: [] def qsort([h | t]) do {lesser, greater} = Enum.split_with(t, &(&1 < h)) qsort(lesser) ++ [h] ++ qsort(greater) end endErlang
like haskell. Used by Measure_relative_performance_of_sorting_algorithms_implementations. If changed keep the interface or change Measure_relative_performance_of_sorting_algorithms_implementations
-module( quicksort ). -export( [qsort/1] ). qsort([]) -> []; qsort([X|Xs]) -> qsort([ Y || Y <- Xs, Y < X]) ++ [X] ++ qsort([ Y || Y <- Xs, Y >= X]).
multi-process implementation (number processes = number of processor cores):
quick_sort(L) -> qs(L, trunc(math:log2(erlang:system_info(schedulers)))). qs([],_) -> []; qs([H|T], N) when N > 0 -> {Parent, Ref} = {self(), make_ref()}, spawn(fun()-> Parent ! {l1, Ref, qs([E||E<-T, E<H], N-1)} end), spawn(fun()-> Parent ! {l2, Ref, qs([E||E<-T, H =< E], N-1)} end), {L1, L2} = receive_results(Ref, undefined, undefined), L1 ++ [H] ++ L2; qs([H|T],_) -> qs([E||E<-T, E<H],0) ++ [H] ++ qs([E||E<-T, H =< E],0). receive_results(Ref, L1, L2) -> receive {l1, Ref, L1R} when L2 == undefined -> receive_results(Ref, L1R, L2); {l2, Ref, L2R} when L1 == undefined -> receive_results(Ref, L1, L2R); {l1, Ref, L1R} -> {L1R, L2}; {l2, Ref, L2R} -> {L1, L2R} after 5000 -> receive_results(Ref, L1, L2) end.Emacs Lisp
Unoptimized
(require 'seq) (defun quicksort (xs) (if (null xs) () (let* ((head (car xs)) (tail (cdr xs)) (lower-part (quicksort (seq-filter (lambda (x) (<= x head)) tail))) (higher-part (quicksort (seq-filter (lambda (x) (> x head)) tail)))) (append lower-part (list head) higher-part))))ERRE
PROGRAM QUICKSORT_DEMO DIM ARRAY[21] !$DYNAMIC DIM QSTACK[0] !$INCLUDE="PC.LIB" PROCEDURE QSORT(ARRAY[],START,NUM) FIRST=START ! initialize work variables LAST=START+NUM-1 LOOP REPEAT TEMP=ARRAY[(LAST+FIRST) DIV 2] ! seek midpoint I=FIRST J=LAST REPEAT ! reverse both < and > below to sort descending WHILE ARRAY[I]<TEMP DO I=I+1 END WHILE WHILE ARRAY[J]>TEMP DO J=J-1 END WHILE EXIT IF I>J IF I<J THEN SWAP(ARRAY[I],ARRAY[J]) END IF I=I+1 J=J-1 UNTIL NOT(I<=J) IF I<LAST THEN ! Done QSTACK[SP]=I ! Push I QSTACK[SP+1]=LAST ! Push Last SP=SP+2 END IF LAST=J UNTIL NOT(FIRST<LAST) EXIT IF SP=0 SP=SP-2 FIRST=QSTACK[SP] ! Pop First LAST=QSTACK[SP+1] ! Pop Last END LOOP END PROCEDURE BEGIN RANDOMIZE(TIMER) ! generate a new series each run ! create an array FOR X=1 TO 21 DO ! fill with random numbers ARRAY[X]=RND(1)*500 ! between 0 and 500 END FOR PRIMO=6 ! sort starting here NUM=10 ! sort this many elements CLS PRINT("Before Sorting:";TAB(31);"After sorting:") PRINT("===============";TAB(31);"==============") FOR X=1 TO 21 DO ! show them before sorting IF X>=PRIMO AND X<=PRIMO+NUM-1 THEN PRINT("==>";) END IF PRINT(TAB(5);) WRITE("###.##";ARRAY[X]) END FOR ! create a stack !$DIM QSTACK[INT(NUM/5)+10] QSORT(ARRAY[],PRIMO,NUM) !$ERASE QSTACK LOCATE(2,1) FOR X=1 TO 21 DO ! print them after sorting LOCATE(2+X,30) IF X>=PRIMO AND X<=PRIMO+NUM-1 THEN PRINT("==>";) ! point to sorted items END IF LOCATE(2+X,35) WRITE("###.##";ARRAY[X]) END FOR END PROGRAMF#
let rec qsort = function hd :: tl -> let less, greater = List.partition ((>=) hd) tl List.concat [qsort less; [hd]; qsort greater] | _ -> []Factor
: qsort ( seq -- seq ) dup empty? [ unclip [ [ < ] curry partition [ qsort ] bi@ ] keep prefix append ] unless ;Fe
; utility for list joining (= join (fn (a b) (if (is a nil) b (is b nil) a (do (let res a) (while (cdr a) (= a (cdr a))) (setcdr a b) res)))) (= quicksort (fn (lst) (if (not (cdr lst)) lst (do (let pivot (car lst)) (let less nil) (let equal nil) (let greater nil) ; filter list for less than pivot, equal to pivot and greater than pivot (while lst (let x (car lst)) (if (< x pivot) (= less (cons x less)) (< pivot x) (= greater (cons x greater)) (= equal (cons x equal))) (= lst (cdr lst))) ; sort 'less' and 'greater' partitions ('equal' partition is always sorted) (= less (quicksort less)) (= greater (quicksort greater)) ; join partitions to one (join less (join equal greater)))))) (print '(4 65 0 2 -31 99 2 0 83 782 1)) (print (quicksort '(4 65 0 2 -31 99 2 0 83 782 1)))
Outputs:
(4 65 0 2 -31 99 2 0 83 782 1) (-31 0 0 1 2 2 4 65 83 99 782)Fexl
# (sort xs) is the ordered list of all elements in list xs. # This version preserves duplicates. \sort== (\xs xs [] \x\xs append (sort; filter (gt x) xs); # all the items less than x cons x; append (filter (eq x) xs); # all the items equal to x sort; filter (lt x) xs # all the items greater than x ) # (unique xs) is the ordered list of unique elements in list xs. \unique== (\xs xs [] \x\xs append (unique; filter (gt x) xs); # all the items less than x cons x; # x itself unique; filter (lt x) xs # all the items greater than x )Forth
: mid ( l r -- mid ) over - 2/ -cell and + ; : exch ( addr1 addr2 -- ) dup @ >r over @ swap ! r> swap ! ; : partition ( l r -- l r r2 l2 ) 2dup mid @ >r ( r: pivot ) 2dup begin swap begin dup @ r@ < while cell+ repeat swap begin r@ over @ < while cell- repeat 2dup <= if 2dup exch >r cell+ r> cell- then 2dup > until r> drop ; : qsort ( l r -- ) partition swap rot \ 2over 2over - + < if 2swap then 2dup < if recurse else 2drop then 2dup < if recurse else 2drop then ; : sort ( array len -- ) dup 2 < if 2drop exit then 1- cells over + qsort ;Fortran
recursive subroutine fsort(a) use inserts, only:insertion_sort !Not included in this posting implicit none ! ! PARAMETER definitions ! integer, parameter :: changesize = 64 ! ! Dummy arguments ! real, dimension(:) ,contiguous :: a intent (inout) a ! ! Local variables ! integer :: first = 1 integer :: i integer :: j integer :: last logical :: stay real :: t real :: x ! !*Code ! last = size(a, 1) if( (last - first)<changesize )then call insertion_sort(a(first:last)) return end if j = shiftr((first + last), 1) + 1 ! x = a(j) i = first j = last stay = .true. do while ( stay ) do while ( a(i)<x ) i = i + 1 end do do while ( x<a(j) ) j = j - 1 end do if( j<i )then stay = .false. else t = a(i) ! Swap the values a(i) = a(j) a(j) = t i = i + 1 ! Adjust the pointers (PIVOT POINTS) j = j - 1 end if end do if( first<i - 1 )call fsort(a(first:i - 1)) ! We still have some left to do on the lower if( j + 1<last )call fsort(a(j + 1:last)) ! We still have some left to do on the upper return end subroutine fsortFunL
def qsort( [] ) = [] qsort( p:xs ) = qsort( xs.filter((< p)) ) + [p] + qsort( xs.filter((>= p)) )
Here is a more efficient version using the partition
function.
def qsort( [] ) = [] qsort( x:xs ) = val (ys, zs) = xs.partition( (< x) ) qsort( ys ) + (x : qsort( zs )) println( qsort([4, 2, 1, 3, 0, 2]) ) println( qsort(["Juan", "Daniel", "Miguel", "William", "Liam", "Ethan", "Jacob"]) )
[0, 1, 2, 2, 3, 4] [Daniel, Ethan, Jacob, Juan, Liam, Miguel, William]Go
Note that Go's sort.Sort
function is a Quicksort so in practice it would be just be used. It's actually a combination of quick sort, heap sort, and insertion sort. It starts with a quick sort, after a depth of 2*ceil(lg(n+1)) it switches to heap sort, or once a partition becomes small (less than eight items) it switches to insertion sort.
Old school, following Hoare's 1962 paper.
As a nod to the task request to work for all types with weak strict ordering, code below uses the < operator when comparing key values. The three points are noted in the code below.
Actually supporting arbitrary types would then require at a minimum a user supplied less-than function, and values referenced from an array of interface{} types. More efficient and flexible though is the sort interface of the Go sort package. Replicating that here seemed beyond the scope of the task so code was left written to sort an array of ints.
Go has no language support for indexing with discrete types other than integer types, so this was not coded.
Finally, the choice of a recursive closure over passing slices to a recursive function is really just a very small optimization. Slices are cheap because they do not copy the underlying array, but there's still a tiny bit of overhead in constructing the slice object. Passing just the two numbers is in the interest of avoiding that overhead.
package main import "fmt" func main() { list := []int{31, 41, 59, 26, 53, 58, 97, 93, 23, 84} fmt.Println("unsorted:", list) quicksort(list) fmt.Println("sorted! ", list) } func quicksort(a []int) { var pex func(int, int) pex = func(lower, upper int) { for { switch upper - lower { case -1, 0: // 0 or 1 item in segment. nothing to do here! return case 1: // 2 items in segment // < operator respects strict weak order if a[upper] < a[lower] { // a quick exchange and we're done. a[upper], a[lower] = a[lower], a[upper] } return // Hoare suggests optimized sort-3 or sort-4 algorithms here, // but does not provide an algorithm. } // Hoare stresses picking a bound in a way to avoid worst case // behavior, but offers no suggestions other than picking a // random element. A function call to get a random number is // relatively expensive, so the method used here is to simply // choose the middle element. This at least avoids worst case // behavior for the obvious common case of an already sorted list. bx := (upper + lower) / 2 b := a[bx] // b = Hoare's "bound" (aka "pivot") lp := lower // lp = Hoare's "lower pointer" up := upper // up = Hoare's "upper pointer" outer: for { // use < operator to respect strict weak order for lp < upper && !(b < a[lp]) { lp++ } for { if lp > up { // "pointers crossed!" break outer } // < operator for strict weak order if a[up] < b { break // inner } up-- } // exchange a[lp], a[up] = a[up], a[lp] lp++ up-- } // segment boundary is between up and lp, but lp-up might be // 1 or 2, so just call segment boundary between lp-1 and lp. if bx < lp { // bound was in lower segment if bx < lp-1 { // exchange bx with lp-1 a[bx], a[lp-1] = a[lp-1], b } up = lp - 2 } else { // bound was in upper segment if bx > lp { // exchange a[bx], a[lp] = a[lp], b } up = lp - 1 lp++ } // "postpone the larger of the two segments" = recurse on // the smaller segment, then iterate on the remaining one. if up-lower < upper-lp { pex(lower, up) lower = lp } else { pex(lp, upper) upper = up } } } pex(0, len(a)-1) }
unsorted: [31 41 59 26 53 58 97 93 23 84] sorted! [23 26 31 41 53 58 59 84 93 97]
More traditional version of quicksort. It work generically with any container that conforms to sort.Interface
.
package main import ( "fmt" "sort" "math/rand" ) func partition(a sort.Interface, first int, last int, pivotIndex int) int { a.Swap(first, pivotIndex) // move it to beginning left := first+1 right := last for left <= right { for left <= last && a.Less(left, first) { left++ } for right >= first && a.Less(first, right) { right-- } if left <= right { a.Swap(left, right) left++ right-- } } a.Swap(first, right) // swap into right place return right } func quicksortHelper(a sort.Interface, first int, last int) { if first >= last { return } pivotIndex := partition(a, first, last, rand.Intn(last - first + 1) + first) quicksortHelper(a, first, pivotIndex-1) quicksortHelper(a, pivotIndex+1, last) } func quicksort(a sort.Interface) { quicksortHelper(a, 0, a.Len()-1) } func main() { a := []int{1, 3, 5, 7, 9, 8, 6, 4, 2} fmt.Printf("Unsorted: %v\n", a) quicksort(sort.IntSlice(a)) fmt.Printf("Sorted: %v\n", a) b := []string{"Emil", "Peg", "Helen", "Juergen", "David", "Rick", "Barb", "Mike", "Tom"} fmt.Printf("Unsorted: %v\n", b) quicksort(sort.StringSlice(b)) fmt.Printf("Sorted: %v\n", b) }
Unsorted: [1 3 5 7 9 8 6 4 2] Sorted: [1 2 3 4 5 6 7 8 9] Unsorted: [Emil Peg Helen Juergen David Rick Barb Mike Tom] Sorted: [Barb David Emil Helen Juergen Mike Peg Rick Tom]Golfscript
{.,0>{(\.{2$<!},qs\{2$<},qs@+\+}*}:qs; [4 65 0 2 -31 99 2 0 83 782 1] $ p [4 65 0 2 -31 99 2 0 83 782 1] qs p
[-31 0 0 1 2 2 4 65 83 99 782] [-31 0 0 1 2 2 4 65 83 99 782]Haskell
The famous two-liner, reflecting the underlying algorithm directly:
qsort [] = [] qsort (x:xs) = qsort [y | y <- xs, y < x] ++ [x] ++ qsort [y | y <- xs, y >= x]
A more efficient version, doing only one comparison per element:
import Data.List (partition) qsort :: Ord a => [a] -> [a] qsort [] = [] qsort (x:xs) = qsort ys ++ [x] ++ qsort zs where (ys, zs) = partition (< x) xsIcon and Unicon
procedure main() #: demonstrate various ways to sort a list and string demosort(quicksort,[3, 14, 1, 5, 9, 2, 6, 3],"qwerty") end procedure quicksort(X,op,lower,upper) #: return sorted list local pivot,x if /lower := 1 then { # top level call setup upper := *X op := sortop(op,X) # select how and what we sort } if upper - lower > 0 then { every x := quickpartition(X,op,lower,upper) do # find a pivot and sort ... /pivot | X := x # ... how to return 2 values w/o a structure X := quicksort(X,op,lower,pivot-1) # ... left X := quicksort(X,op,pivot,upper) # ... right } return X end procedure quickpartition(X,op,lower,upper) #: quicksort partitioner helper local pivot static pivotL initial pivotL := list(3) pivotL[1] := X[lower] # endpoints pivotL[2] := X[upper] # ... and pivotL[3] := X[lower+?(upper-lower)] # ... random midpoint if op(pivotL[2],pivotL[1]) then pivotL[2] :=: pivotL[1] # mini- if op(pivotL[3],pivotL[2]) then pivotL[3] :=: pivotL[2] # ... sort pivot := pivotL[2] # median is pivot lower -:= 1 upper +:= 1 while lower < upper do { # find values on wrong side of pivot ... while op(pivot,X[upper -:= 1]) # ... rightmost while op(X[lower +:=1],pivot) # ... leftmost if lower < upper then # not crossed yet X[lower] :=: X[upper] # ... swap } suspend lower # 1st return pivot point suspend X # 2nd return modified X (in case immutable) end
Implementation notes:
Algorithm notes:
Note: This example relies on the supporting procedures 'sortop', and 'demosort' in Bubble Sort. The full demosort exercises the named sort of a list with op = "numeric", "string", ">>" (lexically gt, descending),">" (numerically gt, descending), a custom comparator, and also a string.
Abbreviated
Sorting Demo using procedure quicksort on list : [ 3 14 1 5 9 2 6 3 ] with op = &null: [ 1 2 3 3 5 6 9 14 ] (0 ms) ... on string : "qwerty" with op = &null: "eqrtwy" (0 ms)IDL
IDL has a powerful optimized sort() built-in. The following is thus merely for demonstration.
function qs, arr if (count = n_elements(arr)) lt 2 then return,arr pivot = total(arr) / count ; use the average for want of a better choice return,[qs(arr[where(arr le pivot)]),qs(arr[where(arr gt pivot)])] end
Example:
IDL> print,qs([3,17,-5,12,99]) -5 3 12 17 99Idris
quicksort : Ord elem => List elem -> List elem quicksort [] = [] quicksort (x :: xs) = let lesser = filter (< x) xs greater = filter(>= x) xs in (quicksort lesser) ++ [x] ++ (quicksort greater)
Example:
*quicksort> quicksort [1, 3, 7, 2, 5, 4, 9, 6, 8, 0] [0, 1, 2, 3, 4, 5, 6, 7, 8, 9] : List IntegerIo
List do( quickSort := method( if(size > 1) then( pivot := at(size / 2 floor) return select(x, x < pivot) quickSort appendSeq( select(x, x == pivot) appendSeq(select(x, x > pivot) quickSort) ) ) else(return self) ) quickSortInPlace := method( copy(quickSort) ) ) lst := list(5, -1, -4, 2, 9) lst quickSort println # ==> list(-4, -1, 2, 5, 9) lst quickSortInPlace println # ==> list(-4, -1, 2, 5, 9)
Another more low-level Quicksort implementation can be found in Io's [github ] repository.
Isabelletheory Quicksort imports Main begin fun quicksort :: "('a :: linorder) list ⇒ 'a list" where "quicksort [] = []" | "quicksort (x#xs) = (quicksort [y←xs. y<x]) @ [x] @ (quicksort [y←xs. y>x])" lemma "quicksort [4::int, 2, 7, 1] = [1, 2, 4, 7]" by(code_simp) lemma set_first_second_partition: fixes x :: "'a :: linorder" shows "{y ∈ ys. y < x} ∪ {x} ∪ {y ∈ ys. x < y} = insert x ys" by fastforce lemma set_quicksort: "set (quicksort xs) = set xs" by(induction xs rule: quicksort.induct) (simp add: set_first_second_partition[simplified])+ theorem "sorted (quicksort xs)" proof(induction xs rule: quicksort.induct) case 1 show "sorted (quicksort [])" by simp next case (2 x xs) assume IH_less: "sorted (quicksort [y←xs. y<x])" assume IH_greater: "sorted (quicksort [y←xs. y>x])" have pivot_geq_first_partition: "∀z∈set (quicksort [y←xs. y<x]). z ≤ x" by (simp add: set_quicksort less_imp_le) have pivot_leq_second_partition: "∀z ∈ (set (quicksort [y←xs. y>x])). (x ≤ z)" by (simp add: set_quicksort less_imp_le) have first_partition_leq_second_partition: "∀p∈set (quicksort [y←xs. y<x]). ∀z ∈ (set (quicksort [y←xs. y>x])). (p ≤ z)" by (auto simp add: set_quicksort) from IH_less IH_greater pivot_geq_first_partition pivot_leq_second_partition first_partition_leq_second_partition show "sorted (quicksort (x # xs))" by(simp add: sorted_append) qed text‹ The specification on rosettacode says ▪ All elements less than the pivot must be in the first partition. ▪ All elements greater than the pivot must be in the second partition. Since this specification neither says "less than or equal" nor "greater or equal", this quicksort implementation removes duplicate elements. › lemma "quicksort [1::int, 1, 1, 2, 2, 3] = [1, 2, 3]" by(code_simp) text‹If we try the following, we automatically get a counterexample› lemma "length (quicksort xs) = length xs" (* Auto Quickcheck found a counterexample: xs = [a⇩1, a⇩1] Evaluated terms: length (quicksort xs) = 1 length xs = 2 *) oops endJ
Generally, this task should be accomplished in J using /:~
. Here we take an approach that's more comparable with the other examples on this page.
A two-partition tacit version with random pivot:
qsort=: (((<:#[) ,&$: (>#[)) (?@#{]))^:(1<#@~.)
Use:
1 2 4 4 5 6 7 8 9
A three-partition explicit version broken into smaller steps:
sel=: 1 : 'u # ]' quicksort=: 3 : 0 if. 1 >: #y do. y else. p=. y{~?#y (quicksort y <sel p),(y =sel p),quicksort y >sel p end. )
See the Quicksort essay in the J Wiki for additional explanations and examples.
Java Imperativepublic static <E extends Comparable<? super E>> List<E> quickSort(List<E> arr) { if (arr.isEmpty()) return arr; else { E pivot = arr.get(0); List<E> less = new LinkedList<E>(); List<E> pivotList = new LinkedList<E>(); List<E> more = new LinkedList<E>(); // Partition for (E i: arr) { if (i.compareTo(pivot) < 0) less.add(i); else if (i.compareTo(pivot) > 0) more.add(i); else pivotList.add(i); } // Recursively sort sublists less = quickSort(less); more = quickSort(more); // Concatenate results less.addAll(pivotList); less.addAll(more); return less; } }Functional
public static <E extends Comparable<E>> List<E> sort(List<E> col) { if (col == null || col.isEmpty()) return Collections.emptyList(); else { E pivot = col.get(0); Map<Integer, List<E>> grouped = col.stream() .collect(Collectors.groupingBy(pivot::compareTo)); return Stream.of(sort(grouped.get(1)), grouped.get(0), sort(grouped.get(-1))) .flatMap(Collection::stream).collect(Collectors.toList()); } }JavaScript Imperative
function sort(array, less) { function swap(i, j) { var t = array[i]; array[i] = array[j]; array[j] = t; } function quicksort(left, right) { if (left < right) { var pivot = array[left + Math.floor((right - left) / 2)], left_new = left, right_new = right; do { while (less(array[left_new], pivot)) { left_new += 1; } while (less(pivot, array[right_new])) { right_new -= 1; } if (left_new <= right_new) { swap(left_new, right_new); left_new += 1; right_new -= 1; } } while (left_new <= right_new); quicksort(left, right_new); quicksort(left_new, right); } } quicksort(0, array.length - 1); return array; }
Example:
var test_array = [10, 3, 11, 15, 19, 1]; var sorted_array = sort(test_array, function(a,b) { return a<b; });Functional ES6
Using destructuring and satisfying immutability we can propose a single expresion solution (from https://github.com/ddcovery/expressive_sort)
const qsort = ([pivot, ...others]) => pivot === void 0 ? [] : [ ...qsort(others.filter(n => n < pivot)), pivot, ...qsort(others.filter(n => n >= pivot)) ]; qsort( [ 11.8, 14.1, 21.3, 8.5, 16.7, 5.7 ] )
[ 5.7, 8.5, 11.8, 14.1, 16.7, 21.3 ]ES5
Unlike what happens with ES6, there are no destructuring nor lambdas, but we can ensure immutability and propose a single expression solution with standard anonymous functions
function qsort( xs ){ return xs.length === 0 ? [] : [].concat( qsort( xs.slice(1).filter(function(x){ return x< xs[0] })), xs[0], qsort( xs.slice(1).filter(function(x){ return x>= xs[0] })) ) } qsort( [ 11.8, 14.1, 21.3, 8.5, 16.7, 5.7 ] )
[5.7, 8.5, 11.8, 14.1, 16.7, 21.3]Joy
DEFINE qsort == [small] # termination condition: 0 or 1 element [] # do nothing [uncons [>] split] # pivot and two lists [enconcat] # insert the pivot after the recursion binrec. # recursion on the two listsjq
jq's built-in sort currently (version 1.4) uses the standard C qsort, a quicksort. sort can be used on any valid JSON array.
Example:
[1, 1.1, [1,2], true, false, null, {"a":1}, null] | sort
[null,null,false,true,1,1.1,[1,2],{"a":1}]
Here is an implementation in jq of the pseudo-code (and comments :-) given at the head of this article:
def quicksort: if length < 2 then . # it is already sorted else .[0] as $pivot | reduce .[] as $x # state: [less, equal, greater] ( [ [], [], [] ]; # three empty arrays: if $x < $pivot then .[0] += [$x] # add x to less elif $x == $pivot then .[1] += [$x] # add x to equal else .[2] += [$x] # add x to greater end ) | (.[0] | quicksort ) + .[1] + (.[2] | quicksort ) end ;
Fortunately, the example input used above produces the same output,
and so both are omitted here.
JuliaBuilt-in function for in-place sorting via quicksort (the code from the standard library is quite readable):
A simple polymorphic implementation of an in-place recursive quicksort (based on the pseudocode above):
function quicksort!(A,i=1,j=length(A)) if j > i pivot = A[rand(i:j)] # random element of A left, right = i, j while left <= right while A[left] < pivot left += 1 end while A[right] > pivot right -= 1 end if left <= right A[left], A[right] = A[right], A[left] left += 1 right -= 1 end end quicksort!(A,i,right) quicksort!(A,left,j) end return A end
A one-line (but rather inefficient) implementation based on the Haskell version, which operates out-of-place and allocates temporary arrays:
qsort(L) = isempty(L) ? L : vcat(qsort(filter(x -> x < L[1], L[2:end])), L[1:1], qsort(filter(x -> x >= L[1], L[2:end])))
julia> A = [84,77,20,60,47,20,18,97,41,49,31,39,73,68,65,52,1,92,15,9] julia> qsort(A) [1,9,15,18,20,20,31,39,41,47,49,52,60,65,68,73,77,84,92,97] julia> quicksort!(copy(A)) [1,9,15,18,20,20,31,39,41,47,49,52,60,65,68,73,77,84,92,97] julia> qsort(A) == quicksort!(copy(A)) == sort(A) == sort(A, alg=QuickSort) trueK Bi-partition
qsort:{$[2>#?x;x;,/o'x@&'~:\x<*1?x]}
This version partitions the array into [elements greater than or equal to the pivot], and [those less than the pivot], stopping recursion when the subarray contains only one unique element.
The $[...]
works as $[if;then;else]
.
x<*1?x
selects a random pivot and gives a logical mask (vector of 0’s and 1’s) where a 1 at index n indicates that the element at n is less than the pivot.
f\
successively applies f until the result converges (i.e., yields a result from a prior iteration), and collects the intermediate results (including the initial argument). Since f is negation here, this happens after one iteration. Each mask is coupled with its negation, e.g., ~:\0 1 1
produces (0 1 1;1 0 0)
.
x@&'
converts each logical mask into corresponding indices, and uses them to index into array x, yielding the two partitions.
Finally, ,/o'
recurses on each partition and joins the results.
A 3-partition version (faster if many elements are equal):
quicksort:{p:*x[1?#x];:[0=#x;x;,/(_f x[&x<p];x[&x=p];_f x[&x>p])]}
Example:
quicksort 1 3 5 7 9 8 6 4 2
1 2 3 4 5 6 7 8 9
Explanation:
is the current function called recursively.
generally means :[condition1;then1;condition2;then2;....;else]. Here it is used as :[if;then;else].
This construct
assigns a random element in x (the argument) to p, as the pivot value.
And here is the full if/then/else clause:
:[ 0=#x; / if length of x is zero x; / then return x / else ,/( / join the results of: _f x[&x<p] / sort (recursively) elements less than pivot p x[&x=p] / elements equal to p _f x[&x>p]) / sort (recursively) elements greater than p ]
Note that - as with APL and J - for larger arrays it's much faster to sort using "<" (grade up) which gives the indices of the list sorted ascending, i.e.
t@<t:1 3 5 7 9 8 6 4 2 1 2 3 4 5 6 7 8 9Koka
Haskell-like solution
fun qsort( xs : list<int> ) : div list<int> { match(xs) { Cons(x,xx) -> { val ys = xx.filter fn(el) { el < x } val zs = xx.filter fn(el) { el >= x } qsort(ys) ++ [x] ++ qsort(zs) } Nil -> Nil } }
or using standard partition
function
fun qsort( xs : list<int> ) : div list<int> { match(xs) { Cons(x,xx) -> { val (ys, zs) = xx.partition fn(el) { el < x } qsort(ys) ++ [x] ++ qsort(zs) } Nil -> Nil } }
Example:
fun main() { val arr = [24,63,77,26,84,64,56,80,85,17] println(arr.qsort.show) }
[17,24,26,56,63,64,77,80,84,85]Kotlin
A version that reflects the algorithm directly:
fun <E : Comparable<E>> List<E>.qsort(): List<E> = if (size < 2) this else filter { it < first() }.qsort() + filter { it == first() } + filter { it > first() }.qsort()
A more efficient version that does only one comparison per element:
fun <E : Comparable<E>> List<E>.qsort(): List<E> = if (size < 2) this else { val (less, high) = subList(1, size).partition { it < first() } less.qsort() + first() + high.qsort() }Lambdatalk
We create a binary tree from a random array, then we walk the canopy. 1) three functions for readability: {def BT.data {lambda {:t} {A.get 0 :t}}} -> BT.data {def BT.left {lambda {:t} {A.get 1 :t}}} -> BT.left {def BT.right {lambda {:t} {A.get 2 :t}}} -> BT.right 2) adding a leaf to the tree: {def BT.add {lambda {:x :t} {if {A.empty? :t} then {A.new :x {A.new} {A.new}} else {if {= :x {BT.data :t}} then :t else {if {< :x {BT.data :t}} then {A.new {BT.data :t} {BT.add :x {BT.left :t}} {BT.right :t}} else {A.new {BT.data :t} {BT.left :t} {BT.add :x {BT.right :t}} }}}}}} -> BT.add 3) creating the tree from an array of numbers: {def BT.create {def BT.create.rec {lambda {:l :t} {if {A.empty? :l} then :t else {BT.create.rec {A.rest :l} {BT.add {A.first :l} :t}} }}} {lambda {:l} {BT.create.rec :l {A.new}} }} -> BT.create 4) walking the canopy -> sorting in increasing order: {def BT.sort {lambda {:t} {if {A.empty? :t} then else {BT.sort {BT.left :t}} {BT.data :t} {BT.sort {BT.right :t}} }}} -> BT.sort Testing 1) generating random numbers: {def L {A.new {S.map {lambda {:n} {floor {* {random} 100000}}} {S.serie 1 100}}}} -> L = [1850,7963,50540,92667,72892,47361,19018,40640,10126,80235,48407,51623,63597,71675,27814,63478,18985,88032,46585,85209, 74053,95005,27592,9575,22162,35904,70467,38527,89715,36594,54309,39950,89345,72224,7772,65756,68766,43942,52422,85144, 66010,38961,21647,53194,72166,33545,49037,23218,27969,83566,19382,53120,55291,77374,27502,66648,99637,37322,9815,432,90565, 37831,26503,99232,87024,65625,75155,55382,30120,58117,70031,13011,81375,10490,39786,1926,71311,4213,55183,2583,22075,90411, 92928,61120,94259,433,93332,88423,64119,40850,94318,27816,84818,90632,5094,36696,94705,50602,45818,61365] 2) creating the tree is the main work: {def T {BT.create {L}}} -> T = [1850,[432,],[433,],]]],[7963,[7772,[1926,],[4213,[2583,],]],[5094,],]]]],]],[50540,[47361,[19018,[10126,[9575,], [9815,],]]],[18985,[13011,[10490,],]],]],]]],[40640,[27814,[27592,[22162,[21647,[19382,],]],[22075,],]]],[23218,], [27502,[26503,],]],]]]],]],[35904,[33545,[27969,[27816,],]],[30120,],]]],]],[38527,[36594,],[37322,[36696,],]],[37831,],]]]], [39950,[38961,],[39786,],]]],]]]]],[46585,[43942,[40850,],]],[45818,],]]],]]]],[48407,],[49037,],]]]],[92667,[72892, [51623,[50602,],]],[63597,[63478,[54309,[52422,],[53194,[53120,],]],]]],[55291,[55183,],]],[55382,],[58117,],[61120,],[61365,],]]]]]]],]],[71675,[70467,[65756,[65625,[64119,],]],]],[68766,[66010,],[66648,],]]],[70031,],]]]],[71311,],]]], [72224,[72166,],]],]]]]],[80235,[74053,],[77374,[75155,],]],]]],[88032,[85209,[85144,[83566,[81375,],]],[84818,],]]],]], [87024,],]]],[89715,[89345,[88423,],]],]],[90565,[90411,],]],[90632,],]]]]]]],[95005,[92928,],[94259,[93332,],]],[94318,], [94705,],]]]]],[99637,[99232,],]],]]]]]]] 3) walking the canopy is fast: {BT.sort {T}} -> 432 433 1850 1926 2583 4213 5094 7772 7963 9575 9815 10126 10490 13011 18985 19018 19382 21647 22075 22162 23218 26503 27502 27592 27814 27816 27969 30120 33545 35904 36594 36696 37322 37831 38527 38961 39786 39950 40640 40850 43942 45818 46585 47361 48407 49037 50540 50602 51623 52422 53120 53194 54309 55183 55291 55382 58117 61120 61365 63478 63597 64119 65625 65756 66010 66648 68766 70031 70467 71311 71675 72166 72224 72892 74053 75155 77374 80235 81375 83566 84818 85144 85209 87024 88032 88423 89345 89715 90411 90565 90632 92667 92928 93332 94259 94318 94705 95005 99232 99637 4) walking with new leaves is fast: {BT.sort {BT.add -1 {T}}} -> -1 432 433 1850 1926 2583 4213 5094 7772 7963 9575 9815 10126 10490 13011 18985 19018 19382 21647 22075 22162 23218 26503 27502 27592 27814 27816 27969 30120 33545 35904 36594 36696 37322 37831 38527 38961 39786 39950 40640 40850 43942 45818 46585 47361 48407 49037 50540 50602 51623 52422 53120 53194 54309 55183 55291 55382 58117 61120 61365 63478 63597 64119 65625 65756 66010 66648 68766 70031 70467 71311 71675 72166 72224 72892 74053 75155 77374 80235 81375 83566 84818 85144 85209 87024 88032 88423 89345 89715 90411 90565 90632 92667 92928 93332 94259 94318 94705 95005 99232 99637 {BT.sort {BT.add 50000 {T}}} -> 432 433 1850 1926 2583 4213 5094 7772 7963 9575 9815 10126 10490 13011 18985 19018 19382 21647 22075 22162 23218 26503 27502 27592 27814 27816 27969 30120 33545 35904 36594 36696 37322 37831 38527 38961 39786 39950 40640 40850 43942 45818 46585 47361 48407 49037 50000 50540 50602 51623 52422 53120 53194 54309 55183 55291 55382 58117 61120 61365 63478 63597 64119 65625 65756 66010 66648 68766 70031 70467 71311 71675 72166 72224 72892 74053 75155 77374 80235 81375 83566 84818 85144 85209 87024 88032 88423 89345 89715 90411 90565 90632 92667 92928 93332 94259 94318 94705 95005 99232 99637 {BT.sort {BT.add 100000 {T}}} -> 432 433 1850 1926 2583 4213 5094 7772 7963 9575 9815 10126 10490 13011 18985 19018 19382 21647 22075 22162 23218 26503 27502 27592 27814 27816 27969 30120 33545 35904 36594 36696 37322 37831 38527 38961 39786 39950 40640 40850 43942 45818 46585 47361 48407 49037 50540 50602 51623 52422 53120 53194 54309 55183 55291 55382 58117 61120 61365 63478 63597 64119 65625 65756 66010 66648 68766 70031 70467 71311 71675 72166 72224 72892 74053 75155 77374 80235 81375 83566 84818 85144 85209 87024 88032 88423 89345 89715 90411 90565 90632 92667 92928 93332 94259 94318 94705 95005 99232 99637 100000Lobster
include "std.lobster" def quicksort(xs, lt): if xs.length <= 1: xs else: pivot := xs[0] tail := xs.slice(1, -1) f1 := filter tail: lt(_, pivot) f2 := filter tail: !lt(_, pivot) append(append(quicksort(f1, lt), [ pivot ]), quicksort(f2, lt)) sorted := [ 3, 9, 5, 4, 1, 3, 9, 5, 4, 1 ].quicksort(): _a < _b print sortedLogo
; quicksort (lists, functional) to small? :list output or [empty? :list] [empty? butfirst :list] end to quicksort :list if small? :list [output :list] localmake "pivot first :list output (sentence quicksort filter [? < :pivot] butfirst :list filter [? = :pivot] :list quicksort filter [? > :pivot] butfirst :list ) end show quicksort [1 3 5 7 9 8 6 4 2]
; quicksort (arrays, in-place) to incr :name make :name (thing :name) + 1 end to decr :name make :name (thing :name) - 1 end to swap :i :j :a localmake "t item :i :a setitem :i :a item :j :a setitem :j :a :t end to quick :a :low :high if :high <= :low [stop] localmake "l :low localmake "h :high localmake "pivot item ashift (:l + :h) -1 :a do.while [ while [(item :l :a) < :pivot] [incr "l] while [(item :h :a) > :pivot] [decr "h] if :l <= :h [swap :l :h :a incr "l decr "h] ] [:l <= :h] quick :a :low :h quick :a :l :high end to sort :a quick :a first :a count :a end make "test {1 3 5 7 9 8 6 4 2} sort :test show :testLogtalk
quicksort(List, Sorted) :- quicksort(List, [], Sorted). quicksort([], Sorted, Sorted). quicksort([Pivot| Rest], Acc, Sorted) :- partition(Rest, Pivot, Smaller0, Bigger0), quicksort(Smaller0, [Pivot| Bigger], Sorted), quicksort(Bigger0, Acc, Bigger). partition([], _, [], []). partition([X| Xs], Pivot, Smalls, Bigs) :- ( X @< Pivot -> Smalls = [X| Rest], partition(Xs, Pivot, Rest, Bigs) ; Bigs = [X| Rest], partition(Xs, Pivot, Smalls, Rest) ).Lua
NOTE: If you want to use quicksort in a Lua script, you don't need to implement it yourself. Just do:
table.sort(tableName)in-place
--in-place quicksort function quicksort(t, start, endi) start, endi = start or 1, endi or #t --partition w.r.t. first element if(endi - start < 1) then return t end local pivot = start for i = start + 1, endi do if t[i] <= t[pivot] then if i == pivot + 1 then t[pivot],t[pivot+1] = t[pivot+1],t[pivot] else t[pivot],t[pivot+1],t[i] = t[i],t[pivot],t[pivot+1] end pivot = pivot + 1 end end t = quicksort(t, start, pivot - 1) return quicksort(t, pivot + 1, endi) end --example print(unpack(quicksort{5, 2, 7, 3, 4, 7, 1}))non in-place
function quicksort(t) if #t<2 then return t end local pivot=t[1] local a,b,c={},{},{} for _,v in ipairs(t) do if v<pivot then a[#a+1]=v elseif v>pivot then c[#c+1]=v else b[#b+1]=v end end a=quicksort(a) c=quicksort(c) for _,v in ipairs(b) do a[#a+1]=v end for _,v in ipairs(c) do a[#a+1]=v end return a endLucid
qsort(a) = if eof(first a) then a else follow(qsort(b0),qsort(b1)) fi where p = first a < a; b0 = a whenever p; b1 = a whenever not p; follow(x,y) = if xdone then y upon xdone else x fi where xdone = iseod x fby xdone or iseod x; end; endM2000 Interpreter Recursive calling Functions
Module Checkit1 { Group Quick { Private: Function partition { Read &A(), p, r x = A(r) i = p-1 For j=p to r-1 { If .LE(A(j), x) Then { i++ Swap A(i),A(j) } } Swap A(i+1),A(r) = i+1 } Public: LE=Lambda->Number<=Number Function quicksort { Read &A(), p, r If p < r Then { q = .partition(&A(), p, r) Call .quicksort(&A(), p, q - 1) Call .quicksort(&A(), q + 1, r) } } } Dim A(10)<<Random(50, 100) Print A() Call Quick.quicksort(&A(), 0, Len(A())-1) Print A() } Checkit1Recursive calling Subs
Variables p, r, q removed from quicksort function. we use stack for values. Also Partition push to stack now. Works for string arrays too.
Module Checkit2 { Class Quick { Private: partition=lambda-> { Read &A(), p, r : i = p-1 : x=A(r) For j=p to r-1 {If .LE(A(j), x) Then i++:Swap A(i),A(j) } : Swap A(i+1), A(r) : Push i+1 } Public: LE=Lambda->Number<=Number Module ForStrings { .partition<=lambda-> { Read &A$(), p, r : i = p-1 : x$=A$(r) For j=p to r-1 {If A$(j)<= x$ Then i++:Swap A$(i),A$(j) } : Swap A$(i+1), A$(r) : Push i+1 } } Function quicksort (ref$) { myQuick() sub myQuick() If Stackitem() >= stackitem(2) Then drop 2 : Exit Sub Over 2, 2 : Call .partition(ref$) : Over : Shiftback 3, 2 myQuick(number, number - 1) myQuick( number + 1, number) End Sub } } Quick=Quick() Dim A(10) A(0):=57, 83, 74, 98, 51, 73, 85, 76, 65, 92 Print A() Call Quick.quicksort(&A(), 0, Len(A())-1) Print A() Quick=Quick() Quick.ForStrings Dim A$() A$()=("one","two", "three","four", "five") Print A$() Call Quick.quicksort(&A$(), 0, Len(A$())-1) Print A$() } Checkit2Non Recursive
Partition function return two values (where we want q, and use it as q-1 an q+1 now Partition() return final q-1 and q+1_ Example include numeric array, array of arrays (we provide a lambda for comparison) and string array.
Module Checkit3 { Class Quick { Private: partition=lambda-> { Read &A(), p, r : i = p-1 : x=A(r) For j=p to r-1 {If .LE(A(j), x) Then i++:Swap A(i),A(j) } : Swap A(i+1), A(r) : Push i+2, i } Public: LE=Lambda->Number<=Number Module ForStrings { .partition<=lambda-> { Read &A$(), p, r : i = p-1 : x$=A$(r) For j=p to r-1 {If A$(j)<= x$ Then i++:Swap A$(i),A$(j) } : Swap A$(i+1), A$(r) : Push i+2, i } } Function quicksort { Read ref$ { loop : If Stackitem() >= Stackitem(2) Then Drop 2 : if empty then {Break} else continue over 2,2 : call .partition(ref$) :shift 3 } } } Quick=Quick() Dim A(10)<<Random(50, 100) Print A() Call Quick.quicksort(&A(), 0, Len(A())-1) Print A() Quick=Quick() Function join$(a$()) { n=each(a$(), 1, -2) k$="" while n { overwrite k$, ".", n^:=array$(n) } =k$ } Stack New { Data "1.3.6.1.4.1.11.2.17.19.3.4.0.4" , "1.3.6.1.4.1.11.2.17.19.3.4.0.1", "1.3.6.1.4.1.11150.3.4.0.1" Data "1.3.6.1.4.1.11.2.17.19.3.4.0.10", "1.3.6.1.4.1.11.2.17.5.2.0.79", "1.3.6.1.4.1.11150.3.4.0" Dim Base 0, arr(Stack.Size) Link arr() to arr$() i=0 : While not Empty {arr$(i)=piece$(letter$+".", ".") : i++ } } \\ change comparison function Quick.LE=lambda (a, b)->{ Link a, b to a$(), b$() def i=-1 do { i++ } until a$(i)="" or b$(i)="" or a$(i)<>b$(i) if b$(i)="" then =a$(i)="":exit if a$(i)="" then =true:exit =val(a$(i))<=val(b$(i)) } Call Quick.quicksort(&arr(), 0, Len(arr())-1) For i=0 to len(arr())-1 { Print join$(arr(i)) } \\ Fresh load Quick=Quick() Quick.ForStrings Dim A$() A$()=("one","two", "three","four", "five") Print A$() Call Quick.quicksort(&A$(), 0, Len(A$())-1) Print A$() } Checkit3M4
dnl return the first element of a list when called in the funny way seen below define(`arg1', `$1')dnl dnl dnl append lists 1 and 2 define(`append', `ifelse(`$1',`()', `$2', `ifelse(`$2',`()', `$1', `substr($1,0,decr(len($1))),substr($2,1)')')')dnl dnl dnl separate list 2 based on pivot 1, appending to left 3 and right 4, dnl until 2 is empty, and then combine the sort of left with pivot with dnl sort of right define(`sep', `ifelse(`$2', `()', `append(append(quicksort($3),($1)),quicksort($4))', `ifelse(eval(arg1$2<=$1),1, `sep($1,(shift$2),append($3,(arg1$2)),$4)', `sep($1,(shift$2),$3,append($4,(arg1$2)))')')')dnl dnl dnl pick first element of list 1 as pivot and separate based on that define(`quicksort', `ifelse(`$1', `()', `()', `sep(arg1$1,(shift$1),`()',`()')')')dnl dnl quicksort((3,1,4,1,5,9))
(1,1,3,4,5,9)Maclisp
;; While not strictly required, it simplifies the ;; implementation considerably to use filter. MACLisp ;; Doesn't have one out of the box, so we bring our own (DEFUN FILTER (F LIST) (COND ((EQ LIST NIL) NIL) ((FUNCALL F (CAR LIST)) (CONS (CAR LIST) (FILTER F (CDR LIST)))) (T (FILTER F (CDR LIST))))) ;; And then, quicksort. (DEFUN QUICKSORT (LIST) (COND ((OR (EQ LIST ()) (EQ (CDR LIST) ())) LIST) (T (LET ((PIVOT (CAR LIST)) (REST (CDR LIST))) (APPEND (QUICKSORT (FILTER #'(LAMBDA (X) (<= X PIVOT)) REST)) (LIST PIVOT) (QUICKSORT (FILTER #'(LAMBDA (X) (> X PIVOT)) REST)))))))Maple
swap := proc(arr, a, b) local temp := arr[a]: arr[a] := arr[b]: arr[b] := temp: end proc: quicksort := proc(arr, low, high) local pi: if (low < high) then pi := qpart(arr,low,high): quicksort(arr, low, pi-1): quicksort(arr, pi+1, high): end if: end proc: qpart := proc(arr, low, high) local i,j,pivot; pivot := arr[high]: i := low-1: for j from low to high-1 by 1 do if (arr[j] <= pivot) then i++: swap(arr, i, j): end if; end do; swap(arr, i+1, high): return (i+1): end proc: a:=Array([12,4,2,1,0]); quicksort(a,1,5); a;
[0, 1, 2, 4, 12]Mathematica /Wolfram Language
QuickSort[x_List] := Module[{pivot}, If[Length@x <= 1, Return[x]]; pivot = RandomChoice@x; Flatten@{QuickSort[Cases[x, j_ /; j < pivot]], Cases[x, j_ /; j == pivot], QuickSort[Cases[x, j_ /; j > pivot]]} ]
qsort[{}] = {}; qsort[{x_, xs___}] := Join[qsort@Select[{xs}, # <= x &], {x}, qsort@Select[{xs}, # > x &]];
QuickSort[{}] := {} QuickSort[list: {__}] := With[{pivot=RandomChoice[list]}, Join[ <|1->{}, -1->{}|>, GroupBy[list,Order[#,pivot]&] ] // Catenate[ {QuickSort@#[1], #[0], QuickSort@#[-1]} ]& ]MATLAB
This implements the pseudo-code in the specification. The input can be either a row or column vector, but the returned vector will always be a row vector. This can be modified to operate on any built-in primitive or user defined class by replacing the "<=" and ">" comparisons with "le" and "gt" functions respectively. This is because operators can not be overloaded, but the functions that are equivalent to the operators can be overloaded in class definitions.
This should be placed in a file named quickSort.m.
function sortedArray = quickSort(array) if numel(array) <= 1 %If the array has 1 element then it can't be sorted sortedArray = array; return end pivot = array(end); array(end) = []; %Create two new arrays which contain the elements that are less than or %equal to the pivot called "less" and greater than the pivot called %"greater" less = array( array <= pivot ); greater = array( array > pivot ); %The sorted array is the concatenation of the sorted "less" array, the %pivot and the sorted "greater" array in that order sortedArray = [quickSort(less) pivot quickSort(greater)]; end
A slightly more vectorized version of the above code that removes the need for the less and greater arrays:
function sortedArray = quickSort(array) if numel(array) <= 1 %If the array has 1 element then it can't be sorted sortedArray = array; return end pivot = array(end); array(end) = []; sortedArray = [quickSort( array(array <= pivot) ) pivot quickSort( array(array > pivot) )]; end
Sample usage:
quickSort([4,3,7,-2,9,1]) ans = -2 1 3 4 7 9MAXScript
fn quickSort arr = ( less = #() pivotList = #() more = #() if arr.count <= 1 then ( arr ) else ( pivot = arr[arr.count/2] for i in arr do ( case of ( (i < pivot): (append less i) (i == pivot): (append pivotList i) (i > pivot): (append more i) ) ) less = quickSort less more = quickSort more less + pivotList + more ) ) a = #(4, 89, -3, 42, 5, 0, 2, 889) a = quickSort aMercury A quicksort that works on linked lists
%%%------------------------------------------------------------------- :- module quicksort_task_for_lists. :- interface. :- import_module io. :- pred main(io, io). :- mode main(di, uo) is det. :- implementation. :- import_module int. :- import_module list. %%%------------------------------------------------------------------- %%% %%% Partitioning a list into three: %%% %%% Left elements less than the pivot %%% Middle elements equal to the pivot %%% Right elements greater than the pivot %%% %%% The implementation is tail-recursive. %%% :- pred partition(comparison_func(T), T, list(T), list(T), list(T), list(T)). :- mode partition(in, in, in, out, out, out) is det. partition(Compare, Pivot, Lst, Left, Middle, Right) :- partition(Compare, Pivot, Lst, [], Left, [], Middle, [], Right). :- pred partition(comparison_func(T), T, list(T), list(T), list(T), list(T), list(T), list(T), list(T)). :- mode partition(in, in, in, in, out, in, out, in, out) is det. partition(_, _, [], Left0, Left, Middle0, Middle, Right0, Right) :- Left = Left0, Middle = Middle0, Right = Right0. partition(Compare, Pivot, [Head | Tail], Left0, Left, Middle0, Middle, Right0, Right) :- Compare(Head, Pivot) = Cmp, (if (Cmp = (<)) then partition(Compare, Pivot, Tail, [Head | Left0], Left, Middle0, Middle, Right0, Right) else if (Cmp = (=)) then partition(Compare, Pivot, Tail, Left0, Left, [Head | Middle0], Middle, Right0, Right) else partition(Compare, Pivot, Tail, Left0, Left, Middle0, Middle, [Head | Right0], Right)). %%%------------------------------------------------------------------- %%% %%% Quicksort using the first element as pivot. %%% %%% This is not the world's best choice of pivot, but it is the %%% easiest one to get from a linked list. %%% %%% This implementation is *not* tail-recursive--as most quicksort %%% implementations also are not. (However, do an online search on %%% "quicksort fortran 77" and you will find some "tail-recursive" %%% implementations, with the tail recursions expressed as gotos.) %%% :- func quicksort(comparison_func(T), list(T)) = list(T). quicksort(_, []) = []. quicksort(Compare, [Pivot | Tail]) = Sorted_Lst :- partition(Compare, Pivot, Tail, Left, Middle, Right), quicksort(Compare, Left) = Sorted_Left, quicksort(Compare, Right) = Sorted_Right, Sorted_Left ++ [Pivot | Middle] ++ Sorted_Right = Sorted_Lst. %%%------------------------------------------------------------------- :- func example_numbers = list(int). example_numbers = [1, 3, 9, 5, 8, 6, 5, 1, 7, 9, 8, 6, 4, 2]. :- func int_compare(int, int) = comparison_result. int_compare(I, J) = Cmp :- if (I < J) then (Cmp = (<)) else if (I = J) then (Cmp = (=)) else (Cmp = (>)). main(!IO) :- quicksort(int_compare, example_numbers) = Sorted_Numbers, print("unsorted: ", !IO), print_line(example_numbers, !IO), print("sorted: ", !IO), print_line(Sorted_Numbers, !IO). %%%------------------------------------------------------------------- %%% local variables: %%% mode: mercury %%% prolog-indent-width: 2 %%% end:
$ mmc quicksort_task_for_lists.m && ./quicksort_task_for_lists unsorted: [1, 3, 9, 5, 8, 6, 5, 1, 7, 9, 8, 6, 4, 2] sorted: [1, 1, 2, 3, 4, 5, 5, 6, 6, 7, 8, 8, 9, 9]A quicksort that works on arrays
The in-place partitioning algorithm here is similar to but not quite the same as that of the task pseudocode. I wrote it by referring to some Fortran code I wrote several months ago for a quickselect. (That quickselect had a random pivot, however.)
%%%------------------------------------------------------------------- :- module quicksort_task_for_arrays. :- interface. :- import_module io. :- pred main(io, io). :- mode main(di, uo) is det. :- implementation. :- import_module array. :- import_module int. :- import_module list. %%%------------------------------------------------------------------- %%% %%% 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). %%%------------------------------------------------------------------- %%% %%% Quicksort with median of three as pivot. %%% %%% Like most quicksort implementations, this one is *not* %%% tail-recursive. %%% %% quicksort/3 sorts an entire array. :- pred quicksort(pred(T, T), array(T), array(T)). :- mode quicksort(pred(in, in) is semidet, array_di, array_uo) is det. quicksort(Less_than, Arr0, Arr) :- bounds(Arr0, I_first, I_last), quicksort(Less_than, I_first, I_last, Arr0, Arr). %% quicksort/5 sorts a subarray. :- pred quicksort(pred(T, T), int, int, array(T), array(T)). :- mode quicksort(pred(in, in) is semidet, in, in, array_di, array_uo) is det. quicksort(Less_than, I_first, I_last, Arr0, Arr) :- if (I_last - I_first >= 2) then (median_of_three(Less_than, I_first, I_last, Arr0, Arr1, Pivot), %% Partition only from I_first to I_last - 1. partition(Less_than, Pivot, I_first, I_last - 1, Arr1, Arr2, K), %% Now everything that is less than the pivot is to the %% left of K. %% Put the pivot at K, moving the element that had been there %% to the end. If K = 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. Arr2^elem(K) = Elem_to_move, (Arr2^elem(I_last) := Elem_to_move) = Arr3, (Arr3^elem(K) := Pivot) = Arr4, %% Sort the subarray on either side of the pivot. quicksort(Less_than, I_first, K - 1, Arr4, Arr5), quicksort(Less_than, K + 1, I_last, Arr5, Arr)) else if (I_last - I_first = 1) % Two elements. then (Elem_first = Arr0^elem(I_first), Elem_last = Arr0^elem(I_last), (if Less_than(Elem_first, Elem_last) then (Arr = Arr0) else ((Arr0^elem(I_first) := Elem_last) = Arr1, (Arr1^elem(I_last) := Elem_first) = Arr))) else (Arr = Arr0). % Zero or one element. %% median_of_three/6 both chooses a pivot and rearranges the array %% elements so one may partition them from I_first to I_last - 1, %% leaving the pivot element out of the array. :- pred median_of_three(pred(T, T), int, int, array(T), array(T), T). :- mode median_of_three(pred(in, in) is semidet, in, in, array_di, array_uo, out) is det. median_of_three(Less_than, I_first, I_last, Arr0, Arr, Pivot) :- I_middle = I_first + ((I_last - I_first) // 2), Elem_first = Arr0^elem(I_first), Elem_middle = Arr0^elem(I_middle), Elem_last = Arr0^elem(I_last), (if pred_xor(Less_than, Less_than, Elem_middle, Elem_first, Elem_last, Elem_first) then (Pivot = Elem_first, (if Less_than(Elem_middle, Elem_last) then (Arr1 = (Arr0^elem(I_first) := Elem_middle), Arr = (Arr1^elem(I_middle) := Elem_last)) else (Arr = (Arr0^elem(I_first) := Elem_last)))) else if pred_xor(Less_than, Less_than, Elem_middle, Elem_first, Elem_middle, Elem_last) then (Pivot = Elem_middle, (if Less_than(Elem_first, Elem_last) then (Arr = (Arr0^elem(I_middle) := Elem_last)) else (Arr1 = (Arr0^elem(I_first) := Elem_last), Arr = (Arr1^elem(I_middle) := Elem_first)))) else (Pivot = Elem_last, (if Less_than(Elem_first, Elem_middle) then (Arr = Arr0) else (Arr1 = (Arr0^elem(I_first) := Elem_middle), Arr = (Arr1^elem(I_middle) := Elem_first))))). :- pred pred_xor(pred(T, T), pred(T, T), T, T, T, T). :- mode pred_xor(pred(in, in) is semidet, pred(in, in) is semidet, in, in, in, in) is semidet. pred_xor(P, Q, W, X, Y, Z) :- if P(W, X) then (not Q(Y, Z)) else Q(Y, Z). %%%------------------------------------------------------------------- :- func example_numbers = list(int). example_numbers = [1, 3, 9, 5, 8, 6, 5, 0, 1, 7, 9, 8, 6, 4, 2, -28, 30, 31, 1, 3, 9, 5, 8, 6, 5, 1, 6, 4, 2, -28, 30, -50, 500, -1234, 1234, 12]. main(!IO) :- (array.from_list(example_numbers, Arr0)), print_line("", !IO), print_line(Arr0, !IO), print_line("", !IO), print_line(" |", !IO), print_line(" V", !IO), print_line("", !IO), quicksort(<, Arr0, Arr1), print_line(Arr1, !IO), print_line("", !IO). %%%------------------------------------------------------------------- %%% local variables: %%% mode: mercury %%% prolog-indent-width: 2 %%% end:
$ mmc quicksort_task_for_arrays.m && ./quicksort_task_for_arrays array([1, 3, 9, 5, 8, 6, 5, 0, 1, 7, 9, 8, 6, 4, 2, -28, 30, 31, 1, 3, 9, 5, 8, 6, 5, 1, 6, 4, 2, -28, 30, -50, 500, -1234, 1234, 12]) | V array([-1234, -50, -28, -28, 0, 1, 1, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 5, 5, 6, 6, 6, 6, 7, 8, 8, 8, 9, 9, 9, 12, 30, 30, 31, 500, 1234])MiniScript
Quick implementation for Miniscript, simply goes through the list reference and swaps the positions
Partition = function(a, low, high) pivot = a[low] leftwall = low for i in range(low + 1, high) if a[i] < pivot then leftwall = leftwall + 1 temp = a[leftwall] a[leftwall] = a[i] a[i] = temp end if end for temp = a[leftwall] a[leftwall] = pivot a[low] = temp return leftwall end function QuickSort = function(a, low=null, high=null) if not low then low = 0 if not high then high = a.len - 1 if low < high then pivot_location = Partition(a, low, high) QuickSort a, low, pivot_location - 1 QuickSort a, pivot_location + 1, high end if return a end function print QuickSort([3, 5, 2, 4, 1])
[1, 2, 3, 4, 5]Miranda
main :: [sys_message] main = [Stdout ("Before: " ++ show testlist ++ "\n"), Stdout ("After: " ++ show (quicksort testlist) ++ "\n")] where testlist = [4,65,2,-31,0,99,2,83,782,1] quicksort [] = [] quicksort [x] = [x] quicksort xs = (quicksort less) ++ equal ++ (quicksort more) where pivot = hd xs less = [x | x<-xs; x<pivot] equal = [x | x<-xs; x=pivot] more = [x | x<-xs; x>pivot]
Before: [4,65,2,-31,0,99,2,83,782,1] After: [-31,0,1,2,2,4,65,83,99,782]Modula-2
The definition module exposes the interface. This one uses the procedure variable feature to pass a caller defined compare callback function so that it can sort various simple and structured record types.
This Quicksort assumes that you are working with an an array of pointers to an arbitrary type and are not moving the record data itself but only the pointers. The M2 type "ADDRESS" is considered compatible with any pointer type.
The use of type ADDRESS here to achieve genericity is something of a chink the the normal strongly typed flavor of Modula-2. Unlike the other language types, "system" types such as ADDRESS or WORD must be imported explicity from the SYSTEM MODULE. The ISO standard for the "Generic Modula-2" language extension provides genericity without the chink, but most compilers have not implemented this extension.
(*#####################*) DEFINITION MODULE QSORT; (*#####################*) FROM SYSTEM IMPORT ADDRESS; TYPE CmpFuncPtrs = PROCEDURE(ADDRESS, ADDRESS):INTEGER; PROCEDURE QuickSortPtrs(VAR Array:ARRAY OF ADDRESS; N:CARDINAL; Compare:CmpFuncPtrs); END QSORT.
The implementation module is not visible to clients, so it may be changed without worry so long as it still implements the definition.
Sedgewick suggests that faster sorting will be achieved if you drop back to an insertion sort once the partitions get small.
(*##########################*) IMPLEMENTATION MODULE QSORT; (*##########################*) FROM SYSTEM IMPORT ADDRESS; CONST SmallPartition = 9; (* NOTE 1.Reference on QuickSort: "Implementing Quicksort Programs", Robert Sedgewick, Communications of the ACM, Oct 78, v21 #10. *) (*==============================================================*) PROCEDURE QuickSortPtrs(VAR Array:ARRAY OF ADDRESS; N:CARDINAL; Compare:CmpFuncPtrs); (*==============================================================*) (*-----------------------------*) PROCEDURE Swap(VAR A,B:ADDRESS); (*-----------------------------*) VAR temp :ADDRESS; BEGIN temp := A; A := B; B := temp; END Swap; (*-------------------------------*) PROCEDURE TstSwap(VAR A,B:ADDRESS); (*-------------------------------*) VAR temp :ADDRESS; BEGIN IF Compare(A,B) > 0 THEN temp := A; A := B; B := temp; END; END TstSwap; (*--------------*) PROCEDURE Isort; (*--------------*) (* Insertion sort. *) VAR i,j :CARDINAL; temp :ADDRESS; BEGIN IF N < 2 THEN RETURN END; FOR i := N-2 TO 0 BY -1 DO IF Compare(Array[i],Array[i+1]) > 0 THEN temp := Array[i]; j := i+1; REPEAT Array[j-1] := Array[j]; INC(j); UNTIL (j = N) OR (Compare(Array[j],temp) >= 0); Array[j-1] := temp; END; END; END Isort; (*----------------------------------*) PROCEDURE Quick(left,right:CARDINAL); (*----------------------------------*) VAR i,j, second :CARDINAL; Partition :ADDRESS; BEGIN IF right > left THEN i := left; j := right; Swap(Array[left],Array[(left+right) DIV 2]); second := left+1; (* insure 2nd element is in *) TstSwap(Array[second], Array[right]); (* the lower part, last elem *) TstSwap(Array[left], Array[right]); (* in the upper part *) TstSwap(Array[second], Array[left]); (* THUS, only one test is *) (* needed in repeat loops *) Partition := Array[left]; LOOP REPEAT INC(i) UNTIL Compare(Array[i],Partition) >= 0; REPEAT DEC(j) UNTIL Compare(Array[j],Partition) <= 0; IF j < i THEN EXIT END; Swap(Array[i],Array[j]); END; (*loop*) Swap(Array[left],Array[j]); IF (j > 0) AND (j-1-left >= SmallPartition) THEN Quick(left,j-1); END; IF right-i >= SmallPartition THEN Quick(i,right); END; END; END Quick; BEGIN (* QuickSortPtrs --------------------------------------------------*) IF N > SmallPartition THEN (* won't work for 2 elements *) Quick(0,N-1); END; Isort; END QuickSortPtrs; END QSORT.Modula-3
This code is taken from libm3, which is basically Modula-3's "standard library". Note that this code uses Insertion sort when the array is less than 9 elements long.
GENERIC INTERFACE ArraySort(Elem); PROCEDURE Sort(VAR a: ARRAY OF Elem.T; cmp := Elem.Compare); END ArraySort.
GENERIC MODULE ArraySort (Elem); PROCEDURE Sort (VAR a: ARRAY OF Elem.T; cmp := Elem.Compare) = BEGIN QuickSort (a, 0, NUMBER (a), cmp); InsertionSort (a, 0, NUMBER (a), cmp); END Sort; PROCEDURE QuickSort (VAR a: ARRAY OF Elem.T; lo, hi: INTEGER; cmp := Elem.Compare) = CONST CutOff = 9; VAR i, j: INTEGER; key, tmp: Elem.T; BEGIN WHILE (hi - lo > CutOff) DO (* sort a[lo..hi) *) (* use median-of-3 to select a key *) i := (hi + lo) DIV 2; IF cmp (a[lo], a[i]) < 0 THEN IF cmp (a[i], a[hi-1]) < 0 THEN key := a[i]; ELSIF cmp (a[lo], a[hi-1]) < 0 THEN key := a[hi-1]; a[hi-1] := a[i]; a[i] := key; ELSE key := a[lo]; a[lo] := a[hi-1]; a[hi-1] := a[i]; a[i] := key; END; ELSE (* a[lo] >= a[i] *) IF cmp (a[hi-1], a[i]) < 0 THEN key := a[i]; tmp := a[hi-1]; a[hi-1] := a[lo]; a[lo] := tmp; ELSIF cmp (a[lo], a[hi-1]) < 0 THEN key := a[lo]; a[lo] := a[i]; a[i] := key; ELSE key := a[hi-1]; a[hi-1] := a[lo]; a[lo] := a[i]; a[i] := key; END; END; (* partition the array *) i := lo+1; j := hi-2; (* find the first hole *) WHILE cmp (a[j], key) > 0 DO DEC (j) END; tmp := a[j]; DEC (j); LOOP IF (i > j) THEN EXIT END; WHILE i < hi AND cmp (a[i], key) < 0 DO INC (i) END; IF (i > j) THEN EXIT END; a[j+1] := a[i]; INC (i); WHILE j > lo AND cmp (a[j], key) > 0 DO DEC (j) END; IF (i > j) THEN IF (j = i-1) THEN DEC (j) END; EXIT END; a[i-1] := a[j]; DEC (j); END; (* fill in the last hole *) a[j+1] := tmp; i := j+2; (* then, recursively sort the smaller subfile *) IF (i - lo < hi - i) THEN QuickSort (a, lo, i-1, cmp); lo := i; ELSE QuickSort (a, i, hi, cmp); hi := i-1; END; END; (* WHILE (hi-lo > CutOff) *) END QuickSort; PROCEDURE InsertionSort (VAR a: ARRAY OF Elem.T; lo, hi: INTEGER; cmp := Elem.Compare) = VAR j: INTEGER; key: Elem.T; BEGIN FOR i := lo+1 TO hi-1 DO key := a[i]; j := i-1; WHILE (j >= lo) AND cmp (key, a[j]) < 0 DO a[j+1] := a[j]; DEC (j); END; a[j+1] := key; END; END InsertionSort; BEGIN END ArraySort.
To use this generic code to sort an array of text, we create two files called TextSort.i3 and TextSort.m3, respectively.
INTERFACE TextSort = ArraySort(Text) END TextSort.
MODULE TextSort = ArraySort(Text) END TextSort.
Then, as an example:
MODULE Main; IMPORT IO, TextSort; VAR arr := ARRAY [1..10] OF TEXT {"Foo", "bar", "!ooF", "Modula-3", "hickup", "baz", "quuz", "Zeepf", "woo", "Rosetta Code"}; BEGIN TextSort.Sort(arr); FOR i := FIRST(arr) TO LAST(arr) DO IO.Put(arr[i] & "\n"); END; END Main.Mond
Implements the simple quicksort algorithm.
fun quicksort( arr, cmp ) { if( arr.length() < 2 ) return arr; if( !cmp ) cmp = ( a, b ) -> a - b; var a = [ ], b = [ ]; var pivot = arr[0]; var len = arr.length(); for( var i = 1; i < len; ++i ) { var item = arr[i]; if( cmp( item, pivot ) < cmp( pivot, item ) ) a.add( item ); else b.add( item ); } a = quicksort( a, cmp ); b = quicksort( b, cmp ); a.add( pivot ); foreach( var item in b ) a.add( item ); return a; }
var array = [ 532, 16, 153, 3, 63.60, 925, 0.214 ]; var sorted = quicksort( array ); printLn( sorted );
[ 0.214, 3, 16, 63.6, 153, 532, 925 ]MUMPS
Shows quicksort on a 16-element array.
main new collection,size set size=16 set collection=size for i=0:1:size-1 set collection(i)=$random(size) write "Collection to sort:",!! zwrite collection ; This will only work on Intersystem's flavor of MUMPS do quicksort(.collection,0,collection-1) write:$$isSorted(.collection) !,"Collection is sorted:",!! zwrite collection ; This will only work on Intersystem's flavor of MUMPS q quicksort(array,low,high) if low<high do . set pivot=$$partition(.array,low,high) . do quicksort(.array,low,pivot-1) . do quicksort(.array,pivot+1,high) q partition(A,p,r) set pivot=A(r) set i=p-1 for j=p:1:r-1 do . i A(j)<=pivot do . . set i=i+1 . . set helper=A(j) . . set A(j)=A(i) . . set A(i)=helper set helper=A(r) set A(r)=A(i+1) set A(i+1)=helper quit i+1 isSorted(array) set sorted=1 for i=0:1:array-2 do quit:sorted=0 . for j=i+1:1:array-1 do quit:sorted=0 . . set:array(i)>array(j) sorted=0 quit sorted
Collection to sort: collection=16 collection(0)=4 collection(1)=0 collection(2)=6 collection(3)=14 collection(4)=4 collection(5)=0 collection(6)=10 collection(7)=5 collection(8)=11 collection(9)=4 collection(10)=12 collection(11)=9 collection(12)=13 collection(13)=4 collection(14)=14 collection(15)=0 Collection is sorted: collection=16 collection(0)=0 collection(1)=0 collection(2)=0 collection(3)=4 collection(4)=4 collection(5)=4 collection(6)=4 collection(7)=5 collection(8)=6 collection(9)=9 collection(10)=10 collection(11)=11 collection(12)=12 collection(13)=13 collection(14)=14 collection(15)=14Nanoquery
def quickSort(arr) less = {} pivotList = {} more = {} if len(arr) <= 1 return arr else pivot = arr[0] for i in arr if i < pivot less.append(i) else if i > pivot more.append(i) else pivotList.append(i) end end less = quickSort(less) more = quickSort(more) return less + pivotList + more end endNemerle
A little less clean and concise than Haskell, but essentially the same.
using System; using System.Console; using Nemerle.Collections.NList; module Quicksort { Qsort[T] (x : list[T]) : list[T] where T : IComparable { |[] => [] |x::xs => Qsort($[y|y in xs, (y.CompareTo(x) < 0)]) + [x] + Qsort($[y|y in xs, (y.CompareTo(x) > 0)]) } Main() : void { def empty = []; def single = [2]; def several = [2, 6, 1, 7, 3, 9, 4]; WriteLine(Qsort(empty)); WriteLine(Qsort(single)); WriteLine(Qsort(several)); } }NetRexx
This sample implements both the simple and in place algorithms as described in the task's description:
/* NetRexx */ options replace format comments java crossref savelog symbols binary import java.util.List placesList = [String - "UK London", "US New York", "US Boston", "US Washington" - , "UK Washington", "US Birmingham", "UK Birmingham", "UK Boston" - ] lists = [ - placesList - , quickSortSimple(String[] Arrays.copyOf(placesList, placesList.length)) - , quickSortInplace(String[] Arrays.copyOf(placesList, placesList.length)) - ] loop ln = 0 to lists.length - 1 cl = lists[ln] loop ct = 0 to cl.length - 1 say cl[ct] end ct say end ln return method quickSortSimple(array = String[]) public constant binary returns String[] rl = String[array.length] al = List quickSortSimple(Arrays.asList(array)) al.toArray(rl) return rl method quickSortSimple(array = List) public constant binary returns ArrayList if array.size > 1 then do less = ArrayList() equal = ArrayList() greater = ArrayList() pivot = array.get(Random().nextInt(array.size - 1)) loop x_ = 0 to array.size - 1 if (Comparable array.get(x_)).compareTo(Comparable pivot) < 0 then less.add(array.get(x_)) if (Comparable array.get(x_)).compareTo(Comparable pivot) = 0 then equal.add(array.get(x_)) if (Comparable array.get(x_)).compareTo(Comparable pivot) > 0 then greater.add(array.get(x_)) end x_ less = quickSortSimple(less) greater = quickSortSimple(greater) out = ArrayList(array.size) out.addAll(less) out.addAll(equal) out.addAll(greater) array = out end return ArrayList array method quickSortInplace(array = String[]) public constant binary returns String[] rl = String[array.length] al = List quickSortInplace(Arrays.asList(array)) al.toArray(rl) return rl method quickSortInplace(array = List, ixL = int 0, ixR = int array.size - 1) public constant binary returns ArrayList if ixL < ixR then do ixP = int ixL + (ixR - ixL) % 2 ixP = quickSortInplacePartition(array, ixL, ixR, ixP) quickSortInplace(array, ixL, ixP - 1) quickSortInplace(array, ixP + 1, ixR) end array = ArrayList(array) return ArrayList array method quickSortInplacePartition(array = List, ixL = int, ixR = int, ixP = int) public constant binary returns int pivotValue = array.get(ixP) rValue = array.get(ixR) array.set(ixP, rValue) array.set(ixR, pivotValue) ixStore = ixL loop i_ = ixL to ixR - 1 iValue = array.get(i_) if (Comparable iValue).compareTo(Comparable pivotValue) < 0 then do storeValue = array.get(ixStore) array.set(i_, storeValue) array.set(ixStore, iValue) ixStore = ixStore + 1 end end i_ storeValue = array.get(ixStore) rValue = array.get(ixR) array.set(ixStore, rValue) array.set(ixR, storeValue) return ixStore
UK London US New York US Boston US Washington UK Washington US Birmingham UK Birmingham UK Boston UK Birmingham UK Boston UK London UK Washington US Birmingham US Boston US New York US Washington UK Birmingham UK Boston UK London UK Washington US Birmingham US Boston US New York US WashingtonNial
quicksort is fork [ >= [1 first,tally], pass, link [ quicksort sublist [ < [pass, first], pass ], sublist [ match [pass,first],pass ], quicksort sublist [ > [pass,first], pass ] ] ]
Using it.
|quicksort [5, 8, 7, 4, 3] =3 4 5 7 8Nim Procedural (in place) algorithm
proc quickSortImpl[T](a: var openarray[T], start, stop: int) = if stop - start > 0: let pivot = a[start] var left = start var right = stop while left <= right: while cmp(a[left], pivot) < 0: inc(left) while cmp(a[right], pivot) > 0: dec(right) if left <= right: swap(a[left], a[right]) inc(left) dec(right) quickSortImpl(a, start, right) quickSortImpl(a, left, stop) proc quickSort[T](a: var openarray[T]) = quickSortImpl(a, 0, a.len - 1) var a = @[4, 65, 2, -31, 0, 99, 2, 83, 782] a.quickSort() echo aFunctional (inmmutability) algorithm
import sequtils,sugar func sorted[T](xs:seq[T]): seq[T] = if xs.len==0: @[] else: concat( xs[1..^1].filter(x=>x<xs[0]).sorted, @[xs[0]], xs[1..^1].filter(x=>x>=xs[0]).sorted ) @[4, 65, 2, -31, 0, 99, 2, 83, 782].sorted.echo
@[-31, 0, 2, 2, 4, 65, 83, 99, 782]Nix
let qs = l: if l == [] then [] else with builtins; let x = head l; xs = tail l; low = filter (a: a < x) xs; high = filter (a: a >= x) xs; in qs low ++ [x] ++ qs high; in qs [4 65 2 (-31) 0 99 83 782]
[ -31 0 2 4 65 83 99 782 ]Oberon-2
MODULE QS; IMPORT Out; TYPE TItem = INTEGER; CONST N = 10; VAR I:LONGINT; A:ARRAY N OF INTEGER; PROCEDURE Init(VAR A:ARRAY OF TItem); BEGIN A[0] := 4; A[1] := 65; A[2] := 2; A[3] := -31; A[4] := 0; A[5] := 99; A[6] := 2; A[7] := 83; A[8] := 782; A[9] := 1; END Init; PROCEDURE QuickSort(VAR A:ARRAY OF TItem; Left,Right:LONGINT); VAR I,J:LONGINT; Pivot,Temp:TItem; BEGIN I := Left; J := Right; Pivot := A[(Left + Right) DIV 2]; REPEAT WHILE Pivot > A[I] DO INC(I) END; WHILE Pivot < A[J] DO DEC(J) END; IF I <= J THEN Temp := A[I]; A[I] := A[J]; A[J] := Temp; INC(I); DEC(J); END; UNTIL I > J; IF Left < J THEN QuickSort(A, Left, J) END; IF I < Right THEN QuickSort(A, I, Right) END; END QuickSort; BEGIN Init(A); FOR I := 0 TO LEN(A)-1 DO Out.Int(A[I], 0); Out.Char(' '); END; Out.Ln; QuickSort(A, 0, LEN(A)-1); FOR I := 0 TO LEN(A)-1 DO Out.Int(A[I], 0); Out.Char(' '); END; Out.Ln; END QS.Objeck
class QuickSort { function : Main(args : String[]) ~ Nil { array := [1, 3, 5, 7, 9, 8, 6, 4, 2]; Sort(array); each(i : array) { array[i]->PrintLine(); }; } function : Sort(array : Int[]) ~ Nil { size := array->Size(); if(size <= 1) { return; }; Sort(array, 0, size - 1); } function : native : Sort(array : Int[], low : Int, high : Int) ~ Nil { i := low; j := high; pivot := array[low + (high-low)/2]; while(i <= j) { while(array[i] < pivot) { i+=1; }; while(array[j] > pivot) { j-=1; }; if (i <= j) { temp := array[i]; array[i] := array[j]; array[j] := temp; i+=1; j-=1; }; }; if(low < j) { Sort(array, low, j); }; if(i < high) { Sort(array, i, high); }; } }Objective-C
The latest XCode compiler is assumed with ARC enabled.
void quicksortInPlace(NSMutableArray *array, NSInteger first, NSInteger last, NSComparator comparator) { if (first >= last) return; id pivot = array[(first + last) / 2]; NSInteger left = first; NSInteger right = last; while (left <= right) { while (comparator(array[left], pivot) == NSOrderedAscending) left++; while (comparator(array[right], pivot) == NSOrderedDescending) right--; if (left <= right) [array exchangeObjectAtIndex:left++ withObjectAtIndex:right--]; } quicksortInPlace(array, first, right, comparator); quicksortInPlace(array, left, last, comparator); } NSArray* quicksort(NSArray *unsorted, NSComparator comparator) { NSMutableArray *a = [NSMutableArray arrayWithArray:unsorted]; quicksortInPlace(a, 0, a.count - 1, comparator); return a; } int main(int argc, const char * argv[]) { @autoreleasepool { NSArray *a = @[ @1, @3, @5, @7, @9, @8, @6, @4, @2 ]; NSLog(@"Unsorted: %@", a); NSLog(@"Sorted: %@", quicksort(a, ^(id x, id y) { return [x compare:y]; })); NSArray *b = @[ @"Emil", @"Peg", @"Helen", @"Juergen", @"David", @"Rick", @"Barb", @"Mike", @"Tom" ]; NSLog(@"Unsorted: %@", b); NSLog(@"Sorted: %@", quicksort(b, ^(id x, id y) { return [x compare:y]; })); } return 0; }
Unsorted: ( 1, 3, 5, 7, 9, 8, 6, 4, 2 ) Sorted: ( 1, 2, 3, 4, 5, 6, 7, 8, 9 ) Unsorted: ( Emil, Peg, Helen, Juergen, David, Rick, Barb, Mike, Tom ) Sorted: ( Barb, David, Emil, Helen, Juergen, Mike, Peg, Rick, Tom )OCaml Declarative and purely functional
let rec quicksort gt = function | [] -> [] | x::xs -> let ys, zs = List.partition (gt x) xs in (quicksort gt ys) @ (x :: (quicksort gt zs)) let _ = quicksort (>) [4; 65; 2; -31; 0; 99; 83; 782; 1]
The list based implementation is elegant and perspicuous, but inefficient in time (because partition
and @
are linear) and in space (since it creates numerous new lists along the way).
Using aliased array slices from the Containers library.
module Slice = CCArray_slice let quicksort : int Array.t -> unit = fun arr -> let rec quicksort' : int Slice.t -> unit = fun slice -> let len = Slice.length slice in if len > 1 then begin let pivot = Slice.get slice (len / 2) and i = ref 0 and j = ref (len - 1) in while !i < !j do while Slice.get slice !i < pivot do incr i done; while Slice.get slice !j > pivot do decr j done; if !i < !j then begin let i_val = Slice.get slice !i in Slice.set slice !i (Slice.get slice !j); Slice.set slice !j i_val; incr i; decr j; end done; quicksort' (Slice.sub slice 0 !i); quicksort' (Slice.sub slice !i (len - !i)); end in (* Take the array into an aliased array slice *) Slice.full arr |> quicksort'Octave
(The MATLAB version works as is in Octave, provided that the code is put in a file named quicksort.m, and everything below the return must be typed in the prompt of course)
function f=quicksort(v) % v must be a column vector f = v; n=length(v); if(n > 1) vl = min(f); vh = max(f); % min, max p = (vl+vh)*0.5; % pivot ia = find(f < p); ib = find(f == p); ic=find(f > p); f = [quicksort(f(ia)); f(ib); quicksort(f(ic))]; end endfunction N=30; v=rand(N,1); tic,u=quicksort(v); toc uOforth
Oforth built-in sort uses quick sort algorithm (see lang/collect/ListBuffer.of for implementation) :
[ 5, 8, 2, 3, 4, 1 ] sortOl
(define (quicksort l ??) (if (null? l) '() (append (quicksort (filter (lambda (x) (?? (car l) x)) (cdr l)) ??) (list (car l)) (quicksort (filter (lambda (x) (not (?? (car l) x))) (cdr l)) ??)))) (print (quicksort (list 1 3 5 9 8 6 4 3 2) >)) (print (quicksort (iota 100) >)) (print (quicksort (iota 100) <))
(1 2 3 3 4 5 6 8 9) (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99) (99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79 78 77 76 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0)ooRexx
a = .array~Of(4, 65, 2, -31, 0, 99, 83, 782, 1) say 'before:' a~toString( ,', ') a = quickSort(a) say ' after:' a~toString( ,', ') exit ::routine quickSort use arg arr -- the array to be sorted less = .array~new pivotList = .array~new more = .array~new if arr~items <= 1 then return arr else do pivot = arr[1] do i over arr if i < pivot then less~append(i) else if i > pivot then more~append(i) else pivotList~append(i) end less = quickSort(less) more = quickSort(more) return less~~appendAll(pivotList)~~appendAll(more) end
before: 4, 65, 2, -31, 0, 99, 83, 782, 1 after: -31, 0, 1, 2, 4, 65, 83, 99, 782Oz
declare fun {QuickSort Xs} case Xs of nil then nil [] Pivot|Xr then fun {IsSmaller X} X < Pivot end Smaller Larger in {List.partition Xr IsSmaller ?Smaller ?Larger} {Append {QuickSort Smaller} Pivot|{QuickSort Larger}} end end in {Show {QuickSort [3 1 4 1 5 9 2 6 5]}}PARI/GP
quickSort(v)={ if(#v<2, return(v)); my(less=List(),more=List(),same=List(),pivot); pivot=median([v[random(#v)+1],v[random(#v)+1],v[random(#v)+1]]); \\ Middle-of-three for(i=1,#v, if(v[i]<pivot, listput(less, v[i]), if(v[i]==pivot, listput(same, v[i]), listput(more, v[i])) ) ); concat(quickSort(Vec(less)), concat(Vec(same), quickSort(Vec(more)))) }; median(v)={ vecsort(v)[#v>>1] };Pascal
program QSortDemo; {$mode objfpc}{$h+}{$b-} procedure QuickSort(var A: array of Integer); procedure QSort(L, R: Integer); var I, J, Tmp, Pivot: Integer; begin if R - L < 1 then exit; I := L; J := R; {$push}{$q-}{$r-}Pivot := A[(L + R) shr 1];{$pop} repeat while A[I] < Pivot do Inc(I); while A[J] > Pivot do Dec(J); if I <= J then begin Tmp := A[I]; A[I] := A[J]; A[J] := Tmp; Inc(I); Dec(J); end; until I > J; QSort(L, J); QSort(I, R); end; begin QSort(0, High(A)); end; procedure PrintArray(const A: array of Integer); var I: Integer; begin Write('['); for I := 0 to High(A) - 1 do Write(A[I], ', '); WriteLn(A[High(A)], ']'); end; var a: array[-7..6] of Integer = (-34, -20, 30, 13, 36, -10, 5, -25, 9, 19, 35, -50, 29, 11); begin QuickSort(a); PrintArray(a); end.
[-50, -34, -25, -20, -10, 5, 9, 11, 13, 19, 29, 30, 35, 36]PascalABC.NET
function Partition(a: array of integer; l,r: integer): integer; begin var i := l - 1; var j := r + 1; var x := a[l]; while True do begin repeat i += 1; until a[i]>=x; repeat j -= 1; until a[j]<=x; if i<j then Swap(a[i],a[j]) else begin Result := j; exit; end; end; end; procedure QuickSort(a: array of integer; l,r: integer); begin if l>=r then exit; var j := Partition(a,l,r); QuickSort(a,l,j); QuickSort(a,j+1,r); end; const n = 20; begin var a := ArrRandom(n); Println('Before: '); Println(a); QuickSort(a,0,a.Length-1); Println('After sorting: '); Println(a); end.
Before: [67,95,79,96,14,56,25,9,4,56,70,62,33,52,13,12,73,19,8,72] After sorting: [4,8,9,12,13,14,19,25,33,52,56,56,62,67,70,72,73,79,95,96]Perl
sub quick_sort { return @_ if @_ < 2; my $p = splice @_, int rand @_, 1; quick_sort(grep $_ < $p, @_), $p, quick_sort(grep $_ >= $p, @_); } my @a = (4, 65, 2, -31, 0, 99, 83, 782, 1); @a = quick_sort @a; print "@a\n";Phix
with javascript_semantics function quick_sort(sequence x) -- -- put x into ascending order using recursive quick sort -- integer n = length(x) if n<2 then return x -- already sorted (trivial case) end if integer mid = floor((n+1)/2), last = 1 object midval = x[mid] x[mid] = x[1] for i=2 to n do object xi = x[i] if xi<midval then last += 1 x[i] = x[last] x[last] = xi end if end for return quick_sort(x[2..last]) & {midval} & quick_sort(x[last+1..n]) end function ?quick_sort({5,"oranges","and",3,"apples"})
{3,5,"and","apples","oranges"}PHP
function quicksort($arr){ $lte = $gt = array(); if(count($arr) < 2){ return $arr; } $pivot_key = key($arr); $pivot = array_shift($arr); foreach($arr as $val){ if($val <= $pivot){ $lte[] = $val; } else { $gt[] = $val; } } return array_merge(quicksort($lte),array($pivot_key=>$pivot),quicksort($gt)); } $arr = array(1, 3, 5, 7, 9, 8, 6, 4, 2); $arr = quicksort($arr); echo implode(',',$arr);
1,2,3,4,5,6,7,8,9
function quickSort(array $array) { // base case if (empty($array)) { return $array; } $head = array_shift($array); $tail = $array; $lesser = array_filter($tail, function ($item) use ($head) { return $item <= $head; }); $bigger = array_filter($tail, function ($item) use ($head) { return $item > $head; }); return array_merge(quickSort($lesser), [$head], quickSort($bigger)); } $testCase = [1, 4, 8, 2, 8, 0, 2, 8]; $result = quickSort($testCase); echo sprintf("[%s] ==> [%s]\n", implode(', ', $testCase), implode(', ', $result));
[1, 4, 8, 2, 8, 0, 2, 8] ==> [0, 1, 2, 2, 4, 8, 8, 8]Picat Function
qsort([]) = []. qsort([H|T]) = qsort([E : E in T, E =< H]) ++ [H] ++ qsort([E : E in T, E > H]).Recursion
qsort( [], [] ). qsort( [H|U], S ) :- splitBy(H, U, L, R), qsort(L, SL), qsort(R, SR), append(SL, [H|SR], S). % splitBy( H, U, LS, RS ) % True if LS = { L in U | L <= H }; RS = { R in U | R > H } splitBy( _, [], [], []). splitBy( H, [U|T], [U|LS], RS ) :- U =< H, splitBy(H, T, LS, RS). splitBy( H, [U|T], LS, [U|RS] ) :- U > H, splitBy(H, T, LS, RS).PicoLisp
(de quicksort (L) (if (cdr L) (let Pivot (car L) (append (quicksort (filter '((A) (< A Pivot)) (cdr L))) (filter '((A) (= A Pivot)) L ) (quicksort (filter '((A) (> A Pivot)) (cdr L)))) ) L) )PL/I
DCL (T(20)) FIXED BIN(31); /* scratch space of length N */ QUICKSORT: PROCEDURE (A,AMIN,AMAX,N) RECURSIVE ; DECLARE (A(*)) FIXED BIN(31); DECLARE (N,AMIN,AMAX) FIXED BIN(31) NONASGN; DECLARE (I,J,IA,IB,IC,PIV) FIXED BIN(31); DECLARE (P,Q) POINTER; DECLARE (AP(1)) FIXED BIN(31) BASED(P); IF(N <= 1)THEN RETURN; IA=0; IB=0; IC=N+1; PIV=(AMIN+AMAX)/2; DO I=1 TO N; IF(A(I) < PIV)THEN DO; IA+=1; A(IA)=A(I); END; ELSE IF(A(I) > PIV) THEN DO; IC-=1; T(IC)=A(I); END; ELSE DO; IB+=1; T(IB)=A(I); END; END; DO I=1 TO IB; A(I+IA)=T(I); END; DO I=IC TO N; A(I)=T(N+IC-I); END; P=ADDR(A(IC)); IC=N+1-IC; IF(IA > 1) THEN CALL QUICKSORT(A, AMIN, PIV-1,IA); IF(IC > 1) THEN CALL QUICKSORT(AP,PIV+1,AMAX, IC); RETURN; END QUICKSORT; MINMAX: PROC(A,AMIN,AMAX,N); DCL (AMIN,AMAX) FIXED BIN(31), (N,A(*)) FIXED BIN(31) NONASGN ; DCL (I,X,Y) FIXED BIN(31); AMIN=A(N); AMAX=AMIN; DO I=1 TO N-1; X=A(I); Y=A(I+1); IF (X < Y)THEN DO; IF (X < AMIN) THEN AMIN=X; IF (Y > AMAX) THEN AMAX=Y; END; ELSE DO; IF (X > AMAX) THEN AMAX=X; IF (Y < AMIN) THEN AMIN=Y; END; END; RETURN; END MINMAX; CALL MINMAX(A,AMIN,AMAX,N); CALL QUICKSORT(A,AMIN,AMAX,N);PowerShell First solution
Function SortThree( [Array] $data ) { if( $data[ 0 ] -gt $data[ 1 ] ) { if( $data[ 0 ] -lt $data[ 2 ] ) { $data = $data[ 1, 0, 2 ] } elseif ( $data[ 1 ] -lt $data[ 2 ] ){ $data = $data[ 1, 2, 0 ] } else { $data = $data[ 2, 1, 0 ] } } else { if( $data[ 0 ] -gt $data[ 2 ] ) { $data = $data[ 2, 0, 1 ] } elseif( $data[ 1 ] -gt $data[ 2 ] ) { $data = $data[ 0, 2, 1 ] } } $data } Function QuickSort( [Array] $data, $rand = ( New-Object Random ) ) { $datal = $data.length if( $datal -gt 3 ) { [void] $datal-- $median = ( SortThree $data[ 0, ( $rand.Next( 1, $datal - 1 ) ), -1 ] )[ 1 ] $lt = @() $eq = @() $gt = @() $data | ForEach-Object { if( $_ -lt $median ) { $lt += $_ } elseif( $_ -eq $median ) { $eq += $_ } else { $gt += $_ } } $lt = ( QuickSort $lt $rand ) $gt = ( QuickSort $gt $rand ) $data = @($lt) + $eq + $gt } elseif( $datal -eq 3 ) { $data = SortThree( $data ) } elseif( $datal -eq 2 ) { if( $data[ 0 ] -gt $data[ 1 ] ) { $data = $data[ 1, 0 ] } } $data } QuickSort 5,3,1,2,4 QuickSort 'e','c','a','b','d' QuickSort 0.5,0.3,0.1,0.2,0.4 $l = 100; QuickSort ( 1..$l | ForEach-Object { $Rand = New-Object Random }{ $Rand.Next( 0, $l - 1 ) } )Another solution
function quicksort($array) { $less, $equal, $greater = @(), @(), @() if( $array.Count -gt 1 ) { $pivot = $array[0] foreach( $x in $array) { if($x -lt $pivot) { $less += @($x) } elseif ($x -eq $pivot) { $equal += @($x)} else { $greater += @($x) } } $array = (@(quicksort $less) + @($equal) + @(quicksort $greater)) } $array } $array = @(60, 21, 19, 36, 63, 8, 100, 80, 3, 87, 11) "$(quicksort $array)"
The output is: 3 8 11 19 21 36 60 63 80 87 100Yet another solution
function quicksort($in) { $n = $in.count switch ($n) { 0 {} 1 { $in[0] } 2 { if ($in[0] -lt $in[1]) {$in[0], $in[1]} else {$in[1], $in[0]} } default { $pivot = $in | get-random $lt = $in | ? {$_ -lt $pivot} $eq = $in | ? {$_ -eq $pivot} $gt = $in | ? {$_ -gt $pivot} @(quicksort $lt) + @($eq) + @(quicksort $gt) } } }Prolog
qsort( [], [] ). qsort( [H|U], S ) :- splitBy(H, U, L, R), qsort(L, SL), qsort(R, SR), append(SL, [H|SR], S). % splitBy( H, U, LS, RS ) % True if LS = { L in U | L <= H }; RS = { R in U | R > H } splitBy( _, [], [], []). splitBy( H, [U|T], [U|LS], RS ) :- U =< H, splitBy(H, T, LS, RS). splitBy( H, [U|T], LS, [U|RS] ) :- U > H, splitBy(H, T, LS, RS).Python
def quick_sort(sequence): lesser = [] equal = [] greater = [] if len(sequence) <= 1: return sequence pivot = sequence[0] for element in sequence: if element < pivot: lesser.append(element) elif element > pivot: greater.append(element) else: equal.append(element) lesser = quick_sort(lesser) greater = quick_sort(greater) return lesser + equal + greater a = [4, 65, 2, -31, 0, 99, 83, 782, 1] a = quick_sort(a)
In a Haskell fashion --
def qsort(L): return (qsort([y for y in L[1:] if y < L[0]]) + [L[0]] + qsort([y for y in L[1:] if y >= L[0]])) if len(L) > 1 else L
More readable, but still using list comprehensions:
def qsort(list): if not list: return [] else: pivot = list[0] less = [x for x in list[1:] if x < pivot] more = [x for x in list[1:] if x >= pivot] return qsort(less) + [pivot] + qsort(more)
More correctly in some tests:
from random import * def qSort(a): if len(a) <= 1: return a else: q = choice(a) return qSort([elem for elem in a if elem < q]) + [q] * a.count(q) + qSort([elem for elem in a if elem > q])
def quickSort(a): if len(a) <= 1: return a else: less = [] more = [] pivot = choice(a) for i in a: if i < pivot: less.append(i) if i > pivot: more.append(i) less = quickSort(less) more = quickSort(more) return less + [pivot] * a.count(pivot) + more
Returning a new list:
def qsort(array): if len(array) < 2: return array head, *tail = array less = qsort([i for i in tail if i < head]) more = qsort([i for i in tail if i >= head]) return less + [head] + more
Sorting a list in place:
def quicksort(array): _quicksort(array, 0, len(array) - 1) def _quicksort(array, start, stop): if stop - start > 0: pivot, left, right = array[start], start, stop while left <= right: while array[left] < pivot: left += 1 while array[right] > pivot: right -= 1 if left <= right: array[left], array[right] = array[right], array[left] left += 1 right -= 1 _quicksort(array, start, right) _quicksort(array, left, stop)
Functional Style (no for or while loops, constants only):
def quicksort(unsorted_list): if len(unsorted_list) == 0: return [] pivot = unsorted_list[0] less = list(filter(lambda x: x < pivot, unsorted_list)) same = list(filter(lambda x: x == pivot, unsorted_list)) more = list(filter(lambda x: x > pivot, unsorted_list)) return quicksort(less) + same + quicksort(more)Qi
(define keep _ [] -> [] Pred [A|Rest] -> [A | (keep Pred Rest)] where (Pred A) Pred [_|Rest] -> (keep Pred Rest)) (define quicksort [] -> [] [A|R] -> (append (quicksort (keep (>= A) R)) [A] (quicksort (keep (< A) R)))) (quicksort [6 8 5 9 3 2 2 1 4 7])Quackery
Sort a nest of numbers.
[ stack ] is less ( --> s ) [ stack ] is same ( --> s ) [ stack ] is more ( --> s ) [ - -1 1 clamp 1+ ] is <=> ( n n --> n ) [ dup size 2 < if done [] less put [] same put [] more put behead swap witheach [ 2dup swap <=> [ table less same more ] gather ] same gather less take recurse same take join more take recurse join ] is quicksort ( [ --> [ ) [] 10 times [ i^ join ] 3 of dup echo cr quicksort echo cr
Output:
[ 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 ] [ 0 0 0 1 1 1 2 2 2 3 3 3 4 4 4 5 5 5 6 6 6 7 7 7 8 8 8 9 9 9 ]R
qsort <- function(v) { if ( length(v) > 1 ) { pivot <- (min(v) + max(v))/2.0 # Could also use pivot <- median(v) c(qsort(v[v < pivot]), v[v == pivot], qsort(v[v > pivot])) } else v } N <- 100 vs <- runif(N) system.time(u <- qsort(vs)) print(u)Racket
#lang racket (define (quicksort < l) (match l ['() '()] [(cons x xs) (let-values ([(xs-gte xs-lt) (partition (curry < x) xs)]) (append (quicksort < xs-lt) (list x) (quicksort < xs-gte)))]))
Examples
(quicksort < '(8 7 3 6 4 5 2)) ;returns '(2 3 4 5 6 7 8) (quicksort string<? '("Mergesort" "Quicksort" "Bubblesort")) ;returns '("Bubblesort" "Mergesort" "Quicksort")Raku
#| Recursive, single-thread, random pivot, single-pass, quicksort implementation multi quicksort(\a where a.elems < 2) { a } multi quicksort(\a, \pivot = a.pick) { my %prt{Order} is default([]) = a.classify: * cmp pivot; |samewith(%prt{Less}), |%prt{Same}, |samewith(%prt{More}) }concurrent implementation
The partitions can be sorted in parallel.
#| Recursive, parallel, random pivot, single-pass, quicksort implementation multi quicksort-parallel-naive(\a where a.elems < 2) { a } multi quicksort-parallel-naive(\a, \pivot = a.pick) { my %prt{Order} is default([]) = a.classify: * cmp pivot; my Promise $less = start { samewith(%prt{Less}) } my $more = samewith(%prt{More}); await $less andthen |$less.result, |%prt{Same}, |$more; }
Let's tune the parallel execution by applying a minimum batch size in order to spawn a new thread.
#| Recursive, parallel, batch tuned, single-pass, quicksort implementation sub quicksort-parallel(@a, $batch = 2**9) { return @a if @a.elems < 2; # separate unsorted input into Order Less, Same and More compared to a random $pivot my $pivot = @a.pick; my %prt{Order} is default([]) = @a.classify( * cmp $pivot ); # decide if we sort the Less partition on a new thread my $less = %prt{Less}.elems >= $batch ?? start { samewith(%prt{Less}, $batch) } !! samewith(%prt{Less}, $batch); # meanwhile use current thread for sorting the More partition my $more = samewith(%prt{More}, $batch); # if we went parallel, we need to await the result await $less andthen $less = $less.result if $less ~~ Promise; # concat all sorted partitions into a list and return |$less, |%prt{Same}, |$more; }testing
Let's run some tests.
say "x" x 10 ~ " Testing " ~ "x" x 10; use Test; my @functions-under-test = &quicksort, &quicksort-parallel-naive, &quicksort-parallel; my @testcases = () => (), <a>.List => <a>.List, <a a> => <a a>, ("b", "a", 3) => (3, "a", "b"), <h b a c d f e g> => <a b c d e f g h>, <a 🎮 3 z 4 🐧> => <a 🎮 3 z 4 🐧>.sort ; plan @testcases.elems * @functions-under-test.elems; for @functions-under-test -> &fun { say &fun.name; is-deeply &fun(.key), .value, .key ~ " => " ~ .value for @testcases; } done-testing;
xxxxxxxxxx Testing xxxxxxxxxx 1..18 quicksort ok 1 - => ok 2 - a => a ok 3 - a a => a a ok 4 - b a 3 => 3 a b ok 5 - h b a c d f e g => a b c d e f g h ok 6 - a 🎮 3 z 4 🐧 => 3 4 a z 🎮 🐧 quicksort-parallel-naive ok 7 - => ok 8 - a => a ok 9 - a a => a a ok 10 - b a 3 => 3 a b ok 11 - h b a c d f e g => a b c d e f g h ok 12 - a 🎮 3 z 4 🐧 => 3 4 a z 🎮 🐧 quicksort-parallel ok 13 - => ok 14 - a => a ok 15 - a a => a a ok 16 - b a 3 => 3 a b ok 17 - h b a c d f e g => a b c d e f g h ok 18 - a 🎮 3 z 4 🐧 => 3 4 a z 🎮 🐧benchmarking
and some benchmarking
say "x" x 11 ~ " Benchmarking " ~ "x" x 11; use Benchmark; my $runs = 5; my $elems = 10 * Kernel.cpu-cores * 2**10; my @unsorted of Str = ('a'..'z').roll(8).join xx $elems; my UInt $l-batch = 2**13; my UInt $m-batch = 2**11; my UInt $s-batch = 2**9; my UInt $t-batch = 2**7; say "elements: $elems, runs: $runs, cpu-cores: {Kernel.cpu-cores}, large/medium/small/tiny-batch: $l-batch/$m-batch/$s-batch/$t-batch"; my %results = timethese $runs, { single-thread => { quicksort(@unsorted) }, parallel-naive => { quicksort-parallel-naive(@unsorted) }, parallel-tiny-batch => { quicksort-parallel(@unsorted, $t-batch) }, parallel-small-batch => { quicksort-parallel(@unsorted, $s-batch) }, parallel-medium-batch => { quicksort-parallel(@unsorted, $m-batch) }, parallel-large-batch => { quicksort-parallel(@unsorted, $l-batch) }, }, :statistics; my @metrics = <mean median sd>; my $msg-row = "%.4f\t" x @metrics.elems ~ '%s'; say @metrics.join("\t"); for %results.kv -> $name, %m { say sprintf($msg-row, %m{@metrics}, $name); }
xxxxxxxxxxx Benchmarking xxxxxxxxxxx elements: 40960, runs: 5, cpu-cores: 4, large/medium/small/tiny-batch: 8192/2048/512/128 mean median sd 2.9503 2.8907 0.2071 parallel-small-batch 3.2054 3.1727 0.2078 parallel-tiny-batch 5.6524 5.0980 1.2628 parallel-naive 3.4717 3.3353 0.3622 parallel-medium-batch 4.6275 4.7793 0.4930 parallel-large-batch 6.5401 6.2832 0.5585 single-threadRed
Red [] ;;------------------------------- ;; we have to use function not func here, otherwise we'd have to define all "vars" as local... qsort: function [list][ ;;------------------------------- if 1 >= length? list [ return list ] left: copy [] right: copy [] eq: copy [] ;; "equal" pivot: list/2 ;; simply choose second element as pivot element foreach ele list [ case [ ele < pivot [ append left ele ] ele > pivot [ append right ele ] true [append eq ele ] ] ] ;; this is the last expression of the function, so coding "return" here is not necessary reduce [qsort left eq qsort right] ] ;; lets test the function with an array of 100k integers, range 1..1000 list: [] loop 100000 [append list random 1000] t0: now/time/precise ;; start timestamp qsort list ;; the return value (block) contains the sorted list, original list has not changed print ["time1: " now/time/precise - t0] ;; about 1.1 sec on my machine t0: now/time/precise sort list ;; just for fun time the builtin function also ( also implementation of quicksort ) print ["time2: " now/time/precise - t0]REXX version 1 quickSort
The Python code translates very well to ooRexx but here is a way to implement it in classic REXX as well.
This REXX version doesn't handle numbers with leading/trailing/embedded blanks, or textual values that have blanks (or whitespace) in them.
/*REXX*/ a = '4 65 2 -31 0 99 83 782 1' do i = 1 to words(a) queue word(a, i) end call quickSort parse pull item do queued() call charout ,item', ' parse pull item end say item exit quickSort: procedure /* In classic Rexx, arguments are passed by value, not by reference so stems cannot be passed as arguments nor used as return values. Putting their contents on the external data queue is a way to bypass this issue. */ /* construct the input stem */ arr.0 = queued() do i = 1 to arr.0 parse pull arr.i end less.0 = 0 pivotList.0 = 0 more.0 = 0 if arr.0 <= 1 then do if arr.0 = 1 then queue arr.1 return end else do pivot = arr.1 do i = 1 to arr.0 item = arr.i select when item < pivot then do j = less.0 + 1 less.j = item less.0 = j end when item > pivot then do j = more.0 + 1 more.j = item more.0 = j end otherwise j = pivotList.0 + 1 pivotList.j = item pivotList.0 = j end end end /* recursive call to sort the less. stem */ do i = 1 to less.0 queue less.i end if queued() > 0 then do call quickSort less.0 = queued() do i = 1 to less.0 parse pull less.i end end /* recursive call to sort the more. stem */ do i = 1 to more.0 queue more.i end if queued() > 0 then do call quickSort more.0 = queued() do i = 1 to more.0 parse pull more.i end end /* put the contents of all 3 stems on the queue in order */ do i = 1 to less.0 queue less.i end do i = 1 to pivotList.0 queue pivotList.i end do i = 1 to more.0 queue more.i end returnVersion 2 Elegant
A basic quicksort using the stack, but only for the pending partitions. Short and elegant.
Elegant: procedure expose stem. push 1 stem.0 do while queued() > 0 pull l r if l < r then do m = (l+r)%2; p = stem.m; i = l-1; j = r+1 do forever do until stem.j <= p j = j-1 end do until stem.i >= p i = i+1 end if i < j then do t = stem.i; stem.i = stem.j; stem.j = t end else leave end push l j; push j+1 r end end returnVersion 3 Recursive
Also a basic quicksort, but now using recursion as stated in the task. No stack usage.
Recursive: procedure expose stem. arg l r m = (l+r)%2; p = stem.m i = l; j = r do while i <= j do i = i while stem.i < p end do j = j by -1 while stem.j > p end if i <= j then do t = stem.i; stem.i = stem.j; stem.j = t i = i+1; j = j-1 end end if l < j then call Recursive l j if i < r then call Recursive i r returnVersion 6 Optimized
The fastest. As in Version 1, no recursion and no stack usage. The pending partitions are kept in small stems. For partitions < 11 items, a selection sort is employed. Pivot choice is optimized to prevent 'worst case' scenarios.
Optimized: procedure expose stem. n = stem.0; s = 1; sl.1 = 1; sr.1 = n do until s = 0 l = sl.s; r = sr.s; s = s-1 do until l >= r if r-l < 11 then do do i = l+1 to r a = stem.i do j=i-1 by -1 to l while stem.j > a k = j+1; stem.k = stem.j end k = j+1; stem.k = a end if s = 0 then leave l = sl.s; r = sr.s; s = s-1 end else do m = (l+r)%2 if stem.l > stem.m then do t = stem.l; stem.l = stem.m; stem.m = t end if stem.l > stem.r then do t = stem.l; stem.l = stem.r; stem.r = t end if stem.m > stem.r then do t = stem.m; stem.m = stem.r; stem.r = t end i = l; j = r; p = stem.m do until i > j do i = i while stem.i < p end do j = j by -1 while stem.j > p end if i <= j then do t = stem.i; stem.i = stem.j; stem.j = t i = i+1; j = j-1 end end if j-l < r-i then do if i < r then do s = s+1; sl.s = i; sr.s = r end r = j end else do if l < j then do s = s+1; sl.s = l; sr.s = j end l = i end end end end returnTiming all versions
Using following program, with all versions copied in.
include Settings say 'QUICKSORT - 4 Mar 2025' say version say numeric digits 9 arg n v if n = '' then n = 10 if v = '' then v = 1 show = (n > 0); n = Abs(n) say 'Timing Version' v 'for' n 'random numbers' call Generate if show then call ShowSave if v = 0 | v = 1 then do call Time 'r'; call Save2Stack; say 'Save2Stack' format(time('e'),3,3) 'seconds' call Time 'r'; call Quicksort; say 'Quicksort ' format(time('e'),3,3) 'seconds' call Time 'r'; call Stack2Stem; say 'Stack2Stem' format(time('e'),3,3) 'seconds' if show then call ShowStem end if v = 0 | v = 2 then do call Save2Stem call Time 'r'; call Elegant; say 'Elegant' format(time('e'),3,3) 'seconds' if show then call ShowStem end if v = 0 | v = 3 then do call Save2Stem call Time 'r'; call Recursive 1 n; say 'Recursive' format(time('e'),3,3) 'seconds' if show then call ShowStem end if v = 0 | v = 4 then do call Save2Stem call Time 'r'; call Optimized; say 'Optimized' format(time('e'),3,3) 'seconds' if show then call ShowStem end say exit Generate: do x = 1 to n save.x = 10000*Random(0,9999)+Random(0,9999) end save.0 = n return ShowSave: do x = 1 to 5 say x save.x end do x = n-4 to n say x save.x end say return ShowStem: do x = 1 to 5 say x stem.x end do x = n-4 to n say x stem.x end say return Save2Stem: do x = 0 to n stem.x = save.x end return Save2Stack: do x = 1 to n queue save.x end return Quicksort: procedure arr.0 = queued() do i = 1 to arr.0 parse pull arr.i end less.0 = 0 pivotList.0 = 0 more.0 = 0 if arr.0 <= 1 then do if arr.0 = 1 then queue arr.1 return end else do pivot = arr.1 do i = 1 to arr.0 item = arr.i select when item < pivot then do j = less.0 + 1 less.j = item less.0 = j end when item > pivot then do j = more.0 + 1 more.j = item more.0 = j end otherwise j = pivotList.0 + 1 pivotList.j = item pivotList.0 = j end end end do i = 1 to less.0 queue less.i end if queued() > 0 then do call quickSort less.0 = queued() do i = 1 to less.0 parse pull less.i end end do i = 1 to more.0 queue more.i end if queued() > 0 then do call quickSort more.0 = queued() do i = 1 to more.0 parse pull more.i end end do i = 1 to less.0 queue less.i end do i = 1 to pivotList.0 queue pivotList.i end do i = 1 to more.0 queue more.i end return Stack2Stem: do x = 1 to n parse pull stem.x end return Elegant: procedure expose stem. push 1 stem.0 do while queued() > 0 pull l r if l < r then do m = (l+r)%2; p = stem.m; i = l-1; j = r+1 do forever do until stem.j <= p j = j-1 end do until stem.i >= p i = i+1 end if i < j then do t = stem.i; stem.i = stem.j; stem.j = t end else leave end push l j; push j+1 r end end return Recursive: procedure expose stem. arg l r m = (l+r)%2; p = stem.m i = l; j = r do while i <= j do i = i while stem.i < p end do j = j by -1 while stem.j > p end if i <= j then do t = stem.i; stem.i = stem.j; stem.j = t i = i+1; j = j-1 end end if l < j then call Recursive l j if i < r then call Recursive i r return Optimized: procedure expose stem. n = stem.0; s = 1; sl.1 = 1; sr.1 = n do until s = 0 l = sl.s; r = sr.s; s = s-1 do until l >= r if r-l < 20 then do do i = l+1 to r a = stem.i do j=i-1 by -1 to l while stem.j > a k = j+1; stem.k = stem.j end k = j+1; stem.k = a end if s = 0 then leave l = sl.s; r = sr.s; s = s-1 end else do m = (l+r)%2 if stem.l > stem.m then do t = stem.l; stem.l = stem.m; stem.m = t end if stem.l > stem.r then do t = stem.l; stem.l = stem.r; stem.r = t end if stem.m > stem.r then do t = stem.m; stem.m = stem.r; stem.r = t end i = l; j = r; p = stem.m do until i > j do i = i while stem.i < p end do j = j by -1 while stem.j > p end if i <= j then do t = stem.i; stem.i = stem.j; stem.j = t i = i+1; j = j-1 end end if j-l < r-i then do if i < r then do s = s+1; sl.s = i; sr.s = r end r = j end else do if l < j then do s = s+1; sl.s = l; sr.s = j end l = i end end end end return include Abend
Running under Regina with some values for n and v.
QUICKSORT - 4 Mar 2025 REXX-Regina_3.9.6(MT) 5.00 29 Apr 2024 Timing Version 0 for 1000 random numbers 1 1301504 2 38896302 3 64465028 4 45809725 5 15575175 996 63419779 997 64807001 998 37579553 999 48391176 1000 10331477 Save2Stack 0.001 seconds Quicksort 0.014 seconds Stack2Stem 0.000 seconds 1 61491 2 269651 3 273193 4 412881 5 502890 996 99166237 997 99503994 998 99694640 999 99764115 1000 99892071 Elegant 0.005 seconds 1 61491 2 269651 3 273193 4 412881 5 502890 996 99166237 997 99503994 998 99694640 999 99764115 1000 99892071 Recursive 0.005 seconds 1 61491 2 269651 3 273193 4 412881 5 502890 996 99166237 997 99503994 998 99694640 999 99764115 1000 99892071 Optimized 0.004 seconds 1 61491 2 269651 3 273193 4 412881 5 502890 996 99166237 997 99503994 998 99694640 999 99764115 1000 99892071 QUICKSORT - 4 Mar 2025 REXX-Regina_3.9.6(MT) 5.00 29 Apr 2024 Timing Version 0 for 10000 random numbers 1 45804118 2 58006939 3 99056246 4 19385685 5 20501425 9996 353332 9997 55031534 9998 59163614 9999 53889037 10000 50007918 Save2Stack 0.002 seconds Quicksort 0.182 seconds Stack2Stem 0.001 seconds 1 11640 2 11650 3 33340 4 38842 5 49723 9996 99969708 9997 99978183 9998 99982926 9999 99990755 10000 99994460 Elegant 0.060 seconds 1 11640 2 11650 3 33340 4 38842 5 49723 9996 99969708 9997 99978183 9998 99982926 9999 99990755 10000 99994460 Recursive 0.064 seconds 1 11640 2 11650 3 33340 4 38842 5 49723 9996 99969708 9997 99978183 9998 99982926 9999 99990755 10000 99994460 Optimized 0.048 seconds 1 11640 2 11650 3 33340 4 38842 5 49723 9996 99969708 9997 99978183 9998 99982926 9999 99990755 10000 99994460 QUICKSORT - 4 Mar 2025 REXX-Regina_3.9.6(MT) 5.00 29 Apr 2024 Timing Version 0 for 100000 random numbers 1 79656070 2 53147678 3 33198079 4 73711621 5 25030588 99996 95991033 99997 91754003 99998 96554128 99999 17561510 100000 90831043 Save2Stack 0.012 seconds Quicksort 2.604 seconds Stack2Stem 0.018 seconds 1 1655 2 2312 3 2996 4 5234 5 5910 99996 99996845 99997 99997333 99998 99998029 99999 99998520 100000 99998624 Elegant 0.831 seconds 1 1655 2 2312 3 2996 4 5234 5 5910 99996 99996845 99997 99997333 99998 99998029 99999 99998520 100000 99998624 Recursive 0.820 seconds 1 1655 2 2312 3 2996 4 5234 5 5910 99996 99996845 99997 99997333 99998 99998029 99999 99998520 100000 99998624 Optimized 0.624 seconds 1 1655 2 2312 3 2996 4 5234 5 5910 99996 99996845 99997 99997333 99998 99998029 99999 99998520 100000 99998624
And the same for ooRexx.
QUICKSORT - 4 Mar 2025 REXX-ooRexx_5.0.0(MT)_64-bit 6.05 23 Dec 2022 Timing Version 0 for 1000 random numbers 1 12348318 2 21439648 3 53366128 4 74109613 5 66433021 996 15294386 997 41393496 998 98896596 999 76044992 1000 36705449 Save2Stack 0.016 seconds Quicksort 0.874 seconds Stack2Stem 0.032 seconds 1 86063 2 244756 3 543315 4 573109 5 1007248 996 99303638 997 99361501 998 99490621 999 99607308 1000 99915213 Elegant 0.097 seconds 1 86063 2 244756 3 543315 4 573109 5 1007248 996 99303638 997 99361501 998 99490621 999 99607308 1000 99915213 Recursive 0.016 seconds 1 86063 2 244756 3 543315 4 573109 5 1007248 996 99303638 997 99361501 998 99490621 999 99607308 1000 99915213 Optimized 0.000 seconds 1 86063 2 244756 3 543315 4 573109 5 1007248 996 99303638 997 99361501 998 99490621 999 99607308 1000 99915213 QUICKSORT - 4 Mar 2025 REXX-ooRexx_5.0.0(MT)_64-bit 6.05 23 Dec 2022 Timing Version 0 for 10000 random numbers 1 18751559 2 9664983 3 6520871 4 81853537 5 89290461 9996 15858744 9997 68183578 9998 35786265 9999 56447804 10000 79587338 Save2Stack 0.203 seconds Quicksort 12.867 seconds Stack2Stem 0.219 seconds 1 24406 2 29380 3 33215 4 41202 5 49899 9996 99934267 9997 99965563 9998 99969701 9999 99975853 10000 99981523 Elegant 1.218 seconds 1 24406 2 29380 3 33215 4 41202 5 49899 9996 99934267 9997 99965563 9998 99969701 9999 99975853 10000 99981523 Recursive 0.063 seconds 1 24406 2 29380 3 33215 4 41202 5 49899 9996 99934267 9997 99965563 9998 99969701 9999 99975853 10000 99981523 Optimized 0.047 seconds 1 24406 2 29380 3 33215 4 41202 5 49899 9996 99934267 9997 99965563 9998 99969701 9999 99975853 10000 99981523 QUICKSORT - 4 Mar 2025 REXX-ooRexx_5.0.0(MT)_64-bit 6.05 23 Dec 2022 Timing Version 0 for 100000 random numbers 1 14248584 2 45991690 3 89316579 4 84248840 5 12197638 99996 37141859 99997 969474 99998 38567819 99999 51328048 100000 15192855 Save2Stack 1.890 seconds Quicksort 234.253 seconds Stack2Stem 1.906 seconds 1 204 2 2240 3 3097 4 3636 5 7776 99996 99996524 99997 99996951 99998 99998955 99999 99999284 100000 99999411 Elegant 12.473 seconds 1 204 2 2240 3 3097 4 3636 5 7776 99996 99996524 99997 99996951 99998 99998955 99999 99999284 100000 99999411 Recursive 1.047 seconds 1 204 2 2240 3 3097 4 3636 5 7776 99996 99996524 99997 99996951 99998 99998955 99999 99999284 100000 99999411 Optimized 0.843 seconds 1 204 2 2240 3 3097 4 3636 5 7776 99996 99996524 99997 99996951 99998 99998955 99999 99999284 100000 99999411
$ENTRY Go { , 7 6 5 9 8 4 3 1 2 0: e.Arr = <Prout e.Arr> <Prout <Sort e.Arr>>; }; Sort { = ; s.N = s.N; s.Pivot e.X = <Sort <Filter s.Pivot '-' e.X>> <Filter s.Pivot '=' e.X> s.Pivot <Sort <Filter s.Pivot '+' e.X>>; }; Filter { s.N s.Comp = ; s.N s.Comp s.I e.List, <Compare s.I s.N>: { s.Comp = s.I <Filter s.N s.Comp e.List>; s.X = <Filter s.N s.Comp e.List>; }; };
7 6 5 9 8 4 3 1 2 0 0 1 2 3 4 5 6 7 8 9Ring
# Project : Sorting algorithms/Quicksort test = [4, 65, 2, -31, 0, 99, 2, 83, 782, 1] see "before sort:" + nl showarray(test) quicksort(test, 1, 10) see "after sort:" + nl showarray(test) func quicksort(a, s, n) if n < 2 return ok t = s + n - 1 l = s r = t p = a[floor((l + r) / 2)] while l <= r while a[l] < p l = l + 1 end while a[r] > p r = r - 1 end if l <= r temp = a[l] a[l] = a[r] a[r] = temp l = l + 1 r = r - 1 ok end if s < r quicksort(a, s, r - s + 1) ok if l < t quicksort(a, l, t - l + 1 ) ok func showarray(vect) svect = "" for n = 1 to len(vect) svect = svect + vect[n] + " " next svect = left(svect, len(svect) - 1) see svect + nl
Output:
before sort: 4 65 2 -31 0 99 2 83 782 1 after sort: -31 0 1 2 2 4 65 83 99 782RPL
≪ DUP SIZE → size ≪ IF size 1 > THEN DUP size 2 / CEIL GET { } DUP DUP → pivot less equal greater ≪ 1 size FOR j DUP j GET pivot CASE DUP2 < THEN DROP 'less' STO+ END DUP2 == THEN DROP 'equal' STO+ END DROP 'greater' STO+ END NEXT DROP less QSORT greater QSORT equal SWAP + + ≫ END ≫ ≫ 'QSORT' STORuby
class Array def quick_sort return self if length <= 1 pivot = self[0] less, greatereq = self[1..-1].partition { |x| x < pivot } less.quick_sort + [pivot] + greatereq.quick_sort end end
or
class Array def quick_sort return self if length <= 1 pivot = sample group = group_by{ |x| x <=> pivot } group.default = [] group[-1].quick_sort + group[0] + group[1].quick_sort end end
or functionally
class Array def quick_sort h, *t = self h ? t.partition { |e| e < h }.inject { |l, r| l.quick_sort + [h] + r.quick_sort } : [] end endRust
fn main() { println!("Sort numbers in descending order"); let mut numbers = [4, 65, 2, -31, 0, 99, 2, 83, 782, 1]; println!("Before: {:?}", numbers); quick_sort(&mut numbers, &|x,y| x > y); println!("After: {:?}\n", numbers); println!("Sort strings alphabetically"); let mut strings = ["beach", "hotel", "airplane", "car", "house", "art"]; println!("Before: {:?}", strings); quick_sort(&mut strings, &|x,y| x < y); println!("After: {:?}\n", strings); println!("Sort strings by length"); println!("Before: {:?}", strings); quick_sort(&mut strings, &|x,y| x.len() < y.len()); println!("After: {:?}", strings); } fn quick_sort<T,F>(v: &mut [T], f: &F) where F: Fn(&T,&T) -> bool { let len = v.len(); if len >= 2 { let pivot_index = partition(v, f); quick_sort(&mut v[0..pivot_index], f); quick_sort(&mut v[pivot_index + 1..len], f); } } fn partition<T,F>(v: &mut [T], f: &F) -> usize where F: Fn(&T,&T) -> bool { let len = v.len(); let pivot_index = len / 2; let last_index = len - 1; v.swap(pivot_index, last_index); let mut store_index = 0; for i in 0..last_index { if f(&v[i], &v[last_index]) { v.swap(i, store_index); store_index += 1; } } v.swap(store_index, len - 1); store_index }
Sort numbers in descending order Before: [4, 65, 2, -31, 0, 99, 2, 83, 782, 1] After: [782, 99, 83, 65, 4, 2, 2, 1, 0, -31] Sort strings alphabetically Before: ["beach", "hotel", "airplane", "car", "house", "art"] After: ["airplane", "art", "beach", "car", "hotel", "house"] Sort strings by length Before: ["airplane", "art", "beach", "car", "hotel", "house"] After: ["car", "art", "house", "hotel", "beach", "airplane"]
Or, using functional style (slower than the imperative style but faster than functional style in other languages):
fn main() { let numbers = [4, 65, 2, -31, 0, 99, 2, 83, 782, 1]; println!("{:?}\n", quick_sort(numbers.iter())); } fn quick_sort<T, E>(mut v: T) -> Vec<E> where T: Iterator<Item = E>, E: PartialOrd, { match v.next() { None => Vec::new(), Some(pivot) => { let (lower, higher): (Vec<_>, Vec<_>) = v.partition(|it| it < &pivot); let lower = quick_sort(lower.into_iter()); let higher = quick_sort(higher.into_iter()); lower.into_iter() .chain(core::iter::once(pivot)) .chain(higher.into_iter()) .collect() } } }
By the way this implementation needs only O(n) memory because the partition(...) call already "consumes" v. This means that the memory of v will be freed here, before the recursive calls to quick_sort(...). If we tried to use v later, we would get a compilation error.
SASLCopied from SASL manual, Appendix II, solution (2)(b)
DEF || this rather nice solution is due to Silvio Meira sort () = () sort (a : x) = sort {b <- x; b <= a } ++ a : sort { b <- x; b>a} ?Sather
class SORT{T < $IS_LT{T}} is private afilter(a:ARRAY{T}, cmp:ROUT{T,T}:BOOL, p:T):ARRAY{T} is filtered ::= #ARRAY{T}; loop v ::= a.elt!; if cmp.call(v, p) then filtered := filtered.append(|v|); end; end; return filtered; end; private mlt(a, b:T):BOOL is return a < b; end; private mgt(a, b:T):BOOL is return a > b; end; quick_sort(inout a:ARRAY{T}) is if a.size < 2 then return; end; pivot ::= a.median; left:ARRAY{T} := afilter(a, bind(mlt(_,_)), pivot); right:ARRAY{T} := afilter(a, bind(mgt(_,_)), pivot); quick_sort(inout left); quick_sort(inout right); res ::= #ARRAY{T}; res := res.append(left, |pivot|, right); a := res; end; end;
class MAIN is main is a:ARRAY{INT} := |10, 9, 8, 7, 6, -10, 5, 4, 656, -11|; b ::= a.copy; SORT{INT}::quick_sort(inout a); #OUT + a + "\n" + b.sort + "\n"; end; end;
The ARRAY class has a builtin sorting method, which is quicksort (but under certain condition an insertion sort is used instead), exactly quicksort_range
; this implementation is original.
What follows is a progression on genericity here.
First, a quick sort of a list of integers:
def sort(xs: List[Int]): List[Int] = xs match { case Nil => Nil case head :: tail => val (less, notLess) = tail.partition(_ < head) // Arbitrarily partition list in two sort(less) ++ (head :: sort(notLess)) // Sort each half }
Next, a quick sort of a list of some type T, given a lessThan function:
def sort[T](xs: List[T], lessThan: (T, T) => Boolean): List[T] = xs match { case Nil => Nil case x :: xx => val (lo, hi) = xx.partition(lessThan(_, x)) sort(lo, lessThan) ++ (x :: sort(hi, lessThan)) }
To take advantage of known orderings, a quick sort of a list of some type T, for which exists an implicit (or explicit) Ordering[T]:
def sort[T](xs: List[T])(implicit ord: Ordering[T]): List[T] = xs match { case Nil => Nil case x :: xx => val (lo, hi) = xx.partition(ord.lt(_, x)) sort[T](lo) ++ (x :: sort[T](hi)) }
That last one could have worked with Ordering, but Ordering is Java, and doesn't have the less than operator. Ordered is Scala-specific, and provides it.
def sort[T <: Ordered[T]](xs: List[T]): List[T] = xs match { case Nil => Nil case x :: xx => val (lo, hi) = xx.partition(_ < x) sort(lo) ++ (x :: sort(hi)) }
What hasn't changed in all these examples is ordering a list. It is possible to write a generic quicksort in Scala, which will order any kind of collection. To do so, however, requires that the type of the collection, itself, be made a parameter to the function. Let's see it below, and then remark upon it:
def sort[T, C[T] <: scala.collection.TraversableLike[T, C[T]]] (xs: C[T]) (implicit ord: scala.math.Ordering[T], cbf: scala.collection.generic.CanBuildFrom[C[T], T, C[T]]): C[T] = { // Some collection types can't pattern match if (xs.isEmpty) { xs } else { val (lo, hi) = xs.tail.partition(ord.lt(_, xs.head)) val b = cbf() b.sizeHint(xs.size) b ++= sort(lo) b += xs.head b ++= sort(hi) b.result() } }
The type of our collection is "C[T]", and, by providing C[T] as a type parameter to TraversableLike, we ensure C[T] is capable of returning instances of type C[T]. Traversable is the base type of all collections, and TraversableLike is a trait which contains the implementation of most Traversable methods.
We need another parameter, though, which is a factory capable of building a C[T] collection. That is being passed implicitly, so callers to this method do not need to provide them, as the collection they are using should already provide one as such implicitly. Because we need that implicitly, then we need to ask for the "T => Ordering[T]" as well, as the "T <: Ordered[T]" which provides it cannot be used in conjunction with implicit parameters.
The body of the function is from the list variant, since many of the Traversable collection types don't support pattern matching, "+:" or "::".
Scheme List quicksort(define (split-by l p k) (let loop ((low '()) (high '()) (l l)) (cond ((null? l) (k low high)) ((p (car l)) (loop low (cons (car l) high) (cdr l))) (else (loop (cons (car l) low) high (cdr l)))))) (define (quicksort l gt?) (if (null? l) '() (split-by (cdr l) (lambda (x) (gt? x (car l))) (lambda (low high) (append (quicksort low gt?) (list (car l)) (quicksort high gt?)))))) (quicksort '(1 3 5 7 9 8 6 4 2) >)
With srfi-1:
(define (quicksort l gt?) (if (null? l) '() (append (quicksort (filter (lambda (x) (gt? (car l) x)) (cdr l)) gt?) (list (car l)) (quicksort (filter (lambda (x) (not (gt? (car l) x))) (cdr l)) gt?)))) (quicksort '(1 3 5 7 9 8 6 4 2) >)Vector quicksort (in place)
For CHICKEN:
;;;------------------------------------------------------------------- ;;; ;;; Quicksort in R7RS Scheme, working in-place on vectors (that is, ;;; arrays). I closely follow the "better quicksort algorithm" ;;; pseudocode, and thus the code is more "procedural" than ;;; "functional". ;;; ;;; I use a random pivot. If you can generate a random number quickly, ;;; this is a good method, but for this demonstration I have taken a ;;; fast linear congruential generator and made it brutally slow. It's ;;; just a demonstration. :) ;;; (import (scheme base)) (import (scheme case-lambda)) (import (scheme write)) ;;;------------------------------------------------------------------- ;;; ;;; Add "while" loops to the language. ;;; (define-syntax while (syntax-rules () ((_ pred? body ...) (let loop () (when pred? (begin body ...) (loop)))))) ;;;------------------------------------------------------------------- ;;; ;;; In-place quicksort. ;;; (define vector-quicksort! (case-lambda ;; Use a default pivot selector. ((<? vec) ;; Random pivot. (vector-quicksort! (lambda (vec i-first i-last) (vector-ref vec (randint i-first i-last))) <? vec)) ;; Specify a pivot selector. ((pivot-select <? vec) ;; ;; The recursion: ;; (let quicksort! ((i-first 0) (i-last (- (vector-length vec) 1))) (let ((n (- i-last i-first -1))) (when (> n 1) (let* ((pivot (pivot-select vec i-first i-last))) (let ((left i-first) (right i-last)) (while (<= left right) (while (< (vector-ref vec left) pivot) (set! left (+ left 1))) (while (> (vector-ref vec right) pivot) (set! right (- right 1))) (when (<= left right) (let ((lft (vector-ref vec left)) (rgt (vector-ref vec right))) (vector-set! vec left rgt) (vector-set! vec right lft) (set! left (+ left 1)) (set! right (- right 1))))) (quicksort! i-first right) (quicksort! left i-last))))))))) ;;;------------------------------------------------------------------- ;;; ;;; A simple linear congruential generator, attributed by ;;; https://en.wikipedia.org/w/index.php?title=Linear_congruential_generator&oldid=1083800601 ;;; to glibc and GCC. No attempt has been made to optimize this code. ;;; (define seed 1) (define two**31 (expt 2 31)) (define (random-integer) (let* ((s0 seed) (s1 (truncate-remainder (+ (* 1103515245 s0) 12345) two**31))) (set! seed s1) s0)) (define randint (case-lambda ((n) (truncate-remainder (random-integer) n)) ((i-first i-last) (+ i-first (randint (- i-last i-first -1)))))) ;;;------------------------------------------------------------------- ;;; ;;; A demonstration of in-place vector quicksort. ;;; (define vec1 (vector-copy #(60 53 100 72 19 67 14 31 4 1 5 9 2 6 5 3 5 8 28 9 95 22 67 55 20 41 42 29 20 74 39))) (vector-quicksort! < vec1) (write vec1) (newline) ;;;-------------------------------------------------------------------
$ gosh vector-quicksort.scm #(1 2 3 4 5 5 5 6 8 9 9 14 19 20 20 22 28 29 31 39 41 42 53 55 60 67 67 72 74 95 100)Seed7
const proc: quickSort (inout array elemType: arr, in integer: left, in integer: right) is func local var elemType: compare_elem is elemType.value; var integer: less_idx is 0; var integer: greater_idx is 0; var elemType: help is elemType.value; begin if right > left then compare_elem := arr[right]; less_idx := pred(left); greater_idx := right; repeat repeat incr(less_idx); until arr[less_idx] >= compare_elem; repeat decr(greater_idx); until arr[greater_idx] <= compare_elem or greater_idx = left; if less_idx < greater_idx then help := arr[less_idx]; arr[less_idx] := arr[greater_idx]; arr[greater_idx] := help; end if; until less_idx >= greater_idx; arr[right] := arr[less_idx]; arr[less_idx] := compare_elem; quickSort(arr, left, pred(less_idx)); quickSort(arr, succ(less_idx), right); end if; end func; const proc: quickSort (inout array elemType: arr) is func begin quickSort(arr, 1, length(arr)); end func;
Original source: [2]
SETLIn-place sort (looks much the same as the C version)
a := [2,5,8,7,0,9,1,3,6,4]; qsort(a); print(a); proc qsort(rw a); if #a > 1 then pivot := a(#a div 2 + 1); l := 1; r := #a; (while l < r) (while a(l) < pivot) l +:= 1; end; (while a(r) > pivot) r -:= 1; end; swap(a(l), a(r)); end; qsort(a(1..l-1)); qsort(a(r+1..#a)); end if; end proc; proc swap(rw x, rw y); [y,x] := [x,y]; end proc;
Copying sort using comprehensions:
a := [2,5,8,7,0,9,1,3,6,4]; print(qsort(a)); proc qsort(a); if #a > 1 then pivot := a(#a div 2 + 1); a := qsort([x in a | x < pivot]) + [x in a | x = pivot] + qsort([x in a | x > pivot]); end if; return a; end proc;Sidef
func quicksort (a) { a.len < 2 && return(a); var p = a.pop_rand; # to avoid the worst cases __FUNC__(a.grep{ .< p}) + [p] + __FUNC__(a.grep{ .>= p}); }Simula
PROCEDURE QUICKSORT(A); REAL ARRAY A; BEGIN PROCEDURE QS(A, FIRST, LAST); REAL ARRAY A; INTEGER FIRST, LAST; BEGIN INTEGER LEFT, RIGHT; LEFT := FIRST; RIGHT := LAST; IF RIGHT - LEFT + 1 > 1 THEN BEGIN REAL PIVOT; PIVOT := A((LEFT + RIGHT) // 2); WHILE LEFT <= RIGHT DO BEGIN WHILE A(LEFT) < PIVOT DO LEFT := LEFT + 1; WHILE A(RIGHT) > PIVOT DO RIGHT := RIGHT - 1; IF LEFT <= RIGHT THEN BEGIN REAL SWAP; SWAP := A(LEFT); A(LEFT) := A(RIGHT); A(RIGHT) := SWAP; LEFT := LEFT + 1; RIGHT := RIGHT - 1; END; END; QS(A, FIRST, RIGHT); QS(A, LEFT, LAST); END; END QS; QS(A, LOWERBOUND(A, 1), UPPERBOUND(A, 1)); END QUICKSORT;Standard ML
fun quicksort [] = [] | quicksort (x::xs) = let val (left, right) = List.partition (fn y => y<x) xs in quicksort left @ [x] @ quicksort right end
Solution 2:
Without using List.partition
fun par_helper([], x, l, r) = (l, r) | par_helper(h::t, x, l, r) = if h <= x then par_helper(t, x, l @ [h], r) else par_helper(t, x, l, r @ [h]); fun par(l, x) = par_helper(l, x, [], []); fun quicksort [] = [] | quicksort (h::t) = let val (left, right) = par(t, h) in quicksort left @ [h] @ quicksort right end;Swift
func quicksort<T where T : Comparable>(inout elements: [T], range: Range<Int>) { if (range.endIndex - range.startIndex > 1) { let pivotIndex = partition(&elements, range) quicksort(&elements, range.startIndex ..< pivotIndex) quicksort(&elements, pivotIndex+1 ..< range.endIndex) } } func quicksort<T where T : Comparable>(inout elements: [T]) { quicksort(&elements, indices(elements)) }Symsyn
x : 23 : 15 : 99 : 146 : 3 : 66 : 71 : 5 : 23 : 73 : 19 quicksort param l r l i r j ((l+r) shr 1) k x.k pivot repeat if pivot > x.i + cmp + i goif endif if pivot < x.j + cmp - j goif endif if i <= j swap x.i x.j - j + i endif if i <= j go repeat endif if l < j save l r i j call quicksort l j restore l r i j endif if i < r save l r i j call quicksort i r restore l r i j endif return start ' original values : ' $r call showvalues call quicksort 0 10 ' sorted values : ' $r call showvalues stop showvalues $s i if i <= 10 "$s ' ' x.i ' '" $s + i goif endif " $r $s " [] returnTailspin
Simple recursive quicksort:
templates quicksort @: []; $ -> # when <[](2..)> do def pivot: $(1); [ [ $(2..last)... -> \( when <..$pivot> do $ ! otherwise ..|@quicksort: $; \)] -> quicksort..., $pivot, $@ -> quicksort... ] ! otherwise $ ! end quicksort [4,5,3,8,1,2,6,7,9,8,5] -> quicksort -> !OUT::write
In v0.5 recursion must be done internally on the matchers, so we need a separate partition function
quicksort templates partition templates @ set []; pivot is $(1); [$(2..)... -> #]! $pivot ! $@ ! when <|..$pivot> do $ ! otherwise ..|@ set $; end partition [$ -> #] ! when <|[](1..)> do $ -> partition -> # ! when <~|[]> do $ ! end quicksort [4,5,3,8,1,2,6,7,9,8,5] -> quicksort !
In place:
templates quicksort templates partial def first: $(1); def last: $(2); def pivot: $@quicksort($first); @: $(1) + 1; $(2) -> # when <..~$@> do def limit: $; @quicksort($first): $@quicksort($limit); @quicksort($limit): $pivot; [ $first, $limit - 1 ] ! [ $limit + 1, $last ] ! when <?($@quicksort($) <$pivot~..>)> do $ - 1 -> # when <?($@quicksort($@) <..$pivot>)> do @: $@ + 1; $ -> # otherwise def temp: $@quicksort($@); @quicksort($@): $@quicksort($); @quicksort($): $temp; @: $@ + 1; $ - 1 -> # end partial @: $; [1, $@::length] -> # $@ ! when <?($(1) <..~$(2)>)> do $ -> partial -> # end quicksort [4,5,3,8,1,2,6,7,9,8,5] -> quicksort -> !OUT::write
v0.5
quicksort templates partial templates first is $(1); last is $(2); pivot is $@quicksort($first); @ set $first + 1; $last -> # ! when <|..~$@> do limit is $; @quicksort($first) set $@quicksort($limit); @quicksort($limit) set $pivot; [ $first, $limit - 1 ] ! [ $limit + 1, $last ] ! when <|?($@quicksort($) matches <|$pivot~..>)> do $ - 1 -> # ! when <|?($@quicksort($@) matches <|..$pivot>)> do @ set $@ + 1; $ -> # ! otherwise temp is $@quicksort($@); @quicksort($@) set $@quicksort($); @quicksort($) set $temp; @ set $@ + 1; $ - 1 -> # ! end partial @ set $; [1, $@::length] -> !# $@ ! when <|?($(1) matches <|..~$(2)>)> do $ -> partial -> !# end quicksort [4,5,3,8,1,2,6,7,9,8,5] -> quicksort !Tcl
package require Tcl 8.5 proc quicksort {m} { if {[llength $m] <= 1} { return $m } set pivot [lindex $m 0] set less [set equal [set greater [list]]] foreach x $m { lappend [expr {$x < $pivot ? "less" : $x > $pivot ? "greater" : "equal"}] $x } return [concat [quicksort $less] $equal [quicksort $greater]] } puts [quicksort {8 6 4 2 1 3 5 7 9}] ;# => 1 2 3 4 5 6 7 8 9TypeScript
/** Generic quicksort function using typescript generics. Follows quicksort as done in CLRS. */ export type Comparator<T> = (o1: T, o2: T) => number; export function quickSort<T>(array: T[], compare: Comparator<T>) { if (array.length <= 1 || array == null) { return; } sort(array, compare, 0, array.length - 1); } function sort<T>( array: T[], compare: Comparator<T>, low: number, high: number) { if (low < high) { const partIndex = partition(array, compare, low, high); sort(array, compare, low, partIndex - 1); sort(array, compare, partIndex + 1, high); } } function partition<T>( array: T[], compare: Comparator<T>, low: number, high: number): number { const pivot: T = array[high]; let i: number = low - 1; for (let j = low; j <= high - 1; j++) { if (compare(array[j], pivot) == -1) { i = i + 1; swap(array, i, j) } } if (compare(array[high], array[i + 1]) == -1) { swap(array, i + 1, high); } return i + 1; } function swap<T>(array: T[], i: number, j: number) { const newJ: T = array[i]; array[i] = array[j]; array[j] = newJ; } export function testQuickSort(): void { function numberComparator(o1: number, o2: number): number { if (o1 < o2) { return -1; } else if (o1 == o2) { return 0; } return 1; } let tests: number[][] = [ [], [1], [2, 1], [-1, 2, -3], [3, 16, 8, -5, 6, 4], [1, 2, 3, 4, 5, 6], [1, 2, 3, 4, 5] ]; for (let testArray of tests) { quickSort(testArray, numberComparator); console.log(testArray); } }UnixPipes
split() { (while read n ; do test $1 -gt $n && echo $n > $2 || echo $n > $3 done) } qsort() { (read p; test -n "$p" && ( lc="1.$1" ; gc="2.$1" split $p >(qsort $lc >$lc) >(qsort $gc >$gc); cat $lc <(echo $p) $gc rm -f $lc $gc; )) } cat to.sort | qsortUrsala
The distributing bipartition operator, *|, is useful for this algorithm. The pivot is chosen as the greater of the first two items, this being the least sophisticated method sufficient to ensure termination. The quicksort function is a higher order function parameterized by the relational predicate p, which can be chosen appropriately for the type of items in the list being sorted. This example demonstrates sorting a list of natural numbers.
#import nat quicksort "p" = ~&itB^?a\~&a ^|WrlT/~& "p"*|^\~& "p"?hthPX/~&th ~&h #cast %nL example = quicksort(nleq) <694,1377,367,506,3712,381,1704,1580,475,1872>
<367,381,475,506,694,1377,1580,1704,1872,3712>V
[qsort [joinparts [p [*l1] [*l2] : [*l1 p *l2]] view]. [split_on_first uncons [>] split]. [small?] [] [split_on_first [l1 l2 : [l1 qsort l2 qsort joinparts]] view i] ifte].
The way of joy (using binrec)
[qsort [small?] [] [uncons [>] split] [[p [*l] [*g] : [*l p *g]] view] binrec].V (Vlang)
fn partition(mut arr []int, low int, high int) int { pivot := arr[high] mut i := (low - 1) for j in low .. high { if arr[j] < pivot { i++ temp := arr[i] arr[i] = arr[j] arr[j] = temp } } temp := arr[i + 1] arr[i + 1] = arr[high] arr[high] = temp return i + 1 } fn quick_sort(mut arr []int, low int, high int) { if low < high { pi := partition(mut arr, low, high) quick_sort(mut arr, low, pi - 1) quick_sort(mut arr, pi + 1, high) } } fn main() { mut arr := [4, 65, 2, -31, 0, 99, 2, 83, 782, 1] n := arr.len - 1 println('Input: ' + arr.str()) quick_sort(mut arr, 0, n) println('Output: ' + arr.str()) }
Input: [4, 65, 2, -31, 0, 99, 2, 83, 782, 1] Output: [-31, 0, 1, 2, 2, 4, 65, 83, 99, 782]Wart
def (qsort (pivot ... ns)) (+ (qsort+keep (fn(_) (_ < pivot)) ns) list.pivot (qsort+keep (fn(_) (_ > pivot)) ns)) def (qsort x) :case x=nil nilWren
import "./sort" for Sort var array = [ [4, 65, 2, -31, 0, 99, 2, 83, 782, 1], [7, 5, 2, 6, 1, 4, 2, 6, 3], ["echo", "lima", "charlie", "whiskey", "golf", "papa", "alfa", "india", "foxtrot", "kilo"] ] for (a in array) { System.print("Before: %(a)") Sort.quick(a) System.print("After : %(a)") System.print() }
Before: [4, 65, 2, -31, 0, 99, 2, 83, 782, 1] After : [-31, 0, 1, 2, 2, 4, 65, 83, 99, 782] Before: [7, 5, 2, 6, 1, 4, 2, 6, 3] After : [1, 2, 2, 3, 4, 5, 6, 6, 7] Before: [echo, lima, charlie, whiskey, golf, papa, alfa, india, foxtrot, kilo] After : [alfa, charlie, echo, foxtrot, golf, india, kilo, lima, papa, whiskey]XPL0
include c:\cxpl\codes; \intrinsic 'code' declarations string 0; \use zero-terminated strings proc QSort(Array, Num); \Quicksort Array into ascending order char Array; \address of array to sort int Num; \number of elements in the array int I, J, Mid, Temp; [I:= 0; J:= Num-1; Mid:= Array(J>>1); while I <= J do [while Array(I) < Mid do I:= I+1; while Array(J) > Mid do J:= J-1; if I <= J then [Temp:= Array(I); Array(I):= Array(J); Array(J):= Temp; I:= I+1; J:= J-1; ]; ]; if I < Num-1 then QSort(@Array(I), Num-I); if J > 0 then QSort(Array, J+1); ]; \QSort func StrLen(Str); \Return number of characters in an ASCIIZ string char Str; int I; for I:= 0 to -1>>1-1 do if Str(I) = 0 then return I; char Str; [Str:= "Pack my box with five dozen liquor jugs."; QSort(Str, StrLen(Str), 1); Text(0, Str); CrLf(0); ]
.PabcdeefghiiijklmnoooqrstuuvwxyzZ80 Assembly
sjasmplus syntax
;-------------------------------------------------------------------------------------------------------------------- ; Quicksort, inputs (__sdcccall(1) calling convention): ; HL = uint16_t* A (pointer to beginning of array) ; DE = uint16_t len (number of word elements in array) ; modifies: AF, A'F', BC, DE, HL ; WARNING: array can't be aligned to start/end of 64ki address space, like HL == 0x0000, or having last value at 0xFFFE ; WARNING: stack space required is on average about 6*log(len) (depending on the data, in extreme case it may be more) quicksort_a: ; convert arguments to HL=A.begin(), DE=A.end() and continue with quicksort_a_impl ex de,hl add hl,hl add hl,de ex de,hl ; | ; fallthrough into implementation ; | ; v ;-------------------------------------------------------------------------------------------------------------------- ; Quicksort implementation, inputs: ; HL = uint16_t* A.begin() (pointer to beginning of array) ; DE = uint16_t* A.end() (pointer beyond array) ; modifies: AF, A'F', BC, HL (DE is preserved) quicksort_a_impl: ; array must be located within 0x0002..0xFFFD ld c,l ld b,h ; BC = A.begin() ; if (len < 2) return; -> if (end <= begin+2) return; inc hl inc hl or a sbc hl,de ; HL = -(2*len-2), len = (2-HL)/2 ret nc ; case: begin+2 >= end <=> (len < 2) push de ; preserve A.end() for recursion push bc ; preserve A.begin() for recursion ; uint16_t pivot = A[len / 2]; rr h rr l dec hl res 0,l add hl,de ld a,(hl) inc hl ld l,(hl) ld h,b ld b,l ld l,c ld c,a ; HL = A.begin(), DE = A.end(), BC = pivot ; flip HL/DE meaning, it makes simpler the recursive tail and (A[j] > pivot) test ex de,hl ; DE = A.begin(), HL = A.end(), BC = pivot dec de ; but keep "from" address (related to A[i]) at -1 as "default" state ; for (i = 0, j = len - 1; ; i++, j--) { ; DE = (A+i-1).hi, HL = A+j+1 .find_next_swap: ; while (A[j] > pivot) j--; .find_j: dec hl ld a,b sub (hl) dec hl ; HL = A+j (finally) jr c,.find_j ; if cf=1, A[j].hi > pivot.hi jr nz,.j_found ; if zf=0, A[j].hi < pivot.hi ld a,c ; if (A[j].hi == pivot.hi) then A[j].lo vs pivot.lo is checked sub (hl) jr c,.find_j .j_found: ; while (A[i] < pivot) i++; .find_i: inc de ld a,(de) inc de ; DE = (A+i).hi (ahead +0.5 for swap) sub c ld a,(de) sbc a,b jr c,.find_i ; cf=1 -> A[i] < pivot ; if (i >= j) break; // DE = (A+i).hi, HL = A+j, BC=pivot sbc hl,de ; cf=0 since `jr c,.find_i` jr c,.swaps_done add hl,de ; DE = (A+i).hi, HL = A+j ; swap(A[i], A[j]); inc hl ld a,(de) ldd ex af,af ld a,(de) ldi ex af,af ld (hl),a ; Swap(A[i].hi, A[j].hi) done dec hl ex af,af ld (hl),a ; Swap(A[i].lo, A[j].lo) done inc bc inc bc ; pivot value restored (was -=2 by ldd+ldi) ; --j; HL = A+j is A+j+1 for next loop (ready) ; ++i; DE = (A+i).hi is (A+i-1).hi for next loop (ready) jp .find_next_swap .swaps_done: ; i >= j, all elements were already swapped WRT pivot, call recursively for the two sub-parts dec de ; DE = A+i ; quicksort_c(A, i); pop hl ; HL = A call quicksort_a_impl ; quicksort_c(A + i, len - i); ex de,hl ; HL = A+i pop de ; DE = end() (and return it preserved) jp quicksort_a_impl
Full example with test/debug data for ZX Spectrum is at [github].
ZigWorks with: 0.10.x, 0.11.x, 0.12.0-dev.1390+94cee4fb2
const std = @import("std"); pub fn quickSort(comptime T: type, arr: []T, comptime compareFn: fn (T, T) bool) void { if (arr.len < 2) return; const pivot_index = partition(T, arr, compareFn); quickSort(T, arr[0..pivot_index], compareFn); quickSort(T, arr[pivot_index + 1 .. arr.len], compareFn); } fn partition(comptime T: type, arr: []T, comptime compareFn: fn (T, T) bool) usize { const pivot_index = arr.len / 2; const last_index = arr.len - 1; std.mem.swap(T, &arr[pivot_index], &arr[last_index]); var store_index: usize = 0; for (arr[0 .. arr.len - 1]) |*elem_ptr| { if (compareFn(elem_ptr.*, arr[last_index])) { std.mem.swap(T, elem_ptr, &arr[store_index]); store_index += 1; } } std.mem.swap(T, &arr[store_index], &arr[last_index]); return store_index; }
const std = @import("std"); pub fn main() void { const print = std.debug.print; var arr = [_]i16{ 4, 65, 2, -31, 0, 99, 2, 83, 782, 1 }; print("Before: {any}\n\n", .{arr}); print("Sort numbers in ascending order.\n", .{}); quickSort(i16, &arr, struct { fn sortFn(left: i16, right: i16) bool { return left < right; } }.sortFn); print("After: {any}\n\n", .{arr}); print("Sort numbers in descending order.\n", .{}); quickSort(i16, &arr, struct { fn sortFn(left: i16, right: i16) bool { return left > right; } }.sortFn); print("After: {any}\n\n", .{arr}); }
Before: { 4, 65, 2, -31, 0, 99, 2, 83, 782, 1 } Sort numbers in ascending order. After: { -31, 0, 1, 2, 2, 4, 65, 83, 99, 782 } Sort numbers in descending order. After: { 782, 99, 83, 65, 4, 2, 2, 1, 0, -31 }zkl
These are the Wikipedia algorithms.
Quick sort immutable sequence using crappy pivot choice:
fcn qtSort(list,cmp=Op("<")){ // sort immutable lists fcn(list,cmp,N){ // spendy to keep recreating cmp reg pivot=list[0], rest=list[1,*]; left,right:=rest.filter22(cmp,pivot); N+=1; T.extend(self.fcn(left,cmp,N),T(pivot),self.fcn(right,cmp,N)); }(list,cmp,0); }
In place quick sort:
fcn qiSort(list,cmp='<){ // in place quick sort fcn(list,left,right,cmp){ if (left<right){ // partition list pivotIndex:=(left+right)/2; // or median of first,middle,last pivot:=list[pivotIndex]; list.swap(pivotIndex,right); // move pivot to end pivotIndex:=left; i:=left; do(right-left){ // foreach i in ([left..right-1]) if(cmp(list[i],pivot)){ // not cheap list.swap(i,pivotIndex); pivotIndex+=1; } i+=1; } list.swap(pivotIndex,right); // move pivot to final place // sort the partitions self.fcn(list,left,pivotIndex-1,cmp); return(self.fcn(list,pivotIndex+1,right,cmp)); } }(list,0,list.len()-1,cmp); list; }
RetroSearch is an open source project built by @garambo | Open a GitHub Issue
Search and Browse the WWW like it's 1997 | Search results from DuckDuckGo
HTML:
3.2
| Encoding:
UTF-8
| Version:
0.7.4