PureBasic

Code : Tout sélectionner

CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
#octets=4
CompilerElse
#octets=8
CompilerEndIf

Procedure NewHeap()
  *mem=AllocateMemory(#octets,#PB_Memory_NoClear)
  PokeI(*mem,0) ;nombre d'éléments dans le tas: 0
  ProcedureReturn *mem  
EndProcedure

Procedure ClearHeap(*mem)
  *mem=ReAllocateMemory(*mem,#octets,#PB_Memory_NoClear)
  PokeI(*mem,0) ;nombre d'éléments dans le tas: 0
  ProcedureReturn *mem 
EndProcedure

Procedure FreeHeap(*mem)
  FreeMemory(*mem)
EndProcedure

Procedure AddHeapElement(*mem,*key)
  nb.i=PeekI(*mem)+1
  *mem=ReAllocateMemory(*mem,#octets+#octets*nb,#PB_Memory_NoClear)
  PokeI(*mem,nb) ;Nombre d'élements+1
  courant.i=nb
  PokeI(*mem+courant*#octets,*key) ;met l'adresse de la valeur en fin de tas
  Repeat
    *actuel=*mem+courant*#octets
    courant=courant>>1
    *parent=*mem+courant*#octets ;i/2
    If courant<1 Or PeekI(PeekI(*parent))<PeekI(PeekI(*actuel)):Break:EndIf
    swap1.i=PeekI(*parent)
    swap2.i=PeekI(*actuel)
    PokeI(*parent,swap2)
    PokeI(*actuel,swap1)    
  ForEver
  ProcedureReturn *mem
EndProcedure

Procedure Heapify(*mem,i)
  nb.i=PeekI(*mem)
  Repeat
  L.i=i<<1 ;gauche
  R.i=L+1 ;droit
  If L<=nb And PeekI(PeekI(*mem+L*#octets))<PeekI(PeekI(*mem+i*#octets))
  Min=L
  Else
  Min=i
  EndIf
  If R<=nb And PeekI(PeekI(*mem+R*#octets))<PeekI(PeekI(*mem+Min*#octets))
  Min=R
  EndIf
  If Min=i:Break:EndIf
    swap1.i=PeekI(*mem+i*#octets)
    swap2.i=PeekI(*mem+Min*#octets)
    PokeI(*mem+i*#octets,swap2)
    PokeI(*mem+Min*#octets,swap1)    
  i=Min
  ForEver
EndProcedure  

Procedure GetHeapMin(*mem,delta.i) ;retourne zero si vide sinon l'adresse de l'element minimum.
  nb.i=PeekI(*mem)
  If nb=0:ProcedureReturn 0:EndIf ;si le tas est vide on renvoit 0
    *Minimum=PeekI(*mem+#octets)-delta
    swap2.i=PeekI(*mem+nb*#octets)
    PokeI(*mem+#octets,swap2)
    nb-1
    PokeI(*mem,nb)

    ;Heapify avec i=1
    i=1
    Repeat
  L.i=i<<1 ;gauche
  R.i=L+1 ;droit
  If L<=nb And PeekI(PeekI(*mem+L*#octets))<PeekI(PeekI(*mem+i*#octets))
  Min=L
  Else
  Min=i
  EndIf
  If R<=nb And PeekI(PeekI(*mem+R*#octets))<PeekI(PeekI(*mem+Min*#octets))
  Min=R
  EndIf
  If Min=i:Break:EndIf
    swap1.i=PeekI(*mem+i*#octets)
    swap2.i=PeekI(*mem+Min*#octets)
    PokeI(*mem+i*#octets,swap2)
    PokeI(*mem+Min*#octets,swap1)    
  i=Min
ForEver

    ProcedureReturn *Minimum
EndProcedure

Procedure HeapSize(*mem)
  ProcedureReturn PeekI(*mem)
EndProcedure

;Exemples
Structure test
  val2.i
  val.i
  chaine.s
EndStructure
NewList test1.test()
NewList test2.i()
nbelement.i=10
*tas1=NewHeap()
*tas2=NewHeap()
For i=1 To nbelement
  AddElement(test1())
  test1()\val=Random(nbelement)
  *tas1=AddHeapElement(*tas1,@test1()\val)
  
  AddElement(test2())
  test2()=Random(nbelement)
  *tas2=AddheapElement(*tas2,@test2())
Next i

For i=1 To nbelement
  *adresseMin=GetHeapMin(*tas1,@test1()\val-@test1())
  If *adresseMin=0:Debug "Tas vide":Continue:EndIf
  ChangeCurrentElement(test1(),*adresseMin)
  Debug test1()\val 
Next i

Debug "-------------"
For i=1 To nbelement
  *adresseMin=GetHeapMin(*tas2,0) ;0 car pas de champs
  If *adresseMin=0:Debug "Tas vide":Continue:EndIf
  ChangeCurrentElement(test2(),*adresseMin)
  Debug test2()
Next i