360 Assembly Translation of: REXX 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) | 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(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=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 Output: 1 1 2 6 7 8 8 9 9 9 10 15 16 16 16 17 18 18 19 20 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) ActionScript Works with: ActionScript version 3 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 Quicksort procedure ----------------------------------------------------------------------- generic type Element_Type is private; type Index_Type is (<>); type Element_Array is array(Index_Type range <>) of Element_Type; with function "<" (Left, Right : Element_Type) return Boolean is <>; with function ">" (Left, Right : Element_Type) return Boolean is <>; procedure Sort(Item : in out Element_Array); The procedure body deals with any discrete index type, either an integer type or an enumerated type. ----------------------------------------------------------------------- -- Generic Quicksort procedure ----------------------------------------------------------------------- procedure Sort (Item : in out Element_Array) is procedure Swap(Left, Right : in out Element_Type) is Temp : Element_Type := Left; begin Left := Right; Right := Temp; end Swap; Pivot_Index : Index_Type; Pivot_Value : Element_Type; Right : Index_Type := Item'Last; Left : Index_Type := Item'First; begin if Item'Length > 1 then Pivot_Index := Index_Type'Val((Index_Type'Pos(Item'Last) + 1 + Index_Type'Pos(Item'First)) / 2); Pivot_Value := Item(Pivot_Index); Left := Item'First; Right := Item'Last; loop while Left < Item'Last and then Item(Left) < Pivot_Value loop Left := Index_Type'Succ(Left); end loop; while Right > Item'First and then Item(Right) > Pivot_Value loop Right := Index_Type'Pred(Right); end loop; exit when Left >= Right; Swap(Item(Left), Item(Right)); if Left < Item'Last then Left := Index_Type'Succ(Left); end if; if Right > Item'First then Right := Index_Type'Pred(Right); end if; end loop; if Right > Item'First then Sort(Item(Item'First..Index_Type'Pred(Right))); end if; if Left < Item'Last then Sort(Item(Left..Item'Last)); end if; end if; end Sort; An example of how this procedure may be used is: with Sort; with Ada.Text_Io; with Ada.Float_Text_IO; use Ada.Float_Text_IO; 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 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)) ) Output: Before: +73 +921 +179 +961 +50 +324 +82 +178 +243 +458 After: +50 +73 +82 +178 +179 +243 +324 +458 +921 +961 APL Works with: Dyalog APL Translation of: J qsort ← {1≥⍴⍵:⍵ ⋄ e←⍵[?⍴⍵] ⋄ (∇(⍵e)/⍵)} 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 ⍋ to sort (which will pick a sorting algorithm suited to the argument). AppleScript 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). Translation of: JavaScript (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 lambda(x) x ≤ h end lambda 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 ((lambda(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 lambda : f end script end if end mReturn Output: {5.7, 8.5, 11.8, 14.1, 16.7, 21.3} 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); } } AutoHotkey 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 } BASIC Works with: FreeBASIC Works with: PowerBASIC for DOS Works with: QB64 Works with: QBasic This is specifically for INTEGERs, 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 SUB BBC 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 Output: -31 0 1 2 2 4 65 83 99 782 BCPL // 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+8midpt 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, a c, a, b a 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() } Bracmat 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) ); Output: 90 1900 4001/2 Quicksort are features languages of of optimized variants (quick,sober) (quick,sort) C #include 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); } Output: 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 // 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 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 #include // for std::partition #include // for std::less // helper function for median of three template 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 struct non_strict_op: public std::binary_function { 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 non_strict_op non_strict(Order o) { return non_strict_op(o); } template void quicksort(RandomAccessIterator first, RandomAccessIterator last, Order order) { if (first != last && first+1 != last) { typedef typename std::iterator_traits::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 void quicksort(RandomAccessIterator first, RandomAccessIterator last) { quicksort(first, last, std::less::value_type>()); } A simpler version of the above that just uses the first element as the pivot and only does one "partition". #include #include // for std::partition #include // for std::less template 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 void quicksort(RandomAccessIterator first, RandomAccessIterator last) { quicksort(first, last, std::less::value_type>()); } C# Note that Array.Sort and ArrayList.Sort both use an unstable implementation of the quicksort algorithm. // // 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 Sort { using System; class QuickSort where T : IComparable { #region Constants private const Int32 insertionLimitDefault = 12; #endregion #region Properties public Int32 InsertionLimit { get; set; } protected Random Random { get; set; } #endregion #region Constructors public QuickSort(Int32 insertionLimit, Random random) { InsertionLimit = insertionLimit; Random = random; } public QuickSort(Int32 insertionLimit) : this(insertionLimit, new Random()) { } public QuickSort() : this(insertionLimitDefault) { } #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.Sort(entries, first, last); return; } var median = pivot(entries, first, last); var left = first; var right = last; partition(entries, median, ref left, ref right); 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; } } } private T pivot(T[] entries, Int32 first, Int32 last) { var length = last + 1 - first; var logLen = (Int32)Math.Log10(length); var pivotSamples = 2 * logLen + 1; var sampleSize = Math.Min(pivotSamples, length); var right = first + sampleSize - 1; for (var left = first; left <= right; left++) { // Random sampling avoids pathological cases var random = Random.Next(left, last + 1); // Sample without replacement Swap(entries, left, random); } InsertionSort.Sort(entries, first, right); var median = entries[first + sampleSize / 2]; return median; } private static void partition(T[] entries, T median, ref Int32 left, ref Int32 right) { var first = left; var last = right; #if Tripartite var leftMedian = first; var 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); #if Tripartite swapOut(entries, median, left, right, ref leftMedian, ref rightMedian); #endif left++; right--; //[Assert]entries[first:left - 1] <= median <= entries[right + 1:last] } if (left == right) { left++; right--; } //[Assert]right < left #if Tripartite swapIn(entries, ref left, ref right, leftMedian, rightMedian, first, last); #endif //[Assert]entries[first:right] <= median <= entries[left:last] //[Assert]entries[right + 1:left - 1] == median when non-empty } private static void swapOut(T[] entries, T median, Int32 left, Int32 right, ref Int32 leftMedian, ref Int32 rightMedian) { if (median.CompareTo(entries[left]) == 0) Swap(entries, leftMedian++, left); if (median.CompareTo(entries[right]) == 0) Swap(entries, right, rightMedian--); } private static void swapIn(T[] entries, ref Int32 left, ref Int32 right, Int32 leftMedian, Int32 rightMedian, Int32 first, Int32 last) { // Restore median entries for (var prefix = first; prefix < leftMedian;) Swap(entries, prefix++, right--); for (var suffix = last; rightMedian < suffix;) Swap(entries, left++, suffix--); } public static void Swap(T[] entries, Int32 index1, Int32 index2) { if (index1 != index2) { var entry = entries[index1]; entries[index1] = entries[index2]; entries[index2] = entry; } } } #endregion #region Insertion Sort static class InsertionSort where T : IComparable { public static void Sort(T[] entries, Int32 first, Int32 last) { for (var i = first + 1; i <= last; i++) { var entry = entries[i]; var j = i; while (j > first && entries[j - 1].CompareTo(entry) > 0) entries[j] = entries[--j]; entries[j] = 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(); sorter.Sort(entries); Console.WriteLine(String.Join(" ", entries)); } } Output: 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 empty = new List(); public static IEnumerable QSort(IEnumerable 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; } } } 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 Works with: Visual 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)) Crystal Translation of: Ruby 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) goal = qsort [2,3,1,0] D A functional version: import std.stdio, std.algorithm, std.range, std.array; auto quickSort(T)(T[] items) pure nothrow @safe { if (items.length < 2) return items; immutable pivot = items[0]; return items[1 .. $].filter!(x => x < pivot).array.quickSort ~ pivot ~ items[1 .. $].filter!(x => x >= pivot).array.quickSort; } void main() { [4, 65, 2, -31, 0, 99, 2, 83, 782, 1].quickSort.writeln; } Output: [-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; } 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) } } 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))))) Output: (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# 6198601 Eero Translated from Objective-C example on this page. #import 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 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 Output: 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 QUICKSORT 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 end Elixir defmodule QuickSort do def qsort([]), do: [] def qsort([pivot | rest]) do {left, right} = Enum.split_with(rest, &(&1 < pivot)) sort(left) ++ [pivot] ++ sort(right) end end Erlang 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, erlang:system_info(schedulers)). qs([],_) -> []; qs([H|T], N) when N > 1 -> {Parent, Ref} = {self(), make_ref()}, spawn(fun()-> Parent ! {l1, Ref, qs([E||E<-T, E Parent ! {l2, Ref, qs([E||E<-T, H =< E], N-2)} end), {L1, L2} = receive_results(Ref, undefined, undefined), L1 ++ [H] ++ L2; qs([H|T],_) -> qs([E||E<-T, E 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. 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 J=J-1 END WHILE EXIT IF I>J IF I=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 PROGRAM F# 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 ; 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 Works with: Fortran version 90 and later module qsort_mod implicit none type group integer :: order ! original order of unsorted data real :: value ! values to be sorted by end type group contains recursive subroutine QSort(a,na) ! DUMMY ARGUMENTS integer, intent(in) :: nA type (group), dimension(nA), intent(in out) :: A ! LOCAL VARIABLES integer :: left, right real :: random real :: pivot type (group) :: temp integer :: marker if (nA > 1) then call random_number(random) pivot = A(int(random*real(nA-1))+1)%value ! random pivor (not best performance, but avoids worst-case) left = 0 right = nA + 1 do while (left < right) right = right - 1 do while (A(right)%value > pivot) right = right - 1 end do left = left + 1 do while (A(left)%value < pivot) left = left + 1 end do if (left < right) then temp = A(left) A(left) = A(right) A(right) = temp end if end do if (left == right) then marker = left + 1 else marker = left end if call QSort(A(:marker-1),marker-1) call QSort(A(marker:),nA-marker+1) end if end subroutine QSort end module qsort_mod ! Test Qsort Module program qsort_test use qsort_mod implicit none integer, parameter :: l = 8 type (group), dimension(l) :: A integer, dimension(12) :: seed = [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12] integer :: i real :: random write (*,*) "Unsorted Values:" call random_seed(put = seed) do i = 1, l call random_number(random) A(i)%value = random A(i)%order = i if (mod(i,4) == 0) write (*,"(4(I5,1X,F8.6))") A(i-3:i) end do call QSort(A,l) write (*,*) "Sorted Values:" do i = 4, l, 4 if (mod(i,4) == 0) write (*,"(4(I5,1X,F8.6))") A(i-3:i) end do end program qsort_test Output: Compiled with GNU Fortran 4.6.3 Unsorted Values: 1 0.228570 2 0.352733 3 0.167898 4 0.883237 5 0.968189 6 0.806234 7 0.117714 8 0.487401 Sorted Values: 7 0.117714 3 0.167898 1 0.228570 2 0.352733 8 0.487401 6 0.806234 4 0.883237 5 0.968189 A discussion about Quicksort pivot options, free source code for an optimized quicksort using insertion sort as a finisher, and an OpenMP multi-threaded quicksort is found at balfortran.org FreeBASIC ' 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 Output: 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 7 FunL 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"]) ) Output: [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) } Output: 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) } Output: 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] 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) xs 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 99 Icon 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: Since this transparently sorts both string and list arguments the result must 'return' to bypass call by value (strings) The partition procedure must "return" two values - 'suspend' is used to accomplish this Algorithm notes: The use of a type specific sorting operator meant that a general pivot choice need to be made. The median of the ends and random middle seemed reasonable. It turns out to have been suggested by Sedgewick. Sedgewick's suggestions for tail calling to recurse into the larger side and using insertion sort below a certain size were not implemented. (Q: does Icon/Unicon has tail calling optimizations?) 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. Output: 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) Io 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. J 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. sel=: 1 : 'x # [' quicksort=: 3 : 0 if. 1 >: #y do. y else. e=. y{~?#y (quicksort y sel e end. ) See the Quicksort essay in the J Wiki for additional explanations and examples. Java Works with: Java version 1.5+ Translation of: Python public static > List quickSort(List arr) { if (!arr.isEmpty()) { E pivot = arr.get(0); //This pivot can change to get faster results List less = new LinkedList(); List pivotList = new LinkedList(); List more = new LinkedList(); // 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; } return arr; } 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 - right) / 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 [a] -> [a] function quickSort(xs) { if (xs.length) { var h = xs[0], t = xs.slice(1), lessMore = partition(function (x) { return x <= h; }, t), less = lessMore[0], more = lessMore[1]; return [].concat.apply( [], [quickSort(less), h, quickSort(more)] ); } else return []; } // partition :: Predicate -> List -> (Matches, nonMatches) // partition :: (a -> Bool) -> [a] -> ([a], [a]) function partition(p, xs) { return xs.reduce(function (a, x) { return ( a[p(x) ? 0 : 1].push(x), a ); }, [[], []]); } return quickSort([11.8, 14.1, 21.3, 8.5, 16.7, 5.7]) })(); Output: [5.7, 8.5, 11.8, 14.1, 16.7, 21.3] ES6 Array.prototype.quick_sort = function () { if (this.length < 2) { return this; } var pivot = this[Math.round(this.length / 2)]; return this.filter(x => x < pivot) .quick_sort() .concat(this.filter(x => x == pivot)) .concat(this.filter(x => x > pivot).quick_sort()); }; Or, expressed in terms of a single partition, rather than two consecutive filters: (function () { 'use strict'; // quickSort :: (Ord a) => [a] -> [a] function quickSort(xs) { if (xs.length) { var h = xs[0], [less, more] = partition( x => x <= h, xs.slice(1) ); return [].concat.apply( [], [quickSort(less), h, quickSort(more)] ); } else return []; } // partition :: Predicate -> List -> (Matches, nonMatches) // partition :: (a -> Bool) -> [a] -> ([a], [a]) function partition(p, xs) { return xs.reduce((a, x) => ( a[p(x) ? 0 : 1].push(x), a ), [[], []]); } return quickSort([11.8, 14.1, 21.3, 8.5, 16.7, 5.7]); })(); Output: [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 lists jq 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 Output: [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. Julia Built-in function for in-place sorting via quicksort (the code from the standard library is quite readable): sort!(A, alg=QuickSort) 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]))) Output: 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) true K quicksort:{f:*x@1?#x;:[0=#x;x;,/(_f x@&xf)]} Example: quicksort 1 3 5 7 9 8 6 4 2 Output: 1 2 3 4 5 6 7 8 9 Explanation: _f() is the current function called recursively. :[....] generally means :[condition1;then1;condition2;then2;....;else]. Though here it is used as :[if;then;else]. This construct f:*x@1?#x assigns a random element in x (the argument) to f, 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@&xf) / sort (recursively) elements greater than f ] Though - 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@ quickSort(a: List, c: Comparator): ArrayList { if (a.isEmpty()) return ArrayList(a) val boxes = Array(3, { ArrayList() }) fun normalise(i: Int) = i / Math.max(1, Math.abs(i)) a.forEach { boxes[normalise(c.compare(it, a[0])) + 1].add(it) } arrayOf(0, 2).forEach { boxes[it] = quickSort(boxes[it], c) } return boxes.flatMapTo(ArrayList()) { it } } Another version of the code: fun quicksort(list: List): List { if (list.size == 0) { return listOf() } else { val head = list.first() val tail = list.takeLast(list.size - 1) val less = quicksort(tail.filter { it < head }) val high = quicksort(tail.filter { it >= head }) return less + head + high } } fun main(args: Array) { val nums = listOf(9, 7, 9, 8, 1, 2, 3, 4, 1, 9, 8, 9, 2, 4, 2, 4, 6, 3) println(quicksort(nums)) } Lobster 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 sorted Logo ; 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 :test Logtalk 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 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 vpivot 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 end Lucid [1] 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; end M4 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)) Output: (1,1,3,4,5,9) Mathematica 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 9 MAXScript 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 a 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; } Usage var array = [ 532, 16, 153, 3, 63.60, 925, 0.214 ]; var sorted = quicksort( array ); printLn( sorted ); Output: [ 0.214, 3, 16, 63.6, 153, 532, 925 ]