Sorting algorithms/Heapsort: Difference between revisions
m
→{{header|Wren}}: Changed to Wren S/H
Not a robot (talk | contribs) (Add Draco) |
m (→{{header|Wren}}: Changed to Wren S/H) |
||
| (31 intermediate revisions by 15 users not shown) | |||
Line 67:
{{trans|Python}}
<
V root = start
L
Line 91:
V arr = [7, 6, 5, 9, 8, 4, 3, 1, 2, 0]
heapsort(&arr)
print(arr)</
{{out}}
Line 101:
{{trans|PL/I}}
The program uses ASM structured macros and two ASSIST macros (XDECO, XPRNT) to keep the code as short as possible.
<
HEAPS CSECT
USING HEAPS,R13 base register
Line 235:
N DC A((N-A)/L'A) number of items
YREGS
END HEAPS</
{{out}}
<pre>
Line 243:
=={{header|AArch64 Assembly}}==
{{works with|as|Raspberry Pi 3B version Buster 64 bits}}
<syntaxhighlight lang="aarch64 assembly">
/* ARM assembly AARCH64 Raspberry PI 3B */
/* program heapSort64.s */
Line 481:
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"
</syntaxhighlight>
=={{header|Action!}}==
{{Trans|PL/M}}
<syntaxhighlight lang="action!">
;;; HeapSort - tranlsated from the PL/M sample
;;; and using the test cases and test routines from
;;; the Gnome Sort Action! sample (also used in other Action! sort samples)
PROC PrintArray(INT ARRAY a INT size)
INT i
Put('[)
FOR i=0 TO size-1
DO
IF i>0 THEN Put(' ) FI
PrintI(a(i))
OD
Put(']) PutE()
RETURN
PROC SiftDown(INT ARRAY a, INT start, endv)
INT root, child, temp
root = start
child = (root LSH 1) + 1
WHILE child <= endv DO
IF child + 1 <= endv AND a(child) < a(child+1) THEN child==+ 1 FI
IF a(root) < a(child) THEN
temp = a(root)
a(root) = a(child)
a(child) = temp
root = child
child = (root LSH 1) + 1
ELSE
RETURN
FI
OD
RETURN
PROC Heapify(INT ARRAY a, INT count)
INT start
start = ((count-2) / 2) + 1
WHILE start <> 0 DO
start = start - 1
SiftDown(a, start, count-1)
OD
RETURN
PROC HeapSort(INT ARRAY a, INT count)
INT endv, temp
Heapify(a, count)
endv = count - 1
WHILE endv > 0 DO
temp = a(0)
a(0) = a(endv)
a(endv) = temp
endv = endv - 1
SiftDown(a, 0, endv)
OD
RETURN
PROC Test(INT ARRAY a INT size)
PrintE("Array before sort:")
PrintArray(a,size)
HeapSort(a,size)
PrintE("Array after sort:")
PrintArray(a,size)
PutE()
RETURN
PROC Main()
INT ARRAY
a(10)=[1 4 65535 0 3 7 4 8 20 65530],
b(21)=[10 9 8 7 6 5 4 3 2 1 0
65535 65534 65533 65532 65531
65530 65529 65528 65527 65526],
c(8)=[101 102 103 104 105 106 107 108],
d(12)=[1 65535 1 65535 1 65535 1
65535 1 65535 1 65535]
Test(a,10)
Test(b,21)
Test(c,8)
Test(d,12)
RETURN
</syntaxhighlight>
{{out}}
<pre>
Array before sort:
[1 4 -1 0 3 7 4 8 20 -6]
Array after sort:
[-6 -1 0 1 3 4 4 7 8 20]
Array before sort:
[10 9 8 7 6 5 4 3 2 1 0 -1 -2 -3 -4 -5 -6 -7 -8 -9 -10]
Array after sort:
[-10 -9 -8 -7 -6 -5 -4 -3 -2 -1 0 1 2 3 4 5 6 7 8 9 10]
Array before sort:
[101 102 103 104 105 106 107 108]
Array after sort:
[101 102 103 104 105 106 107 108]
Array before sort:
[1 -1 1 -1 1 -1 1 -1 1 -1 1 -1]
Array after sort:
[-1 -1 -1 -1 -1 -1 1 1 1 1 1 1]
</pre>
=={{header|ActionScript}}==
<
for (var start:int = (data.length-2)/2; start >= 0; start--) {
siftDown(data, start, data.length);
Line 511 ⟶ 621:
}
}
}</
=={{header|Ada}}==
This implementation is a generic heapsort for unconstrained arrays.
<
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);</
<
procedure Swap(Left : in out Element_Type; Right : in out Element_Type) is
Temp : Element_Type := Left;
Line 570 ⟶ 680:
end loop;
end Generic_Heapsort;</
Demo code:
<
with Ada.Text_Io; use Ada.Text_Io;
Line 590 ⟶ 700:
end loop;
New_Line;
end Test_Generic_Heapsort;</
=={{header|ALGOL 68}}==
<
PROC swap = (REF []INT array, INT first, INT second) VOID:
(
Line 644 ⟶ 754:
print(("After: ", a))
)</
{{out}}
<pre>
Line 650 ⟶ 760:
After: +136 +326 +494 +633 +720 +760 +784 +813 +972 +980
</pre>
=={{header|ALGOL W}}==
{{Trans|PL/M}}
<syntaxhighlight lang="algolw">
begin % heapsort - translated from the PL/M sample %
% in-place heapsorts a, a must have bounds 0 :: count - 1 %
procedure heapSort ( integer array a ( * ); integer value count ) ;
begin
procedure siftDown ( integer array a ( * ); integer value start, endv ) ;
begin
integer root, child, temp;
logical done;
root := start;
done := false;
while begin
child := ( root * 2 ) + 1;
child <= endv and not done
end
do begin
if child + 1 <= endv and a( child ) < a( child + 1 ) then child := child + 1;
if a( root ) < a( child ) then begin
temp := a( root );
a( root ) := a( child );
a( child ) := temp;
root := child
end
else done := true
end while_child_le_endv_and_not_done
end siftDown ;
procedure heapify ( integer array a ( * ); integer value count ) ;
begin
integer start;
start := ( count - 2 ) div 2;
while begin
siftDown( a, start, count - 1 );
if start = 0
then false
else begin
start := start - 1;
true
end if_start_eq_0__
end do begin end
end heapify ;
begin % heapSort body %
integer endv, temp;
heapify( a, count );
endv := count - 1;
while endv > 0 do begin
temp := a( 0 );
a( 0 ) := a( endv );
a( endv ) := temp;
endv := endv - 1;
siftDown( a, 0, endv )
end while_endv_gt_0
end heapSortBody
end heapSort;
begin % test heapSort %
integer array numbers ( 0 :: 10 );
integer nPos;
% constructy an array of integers and sort it %
nPos := 0;
for v := 4, 65, 2, 31, 0, 99, 2, 8, 3, 782, 1 do begin
numbers( nPos ) := v;
nPos := nPos + 1
end for_v ;
heapSort( numbers, 11 );
% print the sorted array %
for n := 0 until 10 do writeon( i_w := 1, s_w := 0, " ", numbers( n ) )
end tests
end.
</syntaxhighlight>
{{out}}
<pre>
0 1 2 2 3 4 8 31 65 99 782
</pre>
=={{header|AppleScript}}==
===Binary heap===
<
-- Heap sort algorithm: J.W.J. Williams.
on heapSort(theList, l, r) -- Sort items l thru r of theList.
Line 716 ⟶ 903:
set aList to {74, 95, 9, 56, 76, 33, 51, 27, 62, 55, 86, 60, 65, 32, 10, 62, 72, 87, 86, 85, 36, 20, 44, 17, 60}
sort(aList, 1, -1) -- Sort items 1 thru -1 of aList.
return aList</
{{output}}
<
===Ternary heap===
<
-- Heap sort algorithm: J.W.J. Williams.
on heapSort(theList, l, r) -- Sort items l thru r of theList.
Line 792 ⟶ 979:
set aList to {75, 46, 8, 43, 20, 9, 25, 89, 19, 29, 16, 71, 44, 23, 17, 99, 79, 97, 19, 75, 32, 27, 42, 93, 75}
sort(aList, 1, -1) -- Sort items 1 thru -1 of aList.
return aList</
{{output}}
<
=={{header|ARM Assembly}}==
{{works with|as|Raspberry Pi}}
<syntaxhighlight lang="arm assembly">
/* ARM assembly Raspberry PI */
Line 1,090 ⟶ 1,277:
iMagicNumber: .int 0xCCCCCCCD
</syntaxhighlight>
=={{header|Arturo}}==
<
root: start
a: new items
Line 1,126 ⟶ 1,313:
]
print heapSort [3 1 2 8 5 7 9 4 6]</
{{out}}
Line 1,134 ⟶ 1,321:
=={{header|AutoHotkey}}==
<
Local end
end := %a%0
Line 1,167 ⟶ 1,354:
heapSort("a")
ListVars
MsgBox</
=={{header|BBC BASIC}}==
<
test() = 4, 65, 2, -31, 0, 99, 2, 83, 782, 1
PROCheapsort(test())
Line 1,204 ⟶ 1,391:
IF a(r%) < a(c%) SWAP a(r%), a(c%) : r% = c% ELSE ENDPROC
ENDWHILE
ENDPROC</
{{out}}
<pre>
Line 1,211 ⟶ 1,398:
=={{header|BCPL}}==
<
GET "libhdr.h"
Line 1,252 ⟶ 1,439:
}
newline()
}</
=={{header|C}}==
<
int max (int *a, int n, int i, int j, int k) {
Line 1,305 ⟶ 1,492:
return 0;
}
</syntaxhighlight>
=={{header|C sharp|C#}}==
<
using System.Collections.Generic;
using System.Text;
Line 1,383 ⟶ 1,570:
HeapSort(s, 0, s.Length, StringComparer.CurrentCultureIgnoreCase);
}
}</
=={{header|C++}}==
Uses C++11. Compile with
g++ -std=c++11 heap.cpp
<
#include <iterator>
#include <iostream>
Line 1,403 ⟶ 1,590:
copy(std::begin(a), std::end(a), std::ostream_iterator<int>(std::cout, " "));
std::cout << "\n";
}</
{{out}}
<pre>
Line 1,412 ⟶ 1,599:
Uses C++11. Compile with
g++ -std=c++11
<
#include <iostream>
#include <vector>
Line 1,459 ⟶ 1,646:
heap_sort(data);
for(int i : data) cout << i << " ";
}</
{{out}}
<pre>
Line 1,466 ⟶ 1,653:
=={{header|Clojure}}==
<
(assoc a i (nth a j) j (nth a i)))
Line 1,493 ⟶ 1,680:
([a]
(heap-sort a <)))
</syntaxhighlight>
Example usage:
<
[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]</
=={{header|CLU}}==
<syntaxhighlight lang="clu">% Sort an array in place using heap-sort. The contained type
% may be any type that can be compared.
heapsort = cluster [T: type] is sort
where T has lt: proctype (T,T) returns (bool)
rep = null
aT = array[T]
sort = proc (a: aT)
% CLU arrays may start at any index.
% For simplicity, we will store the old index,
% reindex the array at zero, do the heap-sort,
% then undo the reindexing.
% This should be a constant-time operation.
old_low: int := aT$low(a)
aT$set_low(a, 0)
heapsort_(a)
aT$set_low(a, old_low)
end sort
% Heap-sort a zero-indexed array
heapsort_ = proc (a: aT)
heapify(a)
end_: int := aT$high(a)
while end_ > 0 do
swap(a, end_, 0)
end_ := end_ - 1
siftDown(a, 0, end_)
end
end heapsort_
heapify = proc (a: aT)
start: int := (aT$high(a) - 1) / 2
while start >= 0 do
siftDown(a, start, aT$high(a))
start := start - 1
end
end heapify
siftDown = proc (a: aT, start, end_: int)
root: int := start
while root*2 + 1 <= end_ do
child: int := root * 2 + 1
if child + 1 <= end_ cand 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 siftDown
swap = proc (a: aT, i, j: int)
temp: T := a[i]
a[i] := a[j]
a[j] := temp
end swap
end heapsort
% Print an array
print_arr = proc [T: type] (s: stream, a: array[T], w: int)
where T has unparse: proctype (T) returns (string)
for e: T in array[T]$elements(a) do
stream$putright(s, T$unparse(e), w)
end
stream$putl(s, "")
end print_arr
% Test the heapsort
start_up = proc ()
po: stream := stream$primary_output()
arr: array[int] := array[int]$[9, -5, 3, 3, 24, -16, 3, -120, 250, 17]
stream$puts(po, "Before sorting: ")
print_arr[int](po,arr,5)
heapsort[int]$sort(arr)
stream$puts(po, "After sorting: ")
print_arr[int](po,arr,5)
end start_up</syntaxhighlight>
{{out}}
<pre>Before sorting: 9 -5 3 3 24 -16 3 -120 250 17
After sorting: -120 -16 -5 3 3 3 9 17 24 250</pre>
=={{header|COBOL}}==
{{works with|GnuCOBOL}}
<
*> This code is dedicated to the public domain
*> This is GNUCOBOL 2.0
Line 1,584 ⟶ 1,858:
end-perform
.
end program heapsort.</
{{out}}
<pre>prompt$ cobc -xj heapsort.cob
Line 1,592 ⟶ 1,866:
=={{header|CoffeeScript}}==
<
heap_sort = (arr) ->
put_array_in_heap_order(arr)
Line 1,624 ⟶ 1,898:
arr = [12, 11, 15, 10, 9, 1, 2, 3, 13, 14, 4, 5, 6, 7, 8]
heap_sort arr
console.log arr</
{{out}}
<pre>
Line 1,632 ⟶ 1,906:
=={{header|Common Lisp}}==
<
(make-array length :adjustable t :fill-pointer 0))
Line 1,704 ⟶ 1,978:
(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)))))</
Example usage:
<pre>(heapsort (vector 1 9 2 8 3 7 4 6 5) '<) ; #(1 2 3 4 5 6 7 8 9)
Line 1,710 ⟶ 1,984:
=={{header|D}}==
<
void heapSort(T)(T[] data) /*pure nothrow @safe @nogc*/ {
Line 1,720 ⟶ 1,994:
items.heapSort;
items.writeln;
}</
A lower level implementation:
<
void heapSort(R)(R seq) pure nothrow @safe @nogc {
Line 1,754 ⟶ 2,028:
data.heapSort;
data.writeln;
}</
=={{header|Dart}}==
<
void heapSort(List a) {
int count = a.length;
Line 1,828 ⟶ 2,102:
}
</syntaxhighlight>
=={{header|Delphi}}==
See [https://rosettacode.org/wiki/Sorting_algorithms/Heapsort#Pascal Pascal].
=={{header|Draco}}==
<
word root, child;
int temp;
Line 1,898 ⟶ 2,172:
write("After sorting: ");
for i from 0 upto 9 do write(a[i]:5) od
corp</
{{out}}
<pre>Before sorting: 9 -5 3 3 24 -16 3 -120 250 17
Line 1,905 ⟶ 2,179:
=={{header|E}}==
{{trans|Python}}
<
def cswap(c, a, b) {
def t := c[a]
Line 1,941 ⟶ 2,215:
}
}
}</
=={{header|EasyLang}}==
<syntaxhighlight lang="text">
proc sort . d[] .
n
# make
for i = 2 to n
if
j =
repeat
h = (j + 1) div 2
until d[j] <= d[h]
swap d[j] d[h]
j = h
.
.
for i = n downto 2
swap d[1] d[i]
j = 1
while ind < i
ind += 1
swap d[j] d[ind]
.
ind = 2 * j
.
.
.
data[] = [ 29 4 72 44 55 26 27 77 92 5 ]
print data[]
</syntaxhighlight>
=={{header|EchoLisp}}==
We use the heap library and the '''heap-pop''' primitive to implement heap-sort.
<
(lib 'heap)
Line 1,996 ⟶ 2,272:
→ (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14)
</syntaxhighlight>
=={{header|Eiffel}}==
<syntaxhighlight lang="eiffel">
class
HEAPSORT
Line 2,081 ⟶ 2,357:
end
</syntaxhighlight>
Test:
<syntaxhighlight lang="eiffel">
class
APPLICATION
Line 2,118 ⟶ 2,394:
end
</syntaxhighlight>
{{out}}
<pre>
Line 2,126 ⟶ 2,402:
=={{header|Elixir}}==
<
def heapSort(list) do
len = length(list)
Line 2,162 ⟶ 2,438:
end
(for _ <- 1..20, do: :rand.uniform(20)) |> IO.inspect |> Sort.heapSort |> IO.inspect</
{{out}}
Line 2,171 ⟶ 2,447:
=={{header|F Sharp|F#}}==
<
let temp = a.[i]
a.[i] <- a.[j]
Line 2,192 ⟶ 2,468:
for term = n - 1 downto 1 do
swap a term 0
sift cmp a 0 term</
=={{header|Forth}}==
This program assumes that return addresses simply reside as a single cell on the Return Stack. Most Forth compilers fulfill this requirement.
<
70 , 61 , 63 , 37 , 63 , 25 , 46 , 92 , 38 , 87 ,
Line 2,246 ⟶ 2,522:
: .array 10 0 do example i cells + ? loop cr ;
.array example 10 heapsort .array </
<
\ Written in ANS-Forth; tested under VFX.
\ Requires the novice package: http://www.forth.org/novice.html
Line 2,333 ⟶ 2,609:
10 test-sort
</syntaxhighlight>
{{out}}
<pre style="height:8ex;overflow:scroll">
Line 2,343 ⟶ 2,619:
{{works with|Fortran|90 and later}}
Translation of the pseudocode
<
implicit none
Line 2,407 ⟶ 2,683:
end subroutine siftdown
end program Heapsort_Demo</
=={{header|FreeBASIC}}==
<
' compile with: fbc -s console
' for boundary checks on array's compile with: fbc -s console -exx
Line 2,480 ⟶ 2,756:
Print : Print "hit any key to end program"
Sleep
End</
{{out}}
<pre>Unsorted
Line 2,491 ⟶ 2,767:
Direct translation of the pseudocode. The array object (using Scala's <code>ArraySeq</code> class) has built-in method <code>length</code>, so the <code>count</code> parameter is not needed.
<
heapify( a )
end = a.length() - 1
Line 2,520 ⟶ 2,796:
a = array( [7, 2, 6, 1, 9, 5, 0, 3, 8, 4] )
heapSort( a )
println( a )</
{{out}}
Line 2,532 ⟶ 2,808:
Since we want to implement a generic algorithm, we accept an argument of type <code>sort.Interface</code>, and thus do not have access to the actual elements of the container we're sorting. We can only swap elements. This causes a problem for us when implementing the <code>Pop</code> method, as we can't actually return an element. The ingenious step is realizing that <code>heap.Pop()</code> must move the value to pop to the "end" of the heap area, because its interface only has access to a "Swap" function, and a "Pop" function that pops from the end. (It does not have the ability to pop a value at the beginning.) This is perfect because we precisely want to move the thing popped to the end and shrink the "heap area" by 1. Our "Pop" function returns nothing since we can't get the value, but don't actually need it. (We only need the swapping that it does for us.)
<
import (
Line 2,569 ⟶ 2,845:
heapSort(sort.IntSlice(a))
fmt.Println("after: ", a)
}</
{{out}}
<pre>
Line 2,576 ⟶ 2,852:
</pre>
If you want to implement it manually:
<
import (
Line 2,613 ⟶ 2,889:
root = child
}
}</
=={{header|Groovy}}==
Loose translation of the pseudocode:
<
def checkSwap = { list, i, j = i+1 -> [(list[i] > list[j])].find{ it }.each { makeSwap(list, i, j) } }
Line 2,641 ⟶ 2,917:
}
list
}</
This is a better to read version. It includes comments and much better to understand and read function headers and loops.
It also has better readable variable names and can therefore be better used for study purposes.
It contains the same functions, even if a function with a single variable assignment in it is not very useful.
<syntaxhighlight lang="groovy">
def makeSwap (list, element1, element2) {
//exchanges two elements in a list.
//print a dot for each swap.
print "."
list[[element2,element1]] = list[[element1,element2]]
}
def checkSwap (list, child, parent) {
//check if parent is smaller than child, then swap.
if (list[parent] < list[child]) makeSwap(list, child, parent)
}
def siftDown (list, start, end) {
//end represents the limit of how far down the heap to sift
//start is the head of the heap
def parent = start
while (parent*2 < end) { //While the root has at least one child
def child = parent*2 + 1 //root*2+1 points to the left child
//find the child with the higher value
//if the child has a sibling and the child's value is less than its sibling's..
if (child + 1 <= end && list[child] < list[child+1]) child++ //point to the other child
if (checkSwap(list, child, parent)) { //check if parent is smaller than child and swap
parent = child //make child to next parent
} else {
return //The rest of the heap is in order - return.
}
}
}
def heapify (list) {
// Create a heap out of a list
// run through all the heap parents and
// ensure that each parent is lager than the child for all parent/childs.
// (list.size() -2) / 2 = last parent in the heap.
for (start in ((list.size()-2).intdiv(2))..0 ) {
siftDown(list, start, list.size() - 1)
}
}
def heapSort (list) {
//heap sort any unsorted list
heapify(list) //ensure that the list is in a binary heap state
//Run the list backwards and
//for end = (size of list -1 ) to 0
for (end in (list.size()-1)..0 ) {
makeSwap(list, 0, end) //put the top of the heap to the end (largest element)
siftDown(list, 0, end-1) //ensure that the rest is a heap again
}
list
}</syntaxhighlight>
Test:
<
println (heapSort([88,18,31,44,4,0,8,81,14,78,20,76,84,33,73,75,82,5,62,70,12,7,1]))</
{{out}}
<pre>.......................................................................[4, 12, 14, 23, 24, 24, 31, 35, 38, 46, 51, 57, 57, 58, 76, 78, 89, 92, 95, 97, 99]
Line 2,650 ⟶ 2,983:
=={{header|Haskell}}==
<syntaxhighlight lang="haskell">data Tree a = Nil
| Node a (Tree a) (Tree a)
deriving Show
insert :: Ord a => a -> Tree a -> Tree a
insert x Nil = Node x Nil Nil
insert x (Node y leftBranch rightBranch)
| x < y = Node x (insert y rightBranch) leftBranch
| otherwise = Node y (insert x rightBranch) leftBranch
merge :: Ord a => Tree a -> Tree a -> Tree a
merge Nil t = t
merge t Nil = t
merge tx@(Node vx lx rx) ty@(Node vy ly ry)
| vx < vy = Node vx (merge lx rx) ty
| otherwise = Node vy tx (merge ly ry)
fromList :: Ord a => [a] -> Tree a
fromList = foldr insert Nil
toList :: Ord a => Tree a -> [a]
toList Nil = []
toList (Node x l r) = x : toList (merge l r)
heapSort :: Ord a => [a] -> [a]
heapSort = toList . fromList</syntaxhighlight>
e.g
<syntaxhighlight lang="haskell">ghci> heapSort [9,5,8,2,1,4,6,3,0,7]
[0,1,2,3,4,5,6,7,8,9]
</syntaxhighlight>
Using package [http://hackage.haskell.org/package/fgl fgl] from HackageDB
<
Heap(..),insert,findMin,deleteMin)
Line 2,664 ⟶ 3,031:
where (x,r) = (findMin h,deleteMin h)
e.g.
<
[[2,13],[5],[6,8,14,9],[6,9],[10,7]]</
=={{header|Haxe}}==
{{trans|D}}
<
@:generic
private static function siftDown<T>(arr: Array<T>, start:Int, end:Int) {
Line 2,731 ⟶ 3,098:
Sys.println('Sorted Strings: ' + stringArray);
}
}</
{{out}}
<pre>
Line 2,743 ⟶ 3,110:
=={{header|Icon}} and {{header|Unicon}}==
<
demosort(heapsort,[3, 14, 1, 5, 9, 2, 6, 3],"qwerty")
end
Line 2,779 ⟶ 3,146:
}
return X
end</
Algorithm notes:
* This is a fairly straight forward implementation of the pseudo-code with 'heapify' coded in-line.
Line 2,799 ⟶ 3,166:
{{eff note|J|/:~}}
'''Translation of the pseudocode'''
<
siftDown=: 4 : 0
Line 2,815 ⟶ 3,182:
z=. siftDown&.>/ (c,~each i.<.c%2),<y NB. heapify
> ([ siftDown swap~)&.>/ (0,each}.i.c),z
)</
'''Examples'''
<
1 1 2 3 4 5 6 7 8 9
heapSort &. (a.&i.) 'aqwcdhkij'
acdhijkqw</
=={{header|Janet}}==
Translation of [https://gist.github.com/Techcable/c411b3a550e252b1fd681e1fc1734174 this] Python code. Based on R. Sedgwick's Algorithms Section 2.4.
Although Janet is a (functional) Lisp, it has support for [https://janet-lang.org/docs/data_structures/arrays.html mutable arrays] and imperative programming.
<syntaxhighlight lang="janet">
(defn swap [l a b]
(let [aval (get l a) bval (get l b)]
(put l a bval)
(put l b aval)))
(defn heap-sort [l]
(def len (length l))
# Invariant: heap[parent] <= heap[*children]
(def heap (array/new (+ len 1)))
(array/push heap nil)
(def ROOT 1)
# Returns the parent index of index, or nil if none
(defn parent [idx]
(assert (> idx 0))
(if (= idx 1) nil (math/trunc (/ idx 2))))
# Returns a tuple [a b] of the two child indices of idx
(defn children [idx]
(def a (* idx 2))
(def b (+ a 1))
(def l (length heap))
# NOTE: `if` implicitly returns nil on false
[(if (< a l) a) (if (< b l) b)])
(defn check-invariants [idx]
(def [a b] (children idx))
(def p (parent idx))
(assert (or (nil? a) (<= (get heap idx) (get heap a))))
(assert (or (nil? b) (<= (get heap idx) (get heap b))))
(assert (or (nil? p) (>= (get heap idx) (get heap p)))))
(defn swim [idx]
(def val (get heap idx))
(def parent-idx (parent idx))
(when (and (not (nil? parent-idx)) (< val (get heap parent-idx)))
(swap heap parent-idx idx)
(swim parent-idx)
)
(check-invariants idx))
(defn sink [idx]
(def [a b] (children idx))
(def target-val (get heap idx))
(def smaller-children @[])
(defn handle-child [idx]
(let [child-val (get heap idx)]
(if (and (not (nil? idx)) (< child-val target-val))
(array/push smaller-children idx))))
(handle-child a)
(handle-child b)
(assert (<= (length smaller-children) 2))
(def smallest-child (cond
(empty? smaller-children) nil
(= 1 (length smaller-children)) (get smaller-children 0)
(< (get heap (get smaller-children 0)) (get heap (get smaller-children 1))) (get smaller-children 0)
# NOTE: The `else` for final branch of `cond` is implicit
(get smaller-children 1)
))
(unless (nil? smallest-child)
(swap heap smallest-child idx)
(sink smallest-child)
# Recheck invariants
(check-invariants idx)))
(defn insert [val]
(def idx (length heap))
(array/push heap val)
(swim idx))
(defn remove-smallest []
(assert (> (length heap) 1))
(def largest (get heap ROOT))
(def new-root (array/pop heap))
(when (> (length heap) 1)
(put heap ROOT new-root)
(sink ROOT))
(assert (not (nil? largest)))
largest)
(each item l (insert item))
(def res @[])
(while (> (length heap) 1)
(array/push res (remove-smallest)))
res)
# NOTE: Makes a copy of input array. Output is mutable
(print (heap-sort [7 12 3 9 -1 17 6]))</syntaxhighlight>
{{out}}
<pre>
@[-1 3 6 7 9 12 17]
</pre>
=={{header|Java}}==
Direct translation of the pseudocode.
<
int count = a.length;
Line 2,877 ⟶ 3,342:
return;
}
}</
=={{header|Javascript}}==
<syntaxhighlight lang="javascript">
function heapSort(arr) {
heapify(arr)
Line 2,920 ⟶ 3,385:
heapSort(arr)
expect(arr).toStrictEqual([1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15])
})</
{{out}}
<pre>
Line 2,931 ⟶ 3,396:
Since jq is a purely functional language, the putative benefits of the heapsort algorithm do not accrue here.
<
$a
| .[$i] as $t
Line 2,974 ⟶ 3,439:
"Before: \(.)",
"After : \(heapSort)\n"
</syntaxhighlight>
{{out}}
<pre>
Line 2,985 ⟶ 3,450:
=={{header|Julia}}==
<
a[i], a[j] = a[j], a[i]
end
Line 3,027 ⟶ 3,492:
println("Unsorted: $a")
println("Heap sorted: ", heapsort!(a))
</
Unsorted: [3, 12, 11, 4, 2, 7, 5, 8, 9, 1, 10, 6]
Heap sorted: [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12]
Line 3,033 ⟶ 3,498:
=={{header|Kotlin}}==
<
fun heapSort(a: IntArray) {
Line 3,080 ⟶ 3,545:
println(a.joinToString(", "))
}
}</
{{out}}
Line 3,090 ⟶ 3,555:
=={{header|Liberty BASIC}}==
<
data 6, 5, 3, 1, 8, 7, 2, 4
Line 3,167 ⟶ 3,632:
next i
print
end sub</
=={{header|Lobster}}==
<
// (end represents the limit of how far down the heap to sift)
var root = start
Line 3,227 ⟶ 3,692:
heapSort(inputs)
print ("sorted: " + inputs)
</syntaxhighlight>
{{out}}
<pre>
Line 3,240 ⟶ 3,705:
=={{header|LotusScript}}==
<syntaxhighlight lang="lotusscript">
Public Sub heapsort(pavIn As Variant)
Dim liCount As Integer, liEnd As Integer
Line 3,286 ⟶ 3,751:
wend
End Sub
</syntaxhighlight>
=={{header|M4}}==
<
define(`randSeed',141592653)
Line 3,344 ⟶ 3,809:
show(`a')
heapsort(`a')
show(`a')</
=={{header|Maple}}==
<syntaxhighlight lang="text">swap := proc(arr, a, b)
local temp:
temp := arr[a]:
Line 3,382 ⟶ 3,847:
arr := Array([17,3,72,0,36,2,3,8,40,0]);
heapsort(arr);
arr;</
{{Out|Output}}
<pre>[0,0,2,3,3,8,17,36,40,72]</pre>
=={{header|Mathematica}}/{{header|Wolfram Language}}==
<
While[(root*2) <= theEnd,
child = root*2;
Line 3,404 ⟶ 3,869:
count--; list = siftDown[list,1,count];
]
]</
{{out}}
<pre>heapSort@{2,3,1,5,7,6}
Line 3,411 ⟶ 3,876:
=={{header|MATLAB}} / {{header|Octave}}==
This function definition is an almost exact translation of the pseudo-code into MATLAB, but I have chosen to make the heapify function inline because it is only called once in the pseudo-code. Also, MATLAB uses 1 based array indecies, therefore all of the pseudo-code has been translated to reflect that difference.
<
function list = siftDown(list,root,theEnd)
Line 3,450 ⟶ 3,915:
end
end</
Sample Usage:
<
ans =
1 2 3 4 5 6</
=={{header|MAXScript}}==
<
(
local s = count /2
Line 3,501 ⟶ 3,966:
)
)</
Output:
<syntaxhighlight lang="maxscript">
a = for i in 1 to 10 collect random 0 9
#(7, 2, 5, 6, 1, 5, 4, 0, 1, 6)
heapSort a
#(0, 1, 1, 2, 4, 5, 5, 6, 6, 7)
</syntaxhighlight>
=={{header|Mercury}}==
{{works with|Mercury|22.01.1}}
<syntaxhighlight lang="mercury">%%%-------------------------------------------------------------------
:- module heapsort_task.
:- interface.
:- import_module io.
:- pred main(io::di, io::uo) is det.
:- implementation.
:- import_module array.
:- import_module int.
:- import_module list.
:- import_module random.
:- import_module random.sfc16.
%%%-------------------------------------------------------------------
%%%
%%% heapsort/3 --
%%%
%%% A generic heapsort predicate. It takes a "Less_than" predicate to
%%% determine the order of the sort.
%%%
%%% That I call the predicate "Less_than" does not, by any means,
%%% preclude a descending order. This "Less_than" refers to the
%%% ordinals of the sequence. In other words, it means "comes before".
%%%
%%% The implementation closely follows the task pseudocode--although,
%%% of course, loops have been turned into tail recursions and arrays
%%% are treated as state variables.
%%%
:- pred heapsort(pred(T, T)::pred(in, in) is semidet,
array(T)::array_di, array(T)::array_uo) is det.
heapsort(Less_than, !Arr) :-
heapsort(Less_than, size(!.Arr), !Arr).
:- pred heapsort(pred(T, T)::pred(in, in) is semidet, int::in,
array(T)::array_di, array(T)::array_uo) is det.
heapsort(Less_than, Count, !Arr) :-
heapify(Less_than, Count, !Arr),
heapsort_loop(Less_than, Count, Count - 1, !Arr).
:- pred heapsort_loop(pred(T, T)::pred(in, in) is semidet,
int::in, int::in,
array(T)::array_di, array(T)::array_uo) is det.
heapsort_loop(Less_than, Count, End, !Arr) :-
if (End = 0) then true
else (swap(End, 0, !Arr),
sift_down(Less_than, 0, End - 1, !Arr),
heapsort_loop(Less_than, Count, End - 1, !Arr)).
:- pred heapify(pred(T, T)::pred(in, in) is semidet, int::in,
array(T)::array_di, array(T)::array_uo) is det.
heapify(Less_than, Count, !Arr) :-
heapify(Less_than, Count, (Count - 2) // 2, !Arr).
:- pred heapify(pred(T, T)::pred(in, in) is semidet,
int::in, int::in,
array(T)::array_di, array(T)::array_uo) is det.
heapify(Less_than, Count, Start, !Arr) :-
if (Start = -1) then true
else (sift_down(Less_than, Start, Count - 1, !Arr),
heapify(Less_than, Count, Start - 1, !Arr)).
:- pred sift_down(pred(T, T)::pred(in, in) is semidet,
int::in, int::in,
array(T)::array_di, array(T)::array_uo) is det.
sift_down(Less_than, Root, End, !Arr) :-
if (End < (Root * 2) + 1) then true
else (locate_child(Less_than, Root, End, !.Arr, Child),
(if not Less_than(!.Arr^elem(Root), !.Arr^elem(Child))
then true
else (swap(Root, Child, !Arr),
sift_down(Less_than, Child, End, !Arr)))).
:- pred locate_child(pred(T, T)::pred(in, in) is semidet,
int::in, int::in,
array(T)::in, int::out) is det.
locate_child(Less_than, Root, End, Arr, Child) :-
Child0 = (Root * 2) + 1,
(if (End =< Child0 + 1)
then (Child = Child0)
else if not Less_than(Arr^elem(Child0), Arr^elem(Child0 + 1))
then (Child = Child0)
else (Child = Child0 + 1)).
%%%-------------------------------------------------------------------
main(!IO) :-
R = (sfc16.init),
make_io_random(R, M, !IO),
Generate = (pred(Index::in, Number::out, IO1::di, IO::uo) is det :-
uniform_int_in_range(M, min(0, Index), 10, Number,
IO1, IO)),
generate_foldl(30, Generate, Arr0, !IO),
print_line(Arr0, !IO),
heapsort(<, Arr0, Arr1),
print_line(Arr1, !IO),
heapsort(>=, Arr1, Arr2),
print_line(Arr2, !IO).
%%%-------------------------------------------------------------------
%%% local variables:
%%% mode: mercury
%%% prolog-indent-width: 2
%%% end:</syntaxhighlight>
{{out}}
<pre>$ mmc heapsort_task.m && ./heapsort_task
array([3, 9, 3, 8, 5, 7, 0, 7, 3, 9, 5, 0, 1, 2, 0, 5, 8, 0, 8, 3, 8, 2, 6, 6, 8, 5, 7, 6, 5, 7])
array([0, 0, 0, 0, 1, 2, 2, 3, 3, 3, 3, 5, 5, 5, 5, 5, 6, 6, 6, 7, 7, 7, 7, 8, 8, 8, 8, 8, 9, 9])
array([9, 9, 8, 8, 8, 8, 8, 7, 7, 7, 7, 6, 6, 6, 5, 5, 5, 5, 5, 3, 3, 3, 3, 2, 2, 1, 0, 0, 0, 0])</pre>
=={{header|NetRexx}}==
<
options replace format comments java crossref savelog symbols binary
Line 3,593 ⟶ 4,175:
end root
return a</
{{out}}
<pre>
Line 3,616 ⟶ 4,198:
=={{header|Nim}}==
<
var root = start
while root * 2 + 1 < ending:
Line 3,638 ⟶ 4,220:
var a = @[4, 65, 2, -31, 0, 99, 2, 83, 782]
heapSort a
echo a</
{{out}}
<pre>@[-31, 0, 2, 2, 4, 65, 83, 99, 782]</pre>
Line 3,644 ⟶ 4,226:
=={{header|Objeck}}==
{{trans|Java}}
<
class HeapSort {
function : Main(args : String[]) ~ Nil {
Line 3,696 ⟶ 4,278:
}
}
}</
=={{header|OCaml}}==
<
let swap i j =
Line 3,721 ⟶ 4,303:
swap term 0;
sift 0 term;
done;;</
Usage:
<
heapsort a;
Array.iter (Printf.printf "%d ") a;;
Line 3,732 ⟶ 4,314:
heapsort b;
Array.iter print_char b;;
print_newline ();;</
{{out}}
<pre>
Line 3,741 ⟶ 4,323:
=={{header|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.
<
proc {HeapSort A}
Low = {Array.low A}
Line 3,797 ⟶ 4,379:
in
{HeapSort Arr}
{Show {Array.toRecord unit Arr}}</
=={{header|Pascal}}==
{{works with|FPC}}
An example, which works on arrays with arbitrary bounds :-)
<syntaxhighlight lang
program HeapSortDemo;
{$mode objfpc}{$h+}{$b-}
procedure
procedure SiftDown(Root, Last: Integer);
var
begin
while Root * 2 + 1 <= Last do begin
if (Child + 1 <= Last) and (a[Child] < a[Child + 1]) then
if a[Root] < a[Child] then begin
a[Root] := a[Child];
a[Child] := Tmp;
Root := Child;
end else exit;
end;
end;
var
I, Tmp: Integer;
begin
for I := Length(a) div 2 downto 0 do
SiftDown(I, High(a));
for I := High(a) downto 1 do begin
SiftDown(0, I
end;
end;
procedure PrintArray(const Name: string; const A: array of Integer);
var
I: Integer;
begin
Write(Name, ': [');
for I := 0 to High(A) - 1 do
WriteLn(A[High(A)], ']');
end;
var
a1: array[-7..5] of Integer = (-34, -20, 30, 13, 36, -10, 5, -25, 9, 19, 35, -50, 29);
a2: array of Integer = (-9, 42, -38, -5, -38, 0, 0, -15, 37, 7, -7, 40);
begin
HeapSort(a1);
PrintArray('a1', a1);
PrintArray('a2', a2);
end.
</syntaxhighlight>
{{out}}
<pre>
a1: [-50, -34, -25, -20, -10, 5, 9, 13, 19, 29, 30, 35, 36]
a2: [-38, -38, -15, -9, -7, -5, 0, 0, 7, 37, 40, 42]
</pre>
=={{header|Perl}}==
<
my @a = (4, 65, 2, -31, 0, 99, 2, 83, 782, 1);
Line 3,927 ⟶ 4,486:
return $m;
}
</syntaxhighlight>
=={{header|Phix}}==
<!--<
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
Line 3,972 ⟶ 4,531:
<span style="color: #0000FF;">?</span><span style="color: #000000;">heap_sort</span><span style="color: #0000FF;">({</span><span style="color: #000000;">5</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"oranges"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"and"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">3</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"apples"</span><span style="color: #0000FF;">})</span>
<!--</
{{out}}
<pre>
{3,5,"and","apples","oranges"}
</pre>
=={{header|Picat}}==
<syntaxhighlight lang="picat">main =>
_ = random2(),
A = [random(-10,10) : _ in 1..30],
println(A),
heapSort(A),
println(A).
heapSort(A) =>
heapify(A),
End = A.len,
while (End > 1)
swap(A, End, 1),
End := End - 1,
siftDown(A, 1, End)
end.
heapify(A) =>
Count = A.len,
Start = Count // 2,
while (Start >= 1)
siftDown(A, Start, Count),
Start := Start - 1
end.
siftDown(A, Start, End) =>
Root = Start,
Loop = true,
while (Root * 2 - 1 < End, Loop == true)
Child := Root * 2- 1,
if Child + 1 <= End, A[Child] @< A[Child+1] then
Child := Child + 1
end,
if A[Root] @< A[Child] then
swap(A,Root, Child),
Root := Child
else
Loop := false
end
end.
swap(L,I,J) =>
T = L[I],
L[I] := L[J],
L[J] := T.</syntaxhighlight>
{{out}}
<pre>[6,2,3,1,9,2,5,1,-7,1,2,1,-1,-7,2,0,4,-6,4,-8,1,9,3,5,-6,-6,0,7,-8,-2]
[-8,-8,-7,-7,-6,-6,-6,-2,-1,0,0,1,1,1,1,1,2,2,2,2,3,3,4,4,5,5,6,7,9,9]</pre>
=={{header|PicoLisp}}==
<
(let Cnt (length A)
(for (Start (/ Cnt 2) (gt0 Start) (dec Start))
Line 3,997 ⟶ 4,607:
(NIL (> (get A Child) (get A Root)))
(xchg (nth A Root) (nth A Child))
(setq Root Child) ) ) )</
{{out}}
<pre>: (heapSort (make (do 9 (link (rand 1 999)))))
Line 4,003 ⟶ 4,613:
=={{header|PL/I}}==
<
/*********************************************************************
* Pseudocode found here:
Line 4,078 ⟶ 4,688:
End;
End;</
{{out}}
<pre>
Line 4,136 ⟶ 4,746:
=={{header|PL/M}}==
<
/* HEAP SORT AN ARRAY OF 16-BIT INTEGERS */
Line 4,210 ⟶ 4,820:
CALL BDOS(0,0);
EOF</
{{out}}
<pre>0 1 2 2 3 4 8 31 65 99 782</pre>
=={{header|PowerShell}}==
<syntaxhighlight lang="powershell">
function heapsort($a, $count) {
$a = heapify $a $count
Line 4,251 ⟶ 4,861:
$array = @(60, 21, 19, 36, 63, 8, 100, 80, 3, 87, 11)
"$(heapsort $array $array.Count)"
</syntaxhighlight>
<b>Output:</b>
<pre>
Line 4,258 ⟶ 4,868:
=={{header|PureBasic}}==
<
Declare siftDown(Array a(1), start, ending)
Line 4,293 ⟶ 4,903:
EndIf
Wend
EndProcedure</
=={{header|Python}}==
<
''' Heapsort. Note: this function sorts in-place (it mutates the list). '''
Line 4,319 ⟶ 4,929:
root = child
else:
break</
Testing:
<pre>>>> ary = [7, 6, 5, 9, 8, 4, 3, 1, 2, 0]
Line 4,326 ⟶ 4,936:
=={{header|Quackery}}==
This uses code from [[Priority queue#Quackery]].
<syntaxhighlight lang="quackery"> [ [] swap pqwith >
dup pqsize times
[ frompq rot join swap ]
drop ] is hsort ( [ --> [ )
[] 23 times [ 90 random 10 + join ]
say " " dup echo cr
say " --> " hsort echo </
''' Output:'''
<pre> [
--> [ 10 11
=={{header|Racket}}==
<
#lang racket
(require (only-in srfi/43 vector-swap!))
Line 4,437 ⟶ 4,980:
(sift-down! 0 (- end 1)))
xs)
</syntaxhighlight>
=={{header|Raku}}==
(formerly Perl 6)
<syntaxhighlight lang="raku"
for ( 0 ..^ +@list div 2 ).reverse -> $start {
_sift_down $start, @list.end, @list;
Line 4,465 ⟶ 5,008:
say 'Input = ' ~ @data;
@data.&heap_sort;
say 'Output = ' ~ @data;</
{{out}}
<pre>
Line 4,478 ⟶ 5,021:
Indexing of the array starts with '''1''' (one), but can be programmed to start with zero.
<
parse arg x; call init /*use args or default, define @ array.*/
call show "before sort:" /*#: the number of elements in array*/
Line 4,499 ⟶ 5,042:
end /*while*/; @.i= $; return /*define lowest.*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
show: do s=1 for #; say ' element' right(s, length(#)) arg(1) @.s; end; return</
{{out|output|text= when using the default (epichoric Greek alphabet) for input:}}
(Shown at three-quarter size.)
Line 4,624 ⟶ 5,167:
===version 2===
<
* Translated from PL/I
* 27.07.2013 Walter Pachl
Line 4,695 ⟶ 5,238:
Say 'element' format(j,2) txt a.j
End
Return</
Output: see PL/I
=={{header|Ring}}==
<
# Project : Sorting algorithms/Heapsort
Line 4,750 ⟶ 5,293:
svect = left(svect, len(svect) - 1)
see svect + nl
</syntaxhighlight>
Output:
<pre>
Line 4,760 ⟶ 5,303:
=={{header|Ruby}}==
<
def heapsort
self.dup.heapsort!
Line 4,793 ⟶ 5,336:
end
end
end</
Testing:
<pre>irb(main):035:0> ary = [7, 6, 5, 9, 8, 4, 3, 1, 2, 0]
Line 4,803 ⟶ 5,346:
{{trans|Python}}
This program allows the caller to specify an arbitrary function by which an order is determined.
<
let mut v = [4, 6, 8, 1, 0, 3, 2, 2, 9, 5];
heap_sort(&mut v, |x, y| x < y);
Line 4,845 ⟶ 5,388:
}
}
}</
Of course, you could also simply use <code>BinaryHeap</code> in the standard library.
<
fn main() {
Line 4,855 ⟶ 5,398:
let sorted = BinaryHeap::from(src).into_sorted_vec();
println!("{:?}", sorted);
}</
=={{header|Scala}}==
{{works with|Scala|2.8}}
This code is not written for maximum performance, though, of course, it preserves the O(n log n) characteristic of heap sort.
<
import scala.annotation.tailrec // Ensure functions are tail-recursive
import ord._
Line 4,901 ⟶ 5,444:
siftDown(0, i)
}
}</
=={{header|Scheme}}==
{{works with|Scheme|R<math>^5</math>RS}}
<
(define (swap! v i j)
(define temp (vector-ref v i))
Line 4,958 ⟶ 5,501:
(define uriah (list->vector '(3 5 7 9 0 8 1 4 2 6)))
(heapsort uriah)
uriah</
{{out}}
<pre>done
Line 4,964 ⟶ 5,507:
=={{header|Seed7}}==
<
local
var elemType: help is elemType.value;
Line 5,002 ⟶ 5,545:
downheap(arr, 1, n);
until n <= 1;
end func;</
Original source: [http://seed7.sourceforge.net/algorith/sorting.htm#heapSort]
=={{header|SequenceL}}==
<syntaxhighlight lang="sequencel">
import <Utilities/Sequence.sl>;
Line 5,039 ⟶ 5,582:
in
setElementAt(setElementAt(list, i, vals.B), j, vals.A);
</syntaxhighlight>
=={{header|Sidef}}==
<
var root = start
while ((2*root + 1) <= end) {
var child = (2*root + 1)
if ((child+1 <= end) && (a[child] < a[child + 1])) {
child += 1
}
if (a[root] < a[child]) {
a[child, root] = a[root, child]
root = child
} else {
return
}
}
}
func heapify(a, count) {
var start = ((count - 2) / 2)
while (start >= 0) {
sift_down(a, start, count-1)
start -= 1
}
}
func heap_sort(a, count) {
heapify(a, count)
var end = (count - 1)
while (end > 0) {
a[0, end] = a[end, 0]
end -= 1
sift_down(a, 0, end)
}
Line 5,077 ⟶ 5,620:
}
var arr = (1..10 -> shuffle)
say arr
heap_sort(arr, arr.len)
say arr
{{out}}
<pre>[10, 5, 2, 1, 7, 6, 4, 8, 3, 9]
Line 5,089 ⟶ 5,632:
Since Standard ML is a functional language, a [http://en.wikipedia.org/wiki/Pairing_heap pairing heap] is used instead of a standard binary heap.
<
functor PairingHeap(type t
val cmp : t * t -> order) =
Line 5,143 ⟶ 5,686:
val test_3 = heapsort [6,2,7,5,8,1,3,4] = [1, 2, 3, 4, 5, 6, 7, 8]
end;
</syntaxhighlight>
=={{header|Stata}}==
Line 5,149 ⟶ 5,692:
Variant with siftup and siftdown, using Mata.
<
k = i
while (k > 1) {
Line 5,192 ⟶ 5,735:
siftdown(a, i-1)
}
}</
=={{header|Swift}}==
<
var count = list.count
Line 5,243 ⟶ 5,786:
shiftDown(&list, 0, end)
}
}</
=={{header|Tcl}}==
Based on the algorithm from Wikipedia:
{{works with|Tcl|8.5}}
<
proc heapsort {list {count ""}} {
Line 5,286 ⟶ 5,829:
lset a $x [lindex $a $y]
lset a $y $tmp
}</
Demo code:
<
{{out}}
<pre>0 1 2 3 4 5 6 7 8 9</pre>
Line 5,367 ⟶ 5,910:
=={{header|True BASIC}}==
{{trans|Liberty BASIC}}
<
!creamos la matriz y la inicializamos
LET lim = 20
Line 5,442 ⟶ 5,985:
CALL printArray (lim)
END
</syntaxhighlight>
=={{header|uBasic/4tH}}==
<syntaxhighlight lang="text">PRINT "Heap sort:"
n = FUNC (_InitArray)
PROC _ShowArray (n)
Line 5,518 ⟶ 6,061:
PRINT
RETURN</
=={{header|Vala}}==
{{trans|C++}}
<
if (array[i1] == array[i2])
return;
Line 5,574 ⟶ 6,117:
stdout.printf("%d ", i);
}
}</
{{out}}
Line 5,583 ⟶ 6,126:
=={{header|VBA}}==
{{trans|FreeBASIC}}
<
Dim root As Long : root = start
Dim lb As Long : lb = LBound(list)
Line 5,629 ⟶ 6,172:
SiftDown list(), 0, eend
Wend
End Sub</
=={{header|V (Vlang)}}==
<syntaxhighlight lang="v (vlang)">
fn main() {
mut test_arr := [4, 65, 2, -31, 0, 99, 2, 83, 782, 1]
println('Before : $test_arr')
heap_sort(mut test_arr) // Heap Sort
println('After : $test_arr')
}
[direct_array_access]
fn heap_sort(mut array []int) {
n := array.len
for i := n/2; i > -1; i-- {
heapify(mut array, n, i) // Max heapify
}
for i := n - 1; i > 0; i-- {
array[i], array[0] = array[0], array[i]
heapify(mut array, i, 0)
}
}
[direct_array_access]
fn heapify(mut array []int, n int, i int) {
mut largest := i
left := 2 * i + 1
right := 2 * i + 2
if left < n && array[i] < array[left] {
largest = left
}
if right < n && array[largest] < array[right] {
largest = right
}
if largest != i {
array[i], array[largest] = array[largest], array[i]
heapify(mut array, n, largest)
}
}
</syntaxhighlight>
{{out}}
<pre>
Before : [4, 65, 2, -31, 0, 99, 2, 83, 782, 1]
After : [-31, 0, 1, 2, 2, 4, 65, 83, 99, 782]
</pre>
=={{header|Wren}}==
<
var root = start
while (root*2 + 1 <= end) {
Line 5,669 ⟶ 6,257:
}
var
for (a in
System.print("Before: %(a)")
heapSort.call(a)
System.print("After : %(a)")
System.print()
}</
{{out}}
Line 5,688 ⟶ 6,276:
Alternatively, we can just call a library method.
{{libheader|Wren-sort}}
<
var
for (a in
System.print("Before: %(a)")
Sort.heap(a)
System.print("After : %(a)")
System.print()
}</
{{out}}
Line 5,702 ⟶ 6,290:
As above.
</pre>
=={{header|XPL0}}==
<syntaxhighlight lang "XPL0">proc HeapSort(Array, Size);
int Array, Size;
int First, Last, T;
proc Sift(First, Count);
int First, Count;
int Root, Child, T;
[Root:= First;
loop [if Root*2 + 1 >= Count then quit;
Child:= Root*2 + 1;
if Child < Count-1 and Array(Child) < Array(Child+1) then
Child:= Child+1;
if Array(Root) < Array(Child) then
[T:= Array(Root); Array(Root):= Array(Child); Array(Child):= T;
Root:= Child;
]
else quit;
];
];
[First:= (Size-1)/2 - 1;
Last:= Size-1;
while First >= 0 do
[Sift(First, Size-1);
First:= First-1;
];
while Last > 0 do
[T:= Array(Last); Array(Last):= Array(0); Array(0):= T;
Sift(0, Last);
Last:= Last-1;
];
];
int Array, Size, I;
[Array:= [4, 65, 2, 31, 0, 99, 2, 8, 3, 782, 1];
Size:= 11;
HeapSort(Array, Size);
for I:= 0, Size-1 do
[IntOut(0, Array(I)); ChOut(0, ^ )];
]</syntaxhighlight>
{{out}}
<pre>
0 1 2 2 3 4 8 31 65 99 782 </pre>
=={{header|zkl}}==
<
n := a.len();
foreach start in ([(n-2)/2 .. 0,-1])
Line 5,722 ⟶ 6,355:
start = child;
}
}</
<
heapSort("this is a test".split("")).println();</
{{out}}
<pre>
| |||