Comment trouver les 10 strings les plus presentes ?
Publié : mar. 11/juil./2006 15:53
Imaginons un a$ contenant 60k de texte. Comment procèderiez vous pour trouver les 10 chaines les plus frequements presentes ??
Forums PureBasic - Français
http://forums.purebasic.com/french/
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
c'est clair, le porte-monnaie aussi elle te le trouve sans problème.nico a écrit :Un jour de solde avec ta copine, elle va vite te les trouver tes strings.
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