Sorting algorithms/Heapsort

From Rosetta Code
Revision as of 17:19, 20 November 2009 by rosettacode>UnderBot (Fixed lang tags.)
Task
Sorting algorithms/Heapsort
You are encouraged to solve this task according to the task description, using any language you may know.
This page uses content from Wikipedia. The original article was at Sorting algorithms/Heapsort. The list of authors can be seen in the page history. As with Rosetta Code, the text of Wikipedia is available under the GNU FDL. (See links for details on variance)

Heapsort is an in-place sorting algorithm with worst case and average complexity of O(n logn). The basic idea is to turn the array into a binary heap structure, which has the property that it allows efficient retrieval and removal of the maximal element. We repeatedly "remove" the maximal element from the heap, thus building the sorted list from back to front. Heapsort requires random access, so can only be used on an array-like data structure.

Pseudocode:

function heapSort(a, count) is
   input: an unordered array a of length count
 
   (first place a in max-heap order)
   heapify(a, count)
 
   end := count - 1
   while end > 0 do
      (swap the root(maximum value) of the heap with the
       last element of the heap)
      swap(a[end], a[0])
      (put the heap back in max-heap order)
      siftDown(a, 0, end-1)
      (decrement the size of the heap so that the previous
       max value will stay in its proper place)
      end := end - 1
 
function heapify(a,count) is
   (start is assigned the index in a of the last parent node)
   start := (count - 2) / 2
   
   while start ≥ 0 do
      (sift down the node at index start to the proper place
       such that all nodes below the start index are in heap
       order)
      siftDown(a, start, count-1)
      start := start - 1
   (after sifting down the root all nodes/elements are in heap order)
 
function siftDown(a, start, end) is
   (end represents the limit of how far down the heap to sift)
   root := start

   while root * 2 + 1 ≤ end do       (While the root has at least one child)
      child := root * 2 + 1           (root*2+1 points to the left child)
      (If the child has a sibling and the child's value is less than its sibling's...)
      if child + 1 ≤ end and a[child] < a[child + 1] then
         child := child + 1           (... then point to the right child instead)
      if a[root] < a[child] then     (out of max-heap order)
         swap(a[root], a[child])
         root := child                (repeat to continue sifting down the child now)
      else
         return

Write a function to sort a collection of integers using heapsort.

Ada

This implementation is a generic heapsort for unconstrained arrays. <lang Ada>generic

  type Element_Type is private;
  type Index_Type is (<>);
  type Collection is array(Index_Type range <>) of Element_Type;
  with function "<" (Left, right : element_type) return boolean is <>;

procedure Generic_Heapsort(Item : in out Collection);</lang>

<lang Ada>procedure Generic_Heapsort(Item : in out Collection) is

  procedure Swap(Left : in out Element_Type; Right : in out Element_Type) is
     Temp : Element_Type := Left;
  begin
     Left := Right;
     Right := Temp;
  end Swap;
  procedure Sift_Down(Item : in out Collection) is
     Root : Integer := Index_Type'Pos(Item'First);
     Child : Integer := Index_Type'Pos(Item'Last);
     Last : Integer := Index_Type'Pos(Item'Last);
  begin
     while Root * 2 + 1 <= Last loop
        Child := Root * 2 + 1;
        if Child + 1 <= Last and then Item(index_Type'Val(Child)) < Item(Index_Type'Val(Child + 1)) then
           Child := Child + 1;
        end if;
        if Item(Index_Type'Val(Root)) < Item(Index_Type'Val(Child)) then
           Swap(Item(Index_Type'Val(Root)), Item(Index_Type'Val(Child)));
           Root := Child;
        else
           exit;
        end if;
     end loop;
  end Sift_Down;
  
  procedure Heapify(Item : in out Collection) is
     First_Pos : Integer := Index_Type'Pos(Index_Type'First);
     Last_Pos  : Integer := Index_Type'Pos(Index_type'Last);
     Start : Index_type := Index_Type'Val((Last_Pos - First_Pos + 1) / 2);
  begin
     loop
        Sift_Down(Item(Start..Item'Last));
        if Start > Index_Type'First then
           Start := Index_Type'Pred(Start);
        else
           exit;
        end if;
     end loop;
  end Heapify;
  Last_Index : Index_Type := Index_Type'Last;

begin

  Heapify(Item);
  while Last_Index > Index_Type'First loop
     Swap(Item(Last_Index), Item(Item'First));
     Last_Index := Index_Type'Pred(Last_Index);
     Sift_Down(Item(Item'First..Last_Index));
  end loop;
  

end Generic_Heapsort;</lang> Demo code: <lang Ada>with Generic_Heapsort; with Ada.Text_Io; use Ada.Text_Io;

procedure Test_Generic_Heapsort is

  type Days is (Sun, Mon, Tue, Wed, Thu, Fri, Sat);
  type Days_Col is array(Days range <>) of Natural;
  procedure Sort is new Generic_Heapsort(Natural, Days, Days_Col);
  Week : Days_Col := (5, 2, 7, 3, 4, 9, 1);

begin

  for I in Week'range loop
     Put(Days'Image(I) & ":" & Natural'Image(Week(I)) & " ");
  end loop;
  New_Line;
  Sort(Week);
  for I in Week'range loop
     Put(Days'Image(I) & ":" & Natural'Image(Week(I))& " ");
  end loop;
  New_Line;

end Test_Generic_Heapsort;</lang>

C#

<lang csharp>using System; using System.Collections.Generic; using System.Text;

public class HeapSortClass {

   public static void HeapSort<T>(T[] array)
   {
       HeapSort<T>(array, 0, array.Length, Comparer<T>.Default);
   }
   public static void HeapSort<T>(T[] array, int offset, int length, IComparer<T> comparer)
   {
       HeapSort<T>(array, offset, length, comparer.Compare);
   }
   public static void HeapSort<T>(T[] array, int offset, int length, Comparison<T> comparison)
   {
       // build binary heap from all items
       for (int i = 0; i < length; i++)
       {
           int index = i;
           T item = array[offset + i]; // use next item
           // and move it on top, if greater than parent
           while (index > 0 &&
               comparison(array[offset + (index - 1) / 2], item) < 0)
           {
               int top = (index - 1) / 2;
               array[offset + index] = array[offset + top];
               index = top;
           }
           array[offset + index] = item;
       }
       for (int i = length - 1; i > 0; i--)
       {
           // delete max and place it as last
           T last = array[offset + i];
           array[offset + i] = array[offset];
           int index = 0;
           // the last one positioned in the heap
           while (index * 2 + 1 < i)
           {
               int left = index * 2 + 1, right = left + 1;
               if (right < i && comparison(array[offset + left], array[offset + right]) < 0)
               {
                   if (comparison(last, array[offset + right]) > 0) break;
                   array[offset + index] = array[offset + right];
                   index = right;
               }
               else
               {
                   if (comparison(last, array[offset + left]) > 0) break;
                   array[offset + index] = array[offset + left];
                   index = left;
               }
           }
           array[offset + index] = last;
       }
   }
   static void Main()
   {
       // usage
       byte[] r = {5, 4, 1, 2};
       HeapSort(r);
       string[] s = { "-", "D", "a", "33" };
       HeapSort(s, 0, s.Length, StringComparer.CurrentCultureIgnoreCase);
   }

}</lang>

Common Lisp

<lang lisp>(defun make-heap (&optional (length 7))

 (make-array length :adjustable t :fill-pointer 0))

(defun left-index (index)

 (1- (* 2 (1+ index))))

(defun right-index (index)

 (* 2 (1+ index)))

(defun parent-index (index)

 (floor (1- index) 2))

(defun percolate-up (heap index predicate)

 (if (zerop index) heap
   (do* ((element (aref heap index))
         (index index pindex)
         (pindex (parent-index index)
                 (parent-index index)))
        ((zerop index) heap)
     (if (funcall predicate element (aref heap pindex))
       (rotatef (aref heap index) (aref heap pindex))
       (return-from percolate-up heap)))))

(defun heap-insert (heap element predicate)

 (let ((index (vector-push-extend element heap 2)))
   (percolate-up heap index predicate)))

(defun percolate-down (heap index predicate)

 (let ((length (length heap))
       (element (aref heap index)))
   (flet ((maybe-element (index)
            "return the element at index or nil, and a boolean
             indicating whether there was an element."
            (if (< index length)
              (values (aref heap index) t)
              (values nil nil))))
     (do ((index index swap-index)
          (lindex (left-index index) (left-index index))
          (rindex (right-index index) (right-index index))
          (swap-index nil) (swap-child nil))
         (nil)
       ;; Extact the left child if there is one. If there is not,
       ;; return the heap.  Set the left child as the swap-child.
       (multiple-value-bind (lchild lp) (maybe-element lindex)
         (if (not lp) (return-from percolate-down heap)
           (setf swap-child lchild
                 swap-index lindex))
         ;; Extract the right child, if any, and when better than the
         ;; current swap-child, update the swap-child.
         (multiple-value-bind (rchild rp) (maybe-element rindex)
           (when (and rp (funcall predicate rchild lchild))
             (setf swap-child rchild
                   swap-index rindex))
           ;; If the swap-child is better than element, rotate them,
           ;; and continue percolating down, else return heap.
           (if (not (funcall predicate swap-child element))
             (return-from percolate-down heap)
             (rotatef (aref heap index) (aref heap swap-index)))))))))

(defun heap-empty-p (heap)

 (eql (length heap) 0))

(defun heap-delete-min (heap predicate)

 (assert (not (heap-empty-p heap)) () "Can't pop from empty heap.")
 (prog1 (aref heap 0)
   (setf (aref heap 0) (vector-pop heap))
   (unless (heap-empty-p heap)
     (percolate-down heap 0 predicate))))

(defun heapsort (sequence predicate)

 (let ((h (make-heap (length sequence))))
   (map nil #'(lambda (e) (heap-insert h e predicate)) sequence)
   (map-into sequence #'(lambda () (heap-delete-min h predicate)))))</lang>

Example usage:

(heapsort (vector 1 9 2 8 3 7 4 6 5) '<) ; #(1 2 3 4 5 6 7 8 9)
(heapsort (list 9 8 1 2 7 6 3 4 5) '<)   ; (1 2 3 4 5 6 7 8 9)

E

Translation of: Python

<lang e>def heapsort := {

 def cswap(c, a, b) {
   def t := c[a]
   c[a]  := c[b]
   c[b]  := t
   # println(c)
 }
 def siftDown(array, start, finish) {
   var root := start
   while (var child := root * 2 + 1
          child <= finish) {
     if (child + 1 <= finish && array[child] < array[child + 1]) {
       child += 1
     }
     if (array[root] < array[child]) {
       cswap(array, root, child)
       root := child
     } else {
       break
     }
   }
 }
 /** Heapsort (in-place). */
 def heapsort(array) {
   # in pseudo-code, heapify only called once, so inline it here
   for start in (0..((array.size()-2)//2)).descending() {
     siftDown(array, start, array.size()-1)
   }

   for finish in (0..(array.size()-1)).descending() {
     cswap(array, 0, finish)
     siftDown(array, 0, finish - 1)
   }
 }

}</lang>

Java

Direct translation of the pseudocode. <lang java>public static void heapSort(int[] a){ int count = a.length;

//first place a in max-heap order heapify(a, count);

int end = count - 1; while(end > 0){ //swap the root(maximum value) of the heap with the //last element of the heap int tmp = a[end]; a[end] = a[0]; a[0] = tmp; //put the heap back in max-heap order siftDown(a, 0, end - 1); //decrement the size of the heap so that the previous //max value will stay in its proper place end--; } }

public static void heapify(int[] a, int count){ //start is assigned the index in a of the last parent node int start = (count - 2) / 2; //binary heap

while(start >= 0){ //sift down the node at index start to the proper place //such that all nodes below the start index are in heap //order siftDown(a, start, count - 1); start--; } //after sifting down the root all nodes/elements are in heap order }

public static void siftDown(int[] a, int start, int end){ //end represents the limit of how far down the heap to sift int root = start;

while((root * 2 + 1) <= end){ //While the root has at least one child int child = root * 2 + 1; //root*2+1 points to the left child //if the child has a sibling and the child's value is less than its sibling's... if(child + 1 <= end && a[child] < a[child + 1]) child = child + 1; //... then point to the right child instead if(a[root] < a[child]){ //out of max-heap order int tmp = a[root]; a[root] = a[child]; a[child] = tmp; root = child; //repeat to continue sifting down the child now }else return; } }</lang>


M4

<lang M4>divert(-1)

define(`randSeed',141592653) define(`setRand',

  `define(`randSeed',ifelse(eval($1<10000),1,`eval(20000-$1)',`$1'))')

define(`rand_t',`eval(randSeed^(randSeed>>13))') define(`random',

  `define(`randSeed',eval((rand_t^(rand_t<<18))&0x7fffffff))randSeed')

define(`set',`define(`$1[$2]',`$3')') define(`get',`defn(`$1[$2]')') define(`new',`set($1,size,0)') dnl for the heap calculations, it's easier if origin is 0, so set value first define(`append',

  `set($1,get($1,size),$2)`'set($1,size,incr(get($1,size)))')

dnl swap(<name>,<j>,<name>[<j>],<k>) using arg stack for the temporary define(`swap',`set($1,$2,get($1,$4))`'set($1,$4,$3)')

define(`deck',

  `new($1)for(`x',1,$2,
        `append(`$1',eval(random%100))')')

define(`show',

  `for(`x',0,decr(get($1,size)),`get($1,x) ')')

define(`for',

  `ifelse($#,0,``$0,
  `ifelse(eval($2<=$3),1,
  `pushdef(`$1',$2)$4`'popdef(`$1')$0(`$1',incr($2),$3,`$4')')')')

define(`ifywork',

  `ifelse(eval($2>=0),1,
     `siftdown($1,$2,$3)`'ifywork($1,decr($2),$3)')')

define(`heapify',

  `define(`start',eval((get($1,size)-2)/2))`'ifywork($1,start,
     decr(get($1,size)))')

define(`siftdown',

  `define(`child',eval($2*2+1))`'ifelse(eval(child<=$3),1,
      `ifelse(eval(child+1<=$3),1,
      `ifelse(eval(get($1,child)<get($1,incr(child))),1,
      `define(`child',
          incr(child))')')`'ifelse(eval(get($1,$2)<get($1,child)),1,
      `swap($1,$2,get($1,$2),child)`'siftdown($1,child,$3)')')')

define(`sortwork',

  `ifelse($2,0,
     `',
     `swap($1,0,get($1,0),$2)`'siftdown($1,0,decr($2))`'sortwork($1,
           decr($2))')')

define(`heapsort',

  `heapify($1)`'sortwork($1,decr(get($1,size)))')

divert deck(`a',10) show(`a') heapsort(`a') show(`a')</lang>

OCaml

<lang ocaml>let heapsort a =

 let swap i j =
   let t = a.(i) in a.(i) <- a.(j); a.(j) <- t in
 let sift k l =
   let rec check x y =
     if 2*x+1 < l then
       let ch =
         if y < l-1 && a.(y) < a.(y+1) then y+1 else y in
       if a.(x) < a.(ch) then (swap x ch; check ch (2*ch+1)) in
   check k (2*k+1) in
 let len = Array.length a in
 for start = (len/2)-1 downto 0 do
   sift start len;
 done;
 for term = len-1 downto 1 do
   swap term 0;
   sift 0 term;
 done;;</lang>

Usage: <lang ocaml>let a = [|3;1;4;1;5;9;2;6;5;3;5;8;97;93;23;84;62;64;33;83;27;95|] in

 heapsort a;
 Array.iter (Printf.printf "%d ") a;;

print_newline ();;

let s = "Just to show this is a type-checked polymorphic function" in let b = Array.init (String.length s) (String.get s) in

 heapsort b;
 Array.iter print_char b;;

print_newline ();;</lang> Output:

1 1 2 3 3 4 5 5 5 6 8 9 23 27 33 62 64 83 84 93 95 97 
        -Jaccccdeeefhhhhiiiiklmnnoooooppprsssstttttuuwyy

Python

<lang python>def heapsort(lst):

  Heapsort. Note: this function sorts in-place (it mutates the list). 
 # in pseudo-code, heapify only called once, so inline it here
 for start in range((len(lst)-2)/2, -1, -1):
   siftdown(lst, start, len(lst)-1)
 for end in range(len(lst)-1, 0, -1):
   lst[end], lst[0] = lst[0], lst[end]
   siftdown(lst, 0, end - 1)
 return lst

def siftdown(lst, start, end):

 root = start
 while True:
   child = root * 2 + 1
   if child > end: break
   if child + 1 <= end and lst[child] < lst[child + 1]:
     child += 1
   if lst[root] < lst[child]:
     lst[root], lst[child] = lst[child], lst[root]
     root = child
   else:
     break</lang>

Testing:

>>> ary = [7, 6, 5, 9, 8, 4, 3, 1, 2, 0]
>>> heapsort(ary)
[0, 1, 2, 3, 4, 5, 6, 7, 8, 9]

Ruby

<lang ruby>class Array

 def heapsort
   self.dup.heapsort!
 end
 def heapsort!
   # in pseudo-code, heapify only called once, so inline it here
   ((length - 2) / 2).downto(0) {|start| siftdown(start, length - 1)}
   # "end" is a ruby keyword
   (length - 1).downto(1) do |end_|
     self[end_], self[0] = self[0], self[end_]
     siftdown(0, end_ - 1)
   end
   self
 end
 def siftdown(start, end_)
   root = start
   loop do
     child = root * 2 + 1
     break if child > end_
     if child + 1 <= end_ and self[child] < self[child + 1]
       child += 1
     end
     if self[root] < self[child]
       self[root], self[child] = self[child], self[root]
       root = child
     else
       break
     end
   end
 end

end</lang> Testing:

irb(main):035:0> ary = [7, 6, 5, 9, 8, 4, 3, 1, 2, 0]
=> [7, 6, 5, 9, 8, 4, 3, 1, 2, 0]
irb(main):036:0> ary.heapsort
=> [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]

Seed7

<lang seed7>const proc: downheap (inout array elemType: arr, in var integer: k, in integer: n) is func

 local
   var elemType: help is elemType.value;
   var integer: j is 0;
 begin
   if k <= n div 2 then
     help := arr[k];
     repeat
       j := 2 * k;
       if j < n and arr[j] < arr[succ(j)] then
         incr(j);
       end if;
       if help < arr[j] then
         arr[k] := arr[j];
         k := j;
       end if;
     until help >= arr[j] or k > n div 2;
     arr[k] := help;
   end if;
 end func;

const proc: heapSort (inout array elemType: arr) is func

 local
   var integer: n is 0;
   var integer: k is 0;
   var elemType: help is elemType.value;
 begin
   n := length(arr);
   for k range n div 2 downto 1 do
     downheap(arr, k, n);
   end for;
   repeat
     help := arr[1];
     arr[1] := arr[n];
     arr[n] := help;
     decr(n);
     downheap(arr, 1, n);
   until n <= 1;
 end func;</lang>

Original source: [1]

Tcl

Based on the algorithm from Wikipedia:

Works with: Tcl version 8.5

<lang tcl>package require Tcl 8.5

proc heapsort {list {count ""}} {

   if {$count eq ""} {

set count [llength $list]

   }
   for {set i [expr {$count/2 - 1}]} {$i >= 0} {incr i -1} {

siftDown list $i [expr {$count - 1}]

   }
   for {set i [expr {$count - 1}]} {$i > 0} {} {

swap list $i 0 incr i -1 siftDown list 0 $i

   }
   return $list

} proc siftDown {varName i j} {

   upvar 1 $varName a
   while true {

set child [expr {$i*2 + 1}] if {$child > $j} { break } if {$child+1 <= $j && [lindex $a $child] < [lindex $a $child+1]} { incr child } if {[lindex $a $i] >= [lindex $a $child]} { break } swap a $i $child set i $child

   }

} proc swap {varName x y} {

   upvar 1 $varName a
   set tmp [lindex $a $x]
   lset a $x [lindex $a $y]
   lset a $y $tmp

}</lang> Demo code: <lang tcl>puts [heapsort {1 5 3 7 9 2 8 4 6 0}]</lang> Output:

0 1 2 3 4 5 6 7 8 9