A small code inspired from Junmin Lee's video about Heap data structure.
https://www.youtube.com/watch?v=3DYIgTC4T1o
I have coded the heap with Long type but feel free to change it to any other type you might need.
Best regards
StarBootics
Code: Select all
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Project name : Long Heap Data Structure
; File Name : LongHeap - OOP.pb
; File version: 1.0.0
; Programming : OK
; Programmed by : StarBootics
; Date : October 4th, 2022
; Last Update : October 4th, 2022
; PureBasic code : V6.00 LTS
; Platform : Windows, Linux, MacOS X
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Programming Notes
;
; 1. This code is inspired from Junmin Lee's video about Heap
; data structure.
;
; https://www.youtube.com/watch?v=3DYIgTC4T1o
;
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
DeclareModule LongHeap
#Type_Min = 0
#Type_Max = 1
Interface LongHeap
CurrentSize.l()
Insert(Key.l)
Extract.l()
Free()
EndInterface
Declare.i New(Type.i = #Type_Min)
EndDeclareModule
Module LongHeap
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Structure decalration <<<<<
Structure Private_Members
VirtualTable.i
Type.i
Array Heap.l(0)
CurrentSize.l
EndStructure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Helper macros <<<<<
Macro ParentIndex(Index)
((Index-1) / 2)
EndMacro
Macro LeftChildIndex(Index)
((Index << 1) + 1)
EndMacro
Macro RightChildIndex(Index)
((Index << 1) + 2)
EndMacro
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The HeapifyUp (Private) <<<<<
Procedure HeapifyUp(*This.Private_Members, Index.l)
Select *This\Type
Case #Type_Min
While *This\Heap(ParentIndex(Index)) > *This\Heap(Index)
Swap *This\Heap(ParentIndex(Index)), *This\Heap(Index)
Index = ParentIndex(Index)
Wend
Case #Type_Max
While *This\Heap(ParentIndex(Index)) < *This\Heap(Index)
Swap *This\Heap(ParentIndex(Index)), *This\Heap(Index)
Index = ParentIndex(Index)
Wend
EndSelect
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The HeapifyDown (Private) <<<<<
Procedure HeapifyDown(*This.Private_Members, Index.l)
LastIndex.l = ArraySize(*This\Heap())
LeftIndex.l = LeftChildIndex(Index)
RightIndex.l = RightChildIndex(Index)
ChildToCompare.l = 0
Select *This\Type
Case #Type_Min
While LeftIndex < LastIndex
If LeftIndex = LastIndex
ChildToCompare = LeftIndex
ElseIf *This\Heap(LeftIndex) < *This\Heap(RightIndex)
ChildToCompare = LeftIndex
Else
ChildToCompare = RightIndex
EndIf
If *This\Heap(Index) > *This\Heap(ChildToCompare)
Swap *This\Heap(Index), *This\Heap(ChildToCompare)
Index = ChildToCompare
LeftIndex = LeftChildIndex(Index)
RightIndex = RightChildIndex(Index)
Else
LeftIndex = LastIndex + 5
EndIf
Wend
Case #Type_Max
While LeftIndex < LastIndex
If LeftIndex = LastIndex
ChildToCompare = LeftIndex
ElseIf *This\Heap(LeftIndex) > *This\Heap(RightIndex)
ChildToCompare = LeftIndex
Else
ChildToCompare = RightIndex
EndIf
If *This\Heap(Index) < *This\Heap(ChildToCompare)
Swap *This\Heap(Index), *This\Heap(ChildToCompare)
Index = ChildToCompare
LeftIndex = LeftChildIndex(Index)
RightIndex = RightChildIndex(Index)
Else
LeftIndex = LastIndex + 5
EndIf
Wend
EndSelect
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The CurrentSize operator <<<<<
Procedure.l CurrentSize(*This.Private_Members)
ProcedureReturn ArraySize(*This\Heap())
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Insert operator <<<<<
Procedure Insert(*This.Private_Members, Key.l)
CurrentSize.l = ArraySize(*This\Heap())
*This\CurrentSize + 1
*This\Heap(CurrentSize) = Key
ReDim *This\Heap(CurrentSize + 1)
HeapifyUp(*This, CurrentSize)
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Extract operator <<<<<
Procedure.l Extract(*This.Private_Members)
CurrentSize.l = ArraySize(*This\Heap())
*This\CurrentSize - 1
If *This\CurrentSize >= 0
Extracted.l = *This\Heap(0)
*This\Heap(0) = *This\Heap(CurrentSize-1)
ReDim *This\Heap(CurrentSize - 1)
HeapifyDown(*This, 0)
Else
Debug "The heap Is Empty !"
EndIf
ProcedureReturn Extracted
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Destructor <<<<<
Procedure Free(*This.Private_Members)
FreeStructure(*This)
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Constructor <<<<<
Procedure.i New(Type.i = #Type_Min)
*This.Private_Members = AllocateStructure(Private_Members)
*This\VirtualTable = ?START_METHODS
If Type <= #Type_Min
*THis\Type = #Type_Min
ElseIf Type >= #Type_Max
*THis\Type = #Type_Max
EndIf
ProcedureReturn *This
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Virtual Table Entries <<<<<
DataSection
START_METHODS:
Data.i @CurrentSize()
Data.i @Insert()
Data.i @Extract()
Data.i @Free()
END_METHODS:
EndDataSection
EndModule
CompilerIf #PB_Compiler_IsMainFile
MyMinHeap.LongHeap::LongHeap = LongHeap::New(LongHeap::#Type_Min)
MyMaxHeap.LongHeap::LongHeap = LongHeap::New(LongHeap::#Type_Max)
MyMinHeap\Insert(10)
MyMinHeap\Insert(20)
MyMinHeap\Insert(30)
MyMinHeap\Insert(5)
MyMinHeap\Insert(7)
MyMinHeap\Insert(9)
MyMinHeap\Insert(11)
MyMinHeap\Insert(13)
MyMinHeap\Insert(15)
MyMinHeap\Insert(17)
While MyMinHeap\CurrentSize() > 0
Value.l = MyMinHeap\Extract()
Debug Value
MyMaxHeap\Insert(Value)
Wend
Debug "------------------------"
While MyMaxHeap\CurrentSize() > 0
Debug MyMaxHeap\Extract()
Wend
MyMinHeap\Free()
MyMaxHeap\Free()
CompilerEndIf
; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< END OF FILE <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<