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
C'est dommage que PB n'intègre pas cette structure nativement comme il le fait pour les listes chainées.
On pourra facilement transformer les procédures en assembleur plus optimisé, si besoin.