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

/// This stable in-place sort has the important characteristic that each element
/// is only moved once. Therefore, it is useful for arrays with very large
/// elements. Runtime tends to be stable regardless of the original order.
///
/// Uses about N^2/2 comparisons and N exchanges. Complexity is O(N log N)
/// on average, O(N^2) in the worst case, and linear for arrays with small keys
/// and large elements.
 
val selectionsort : ('a -> 'a -> int) -> 'a array -> unit
 
/// Another in-place stable sort, this routine is ideal for arrays that are
/// already mostly ordered. In fact, this sort is often used as a final step in
/// quicksort, rather than having the latter fully order the array.
/// Performs poorly when elements are in reverse order.
///
/// Uses around N^2/4 comparisons and about N^2/8 exchanges, with N^2/4 in the
/// worst case. Complexity is linear for "almost" sorted files, but quadratic
/// for files in reverse order.
 
val insertionsort : ('a -> 'a -> int) -> 'a array -> unit
 
/// Added for comparison, this calls the F# default sort, which internally
/// calls the .NET BCL Array.Sort method. Performs slightly better than
/// this library's shellsort on random data with 10,000 or more elements,
/// but worse on mostly ordered data, even if in reverse order.
///
/// Complexity is unknown, but based on performance the implementation is
/// suspected to be a form of shell sort.
 
val stocksort : ('a -> 'a -> int) -> 'a array -> unit
 
/// An unstable in-place sort with excellent performance characteristics. Based
/// on the insertion sort, but modified to rapidly move elements over large
/// distances. Tends to outperfom Array.Sort and Quicksort for small arrays
/// (up to 1,000s of records), and outperforms Array.Sort most of the time.
/// Not particularaly sensitive to initial ordering.
/// 
/// This implementation never does more than N^3/2 comparisons. The exact
/// complexity is not known, but suspected to be either N(log2 N)^2 or N^1.25.
 
val shellsort : ('a -> 'a -> int) -> 'a array -> unit
 
/// This is the fastest sort in the library, but is both unstable and requires a
/// small supplementary stack of about log2 N indicies. Due to overhead, not
/// recommended for 100s of records or less (use shellsort instead).
/// Tends not to perform as well as shellsort when records are in reverse
/// order.
///
/// Uses 1.38N(log2 N) comparisons on average, with a very tight inner loop.
/// Tends to avoid the worst case of O(N^2) and gains about 5% performance by
/// using a "median-of-three partitioning" algorithm. For an additional savings
/// of about 20%, only orders partitions with more than 21 elements; an insertion
/// sort is used as a last step on the "almost" sorted result.
 
val quicksort : ('a -> 'a -> int) -> 'a array -> unit

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
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125

#light
 
open System
 
let selectionsort f a =
    let N = (Array.length a) - 1
    for i = 0 to N do
        let mutable minIx = i
        for j = i+1 to N do
            if (f a.[j] a.[minIx]) < 0 then minIx <- j
        if minIx <> i then
            let t = a.[ i ]
            a.[ i ] <- a.[minIx]
            a.[minIx] <- t
 
let insertionsort f a =
    let N = (Array.length a) - 1
    for i = 1 to N do
        let v = a.[ i ]
        let mutable j = i
        while (j>0) && (f a.[j-1] v) > 0 do
            a.[j] <- a.[j-1]
            j <- j - 1
        a.[j] <- v
 
let shellsort f a =
    let N = Array.length a - 1
 
    let mutable width = 1
    while width <= N do width <- 3*width+1
    width <- width / 3
 
    while width >= 1 do
        for i = width to N do
            let v = a.[ i ]
            let mutable j = i
            while j>=width && (f a.[j-width] v) > 0 do
                a.[j] <- a.[j-width]
                j <- j-width
            a.[j] <- v
        width <- width / 3
 
let stocksort f a = Array.sort f a
 
let quicksortM M fn a =
    let N = Array.length a - 1 
    let mutable stack = [0,0]
    let mutable l = 0
    let mutable r = N
 
    let swap x y =
    let t = a.[ x ]
    a.[ x ] <- a.[ y ]
        a.[ y ] <- t
 
    let sort3 x y z =
        if a.[ x ] > a.[ y ] then swap x y
        if a.[ x ] > a.[ z ] then swap x z
        if a.[ y ] > a.[ z ] then swap y z
 
    while stack <> [] do
 
        let count = (r-l)+1
 
#if DEBUG_QUICKSORT
        // Special case this for debugging to handle l=0 & r=1
        if count = 2 then
            if a.[l] > a.[r] then swap l r
 
        else if count = 3 then
            // Median-of-three
            let m = l + 1
            sort3 l m r
 
        else
#endif
 
        if count > M then
 
            // Median-of-three
            let m = l + (r-l)/2
            sort3 l m r
            let rm1 = r-1
            swap m rm1
 
            let v = a.[rm1]
            let mutable i = l
            let mutable j = rm1
 
            while i <= j do
                i <- i + 1
                while (fn a.[ i ] v) < 0 do
                    i <- i + 1
                j <- j - 1
                while (fn a.[j] v) > 0 do
                    j <- j - 1
                swap i j
 
            swap j i
            a.[rm1] <- a.[ i ]
            a.[ i ] <- v
 
            if j-l > r-i then
                stack <- (l,j) :: stack
                l <- i + 1
            else
                stack <- (i+1,r) :: stack
                r <- j
 
        else
            let tl,tr = List.hd stack
            stack <- List.tl stack
            l <- tl
            r <- tr
 
#if DEBUG_QUICKSORT
#else
     insertionsort fn a
#endif
 
// Emperical testing shows that 21 is a good all-around value for the quicksort
// partition size on my laptop.
 
let quicksort fn a = quicksortM 21 fn a

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

#light

open Sort
open System
open System.Diagnostics
 
let assertIsSorted a =
    let N = Array.length a - 1
    let mutable min = a.[0]
    for i = 1 to N do
        if a.[ i ] >= min then
            min <- a.[ i ]
        else
            failwithf "Array is not sorted at index %i (%i > %i)" i min a.[ i ]
    done
 
let assertAreEqual a b =
    if Array.length a <> Array.length b then
        failwithf "Array lengths are different: %i <> %i" (Array.length a) (Array.length b)
    a |> Array.iteri (fun ix v -> if v <> b.[ix] then failwithf "Array not equal at index %i (%i <> %i)" ix v b.[ix])
 
 
let rnd = new Random();
let stopw = new Stopwatch();
 
//--------------
 
let sorts = [
                ("Stock F# Sort", stocksort);
                ("Quick Sort", quicksort);
                ("Shell Sort", shellsort);
#if I_HAVE_LOTS_OF_TIME_FOR_ON2
                ("Insertion Sort", insertionsort);
                ("Selection Sort", selectionsort);
#endif
            ]
 
let asc a b = (a-b)
let dec a b = (b-a)
 
 
//--------------
 
 
let sortDriver a sortfn =
    let b = Array.copy a
 
    System.GC.Collect();
    stopw.Start()
    a |> sortfn asc
    stopw.Stop()
 
    b |> stocksort asc
    assertAreEqual a b
 
let tests = [ yield! [for mag in 2 .. 7 ->>
                          [ (sprintf "Random x 10^%i" mag, (fun () -> let N = (int (10.0**(float mag))) in [| for i in 0..N -> rnd.Next() |]) )
                            (sprintf "Sorted x 10^%i" mag, (fun () -> let N = (int (10.0**(float mag))) in [| for i in 0..N -> i |]) )
                            (sprintf "Reverse x 10^%i" mag, (fun () -> let N = (int (10.0**(float mag))) in [| for i in 0..N -> N-i |]) )
                            // (sprintf "Alternating x 10^%i" mag, (fun () -> let N = (int (10.0**(float mag))) in [| for i in 0..N -> i % 2 |]) )
                            // (sprintf "Alternating2 x 10^%i" mag, (fun () -> let N = (int (10.0**(float mag))) in [| for i in 0..N -> (i+1) % 2 |]) )
                          ]
                     ]
            ]
 
//--------------
 
for test in tests do
    printfn "%s:" (fst test)
    let mutable defaultMS = -1.0
    for sort in sorts do
        printf "\t%s..." (fst sort)
        let N = 5
        stopw.Reset()
        for iteration = 1 to N do
            System.Console.Write(".");
            System.Console.Out.Flush()
            let ar = (snd test)()
            let fn = snd sort
            sortDriver ar fn
        let avg = (stopw.Elapsed.TotalMilliseconds / (float N))
        if defaultMS = -1.0 then
            defaultMS <- avg 
        printfn "\tAvg. %fms (%i%%)" avg (int (avg*100.0 / defaultMS + 0.5 ))
    done
    printfn ""
done
 
Console.WriteLine( "Press <Enter> to continue..." );
Console.ReadKey() |> ignore;