Arbres + exemple

Dr. Dri · Message par **Dr. Dri** » mer. 27/déc./2006 16:12

C'est le genre de code qu'on a déjà vu sur le forum
Voila un petit code pour manipuler des arbres de String
Parce que trop la flemme de gérer n'importe quel type

C'est loin d'être fini mais c'est calqué sur les listes chaînées
de PB (en gros on a un arbre vide ou un élément courant)

La fonction FreeNode n'est pas terminée, en fait elle fonctionne
de paire avec DeleteNode qui n'existe pas encore...

En gros pour les arbres :

Un arbre (tree) est constitué de noeuds (node)
Chaque noeud peut contenir plusieurs noeud fils (children)
Chaque noeud fils a un père (superior)
Les Noeuds fils d'un même père sont frères (siblings)
La racine (root) de l'arbre n'a ni père ni frère

Code : Tout sélectionner

EnableExplicit

Structure Node
  Element.s
  nNodes.l
  *Superior.Node
  *Siblings.Node
  *Children.Node
EndStructure

Structure Tree
  *Current.Node
EndStructure

Procedure.l NewTree()
  ProcedureReturn AllocateMemory( SizeOf(Tree) )
EndProcedure

Procedure.l IsEmpty(*Tree.Tree)
  ProcedureReturn (Not *Tree\Current)
EndProcedure

Procedure.l IsRoot(*Tree.Tree)
  Protected *Root.Node
  
  *Root = *Tree\Current
  
  If *Root And *Root\Superior
    *Root = #Null
  EndIf
  
  ProcedureReturn *Root
EndProcedure

Procedure.l GetRoot(*Tree.Tree)
  Protected *Root.Node
  
  *Root = *Tree\Current
  
  If *Root
    While *Root\Superior
      *Root = *Root\Superior
    Wend
  EndIf
  
  ProcedureReturn *Root
EndProcedure

Procedure.l AddNode(*Tree.Tree)
  Protected *Node.Node
  
  *Node = AllocateMemory( SizeOf(Node) )
  
  If *Tree\Current
    *Tree\Current\nNodes  + 1
    
    If *Tree\Current\Children
      *Tree\Current = *Tree\Current\Children
      While *Tree\Current\Siblings
        *Tree\Current = *Tree\Current\Siblings
      Wend
      *Tree\Current\Siblings = *Node
      *Tree\Current = *Tree\Current\Superior
    Else
      *Tree\Current\Children = *Node
    EndIf
  EndIf
  
  If *Node
    *Node\Superior  = *Tree\Current
    *Tree\Current = *Node
  EndIf
  
  ProcedureReturn *Node
EndProcedure

Procedure.l InsertNode(*Tree.Tree)
  Protected *Node.Node
  
  *Node = AllocateMemory( SizeOf(Node) )
  
  If *Tree\Current
    *Tree\Current\nNodes  + 1
    
    If *Tree\Current\Children
      *Tree = *Tree\Current\Children
      *Node\Siblings = *Tree\Current
      *Tree\Current = *Tree\Current\Superior
      *Tree\Current\Children = *Node
    Else
      *Tree\Current\Children = *Node
    EndIf
  EndIf
  
  If *Node
    *Node\Superior  = *Tree\Current
    *Tree\Current = *Node
  EndIf
  
  ProcedureReturn *Node
EndProcedure

Procedure.l FreeNode(*Node.Node)
  Protected Free.l = #True, *Temp.Node
  
  If *Node
    Free  & FreeNode(*Node\Children)
    *Temp = *Node
    *Node = *Node\Siblings
    Free  & FreeMemory(*Temp)
    
    While *Node
      Free  & FreeNode(*Node\Children)
      *Temp = *Node
      *Node = *Node\Siblings
      Free  & FreeMemory(*Temp)
    Wend
  EndIf
  
  ProcedureReturn Free
EndProcedure

Procedure.l ClearTree(*Tree.Tree)
  ProcedureReturn FreeNode( GetRoot(*Tree) )
EndProcedure

Procedure.l FreeTree(*Tree.Tree)
  ProcedureReturn FreeNode( GetRoot(*Tree) ) & FreeMemory(*Tree)
EndProcedure

Dr. Dri · Message par **Dr. Dri** » mer. 27/déc./2006 16:32

Petit exemple :

On représente un arbre avec une chaîne de caractère
Chaque noeud est représenté par des accolades {}
Et bien sûr un noeud peut en contenir d'autres

La chaine que j'utilise représente une expression
mathématique (opérations de base sur des entiers)

L'abre généré ressemble à un arbre binaire sauf
que certains opérateurs sont unaires (exemple "-1")

Du coup j'ai ajouté une fonction pour générer la
formule mathématique contenue dans l'arbre et une
autre pour calculer le résultat...

Code : Tout sélectionner

Procedure.l IsTreeString(String.s)
  Protected Valid.l
  
  If Left(String, 1) = "{" And Right(String, 1) = "}"
    If CountString(String, "{") = CountString(String, "}")
      If Not FindString(String, "{}", 1) ;pas d'élément vide
        Valid = #True
      EndIf
    EndIf
  EndIf
  
  ProcedureReturn Valid
EndProcedure

Procedure.l ParseTreeString(*Tree.Tree, String.s)
  Protected c.s, i.l = 1
  
  If IsTreeString(String)
    While i < Len(String)
      c = Mid(String, i, 1)
      
      Select c
        Case "{"
          AddNode(*Tree)
        Case "}"
          *Tree\Current = *Tree\Current\Superior
        Default
          *Tree\Current\Element + c
      EndSelect
      
      i + 1
    Wend
  EndIf
  
  ProcedureReturn *Tree
EndProcedure

Procedure.l GetNodeValue(*Node.Node)
  Protected Value.l
  
  If *Node
    Select Asc(*Node\Element)
      Case '('
        Value = GetNodeValue(*Node\Children)
      Case '+'
        If *Node\Children\Siblings
          Value = GetNodeValue(*Node\Children\Siblings) + GetNodeValue(*Node\Children)
        Else
          Value = GetNodeValue(*Node\Children)
        EndIf
      Case '-'
        If *Node\Children\Siblings
          Value = GetNodeValue(*Node\Children) - GetNodeValue(*Node\Children\Siblings)
        Else
          Value = - GetNodeValue(*Node\Children)
        EndIf
      Case '*'
        Value = GetNodeValue(*Node\Children) * GetNodeValue(*Node\Children\Siblings)
      Case '/'
        Value = GetNodeValue(*Node\Children) / GetNodeValue(*Node\Children\Siblings)
      Default
        Value = Val(*Node\Element)
    EndSelect
  EndIf
  
  ProcedureReturn Value
EndProcedure

Procedure.l GetTreeValue(*Tree.Tree)
  ProcedureReturn GetNodeValue( GetRoot(*Tree) )
EndProcedure

Procedure.s GetNodeString(*Node.Node)
  Protected String.s
  
  If *Node
    If *Node\Element = "("
      String = "(" + GetNodeString(*Node\Children) + ")"
    Else
      If *Node\Children And *Node\Children\Siblings
        String = GetNodeString(*Node\Children)
        String + *Node\Element
        String + GetNodeString(*Node\Children\Siblings)
      Else
        String + *Node\Element
        String + GetNodeString(*Node\Children)
      EndIf
    EndIf
  EndIf
  
  ProcedureReturn String
EndProcedure

Procedure.s GetTreeString(*Tree.Tree)
  ProcedureReturn GetNodeString( GetRoot(*Tree) )
EndProcedure

Define Expression.l, TreeString.s

TreeString = "{+{3}{({*{5}{*{({-{/{*{*{({-{12}}}{6}}{8}}{4}}{/{/{*{/{4}{2}}{6}}{3}}{2}}}}{7}}}}}"

Expression = NewTree()

ParseTreeString(Expression, TreeString)

Debug GetTreeString(Expression)
Debug "3+(5*((-12)*6*8/4-4/2*6/3/2)*7)"

Debug GetTreeValue(Expression)
Debug 3+(5*((-12)*6*8/4-4/2*6/3/2)*7)

Dri

Dr. Dri · Message par **Dr. Dri** » mer. 27/déc./2006 16:41

Pour faire mumuse, je construit mon arbre en lisant la chaîne à l'envers ^^

Code : Tout sélectionner

Procedure.l ParseTreeStringReverse(*Tree.Tree, String.s)
  Protected c.s, i.l = Len(String)
  
  If IsTreeString(String)
    While i > 1
      c = Mid(String, i, 1)
      
      Select c
        Case "}"
          InsertNode(*Tree)
        Case "{"
          *Tree\Current = *Tree\Current\Superior
        Default
          *Tree\Current\Element = c + *Tree\Current\Element
      EndSelect
      
      i - 1
    Wend
  EndIf
  
  ProcedureReturn *Tree
EndProcedure

Dri

Dr. Dri · Message par **Dr. Dri** » mer. 27/déc./2006 16:43

Pour finir une fonction qui affiche un arbre dans un TreeGadget
(après je mettrais le code à jour)

Code : Tout sélectionner

Procedure AddTreeGadgetNode(Gadget.l, *Node.Node, Depth.l)
 
  If *Node
    AddGadgetItem(Gadget, #PB_Default, *Node\Element, #Null, Depth)
    AddTreeGadgetNode(Gadget, *Node\Children, Depth + 1)
    
    *Node = *Node\Siblings
    
    While *Node
      AddGadgetItem(Gadget, #PB_Default, *Node\Element, #Null, Depth)
      AddTreeGadgetNode(Gadget, *Node\Children, Depth + 1)
      *Node = *Node\Siblings
    Wend
  EndIf
 
EndProcedure 

Procedure SetTreeGadgetTree(Gadget.l, *Tree.Tree)
  ClearGadgetItemList(Gadget)
  AddTreeGadgetNode(Gadget, GetRoot(*Tree), 0)
EndProcedure

Dri

Progi1984 · Message par **Progi1984** » mer. 27/déc./2006 16:52

J'en connais un qui s'amuse bien

Dr. Dri · Message par **Dr. Dri** » mer. 27/déc./2006 17:50

bah je suis au boulot
faut bien passer le temps

(donc un chtit PB4 sur ma clé usb et c'est la fête =)

Dri

Flype · Message par **Flype** » jeu. 28/déc./2006 23:39

euh ils embauchent dans ta boite

moi je veux bien.

en tout cas sympa ton algo. çà me rappelle mes cours au cnam et les langages fonctionnels.

Dr. Dri · Message par **Dr. Dri** » ven. 29/déc./2006 0:09

Bah c'est les vacances tous mes responsables sont en vacances

Sinon une question qui n'a pas survécu au changement de forum

Droopy a écrit :as tu prévu une fonction pour enregistrer un arbre dans un fichier ?

et ma réponse

Dr. Dri a écrit :J'ai envie de répondre non... Et j'ai envie de dire que si
l'arbre peut etre représenté par une chaine, on peut
l'enregistrer dans un fichier texte tel quel...
(sinon y'a toujours xml)

Sinon voila une fonction pour créer une telle chaîne ^_^
(elle tient pas compte des caractères '{' et '}')
Code : Tout sélectionner
Procedure.s MakeNodeString(*Node.Node)
  Protected String.s
 
  If *Node
    String = "{" + *Node\Element + MakeNodeString(*Node\Children) + "}"
    
    *Node = *Node\Siblings
   
    While *Node
      String + "{" + *Node\Element + MakeNodeString(*Node\Children) + "}"
      *Node = *Node\Siblings
    Wend
  EndIf
 
  ProcedureReturn String
EndProcedure

Procedure.s MakeTreeString(*Tree.Tree)
  ProcedureReturn MakeNodeString( GetRoot(*Tree) )
EndProcedure
Dri

PS. faut que j'en garde un peu pour demain au boulot

Dri

Dr. Dri · Message par **Dr. Dri** » dim. 31/déc./2006 12:12

Une petite fonction pour convertir un TreeGadget en chaîne
(j'utilise toujours le même format de chaîne...)

Code : Tout sélectionner

Procedure.s GetTreeGadgetString(Gadget.l)
  Protected String.s, Count.l
  Protected Item.l, Level.l, NextLevel.l
  
  Count = CountGadgetItems(Gadget)
  
  If Count
    String = ""
    
    While Item < Count
      NextLevel = GetGadgetItemAttribute(Gadget, Item+1, #PB_Tree_SubLevel)
      
      If Level = 0 And Item > 0
        ;L'arbre a plusieurs racines !
        String = ""
        Break
      EndIf
      
      String + "{" + GetGadgetItemText(Gadget, Item, #PB_Default)
      
      While Level >= NextLevel
        String + "}"
        Level - 1
      Wend
      
      Level = NextLevel
      Item + 1
    Wend
  EndIf
  
  ProcedureReturn String
EndProcedure

Dri

PS. faut pas mettre de '{' ou de '}' dans votre gadget

Dr. Dri · Message par **Dr. Dri** » mar. 06/févr./2007 20:25

J'ai eu envie de tester, alors voila du code pour manipuler des arbres binaires de recherche. Un ABR (BST en anglais) est en gros un arbre trié (ici dans l'ordre croissant)... Voila un début de code pour des BST d'entiers, avec les rudiments (insertion et supression) et avec l'affichage en exemple de l'arbre trié (l'arbre est trié "de gauche à droite")

J'en suis arrivé à me dire que ce serait bien d'avoir en natif des arbres, arbres binaires et arbres binaires de recherche pour n'importe quel type ordonné (en gros entiers, réels et chaines). Ce genre de chose en natif (comme les listes chaînées) seraient super utiles... (z'en pensez quoi ?)

Code : Tout sélectionner

EnableExplicit

;> ----------------------------------------- <
;- Structures d'Arbres Binaires de Recherche
;> ----------------------------------------- <

Structure BSN ;Binary Search Node
  item.l
  *subs.BSN[2]
EndStructure

Structure BST ;Binary Search Tree
  StructureUnion
    *root.BSN
    *node.BSN
  EndStructureUnion
EndStructure

;> ----------------------------------- <
;- Fonctions pour manipuler les noeuds
;> ----------------------------------- <

Procedure.l InsertBSN(*Tree.BST, Item.l)
  Protected Insert.l
  
  If Not *Tree\node
    *Tree\node = AllocateMemory( SizeOf(BSN) )
    *Tree\node\item = Item
    Insert = *Tree
  ElseIf Item > *Tree\node\item
    Insert = InsertBSN(@*Tree\node\subs[1], Item)
  ElseIf Item < *Tree\node\item
    Insert = InsertBSN(@*Tree\node\subs[0], Item)
  EndIf
  
  ProcedureReturn Insert
EndProcedure

Procedure.l RemoveBSN(*Tree.BST, *Item.Long)
  Protected Remove.l
  
  If *Tree\node\subs[0]
    RemoveBSN(@*Tree\node\subs[0], *Item)
  Else
    *Item\l = *Tree\node\item
    
    If *Tree\node\subs[1]
      RemoveBSN(@*Tree\node\subs[1], @*Tree\node\item)
    Else
      FreeMemory(*Tree\node)
      *Tree\node = #Null
    EndIf
    
  EndIf
  
  ProcedureReturn Remove
EndProcedure

Procedure.l DeleteBSN(*Tree.BST, Item.l)
  Protected Delete.l
  
  If Not *Tree\node
    Delete = #False
  ElseIf Item > *Tree\node\item
    Delete = DeleteBSN(@*Tree\node\subs[1], Item)
  ElseIf Item < *Tree\node\item
    Delete = DeleteBSN(@*Tree\node\subs[0], Item)
  Else
    If Not *Tree\node\subs[0] Or Not *Tree\node\subs[1]
      RemoveBSN(*Tree, @*Tree\node\item)
    Else
      RemoveBSN(@*Tree\node\subs[1], @*Tree\node\item)
    EndIf
  EndIf
  
  ProcedureReturn Delete
EndProcedure

Procedure.s StrBSN(*Tree.BST, Open.c, Close.c, Empty.c)
  Protected String.s
  
  String + Chr(Open)
  
  If *Tree\node
    String + Str(*Tree\node\item)
    If *Tree\node\subs[0] Or *Tree\node\subs[1]
      String  + StrBSN(@*Tree\node\subs[0], Open, Close, Empty)
      String  + StrBSN(@*Tree\node\subs[1], Open, Close, Empty)
    EndIf
  Else
    String + Chr(Empty)
  EndIf
  
  String + Chr(Close)
  
  ProcedureReturn String
EndProcedure

Procedure.s StrSortedBSN(*Tree.BST, Separator.c)
  Protected String.s
  
  If *Tree\node
    If *Tree\node\subs[0]
      String  + StrSortedBSN(@*Tree\node\subs[0], Separator)
    EndIf
    
    String + Str(*Tree\node\item) + Chr(Separator)
    
    If *Tree\node\subs[1]
      String  + StrSortedBSN(@*Tree\node\subs[1], Separator)
    EndIf
  EndIf
  
  ProcedureReturn String
EndProcedure

;> ----------------------------------- <
;- Fonctions pour manipuler les arbres
;> ----------------------------------- <

ProcedureDLL.l NewBST()
  ProcedureReturn AllocateMemory( SizeOf(BST) )
EndProcedure

ProcedureDLL.l InsertBST(*Tree.BST, Item.l)
  ProcedureReturn InsertBSN(@*Tree\root, Item)
EndProcedure

ProcedureDLL.l DeleteBST(*Tree.BST, Item.l)
  ProcedureReturn DeleteBSN(@*Tree\root, Item)
EndProcedure

ProcedureDLL.l ClearBST(*Tree.BST)
  Protected Clear.l = #True
  
  While *Tree\root
    Clear | DeleteBSN(@*Tree\root, *Tree\root\item)
  Wend
  
  ProcedureReturn Clear
EndProcedure

ProcedureDLL.l FreeBST(*Tree.BST)
  ClearBST(*Tree)
  ProcedureReturn FreeMemory(*Tree)
EndProcedure

ProcedureDLL.s StrBST(*Tree.BST, Open.c = '{', Close.c = '}', Empty.c = '*')
  ProcedureReturn StrBSN(@*Tree\root, Open, Close, Empty)
EndProcedure

ProcedureDLL.s StrSortedBST(*Tree.BST, Separator.c = ' ')
  ProcedureReturn StrSortedBSN(@*Tree\root, Separator)
EndProcedure

;> ------------ <
;- Petits tests
;> ------------ <

Define Tree = NewBST()

InsertBST(Tree, 6)
InsertBST(Tree, 2)
InsertBST(Tree, 1)
InsertBST(Tree, 4)
InsertBST(Tree, 3)
InsertBST(Tree, 5)
InsertBST(Tree, 8)
InsertBST(Tree, 7)
InsertBST(Tree, 9)
InsertBST(Tree, 11)
InsertBST(Tree, 10)

;à l'issue des insertions on a cet arbre :
;        6
;   2         8
; 1   4     7   9
;    3 5          11
;               10
Debug StrBST(Tree)
Debug StrSortedBST(Tree)

DeleteBST(Tree, 8)

;à l'issue de la supression on a cet arbre :
;        6
;   2         9
; 1   4     7   10
;    3 5          11
Debug StrBST(Tree)
Debug StrSortedBST(Tree)

Dri

flaith · Message par **flaith** » mar. 06/févr./2007 21:35

Bon boulot, effectivement en mode natif ça le ferait bien !

Progi1984 · Message par **Progi1984** » mer. 30/avr./2008 11:49

Ceci ne serait il pas améliorable avec des regex ?