3 people like it.

In-place parallel QuickSort

It's fairly straightforward in-place QuickSort implementation which uses ThreadPool for parallelization. Still slower than library function Array.sortInPlace, though.

 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: 
open System
open System.Threading

//quick sort
let quickSort (a : 'a[]) =
    let rand = new Random() //for random pivot choice
    //swaps elements of array a with indices i and j
    let swap (a : 'a[]) i j =
        let temp = a.[i] 
        a.[i] <- a.[j]
        a.[j] <- temp
    
    //sorts subarray [l; r) of array a in-place
    let rec quickSortRange (a : 'a[]) l r =
        match r - l with
        | 0 | 1 -> ()
        | n ->        
            //preprocess: swap pivot to 1st position
            swap a l <| rand.Next(l, r)
            let p = a.[l]
            //scan and partitioning
            let mutable i = l + 1 //left from i <=> less than pivot part 
            for j in (l+1)..(r-1) do
                //preserve invariant: [p|  <p |i >p  |j  unpartitioned  ]
                if a.[j] < p then
                    swap a j i
                    i <- i + 1
            swap a (i-1) l //place pivot in appropriate pos.
            let iImmutable = i //instead of using ref cells
            ThreadPool.QueueUserWorkItem(fun _ -> quickSortRange a l (iImmutable-1)) |> ignore
            ThreadPool.QueueUserWorkItem(fun _ -> quickSortRange a iImmutable r) |> ignore

    quickSortRange a 0 a.Length
namespace System
namespace System.Threading
val quickSort : a:'a [] -> unit (requires comparison)

Full name: Script.quickSort
val a : 'a [] (requires comparison)
val rand : Random
Multiple items
type Random =
  new : unit -> Random + 1 overload
  member Next : unit -> int + 2 overloads
  member NextBytes : buffer:byte[] -> unit
  member NextDouble : unit -> float

Full name: System.Random

--------------------
Random() : unit
Random(Seed: int) : unit
val swap : ('a [] -> int -> int -> unit) (requires comparison)
val i : int
val j : int
val temp : 'a (requires comparison)
val quickSortRange : ('a [] -> int -> int -> unit) (requires comparison)
val l : int
val r : int
val n : int
Random.Next() : int
Random.Next(maxValue: int) : int
Random.Next(minValue: int, maxValue: int) : int
val p : 'a (requires comparison)
val mutable i : int
val j : int32
val iImmutable : int
type ThreadPool =
  static member BindHandle : osHandle:nativeint -> bool + 1 overload
  static member GetAvailableThreads : workerThreads:int * completionPortThreads:int -> unit
  static member GetMaxThreads : workerThreads:int * completionPortThreads:int -> unit
  static member GetMinThreads : workerThreads:int * completionPortThreads:int -> unit
  static member QueueUserWorkItem : callBack:WaitCallback -> bool + 1 overload
  static member RegisterWaitForSingleObject : waitObject:WaitHandle * callBack:WaitOrTimerCallback * state:obj * millisecondsTimeOutInterval:uint32 * executeOnlyOnce:bool -> RegisteredWaitHandle + 3 overloads
  static member SetMaxThreads : workerThreads:int * completionPortThreads:int -> bool
  static member SetMinThreads : workerThreads:int * completionPortThreads:int -> bool
  static member UnsafeQueueNativeOverlapped : overlapped:NativeOverlapped -> bool
  static member UnsafeQueueUserWorkItem : callBack:WaitCallback * state:obj -> bool
  ...

Full name: System.Threading.ThreadPool
ThreadPool.QueueUserWorkItem(callBack: WaitCallback) : bool
ThreadPool.QueueUserWorkItem(callBack: WaitCallback, state: obj) : bool
val ignore : value:'T -> unit

Full name: Microsoft.FSharp.Core.Operators.ignore
property Array.Length: int
Raw view Test code New version

More information

Link:http://fssnip.net/bn
Posted:12 years ago
Author:Lakret
Tags: imperative , sort , algorithms