; Auteur : Comtois
; Date : 28 mars 2004
; PB version : 3.90
; Forum : http://purebasic.hmt-forum.com/viewtopic.php?t = 391

; Librairies extérieures utilisées : Aucune

; Categories : Algorithmes / Arbres

Structure Noeud
   Mot.s         ; Premier élément dans un noeud => un mot
   Compteur.l    ; Deuxième élément dans un noeud => nombre d'apparition du mot
   *Gauche.Noeud ; Mot inférieur
   *Droit.Noeud  ; Mot supérieur
EndStructure

Global *Racine.Noeud
*Racine = #Null ; Initialise le premier noeud

Procedure CompareMot(Mot1.s, Mot2.s, Casse.l)
   ;-1 => Mot1 est inférieur à Mot2
   ; 0 => Mot1 est égal à Mot2
   ; 1 => Mot1 est supérieur à Mot2
   ; Si Casse = 0 => la procedure ne tient pas compte de la casse des mots
   If Casse = 0
      Mot1 = UCase(Mot1)
      Mot2 = UCase(Mot2)
   EndIf
   Index = 1
   While Mid(Mot1, Index , 1) = Mid(Mot2, Index , 1) And Len(Mot1)>= Index
      Index + 1
   Wend
   If Mid(Mot1, Index, 1) = Mid(Mot2, Index , 1)
      Resultat = 0
   ElseIf Mid(Mot1, Index , 1) < Mid(Mot2, Index , 1)
      Resultat = - 1
   Else
      Resultat = 1
   EndIf
   ProcedureReturn Resultat
EndProcedure

Procedure AfficheArbre(*Noeud.Noeud)
   If *Noeud <> #Null
      AfficheArbre(*Noeud\Gauche)
      Debug *Noeud\Mot + " => " + Str(*Noeud\Compteur) + " fois"
      AfficheArbre(*Noeud\Droit)
   EndIf
EndProcedure

Procedure Arbre(*Noeud.Noeud, Mot.s)
   ; le noeud n'existe pas
   If *Noeud = #Null
      ; ajoute un noeud
      *Noeud = AllocateMemory(SizeOf(Noeud))
      ; initialise le noeud
      If *Noeud
         *Noeud\Mot = Mot
         *Noeud\Compteur = 1
         *Noeud\Gauche = #Null
         *Noeud\Droit = #Null
      Else
         MessageRequester("Erreur", "Impossible d'allouer de la mémoire !", 0)
         End
      EndIf
   ; Recherche du mot par récursivité dans l'arbre
   ElseIf CompareMot(Mot, *Noeud\Mot, 1)= 0
      *Noeud\Compteur + 1
   ElseIf CompareMot(Mot, *Noeud\Mot, 1)<0
      *Noeud\Gauche = Arbre(*Noeud\Gauche, Mot)
   Else
     *Noeud\Droit = Arbre(*Noeud\Droit, Mot)
   EndIf
   ProcedureReturn(*Noeud)
EndProcedure

Procedure LectureTexte()
   For a = 1 To 33
      Read Ligne.s
      Index = 1
      Repeat
         Mot.s = StringField(Ligne, Index, " ")
         If Mot<>"" : *Racine = Arbre(*Racine, Mot) : EndIf
         Index + 1
      Until Mot = ""
   Next a
EndProcedure

; exemple d'utilisation d'un arbre binaire => Comptage des mots dans un texte
LectureTexte()
AfficheArbre(*Racine)

; La Mouche du Coche de La Fontaine
DataSection
Data.s "Dans un chemin montant , sablonneux , malaisé ,"
Data.s "Et de tous les côtés au soleil exposé ,"
Data.s "Six forts chevaux tiraient un coche ."
Data.s "Femmes , moine , vieillards , tout était descendu ."
Data.s "L' attelage suait , soufflait , était rendu ."
Data.s "Une mouche survient , et des chevaux s' approche ,"
Data.s "Prétend les animer par son bourdonnement ,"
Data.s "Pique l' un , pique l' autre , et pense à tout moment"
Data.s "Qu' elle fait aller la machine ,"
Data.s "S' assied sur le timon , sur le nez du cocher ."
Data.s "Aussitôt que le char chemine ,"
Data.s "Et qu' elle voit les gens marcher ,"
Data.s "Elle s' en attribue uniquement la gloire ,"
Data.s "Va , vient , fait l' empressée : il semble que ce soit"
Data.s "Un sergent de bataille allant en chaque endroit"
Data.s "Faire avancer ses gens et hâter la victoire ."
Data.s "La mouche , en ce commun besoin ,"
Data.s "Se plaint qu' elle agit seule , et qu' elle a tout le soin ;"
Data.s "Qu' aucun n' aide aux chevaux à se tirer d' affaire ."
Data.s "Le moine disait son bréviaire :"
Data.s "Il prenait bien son temps ! Une femme chantait :"
Data.s "C' était bien de chansons qu' alors il s' agissait !"
Data.s "Dame mouche s' en va chanter à leurs oreilles ,"
Data.s "Et fait cent sottises pareilles ."
Data.s "Après bien du travail , le coche arrive au haut :"
Data.s "« Respirons maintenant , dit la mouche aussitôt :"
Data.s "J' ai tant fait que nos gens sont enfin dans la plaine ."
Data.s "Cà , Messieurs les Chevaux , payez - moi de ma peine . »"
Data.s " "
Data.s "Ainsi certaines gens , faisant les empressés ,"
Data.s "S' introduisent dans les affaires :"
Data.s "Ils font partout les nécessaires ,"
Data.s "Et , partout importuns , devraient être chassés ."
EndDataSection