Sorting algorithms/Heapsort: Difference between revisions
m
→{{header|Wren}}: Changed to Wren S/H
m (→{{header|AppleScript}}: Minor comment correction.) |
m (→{{header|Wren}}: Changed to Wren S/H) |
||
(56 intermediate revisions by 27 users not shown) | |||
Line 1:
{{task|Sorting Algorithms}}
{{Sorting Algorithm}}
[[Category:Sorting]]
{{wikipedia|Heapsort}}
{{omit from|GUISS}}
Line 9 ⟶ 12:
We repeatedly "remove" the maximal element from the heap, thus building the sorted list from back to front.
Pseudocode:
Line 60 ⟶ 63:
Write a function to sort a collection of integers using heapsort.
<br><br>
=={{header|11l}}==
{{trans|Python}}
<syntaxhighlight lang="11l">F siftdown(&lst, start, end)
V root = start
L
V child = root * 2 + 1
I child > end
L.break
I child + 1 <= end & lst[child] < lst[child + 1]
child++
I lst[root] < lst[child]
swap(&lst[root], &lst[child])
root = child
E
L.break
F heapsort(&lst)
L(start) ((lst.len - 2) I/ 2 .. 0).step(-1)
siftdown(&lst, start, lst.len - 1)
L(end) (lst.len - 1 .< 0).step(-1)
swap(&lst[end], &lst[0])
siftdown(&lst, 0, end - 1)
V arr = [7, 6, 5, 9, 8, 4, 3, 1, 2, 0]
heapsort(&arr)
print(arr)</syntaxhighlight>
{{out}}
<pre>
[0, 1, 2, 3, 4, 5, 6, 7, 8, 9]
</pre>
=={{header|360 Assembly}}==
{{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 198 ⟶ 235:
N DC A((N-A)/L'A) number of items
YREGS
END HEAPS</
{{out}}
<pre>
-31 0 1 2 2 4 45 58 65 69 74 82 82 83 88 89 99 104 112 782
</pre>
=={{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 */
/* look Pseudocode begin this task */
/*******************************************/
/* Constantes file */
/*******************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeConstantesARM64.inc"
/*********************************/
/* Initialized data */
/*********************************/
.data
szMessSortOk: .asciz "Table sorted.\n"
szMessSortNok: .asciz "Table not sorted !!!!!.\n"
sMessResult: .asciz "Value : @ \n"
szCarriageReturn: .asciz "\n"
.align 4
//TableNumber: .quad 1,3,6,2,5,9,10,8,4,7
TableNumber: .quad 10,9,8,7,6,-5,4,3,2,1
.equ NBELEMENTS, (. - TableNumber) / 8
/*********************************/
/* UnInitialized data */
/*********************************/
.bss
sZoneConv: .skip 24
/*********************************/
/* code section */
/*********************************/
.text
.global main
main: // entry of program
1:
ldr x0,qAdrTableNumber // address number table
mov x1,#NBELEMENTS // number of élements
bl heapSort
ldr x0,qAdrTableNumber // address number table
bl displayTable
ldr x0,qAdrTableNumber // address number table
mov x1,#NBELEMENTS // number of élements
bl isSorted // control sort
cmp x0,#1 // sorted ?
beq 2f
ldr x0,qAdrszMessSortNok // no !! error sort
bl affichageMess
b 100f
2: // yes
ldr x0,qAdrszMessSortOk
bl affichageMess
100: // standard end of the program
mov x0, #0 // return code
mov x8, #EXIT // request to exit program
svc #0 // perform the system call
qAdrszCarriageReturn: .quad szCarriageReturn
qAdrsMessResult: .quad sMessResult
qAdrTableNumber: .quad TableNumber
qAdrszMessSortOk: .quad szMessSortOk
qAdrszMessSortNok: .quad szMessSortNok
/******************************************************************/
/* control sorted table */
/******************************************************************/
/* x0 contains the address of table */
/* x1 contains the number of elements > 0 */
/* x0 return 0 if not sorted 1 if sorted */
isSorted:
stp x2,lr,[sp,-16]! // save registers
stp x3,x4,[sp,-16]! // save registers
mov x2,#0
ldr x4,[x0,x2,lsl 3]
1:
add x2,x2,1
cmp x2,x1
bge 99f
ldr x3,[x0,x2, lsl 3]
cmp x3,x4
blt 98f
mov x4,x3
b 1b
98:
mov x0,0 // not sorted
b 100f
99:
mov x0,1 // sorted
100:
ldp x3,x4,[sp],16 // restaur 2 registers
ldp x2,lr,[sp],16 // restaur 2 registers
ret // return to address lr x30
/******************************************************************/
/* heap sort */
/******************************************************************/
/* x0 contains the address of table */
/* x1 contains the number of element */
heapSort:
stp x1,lr,[sp,-16]! // save registers
stp x2,x3,[sp,-16]! // save registers
bl heapify // first place table in max-heap order
sub x3,x1,1
1:
cmp x3,0
ble 100f
mov x1,0 // swap the root(maximum value) of the heap with the last element of the heap)
mov x2,x3
bl swapElement
sub x3,x3,1
mov x1,0
mov x2,x3 // put the heap back in max-heap order
bl siftDown
b 1b
100:
ldp x2,x3,[sp],16 // restaur 2 registers
ldp x1,lr,[sp],16 // restaur 2 registers
ret // return to address lr x30
/******************************************************************/
/* place table in max-heap order */
/******************************************************************/
/* x0 contains the address of table */
/* x1 contains the number of element */
heapify:
stp x1,lr,[sp,-16]! // save registers
stp x2,x3,[sp,-16]! // save registers
str x4,[sp,-16]! // save registers
mov x4,x1
sub x3,x1,2
lsr x3,x3,1
1:
cmp x3,0
blt 100f
mov x1,x3
sub x2,x4,1
bl siftDown
sub x3,x3,1
b 1b
100:
ldr x4,[sp],16 // restaur 1 registers
ldp x2,x3,[sp],16 // restaur 2 registers
ldp x1,lr,[sp],16 // restaur 2 registers
ret // return to address lr x30
/******************************************************************/
/* swap two elements of table */
/******************************************************************/
/* x0 contains the address of table */
/* x1 contains the first index */
/* x2 contains the second index */
swapElement:
stp x2,lr,[sp,-16]! // save registers
stp x3,x4,[sp,-16]! // save registers
ldr x3,[x0,x1,lsl #3] // swap number on the table
ldr x4,[x0,x2,lsl #3]
str x4,[x0,x1,lsl #3]
str x3,[x0,x2,lsl #3]
100:
ldp x3,x4,[sp],16 // restaur 2 registers
ldp x2,lr,[sp],16 // restaur 2 registers
ret // return to address lr x30
/******************************************************************/
/* put the heap back in max-heap order */
/******************************************************************/
/* x0 contains the address of table */
/* x1 contains the first index */
/* x2 contains the last index */
siftDown:
stp x1,lr,[sp,-16]! // save registers
stp x2,x3,[sp,-16]! // save registers
stp x4,x5,[sp,-16]! // save registers
stp x6,x7,[sp,-16]! // save registers
// x1 = root = start
mov x3,x2 // save last index
1:
lsl x4,x1,1
add x4,x4,1
cmp x4,x3
bgt 100f
add x5,x4,1
cmp x5,x3
bgt 2f
ldr x6,[x0,x4,lsl 3] // compare elements on the table
ldr x7,[x0,x5,lsl 3]
cmp x6,x7
csel x4,x5,x4,lt
//movlt x4,x5
2:
ldr x7,[x0,x4,lsl 3] // compare elements on the table
ldr x6,[x0,x1,lsl 3] // root
cmp x6,x7
bge 100f
mov x2,x4 // and x1 is root
bl swapElement
mov x1,x4 // root = child
b 1b
100:
ldp x6,x7,[sp],16 // restaur 2 registers
ldp x4,x5,[sp],16 // restaur 2 registers
ldp x2,x3,[sp],16 // restaur 2 registers
ldp x1,lr,[sp],16 // restaur 2 registers
ret // return to address lr x30
/******************************************************************/
/* Display table elements */
/******************************************************************/
/* x0 contains the address of table */
displayTable:
stp x1,lr,[sp,-16]! // save registers
stp x2,x3,[sp,-16]! // save registers
mov x2,x0 // table address
mov x3,0
1: // loop display table
ldr x0,[x2,x3,lsl 3]
ldr x1,qAdrsZoneConv
bl conversion10S // décimal conversion
ldr x0,qAdrsMessResult
ldr x1,qAdrsZoneConv
bl strInsertAtCharInc // insert result at @ character
bl affichageMess // display message
add x3,x3,1
cmp x3,NBELEMENTS - 1
ble 1b
ldr x0,qAdrszCarriageReturn
bl affichageMess
mov x0,x2
100:
ldp x2,x3,[sp],16 // restaur 2 registers
ldp x1,lr,[sp],16 // restaur 2 registers
ret // return to address lr x30
qAdrsZoneConv: .quad sZoneConv
/********************************************************/
/* File Include fonctions */
/********************************************************/
/* 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 233 ⟶ 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 292 ⟶ 680:
end loop;
end Generic_Heapsort;</
Demo code:
<
with Ada.Text_Io; use Ada.Text_Io;
Line 312 ⟶ 700:
end loop;
New_Line;
end Test_Generic_Heapsort;</
=={{header|ALGOL 68}}==
<
PROC swap = (REF []INT array, INT first, INT second) VOID:
(
Line 366 ⟶ 754:
print(("After: ", a))
)</
{{out}}
<pre>
Line 374 ⟶ 762:
</pre>
=={{header|
{{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===
<syntaxhighlight lang="applescript">-- In-place binary heap sort.
-- Heap sort algorithm: J.W.J. Williams.
on heapSort(theList, l, r) -- Sort items l thru r of theList.
set listLen to (count theList)
if (listLen < 2) then return
-- Convert negative and/or transposed range indices.
if (l < 0) then set l to listLen + l + 1
if (r < 0) then set r to listLen + r + 1
if (l > r) then set {l, r} to {r, l}
script o
-- The list
property lst : theList
--
property const : l - 1
-- Private subhandler: sift a value down into the heap from a given node.
on siftDown(siftV, node, endOfHeap)
repeat until (child comes after endOfHeap)
if (child comes before endOfHeap) then
set child2 to child + 1
set
if (
set child to child2
set
end if
end if
if (childV > siftV) then
else
exit repeat
Line 430 ⟶ 880:
-- Insert the sifted-down value at the node reached.
set
end siftDown
end script
-- Arrange the sort range into a "heap" with its "top" at the leftmost position.
repeat with i from (l + r) div 2 to l by -1
end repeat
-- Unpick the heap.
repeat with endOfHeap from
set endV to o's lst's item endOfHeap
set o's lst's item endOfHeap to o's lst's item l
tell o
end
return -- nothing
end heapSort
property sort : heapSort
-- Demo:
local aList
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</syntaxhighlight>
{{output}}
<syntaxhighlight lang="applescript">9, 10, 17, 20, 27, 32, 33, 36, 44, 51, 55, 56, 60, 60, 62, 62, 65, 72, 74, 76, 85, 86, 86, 87, 95}</syntaxhighlight>
===Ternary heap===
<syntaxhighlight lang="applescript">-- In-place ternary heap sort.
-- Heap sort algorithm: J.W.J. Williams.
on heapSort(theList, l, r) -- Sort items l thru r of theList.
set listLen to (count theList)
if (listLen < 2) then return
-- Convert negative and/or transposed range indices.
if (l < 0) then set l to listLen + l + 1
if (r < 0) then set r to listLen + r + 1
if (l > r) then set {l, r} to {r, l}
script o
-- The list as a script property to allow faster references to its items.
property lst : theList
-- In a ternary heap, the list index of each node's first child is (node index * 3) - (l * 2 - 1). Preset the constant part.
property const : l * 2 - 1
-- Private subhandler: sift a value down into the heap from a given node.
on siftDown(siftV, node, endOfHeap)
set child to node * 3 - const
repeat until (child comes after endOfHeap)
set childV to my lst's item child
if (child comes before endOfHeap) then
set child2 to child + 1
set child2V to my lst's item child2
if (child2V > childV) then
set child to child2
set childV to child2V
end if
if (child2 comes before endOfHeap) then
set child3 to child2 + 1
set child3V to my lst's item child3
if (child3V > childV) then
set child to child3
set childV to child3V
end if
end if
end if
if (childV > siftV) then
set my lst's item node to childV
set node to child
set child to node * 3 - const
else
exit repeat
end if
end repeat
-- Insert the sifted-down value at the node reached.
set my lst's item node to siftV
end siftDown
end script
-- Arrange the sort range into a ternary "heap" with its "top" at the leftmost position.
repeat with i from (l + r) div 3 to l by -1
tell o to siftDown(its lst's item i, i, r)
end repeat
-- Unpick the heap.
repeat with endOfHeap from r to (l + 1) by -1
set endV to o's lst's item endOfHeap
set o's lst's item endOfHeap to o's lst's item l
tell o to siftDown(endV, l, endOfHeap - 1)
end repeat
return -- nothing
end heapSort
property sort : heapSort
-- Demo:
local aList
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</syntaxhighlight>
{{output}}
<
=={{header|ARM Assembly}}==
{{works with|as|Raspberry Pi}}
<syntaxhighlight lang="arm assembly">
/* ARM assembly Raspberry PI */
Line 762 ⟶ 1,277:
iMagicNumber: .int 0xCCCCCCCD
</syntaxhighlight>
=={{header|Arturo}}==
<syntaxhighlight lang="rebol">siftDown: function [items, start, ending][
root: start
a: new items
while [ending > 1 + 2 * root][
child: 1 + 2 * root
if and? ending > child + 1
a\[child+1] > a\[child] -> child: child + 1
if? a\[root] < a\[child][
tmp: a\[child]
a\[child]: a\[root]
a\[root]: tmp
root: child
]
else -> return a
]
return a
]
heapSort: function [items][
b: new items
count: size b
loop ((count-2)/2) .. 0 'start -> b: siftDown b start count
loop (count-1) .. 1 'ending [
tmp: b\[ending]
b\[ending]: b\0
b\0: tmp
b: siftDown b 0 ending
]
return b
]
print heapSort [3 1 2 8 5 7 9 4 6]</syntaxhighlight>
{{out}}
<pre>1 2 3 4 5 6 7 8 9</pre>
=={{header|AutoHotkey}}==
<
Local end
end := %a%0
Line 798 ⟶ 1,354:
heapSort("a")
ListVars
MsgBox</
=={{header|BBC BASIC}}==
<
test() = 4, 65, 2, -31, 0, 99, 2, 83, 782, 1
PROCheapsort(test())
Line 835 ⟶ 1,391:
IF a(r%) < a(c%) SWAP a(r%), a(c%) : r% = c% ELSE ENDPROC
ENDWHILE
ENDPROC</
{{out}}
<pre>
Line 842 ⟶ 1,398:
=={{header|BCPL}}==
<
GET "libhdr.h"
Line 883 ⟶ 1,439:
}
newline()
}</
=={{header|C}}==
<
int max (int *a, int n, int i, int j, int k) {
Line 936 ⟶ 1,492:
return 0;
}
</syntaxhighlight>
=={{header|C sharp|C#}}==
<
using System.Collections.Generic;
using System.Text;
Line 1,014 ⟶ 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,034 ⟶ 1,590:
copy(std::begin(a), std::end(a), std::ostream_iterator<int>(std::cout, " "));
std::cout << "\n";
}</
{{out}}
<pre>
Line 1,043 ⟶ 1,599:
Uses C++11. Compile with
g++ -std=c++11
<
#include <iostream>
#include <vector>
Line 1,090 ⟶ 1,646:
heap_sort(data);
for(int i : data) cout << i << " ";
}</
{{out}}
<pre>
Line 1,097 ⟶ 1,653:
=={{header|Clojure}}==
<
(assoc a i (nth a j) j (nth a i)))
Line 1,124 ⟶ 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,215 ⟶ 1,858:
end-perform
.
end program heapsort.</
{{out}}
<pre>prompt$ cobc -xj heapsort.cob
Line 1,223 ⟶ 1,866:
=={{header|CoffeeScript}}==
<
heap_sort = (arr) ->
put_array_in_heap_order(arr)
Line 1,255 ⟶ 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,263 ⟶ 1,906:
=={{header|Common Lisp}}==
<
(make-array length :adjustable t :fill-pointer 0))
Line 1,335 ⟶ 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,341 ⟶ 1,984:
=={{header|D}}==
<
void heapSort(T)(T[] data) /*pure nothrow @safe @nogc*/ {
Line 1,351 ⟶ 1,994:
items.heapSort;
items.writeln;
}</
A lower level implementation:
<
void heapSort(R)(R seq) pure nothrow @safe @nogc {
Line 1,385 ⟶ 2,028:
data.heapSort;
data.writeln;
}</
=={{header|Dart}}==
<
void heapSort(List a) {
int count = a.length;
Line 1,459 ⟶ 2,102:
}
</syntaxhighlight>
=={{header|Delphi}}==
See [https://rosettacode.org/wiki/Sorting_algorithms/Heapsort#Pascal Pascal].
=={{header|Draco}}==
<syntaxhighlight lang="draco">proc nonrec siftDown([*] int a; word start, end) void:
word root, child;
int temp;
bool stop;
root := start;
stop := false;
while not stop and root*2 + 1 <= end do
child := root*2 + 1;
if child+1 <= end and a[child] < a[child + 1] then
child := child + 1
fi;
if a[root] < a[child] then
temp := a[root];
a[root] := a[child];
a[child] := temp;
root := child
else
stop := true
fi
od
corp
proc nonrec heapify([*] int a; word count) void:
word start;
bool stop;
start := (count - 2) / 2;
stop := false;
while not stop do
siftDown(a, start, count-1);
if start=0
then stop := true /* avoid having to use a signed index */
else start := start - 1
fi
od
corp
proc nonrec heapsort([*] int a) void:
word end;
int temp;
heapify(a, dim(a,1));
end := dim(a,1) - 1;
while end > 0 do
temp := a[0];
a[0] := a[end];
a[end] := temp;
end := end - 1;
siftDown(a, 0, end)
od
corp
/* Test */
proc nonrec main() void:
int i;
[10] int a = (9, -5, 3, 3, 24, -16, 3, -120, 250, 17);
write("Before sorting: ");
for i from 0 upto 9 do write(a[i]:5) od;
writeln();
heapsort(a);
write("After sorting: ");
for i from 0 upto 9 do write(a[i]:5) od
corp</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|E}}==
{{trans|Python}}
<
def cswap(c, a, b) {
def t := c[a]
Line 1,499 ⟶ 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,554 ⟶ 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 1,639 ⟶ 2,357:
end
</syntaxhighlight>
Test:
<syntaxhighlight lang="eiffel">
class
APPLICATION
Line 1,676 ⟶ 2,394:
end
</syntaxhighlight>
{{out}}
<pre>
Line 1,684 ⟶ 2,402:
=={{header|Elixir}}==
<
def heapSort(list) do
len = length(list)
Line 1,720 ⟶ 2,438:
end
(for _ <- 1..20, do: :rand.uniform(20)) |> IO.inspect |> Sort.heapSort |> IO.inspect</
{{out}}
Line 1,729 ⟶ 2,447:
=={{header|F Sharp|F#}}==
<
let temp = a.[i]
a.[i] <- a.[j]
Line 1,750 ⟶ 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 1,804 ⟶ 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 1,891 ⟶ 2,609:
10 test-sort
</syntaxhighlight>
{{out}}
<pre style="height:8ex;overflow:scroll">
Line 1,901 ⟶ 2,619:
{{works with|Fortran|90 and later}}
Translation of the pseudocode
<
implicit none
Line 1,965 ⟶ 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,038 ⟶ 2,756:
Print : Print "hit any key to end program"
Sleep
End</
{{out}}
<pre>Unsorted
Line 2,049 ⟶ 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,078 ⟶ 2,796:
a = array( [7, 2, 6, 1, 9, 5, 0, 3, 8, 4] )
heapSort( a )
println( a )</
{{out}}
Line 2,090 ⟶ 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,127 ⟶ 2,845:
heapSort(sort.IntSlice(a))
fmt.Println("after: ", a)
}</
{{out}}
<pre>
Line 2,134 ⟶ 2,852:
</pre>
If you want to implement it manually:
<
import (
Line 2,171 ⟶ 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,199 ⟶ 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,208 ⟶ 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,222 ⟶ 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,289 ⟶ 3,098:
Sys.println('Sorted Strings: ' + stringArray);
}
}</
{{out}}
<pre>
Line 2,301 ⟶ 3,110:
=={{header|Icon}} and {{header|Unicon}}==
<
demosort(heapsort,[3, 14, 1, 5, 9, 2, 6, 3],"qwerty")
end
Line 2,337 ⟶ 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,357 ⟶ 3,166:
{{eff note|J|/:~}}
'''Translation of the pseudocode'''
<
siftDown=: 4 : 0
Line 2,373 ⟶ 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,435 ⟶ 3,342:
return;
}
}</
=={{header|Javascript}}==
<syntaxhighlight lang="javascript">
function heapSort(arr) {
heapify(arr)
[arr[end], arr[0]] = [arr[0], arr[end]]
end--
siftDown(arr, 0, end)
}
}
function
start = Math.floor(arr.length/2) - 1
siftDown(arr, start, arr.length - 1)
start--
}
}
function
while (rootPos * 2
if (
}
}
}
test('rosettacode', () => {
arr = [12, 11, 15, 10, 9, 1, 2, 3, 13, 14, 4, 5, 6, 7, 8,]
expect(arr).toStrictEqual([1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15])
})</syntaxhighlight>
{{out}}
<pre>
Line 2,490 ⟶ 3,391:
</pre>
=={{header|
{{works with|jq}}
'''Works with gojq, the Go implementation of jq'''
Since jq is a purely functional language, the putative benefits of the heapsort algorithm do not accrue here.
<syntaxhighlight lang="jq">def swap($a; $i; $j):
$a
| .[$i] as $t
| .[$i] = .[$j]
| .[$j] = $t ;
def siftDown($a; $start; $iend):
{ $a, root: $start }
| until( .stop or (.root*2 + 1 > $iend);
.child = .root*2 + 1
| if .child + 1 <= $iend and .a[.child] < .a[.child+1]
then .child += 1
else .
end
| if .a[.root] < .a[.child]
then
.a = swap(.a; .root; .child)
| .root = .child
else .stop = true
end)
| .a ;
def heapify:
length as $count
| {a: ., start: ((($count - 2)/2)|floor)}
| until(.start < 0;
.a = siftDown(.a; .start; $count - 1)
| .start += -1 )
| .a ;
def heapSort:
{ a: heapify,
iend: (length - 1) }
| until( .iend <= 0;
.a = swap(.a; 0; .iend)
| .iend += -1
| .a = siftDown(.a; 0; .iend) )
| .a ;
[4, 65, 2, -31, 0, 99, 2, 83, 782, 1], [7, 5, 2, 6, 1, 4, 2, 6, 3]
|
"Before: \(.)",
"After : \(heapSort)\n"
</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]
Before: [7,5,2,6,1,4,2,6,3]
After : [1,2,2,3,4,5,6,6,7]
</pre>
=={{header|Julia}}==
<syntaxhighlight lang="julia">function swap(a, i, j)
a[i], a[j] = a[j], a[i]
end
function pd!(a, first, last)
while (c = 2 * first - 1) < last
Line 2,499 ⟶ 3,460:
end
if a[first] < a[c]
first = c
else
Line 2,506 ⟶ 3,467:
end
end
function heapify!(a, n)
f = div(n, 2)
while f >= 1
pd!(a, f, n)
f -= 1
end
end
function heapsort!(a)
n = length(a)
heapify!(a, n)
l = n
while l > 1
swap(a, 1, l)
l -= 1
pd!(a, 1, l)
end
return a
end
using Random: shuffle
a = shuffle(collect(1:12))
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 2,520 ⟶ 3,498:
=={{header|Kotlin}}==
<
fun heapSort(a: IntArray) {
Line 2,567 ⟶ 3,545:
println(a.joinToString(", "))
}
}</
{{out}}
Line 2,577 ⟶ 3,555:
=={{header|Liberty BASIC}}==
<
data 6, 5, 3, 1, 8, 7, 2, 4
Line 2,654 ⟶ 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 2,714 ⟶ 3,692:
heapSort(inputs)
print ("sorted: " + inputs)
</syntaxhighlight>
{{out}}
<pre>
Line 2,727 ⟶ 3,705:
=={{header|LotusScript}}==
<syntaxhighlight lang="lotusscript">
Public Sub heapsort(pavIn As Variant)
Dim liCount As Integer, liEnd As Integer
Line 2,773 ⟶ 3,751:
wend
End Sub
</syntaxhighlight>
=={{header|M4}}==
<
define(`randSeed',141592653)
Line 2,831 ⟶ 3,809:
show(`a')
heapsort(`a')
show(`a')</
=={{header|Maple}}==
<syntaxhighlight lang="text">swap := proc(arr, a, b)
local temp:
temp := arr[a]:
Line 2,869 ⟶ 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 2,883 ⟶ 3,861:
]
]
heapSort[list_] := Module[{ count, start},
count = Length[list]; start = Floor[count/2];
Line 2,892 ⟶ 3,869:
count--; list = siftDown[list,1,count];
]
]</
{{out}}
<pre>heapSort@{2,3,1,5,7,6}
Line 2,899 ⟶ 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 2,938 ⟶ 3,915:
end
end</
Sample Usage:
<
ans =
1 2 3 4 5 6</
=={{header|MAXScript}}==
<
(
local s = count /2
Line 2,989 ⟶ 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,081 ⟶ 4,175:
end root
return a</
{{out}}
<pre>
Line 3,104 ⟶ 4,198:
=={{header|Nim}}==
<
var root = start
while root * 2 + 1 < ending:
Line 3,126 ⟶ 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,132 ⟶ 4,226:
=={{header|Objeck}}==
{{trans|Java}}
<
class HeapSort {
function : Main(args : String[]) ~ Nil {
Line 3,184 ⟶ 4,278:
}
}
}</
=={{header|OCaml}}==
<
let swap i j =
Line 3,209 ⟶ 4,303:
swap term 0;
sift 0 term;
done;;</
Usage:
<
heapsort a;
Array.iter (Printf.printf "%d ") a;;
Line 3,220 ⟶ 4,314:
heapsort b;
Array.iter print_char b;;
print_newline ();;</
{{out}}
<pre>
Line 3,229 ⟶ 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,285 ⟶ 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,415 ⟶ 4,486:
return $m;
}
</syntaxhighlight>
=={{header|Phix}}==
<!--<syntaxhighlight lang="phix">(phixonline)-->
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">siftDown</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">arr</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">integer</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">integer</span> <span style="color: #000000;">last</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">root</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">s</span>
<span style="color: #008080;">while</span> <span style="color: #000000;">root</span><span style="color: #0000FF;">*</span><span style="color: #000000;">2</span><span style="color: #0000FF;"><=</span><span style="color: #000000;">last</span> <span style="color: #008080;">do</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">child</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">root</span><span style="color: #0000FF;">*</span><span style="color: #000000;">2</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">child</span><span style="color: #0000FF;"><</span><span style="color: #000000;">last</span> <span style="color: #008080;">and</span> <span style="color: #000000;">arr</span><span style="color: #0000FF;">[</span><span style="color: #000000;">child</span><span style="color: #0000FF;">]<</span><span style="color: #000000;">arr</span><span style="color: #0000FF;">[</span><span style="color: #000000;">child</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">child</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">arr</span><span style="color: #0000FF;">[</span><span style="color: #000000;">root</span><span style="color: #0000FF;">]>=</span><span style="color: #000000;">arr</span><span style="color: #0000FF;">[</span><span style="color: #000000;">child</span><span style="color: #0000FF;">]</span> <span style="color: #008080;">then</span> <span style="color: #008080;">exit</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #004080;">object</span> <span style="color: #000000;">tmp</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">arr</span><span style="color: #0000FF;">[</span><span style="color: #000000;">root</span><span style="color: #0000FF;">]</span>
<span style="color: #000000;">arr</span><span style="color: #0000FF;">[</span><span style="color: #000000;">root</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">arr</span><span style="color: #0000FF;">[</span><span style="color: #000000;">child</span><span style="color: #0000FF;">]</span>
<span style="color: #000000;">arr</span><span style="color: #0000FF;">[</span><span style="color: #000000;">child</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">tmp</span>
<span style="color: #000000;">root</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">child</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">arr</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">heapify</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">arr</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">integer</span> <span style="color: #000000;">count</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">s</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">floor</span><span style="color: #0000FF;">(</span><span style="color: #000000;">count</span><span style="color: #0000FF;">/</span><span style="color: #000000;">2</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">while</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">></span><span style="color: #000000;">0</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">arr</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">siftDown</span><span style="color: #0000FF;">(</span><span style="color: #000000;">arr</span><span style="color: #0000FF;">,</span><span style="color: #000000;">s</span><span style="color: #0000FF;">,</span><span style="color: #000000;">count</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">s</span> <span style="color: #0000FF;">-=</span> <span style="color: #000000;">1</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">arr</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">heap_sort</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">arr</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">last</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">arr</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">arr</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">heapify</span><span style="color: #0000FF;">(</span><span style="color: #000000;">arr</span><span style="color: #0000FF;">,</span><span style="color: #000000;">last</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">while</span> <span style="color: #000000;">last</span><span style="color: #0000FF;">></span><span style="color: #000000;">1</span> <span style="color: #008080;">do</span>
<span style="color: #004080;">object</span> <span style="color: #000000;">tmp</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">arr</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span>
<span style="color: #000000;">arr</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">arr</span><span style="color: #0000FF;">[</span><span style="color: #000000;">last</span><span style="color: #0000FF;">]</span>
<span style="color: #000000;">arr</span><span style="color: #0000FF;">[</span><span style="color: #000000;">last</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">tmp</span>
<span style="color: #000000;">last</span> <span style="color: #0000FF;">-=</span> <span style="color: #000000;">1</span>
<span style="color: #000000;">arr</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">siftDown</span><span style="color: #0000FF;">(</span><span style="color: #000000;">arr</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">last</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">arr</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<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>
<!--</syntaxhighlight>-->
{{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,481 ⟶ 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 3,487 ⟶ 4,613:
=={{header|PL/I}}==
<
/*********************************************************************
* Pseudocode found here:
Line 3,562 ⟶ 4,688:
End;
End;</
{{out}}
<pre>
Line 3,618 ⟶ 4,744:
element 25 after sort zeta
</pre>
=={{header|PL/M}}==
<syntaxhighlight lang="plm">100H:
/* HEAP SORT AN ARRAY OF 16-BIT INTEGERS */
HEAP$SORT: PROCEDURE (AP, COUNT);
SIFT$DOWN: PROCEDURE (AP, START, ENDV);
DECLARE (AP, A BASED AP) ADDRESS;
DECLARE (START, ENDV, ROOT, CHILD, TEMP) ADDRESS;
ROOT = START;
DO WHILE (CHILD := SHL(ROOT,1) + 1) <= ENDV;
IF CHILD + 1 <= ENDV AND A(CHILD) < A(CHILD+1) THEN
CHILD = CHILD + 1;
IF A(ROOT) < A(CHILD) THEN DO;
TEMP = A(ROOT);
A(ROOT) = A(CHILD);
A(CHILD) = TEMP;
ROOT = CHILD;
END;
ELSE RETURN;
END;
END SIFT$DOWN;
HEAPIFY: PROCEDURE (AP, COUNT);
DECLARE (AP, COUNT, START) ADDRESS;
START = (COUNT-2) / 2;
LOOP:
CALL SIFT$DOWN(AP, START, COUNT-1);
IF START = 0 THEN RETURN;
START = START - 1;
GO TO LOOP;
END HEAPIFY;
DECLARE (AP, COUNT, ENDV, TEMP, A BASED AP) ADDRESS;
CALL HEAPIFY(AP, COUNT);
ENDV = COUNT - 1;
DO WHILE ENDV > 0;
TEMP = A(0);
A(0) = A(ENDV);
A(ENDV) = TEMP;
ENDV = ENDV - 1;
CALL SIFT$DOWN(AP, 0, ENDV);
END;
END HEAP$SORT;
/* CP/M CALLS AND FUNCTION TO PRINT INTEGERS */
BDOS: PROCEDURE (FN, ARG);
DECLARE FN BYTE, ARG ADDRESS;
GO TO 5;
END BDOS;
PRINT$NUMBER: PROCEDURE (N);
DECLARE S (7) BYTE INITIAL ('..... $');
DECLARE (N, P) ADDRESS, C BASED P BYTE;
P = .S(5);
DIGIT:
P = P-1;
C = N MOD 10 + '0';
N = N / 10;
IF N > 0 THEN GO TO DIGIT;
CALL BDOS(9, P);
END PRINT$NUMBER;
/* SORT AN ARRAY */
DECLARE NUMBERS (11) ADDRESS INITIAL (4, 65, 2, 31, 0, 99, 2, 8, 3, 782, 1);
CALL HEAP$SORT(.NUMBERS, LENGTH(NUMBERS));
/* PRINT THE SORTED ARRAY */
DECLARE N BYTE;
DO N = 0 TO LAST(NUMBERS);
CALL PRINT$NUMBER(NUMBERS(N));
END;
CALL BDOS(0,0);
EOF</syntaxhighlight>
{{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 3,656 ⟶ 4,861:
$array = @(60, 21, 19, 36, 63, 8, 100, 80, 3, 87, 11)
"$(heapsort $array $array.Count)"
</syntaxhighlight>
<b>Output:</b>
<pre>
Line 3,663 ⟶ 4,868:
=={{header|PureBasic}}==
<
Declare siftDown(Array a(1), start, ending)
Line 3,698 ⟶ 4,903:
EndIf
Wend
EndProcedure</
=={{header|Python}}==
<
''' Heapsort. Note: this function sorts in-place (it mutates the list). '''
Line 3,724 ⟶ 4,929:
root = child
else:
break</
Testing:
<pre>>>> ary = [7, 6, 5, 9, 8, 4, 3, 1, 2, 0]
>>> heapsort(ary)
[0, 1, 2, 3, 4, 5, 6, 7, 8, 9]</pre>
=={{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 </syntaxhighlight>
''' Output:'''
<pre> [ 45 82 25 50 14 45 11 25 21 91 10 63 77 42 80 99 16 81 88 97 84 80 87 ]
--> [ 10 11 14 16 21 25 25 42 45 45 50 63 77 80 80 81 82 84 87 88 91 97 99 ]</pre>
=={{header|Racket}}==
<
#lang racket
(require (only-in srfi/43 vector-swap!))
Line 3,758 ⟶ 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 3,786 ⟶ 5,008:
say 'Input = ' ~ @data;
@data.&heap_sort;
say 'Output = ' ~ @data;</
{{out}}
<pre>
Line 3,795 ⟶ 5,017:
=={{header|REXX}}==
===version 1, elements of an array===
This REXX version uses a ''heapsort'' to sort elements of an array
<br>or a mixture of both.
Indexing of the array
<
call show
call heapSort
call show " after sort:"
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
init: _= 'alpha beta gamma delta digamma epsilon zeta eta theta iota kappa lambda mu nu' ,
if x='' then x= _;
do j=1 for #; @.j= word(x, j); end; return /*assign letters to array*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
do n=n by -1 to 2; _= @.1; @.1=
end /*n*/; return /* [↑] swap two elements;
/*──────────────────────────────────────────────────────────────────────────────────────*/
heapSuff: procedure expose @.; parse arg i,n; $= @.i /*obtain parent.*/
do while i+i<=n; j= i+i; k= j+1; if k<=n then if @.k>@.j then j= k
if $>=@.j then leave; @.i= @.j; i= j
end /*while*/; @.i= $; return /*define lowest.*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
show: do s=1 for #; say ' element' right(s, length(#)) arg(1) @.s; end; return</syntaxhighlight>
{{out|output|text= when using the default (epichoric Greek alphabet) for input:}}
(Shown at three-quarter size.)
<pre style="font-size:75%>
element 1 before sort: alpha
element 2 before sort: beta
Line 3,882 ⟶ 5,103:
element 27 after sort: zeta
</pre>
{{out|output|text= when using the following for input: <tt> 19 0 -.2 .1 1e5 19 17 -6 789 11 37 </tt>}}
(Shown at three-quarter size.)
<pre style="font-size:75%">
element 1 before sort: 19
element 2 before sort: 0
Line 3,938 ⟶ 5,132:
</pre>
On an '''ASCII''' system, numbers are sorted ''before'' letters.
{{out|output|text= when executing on an '''ASCII''' system using the following for input: <tt> 11 33 22 scotoma pareidolia </tt>}}
<pre>
element 1 before sort: 11
element 2 before sort: 33
element 3 before sort: 22
element 4 before sort: scotoma
element 5 before sort: pareidolia
▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒
element 1 after sort: 11
element 2 after sort: 22
element 3 after sort: 33
element 4 after sort: pareidolia
element 5 after sort: scotoma
</pre>
On an '''EBCDIC''' system, numbers are sorted ''after'' letters.
{{out|output|text= when executing on an '''EBCDIC''' system using the following for input: <tt> 11 33 22 scotoma pareidolia</tt>}}
<pre>
element 1 before sort: 11
element 2 before sort: 33
element 3 before sort: 22
element 4 before sort: scotoma
element 5 before sort: pareidolia
▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒
element 1 after sort: pareidolia
element 2 after sort: scotoma
element 3 after sort: 11
element 4 after sort: 22
element 5 after sort: 33
</pre>
===version 2===
<syntaxhighlight lang="rexx">/* REXX ***************************************************************
* Translated from PL/I
* 27.07.2013 Walter Pachl
Line 4,010 ⟶ 5,238:
Say 'element' format(j,2) txt a.j
End
Return</
Output: see PL/I
=={{header|Ring}}==
<
# Project : Sorting algorithms/Heapsort
Line 4,065 ⟶ 5,293:
svect = left(svect, len(svect) - 1)
see svect + nl
</syntaxhighlight>
Output:
<pre>
Line 4,075 ⟶ 5,303:
=={{header|Ruby}}==
<
def heapsort
self.dup.heapsort!
Line 4,108 ⟶ 5,336:
end
end
end</
Testing:
<pre>irb(main):035:0> ary = [7, 6, 5, 9, 8, 4, 3, 1, 2, 0]
Line 4,118 ⟶ 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,160 ⟶ 5,388:
}
}
}</
Of course, you could also simply use <code>BinaryHeap</code> in the standard library.
<
fn main() {
Line 4,170 ⟶ 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,216 ⟶ 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,273 ⟶ 5,501:
(define uriah (list->vector '(3 5 7 9 0 8 1 4 2 6)))
(heapsort uriah)
uriah</
{{out}}
<pre>done
Line 4,279 ⟶ 5,507:
=={{header|Seed7}}==
<
local
var elemType: help is elemType.value;
Line 4,317 ⟶ 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 4,354 ⟶ 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 4,392 ⟶ 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 4,404 ⟶ 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 4,458 ⟶ 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 4,464 ⟶ 5,692:
Variant with siftup and siftdown, using Mata.
<
k = i
while (k > 1) {
Line 4,507 ⟶ 5,735:
siftdown(a, i-1)
}
}</
=={{header|Swift}}==
<
var count = list.count
Line 4,558 ⟶ 5,786:
shiftDown(&list, 0, end)
}
}</
=={{header|Tcl}}==
Based on the algorithm from Wikipedia:
{{works with|Tcl|8.5}}
<
proc heapsort {list {count ""}} {
Line 4,601 ⟶ 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 4,678 ⟶ 5,906:
:DelVar L<sub>3</sub>
:Return
=={{header|True BASIC}}==
{{trans|Liberty BASIC}}
<syntaxhighlight lang="qbasic">
!creamos la matriz y la inicializamos
LET lim = 20
DIM array(20)
FOR i = 1 TO lim
LET array(i) = INT(RND * 100) + 1
NEXT i
SUB printArray (lim)
FOR i = 1 TO lim
!PRINT using("###", array(i));
PRINT array(i); " ";
NEXT i
PRINT
END SUB
SUB heapify (count)
LET start = INT(count / 2)
DO WHILE start >= 1
CALL siftDown (start, count)
LET start = start - 1
LOOP
END SUB
SUB siftDown (inicio, final)
LET root = inicio
DO WHILE root * 2 <= final
LET child = root * 2
LET SWAP = root
IF array(SWAP) < array(child) THEN
LET SWAP = child
END IF
IF child+1 <= final THEN
IF array(SWAP) < array(child+1) THEN
LET SWAP = child + 1
END IF
END IF
IF SWAP <> root THEN
CALL SWAP (root, SWAP)
LET root = SWAP
ELSE
EXIT SUB
END IF
LOOP
END SUB
SUB SWAP (x,y)
LET tmp = array(x)
LET array(x) = array(y)
LET array(y) = tmp
END SUB
SUB heapSort (count)
CALL heapify (count)
PRINT "el montículo:"
CALL printArray (count)
LET final = count
DO WHILE final > 1
CALL SWAP (final, 1)
CALL siftDown (1, final-1)
LET final = final - 1
LOOP
END SUB
!--------------------------
PRINT "Antes de ordenar:"
CALL printArray (lim)
PRINT
CALL heapSort (lim)
PRINT
PRINT "Despues de ordenar:"
CALL printArray (lim)
END
</syntaxhighlight>
=={{header|uBasic/4tH}}==
<syntaxhighlight lang="text">PRINT "Heap sort:"
n = FUNC (_InitArray)
PROC _ShowArray (n)
Line 4,752 ⟶ 6,061:
PRINT
RETURN</
=={{header|Vala}}==
{{trans|C++}}
<
if (array[i1] == array[i2])
return;
Line 4,808 ⟶ 6,117:
stdout.printf("%d ", i);
}
}</
{{out}}
Line 4,817 ⟶ 6,126:
=={{header|VBA}}==
{{trans|FreeBASIC}}
<
Dim root As Long : root = start
Dim lb As Long : lb = LBound(list)
Line 4,863 ⟶ 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}}==
<syntaxhighlight lang="wren">var siftDown = Fn.new { |a, start, end|
var root = start
while (root*2 + 1 <= end) {
var child = root*2 + 1
if (child + 1 <= end && a[child] < a[child+1]) child = child + 1
if (a[root] < a[child]) {
var t = a[root]
a[root] = a[child]
a[child] = t
root = child
} else {
return
}
}
}
var heapify = Fn.new { |a, count|
var start = ((count - 2)/2).floor
while (start >= 0) {
siftDown.call(a, start, count - 1)
start = start - 1
}
}
var heapSort = Fn.new { |a|
var count = a.count
heapify.call(a, count)
var end = count - 1
while (end > 0) {
var t = a[end]
a[end] = a[0]
a[0] = t
end = end - 1
siftDown.call(a, 0, end)
}
}
var array = [ [4, 65, 2, -31, 0, 99, 2, 83, 782, 1], [7, 5, 2, 6, 1, 4, 2, 6, 3] ]
for (a in array) {
System.print("Before: %(a)")
heapSort.call(a)
System.print("After : %(a)")
System.print()
}</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]
Before: [7, 5, 2, 6, 1, 4, 2, 6, 3]
After : [1, 2, 2, 3, 4, 5, 6, 6, 7]
</pre>
<br>
Alternatively, we can just call a library method.
{{libheader|Wren-sort}}
<syntaxhighlight lang="wren">import "./sort" for Sort
var array = [ [4, 65, 2, -31, 0, 99, 2, 83, 782, 1], [7, 5, 2, 6, 1, 4, 2, 6, 3] ]
for (a in array) {
System.print("Before: %(a)")
Sort.heap(a)
System.print("After : %(a)")
System.print()
}</syntaxhighlight>
{{out}}
<pre>
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 4,884 ⟶ 6,355:
start = child;
}
}</
<
heapSort("this is a test".split("")).println();</
{{out}}
<pre>
|