aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Initial data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 72d218235f
commit f23f22d71c
199087 changed files with 3378941 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

3
Task/Sorting-algorithms-Heapsort/00-META.yaml Normal file
View file

@ -0,0 +1,3 @@
---
from: http://rosettacode.org/wiki/Sorting_algorithms/Heapsort
note: Sorting Algorithms

64
Task/Sorting-algorithms-Heapsort/00-TASK.txt Normal file
View file

@ -0,0 +1,64 @@
{{Sorting Algorithm}}
[[Category:Sorting]]
{{wikipedia|Heapsort}}
{{omit from|GUISS}}
<br>
[[wp:Heapsort|Heapsort]] is an in-place sorting algorithm with worst case and average complexity of &nbsp; <span style="font-family: serif">O(''n'' log''n'')</span>.
The basic idea is to turn the array into a binary heap structure, which has the property that it allows efficient retrieval and removal of the maximal element.
We repeatedly "remove" the maximal element from the heap, thus building the sorted list from back to front.
A heap sort requires random access, so can only be used on an array-like data structure.
Pseudocode:
'''function''' heapSort(a, count) '''is'''
'''input:''' an unordered array ''a'' of length ''count''
<span style="color: grey">''(first place a in max-heap order)''</span>
heapify(a, count)
end := count - 1
'''while''' end > 0 '''do'''
<span style="color: grey">''(swap the root(maximum value) of the heap with the''
''last element of the heap)''</span>
swap(a[end], a[0])
<span style="color: grey">''(decrement the size of the heap so that the previous''
''max value will stay in its proper place)''</span>
end := end - 1
<span style="color: grey">''(put the heap back in max-heap order)''</span>
siftDown(a, 0, end)
'''function''' heapify(a,count) '''is'''
<span style="color: grey">''(start is assigned the index in ''a'' of the last parent node)''</span>
start := (count - 2) / 2
'''while''' start ≥ 0 '''do'''
<span style="color: grey">''(sift down the node at index start to the proper place''
''such that all nodes below the start index are in heap''
''order)''</span>
siftDown(a, start, count-1)
start := start - 1
<span style="color: grey">''(after sifting down the root all nodes/elements are in heap order)''</span>
'''function''' siftDown(a, start, end) '''is'''
<span style="color: grey">''(''end'' represents the limit of how far down the heap to sift)''</span>
root := start
'''while''' root * 2 + 1 ≤ end '''do''' <span style="color: grey">''(While the root has at least one child)''</span>
child := root * 2 + 1 <span style="color: grey">''(root*2+1 points to the left child)''</span>
<span style="color: grey">''(If the child has a sibling and the child's value is less than its sibling's...)''</span>
'''if''' child + 1 ≤ end '''and''' a[child] < a[child + 1] '''then'''
child := child + 1 <span style="color: grey">''(... then point to the right child instead)''</span>
'''if''' a[root] < a[child] '''then''' <span style="color: grey">''(out of max-heap order)''</span>
swap(a[root], a[child])
root := child <span style="color: grey">''(repeat to continue sifting down the child now)''</span>
'''else'''
'''return'''
<br>
Write a function to sort a collection of integers using heapsort.
<br><br>

25
Task/Sorting-algorithms-Heapsort/11l/sorting-algorithms-heapsort.11l Normal file
View file

@ -0,0 +1,25 @@
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)

135
Task/Sorting-algorithms-Heapsort/360-Assembly/sorting-algorithms-heapsort.360 Normal file
View file

@ -0,0 +1,135 @@
* Heap sort 22/06/2016
HEAPS CSECT
USING HEAPS,R13 base register
B 72(R15) skip savearea
DC 17F'0' savearea
STM R14,R12,12(R13) prolog
ST R13,4(R15) "
ST R15,8(R13) "
LR R13,R15 "
L R1,N n
BAL R14,HEAPSORT call heapsort(n)
LA R3,PG pgi=0
LA R6,1 i=1
DO WHILE=(C,R6,LE,N) for i=1 to n
LR R1,R6 i
SLA R1,2 .
L R2,A-4(R1) a(i)
XDECO R2,XDEC edit a(i)
MVC 0(4,R3),XDEC+8 output a(i)
LA R3,4(R3) pgi=pgi+4
LA R6,1(R6) i=i+1
ENDDO , end for
XPRNT PG,80 print buffer
L R13,4(0,R13) epilog
LM R14,R12,12(R13) "
XR R15,R15 "
BR R14 exit
PG DC CL80' ' local data
XDEC DS CL12 "
*------- heapsort(icount)----------------------------------------------
HEAPSORT ST R14,SAVEHPSR save return addr
ST R1,ICOUNT icount
BAL R14,HEAPIFY call heapify(icount)
MVC IEND,ICOUNT iend=icount
DO WHILE=(CLC,IEND,GT,=F'1') while iend>1
L R1,IEND iend
LA R2,1 1
BAL R14,SWAP call swap(iend,1)
LA R1,1 1
L R2,IEND iend
BCTR R2,0 -1
ST R2,IEND iend=iend-1
BAL R14,SIFTDOWN call siftdown(1,iend)
ENDDO , end while
L R14,SAVEHPSR restore return addr
BR R14 return to caller
SAVEHPSR DS A local data
ICOUNT DS F "
IEND DS F "
*------- heapify(count)------------------------------------------------
HEAPIFY ST R14,SAVEHPFY save return addr
ST R1,COUNT count
SRA R1,1 /2
ST R1,ISTART istart=count/2
DO WHILE=(C,R1,GE,=F'1') while istart>=1
L R1,ISTART istart
L R2,COUNT count
BAL R14,SIFTDOWN call siftdown(istart,count)
L R1,ISTART istart
BCTR R1,0 -1
ST R1,ISTART istart=istart-1
ENDDO , end while
L R14,SAVEHPFY restore return addr
BR R14 return to caller
SAVEHPFY DS A local data
COUNT DS F "
ISTART DS F "
*------- siftdown(jstart,jend)-----------------------------------------
SIFTDOWN ST R14,SAVESFDW save return addr
ST R1,JSTART jstart
ST R2,JEND jend
ST R1,ROOT root=jstart
LR R3,R1 root
SLA R3,1 root*2
DO WHILE=(C,R3,LE,JEND) while root*2<=jend
ST R3,CHILD child=root*2
MVC SW,ROOT sw=root
L R1,SW sw
SLA R1,2 .
L R2,A-4(R1) a(sw)
L R1,CHILD child
SLA R1,2 .
L R3,A-4(R1) a(child)
IF CR,R2,LT,R3 THEN if a(sw)<a(child) then
MVC SW,CHILD sw=child
ENDIF , end if
L R2,CHILD child
LA R2,1(R2) +1
L R1,SW sw
SLA R1,2 .
L R3,A-4(R1) a(sw)
L R1,CHILD child
LA R1,1(R1) +1
SLA R1,2 .
L R4,A-4(R1) a(child+1)
IF C,R2,LE,JEND,AND, if child+1<=jend and X
CR,R3,LT,R4 THEN a(sw)<a(child+1) then
L R2,CHILD child
LA R2,1(R2) +1
ST R2,SW sw=child+1
ENDIF , end if
IF CLC,SW,NE,ROOT THEN if sw^=root then
L R1,ROOT root
L R2,SW sw
BAL R14,SWAP call swap(root,sw)
MVC ROOT,SW root=sw
ELSE , else
B RETSFDW return
ENDIF , end if
L R3,ROOT root
SLA R3,1 root*2
ENDDO , end while
RETSFDW L R14,SAVESFDW restore return addr
BR R14 return to caller
SAVESFDW DS A local data
JSTART DS F "
ROOT DS F "
JEND DS F "
CHILD DS F "
SW DS F "
*------- swap(x,y)-----------------------------------------------------
SWAP SLA R1,2 x
LA R1,A-4(R1) @a(x)
SLA R2,2 y
LA R2,A-4(R2) @a(y)
L R3,0(R1) temp=a(x)
MVC 0(4,R1),0(R2) a(x)=a(y)
ST R3,0(R2) a(y)=temp
BR R14 return to caller
*------- ------ -------------------------------------------------------
A DC F'4',F'65',F'2',F'-31',F'0',F'99',F'2',F'83',F'782',F'1'
DC F'45',F'82',F'69',F'82',F'104',F'58',F'88',F'112',F'89',F'74'
N DC A((N-A)/L'A) number of items
YREGS
END HEAPS

237
Task/Sorting-algorithms-Heapsort/AArch64-Assembly/sorting-algorithms-heapsort.aarch64 Normal file
View file

@ -0,0 +1,237 @@
/* 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"

52
Task/Sorting-algorithms-Heapsort/ALGOL-68/sorting-algorithms-heapsort.alg Normal file
View file

@ -0,0 +1,52 @@
#--- Swap function ---#
PROC swap = (REF []INT array, INT first, INT second) VOID:
(
INT temp := array[first];
array[first] := array[second];
array[second]:= temp
);
#--- Heap sort Move Down ---#
PROC heapmove = (REF []INT array, INT i, INT last) VOID:
(
INT index := i;
INT larger := (index*2);
WHILE larger <= last DO
IF larger < last THEN IF array[larger] < array[larger+1] THEN
larger +:= 1
FI FI;
IF array[index] < array[larger] THEN
swap(array, index, larger)
FI;
index := larger;
larger := (index*2)
OD
);
#--- Heap sort ---#
PROC heapsort = (REF []INT array) VOID:
(
FOR i FROM ENTIER((UPB array) / 2) BY -1 WHILE
heapmove(array, i, UPB array);
i > 1 DO SKIP OD;
FOR i FROM UPB array BY -1 WHILE
swap(array, 1, i);
heapmove(array, 1, i-1);
i > 1 DO SKIP OD
);
#***************************************************************#
main:
(
[10]INT a;
FOR i FROM 1 TO UPB a DO
a[i] := ROUND(random*100)
OD;
print(("Before:", a));
print((newline, newline));
heapsort(a);
print(("After: ", a))
)

68
Task/Sorting-algorithms-Heapsort/ALGOL-W/sorting-algorithms-heapsort.alg Normal file
View file

@ -0,0 +1,68 @@
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.

288
Task/Sorting-algorithms-Heapsort/ARM-Assembly/sorting-algorithms-heapsort.arm Normal file
View file

@ -0,0 +1,288 @@
/* ARM assembly Raspberry PI */
/* program heapSort.s */
/* look Pseudocode begin this task */
/************************************/
/* Constantes */
/************************************/
.equ STDOUT, 1 @ Linux output console
.equ EXIT, 1 @ Linux syscall
.equ WRITE, 4 @ Linux syscall
/*********************************/
/* Initialized data */
/*********************************/
.data
szMessSortOk: .asciz "Table sorted.\n"
szMessSortNok: .asciz "Table not sorted !!!!!.\n"
sMessResult: .ascii "Value : "
sMessValeur: .fill 11, 1, ' ' @ size => 11
szCarriageReturn: .asciz "\n"
.align 4
iGraine: .int 123456
.equ NBELEMENTS, 10
TableNumber: .int 1,3,6,2,5,9,10,8,4,7
#TableNumber: .int 10,9,8,7,6,5,4,3,2,1
/*********************************/
/* UnInitialized data */
/*********************************/
.bss
/*********************************/
/* code section */
/*********************************/
.text
.global main
main: @ entry of program
1:
ldr r0,iAdrTableNumber @ address number table
mov r1,#NBELEMENTS @ number of élements
bl heapSort
ldr r0,iAdrTableNumber @ address number table
bl displayTable
ldr r0,iAdrTableNumber @ address number table
mov r1,#NBELEMENTS @ number of élements
bl isSorted @ control sort
cmp r0,#1 @ sorted ?
beq 2f
ldr r0,iAdrszMessSortNok @ no !! error sort
bl affichageMess
b 100f
2: @ yes
ldr r0,iAdrszMessSortOk
bl affichageMess
100: @ standard end of the program
mov r0, #0 @ return code
mov r7, #EXIT @ request to exit program
svc #0 @ perform the system call
iAdrsMessValeur: .int sMessValeur
iAdrszCarriageReturn: .int szCarriageReturn
iAdrsMessResult: .int sMessResult
iAdrTableNumber: .int TableNumber
iAdrszMessSortOk: .int szMessSortOk
iAdrszMessSortNok: .int szMessSortNok
/******************************************************************/
/* control sorted table */
/******************************************************************/
/* r0 contains the address of table */
/* r1 contains the number of elements > 0 */
/* r0 return 0 if not sorted 1 if sorted */
isSorted:
push {r2-r4,lr} @ save registers
mov r2,#0
ldr r4,[r0,r2,lsl #2]
1:
add r2,#1
cmp r2,r1
movge r0,#1
bge 100f
ldr r3,[r0,r2, lsl #2]
cmp r3,r4
movlt r0,#0
blt 100f
mov r4,r3
b 1b
100:
pop {r2-r4,lr}
bx lr @ return
/******************************************************************/
/* heap sort */
/******************************************************************/
/* r0 contains the address of table */
/* r1 contains the number of element */
heapSort:
push {r2,r3,r4,lr} @ save registers
bl heapify @ first place table in max-heap order
sub r3,r1,#1
1:
cmp r3,#0
ble 100f
mov r1,#0 @ swap the root(maximum value) of the heap with the last element of the heap)
mov r2,r3
bl swapElement
sub r3,#1
mov r1,#0
mov r2,r3 @ put the heap back in max-heap order
bl siftDown
b 1b
100:
pop {r2,r3,r4,lr}
bx lr @ return
/******************************************************************/
/* place table in max-heap order */
/******************************************************************/
/* r0 contains the address of table */
/* r1 contains the number of element */
heapify:
push {r1,r2,r3,r4,lr} @ save registers
mov r4,r1
sub r3,r1,#2
lsr r3,#1
1:
cmp r3,#0
blt 100f
mov r1,r3
sub r2,r4,#1
bl siftDown
sub r3,#1
b 1b
100:
pop {r1,r2,r3,r4,lr}
bx lr @ return
/******************************************************************/
/* swap two elements of table */
/******************************************************************/
/* r0 contains the address of table */
/* r1 contains the first index */
/* r2 contains the second index */
swapElement:
push {r3,r4,lr} @ save registers
ldr r3,[r0,r1,lsl #2] @ swap number on the table
ldr r4,[r0,r2,lsl #2]
str r4,[r0,r1,lsl #2]
str r3,[r0,r2,lsl #2]
100:
pop {r3,r4,lr}
bx lr @ return
/******************************************************************/
/* put the heap back in max-heap order */
/******************************************************************/
/* r0 contains the address of table */
/* r1 contains the first index */
/* r2 contains the last index */
siftDown:
push {r1-r7,lr} @ save registers
@ r1 = root = start
mov r3,r2 @ save last index
1:
lsl r4,r1,#1
add r4,#1
cmp r4,r3
bgt 100f
add r5,r4,#1
cmp r5,r3
bgt 2f
ldr r6,[r0,r4,lsl #2] @ compare elements on the table
ldr r7,[r0,r5,lsl #2]
cmp r6,r7
movlt r4,r5
2:
ldr r7,[r0,r4,lsl #2] @ compare elements on the table
ldr r6,[r0,r1,lsl #2] @ root
cmp r6,r7
bge 100f
mov r2,r4 @ and r1 is root
bl swapElement
mov r1,r4 @ root = child
b 1b
100:
pop {r1-r7,lr}
bx lr @ return
/******************************************************************/
/* Display table elements */
/******************************************************************/
/* r0 contains the address of table */
displayTable:
push {r0-r3,lr} @ save registers
mov r2,r0 @ table address
mov r3,#0
1: @ loop display table
ldr r0,[r2,r3,lsl #2]
ldr r1,iAdrsMessValeur @ display value
bl conversion10 @ call function
ldr r0,iAdrsMessResult
bl affichageMess @ display message
add r3,#1
cmp r3,#NBELEMENTS - 1
ble 1b
ldr r0,iAdrszCarriageReturn
bl affichageMess
100:
pop {r0-r3,lr}
bx lr
/******************************************************************/
/* display text with size calculation */
/******************************************************************/
/* r0 contains the address of the message */
affichageMess:
push {r0,r1,r2,r7,lr} @ save registres
mov r2,#0 @ counter length
1: @ loop length calculation
ldrb r1,[r0,r2] @ read octet start position + index
cmp r1,#0 @ if 0 its over
addne r2,r2,#1 @ else add 1 in the length
bne 1b @ and loop
@ so here r2 contains the length of the message
mov r1,r0 @ address message in r1
mov r0,#STDOUT @ code to write to the standard output Linux
mov r7, #WRITE @ code call system "write"
svc #0 @ call systeme
pop {r0,r1,r2,r7,lr} @ restaur des 2 registres */
bx lr @ return
/******************************************************************/
/* Converting a register to a decimal unsigned */
/******************************************************************/
/* r0 contains value and r1 address area */
/* r0 return size of result (no zero final in area) */
/* area size => 11 bytes */
.equ LGZONECAL, 10
conversion10:
push {r1-r4,lr} @ save registers
mov r3,r1
mov r2,#LGZONECAL
1: @ start loop
bl divisionpar10U @ unsigned r0 <- dividende. quotient ->r0 reste -> r1
add r1,#48 @ digit
strb r1,[r3,r2] @ store digit on area
cmp r0,#0 @ stop if quotient = 0
subne r2,#1 @ else previous position
bne 1b @ and loop
@ and move digit from left of area
mov r4,#0
2:
ldrb r1,[r3,r2]
strb r1,[r3,r4]
add r2,#1
add r4,#1
cmp r2,#LGZONECAL
ble 2b
@ and move spaces in end on area
mov r0,r4 @ result length
mov r1,#' ' @ space
3:
strb r1,[r3,r4] @ store space in area
add r4,#1 @ next position
cmp r4,#LGZONECAL
ble 3b @ loop if r4 <= area size
100:
pop {r1-r4,lr} @ restaur registres
bx lr @return
/***************************************************/
/* division par 10 unsigned */
/***************************************************/
/* r0 dividende */
/* r0 quotient */
/* r1 remainder */
divisionpar10U:
push {r2,r3,r4, lr}
mov r4,r0 @ save value
//mov r3,#0xCCCD @ r3 <- magic_number lower raspberry 3
//movt r3,#0xCCCC @ r3 <- magic_number higter raspberry 3
ldr r3,iMagicNumber @ r3 <- magic_number raspberry 1 2
umull r1, r2, r3, r0 @ r1<- Lower32Bits(r1*r0) r2<- Upper32Bits(r1*r0)
mov r0, r2, LSR #3 @ r2 <- r2 >> shift 3
add r2,r0,r0, lsl #2 @ r2 <- r0 * 5
sub r1,r4,r2, lsl #1 @ r1 <- r4 - (r2 * 2) = r4 - (r0 * 10)
pop {r2,r3,r4,lr}
bx lr @ leave function
iMagicNumber: .int 0xCCCCCCCD

83
Task/Sorting-algorithms-Heapsort/Action-/sorting-algorithms-heapsort.action Normal file
View file

@ -0,0 +1,83 @@
;;; 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

29
Task/Sorting-algorithms-Heapsort/ActionScript/sorting-algorithms-heapsort.as Normal file
View file

@ -0,0 +1,29 @@
function heapSort(data:Vector.<int>):Vector.<int> {
for (var start:int = (data.length-2)/2; start >= 0; start--) {
siftDown(data, start, data.length);
}
for (var end:int = data.length - 1; end > 0; end--) {
var tmp:int=data[0];
data[0]=data[end];
data[end]=tmp;
siftDown(data, 0, end);
}
return data;
}
function siftDown(data:Vector.<int>, start:int, end:int):void {
var heapRoot:int=start;
while (heapRoot * 2+1 < end) {
var child:int=heapRoot*2+1;
if (child+1<end&&data[child]<data[child+1]) {
child++;
}
if (data[heapRoot]<data[child]) {
var tmp:int=data[heapRoot];
data[heapRoot]=data[child];
data[child]=tmp;
heapRoot=child;
} else {
return;
}
}
}

6
Task/Sorting-algorithms-Heapsort/Ada/sorting-algorithms-heapsort-1.ada Normal file
View file

@ -0,0 +1,6 @@
generic
type Element_Type is private;
type Index_Type is (<>);
type Collection is array(Index_Type range <>) of Element_Type;
with function "<" (Left, right : element_type) return boolean is <>;
procedure Generic_Heapsort(Item : in out Collection);

50
Task/Sorting-algorithms-Heapsort/Ada/sorting-algorithms-heapsort-2.ada Normal file
View file

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

19
Task/Sorting-algorithms-Heapsort/Ada/sorting-algorithms-heapsort-3.ada Normal file
View file

@ -0,0 +1,19 @@
with Generic_Heapsort;
with Ada.Text_Io; use Ada.Text_Io;
procedure Test_Generic_Heapsort is
type Days is (Sun, Mon, Tue, Wed, Thu, Fri, Sat);
type Days_Col is array(Days range <>) of Natural;
procedure Sort is new Generic_Heapsort(Natural, Days, Days_Col);
Week : Days_Col := (5, 2, 7, 3, 4, 9, 1);
begin
for I in Week'range loop
Put(Days'Image(I) & ":" & Natural'Image(Week(I)) & " ");
end loop;
New_Line;
Sort(Week);
for I in Week'range loop
Put(Days'Image(I) & ":" & Natural'Image(Week(I))& " ");
end loop;
New_Line;
end Test_Generic_Heapsort;

63
Task/Sorting-algorithms-Heapsort/AppleScript/sorting-algorithms-heapsort-1.applescript Normal file
View file

@ -0,0 +1,63 @@
-- 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 as a script property to allow faster references to its items.
property lst : theList
-- In a binary heap, the list index of each node's first child is (node index * 2) - (l - 1). Preset the constant part.
property const : l - 1
-- Private subhandler: sift a value down into the heap from a given node.
on siftDown(siftV, node, endOfHeap)
set child to node * 2 - 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
end if
if (childV > siftV) then
set my lst's item node to childV
set node to child
set child to node * 2 - 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 "heap" with its "top" at the leftmost position.
repeat with i from (l + r) div 2 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 {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

1
Task/Sorting-algorithms-Heapsort/AppleScript/sorting-algorithms-heapsort-2.applescript Normal file
View file

@ -0,0 +1 @@
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}

71
Task/Sorting-algorithms-Heapsort/AppleScript/sorting-algorithms-heapsort-3.applescript Normal file
View file

@ -0,0 +1,71 @@
-- 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

1
Task/Sorting-algorithms-Heapsort/AppleScript/sorting-algorithms-heapsort-4.applescript Normal file
View file

@ -0,0 +1 @@
{8, 9, 16, 17, 19, 19, 20, 23, 25, 27, 29, 32, 42, 43, 44, 46, 71, 75, 75, 75, 79, 89, 93, 97, 99}

33
Task/Sorting-algorithms-Heapsort/Arturo/sorting-algorithms-heapsort.arturo Normal file
View file

@ -0,0 +1,33 @@
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]

34
Task/Sorting-algorithms-Heapsort/AutoHotkey/sorting-algorithms-heapsort.ahk Normal file
View file

@ -0,0 +1,34 @@
heapSort(a) {
Local end
end := %a%0
heapify(a,end)
While end > 1
%a%%end% := (%a%1 "", %a%1 := %a%%end%)
,siftDown(a, 1, --end)
}
heapify(a, count) {
Local start
start := count // 2
While start
siftDown(a, start--, count)
}
siftDown(a, start, end) {
Local child, c1
While start*2 <= end {
c1 := 1 + child := start*2
If (c1 <= end && %a%%child% < %a%%c1%)
child := c1
If (%a%%start% < %a%%child%)
%a%%start% := (%a%%child% "", %a%%child% := %a%%start%)
,start := child
Else Return
}
}
a = 1,5,2,7,3,4,6,8,1 ; ----- test -----
StringSplit a, a, `,
heapSort("a")
ListVars
MsgBox

35
Task/Sorting-algorithms-Heapsort/BBC-BASIC/sorting-algorithms-heapsort.basic Normal file
View file

@ -0,0 +1,35 @@
DIM test(9)
test() = 4, 65, 2, -31, 0, 99, 2, 83, 782, 1
PROCheapsort(test())
FOR i% = 0 TO 9
PRINT test(i%) ;
NEXT
PRINT
END
DEF PROCheapsort(a())
LOCAL e%
PROCheapify(a())
FOR e% = DIM(a(),1) TO 1 STEP -1
SWAP a(e%), a(0)
PROCsiftdown(a(), 0, e%-1)
NEXT
ENDPROC
DEF PROCheapify(a())
LOCAL s%, m%
m% = DIM(a(),1)
FOR s% = (m% - 1) / 2 TO 0 STEP -1
PROCsiftdown(a(), s%, m%)
NEXT
ENDPROC
DEF PROCsiftdown(a(), s%, e%)
LOCAL c%, r%
r% = s%
WHILE r% * 2 + 1 <= e%
c% = r% * 2 + 1
IF c% + 1 <= e% IF a(c%) < a(c% + 1) c% += 1
IF a(r%) < a(c%) SWAP a(r%), a(c%) : r% = c% ELSE ENDPROC
ENDWHILE
ENDPROC

42
Task/Sorting-algorithms-Heapsort/BCPL/sorting-algorithms-heapsort.bcpl Normal file
View file

@ -0,0 +1,42 @@
// This can be run using Cintcode BCPL freely available from www.cl.cam.ac.uk/users/mr10.
GET "libhdr.h"
LET heapify(v, k, i, last) BE
{ LET j = i+i // If there is a son (or two), j = subscript of first.
AND x = k // x will hold the larger of the sons if any.
IF j<=last DO x := v!j // j, x = subscript and key of first son.
IF j< last DO
{ LET y = v!(j+1) // y = key of the other son.
IF x<y DO x,j := y, j+1 // j, x = subscript and key of larger son.
}
IF k>=x DO
{ v!i := k // k is not lower than larger son if any.
RETURN
}
v!i := x
i := j
} REPEAT
AND heapsort(v, upb) BE
{ FOR i = upb/2 TO 1 BY -1 DO heapify(v, v!i, i, upb)
FOR i = upb TO 2 BY -1 DO
{ LET k = v!i
v!i := v!1
heapify(v, k, 1, i-1)
}
}
LET start() = VALOF {
LET v = VEC 1000
FOR i = 1 TO 1000 DO v!i := randno(1_000_000)
heapsort(v, 1000)
FOR i = 1 TO 1000 DO
{ IF i MOD 10 = 0 DO newline()
writef(" %i6", v!i)
}
newline()
}

16
Task/Sorting-algorithms-Heapsort/C++/sorting-algorithms-heapsort-1.cpp Normal file
View file

@ -0,0 +1,16 @@
#include <algorithm>
#include <iterator>
#include <iostream>
template<typename RandomAccessIterator>
void heap_sort(RandomAccessIterator begin, RandomAccessIterator end) {
std::make_heap(begin, end);
std::sort_heap(begin, end);
}
int main() {
int a[] = {100, 2, 56, 200, -52, 3, 99, 33, 177, -199};
heap_sort(std::begin(a), std::end(a));
copy(std::begin(a), std::end(a), std::ostream_iterator<int>(std::cout, " "));
std::cout << "\n";
}

47
Task/Sorting-algorithms-Heapsort/C++/sorting-algorithms-heapsort-2.cpp Normal file
View file

@ -0,0 +1,47 @@
#include <iostream>
#include <vector>
using namespace std;
void shift_down(vector<int>& heap,int i, int max) {
int i_big, c1, c2;
while(i < max) {
i_big = i;
c1 = (2*i) + 1;
c2 = c1 + 1;
if( c1<max && heap[c1]>heap[i_big] )
i_big = c1;
if( c2<max && heap[c2]>heap[i_big] )
i_big = c2;
if(i_big == i) return;
swap(heap[i],heap[i_big]);
i = i_big;
}
}
void to_heap(vector<int>& arr) {
int i = (arr.size()/2) - 1;
while(i >= 0) {
shift_down(arr, i, arr.size());
--i;
}
}
void heap_sort(vector<int>& arr) {
to_heap(arr);
int end = arr.size() - 1;
while (end > 0) {
swap(arr[0], arr[end]);
shift_down(arr, 0, end);
--end;
}
}
int main() {
vector<int> data = {
12, 11, 15, 10, 9, 1, 2,
3, 13, 14, 4, 5, 6, 7, 8
};
heap_sort(data);
for(int i : data) cout << i << " ";
}

76
Task/Sorting-algorithms-Heapsort/C-sharp/sorting-algorithms-heapsort.cs Normal file
View file

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

50
Task/Sorting-algorithms-Heapsort/C/sorting-algorithms-heapsort.c Normal file
View file

@ -0,0 +1,50 @@
#include <stdio.h>
int max (int *a, int n, int i, int j, int k) {
int m = i;
if (j < n && a[j] > a[m]) {
m = j;
}
if (k < n && a[k] > a[m]) {
m = k;
}
return m;
}
void downheap (int *a, int n, int i) {
while (1) {
int j = max(a, n, i, 2 * i + 1, 2 * i + 2);
if (j == i) {
break;
}
int t = a[i];
a[i] = a[j];
a[j] = t;
i = j;
}
}
void heapsort (int *a, int n) {
int i;
for (i = (n - 2) / 2; i >= 0; i--) {
downheap(a, n, i);
}
for (i = 0; i < n; i++) {
int t = a[n - i - 1];
a[n - i - 1] = a[0];
a[0] = t;
downheap(a, n - i - 1, 0);
}
}
int main () {
int a[] = {4, 65, 2, -31, 0, 99, 2, 83, 782, 1};
int n = sizeof a / sizeof a[0];
int i;
for (i = 0; i < n; i++)
printf("%d%s", a[i], i == n - 1 ? "\n" : " ");
heapsort(a, n);
for (i = 0; i < n; i++)
printf("%d%s", a[i], i == n - 1 ? "\n" : " ");
return 0;
}

82
Task/Sorting-algorithms-Heapsort/CLU/sorting-algorithms-heapsort.clu Normal file
View file

@ -0,0 +1,82 @@
% 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

81
Task/Sorting-algorithms-Heapsort/COBOL/sorting-algorithms-heapsort.cobol Normal file
View file

@ -0,0 +1,81 @@
>>SOURCE FORMAT FREE
*> This code is dedicated to the public domain
*> This is GNUCOBOL 2.0
identification division.
program-id. heapsort.
environment division.
configuration section.
repository. function all intrinsic.
data division.
working-storage section.
01 filler.
03 a pic 99.
03 a-start pic 99.
03 a-end pic 99.
03 a-parent pic 99.
03 a-child pic 99.
03 a-sibling pic 99.
03 a-lim pic 99 value 10.
03 array-swap pic 99.
03 array occurs 10 pic 99.
procedure division.
start-heapsort.
*> fill the array
compute a = random(seconds-past-midnight)
perform varying a from 1 by 1 until a > a-lim
compute array(a) = random() * 100
end-perform
perform display-array
display space 'initial array'
*>heapify the array
move a-lim to a-end
compute a-start = (a-lim + 1) / 2
perform sift-down varying a-start from a-start by -1 until a-start = 0
perform display-array
display space 'heapified'
*> sort the array
move 1 to a-start
move a-lim to a-end
perform until a-end = a-start
move array(a-end) to array-swap
move array(a-start) to array(a-end)
move array-swap to array(a-start)
subtract 1 from a-end
perform sift-down
end-perform
perform display-array
display space 'sorted'
stop run
.
sift-down.
move a-start to a-parent
perform until a-parent * 2 > a-end
compute a-child = a-parent * 2
compute a-sibling = a-child + 1
if a-sibling <= a-end and array(a-child) < array(a-sibling)
*> take the greater of the two
move a-sibling to a-child
end-if
if a-child <= a-end and array(a-parent) < array(a-child)
*> the child is greater than the parent
move array(a-child) to array-swap
move array(a-parent) to array(a-child)
move array-swap to array(a-parent)
end-if
*> continue down the tree
move a-child to a-parent
end-perform
.
display-array.
perform varying a from 1 by 1 until a > a-lim
display space array(a) with no advancing
end-perform
.
end program heapsort.

27
Task/Sorting-algorithms-Heapsort/Clojure/sorting-algorithms-heapsort-1.clj Normal file
View file

@ -0,0 +1,27 @@
(defn- swap [a i j]
(assoc a i (nth a j) j (nth a i)))
(defn- sift [a pred k l]
(loop [a a x k y (inc (* 2 k))]
(if (< (inc (* 2 x)) l)
(let [ch (if (and (< y (dec l)) (pred (nth a y) (nth a (inc y))))
(inc y)
y)]
(if (pred (nth a x) (nth a ch))
(recur (swap a x ch) ch (inc (* 2 ch)))
a))
a)))
(defn- heapify[pred a len]
(reduce (fn [c term] (sift (swap c term 0) pred 0 term))
(reduce (fn [c i] (sift c pred i len))
(vec a)
(range (dec (int (/ len 2))) -1 -1))
(range (dec len) 0 -1)))
(defn heap-sort
([a pred]
(let [len (count a)]
(heapify pred a len)))
([a]
(heap-sort a <)))

6
Task/Sorting-algorithms-Heapsort/Clojure/sorting-algorithms-heapsort-2.clj Normal file
View file

@ -0,0 +1,6 @@
user> (heapsort [1 2 4 6 2 3 6])
[1 2 2 3 4 6 6]
user> (heapsort [1 2 4 6 2 3 6] >)
[6 6 4 3 2 2 1]
user> (heapsort (list 1 2 4 6 2 3 6))
[1 2 2 3 4 6 6]

33
Task/Sorting-algorithms-Heapsort/CoffeeScript/sorting-algorithms-heapsort.coffee Normal file
View file

@ -0,0 +1,33 @@
# Do an in-place heap sort.
heap_sort = (arr) ->
put_array_in_heap_order(arr)
end = arr.length - 1
while end > 0
[arr[0], arr[end]] = [arr[end], arr[0]]
sift_element_down_heap arr, 0, end
end -= 1
put_array_in_heap_order = (arr) ->
i = arr.length / 2 - 1
i = Math.floor i
while i >= 0
sift_element_down_heap arr, i, arr.length
i -= 1
sift_element_down_heap = (heap, i, max) ->
while i < max
i_big = i
c1 = 2*i + 1
c2 = c1 + 1
if c1 < max and heap[c1] > heap[i_big]
i_big = c1
if c2 < max and heap[c2] > heap[i_big]
i_big = c2
return if i_big is i
[heap[i], heap[i_big]] = [heap[i_big], heap[i]]
i = i_big
do ->
arr = [12, 11, 15, 10, 9, 1, 2, 3, 13, 14, 4, 5, 6, 7, 8]
heap_sort arr
console.log arr

73
Task/Sorting-algorithms-Heapsort/Common-Lisp/sorting-algorithms-heapsort.lisp Normal file
View file

@ -0,0 +1,73 @@
(defun make-heap (&optional (length 7))
(make-array length :adjustable t :fill-pointer 0))
(defun left-index (index)
(1- (* 2 (1+ index))))
(defun right-index (index)
(* 2 (1+ index)))
(defun parent-index (index)
(floor (1- index) 2))
(defun percolate-up (heap index predicate)
(if (zerop index) heap
(do* ((element (aref heap index))
(index index pindex)
(pindex (parent-index index)
(parent-index index)))
((zerop index) heap)
(if (funcall predicate element (aref heap pindex))
(rotatef (aref heap index) (aref heap pindex))
(return-from percolate-up heap)))))
(defun heap-insert (heap element predicate)
(let ((index (vector-push-extend element heap 2)))
(percolate-up heap index predicate)))
(defun percolate-down (heap index predicate)
(let ((length (length heap))
(element (aref heap index)))
(flet ((maybe-element (index)
"return the element at index or nil, and a boolean
indicating whether there was an element."
(if (< index length)
(values (aref heap index) t)
(values nil nil))))
(do ((index index swap-index)
(lindex (left-index index) (left-index index))
(rindex (right-index index) (right-index index))
(swap-index nil) (swap-child nil))
(nil)
;; Extact the left child if there is one. If there is not,
;; return the heap. Set the left child as the swap-child.
(multiple-value-bind (lchild lp) (maybe-element lindex)
(if (not lp) (return-from percolate-down heap)
(setf swap-child lchild
swap-index lindex))
;; Extract the right child, if any, and when better than the
;; current swap-child, update the swap-child.
(multiple-value-bind (rchild rp) (maybe-element rindex)
(when (and rp (funcall predicate rchild lchild))
(setf swap-child rchild
swap-index rindex))
;; If the swap-child is better than element, rotate them,
;; and continue percolating down, else return heap.
(if (not (funcall predicate swap-child element))
(return-from percolate-down heap)
(rotatef (aref heap index) (aref heap swap-index)))))))))
(defun heap-empty-p (heap)
(eql (length heap) 0))
(defun heap-delete-min (heap predicate)
(assert (not (heap-empty-p heap)) () "Can't pop from empty heap.")
(prog1 (aref heap 0)
(setf (aref heap 0) (vector-pop heap))
(unless (heap-empty-p heap)
(percolate-down heap 0 predicate))))
(defun heapsort (sequence predicate)
(let ((h (make-heap (length sequence))))
(map nil #'(lambda (e) (heap-insert h e predicate)) sequence)
(map-into sequence #'(lambda () (heap-delete-min h predicate)))))

11
Task/Sorting-algorithms-Heapsort/D/sorting-algorithms-heapsort-1.d Normal file
View file

@ -0,0 +1,11 @@
import std.stdio, std.container;
void heapSort(T)(T[] data) /*pure nothrow @safe @nogc*/ {
for (auto h = data.heapify; !h.empty; h.removeFront) {}
}
void main() {
auto items = [7, 6, 5, 9, 8, 4, 3, 1, 2, 0];
items.heapSort;
items.writeln;
}

32
Task/Sorting-algorithms-Heapsort/D/sorting-algorithms-heapsort-2.d Normal file
View file

@ -0,0 +1,32 @@
import std.stdio, std.algorithm;
void heapSort(R)(R seq) pure nothrow @safe @nogc {
static void siftDown(R seq, in size_t start,
in size_t end) pure nothrow @safe @nogc {
for (size_t root = start; root * 2 + 1 <= end; ) {
auto child = root * 2 + 1;
if (child + 1 <= end && seq[child] < seq[child + 1])
child++;
if (seq[root] < seq[child]) {
swap(seq[root], seq[child]);
root = child;
} else
break;
}
}
if (seq.length > 1)
foreach_reverse (immutable start; 1 .. (seq.length - 2) / 2 + 2)
siftDown(seq, start - 1, seq.length - 1);
foreach_reverse (immutable end; 1 .. seq.length) {
swap(seq[end], seq[0]);
siftDown(seq, 0, end - 1);
}
}
void main() {
auto data = [7, 6, 5, 9, 8, 4, 3, 1, 2, 0];
data.heapSort;
data.writeln;
}

69
Task/Sorting-algorithms-Heapsort/Dart/sorting-algorithms-heapsort.dart Normal file
View file

@ -0,0 +1,69 @@
void heapSort(List a) {
int count = a.length;
// first place 'a' in max-heap order
heapify(a, count);
int end = count - 1;
while (end > 0) {
// swap the root (maximum value) of the heap with the
// last element of the heap
int tmp = a[end];
a[end] = a[0];
a[0] = tmp;
// put the heap back in max-heap order
siftDown(a, 0, end - 1);
// decrement the size of the heap so that the previous
// max value will stay in its proper place
end--;
}
}
void heapify(List a, int count) {
// start is assigned the index in 'a' of the last parent node
int start = ((count - 2)/2).toInt(); // binary heap
while (start >= 0) {
// sift down the node at index 'start' to the proper place
// such that all nodes below the 'start' index are in heap
// order
siftDown(a, start, count - 1);
start--;
}
}
void siftDown(List a, int start, int end) {
// end represents the limit of how far down the heap to shift
int root = start;
while ((root*2 + 1) <= end) { // While the root has at least one child
int child = root*2 + 1; // root*2+1 points to the left child
// if the child has a sibling and the child's value is less than its sibling's...
if (child + 1 <= end && a[child] < a[child + 1]) {
child = child+1; // .. then point to the right child instead
}
if (a[root] < a[child]) { // out of max-heap order
int tmp = a[root];
a[root] = a[child];
a[child] = tmp;
root = child; // repeat to continue shifting down the child now
} else {
return;
}
}
}
void main() {
var arr=[1,5,2,7,3,9,4,6,8];
print("Before sort");
arr.forEach((var i)=>print("$i"));
heapSort(arr);
print("After sort");
arr.forEach((var i)=>print("$i"));
}

66
Task/Sorting-algorithms-Heapsort/Draco/sorting-algorithms-heapsort.draco Normal file
View file

@ -0,0 +1,66 @@
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

37
Task/Sorting-algorithms-Heapsort/E/sorting-algorithms-heapsort.e Normal file
View file

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

33
Task/Sorting-algorithms-Heapsort/EasyLang/sorting-algorithms-heapsort.easy Normal file
View file

@ -0,0 +1,33 @@
proc sort . d[] .
n = len d[]
# make heap
for i = 2 to n
if d[i] > d[(i + 1) div 2]
j = i
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
ind = 2
while ind < i
if ind + 1 < i and d[ind + 1] > d[ind]
ind += 1
.
if d[j] < d[ind]
swap d[j] d[ind]
.
j = ind
ind = 2 * j
.
.
.
data[] = [ 29 4 72 44 55 26 27 77 92 5 ]
call sort data[]
print data[]

13
Task/Sorting-algorithms-Heapsort/EchoLisp/sorting-algorithms-heapsort.l Normal file
View file

@ -0,0 +1,13 @@
(lib 'heap)
(define (heap-sort list)
(define heap (make-heap < )) ;; make a min heap
(list->heap list heap)
(while (not (heap-empty? heap))
(push 'stack (heap-pop heap)))
(stack->list 'stack))
(define L (shuffle (iota 15)))
→ (9 4 0 12 8 3 10 7 11 2 5 6 14 13 1)
(heap-sort L)
→ (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14)

81
Task/Sorting-algorithms-Heapsort/Eiffel/sorting-algorithms-heapsort-1.e Normal file
View file

@ -0,0 +1,81 @@
class
HEAPSORT
feature
sort_array (ar: ARRAY [INTEGER])
-- Sorts array 'ar' in ascending order.
require
not_empty: ar.count > 0
local
i, j, r, l, m, n: INTEGER
sorted: BOOLEAN
do
n := ar.count
j := 0
i := 0
m := 0
r := n
l := (n // 2)+1
from
until
sorted
loop
if l > 1 then
l := l - 1
m := ar[l]
else
m := ar[r]
ar[r] := ar[1]
r := r - 1
if r = 1 then
ar[1]:=m
sorted := True
end
end
if not sorted then
i := l
j := l * 2
from
until
j > r
loop
if (j < r) and (ar[j] < ar[j + 1]) then
j := j + 1
end
if m < ar[j] then
ar[i]:= ar[j]
i := j
j := j + i
else
j := r + 1
end
end
ar[i]:= m
end
end
ensure
sorted: is_sorted(ar)
end
feature{NONE}
is_sorted (ar: ARRAY [INTEGER]): BOOLEAN
--- Is 'ar' sorted in ascending order?
local
i: INTEGER
do
Result := True
from
i := ar.lower
until
i >= ar.upper
loop
if ar [i] > ar [i + 1] then
Result := False
end
i := i + 1
end
end
end

34
Task/Sorting-algorithms-Heapsort/Eiffel/sorting-algorithms-heapsort-2.e Normal file
View file

@ -0,0 +1,34 @@
class
APPLICATION
create
make
feature
make
local
test: ARRAY [INTEGER]
do
create test.make_empty
test := <<5, 91, 13, 99,7, 35>>
io.put_string ("Unsorted: ")
across
test as t
loop
io.put_string (t.item.out + " ")
end
io.new_line
create heap_sort
heap_sort.sort_array (test)
io.put_string ("Sorted: ")
across
test as t
loop
io.put_string (t.item.out + " ")
end
end
heap_sort: HEAPSORT
end

37
Task/Sorting-algorithms-Heapsort/Elixir/sorting-algorithms-heapsort.elixir Normal file
View file

@ -0,0 +1,37 @@
defmodule Sort do
def heapSort(list) do
len = length(list)
heapify(List.to_tuple(list), div(len - 2, 2))
|> heapSort(len-1)
|> Tuple.to_list
end
defp heapSort(a, finish) when finish > 0 do
swap(a, 0, finish)
|> siftDown(0, finish-1)
|> heapSort(finish-1)
end
defp heapSort(a, _), do: a
defp heapify(a, start) when start >= 0 do
siftDown(a, start, tuple_size(a)-1)
|> heapify(start-1)
end
defp heapify(a, _), do: a
defp siftDown(a, root, finish) when root * 2 + 1 <= finish do
child = root * 2 + 1
if child + 1 <= finish and elem(a,child) < elem(a,child + 1), do: child = child + 1
if elem(a,root) < elem(a,child),
do: swap(a, root, child) |> siftDown(child, finish),
else: a
end
defp siftDown(a, _root, _finish), do: a
defp swap(a, i, j) do
{vi, vj} = {elem(a,i), elem(a,j)}
a |> put_elem(i, vj) |> put_elem(j, vi)
end
end
(for _ <- 1..20, do: :rand.uniform(20)) |> IO.inspect |> Sort.heapSort |> IO.inspect

22
Task/Sorting-algorithms-Heapsort/F-Sharp/sorting-algorithms-heapsort.fs Normal file
View file

@ -0,0 +1,22 @@
let inline swap (a: _ []) i j =
let temp = a.[i]
a.[i] <- a.[j]
a.[j] <- temp
let inline sift cmp (a: _ []) start count =
let rec loop root child =
if root * 2 + 1 < count then
let p = child < count - 1 && cmp a.[child] a.[child + 1] < 0
let child = if p then child + 1 else child
if cmp a.[root] a.[child] < 0 then
swap a root child
loop child (child * 2 + 1)
loop start (start * 2 + 1)
let inline heapsort cmp (a: _ []) =
let n = a.Length
for start = n/2 - 1 downto 0 do
sift cmp a start n
for term = n - 1 downto 1 do
swap a term 0
sift cmp a 0 term

51
Task/Sorting-algorithms-Heapsort/Forth/sorting-algorithms-heapsort-1.fth Normal file
View file

@ -0,0 +1,51 @@
create example
70 , 61 , 63 , 37 , 63 , 25 , 46 , 92 , 38 , 87 ,
[UNDEFINED] r'@ [IF]
: r'@ r> r> r@ swap >r swap >r ;
[THEN]
defer precedes ( n1 n2 a -- f)
defer exchange ( n1 n2 a --)
: siftDown ( a e s -- a e s)
swap >r swap >r dup ( s r)
begin ( s r)
dup 2* 1+ dup r'@ < ( s r c f)
while ( s r c)
dup 1+ dup r'@ < ( s r c c+1 f)
if ( s r c c+1)
over over r@ precedes if swap then
then drop ( s r c)
over over r@ precedes ( s r c f)
while ( s r c)
tuck r@ exchange ( s r)
repeat then ( s r)
drop drop r> swap r> swap ( a e s)
;
: heapsort ( a n --)
over >r ( a n)
dup 1- 1- 2/ ( a c s)
begin ( a c s)
dup 0< 0= ( a c s f)
while ( a c s)
siftDown 1- ( a c s)
repeat drop ( a c)
1- 0 ( a e 0)
begin ( a e 0)
over 0> ( a e 0 f)
while ( a e 0)
over over r@ exchange ( a e 0)
siftDown swap 1- swap ( a e 0)
repeat ( a e 0)
drop drop drop r> drop
;
:noname >r cells r@ + @ swap cells r> + @ swap < ; is precedes
:noname >r cells r@ + swap cells r> + over @ over @ swap rot ! swap ! ; is exchange
: .array 10 0 do example i cells + ? loop cr ;
.array example 10 heapsort .array

83
Task/Sorting-algorithms-Heapsort/Forth/sorting-algorithms-heapsort-2.fth Normal file
View file

@ -0,0 +1,83 @@
\ Written in ANS-Forth; tested under VFX.
\ Requires the novice package: http://www.forth.org/novice.html
\ The following should already be done:
\ include novice.4th
\ This is already in the novice package, so it is not really necessary to compile the code provided here.
\ ******
\ ****** This is our array sort. We are using the heap-sort because it provides consistent times and it is not recursive.
\ ****** This code was ported from C++ at: http://www.snippets.24bytes.com/2010/06/heap-sort.html
\ ****** Our array record size must be a multiple of W. This is assured if FIELD is used for creating the record.
\ ****** The easiest way to speed this up is to rewrite EXCHANGE in assembly language.
\ ******
marker HeapSort.4th
macro: exchange ( adrX adrY size -- ) \ the size of the record must be a multiple of W
begin dup while \ -- adrX adrY remaining
over @ fourth @ \ -- adrX adrY remaining Y X
fourth ! fourth ! \ -- adrX adrY remaining
rot w + rot w + rot w -
repeat
3drop ;
\ All of these macros use the locals from SORT, and can only be called from SORT.
macro: adr ( index -- adr )
recsiz * array + ;
macro: left ( x -- y ) 2* 1+ ;
macro: right ( x -- y ) 2* 2 + ;
macro: heapify ( x -- )
dup >r begin \ r: -- great
dup left dup limit < if dup adr rover adr 'comparer execute if rdrop dup >r then then drop
dup right dup limit < if dup adr r@ adr 'comparer execute if rdrop dup >r then then drop
dup r@ <> while
adr r@ adr recsiz exchange
r@ repeat
drop rdrop ;
macro: build-max-heap ( -- )
limit 1- 2/ begin dup 0>= while dup heapify 1- repeat drop ;
: sort { array limit recsiz 'comparer -- }
recsiz [ w 1- ] literal and abort" *** SORT: record size must be a multiple of the cell size ***"
build-max-heap
begin limit while -1 +to limit
0 adr limit adr recsiz exchange
0 heapify repeat ;
\ The SORT locals:
\ array \ the address of the 0th element
\ limit \ the number of records in the array
\ recsiz \ the size of a record in the array \ this must be a multiple of W (FIELD assures this)
\ 'comparer \ adrX adrY -- X>Y?
\ Note for the novice:
\ This code was originally written with colon words rather than macros, and using items rather than local variables.
\ After it was debugged, it was changed to use macros and locals so that it would be fast and reentrant.
\ One of the reasons why the heap-sort was chosen is because it is not recursive, which allows macros to be used.
\ Using macros allows the data (array, limit, recsiz, 'comparer) to be held in locals rather than items, which is reentrant.
\ ******
\ ****** This tests SORT.
\ ******
create aaa 2 , 9 , 3 , 6 , 1 , 4 , 5 , 7 , 0 , 8 ,
: print-aaa ( limit -- )
cells aaa + aaa do I @ . w +loop ;
: int> ( adrX adrY -- X>Y? )
swap @ swap @ > ;
: test-sort ( limit -- )
cr dup print-aaa
aaa over w ['] int> sort
cr print-aaa ;
10 test-sort

65
Task/Sorting-algorithms-Heapsort/Fortran/sorting-algorithms-heapsort.f Normal file
View file

@ -0,0 +1,65 @@
program Heapsort_Demo
implicit none
integer, parameter :: num = 20
real :: array(num)
call random_seed
call random_number(array)
write(*,*) "Unsorted array:-"
write(*,*) array
write(*,*)
call heapsort(array)
write(*,*) "Sorted array:-"
write(*,*) array
contains
subroutine heapsort(a)
real, intent(in out) :: a(0:)
integer :: start, n, bottom
real :: temp
n = size(a)
do start = (n - 2) / 2, 0, -1
call siftdown(a, start, n);
end do
do bottom = n - 1, 1, -1
temp = a(0)
a(0) = a(bottom)
a(bottom) = temp;
call siftdown(a, 0, bottom)
end do
end subroutine heapsort
subroutine siftdown(a, start, bottom)
real, intent(in out) :: a(0:)
integer, intent(in) :: start, bottom
integer :: child, root
real :: temp
root = start
do while(root*2 + 1 < bottom)
child = root * 2 + 1
if (child + 1 < bottom) then
if (a(child) < a(child+1)) child = child + 1
end if
if (a(root) < a(child)) then
temp = a(child)
a(child) = a (root)
a(root) = temp
root = child
else
return
end if
end do
end subroutine siftdown
end program Heapsort_Demo

71
Task/Sorting-algorithms-Heapsort/FreeBASIC/sorting-algorithms-heapsort.basic Normal file
View file

@ -0,0 +1,71 @@
' version 22-10-2016
' compile with: fbc -s console
' for boundary checks on array's compile with: fbc -s console -exx
' sort from lower bound to the higher bound
' array's can have subscript range from -2147483648 to +2147483647
Sub siftdown(hs() As Long, start As ULong, end_ As ULong)
Dim As ULong root = start
Dim As Long lb = LBound(hs)
While root * 2 + 1 <= end_
Dim As ULong child = root * 2 + 1
If (child + 1 <= end_) AndAlso (hs(lb + child) < hs(lb + child + 1)) Then
child = child + 1
End If
If hs(lb + root) < hs(lb + child) Then
Swap hs(lb + root), hs(lb + child)
root = child
Else
Return
End If
Wend
End Sub
Sub heapsort(hs() As Long)
Dim As Long lb = LBound(hs)
Dim As ULong count = UBound(hs) - lb + 1
Dim As Long start = (count - 2) \ 2
Dim As ULong end_ = count - 1
While start >= 0
siftdown(hs(), start, end_)
start = start - 1
Wend
While end_ > 0
Swap hs(lb + end_), hs(lb)
end_ = end_ - 1
siftdown(hs(), 0, end_)
Wend
End Sub
' ------=< MAIN >=------
Dim As Long array(-7 To 7)
Dim As Long i, lb = LBound(array), ub = UBound(array)
Randomize Timer
For i = lb To ub : array(i) = i : Next
For i = lb To ub
Swap array(i), array(Int(Rnd * (ub - lb + 1)) + lb)
Next
Print "Unsorted"
For i = lb To ub
Print Using " ###"; array(i);
Next : Print : Print
heapsort(array())
Print "After heapsort"
For i = lb To ub
Print Using " ###"; array(i);
Next : Print
' empty keyboard buffer
While Inkey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End

30
Task/Sorting-algorithms-Heapsort/FunL/sorting-algorithms-heapsort.funl Normal file
View file

@ -0,0 +1,30 @@
def heapSort( a ) =
heapify( a )
end = a.length() - 1
while end > 0
a(end), a(0) = a(0), a(end)
siftDown( a, 0, --end )
def heapify( a ) =
for i <- (a.length() - 2)\2..0 by -1
siftDown( a, i, a.length() - 1 )
def siftDown( a, start, end ) =
root = start
while root*2 + 1 <= end
child = root*2 + 1
if child + 1 <= end and a(child) < a(child + 1)
child++
if a(root) < a(child)
a(root), a(child) = a(child), a(root)
root = child
else
break
a = array( [7, 2, 6, 1, 9, 5, 0, 3, 8, 4] )
heapSort( a )
println( a )

38
Task/Sorting-algorithms-Heapsort/Go/sorting-algorithms-heapsort-1.go Normal file
View file

@ -0,0 +1,38 @@
package main
import (
"sort"
"container/heap"
"fmt"
)
type HeapHelper struct {
container sort.Interface
length int
}
func (self HeapHelper) Len() int { return self.length }
// We want a max-heap, hence reverse the comparison
func (self HeapHelper) Less(i, j int) bool { return self.container.Less(j, i) }
func (self HeapHelper) Swap(i, j int) { self.container.Swap(i, j) }
// this should not be called
func (self *HeapHelper) Push(x interface{}) { panic("impossible") }
func (self *HeapHelper) Pop() interface{} {
self.length--
return nil // return value not used
}
func heapSort(a sort.Interface) {
helper := HeapHelper{ a, a.Len() }
heap.Init(&helper)
for helper.length > 0 {
heap.Pop(&helper)
}
}
func main() {
a := []int{170, 45, 75, -90, -802, 24, 2, 66}
fmt.Println("before:", a)
heapSort(sort.IntSlice(a))
fmt.Println("after: ", a)
}

38
Task/Sorting-algorithms-Heapsort/Go/sorting-algorithms-heapsort-2.go Normal file
View file

@ -0,0 +1,38 @@
package main
import (
"sort"
"fmt"
)
func main() {
a := []int{170, 45, 75, -90, -802, 24, 2, 66}
fmt.Println("before:", a)
heapSort(sort.IntSlice(a))
fmt.Println("after: ", a)
}
func heapSort(a sort.Interface) {
for start := (a.Len() - 2) / 2; start >= 0; start-- {
siftDown(a, start, a.Len()-1)
}
for end := a.Len() - 1; end > 0; end-- {
a.Swap(0, end)
siftDown(a, 0, end-1)
}
}
func siftDown(a sort.Interface, start, end int) {
for root := start; root*2+1 <= end; {
child := root*2 + 1
if child+1 <= end && a.Less(child, child+1) {
child++
}
if !a.Less(root, child) {
return
}
a.Swap(root, child)
root = child
}
}

25
Task/Sorting-algorithms-Heapsort/Groovy/sorting-algorithms-heapsort-1.groovy Normal file
View file

@ -0,0 +1,25 @@
def makeSwap = { a, i, j = i+1 -> print "."; a[[j,i]] = a[[i,j]] }
def checkSwap = { list, i, j = i+1 -> [(list[i] > list[j])].find{ it }.each { makeSwap(list, i, j) } }
def siftDown = { a, start, end ->
def p = start
while (p*2 < end) {
def c = p*2 + ((p*2 + 1 < end && a[p*2 + 2] > a[p*2 + 1]) ? 2 : 1)
if (checkSwap(a, c, p)) { p = c }
else { return }
}
}
def heapify = {
(((it.size()-2).intdiv(2))..0).each { start -> siftDown(it, start, it.size()-1) }
}
def heapSort = { list ->
heapify(list)
(0..<(list.size())).reverse().each { end ->
makeSwap(list, 0, end)
siftDown(list, 0, end-1)
}
list
}

2
Task/Sorting-algorithms-Heapsort/Groovy/sorting-algorithms-heapsort-2.groovy Normal file
View file

@ -0,0 +1,2 @@
println (heapSort([23,76,99,58,97,57,35,89,51,38,95,92,24,46,31,24,14,12,57,78,4]))
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]))

26
Task/Sorting-algorithms-Heapsort/Haskell/sorting-algorithms-heapsort-1.hs Normal file
View file

@ -0,0 +1,26 @@
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)
mergeSort :: Ord a => [a] -> [a]
mergeSort = toList . fromList

2
Task/Sorting-algorithms-Heapsort/Haskell/sorting-algorithms-heapsort-2.hs Normal file
View file

@ -0,0 +1,2 @@
ghci> heapSort [9,5,8,2,1,4,6,3,0,7]
[0,1,2,3,4,5,6,7,8,9]

15
Task/Sorting-algorithms-Heapsort/Haskell/sorting-algorithms-heapsort-3.hs Normal file
View file

@ -0,0 +1,15 @@
import Data.Graph.Inductive.Internal.Heap(
Heap(..),insert,findMin,deleteMin)
-- heapsort is added in this module as an example application
build :: Ord a => [(a,b)] -> Heap a b
build = foldr insert Empty
toList :: Ord a => Heap a b -> [(a,b)]
toList Empty = []
toList h = x:toList r
where (x,r) = (findMin h,deleteMin h)
heapSort :: Ord a => [a] -> [a]
heapSort = (map fst) . toList . build . map (\x->(x,x))

2
Task/Sorting-algorithms-Heapsort/Haskell/sorting-algorithms-heapsort-4.hs Normal file
View file

@ -0,0 +1,2 @@
*Main> heapsort [[6,9],[2,13],[6,8,14,9],[10,7],[5]]
[[2,13],[5],[6,8,14,9],[6,9],[10,7]]

60
Task/Sorting-algorithms-Heapsort/Haxe/sorting-algorithms-heapsort.haxe Normal file
View file

@ -0,0 +1,60 @@
class HeapSort {
@:generic
private static function siftDown<T>(arr: Array<T>, start:Int, end:Int) {
var root = start;
while (root * 2 + 1 <= end) {
var child = root * 2 + 1;
if (child + 1 <= end && Reflect.compare(arr[child], arr[child + 1]) < 0)
child++;
if (Reflect.compare(arr[root], arr[child]) < 0) {
var temp = arr[root];
arr[root] = arr[child];
arr[child] = temp;
root = child;
} else {
break;
}
}
}
@:generic
public static function sort<T>(arr:Array<T>) {
if (arr.length > 1)
{
var start = (arr.length - 2) >> 1;
while (start > 0) {
siftDown(arr, start - 1, arr.length - 1);
start--;
}
}
var end = arr.length - 1;
while (end > 0) {
var temp = arr[end];
arr[end] = arr[0];
arr[0] = temp;
siftDown(arr, 0, end - 1);
end--;
}
}
}
class Main {
static function main() {
var integerArray = [1, 10, 2, 5, -1, 5, -19, 4, 23, 0];
var floatArray = [1.0, -3.2, 5.2, 10.8, -5.7, 7.3,
3.5, 0.0, -4.1, -9.5];
var stringArray = ['We', 'hold', 'these', 'truths', 'to',
'be', 'self-evident', 'that', 'all',
'men', 'are', 'created', 'equal'];
Sys.println('Unsorted Integers: ' + integerArray);
HeapSort.sort(integerArray);
Sys.println('Sorted Integers: ' + integerArray);
Sys.println('Unsorted Floats: ' + floatArray);
HeapSort.sort(floatArray);
Sys.println('Sorted Floats: ' + floatArray);
Sys.println('Unsorted Strings: ' + stringArray);
HeapSort.sort(stringArray);
Sys.println('Sorted Strings: ' + stringArray);
}
}

37
Task/Sorting-algorithms-Heapsort/Icon/sorting-algorithms-heapsort.icon Normal file
View file

@ -0,0 +1,37 @@
procedure main() #: demonstrate various ways to sort a list and string
demosort(heapsort,[3, 14, 1, 5, 9, 2, 6, 3],"qwerty")
end
procedure heapsort(X,op) #: return sorted list ascending(or descending)
local head,tail
op := sortop(op,X) # select how and what we sort
every head := (tail := *X) / 2 to 1 by -1 do # work back from from last parent node
X := siftdown(X,op,head,tail) # sift down from head to make the heap
every tail := *X to 2 by -1 do { # work between the beginning and the tail to final positions
X[1] :=: X[tail]
X := siftdown(X,op,1,tail-1) # re-sift next (previous) branch after shortening the heap
}
return X
end
procedure siftdown(X,op,root,tail) #: the value @root is moved "down" the path of max(min) value to its level
local child
while (child := root * 2) <= tail do { # move down the branch from root to tail
if op(X[child],X[tail >= child + 1]) then # choose the larger(smaller)
child +:= 1 # ... child
if op(X[root],X[child]) then { # root out of order?
X[child] :=: X[root]
root := child # follow max(min) branch
}
else
return X
}
return X
end

17
Task/Sorting-algorithms-Heapsort/J/sorting-algorithms-heapsort-1.j Normal file
View file

@ -0,0 +1,17 @@
swap=: C.~ <
siftDown=: 4 : 0
'c e'=. x
while. e > c=.1+2*s=.c do.
before=. <&({&y)
if. e > 1+c do. c=.c+ c before c+1 end.
if. s before c do. y=. y swap c,s else. break. end.
end.
y
)
heapSort=: 3 : 0
if. 1>: c=. # y do. y return. end.
z=. siftDown&.>/ (c,~each i.<.c%2),<y NB. heapify
> ([ siftDown swap~)&.>/ (0,each}.i.c),z
)

5
Task/Sorting-algorithms-Heapsort/J/sorting-algorithms-heapsort-2.j Normal file
View file

@ -0,0 +1,5 @@
heapSort 1 5 2 7 3 9 4 6 8 1
1 1 2 3 4 5 6 7 8 9
heapSort &. (a.&i.) 'aqwcdhkij'
acdhijkqw

87
Task/Sorting-algorithms-Heapsort/Janet/sorting-algorithms-heapsort.janet Normal file
View file

@ -0,0 +1,87 @@
(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]))

53
Task/Sorting-algorithms-Heapsort/Java/sorting-algorithms-heapsort.java Normal file
View file

@ -0,0 +1,53 @@
public static void heapSort(int[] a){
int count = a.length;
//first place a in max-heap order
heapify(a, count);
int end = count - 1;
while(end > 0){
//swap the root(maximum value) of the heap with the
//last element of the heap
int tmp = a[end];
a[end] = a[0];
a[0] = tmp;
//put the heap back in max-heap order
siftDown(a, 0, end - 1);
//decrement the size of the heap so that the previous
//max value will stay in its proper place
end--;
}
}
public static void heapify(int[] a, int count){
//start is assigned the index in a of the last parent node
int start = (count - 2) / 2; //binary heap
while(start >= 0){
//sift down the node at index start to the proper place
//such that all nodes below the start index are in heap
//order
siftDown(a, start, count - 1);
start--;
}
//after sifting down the root all nodes/elements are in heap order
}
public static void siftDown(int[] a, int start, int end){
//end represents the limit of how far down the heap to sift
int root = start;
while((root * 2 + 1) <= end){ //While the root has at least one child
int child = root * 2 + 1; //root*2+1 points to the left child
//if the child has a sibling and the child's value is less than its sibling's...
if(child + 1 <= end && a[child] < a[child + 1])
child = child + 1; //... then point to the right child instead
if(a[root] < a[child]){ //out of max-heap order
int tmp = a[root];
a[root] = a[child];
a[child] = tmp;
root = child; //repeat to continue sifting down the child now
}else
return;
}
}

40
Task/Sorting-algorithms-Heapsort/JavaScript/sorting-algorithms-heapsort.js Normal file
View file

@ -0,0 +1,40 @@
function heapSort(arr) {
heapify(arr)
end = arr.length - 1
while (end > 0) {
[arr[end], arr[0]] = [arr[0], arr[end]]
end--
siftDown(arr, 0, end)
}
}
function heapify(arr) {
start = Math.floor(arr.length/2) - 1
while (start >= 0) {
siftDown(arr, start, arr.length - 1)
start--
}
}
function siftDown(arr, startPos, endPos) {
let rootPos = startPos
while (rootPos * 2 + 1 <= endPos) {
childPos = rootPos * 2 + 1
if (childPos + 1 <= endPos && arr[childPos] < arr[childPos + 1]) {
childPos++
}
if (arr[rootPos] < arr[childPos]) {
[arr[rootPos], arr[childPos]] = [arr[childPos], arr[rootPos]]
rootPos = childPos
} else {
return
}
}
}
test('rosettacode', () => {
arr = [12, 11, 15, 10, 9, 1, 2, 3, 13, 14, 4, 5, 6, 7, 8,]
heapSort(arr)
expect(arr).toStrictEqual([1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15])
})

43
Task/Sorting-algorithms-Heapsort/Jq/sorting-algorithms-heapsort.jq Normal file
View file

@ -0,0 +1,43 @@
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"

42
Task/Sorting-algorithms-Heapsort/Julia/sorting-algorithms-heapsort.julia Normal file
View file

@ -0,0 +1,42 @@
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
if c < last && a[c] < a[c + 1]
c += 1
end
if a[first] < a[c]
swap(a, c, first)
first = c
else
break
end
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))

48
Task/Sorting-algorithms-Heapsort/Kotlin/sorting-algorithms-heapsort.kotlin Normal file
View file

@ -0,0 +1,48 @@
// version 1.1.0
fun heapSort(a: IntArray) {
heapify(a)
var end = a.size - 1
while (end > 0) {
val temp = a[end]
a[end] = a[0]
a[0] = temp
end--
siftDown(a, 0, end)
}
}
fun heapify(a: IntArray) {
var start = (a.size - 2) / 2
while (start >= 0) {
siftDown(a, start, a.size - 1)
start--
}
}
fun siftDown(a: IntArray, start: Int, end: Int) {
var root = start
while (root * 2 + 1 <= end) {
var child = root * 2 + 1
if (child + 1 <= end && a[child] < a[child + 1]) child++
if (a[root] < a[child]) {
val temp = a[root]
a[root] = a[child]
a[child] = temp
root = child
}
else return
}
}
fun main(args: Array<String>) {
val aa = arrayOf(
intArrayOf(100, 2, 56, 200, -52, 3, 99, 33, 177, -199),
intArrayOf(4, 65, 2, -31, 0, 99, 2, 83, 782, 1),
intArrayOf(12, 11, 15, 10, 9, 1, 2, 3, 13, 14, 4, 5, 6, 7, 8)
)
for (a in aa) {
heapSort(a)
println(a.joinToString(", "))
}
}

78
Task/Sorting-algorithms-Heapsort/Liberty-BASIC/sorting-algorithms-heapsort.basic Normal file
View file

@ -0,0 +1,78 @@
wikiSample=1 'comment out for random array
data 6, 5, 3, 1, 8, 7, 2, 4
itemCount = 20
if wikiSample then itemCount = 8
dim A(itemCount)
for i = 1 to itemCount
A(i) = int(rnd(1) * 100)
if wikiSample then read tmp: A(i)=tmp
next i
print "Before Sort"
call printArray itemCount
call heapSort itemCount
print "After Sort"
call printArray itemCount
end
'------------------------------------------
sub heapSort count
call heapify count
print "the heap"
call printArray count
theEnd = count
while theEnd > 1
call swap theEnd, 1
call siftDown 1, theEnd-1
theEnd = theEnd - 1
wend
end sub
sub heapify count
start = int(count / 2)
while start >= 1
call siftDown start, count
start = start - 1
wend
end sub
sub siftDown start, theEnd
root = start
while root * 2 <= theEnd
child = root * 2
swap = root
if A(swap) < A(child) then
swap = child
end if
if child+1 <= theEnd then
if A(swap) < A(child+1) then
swap = child + 1
end if
end if
if swap <> root then
call swap root, swap
root = swap
else
exit sub
end if
wend
end sub
sub swap a,b
tmp = A(a)
A(a) = A(b)
A(b) = tmp
end sub
'===========================================
sub printArray itemCount
for i = 1 to itemCount
print using("###", A(i));
next i
print
end sub

57
Task/Sorting-algorithms-Heapsort/Lobster/sorting-algorithms-heapsort.lobster Normal file
View file

@ -0,0 +1,57 @@
def siftDown(a, start, end):
// (end represents the limit of how far down the heap to sift)
var root = start
while root * 2 + 1 <= end: // (While the root has at least one child)
var child = root * 2 + 1 // (root*2+1 points to the left child)
// (If the child has a sibling and the child's value is less than its sibling's...)
if child + 1 <= end and a[child] < a[child + 1]:
child += 1 // (... then point to the right child instead)
if a[root] < a[child]: // (out of max-heap order)
let r = a[root] // swap(a[root], a[child])
a[root] = a[child]
a[child] = r
root = child // (repeat to continue sifting down the child now)
else:
return
def heapify(a, count):
//(start is assigned the index in a of the last parent node)
var start = (count - 2) >> 1
while start >= 0:
// (sift down the node at index start to the proper place
// such that all nodes below the start index are in heap order)
siftDown(a, start, count-1)
start -= 1
// (after sifting down the root all nodes/elements are in heap order)
def heapSort(a):
// input: an unordered array a of length count
let count = a.length
// (first place a in max-heap order)
heapify(a, count)
var end = count - 1
while end > 0:
//(swap the root(maximum value) of the heap with the last element of the heap)
let z = a[0]
a[0] = a[end]
a[end] = z
//(decrement the size of the heap so that the previous max value will stay in its proper place)
end -= 1
// (put the heap back in max-heap order)
siftDown(a, 0, end)
let inputi = [1,10,2,5,-1,5,-19,4,23,0]
print ("input: " + inputi)
heapSort(inputi)
print ("sorted: " + inputi)
let inputf = [1,-3.2,5.2,10.8,-5.7,7.3,3.5,0,-4.1,-9.5]
print ("input: " + inputf)
heapSort(inputf)
print ("sorted: " + inputf)
let inputs = ["We","hold","these","truths","to","be","self-evident","that","all","men","are","created","equal"]
print ("input: " + inputs)
heapSort(inputs)
print ("sorted: " + inputs)

45
Task/Sorting-algorithms-Heapsort/LotusScript/sorting-algorithms-heapsort.lotus Normal file
View file

@ -0,0 +1,45 @@
Public Sub heapsort(pavIn As Variant)
Dim liCount As Integer, liEnd As Integer
Dim lvTemp As Variant
liCount = UBound(pavIn) + 1
heapify pavIn, liCount
liEnd = liCount - 1
While liEnd > 0
lvTemp = pavIn(liEnd)
pavIn(liEnd) = pavIn(0)
pavIn(0) = lvTemp
liEnd = liEnd -1
siftDown pavIn,0, liEnd
Wend
End Sub
Private Sub heapify(pavIn As Variant,piCount As Integer)
Dim liStart As Integer
liStart = (piCount - 2) / 2
While liStart >=0
siftDown pavIn, liStart, piCount -1
liStart = liStart - 1
Wend
End Sub
Private Sub siftDown(pavIn As Variant, piStart As Integer, piEnd As Integer)
Dim liRoot As Integer, liChild As Integer
Dim lvTemp As Variant
liRoot = piStart
While liRoot *2 + 1 <= piEnd
liChild = liRoot *2 + 1
If liChild +1 <= piEnd And pavIn(liChild) < pavIn(liChild + 1) Then
liChild = liChild + 1
End If
If pavIn(liRoot) < pavIn(liChild) Then
lvTemp = pavIn(liRoot)
pavIn(liRoot) = pavIn(liChild)
pavIn(liChild) = lvTemp
liRoot = liChild
Else
Exit sub
End if
wend
End Sub

56
Task/Sorting-algorithms-Heapsort/M4/sorting-algorithms-heapsort.m4 Normal file
View file

@ -0,0 +1,56 @@
divert(-1)
define(`randSeed',141592653)
define(`setRand',
`define(`randSeed',ifelse(eval($1<10000),1,`eval(20000-$1)',`$1'))')
define(`rand_t',`eval(randSeed^(randSeed>>13))')
define(`random',
`define(`randSeed',eval((rand_t^(rand_t<<18))&0x7fffffff))randSeed')
define(`set',`define(`$1[$2]',`$3')')
define(`get',`defn(`$1[$2]')')
define(`new',`set($1,size,0)')
dnl for the heap calculations, it's easier if origin is 0, so set value first
define(`append',
`set($1,get($1,size),$2)`'set($1,size,incr(get($1,size)))')
dnl swap(<name>,<j>,<name>[<j>],<k>) using arg stack for the temporary
define(`swap',`set($1,$2,get($1,$4))`'set($1,$4,$3)')
define(`deck',
`new($1)for(`x',1,$2,
`append(`$1',eval(random%100))')')
define(`show',
`for(`x',0,decr(get($1,size)),`get($1,x) ')')
define(`for',
`ifelse($#,0,``$0'',
`ifelse(eval($2<=$3),1,
`pushdef(`$1',$2)$4`'popdef(`$1')$0(`$1',incr($2),$3,`$4')')')')
define(`ifywork',
`ifelse(eval($2>=0),1,
`siftdown($1,$2,$3)`'ifywork($1,decr($2),$3)')')
define(`heapify',
`define(`start',eval((get($1,size)-2)/2))`'ifywork($1,start,
decr(get($1,size)))')
define(`siftdown',
`define(`child',eval($2*2+1))`'ifelse(eval(child<=$3),1,
`ifelse(eval(child+1<=$3),1,
`ifelse(eval(get($1,child)<get($1,incr(child))),1,
`define(`child',
incr(child))')')`'ifelse(eval(get($1,$2)<get($1,child)),1,
`swap($1,$2,get($1,$2),child)`'siftdown($1,child,$3)')')')
define(`sortwork',
`ifelse($2,0,
`',
`swap($1,0,get($1,0),$2)`'siftdown($1,0,decr($2))`'sortwork($1,
decr($2))')')
define(`heapsort',
`heapify($1)`'sortwork($1,decr(get($1,size)))')
divert
deck(`a',10)
show(`a')
heapsort(`a')
show(`a')

40
Task/Sorting-algorithms-Heapsort/MATLAB/sorting-algorithms-heapsort-1.m Normal file
View file

@ -0,0 +1,40 @@
function list = heapSort(list)
function list = siftDown(list,root,theEnd)
while (root * 2) <= theEnd
child = root * 2;
if (child + 1 <= theEnd) && (list(child) < list(child+1))
child = child + 1;
end
if list(root) < list(child)
list([root child]) = list([child root]); %Swap
root = child;
else
return
end
end %while
end %siftDown
count = numel(list);
%Because heapify is called once in pseudo-code, it is inline here
start = floor(count/2);
while start >= 1
list = siftDown(list, start, count);
start = start - 1;
end
%End Heapify
while count > 1
list([count 1]) = list([1 count]); %Swap
count = count - 1;
list = siftDown(list,1,count);
end
end

5
Task/Sorting-algorithms-Heapsort/MATLAB/sorting-algorithms-heapsort-2.m Normal file
View file

@ -0,0 +1,5 @@
>> heapSort([4 3 1 5 6 2])
ans =
1 2 3 4 5 6

43
Task/Sorting-algorithms-Heapsort/MAXScript/sorting-algorithms-heapsort-1.max Normal file
View file

@ -0,0 +1,43 @@
fn heapify arr count =
(
local s = count /2
while s > 0 do
(
arr = siftDown arr s count
s -= 1
)
return arr
)
fn siftDown arr s end =
(
local root = s
while root * 2 <= end do
(
local child = root * 2
if child < end and arr[child] < arr[child+1] do
(
child += 1
)
if arr[root] < arr[child] then
(
swap arr[root] arr[child]
root = child
)
else return arr
)
return arr
)
fn heapSort arr =
(
local count = arr.count
arr = heapify arr count
local end = count
while end >= 1 do
(
swap arr[1] arr[end]
end -= 1
arr = siftDown arr 1 end
)
)

4
Task/Sorting-algorithms-Heapsort/MAXScript/sorting-algorithms-heapsort-2.max Normal file
View file

@ -0,0 +1,4 @@
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)

36
Task/Sorting-algorithms-Heapsort/Maple/sorting-algorithms-heapsort.maple Normal file
View file

@ -0,0 +1,36 @@
swap := proc(arr, a, b)
local temp:
temp := arr[a]:
arr[a] := arr[b]:
arr[b] := temp:
end proc:
heapify := proc(toSort, n, i)
local largest, l, r, holder:
largest := i:
l := 2*i:
r := 2*i+1:
if (l <= n and toSort[l] > toSort[largest]) then
largest := l:
end if:
if (r <= n and toSort[r] > toSort[largest]) then
largest := r:
end if:
if (not largest = i) then
swap(toSort, i, largest);
heapify(toSort, n, largest):
end if:
end proc:
heapsort := proc(arr)
local n,i:
n := numelems(arr):
for i from trunc(n/2) to 1 by -1 do
heapify(arr, n, i):
end do:
for i from n to 2 by -1 do
swap(arr, 1, i):
heapify(arr, i-1, 1):
end do:
end proc:
arr := Array([17,3,72,0,36,2,3,8,40,0]);
heapsort(arr);
arr;

18
Task/Sorting-algorithms-Heapsort/Mathematica/sorting-algorithms-heapsort.math Normal file
View file

@ -0,0 +1,18 @@
siftDown[list_,root_,theEnd_]:=
While[(root*2) <= theEnd,
child = root*2;
If[(child+1 <= theEnd)&&(list[[child]] < list[[child+1]]), child++;];
If[list[[root]] < list[[child]],
list[[{root,child}]] = list[[{child,root}]]; root = child;,
Break[];
]
]
heapSort[list_] := Module[{ count, start},
count = Length[list]; start = Floor[count/2];
While[start >= 1,list = siftDown[list,start,count];
start--;
]
While[count > 1, list[[{count,1}]] = list[[{1,count}]];
count--; list = siftDown[list,1,count];
]
]

106
Task/Sorting-algorithms-Heapsort/Mercury/sorting-algorithms-heapsort.mercury Normal file
View file

@ -0,0 +1,106 @@
%%%-------------------------------------------------------------------
:- 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:

83
Task/Sorting-algorithms-Heapsort/NetRexx/sorting-algorithms-heapsort.netrexx Normal file
View file

@ -0,0 +1,83 @@
/* NetRexx */
options replace format comments java crossref savelog symbols binary
import java.util.List
placesList = [String -
"UK London", "US New York", "US Boston", "US Washington" -
, "UK Washington", "US Birmingham", "UK Birmingham", "UK Boston" -
]
lists = [ -
placesList -
, heapSort(String[] Arrays.copyOf(placesList, placesList.length)) -
]
loop ln = 0 to lists.length - 1
cl = lists[ln]
loop ct = 0 to cl.length - 1
say cl[ct]
end ct
say
end ln
return
method heapSort(a = String[], count = a.length) public constant binary returns String[]
rl = String[a.length]
al = List heapSort(Arrays.asList(a), count)
al.toArray(rl)
return rl
method heapSort(a = List, count = a.size) public constant binary returns ArrayList
a = heapify(a, count)
iend = count - 1
loop label iend while iend > 0
swap = a.get(0)
a.set(0, a.get(iend))
a.set(iend, swap)
a = siftDown(a, 0, iend - 1)
iend = iend - 1
end iend
return ArrayList(a)
method heapify(a = List, count = int) public constant binary returns List
start = (count - 2) % 2
loop label strt while start >= 0
a = siftDown(a, start, count - 1)
start = start - 1
end strt
return a
method siftDown(a = List, istart = int, iend = int) public constant binary returns List
root = istart
loop label root while root * 2 + 1 <= iend
child = root * 2 + 1
if child + 1 <= iend then do
if (Comparable a.get(child)).compareTo(Comparable a.get(child + 1)) < 0 then do
child = child + 1
end
end
if (Comparable a.get(root)).compareTo(Comparable a.get(child)) < 0 then do
swap = a.get(root)
a.set(root, a.get(child))
a.set(child, swap)
root = child
end
else do
leave root
end
end root
return a

23
Task/Sorting-algorithms-Heapsort/Nim/sorting-algorithms-heapsort.nim Normal file
View file

@ -0,0 +1,23 @@
proc siftDown[T](a: var openarray[T]; start, ending: int) =
var root = start
while root * 2 + 1 < ending:
var child = 2 * root + 1
if child + 1 < ending and a[child] < a[child+1]:
inc child
if a[root] < a[child]:
swap a[child], a[root]
root = child
else:
return
proc heapSort[T](a: var openarray[T]) =
let count = a.len
for start in countdown((count - 2) div 2, 0):
siftDown(a, start, count)
for ending in countdown(count - 1, 1):
swap a[ending], a[0]
siftDown(a, 0, ending)
var a = @[4, 65, 2, -31, 0, 99, 2, 83, 782]
heapSort a
echo a

23
Task/Sorting-algorithms-Heapsort/OCaml/sorting-algorithms-heapsort-1.ocaml Normal file
View file

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

10
Task/Sorting-algorithms-Heapsort/OCaml/sorting-algorithms-heapsort-2.ocaml Normal file
View file

@ -0,0 +1,10 @@
let a = [|3;1;4;1;5;9;2;6;5;3;5;8;97;93;23;84;62;64;33;83;27;95|] in
heapsort a;
Array.iter (Printf.printf "%d ") a;;
print_newline ();;
let s = "Just to show this is a type-checked polymorphic function" in
let b = Array.init (String.length s) (String.get s) in
heapsort b;
Array.iter print_char b;;
print_newline ();;

53
Task/Sorting-algorithms-Heapsort/Objeck/sorting-algorithms-heapsort.objeck Normal file
View file

@ -0,0 +1,53 @@
bundle Default {
class HeapSort {
function : Main(args : String[]) ~ Nil {
values := [4, 3, 1, 5, 6, 2];
HeapSort(values);
each(i : values) {
values[i]->PrintLine();
};
}
function : HeapSort(a : Int[]) ~ Nil {
count := a->Size();
Heapify(a, count);
end := count - 1;
while(end > 0) {
tmp := a[end];
a[end] := a[0];
a[0] := tmp;
SiftDown(a, 0, end - 1);
end -= 1;
};
}
function : Heapify(a : Int[], count : Int) ~ Nil {
start := (count - 2) / 2;
while(start >= 0) {
SiftDown(a, start, count - 1);
start -= 1;
};
}
function : SiftDown(a : Int[], start : Int, end : Int) ~ Nil {
root := start;
while((root * 2 + 1) <= end) {
child := root * 2 + 1;
if(child + 1 <= end & a[child] < a[child + 1]) {
child := child + 1;
};
if(a[root] < a[child]) {
tmp := a[root];
a[root] := a[child];
a[child] := tmp;
root := child;
}
else {
return;
};
};
}
}
}

57
Task/Sorting-algorithms-Heapsort/Oz/sorting-algorithms-heapsort.oz Normal file
View file

@ -0,0 +1,57 @@
declare
proc {HeapSort A}
Low = {Array.low A}
High = {Array.high A}
Count = High-Low+1
%% heapify
LastParent = Low + (Count-2) div 2
in
for Start in LastParent..Low;~1 do
{Siftdown A Start High}
end
%% repeatedly put the maximum element to the end
%% and re-heapify the rest
for End in High..Low+1;~1 do
{Swap A End Low}
{Siftdown A Low End-1}
end
end
proc {Siftdown A Start End}
Low = {Array.low A}
fun {FirstChildOf I} Low+(I-Low)*2+1 end
Root = {NewCell Start}
in
for while:{FirstChildOf @Root} =< End
break:Break
do
Child = {NewCell {FirstChildOf @Root}}
in
if @Child + 1 =< End andthen A.@Child < A.(@Child + 1) then
Child := @Child + 1
end
if A.@Root < A.@Child then
{Swap A @Root @Child}
Root := @Child
else
{Break}
end
end
end
proc {Swap A I J}
A.J := (A.I := A.J)
end
%% create array with indices ~1..7 and fill it
Arr = {Array.new ~1 7 0}
{Record.forAllInd unit(~1:3 0:1 4 1 5 9 2 6 5)
proc {$ I V}
Arr.I := V
end}
in
{HeapSort Arr}
{Show {Array.toRecord unit Arr}}

76
Task/Sorting-algorithms-Heapsort/PL-I/sorting-algorithms-heapsort.pli Normal file
View file

@ -0,0 +1,76 @@
*process source xref attributes or(!);
/*********************************************************************
* Pseudocode found here:
* http://en.wikipedia.org/wiki/Heapsort#Pseudocode
* Sample data from REXX
* 27.07.2013 Walter Pachl
*********************************************************************/
heaps: Proc Options(main);
Dcl a(0:25) Char(50) Var Init(
'---letters of the modern Greek Alphabet---',
'==========================================',
'alpha','beta','gamma','delta','epsilon','zeta','eta','theta',
'iota','kappa','lambda','mu','nu','xi','omicron','pi',
'rho','sigma','tau','upsilon','phi','chi','psi','omega');
Dcl n Bin Fixed(31) Init((hbound(a)+1));
Call showa('before sort');
Call heapsort((n));
Call showa(' after sort');
heapSort: Proc(count);
Dcl (count,end) Bin Fixed(31);
Call heapify((count));
end=count-1;
do while(end>0);
Call swap(end,0);
end=end-1;
Call siftDown(0,(end));
End;
End;
heapify: Proc(count);
Dcl (count,start) Bin Fixed(31);
start=(count-2)/2;
Do while (start>=0);
Call siftDown((start),count-1);
start=start-1;
End;
End;
siftDown: Proc(start,end);
Dcl (count,start,root,end,child,sw) Bin Fixed(31);
root=start;
Do while(root*2+1<= end);
child=root*2+1;
sw=root;
if a(sw)<a(child) Then
sw=child;
if child+1<=end & a(sw)<a(child+1) Then
sw=child+1;
if sw^=root Then Do;
Call swap(root,sw);
root=sw;
End;
else
return;
End;
End;
swap: Proc(x,y);
Dcl (x,y) Bin Fixed(31);
Dcl temp Char(50) Var;
temp=a(x);
a(x)=a(y);
a(y)=temp;
End;
showa: Proc(txt);
Dcl txt Char(*);
Dcl j Bin Fixed(31);
Do j=0 To hbound(a);
Put Edit('element',j,txt,a(j))(skip,a,f(3),x(1),a,x(1),a);
End;
End;
End;

75
Task/Sorting-algorithms-Heapsort/PL-M/sorting-algorithms-heapsort.plm Normal file
View file

@ -0,0 +1,75 @@
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

53
Task/Sorting-algorithms-Heapsort/Pascal/sorting-algorithms-heapsort.pas Normal file
View file

@ -0,0 +1,53 @@
program HeapSortDemo;
{$mode objfpc}{$h+}{$b-}
procedure HeapSort(var a: array of Integer);
procedure SiftDown(Root, Last: Integer);
var
Child, Tmp: Integer;
begin
while Root * 2 + 1 <= Last do begin
Child := Root * 2 + 1;
if (Child + 1 <= Last) and (a[Child] < a[Child + 1]) then
Inc(Child);
if a[Root] < a[Child] then begin
Tmp := a[Root];
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
Tmp := a[0];
a[0] := a[I];
a[I] := Tmp;
SiftDown(0, I - 1);
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
Write(A[I], ', ');
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);
HeapSort(a2);
PrintArray('a2', a2);
end.

40
Task/Sorting-algorithms-Heapsort/Perl/sorting-algorithms-heapsort.pl Normal file
View file

@ -0,0 +1,40 @@
#!/usr/bin/perl
my @a = (4, 65, 2, -31, 0, 99, 2, 83, 782, 1);
print "@a\n";
heap_sort(\@a);
print "@a\n";
sub heap_sort {
my ($a) = @_;
my $n = @$a;
for (my $i = ($n - 2) / 2; $i >= 0; $i--) {
down_heap($a, $n, $i);
}
for (my $i = 0; $i < $n; $i++) {
my $t = $a->[$n - $i - 1];
$a->[$n - $i - 1] = $a->[0];
$a->[0] = $t;
down_heap($a, $n - $i - 1, 0);
}
}
sub down_heap {
my ($a, $n, $i) = @_;
while (1) {
my $j = max($a, $n, $i, 2 * $i + 1, 2 * $i + 2);
last if $j == $i;
my $t = $a->[$i];
$a->[$i] = $a->[$j];
$a->[$j] = $t;
$i = $j;
}
}
sub max {
my ($a, $n, $i, $j, $k) = @_;
my $m = $i;
$m = $j if $j < $n && $a->[$j] > $a->[$m];
$m = $k if $k < $n && $a->[$k] > $a->[$m];
return $m;
}

43
Task/Sorting-algorithms-Heapsort/Phix/sorting-algorithms-heapsort.phix Normal file
View file

@ -0,0 +1,43 @@
(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>
<!--

44
Task/Sorting-algorithms-Heapsort/Picat/sorting-algorithms-heapsort.picat Normal file
View file

@ -0,0 +1,44 @@
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.

19
Task/Sorting-algorithms-Heapsort/PicoLisp/sorting-algorithms-heapsort.l Normal file
View file

@ -0,0 +1,19 @@
(de heapSort (A Cnt)
(let Cnt (length A)
(for (Start (/ Cnt 2) (gt0 Start) (dec Start))
(siftDown A Start (inc Cnt)) )
(for (End Cnt (> End 1) (dec End))
(xchg (nth A End) A)
(siftDown A 1 End) ) )
A )
(de siftDown (A Start End)
(use Child
(for (Root Start (> End (setq Child (* 2 Root))))
(and
(> End (inc Child))
(> (get A (inc Child)) (get A Child))
(inc 'Child) )
(NIL (> (get A Child) (get A Root)))
(xchg (nth A Root) (nth A Child))
(setq Root Child) ) ) )

35
Task/Sorting-algorithms-Heapsort/PowerShell/sorting-algorithms-heapsort.psh Normal file
View file

@ -0,0 +1,35 @@
function heapsort($a, $count) {
$a = heapify $a $count
$end = $count - 1
while( $end -gt 0) {
$a[$end], $a[0] = $a[0], $a[$end]
$end--
$a = siftDown $a 0 $end
}
$a
}
function heapify($a, $count) {
$start = [Math]::Floor(($count - 2) / 2)
while($start -ge 0) {
$a = siftDown $a $start ($count-1)
$start--
}
$a
}
function siftdown($a, $start, $end) {
$b, $root = $true, $start
while(( ($root * 2 + 1) -le $end) -and $b) {
$child = $root * 2 + 1
if( ($child + 1 -le $end) -and ($a[$child] -lt $a[$child + 1]) ) {
$child++
}
if($a[$root] -lt $a[$child]) {
$a[$root], $a[$child] = $a[$child], $a[$root]
$root = $child
}
else { $b = $false}
}
$a
}
$array = @(60, 21, 19, 36, 63, 8, 100, 80, 3, 87, 11)
"$(heapsort $array $array.Count)"

36
Task/Sorting-algorithms-Heapsort/PureBasic/sorting-algorithms-heapsort.basic Normal file
View file

@ -0,0 +1,36 @@
Declare heapify(Array a(1), count)
Declare siftDown(Array a(1), start, ending)
Procedure heapSort(Array a(1), count)
Protected ending=count-1
heapify(a(), count)
While ending>0
Swap a(ending),a(0)
siftDown(a(), 0, ending-1)
ending-1
Wend
EndProcedure
Procedure heapify(Array a(1), count)
Protected start=(count-2)/2
While start>=0
siftDown(a(),start,count-1)
start-1
Wend
EndProcedure
Procedure siftDown(Array a(1), start, ending)
Protected root=start, child
While (root*2+1)<=ending
child=root*2+1
If child+1<=ending And a(child)<a(child+1)
child+1
EndIf
If a(root)<a(child)
Swap a(root), a(child)
root=child
Else
Break
EndIf
Wend
EndProcedure

24
Task/Sorting-algorithms-Heapsort/Python/sorting-algorithms-heapsort.py Normal file
View file

@ -0,0 +1,24 @@
def heapsort(lst):
''' Heapsort. Note: this function sorts in-place (it mutates the list). '''
# in pseudo-code, heapify only called once, so inline it here
for start in range((len(lst)-2)/2, -1, -1):
siftdown(lst, start, len(lst)-1)
for end in range(len(lst)-1, 0, -1):
lst[end], lst[0] = lst[0], lst[end]
siftdown(lst, 0, end - 1)
return lst
def siftdown(lst, start, end):
root = start
while True:
child = root * 2 + 1
if child > end: break
if child + 1 <= end and lst[child] < lst[child + 1]:
child += 1
if lst[root] < lst[child]:
lst[root], lst[child] = lst[child], lst[root]
root = child
else:
break

8
Task/Sorting-algorithms-Heapsort/Quackery/sorting-algorithms-heapsort.quackery Normal file
View file

@ -0,0 +1,8 @@
[ [] 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

22
Task/Sorting-algorithms-Heapsort/REXX/sorting-algorithms-heapsort-1.rexx Normal file
View file

@ -0,0 +1,22 @@
/*REXX pgm sorts an array (names of epichoric Greek letters) using a heapsort algorithm.*/
parse arg x; call init /*use args or default, define @ array.*/
call show "before sort:" /*#: the number of elements in array*/
call heapSort #; say copies('▒', 40) /*sort; then after sort, show separator*/
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' ,
"xi omicron pi san qoppa rho sigma tau upsilon phi chi psi omega"
if x='' then x= _; #= words(x) /*#: number of words in X*/
do j=1 for #; @.j= word(x, j); end; return /*assign letters to array*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
heapSort: procedure expose @.; arg n; do j=n%2 by -1 to 1; call shuffle j,n; end /*j*/
do n=n by -1 to 2; _= @.1; @.1= @.n; @.n= _; call heapSuff 1,n-1
end /*n*/; return /* [↑] swap two elements; and shuffle.*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
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

72
Task/Sorting-algorithms-Heapsort/REXX/sorting-algorithms-heapsort-2.rexx Normal file
View file

@ -0,0 +1,72 @@
/* REXX ***************************************************************
* Translated from PL/I
* 27.07.2013 Walter Pachl
**********************************************************************/
list='---letters of the modern Greek Alphabet---|'||,
'==========================================|'||,
'alpha|beta|gamma|delta|epsilon|zeta|eta|theta|'||,
'iota|kappa|lambda|mu|nu|xi|omicron|pi|'||,
'rho|sigma|tau|upsilon|phi|chi|psi|omega'
Do i=0 By 1 While list<>''
Parse Var list a.i '|' list
End
n=i-1
Call showa 'before sort'
Call heapsort n
Call showa ' after sort'
Exit
heapSort: Procedure Expose a.
Parse Arg count
Call heapify count
end=count-1
do while end>0
Call swap end,0
end=end-1
Call siftDown 0,end
End
Return
heapify: Procedure Expose a.
Parse Arg count
start=(count-2)%2
Do while start>=0
Call siftDown start,count-1
start=start-1
End
Return
siftDown: Procedure Expose a.
Parse Arg start,end
root=start
Do while root*2+1<= end
child=root*2+1
sw=root
if a.sw<a.child Then
sw=child
child_1=child+1
if child+1<=end & a.sw<a.child_1 Then
sw=child+1
if sw<>root Then Do
Call swap root,sw
root=sw
End
else
return
End
Return
swap: Procedure Expose a.
Parse arg x,y
temp=a.x
a.x=a.y
a.y=temp
Return
showa: Procedure Expose a. n
Parse Arg txt
Do j=0 To n-1
Say 'element' format(j,2) txt a.j
End
Return

26
Task/Sorting-algorithms-Heapsort/Racket/sorting-algorithms-heapsort.rkt Normal file
View file

@ -0,0 +1,26 @@
#lang racket
(require (only-in srfi/43 vector-swap!))
(define (heap-sort! xs)
(define (ref i) (vector-ref xs i))
(define (swap! i j) (vector-swap! xs i j))
(define size (vector-length xs))
(define (sift-down! r end)
(define c (+ (* 2 r) 1))
(define c+1 (+ c 1))
(when (<= c end)
(define child
(if (and (<= c+1 end) (< (ref c) (ref c+1)))
c+1 c))
(when (< (ref r) (ref child))
(swap! r child))
(sift-down! child end)))
(for ([i (in-range (quotient (- size 2) 2) -1 -1)])
(sift-down! i (- size 1)))
(for ([end (in-range (- size 1) 0 -1)])
(swap! 0 end)
(sift-down! 0 (- end 1)))
xs)

25
Task/Sorting-algorithms-Heapsort/Raku/sorting-algorithms-heapsort.raku Normal file
View file

@ -0,0 +1,25 @@
sub heap_sort ( @list ) {
for ( 0 ..^ +@list div 2 ).reverse -> $start {
_sift_down $start, @list.end, @list;
}
for ( 1 ..^ +@list ).reverse -> $end {
@list[ 0, $end ] .= reverse;
_sift_down 0, $end-1, @list;
}
}
sub _sift_down ( $start, $end, @list ) {
my $root = $start;
while ( my $child = $root * 2 + 1 ) <= $end {
$child++ if $child + 1 <= $end and [<] @list[ $child, $child+1 ];
return if @list[$root] >= @list[$child];
@list[ $root, $child ] .= reverse;
$root = $child;
}
}
my @data = 6, 7, 2, 1, 8, 9, 5, 3, 4;
say 'Input = ' ~ @data;
@data.&heap_sort;
say 'Output = ' ~ @data;

50
Task/Sorting-algorithms-Heapsort/Ring/sorting-algorithms-heapsort.ring Normal file
View file

@ -0,0 +1,50 @@
# Project : Sorting algorithms/Heapsort
test = [4, 65, 2, -31, 0, 99, 2, 83, 782, 1]
see "before sort:" + nl
showarray(test)
heapsort(test)
see "after sort:" + nl
showarray(test)
func heapsort(a)
cheapify(a)
for e = len(a) to 1 step -1
temp = a[e]
a[e] = a[1]
a[1] = temp
siftdown(a, 1, e-1)
next
func cheapify(a)
m = len(a)
for s = floor((m - 1) / 2) to 1 step -1
siftdown(a,s,m)
next
func siftdown(a,s,e)
r = s
while r * 2 + 1 <= e
c = r * 2
if c + 1 <= e
if a[c] < a[c + 1]
c = c + 1
ok
ok
if a[r] < a[c]
temp = a[r]
a[r] = a[c]
a[c] = temp
r = c
else
exit
ok
end
func showarray(vect)
svect = ""
for n = 1 to len(vect)
svect = svect + vect[n] + " "
next
svect = left(svect, len(svect) - 1)
see svect + nl

34
Task/Sorting-algorithms-Heapsort/Ruby/sorting-algorithms-heapsort.rb Normal file
View file

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

43
Task/Sorting-algorithms-Heapsort/Rust/sorting-algorithms-heapsort-1.rust Normal file
View file

@ -0,0 +1,43 @@
fn main() {
let mut v = [4, 6, 8, 1, 0, 3, 2, 2, 9, 5];
heap_sort(&mut v, |x, y| x < y);
println!("{:?}", v);
}
fn heap_sort<T, F>(array: &mut [T], order: F)
where
F: Fn(&T, &T) -> bool,
{
let len = array.len();
// Create heap
for start in (0..len / 2).rev() {
shift_down(array, &order, start, len - 1)
}
for end in (1..len).rev() {
array.swap(0, end);
shift_down(array, &order, 0, end - 1)
}
}
fn shift_down<T, F>(array: &mut [T], order: &F, start: usize, end: usize)
where
F: Fn(&T, &T) -> bool,
{
let mut root = start;
loop {
let mut child = root * 2 + 1;
if child > end {
break;
}
if child + 1 <= end && order(&array[child], &array[child + 1]) {
child += 1;
}
if order(&array[root], &array[child]) {
array.swap(root, child);
root = child
} else {
break;
}
}
}

Some files were not shown because too many files have changed in this diff Show more