Long Heap Data Structure

Share your advanced PureBasic knowledge/code with the community.
User avatar
StarBootics
Addict
Addict
Posts: 984
Joined: Sun Jul 07, 2013 11:35 am
Location: Canada

Long Heap Data Structure

Post by StarBootics »

Hello everyone,

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 <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<
The Stone Age did not end due to a shortage of stones !