lib/mlton/basic/quick-sort.sml

   1 (* Copyright (C) 2009,2017 Matthew Fluet.
   2  * Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
   3  *    Jagannathan, and Stephen Weeks.
   4  *
   5  * MLton is released under a BSD-style license.
   6  * See the file MLton-LICENSE for details.
   7  *)
   8
   9 structure QuickSort: QUICK_SORT =
  10 struct
  11
  12 open Array
  13
  14 val rand = Word.toIntX o Random.word
  15
  16 fun randInt (lo, hi) = lo + Int.mod (rand(), hi - lo + 1)
  17
  18 (* quicksort based on section 10.2 of Programming Pearls, by Bentley.
  19  * It does repeated partitioning until the segment size is less than the cutoff.
  20  * Then, it does an insertion sort over the whole array to fix up the unsorted
  21  * segments.
  22  *)
  23 fun 'a sortArray (a: 'a array, op <= : 'a * 'a -> bool): unit =
  24    if 0 = Array.length a
  25       then ()
  26    else
  27       let
  28          fun x i = sub (a, i)
  29          fun swap (i, j) =
  30             let
  31                val t = x i
  32                val () = update (a, i, x j)
  33                val () = update (a, j, t)
  34             in
  35                ()
  36             end
  37          val cutoff = 20
  38          fun qsort (l: int, u: int): unit =
  39             if Int.<= (u - l, cutoff)
  40                then ()
  41             else
  42                let
  43                   val () = swap (l, randInt (l, u))
  44                   val t = x l
  45                   (* Partition based on page 115. *)
  46                   fun loop (i, j) =
  47                      let
  48                         fun loopUp i =
  49                            let
  50                               val i = i + 1
  51                            in
  52                               (* The sentinel guarantees that x i is OK. *)
  53                               if t <= x i
  54                                  then i
  55                               else loopUp i
  56                            end
  57                         val i = loopUp i
  58                         fun loopDown j =
  59                            let
  60                               val j = j - 1
  61                            in
  62                               if x j <= t
  63                                  then j
  64                               else loopDown j
  65                            end
  66                         val j = loopDown j
  67                      in
  68                         if j < i
  69                            then (i, j)
  70                         else (swap (i, j); loop (i, j))
  71                      end
  72                   val (i, j) = loop (l, u + 1)
  73                   val () = swap (l, j)
  74                   val () = qsort (l, j - 1)
  75                   val () = qsort (i, u)
  76                in
  77                   ()
  78                end
  79          (* Put a maximal element at the end to use as a sentinel. *)
  80          val (m, _) =
  81             Array.foldi
  82             (a, (0, Array.sub (a, 0)), fn (i, xi, (m, xm)) =>
  83              if xi <= xm
  84                 then (m, xm)
  85              else (i, xi))
  86          val last = length a - 1
  87          val () = swap (m, last)
  88          val () = qsort (0, last - 1)
  89          val () = InsertionSort.sort (a, op <=)
  90       in
  91          ()
  92       end
  93
  94 local
  95    fun make (from, to) (l, f) =
  96       let
  97          val a = from l
  98          val () = sortArray (a, f)
  99       in
 100          to a
 101       end
 102 in
 103    val sortList = fn z => make (Array.fromList, Array.toList) z
 104    val sortVector = fn z => make (Array.fromVector, Array.toVector) z
 105 end
 106
 107 end