Comment trouver les 10 strings les plus presentes ?

[SPH]

Imaginons un a$ contenant 60k de texte. Comment procèderiez vous pour trouver les 10 chaines les plus frequements presentes ??

[Progi1984]

Créer une liste chainée de chaine + un long
Ajouter une chaine si elle n'existe pas dans la liste chainée et incrémenter le long de un
Voir ceux qui ont le long les plus grands !

[nico]

Un jour de solde avec ta copine, elle va vite te les trouver tes strings.

[venom]

[Flype]

je crois que çà t'ira :

Code : Tout sélectionner

;- 
;- Trouve les mots les plus courants dans un texte.
;- flype, juil. 2006, Purebasic 4.0
;- 

Structure ANALYSE
  mot.s
  compteur.l
EndStructure

Global NewList liste.ANALYSE()

Procedure.l EstDedans(mot.s)
  mot = LCase(mot)
  ForEach liste()
    If liste()\mot = mot
      ProcedureReturn #True
    EndIf
  Next
EndProcedure
Procedure.l Combien(mot.s)
  mot = LCase(mot)
  ForEach liste()
    If liste()\mot = mot
      ProcedureReturn liste()\compteur
    EndIf
  Next
EndProcedure
Procedure.l Analyse(texte.s, minimum.l = 4)
  
  Protected mot.s, *txt.Character = @texte
  
  While *txt\c
    
    Select *txt\c
      
      Case ' ', '.', ',', ';', ' ', '(', ')', #TAB, #CR, #LF ; caractère de 'césure', on coupe
        
        mot = LCase(mot)
        
        If EstDedans(mot)
          liste()\compteur + 1
        Else
          If Len(mot) >= minimum And AddElement(liste())
            liste()\compteur = 1
            liste()\mot = mot
          EndIf
        EndIf
        
        mot = ""
        
      Default
        
        mot + Chr(*txt\c) ; caractère normal, on continue
        
    EndSelect
    
    *txt + SizeOf(Character) ; caractère suivant
    
  Wend
  
  ProcedureReturn CountList(liste())
  
EndProcedure

;-

Debug "chargement du fichier..."

texte.s

If ReadFile(0, #PB_Compiler_Home + "Compilers/APIFunctionListing.txt")
  While Not Eof(0)
    texte + ReadString(0)
  Wend
  CloseFile(0)
EndIf

;-

Debug "analyse du texte..."

NbMot.l = Analyse(texte)

;-

Debug "tri descendant..."

SortStructuredList(liste(), 1, OffsetOf(ANALYSE\compteur), #PB_Sort_Long) ; 1 = Descendant

;-

Debug "hWnd : " + Str(Combien("hWnd"))
Debug "DWORD : " + Str(Combien("DWORD"))

Debug "Nombre de mots : " + Str(NbMot)

;-

ForEach liste()
  
  Debug RSet(Str(liste()\compteur),4, "0") + " : [" + liste()\mot + "]"
  
  If ListIndex(liste()) > 10
    Break
  EndIf
  
Next

;-

End

[Flype]

Un jour de solde avec ta copine, elle va vite te les trouver tes strings.

c'est clair, le porte-monnaie aussi elle te le trouve sans problème.

[comtois]

j'avais utilisé un arbre pour compter les mots d'un fichier

http://purebasic.forum-gratuit.com/viewtopic.php?t=391

à l'époque je ne savais pas qu'on pouvait comparer directement les chaines, du coup la procédure CompareMot(Mot1.s,Mot2.s,Casse.l) est obsolète !!

[SPH]

@Flype : ton code fonctionne, je suis impressionné !! Je n'en doutais pas mais tu l'as pondu si vite !

[SPH]

Ce n'est pas totalement commenté mais ca marche :

Code : Tout sélectionner

file$="c:\blabla\texte.txt"
txt$=""
If ReadFile(0, file$) 
  While Not Eof(0) 
    txt$ + ReadString(0) 
  Wend 
  CloseFile(0) 
EndIf 

Resultat$ = LCase(txt$) ; convertion low case

; elimination des accents
resultat$ = ReplaceString(resultat$, "ã¨", "e")
resultat$ = ReplaceString(resultat$, "ã§", "c")
resultat$ = ReplaceString(resultat$, "ã©", "e")
resultat$ = ReplaceString(resultat$, "ãª", "e")
resultat$ = ReplaceString(resultat$, "ã´", "o")
resultat$ = ReplaceString(resultat$, "ã¢", "a")
resultat$ = ReplaceString(resultat$, "ã ", "a")
resultat$ = ReplaceString(resultat$, "ã¹", "u")
;;;;;;;;;;;

resultat$+" zlovoiz "; ici un nom improbable pour terminer le fichier

Dim cmb(1000) ; ceci est notre bank memoire qui contient combien de fois un mot est trouvé
Dim a$(1000) ; ceci est notre bank memoire qui contient le mot trouvé
ici=0 ; le pointeur des 2 bank du dessus


i=0
Repeat
Repeat
i+1
u=Asc(Mid(resultat$,i,1))
Until u>=97 And u<=122
; on ecrit dans a$ le mot
a$=""
While Asc(Mid(resultat$,i,1))>=97 And Asc(Mid(resultat$,i,1))<=122  ; quel paquet !! mais comment simplifier en gardant "WHILE" !?
a$+Chr(Asc(Mid(resultat$,i,1)))
i+1
Wend

If Len(a$)>1 ; on n'examine que les mots de minimum 2 lettres
la=CountString(resultat$, a$)
If la<10 ; on ne repertorie pas les mots qui se reperent moins de 10 fois
Goto stop
EndIf

If ici=0
a$(ici)=a$
cmb(ici)=la
ici+1
Else
ii=0
Repeat
If a$(ii)=a$
Goto stop
EndIf
ii+1
Until ii=ici
a$(ici)=a$
cmb(ici)=la
ici+1
Debug (a$+" : "+Str(la))
EndIf
stop:
EndIf
Until a$="zlovoiz"; lire jusqu'a notre fin de fichier