Compteur de mots dans un fichier ( Arbre binaire )

Partagez votre expérience de PureBasic avec les autres utilisateurs.
comtois
Messages : 5186
Inscription : mer. 21/janv./2004 17:48
Contact :

Compteur de mots dans un fichier ( Arbre binaire )

Message par comtois »

C'est pour donner suite à ce que je racontais dans le post de Denis au sujet de la façon de compter les mots dans un fichier , voici un petit exemple , depuis le temps que je voulais faire un arbre, c'est mon premier , le prochain ne sera pas binaire mais quelconque , enfin si j'y arrive :)

Il faut la version 3.89 pour tester ( AllocateMemory())

Code : Tout sélectionner

;PureBasic 3.89

#Null=0

Structure Noeud
   Mot.s         ; le mot
   Compteur.l    ; compte le nombre d'apparition d'un mot 
   *Gauche.Noeud ; Mot inférieur
   *Droit.Noeud  ; Mot supérieur
EndStructure

Global *Racine.Noeud
*Racine = #Null

Procedure CompareMot(Mot1.s,Mot2.s,Casse.l)
   If Casse = 1
      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)
   If *Noeud = #Null
      *Noeud = AllocateMemory(SizeOf(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      
   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 LectureFichier()
   If ReadFile(0,"lamouche.txt")
      While Eof(0)=0
         Ligne.s = ReadString()
         Index = 1
         Repeat
            Mot.s=StringField(ligne,Index, " ") 
            If Mot<>"" : *Racine=Arbre(*Racine,Mot) : Endif
            Index + 1
         Until Mot =""
      Wend    
      CloseFile(0)
   Else
      MessageRequester("Erreur","Impossible de lire le fichier",0)   
   EndIf   
EndProcedure

;Première série de tests
; *Racine=Arbre(*Racine,"Essai")  
; *Racine=Arbre(*Racine,"Autre")  
; *Racine=Arbre(*Racine,"Fin")
; *Racine=Arbre(*Racine,"Debut")
; *Racine=Arbre(*Racine,"Pourquoi")  
; *Racine=Arbre(*Racine,"Autre")  
; *Racine=Arbre(*Racine,"Encore")
; *Racine=Arbre(*Racine,"Fin")

;Deuxième série de tests , pas encore controlé :)
LectureFichier()
AfficheArbre(*Racine)
fichier à sauvegarder sous le nom "lamouche.txt"
il est possible de faire un test sans le fichier , il suffit de mettre en commentaire la ligne

Code : Tout sélectionner

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

Ainsi certaines gens , faisant les empressés ,
S' introduisent dans les affaires :
Ils font partout les nécessaires ,
Et , partout importuns , devraient être chassés .
Avatar de l’utilisateur
Chris
Messages : 3731
Inscription : sam. 24/janv./2004 14:54
Contact :

Message par Chris »

C'est bien, ça. Ca peut être utile :)

Et puis c'est assez rapide, 563 ms pour afficher les résultats, debug compris.

Chris :)
comtois
Messages : 5186
Inscription : mer. 21/janv./2004 17:48
Contact :

Message par comtois »

la méthode pour récupérer les mots dans un texte pourrait être améliorée , ce qui m'intéressait ici c'était de faire un arbre binaire, c'est la base de nombreuses choses( IA pour les jeux entre autres ). je vais pouvoir poursuivre avec un arbre quelconque :)
Avatar de l’utilisateur
Flype
Messages : 2431
Inscription : jeu. 29/janv./2004 0:26
Localisation : Nantes

Message par Flype »

remis au goût du jour pour purebasic 4.0 ;-)

Code : Tout sélectionner

;- purebasic 4.0

Structure Noeud 
  mot.s 
  compteur.l
  *Gauche.Noeud
  *Droit.Noeud
EndStructure 

Procedure.s Affiche(*Noeud.Noeud, minimum.l) 
  Protected resultat.s
  If *Noeud 
    resultat + Affiche(*Noeud\Gauche, minimum) 
    If *Noeud\compteur >= minimum
      resultat + RSet(Str(*Noeud\compteur), 4, "0") + " : " + *Noeud\mot + #CRLF$
    EndIf
    resultat + Affiche(*Noeud\Droit, minimum) 
  EndIf
  ProcedureReturn resultat
EndProcedure 
Procedure.l Arbre(*Noeud.Noeud, mot.s) 
  If *Noeud
    If mot = *Noeud\mot
      *Noeud\compteur + 1 
    ElseIf mot < *Noeud\mot
      *Noeud\Gauche = Arbre(*Noeud\Gauche, mot) 
    Else 
      *Noeud\Droit = Arbre(*Noeud\Droit, mot) 
    EndIf 
  Else
    *Noeud = AllocateMemory(SizeOf(Noeud)) 
    If *Noeud 
      *Noeud\mot = mot 
      *Noeud\compteur = 1 
    EndIf
  EndIf
  ProcedureReturn *Noeud
EndProcedure 
Procedure.l Analyse(texte.s, minimum.l)
  Protected *arbre, mot.s, nbcar.l, *txt.Character = @texte
  While *txt\c
    Select *txt\c
      Case ' ', '.', ',', ';', ' ', '(', ')', #TAB, #CR, #LF
        If nbcar >= minimum
          *arbre = Arbre(*arbre, mot)
        EndIf
        mot = ""
        nbcar = 0
      Default
        mot + Chr(*txt\c)
        nbcar + 1
    EndSelect
    *txt + SizeOf(Character)
  Wend
  ProcedureReturn *arbre
EndProcedure
Procedure.s Texte(fichier.s)
  Protected texte.s
  If ReadFile(0, fichier)
    texte = Space(Lof(0))
    ReadData(0, @texte, Lof(0))
    CloseFile(0)
  EndIf
  ProcedureReturn texte
EndProcedure

;- affiche les mots de 4 caractères minimum, présents au minimum 20 fois dans le texte.

MessageRequester("Résultat", Affiche(Analyse(Texte(#PB_Compiler_Home+"Compilers/APIFunctionListing.txt"), 4), 20))
Dernière modification par Flype le mar. 11/juil./2006 23:16, modifié 1 fois.
Image
comtois
Messages : 5186
Inscription : mer. 21/janv./2004 17:48
Contact :

Message par comtois »

Tu m'as devancé, mais je n'aurais pas fait aussi bien , intéressant tes ajouts, bravo flype :)
http://purebasic.developpez.com/
Je ne réponds à aucune question technique en PV, utilisez le forum, il est fait pour ça, et la réponse peut profiter à tous.
Avatar de l’utilisateur
Flype
Messages : 2431
Inscription : jeu. 29/janv./2004 0:26
Localisation : Nantes

Message par Flype »

merci comtois

et puis surtout çà speedzzzzzzzzz, grace à tes noeuds.
Moins d'1 seconde pour analyser 230Ko de texte, c'est 5x plus rapide que la routine avec une liste chainée.

ceci dit, comment ferais-tu pour programmer une sorte de SortStructuredTree(), pour remontée les 20 compteurs les plus forts ?

[EDIT]
Resultat dans un MessageRequester() pour se dispenser des Debug/Debugger. Appréciez la vitesse...
Image
comtois
Messages : 5186
Inscription : mer. 21/janv./2004 17:48
Contact :

Message par comtois »

tu me poses une colle , comme ça à froid , je testerais le tri rapide :)

j'avais aussi fait un tas dans l'algo du pathfinding, un tas c'est un arbre binaire organisé pour retrouver la plus grande valeur, ou la plus petite (mon cas dans le pathfinding).

C'est tout ce qui me vient à l'esprit pour l'instant.

exemple avec un tas
http://purebasic.hmt-forum.com/viewtopi ... 1&start=30
http://purebasic.developpez.com/
Je ne réponds à aucune question technique en PV, utilisez le forum, il est fait pour ça, et la réponse peut profiter à tous.
Avatar de l’utilisateur
Flype
Messages : 2431
Inscription : jeu. 29/janv./2004 0:26
Localisation : Nantes

Message par Flype »

Pour le tri, le plus simple (largement), c'est de recopier l'arbre dans une liste, puis d'utiliser la fonction sacrément rapide de Fred (SortStructuredList).

cf. #example = 3

Code : Tout sélectionner

;------------------------------------------------------
;- HiSpeed WordCounter for Purebasic 4.0
;- 
;- Written by comtois (2004), enhanced by flype (2006)
;------------------------------------------------------

EnableExplicit

Macro EnableGadgetRedraw(gadget, bool)
  SendMessage_(GadgetID(gadget), #WM_SETREDRAW, bool, #Null)
EndMacro

Structure NODE
  s.s     ; word
  n.l     ; counter
  *l.NODE ; left node
  *r.NODE ; right node
EndStructure

Procedure.l Node(*node.NODE, word.s)
  If *node
    If word = *node\s
      *node\n + 1
    ElseIf word < *node\s
      *node\l = Node(*node\l, word)
    Else
      *node\r = Node(*node\r, word)
    EndIf
  Else
    *node = AllocateMemory(SizeOf(NODE))
    If *node
      *node\s = word
      *node\n = 1
    EndIf
  EndIf
  ProcedureReturn *node
EndProcedure

Procedure.s FileToString(fichier.s)
  Protected texte.s
  If ReadFile(0, fichier)
    texte = Space(Lof(0))
    ReadData(0, @texte, Lof(0))
    CloseFile(0)
  EndIf
  ProcedureReturn texte
EndProcedure

Procedure.l Process(string.s, minimum.l)
  Protected *node, word.s, length.l, *str.Byte = @string
  While *str\b
    Select *str\b
      Case ' ', '.', ',', ';', ' ', '(', ')', '[', ']', '"', ':', '=', '^', 39, #TAB, #CR, #LF
        If length >= minimum
          *node = Node(*node, word)
        EndIf
        word = ""
        length = 0
      Default
        word + Chr(*str\b)
        length + 1
    EndSelect
    *str + 1
  Wend
  ProcedureReturn *node
EndProcedure

Procedure.s NodesToString(*node.NODE, minimum.l)
  Protected result.s
  If *node
    result + NodesToString(*node\l, minimum)
    If *node\n >= minimum
      result + RSet(Str(*node\n), 3, "0") + " : " + *node\s + #CRLF$
    EndIf
    result + NodesToString(*node\r, minimum)
  EndIf
  ProcedureReturn result
EndProcedure

Procedure.s NodesToList(*node.NODE, list.NODE())
  If *node
    NodesToList(*node\l, list())
    If AddElement(list())
      list()\s = *node\s
      list()\n = *node\n
    EndIf
    NodesToList(*node\r, list())
  EndIf
EndProcedure

Procedure.s NodesToListIcon(*node.NODE, minimum.l)
  If *node
    NodesToListIcon(*node\l, minimum)
    If *node\n >= minimum
      AddGadgetItem(0, -1, *node\s + #LF$ + Str(*node\n))
    EndIf
    NodesToListIcon(*node\r, minimum)
  EndIf
EndProcedure

;------------------------------------------------------
;- TEST
;------------------------------------------------------

#EXAMPLE = 3

Define.l WordLength   = 1
Define.l WordCount    = 1
Define.s WordFileName = #PB_Compiler_Home + "Compilers/PBFunctionListing.txt"
Define.s WordFileName = #PB_Compiler_Home + "Compilers/APIFunctionListing.txt"

Select #EXAMPLE
  
  Case 1 ; Nodes To String
    
    If OpenWindow(0, 0, 0, 340, 480, "WordCounter", #PB_Window_SystemMenu|#PB_Window_Invisible|#PB_Window_ScreenCentered) And CreateGadgetList(WindowID(0))
      EditorGadget(0, 5, 5, WindowWidth(0)-10, WindowHeight(0)-10)
      EnableGadgetRedraw(0, #False)
      SetGadgetText(0, NodesToString(Process(FileToString(WordFileName), WordLength), WordCount))
      EnableGadgetRedraw(0, #True)
      HideWindow(0, #False)
      Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
    EndIf
    
  Case 2 ; Nodes To ListIconGadget
    
    If OpenWindow(0, 0, 0, 340, 480, "WordCounter", #PB_Window_SystemMenu|#PB_Window_Invisible|#PB_Window_ScreenCentered) And CreateGadgetList(WindowID(0))
      ListIconGadget(0, 5, 5, WindowWidth(0)-10, WindowHeight(0)-10, "Word", 250, #PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect)
      AddGadgetColumn(0, 1, "Count", WindowWidth(0)-290)
      EnableGadgetRedraw(0, #False)
      NodesToListIcon(Process(FileToString(WordFileName), WordLength), WordCount)
      EnableGadgetRedraw(0, #True)
      HideWindow(0, #False)
      Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
    EndIf
    
  Case 3 ; Nodes To List To ListIconGadget
    
    If OpenWindow(0, 0, 0, 340, 480, "WordCounter", #PB_Window_SystemMenu|#PB_Window_Invisible|#PB_Window_ScreenCentered) And CreateGadgetList(WindowID(0))
      ListIconGadget(0, 5, 5, WindowWidth(0)-10, WindowHeight(0)-10, "Word", 250, #PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect)
      AddGadgetColumn(0, 1, "Count", WindowWidth(0)-290)
      EnableGadgetRedraw(0, #False)
      NewList SortedList.NODE()
      NodesToList(Process(FileToString(WordFileName), WordLength), SortedList())
      SortStructuredList(SortedList(), 1, OffsetOf(NODE\n), #PB_Sort_Long)
      ForEach SortedList()
        AddGadgetItem(0, -1, SortedList()\s + #LF$ + Str(SortedList()\n))
      Next
      EnableGadgetRedraw(0, #True)
      HideWindow(0, #False)
      Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
    EndIf
    
EndSelect

;------------------------------------------------------
Image
hzj74
Messages : 16
Inscription : lun. 17/avr./2006 18:30

Message par hzj74 »

Flype a écrit :remis au goût du jour pour purebasic 4.0 ;-)

Code : Tout sélectionner

  Protected *arbre, mot.s, nbcar.l, *txt.Character = @texte
Bonjour,

Je ne comprends pas où se trouve la définition de la structure (?) ".Character" dans le code

Merci
RegisLG
Messages : 154
Inscription : mer. 22/juin/2005 2:32

Message par RegisLG »

hzj74 a écrit :Je ne comprends pas où se trouve la définition de la structure (?) ".Character" dans le code

Merci
C'est une structure prédéfinie pour le type de base .c, tu peux voir sa déclaration à partir de l'IDE : outils\visualisateur de structures.
Je remercie Dr. Dri de m'avoir expliqué cela ;) (voir ce post) j'ai retenu ma leçon :)
hzj74
Messages : 16
Inscription : lun. 17/avr./2006 18:30

Message par hzj74 »

RegisLG a écrit :C'est une structure prédéfinie pour le type de base .c, tu peux voir sa déclaration à partir de l'IDE : outils\visualisateur de structures.
Je remercie Dr. Dri de m'avoir expliqué cela ;) (voir ce post) j'ai retenu ma leçon :)
Merci à ton tour pour ton explication et sa rapidité. :D
hzj74
Messages : 16
Inscription : lun. 17/avr./2006 18:30

Message par hzj74 »

Flype a écrit :remis au goût du jour pour purebasic 4.0 ;-)
Bonjour, Il semble qu'il y ait un petit bug car le dernier mot du fichier n'est pas pris en compte. Est-ce que cela se reproduit chez vous ? merci

PS : j'ai trouvé. Le test de traitement du noeud de l'arbre considère que la fin d'une ligne se termine par #LF. Ce qui n'est pas forcément vrai. je cherche comment améliorer ce critère.
Flype a écrit :remis au goût du jour pour purebasic 4.0 ;-)

Code : Tout sélectionner

    *txt + SizeOf(Character)
je ne comprends pas bien cette instruction "*txt + SizeOf(Character)" ? Visiblement, son rôle est de traiter le caractère suivant de *txt donc pourquoi ne pas avoir écrit directement : *txt + 1 ?? Où est la subtilité que je ne comprends pas ?? est-ce pour éviter de traiter un octet de plus quand character est nul ? :D
comtois
Messages : 5186
Inscription : mer. 21/janv./2004 17:48
Contact :

Message par comtois »

hzj74 a écrit :je ne comprends pas bien cette instruction "*txt + SizeOf(Character)" ?
Parce que la taille d'un caractère est différente selon que tu travailles en unicode ou non. SizeOf(Character) permet de connaitre la taille d'un caractère quelque soit le mode choisi.
Tu peux faire l'essai en validant le mode unicode dans les options du compilo.
http://purebasic.developpez.com/
Je ne réponds à aucune question technique en PV, utilisez le forum, il est fait pour ça, et la réponse peut profiter à tous.
hzj74
Messages : 16
Inscription : lun. 17/avr./2006 18:30

Message par hzj74 »

comtois a écrit : Parce que la taille d'un caractère est différente selon que tu travailles en unicode ou non.
Bingo ! Merci Comtois !
Répondre