Rosetta Code

Sorting algorithms/Heapsort: Difference between revisions

Page Discussion

Sorting algorithms/Heapsort (view source)

Revision as of 11:50, 8 February 2024

7,232 bytes added ,  3 months ago
m
→‎{{header|Wren}}: Changed to Wren S/H
(Added Algol W)
m (→‎{{header|Wren}}: Changed to Wren S/H)
 
(19 intermediate revisions by 9 users not shown)
Line 482:
.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}}==
<syntaxhighlight lang="actionscript">function heapSort(data:Vector.<int>):Vector.<int> {
Line 2,109 ⟶ 2,219:
=={{header|EasyLang}}==
 
<syntaxhighlight lang="text">subr make_heap
proc sort . d[] .
for i = 1 to n - 1
n if= data[i]len > datad[(i - 1) / 2]
# make j = iheap
for i = 2 to n
while data[j] > data[(j - 1) / 2]
if swap datad[ji] data> d[(ji -+ 1) /div 2]
j = (j - 1) / 2i
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
subr sort
n = len data[] ind = 2
while ind < i
call make_heap
for i = n - if ind + 1 downto< i and d[ind + 1] > d[ind]
ind += 1
swap data[0] data[i]
j = 0 .
ind = 1 if d[j] < d[ind]
swap d[j] d[ind]
while ind < i
.
if ind + 1 < i and data[ind + 1] > data[ind]
ind +j = 1ind
ind = 2 * j
.
.
if data[j] < data[ind]
swap data[j] data[ind]
.
j = ind
ind = 2 * j + 1
.
.
.
data[] = [ 29 4 72 44 55 26 27 77 92 5 ]
call sort data[]
print data[]</syntaxhighlight>
</syntaxhighlight>
 
=={{header|EchoLisp}}==
Line 2,806 ⟶ 2,918:
list
}</syntaxhighlight>
 
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:
<syntaxhighlight lang="groovy">println (heapSort([23,76,99,58,97,57,35,89,51,38,95,92,24,46,31,24,14,12,57,78,4]))
Line 2,814 ⟶ 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
<syntaxhighlight lang="haskell">import Data.Graph.Inductive.Internal.Heap(
Line 2,828 ⟶ 3,031:
where (x,r) = (findMin h,deleteMin h)
 
heapsortheapSort :: Ord a => [a] -> [a]
heapsortheapSort = (map fst) . toList . build . map (\x->(x,x))</syntaxhighlight>
e.g.
<syntaxhighlight lang="haskell">*Main> heapsort [[6,9],[2,13],[6,8,14,9],[10,7],[5]]
Line 4,179 ⟶ 4,382:
 
=={{header|Pascal}}==
{{works with|FPC}}
An example, which works on arrays with arbitrary bounds :-)
<syntaxhighlight lang="pascal">program HeapSortDemo;
program HeapSortDemo;
 
{$mode objfpc}{$h+}{$b-}
type
TIntArray = array[4..15] of integer;
var
data: TIntArray;
i: integer;
procedure siftDown(var a: TIntArray; start, ende: integer);
var
root, child, swap: integer;
begin
root := start;
while root * 2 - start + 1 <= ende do
begin
child := root * 2 - start + 1;
if (child + 1 <= ende) and (a[child] < a[child + 1]) then
inc(child);
if a[root] < a[child] then
begin
swap := a[root];
a[root] := a[child];
a[child] := swap;
root := child;
end
else
exit;
end;
end;
 
procedure heapifyHeapSort(var a: TIntArrayarray of Integer);
procedure SiftDown(Root, Last: Integer);
var
startChild, countTmp: integerInteger;
begin
while Root * 2 + 1 <= Last do begin
count := length(a);
start Child := low(a)Root + count div* 2 -+ 1;
if (Child + 1 <= Last) and (a[Child] < a[Child + 1]) then
while start >= low(a) do
begin Inc(Child);
if a[Root] < a[Child] then begin
siftdown(a, start, high(a));
dec(start) Tmp := a[Root];
a[Root] := a[Child];
a[Child] := Tmp;
Root := Child;
end else exit;
end;
end;
var
 
I, Tmp: Integer;
procedure heapSort(var a: TIntArray);
begin
var
for I := Length(a) div 2 downto 0 do
ende, swap: integer;
SiftDown(I, High(a));
begin
for I := High(a) downto 1 do begin
heapify(a);
endeTmp := high(a)[0];
whilea[0] ende:= > low(a) do[I];
begina[I] := Tmp;
SiftDown(0, I swap- := a[low(a1)];
a[low(a)] := a[ende];
a[ende] := swap;
dec(ende);
siftdown(a, low(a), ende);
end;
end;
end;
 
procedure PrintArray(const Name: string; const A: array of Integer);
var
I: Integer;
begin
Write(Name, ': [');
Randomize;
for I := 0 to High(A) - 1 do
writeln('The data before sorting:');
for i := lowWrite(data)A[I], to', high(data') do;
WriteLn(A[High(A)], ']');
begin
end;
data[i] := Random(high(data));
 
write(data[i]:4);
var
end;
a1: array[-7..5] of Integer = (-34, -20, 30, 13, 36, -10, 5, -25, 9, 19, 35, -50, 29);
writeln;
a2: array of Integer = (-9, 42, -38, -5, -38, 0, 0, -15, 37, 7, -7, 40);
heapSort(data);
begin
writeln('The data after sorting:');
HeapSort(a1);
for i := low(data) to high(data) do
PrintArray('a1', a1);
begin
writeHeapSort(data[i]:4a2);
PrintArray('a2', a2);
end;
end.
writeln;
end.</syntaxhighlight>
{{out}}
<pre>
a1: [-50, -34, -25, -20, -10, 5, 9, 13, 19, 29, 30, 35, 36]
The data before sorting:
a2: [-38, -38, -15, -9, -7, -5, 0, 0, 7, 37, 40, 42]
12 13 0 1 0 14 13 10 1 10 9 2
The data after sorting:
0 0 1 1 2 9 10 10 12 13 13 14
</pre>
 
Line 5,406 ⟶ 5,586:
=={{header|Sidef}}==
<syntaxhighlight lang="ruby">func sift_down(a, start, end) {
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; nil
}
}
}
 
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,440 ⟶ 5,620:
}
 
var arr = (1..10 -> shuffle); # creates a shuffled array
say arr; # prints the unsorted array
heap_sort(arr, arr.len); # sorts the array in-place
say arr; # prints the sorted array</syntaxhighlight>
{{out}}
<pre>[10, 5, 2, 1, 7, 6, 4, 8, 3, 9]
Line 5,993 ⟶ 6,173:
Wend
End Sub</syntaxhighlight>
 
=={{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="ecmascriptwren">var siftDown = Fn.new { |a, start, end|
var root = start
while (root*2 + 1 <= end) {
Line 6,032 ⟶ 6,257:
}
 
var asarray = [ [4, 65, 2, -31, 0, 99, 2, 83, 782, 1], [7, 5, 2, 6, 1, 4, 2, 6, 3] ]
for (a in asarray) {
System.print("Before: %(a)")
heapSort.call(a)
Line 6,051 ⟶ 6,276:
Alternatively, we can just call a library method.
{{libheader|Wren-sort}}
<syntaxhighlight lang="ecmascriptwren">import "./sort" for Sort
 
var asarray = [ [4, 65, 2, -31, 0, 99, 2, 83, 782, 1], [7, 5, 2, 6, 1, 4, 2, 6, 3] ]
for (a in asarray) {
System.print("Before: %(a)")
Sort.heap(a)
Line 6,065 ⟶ 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}}==
PureFox
9,476

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/330310...349791"