Queue de priorité ou tris pas tas

Partagez votre expérience de PureBasic avec les autres utilisateurs.
Avatar de l’utilisateur
Fig
Messages : 1176
Inscription : jeu. 14/oct./2004 19:48

Queue de priorité ou tris pas tas

Message par Fig »

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
Ce code permet d'intégrer une liste de priorité ou un tris pas tas. Seul l'adresse des éléments à trier est stocké dans le tas.
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.
Il y a deux méthodes pour écrire des programmes sans erreurs. Mais il n’y a que la troisième qui marche.
Version de PB : 6.00LTS - 64 bits
Avatar de l’utilisateur
graph100
Messages : 1318
Inscription : sam. 21/mai/2005 17:50

Re: Queue de priorité ou tris pas tas

Message par graph100 »

effectivement ça pourrais être pratique que cela soit intégré. Mais ça augmenterais le coté "boite noire" de pb (normal c'est un basic)
Je l'utilise pas mal dans plusieurs projets cette méthode.
_________________________________________________
Mon site : CeriseCode (Attention Chantier perpétuel ;))
Avatar de l’utilisateur
Fig
Messages : 1176
Inscription : jeu. 14/oct./2004 19:48

Re: Queue de priorité ou tris pas tas

Message par Fig »

Oui, normal pour un basic...

Mais ça existe de base dans la plupart des autres langages comme le Java par exemple... (et ses avatars)
Il y a deux méthodes pour écrire des programmes sans erreurs. Mais il n’y a que la troisième qui marche.
Version de PB : 6.00LTS - 64 bits
Répondre