
Sorting Algorithm

This is a sorting algorithm.   It may be applied to a set of data in order to sort it.    
For comparing various sorts, see compare sorts.  
For other sorting algorithms,   see sorting algorithms,   or:

O(n logn) sorts
Heap sort |
Merge sort |
Patience sort |
Quick sort
O(n log2n) sorts
Shell Sort
O(n2) sorts
Bubble sort |
Cocktail sort |
Cocktail sort with shifting bounds |
Comb sort |
Cycle sort |
Gnome sort |
Insertion sort |
Selection sort |
Strand sort
other sorts
Bead sort |
Bogo sort |
Common sorted list |
Composite structures sort |
Custom comparator sort |
Counting sort |
Disjoint sublist sort |
External sort |
Jort sort |
Lexicographical sort |
Natural sorting |
Order by pair comparisons |
Order disjoint list items |
Order two numerical lists |
Object identifier (OID) sort |
Pancake sort |
Quickselect |
Permutation sort |
Radix sort |
Ranking methods |
Remove duplicate elements |
Sleep sort |
Stooge sort |
[Sort letters of a string] |
Three variable sort |
Topological sort |
Tree sort


The   merge sort   is a recursive sort of order    n*log(n). 

It is notable for having a worst case and average complexity of    O(n*log(n)),    and a best case complexity of    O(n)    (for pre-sorted input).

The basic idea is to split the collection into smaller groups by halving it until the groups only have one element or no elements   (which are both entirely sorted groups).

Then merge the groups back together so that their elements are in order.

This is how the algorithm gets its   divide and conquer   description.



Task

Write a function to sort a collection of integers using the merge sort.



The merge sort algorithm comes in two parts:

   a sort function     and 
   a merge function 

The functions in pseudocode look like this:

function mergesort(m)
   var list left, right, result
   if length(m) ≤ 1
       return m
   else
       var middle = length(m) / 2
       for each x in m up to middle - 1
           add x to left
       for each x in m at and after middle
           add x to right
       left = mergesort(left)
       right = mergesort(right)
       if last(left) ≤ first(right) 
          append right to left
          return left
       result = merge(left, right)
       return result

function merge(left,right)
   var list result
   while length(left) > 0 and length(right) > 0
       if first(left) ≤ first(right)
           append first(left) to result
           left = rest(left)
       else
           append first(right) to result
           right = rest(right)
   if length(left) > 0 
       append rest(left) to result
   if length(right) > 0 
       append rest(right) to result
   return result



See also

   the Wikipedia entry:    merge sort


Note:   better performance can be expected if, rather than recursing until    length(m) ≤ 1,    an insertion sort is used for    length(m)    smaller than some threshold larger than   1.   However, this complicates the example code, so it is not shown here.




(*------------------------------------------------------------------*)
(* Mergesort in ATS2, for linear lists.                             *)
(*------------------------------------------------------------------*)
 
#include "share/atspre_staload.hats"
 
staload UN = "prelude/SATS/unsafe.sats"
 
#define NIL list_vt_nil ()
#define ::  list_vt_cons
 
(*------------------------------------------------------------------*)
 
(* Destructive stable merge. *)
extern fun {a : vt@ype}
list_vt_merge {m, n : int}
              (lst1 : list_vt (a, m),
               lst2 : list_vt (a, n))
    :<!wrt> list_vt (a, m + n)
 
(* Order predicate for list_vt_merge. You have to implement this to
   suit your needs. *)
extern fun {a : vt@ype}
list_vt_merge$lt : (&a, &a) -<> bool
 
(* Destructive stable mergesort. *)
extern fun {a : vt@ype}
list_vt_mergesort {n   : int}
                  (lst : list_vt (a, n))
    :<!wrt> list_vt (a, n)
 
(* Order predicate for list_vt_mergesort. You have to implement this
   to suit your needs. *)
extern fun {a : vt@ype}
list_vt_mergesort$lt : (&a, &a) -<> bool
 
(*------------------------------------------------------------------*)
 
implement {a}
list_vt_merge {m, n} (lst1, lst2) =
  let
    macdef lt = list_vt_merge$lt<a>
 
    fun
    loop {m, n       : nat} .<m + n>.
         (lst1       : list_vt (a, m),
          lst2       : list_vt (a, n),
          lst_merged : &List_vt a? >> list_vt (a, m + n))
        :<!wrt> void =
      case+ lst1 of
      | ~ NIL => lst_merged := lst2
      | @ elem1 :: tail1 =>
        begin
          case+ lst2 of
          | ~ NIL =>
            let
              prval () = fold@ lst1
            in
              lst_merged := lst1
            end
          | @ elem2 :: tail2 =>
            if ~(elem2 \lt elem1) then
              let
                val () = lst_merged := lst1
                prval () = fold@ lst2
                val () = loop (tail1, lst2, tail1)
                prval () = fold@ lst_merged
              in
              end
            else
              let
                val () = lst_merged := lst2
                prval () = fold@ lst1
                val () = loop (lst1, tail2, tail2)
                prval () = fold@ lst_merged
              in
              end
        end
 
    prval () = lemma_list_vt_param lst1 (* Proves 0 <= m. *)
    prval () = lemma_list_vt_param lst2 (* Proves 0 <= n. *)
    prval () = prop_verify {0 <= m} ()
    prval () = prop_verify {0 <= n} ()
 
    var lst_merged : List_vt a?
    val () = loop {m, n} (lst1, lst2, lst_merged)
  in
    lst_merged
  end
 
(*------------------------------------------------------------------*)
 
implement {a}
list_vt_mergesort {n} lst =
  let
    implement
    list_vt_merge$lt<a> (x, y) =
      list_vt_mergesort$lt<a> (x, y)
 
    (* You can make SMALL larger than 1 and write small_sort as a fast
       stable sort for small lists. *)
    #define SMALL 1
    fn
    small_sort {m   : pos | m <= SMALL}
               (lst : list_vt (a, m),
                m   : int m)
        :<!wrt> list_vt (a, m) =
      lst
 
    fun
    recurs {m   : pos} .<m>.
           (lst : list_vt (a, m),
            m   : int m)
        :<!wrt> list_vt (a, m) =
      if m <= SMALL then
        small_sort (lst, m)
      else
        let
          prval () = prop_verify {2 <= m} ()
          val i = m / 2
          val @(lst1, lst2) = list_vt_split_at<a> (lst, i)
          val lst1 = recurs (lst1, i)
          val lst2 = recurs (lst2, m - i)
        in
          list_vt_merge<a> (lst1, lst2)
        end
 
    prval () = lemma_list_vt_param lst (* Proves 0 <= n. *)
    prval () = prop_verify {0 <= n} ()
  in
    case+ lst of
    | NIL => lst
    | _ :: _ => recurs (lst, length lst)
  end
 
(*------------------------------------------------------------------*)
 
extern fun
list_vt_mergesort_int {n   : int}
                      (lst : list_vt (int, n))
    :<!wrt> list_vt (int, n)
 
implement
list_vt_mergesort_int {n} lst =
  let
    implement
    list_vt_mergesort$lt<int> (x, y) =
      x < y
  in
    list_vt_mergesort<int> {n} lst
  end
 
implement
main0 () =
  let
    val lst = $list_vt (22, 15, 98, 82, 22, 4, 58, 70, 80, 38, 49,
                        48, 46, 54, 93, 8, 54, 2, 72, 84, 86, 76,
                        53, 37, 90)
    val () = println! ("before : ", $UN.castvwtp1{List int} lst)
    val lst = list_vt_mergesort_int lst
    val () = println! ("after  : ", $UN.castvwtp1{List int} lst)
  in
    list_vt_free<int> lst
  end
 
(*------------------------------------------------------------------*)