[MODULE] AVL Tree

[microdevweb]

Bonjour à tous,

Edit :

version 1.0 BETA 2

Voici une teste avec + de 450.000 records

Temps de chargement chez moi (fichier csv) +- 25 secondes avec le déboguer activé et 1.21 secondes sans le déboguer.

Donc pour de meilleurs performances désactiver le déboguer.

Temps de recherche chez moi sous la ms

Lien github


J'ai ajouté un fichier pour comparer avec une list LK_compare.pb

Résultat
au chargement 0.86 s
recherche au pire 66 ms




Voici un petit module (version Beta) pour la gestion d'un arbre AVL (ordonné).

L'avantage d'un arbre par rapport à une liste chaînée réside dans la puissante de la recherche.

Un exemple :
pour 6.000.000.000 d'enregistrements avec une liste et donc un parcours séquentielle dans le pire des cas vous devrez faire 6.000.000.000 d'itérations (comparaisons).

avec un arbre équilibré et donc un parcours dichotomique dans le pire des cas vous devrez faire 33 itérations (comparaisons) 2^33 = +- 8x10^9.

évidement il y a un coût, l'ajout sera plus long que pour une liste.

Remarque : actuellement ne fonctionne qu'avec des clés uniques

Ce module est de type générique :

Vous devez créer une structure et l'allouer dynamiquement (équivalent d'un malloc en c)

Code : Tout sélectionner

Structure people
  id.l
  name.s
EndStructure

Define *p.people

*p = AllocateStructure(people)

Vous devez créer une procédure de test, que vous passerez en paramètre à la création de l'arbre

Code : Tout sélectionner

Procedure compare(*a.people,*b.people)
  If *a\id > *b\id :ProcedureReturn 1 :EndIf
  If *a\id < *b\id :ProcedureReturn -1 :EndIf
  ProcedureReturn 0
EndProcedure

Global myTree.AVL_TREE::tree = AVL_TREE::new_tree(@compare())

Note : je vais faire d'autre tests avec par exemple une table de +- 500.000 élements
Code du main (exemple)
Code du Prototype du module
Code du module

[microdevweb]

Code : Tout sélectionner

;**********************************************************************************************************************
;* PROJECT        : AVL_TREE
;* PROCESS        : manage a avl tree
;* FILE           : main.pbi
;* CONTENT        : main program
;* AUTHOR         : microdedWeb
;* DATE           : 2019/12/17
;**********************************************************************************************************************
EnableExplicit
XIncludeFile "lib/avl_tree.pbi"
;***********************************************************************************************************************
;*DEFINES AND STRUCTURES AND 
;***********************************************************************************************************************
Structure people
  id.l
  name.s
EndStructure
;***********************************************************************************************************************
;*PROTOTYPES OF FUNCTION
;***********************************************************************************************************************
Declare compare(*a.people,*b.people)
Declare.s dsp(*c.people) 
;***********************************************************************************************************************
;*GLOBAL VARAIBLES
;***********************************************************************************************************************
Global myTree.AVL_TREE::tree = AVL_TREE::new_tree(@compare())
;***********************************************************************************************************************
;*RUN PROGRAM
;***********************************************************************************************************************
Define in.s
Define *p.people,*r.people
OpenConsole("AVL TREE")
EnableGraphicalConsole(1)

*p = AllocateStructure(people)
*p\id = 10
*p\name = "Zorro"
myTree\add(*p)

*p = AllocateStructure(people)
*p\id = 20
*p\name = "Boulou"
myTree\add(*p) 

*p = AllocateStructure(people)
*p\id = 30
*p\name = "Pierre"
myTree\add(*p) 

*p = AllocateStructure(people)
*p\id = 40
*p\name = "Alain"
myTree\add(*p) 

*p = AllocateStructure(people)
*p\id = 50
*p\name = "Yve"
myTree\add(*p) 

*p = AllocateStructure(people)
*p\id = 25
*p\name = "Jacques"
myTree\add(*p) 

myTree\display(@dsp())
Input()

*r = myTree\search(*p) ; look for Jacques
If *r
  PrintN("")
  Print(*r\name)
Else
  PrintN("")
  Print("Not found")
EndIf
Input()

*p\id = 30
*r = myTree\search(*p) ; look for Pierre
If *r
  PrintN("")
  Print(*r\name)
Else
  PrintN("")
  Print("Not found")
EndIf
Input()

*p\id = 20
*r = myTree\search(*p) ; look for Boulou
If *r
  PrintN("")
  Print(*r\name)
Else
  PrintN("")
  Print("Not found")
EndIf
Input()

End

;***********************************************************************************************************************
;*FUNCTIONS
;***********************************************************************************************************************
Procedure compare(*a.people,*b.people)
  If *a\id > *b\id :ProcedureReturn 1 :EndIf
  If *a\id < *b\id :ProcedureReturn -1 :EndIf
  ProcedureReturn 0
EndProcedure
Procedure.s dsp(*c.people) 
  ProcedureReturn Str(*c\id)
EndProcedure

[microdevweb]

Code : Tout sélectionner

;**********************************************************************************************************************
;* CLASS          : AVL_TREE
;* PROCESS        : manage a avl tree
;* FILE           : avl_tree.pbi
;* CONTENT        : avlt_tree prototypes
;* AUTHOR         : microdedWeb
;* DATE           : 2019/12/17
;* MAJOR VERSION  : 1
;* MINOR VERSION  : 0 B1
;**********************************************************************************************************************
DeclareModule AVL_TREE
  Interface tree
    ;*******************************************************************
    ;* PUBLIC METHOD : add
    ;* PROCESS       : add a new item to avl tree
    ;* ARGUMENT      : content -> that is a pointer on your structure
    ;* RETURN        : VOID
    ;*******************************************************************
    add(content)
    ;*******************************************************************
    ;* PUBLIC METHOD : search
    ;* PROCESS        : search a node
    ;* ARGUMENT       : *toSearch -> structure to search
    ;* RETURN         : *n._NODE or 0 if not found
    ;*******************************************************************
    search(toSearch)
    ;*******************************************************************
    ;* PUBLIC METHOD : display
    ;* PROCESS       : display node for debug it
    ;* ARGUMENT      : *mth -> personal user function
    ;                          procedure.s myFunction(*content)
    ;                               procedureReturn valueToDisplaying.s
    ;                          EndProcedure
    ;* RETURN        : VOID
    ;*******************************************************************
    display(mth)
  EndInterface
  
  Interface node
    ;*******************************************************************
    ;* PUBLIC METHOD : get_content
    ;* PROCESS       : get content address from the node
    ;* ARGUMENT      : VOID
    ;* RETURN        : content
    ;*******************************************************************
    get_content()
  EndInterface
  ;*********************************************************************
  ;* CONSTRUCTOR :
  ;* ARGUMENTS   : *cmp  -> it's the address off your  procedure(*a,*b) 
  ;*                                    it will return 1 if a > b         
  ;*                                                  -1 if a < b  
  ;*                                                   0 if a = b
  ;*********************************************************************
  Declare new_tree(*cmp)
EndDeclareModule

XIncludeFile "_avl_tree.pbi"

[microdevweb]

Code : Tout sélectionner

;**********************************************************************************************************************
;* CLASS          : AVL_TREE
;* PROCESS        : manage a avl tree
;* FILE           : _avl_tree.pbi
;* CONTENT        : avlt_tree implementation
;* AUTHOR         : microdedWeb
;* DATE           : 2019/12/17
;* MAJOR VERSION  : 1
;* MINOR VERSION  : 0 B1
;**********************************************************************************************************************
Module AVL_TREE
  EnableExplicit
  Prototype.l cmp(*a,*b) 
  Prototype.s dsp(*n)
  Structure _NODE
    *methods
    *content
    *right._NODE
    *left._NODE
    height.l
  EndStructure
  Structure _AVL
    *methods
    *root._NODE
    *cmp.cmp
  EndStructure
  ;*******************************************************************
  ;* PRIVATE METHODS
  ;*******************************************************************
  Declare insert(*this._AVL,*n._NODE,*content)
  Declare max(a,b)
  Declare height(*n._NODE)
  Declare new_node(*content)
  Declare right_rotate(*y._NODE)
  Declare left_rotate(*x._NODE)
  Declare get_balance(*n._NODE)
  Declare _search(*this._AVL,*n._NODE,*toSearch)
  ;*******************************************************************
  ;* PRIVATE METHOD : insert
  ;* PROCESS        : insert a item at avl tree
  ;* ARGUMENT       : *n._NODE -> current avl tree
  ;                   *content   -> content to insert
  ;* RETURN         : VOID
  ;*******************************************************************
  Procedure insert(*this._AVL,*n._NODE,*content)
    With *this
      ; 1 perform the normal tree insertion
      If Not *n
        ProcedureReturn new_node(*content)
      EndIf
      If \cmp(*content,*n\content) < 0
        *n\left = insert(*this,*n\left,*content)
      ElseIf \cmp(*content,*n\content) > 0
        *n\right = insert(*this,*n\right,*content)
      Else ; equal are not allowed at this time
        ProcedureReturn *n
      EndIf
      ; 2 update height of this ancestor node
      *n\height = 1 + max(height(*n\left),height(*n\right))
      ; 3 get the balance factor of this ancestor 
      ; node to chack whether this node became unbalanced
      Define balance = get_balance(*n) 
      ; if this node becomes unbalanced, then there are 4 cases
      ; -> left left case
      If balance > 1 And \cmp(*content,*n\left\content)<0
        ProcedureReturn right_rotate(*n)
      EndIf
      ; -> right right case
      If balance < -1 And \cmp(*content,*n\right\content)>0
        ProcedureReturn left_rotate(*n)
      EndIf
      ; -> left right case
      If balance > 1 And \cmp(*content,*n\left\content)>0
        *n\left = left_rotate(*n\left)
        ProcedureReturn right_rotate(*n)
      EndIf
      ; -> right left case
      If balance < -1 And \cmp(*content,*n\right\content)<0
        *n\right = right_rotate(*n\right)
        ProcedureReturn left_rotate(*n)
      EndIf
      ; return the unchanged node
      ProcedureReturn *n
    EndWith
  EndProcedure
  ;*******************************************************************
  ;* PRIVATE METHOD : max
  ;* PROCESS        : return the greater value between 2 integer
  ;* ARGUMENT       : a       -> first value
  ;                   a       -> second value
  ;* RETURN         : integer -> upper value
  ;*******************************************************************
  Procedure max(a,b)
    If a > b
      ProcedureReturn a
    Else
      ProcedureReturn b
    EndIf
  EndProcedure
  ;*******************************************************************
  ;* PRIVATE METHOD : height
  ;* PROCESS        : return the height of a node or 0 if node is null
  ;* ARGUMENT       : *n._NODE -> node to ask
  ;* RETURN         : integer  -> height to node
  ;*******************************************************************
  Procedure height(*n._NODE)
    With *n
      If Not *n:ProcedureReturn 0:EndIf
      ProcedureReturn \height
    EndWith
  EndProcedure
  ;*******************************************************************
  ;* PRIVATE METHOD : new_node
  ;* PROCESS        : allocate a new node and return it
  ;* ARGUMENT       : *content  -> node content
  ;* RETURN         : *node
  ;*******************************************************************
  Procedure new_node(*content)
    Protected *n._NODE = AllocateStructure(_NODE)
    With *n
      \content = *content
      \left = 0
      \right = 0
      \height = 1
      ProcedureReturn *n
    EndWith
  EndProcedure
  ;*******************************************************************
  ;* PRIVATE METHOD : right_rotate
  ;* PROCESS        : rotate a node to right
  ;* ARGUMENT       : *y -> node to rotate
  ;* RETURN         : *_NODE -> new root
  ;*******************************************************************
  Procedure right_rotate(*y._NODE)
    Protected *x._NODE = *y\left
    Protected *T2._NODE = *x\right
    ; Perform rotation
    *x\right = *y
    *y\left = *T2
    ; update height
    *y\height = max(height(*y\left),height(*y\right))+1
    *x\height = max(height(*x\left),height(*x\right))+1
    ; return the new root
    ProcedureReturn *x
  EndProcedure
  ;*******************************************************************
  ;* PRIVATE METHOD : right_rotate
  ;* PROCESS        : rotate a node to right
  ;* ARGUMENT       : *y -> node to rotate
  ;* RETURN         : *_NODE -> new root
  ;*******************************************************************
  Procedure left_rotate(*x._NODE)
    Protected *y._NODE = *x\right
    Protected *T2._NODE = *y\left
    ; Perform rotation
    *y\left = *x
    *x\right = *T2
    ; update height
    *x\height = max(height(*x\left),height(*x\right))+1
    *y\height = max(height(*y\left),height(*y\right))+1
    ; return the new root
    ProcedureReturn *y
  EndProcedure
  ;*******************************************************************
  ;* PRIVATE METHOD : get_balance
  ;* PROCESS        : get balance factor
  ;* ARGUMENT       : *n._NODE -> node to ask
  ;* RETURN         : int balance factor
  ;*******************************************************************
  Procedure get_balance(*n._NODE)
    With *n
      If Not *n :ProcedureReturn  0 :EndIf
      ProcedureReturn height(*n\left) - height(*n\right)
    EndWith
  EndProcedure
  ;*******************************************************************
  ;* PRIVATE METHOD : _disp
  ;* PROCESS        : display node
  ;* ARGUMENT       : *n._NODE -> node to display
  ;* RETURN         : VOID
  ;* NOTE           : recursive method
  ;*******************************************************************
  Procedure _disp(*n._NODE,*mth,n)
    Protected f.dsp = *mth
    With *n
      If *n
        Print("N : "+Str(n)+"  ")
        Print(f(*n\content))
        If *n\left
          Print(" / ")
        EndIf
        _disp(*n\left,*mth,n+1)
        If *n\right
          Print(" \ ")
        EndIf
        _disp(*n\right,*mth,n+1)
      EndIf
    EndWith
  EndProcedure
  ;*******************************************************************
  ;* PRIVATE METHOD : _search
  ;* PROCESS        : search a node
  ;* ARGUMENT       : *n._NODE   -> root to begin
  ;                    *toSearch -> structure to search
  ;* RETURN         : *n._NODE or 0 if not found
  ;* NOTE           : recursive method
  ;*******************************************************************
  Procedure _search(*this._AVL,*n._NODE,*toSearch)
    With *this
      ; not found
      If Not *n
        ProcedureReturn 0
      EndIf
      If \cmp(*toSearch,*n\content) = 0
        ProcedureReturn *n\content
      EndIf
      If \cmp(*toSearch,*n\content) > 0
        ProcedureReturn _search(*this,*n\right,*toSearch)
      EndIf
      If \cmp(*toSearch,*n\content) < 0
        ProcedureReturn _search(*this,*n\left,*toSearch)
      EndIf
    EndWith
  EndProcedure
  
  ;*******************************************************************
  ;*PUBLIC METHODS AVL
  ;*******************************************************************
  ;*******************************************************************
  ;* PUBLIC METHOD : add
  ;* PROCESS       : add a new item to avl tree
  ;* ARGUMENT      : content -> that is a pointer on your structure
  ;* RETURN        : VOID
  ;*******************************************************************
  Procedure add(*this._AVL,*content) 
    With *this
      \root = insert(*this,\root,*content)
      ProcedureReturn \root
    EndWith
  EndProcedure
  ;*******************************************************************
  ;* PUBLIC METHOD : search
  ;* PROCESS        : search a node
  ;* ARGUMENT       : *toSearch -> structure to search
  ;* RETURN         : *n._NODE or 0 if not found
  ;*******************************************************************
  Procedure search(*this._AVL,*toSearch)
    With *this
      ProcedureReturn _search(*this,\root,*toSearch)
    EndWith
  EndProcedure
  ;*******************************************************************
  ;* PUBLIC METHOD : display
  ;* PROCESS       : display node for debug it
  ;* ARGUMENT      : *mth -> personal user function
  ;                          procedure.s myFunction(*content)
  ;                               procedureReturn valueToDisplaying.s
  ;                          EndProcedure
  ;* RETURN        : VOID
  ;*******************************************************************
  Procedure display(*this._AVL,*mth)
    With *this
      _disp(\root,*mth,1)
    EndWith
  EndProcedure
  ;*******************************************************************
  ;*PUBLIC METHODS NODE
  ;*******************************************************************
  ;*******************************************************************
  ;* PUBLIC METHOD : get_content
  ;* PROCESS       : get content address from the node
  ;* ARGUMENT      : VOID
  ;* RETURN        : content
  ;*******************************************************************
  Procedure get_content(*this._NODE)
    With *this
      ProcedureReturn \content
    EndWith
  EndProcedure
  ;*********************************************************************
  ;*CONSTRUCTOR
  ;*********************************************************************
  Procedure new_tree(*cmp)
    Protected  *this._AVL = AllocateStructure(_AVL)
    With *this
      \methods = ?avl_start
      \cmp = *cmp
      ProcedureReturn *this
    EndWith
  EndProcedure
  ; AVL METHODS
  DataSection
    avl_start:
    Data.i @add()
    Data.i @search()
    Data.i @display()
    avl_end:
  EndDataSection
  ; NODE METHODS
  DataSection
    node_start:
    Data.i @get_content()
    node_end:
  EndDataSection  
EndModule

[Micoute]

Génial, merci pour le partage.

[Kwai chang caine]

Bonjour microdevweb ,

J'ai lancé ton code (W7 X86 / V5.70 X86) et après plusieurs minutes, j'ai ça

Please wait we load above 450.000 records, that can be take some time
449000 data are loaded in 21.97 seconds

[microdevweb]

@Kwai chang caine,

Oui j'aurais peu dire qu'il fallait pousser sur une touche pour la suite Car après tu peux rentrer un id pour le rechercher.

[Naheulf]

J'ai ouvert ton projet et lorsque j'essaye de compiler j'ai ça :

La cible 'Cible par défaut' pour ce projet n'a pas de fichier source principal défini (à spécifier dans 'Options du compilateur').

Après avoir fait quelques modifs* pour avoir une meilleure estimation du temps passé pour la recherche d'éléments j'obtiens les temps suivants :

Débogueur activé :
- chargement : environ 40 secondes
- recherche : 31,207µs par recherche**

Débogueur désactivé :
- chargement : environ 2 secondes
- recherche : 0,792µs par recherche**

*Pour tenter d'avoir une estimation plus précise j'ai mesuré le temps mis pour rechercher 1 million de fois d'affilée chaque valeur moins le temps mis par la boucle "à vide" (temps non négligeable lorsque le débogueur est désactivé).

** Le temps indiqué correspond à la moyenne pour la recherche des 7 valeurs aléatoires suivantes : "2227125", "2251835", "2297421", "1393215", "1374629", "662489", "434194" ainsi qu'une valeur hors plage : "500000"

Note : Le fait de faire plusieurs fois la même recherche d’affilée force les valeurs à rester dans les caches du processeur. Le temps mesuré est donc plus court qu'en situation réelle.

Édit : Ce serait marrant de comparer avec le temps mis par les Map natives de purebasic.

[Micoute]

Je ne comprends pas pourquoi chez moi, il n' a aucun problème, alors que d'habitude les rôles sont inversés.

[microdevweb]

@Naheulf,

Humm a mon avis avec une table de hachage le résultat doit être très similaire. Cela dépend évidement de la diversité des clés.

Remarque : ce technique est parfaitement réalisable pour la lecture d'un fichier, il suffis de remplacer l'adresse des structure par un offset fichier.

A et merci pour ton relevé de temps sans débuger que le n'avais perso pas pensé à désactivé. C'est vrai que cela change tout, chez moi 1.21 s pour le chargement