Sorting algorithms/Heapsort: Difference between revisions
→{{header|J}}: avoiding parentheses |
added perl |
||
Line 691: | Line 691: | ||
{Show {Array.toRecord unit Arr}}</lang> |
{Show {Array.toRecord unit Arr}}</lang> |
||
=={{header|Perl}}== |
|||
Translation of the pseudocode. |
|||
<lang perl>my @my_list = (2,3,6,23,13,5,7,3,4,5); |
|||
heap_sort(\@my_list); |
|||
print "@my_list\n"; |
|||
exit; |
|||
sub heap_sort |
|||
{ |
|||
my($list) = @_; |
|||
my $count = scalar @$list; |
|||
heapify($count,$list); |
|||
my $end = $count - 1; |
|||
while($end > 0) |
|||
{ |
|||
@$list[0,$end] = @$list[$end,0]; |
|||
sift_down(0,$end-1,$list); |
|||
$end--; |
|||
} |
|||
} |
|||
sub heapify |
|||
{ |
|||
my ($count,$list) = @_; |
|||
my $start = ($count - 2) / 2; |
|||
while($start >= 0) |
|||
{ |
|||
sift_down($start,$count-1,$list); |
|||
$start--; |
|||
} |
|||
} |
|||
sub sift_down |
|||
{ |
|||
my($start,$end,$list) = @_; |
|||
my $root = $start; |
|||
while($root * 2 + 1 <= $end) |
|||
{ |
|||
my $child = $root * 2 + 1; |
|||
$child++ if($child + 1 <= $end && $list->[$child] < $list->[$child+1]); |
|||
if($list->[$root] < $list->[$child]) |
|||
{ |
|||
@$list[$root,$child] = @$list[$child,$root]; |
|||
$root = $child; |
|||
}else{ return } |
|||
} |
|||
}</lang> |
|||
=={{header|Python}}== |
=={{header|Python}}== |
||
<lang python>def heapsort(lst): |
<lang python>def heapsort(lst): |
Revision as of 16:09, 22 January 2010
![Task](http://static.miraheze.org/rosettacodewiki/thumb/b/ba/Rcode-button-task-crushed.png/64px-Rcode-button-task-crushed.png)
You are encouraged to solve this task according to the task description, using any language you may know.
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:
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
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 c>#include <stdio.h>
- include <stdlib.h>
- define ValType double
- define IS_LESS(v1, v2) (v1 < v2)
void siftDown( ValType *a, int start, int count);
- define SWAP(r,s) do{ValType t=r; r=s; s=t; } while(0)
void heapsort( ValType *a, int count) {
int start, end; /* heapify */
for (start = (count-2)/2; start >=0; start--) { siftDown( a, start, count); } for (end=count-1; end > 0; end--) { SWAP(a[end],a[0]); siftDown(a, 0, end); }
}
void siftDown( ValType *a, int start, int end) {
int root = start;
while ( root*2+1 < end ) { int child = 2*root + 1; if ((child + 1 < end) && IS_LESS(a[child],a[child+1])) { child += 1; } if (IS_LESS(a[root], a[child])) { SWAP( a[child], a[root] ); root = child; } else return; }
}
int main(int argc, char *argv[])
{
int ix; double valsToSort[] = { 1.4, 50.2, 5.11, -1.55, 301.521, 0.3301, 40.17, -18.0, 88.1, 30.44, -37.2, 3012.0, 49.2};
- define VSIZE (sizeof(valsToSort)/sizeof(valsToSort[0]))
heapsort(valsToSort, VSIZE); printf("{"); for (ix=0; ix<VSIZE; ix++) printf(" %.3f ", valsToSort[ix]); printf("}\n"); return 0;
}</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>
Clojure
<lang lisp> (defn- swap [a i j]
(assoc a i (nth a j) j (nth a i)))
(defn- sift [a pred k l]
(loop [a a x k y (inc (* 2 k))] (if (< (inc (* 2 x)) l) (let [ch (if (and (< y (dec l)) (pred (nth a y) (nth a (inc y)))) (inc y) y)] (if (pred (nth a x) (nth a ch)) (recur (swap a x ch) ch (inc (* 2 ch))) a)) a)))
(defn heapsort
([a pred] (let [len (count a)] (reduce (fn [c term] (sift (swap c term 0) pred 0 term)) (reduce (fn [c i] (sift c pred i len)) (vec a) (range (dec (int (/ len 2))) -1 -1)) (range (dec len) 0 -1)))) ([a] (heapsort a <)))
</lang> Example usage: <lang lisp> user> (heapsort [1 2 4 6 2 3 6]) [1 2 2 3 4 6 6] user> (heapsort [1 2 4 6 2 3 6] >) [6 6 4 3 2 2 1] user> (heapsort (list 1 2 4 6 2 3 6)) [1 2 2 3 4 6 6] </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
<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>
Haskell
Using package fgl from HackageDB
<lang haskell>import Data.Graph.Inductive.Internal.Heap(
Heap(..),insert,findMin,deleteMin)
-- heapsort is added in this module as an example application
build :: Ord a => [(a,b)] -> Heap a b build = foldr insert Empty
toList :: Ord a => Heap a b -> [(a,b)] toList Empty = [] toList h = x:toList r
where (x,r) = (findMin h,deleteMin h)
heapsort :: Ord a => [a] -> [a] heapsort = (map fst) . toList . build . map (\x->(x,x))</lang> e.g. <lang haskell>*Main> heapsort [[6,9],[2,13],[6,8,14,9],[10,7],[5]] [[2,13],[5],[6,8,14,9],[6,9],[10,7]]</lang>
J
Translation of the pseudocode <lang j>siftDown=: 4 : 0
's e'=. x z=.y c=.s while. e > c=.1+2*s=.c do. if. e > 1+c do. if. c <&({&z) c+1 do. c=.c+1 end. end. if. s <&({&z) c do. z=. z {`(|.@[)`]}~ c,s else. break. end. end. z
)
heapSort =: 3 : 0
if. 1>: c=. # y do. y return. end. z=. (] siftDown ~c,~[)&.>/ (<y),~]&.>i.1+<.-:c-2 NB. heapify > (](] siftDown {`(|.@[)`]}~) 0,[)&.>/ z,~]&.>1+i.c-1
)</lang> Examples <lang j> heapSort 1 5 2 7 3 9 4 6 8 1 1 1 2 3 4 5 6 7 8 9
heapSort &. (a.&i.) 'aqwcdhkij'
acdhijkqw</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
Oz
A faithful translation of the pseudocode, adjusted to the fact that Oz arrays can start with an arbitrary index, not just 0 or 1. <lang oz>declare
proc {HeapSort A} Low = {Array.low A} High = {Array.high A} Count = High-Low+1 %% heapify LastParent = Low + (Count-2) div 2 in for Start in LastParent..Low;~1 do {Siftdown A Start High} end %% repeatedly put the maximum element to the end %% and re-heapify the rest for End in High..Low+1;~1 do {Swap A End Low} {Siftdown A Low End-1} end end proc {Siftdown A Start End} Low = {Array.low A} fun {FirstChildOf I} Low+(I-Low)*2+1 end Root = {NewCell Start} in for while:{FirstChildOf @Root} =< End break:Break do Child = {NewCell {FirstChildOf @Root}} in if @Child + 1 =< End andthen A.@Child < A.(@Child + 1) then Child := @Child + 1 end if A.@Root < A.@Child then {Swap A @Root @Child} Root := @Child else {Break} end end end proc {Swap A I J} A.J := (A.I := A.J) end %% create array with indices ~1..7 and fill it Arr = {Array.new ~1 7 0} {Record.forAllInd unit(~1:3 0:1 4 1 5 9 2 6 5) proc {$ I V} Arr.I := V end}
in
{HeapSort Arr} {Show {Array.toRecord unit Arr}}</lang>
Perl
Translation of the pseudocode. <lang perl>my @my_list = (2,3,6,23,13,5,7,3,4,5); heap_sort(\@my_list); print "@my_list\n"; exit;
sub heap_sort {
my($list) = @_; my $count = scalar @$list; heapify($count,$list);
my $end = $count - 1; while($end > 0) { @$list[0,$end] = @$list[$end,0]; sift_down(0,$end-1,$list); $end--; }
} sub heapify {
my ($count,$list) = @_; my $start = ($count - 2) / 2; while($start >= 0) { sift_down($start,$count-1,$list); $start--; }
} sub sift_down {
my($start,$end,$list) = @_;
my $root = $start; while($root * 2 + 1 <= $end) { my $child = $root * 2 + 1; $child++ if($child + 1 <= $end && $list->[$child] < $list->[$child+1]); if($list->[$root] < $list->[$child]) { @$list[$root,$child] = @$list[$child,$root]; $root = $child; }else{ return } }
}</lang>
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:
<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