ML语言
示例代码 > 排序算法 > 堆排序

下面是堆排序的基于数组的实现：
fun heapSort l = let
    val h = Array.fromList l
    val len = Array.length h
    fun get i = Array.sub (h, i)
    fun set i v = Array.update (h, i, v)
    fun siftdown (i, ins, n) = let
        fun sift k = let
            val l = k * 2 + 1
            val r = l + 1
            in 
                if (r < n) andalso
                   (get r) > (get l) then r
                else if (l < n) then l
                else k
            end
        fun loop i = let
            val j = sift i
            in
                if j = i orelse (get j) <= ins
                then set i ins
                else (set i (get j); loop j)
            end
        in
            loop i    
        end
    fun heapify () = let
        fun loop i =
              if i < 0 then ()
              else (siftdown (i, get i, len);
                    loop (i - 1))
        in
            loop (len div 2 - 1)
        end
    fun generate () = let
        fun loop (acc, i) = let
            val t = get 0
            in
               if i <= 0 then t :: acc
               else (siftdown (0, get i, i);
                     loop (t :: acc, i - 1))
            end
        in  
            if len = 0 then []
            else loop ([], len - 1)
        end
    in
        heapify (); 
        generate ()
    end
在数组实现中，siftdown函数融合了插入和筛选功能，它首先在暂时位于堆顶的要插入的元素，和从堆顶节点左右子堆的两个堆顶元素中筛选出的那个元素，二者中选择出哪个适合作堆顶元素；如果要插入元素适合，则以它为新堆顶元素而结束整个过程，否则以筛选出元素为新堆顶元素，并自顶向下逐级处理提供了新堆顶元素的子堆，将要插入元素暂时作为其堆顶元素并对它继续进行siftdown；siftdown只要到达了某个堆底，就插入要插入的元素而结束整个过程。
在提取堆顶元素生成结果列表时，先提取走堆顶元素的内容，再摘掉最后的堆底元素将它的内容暂时放置在堆顶，这时堆的大小也相应的减一，随后的siftdown函数，筛选出新的堆顶元素，并把原最后堆底元素插入回堆中。
在heapify函数建造堆的时候，首先自列表中间将元素分为前后两组，后组中的元素被视为只有一个元素的堆，然后从后往前处理前组中的元素，这时它的左右子节点已经是已有的堆或者为空，在其上进行siftdown，从而合成一个新堆。建造堆也可以采用siftup函数来实现，它自第二个元素开始从前往后逐个处理列表元素，其前面是已有的堆，将这个新元素自堆底向上插入到这个堆中。
堆排序算法也可以使用二叉树数据结构来实现二叉堆：
fun heapSort l = let
    datatype 'a heap
      = Nil 
      | Leaf of 'a
      | Node of 'a * int * 'a heap * 'a heap
    fun key Nil = 
          let val SOME a = Int.minInt in a end
      | key (Leaf k) = k
      | key (Node (k, _, _, _)) = k
    fun count Nil = 0
      | count (Leaf _) = 1
      | count (Node (_, c, _, _)) = c
    fun left Nil = Nil
      | left (Leaf _) = Nil
      | left (Node (_, _, l, _)) = l 
    fun insert (Nil, x) = Leaf x
      | insert (Leaf k, l) = 
          if l >= k
          then Node (l, 2, Leaf k, Nil)
          else Node (k, 2, Leaf l, Nil)
      | insert (Node (k, _, Leaf l, Nil), r) = 
          if r >= k 
          then Node (r, 3, Leaf k, Leaf l)
          else if r >= l
          then Node (k, 3, Leaf r, Leaf l)
          else Node (k, 3, Leaf l, Leaf r)
      | insert (Node (k, c, l, r), x) = let
        val (k, x) = 
              if k >= x then (k, x) else (x, k) 
        in      
            if (count l) <= (count r)
            then Node (k, c + 1, insert (l, x), r) 
            else if x >= (key l)
            then Node (k, c + 1, insert (r, x), l)
            else Node (k, c + 1, l, insert (r, x))
        end
    fun extract Nil = Nil
      | extract (Leaf _) = Nil
      | extract (Node (_, _, l, Nil)) = l
      | extract (Node (_, c, l, r)) = let
        val k = key l
        val n = left l 
        in
            if n = Nil
            then Node (k, c - 1, r, Nil)
            else if (key n) >= (key r)
            then Node (k, c - 1, extract l, r)
            else Node (k, c - 1, r, extract l)
        end
    fun heapify () = let
        fun loop (acc, []) = acc
          | loop (acc, x :: xs) =
              loop (insert (acc, x), xs)  
        in
            loop (Nil, l)
        end
    fun generate h = let
        fun loop (acc, Nil) = acc
          | loop (acc, h) =
              loop ((key h) :: acc, extract h)
        in
            loop ([], h)
        end           
    in
        generate (heapify ())
    end
二叉树实现不能直接访问堆底元素，从而不适宜通过摘掉它使堆的大小减一。这里的insert函数，在原堆顶元素和要插入元素中选择适合者作为新的堆顶元素，将落选的另一个元素作为新的要插入元素，插入到利于保持这个堆平衡的那个子树之中。这里的extract函数只筛选不插入，它将堆的大小减一。
这里的insert和extract函数也可以直接转写为等价的尾递归形式，与列表情况不同，只要树结构能保持良好的平衡，采用尾递归形式就没有太大的必要性。
在二叉树实现下，也可以采用siftdown函数来初始建造堆，而不需要在节点中保存关于树状态的统计信息。