Comment trouver des mot similaires parmi une liste

Vous débutez et vous avez besoin d'aide ? N'hésitez pas à poser vos questions
Avatar de l’utilisateur
falsam
Messages : 7324
Inscription : dim. 22/août/2010 15:24
Localisation : IDF (Yvelines)
Contact :

Re: Comment trouver des mot similaires parmi une liste

Message par falsam »

dayvid a écrit :ba cher pas moi comme sa ta tous !
Quand on est au pied du mur ...... on est au pied du mur.

je vais renoncer à comprendre :)
Configuration : Windows 11 Famille 64-bit - PB 6.20 x64 - AMD Ryzen 7 - 16 GO RAM
Vidéo NVIDIA GeForce GTX 1650 Ti - Résolution 1920x1080 - Mise à l'échelle 125%
dayvid
Messages : 1242
Inscription : mer. 11/nov./2009 18:17
Localisation : Poitiers (Vienne)

Re: Comment trouver des mot similaires parmi une liste

Message par dayvid »

Pardon ? tu veut dire quoi :oops:
La vie, C'est comme, Une boitte, De startis, On en voie, De toutes, Les couleurs !

Mon forum http://purebasic.forumphp3.com/index.php
Avatar de l’utilisateur
Flype
Messages : 2431
Inscription : jeu. 29/janv./2004 0:26
Localisation : Nantes

Re: Comment trouver des mot similaires parmi une liste

Message par Flype »

Salut à tous,

Pour revenir à la question, il est possible d'effectuer
une correction orthographique 'relativement' facilement
en s'inspirant de l'algorithme de Levenshtein.

D'ailleurs, il y a plusieurs exemples sur ce forum (en cherchant un peu).

Voici une application de l'algorithme de Levenshtein associé à un dictionnaire :
(après avoir télécharger un dictionnaire ici par exemple http://www.pps.jussieu.fr/~dicosmo/IUP/ ... ccents-iso)

Code : Tout sélectionner

EnableExplicit

;===============================================
;== Algorithme de Levenshtein
;===============================================

Macro COMPUTE(a, b, c)
  ( 1.0 - Distance(a, b, c) / Max(Len(a), Len(b)) )
EndMacro

Procedure Min(a, b, c)
  Protected m = a
  If b < m
    m = b
  EndIf
  If c < m
    m = c
  EndIf
  ProcedureReturn m
EndProcedure

Procedure Max(a, b)
  If a > b
    ProcedureReturn a
  EndIf
  ProcedureReturn b
EndProcedure
Procedure Distance(a.s, b.s, caseSensitive)
  
  Protected i, j, m, n
  
  If caseSensitive = #False
    a = LCase(a)
    b = LCase(b)
  EndIf
  
  m = Len(a)
  n = Len(b)
  
  Protected Dim d(m, n)
  
  For i = 0 To m
    d(i, 0) = i
  Next
  
  For i = 0 To n
    d(0, i) = i
  Next
  
  For i = 1 To m
    For j = 1 To n
      If Mid(a, i - 1, 1) = Mid(b, j - 1, 1)
        d(i, j) = Min(d(i - 1, j) + 1, d(i, j - 1) + 1, d(i - 1, j - 1))
      Else
        d(i, j) = Min(d(i - 1, j) + 1, d(i, j - 1) + 1, d(i - 1, j - 1) + 1)
      EndIf
    Next
  Next
  
  ProcedureReturn d(m, n)
  
EndProcedure

;===============================================
;== Chargement du dictionnaire
;===============================================

Global NewList dict.s()

If ReadFile(0, "dico.txt") ; <---------------- à modifier
  While Not Eof(0)
    If AddElement(dict())
      dict() = ReadString(0)
    EndIf
  Wend
  CloseFile(0)
EndIf

;===============================================
;== Interface graphique
;===============================================

Enumeration
  #gMOT
  #gPRECISION
  #gRECHERCHE
  #gLISTE
EndEnumeration

Procedure ButtonGadget_OnClick()
  
  Structure RESULTAT
    mot.s
    score.d
  EndStructure
  
  Protected NewList r.RESULTAT()
  Protected mot.s = GetGadgetText(#gMOT)
  Protected precision.d = GetGadgetState(#gPRECISION) / 100.0
  Protected milliseconds = ElapsedMilliseconds()
  
  ForEach dict()
    Protected score.d = COMPUTE(mot, dict(), #False)
    If score >= precision
      If AddElement(r())
        r()\mot = dict()
        r()\score = score
      EndIf
    EndIf
  Next
  
  SortStructuredList(r(), #PB_Sort_Descending, OffsetOf(RESULTAT\score), #PB_Sort_Double)
  SetGadgetItemText(#gLISTE, -1, Str(ListSize(r())) + " résultat(s) en " + Str(ElapsedMilliseconds() - milliseconds) + "ms")
  ClearGadgetItems(#gLISTE)
  
  ForEach r()
    AddGadgetItem(#gLISTE, -1, r()\mot + #LF$ + Str(r()\score * 100))
  Next
  
EndProcedure

Procedure ListIconGadget_OnDblClick()
  
  If EventType() = #PB_EventType_LeftDoubleClick
    SetGadgetText(#gMOT, GetGadgetItemText(#gLISTE, GetGadgetState(#gLISTE), 0))
  EndIf
  
EndProcedure

If OpenWindow(0, 0, 0, 300, 200, "Dictionnaire Levenshtein (" + Str(ListSize(dict())) + " mots)", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  
  StringGadget(#gMOT, 5, 5, 180, 21, "ortografe")
  SpinGadget(#gPRECISION, 190, 5, 35, 21, 1, 100, #PB_Spin_Numeric)
  ButtonGadget(#gRECHERCHE, 230, 5, 65, 21, "Rechercher")
  ListIconGadget(#gLISTE, 5, 30, 290, 165, "Mot", 220, #PB_ListIcon_GridLines)
  AddGadgetColumn(#gLISTE, 1, "Score", 40)
  SetGadgetState(#gPRECISION, 65)
  
  Repeat
    Select WaitWindowEvent()
      Case #PB_Event_Gadget
        Select EventGadget()
          Case #gRECHERCHE
            ButtonGadget_OnClick()
          Case #gLISTE
            ListIconGadget_OnDblClick()
        EndSelect
      Case #PB_Event_CloseWindow
        Break
    EndSelect
  ForEver
  
EndIf
Image
dayvid
Messages : 1242
Inscription : mer. 11/nov./2009 18:17
Localisation : Poitiers (Vienne)

Re: Comment trouver des mot similaires parmi une liste

Message par dayvid »

Salut Flype :)

Ce code est de toi ?

Non parce que chapeau hein ! :D

C'est très bien fait, félicitation :P

Dommage que la recherche soit si longue :(

et le système de précision est vraiment excellent :D

Merci beaucoup pour ce superbe code :D :D :D
La vie, C'est comme, Une boitte, De startis, On en voie, De toutes, Les couleurs !

Mon forum http://purebasic.forumphp3.com/index.php
Avatar de l’utilisateur
Flype
Messages : 2431
Inscription : jeu. 29/janv./2004 0:26
Localisation : Nantes

Re: Comment trouver des mot similaires parmi une liste

Message par Flype »

A part l'algo de Levenshtein (qui est certainement au minimum mille fois plus intelligent que moi),
sinon oui tout est de moi - mais bon c'est ultra-basic - écrit rapidos pour te montrer.

Je suis sûr qu'avec un arbre et non une liste pour parcourir le dictionnaire, la recherche pourrait être beaucoup plus rapide.

Et même l'algorithme de Levenshtein pourrait être plus rapide réécrit autrement (*pointeur, assembleur, ...)

Pour info, il y a une variante de cet algo (Damerau-Levenshtein) qui est censé être plus efficace pour les fautes de frappe - mais plus lent. A toi de juger, moi, je ne vois pas trop la différence.

http://fr.wikipedia.org/wiki/Distance_d ... evenshtein

Code : Tout sélectionner

EnableExplicit

;===============================================
;== Algorithme de Levenshtein
;===============================================

Macro COMPUTE(a, b)
  ( 1.0 - DistanceLevenshteinDamerau(a, b) / Max2(Len(a), Len(b)) )
EndMacro

Procedure Max2(a, b)
  If a > b
    ProcedureReturn a
  EndIf
  ProcedureReturn b
EndProcedure

Procedure Min2(a, b)
  If a < b
    ProcedureReturn a
  EndIf
  ProcedureReturn b
EndProcedure

Procedure Min3(a, b, c)
  Protected m = a
  If b < m
    m = b
  EndIf
  If c < m
    m = c
  EndIf
  ProcedureReturn m
EndProcedure

Procedure DistanceLevenshtein(a.s, b.s)
  
  ; Distance de Levenshtein
  ; http://fr.wikipedia.org/wiki/Distance_de_Levenshtein
  
  Protected i, j, m, n, cost
  
  m = Len(a)
  n = Len(b)
  
  Protected Dim d(m, n)
  
  For i = 0 To m
    d(i, 0) = i
  Next
  
  For i = 0 To n
    d(0, i) = i
  Next
  
  For i = 1 To m
    For j = 1 To n
      If Mid(a, i - 1, 1) = Mid(b, j - 1, 1)
        cost = 0
      Else
        cost = 1
      EndIf
      d(i, j) = Min3(d(i - 1, j) + 1, d(i, j - 1) + 1, d(i - 1, j - 1) + cost)
    Next
  Next
  
  ProcedureReturn d(m, n)
  
EndProcedure

Procedure DistanceLevenshteinDamerau(a.s, b.s)
  
  ; Distance de Levenshtein-Damerau
  ; http://fr.wikipedia.org/wiki/Distance_de_Damerau-Levenshtein
  
  Protected i, j, m, n, cost
  
  m = Len(a)
  n = Len(b)
  
  Protected Dim d(m, n)
  
  For i = 0 To m
    d(i, 0) = i
  Next
  
  For i = 0 To n
    d(0, i) = i
  Next
  
  For i = 1 To m
    For j = 1 To n
      If Mid(a, i - 1, 1) = Mid(b, j - 1, 1)
        cost = 0
      Else
        cost = 1
      EndIf
      d(i, j) = Min3(d(i - 1, j) + 1, d(i, j - 1) + 1, d(i - 1, j - 1) + cost)
      If i > 1 And j > 1 And Mid(a, i - 1, 1) = Mid(b, j - 2, 1) And Mid(a, i - 2, 1) = Mid(b, j - 1, 1)
        d(i, j) = Min2(d(i, j), d(i - 2, j - 2) + cost)
      EndIf
    Next
  Next
  
  ProcedureReturn d(m, n)
  
EndProcedure

;===============================================
;== Chargement du dictionnaire
;===============================================

Global NewList dict.s()

If ReadFile(0, "dico.txt")
  While Not Eof(0)
    If AddElement(dict())
      dict() = ReadString(0)
    EndIf
  Wend
  CloseFile(0)
EndIf

;===============================================
;== Interface graphique
;===============================================

Enumeration
  #gMOT
  #gPRECISION
  #gRECHERCHE
  #gLISTE
EndEnumeration

Procedure ButtonGadget_OnClick()
  
  Structure RESULTAT
    mot.s
    score.d
  EndStructure
  
  Protected NewList r.RESULTAT()
  Protected mot.s = GetGadgetText(#gMOT)
  Protected precision.d = GetGadgetState(#gPRECISION) / 100.0
  Protected milliseconds = ElapsedMilliseconds()
  
  ForEach dict()
    Protected score.d = COMPUTE(mot, dict())
    If score >= precision
      If AddElement(r())
        r()\mot = dict()
        r()\score = score
      EndIf
    EndIf
  Next
  
  SortStructuredList(r(), #PB_Sort_Descending, OffsetOf(RESULTAT\score), #PB_Sort_Double)
  SetGadgetItemText(#gLISTE, -1, Str(ListSize(r())) + " résultat(s) en " + Str(ElapsedMilliseconds() - milliseconds) + "ms")
  ClearGadgetItems(#gLISTE)
  
  ForEach r()
    AddGadgetItem(#gLISTE, -1, r()\mot + #LF$ + Str(r()\score * 100))
  Next
  
EndProcedure
Procedure ListIconGadget_OnDblClick()
  
  If EventType() = #PB_EventType_LeftDoubleClick
    SetGadgetText(#gMOT, GetGadgetItemText(#gLISTE, GetGadgetState(#gLISTE), 0))
  EndIf
  
EndProcedure

If OpenWindow(0, 0, 0, 300, 200, "Dictionnaire Levenshtein (" + Str(ListSize(dict())) + " mots)", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  
  StringGadget(#gMOT, 5, 5, 180, 21, "ortografe")
  SpinGadget(#gPRECISION, 190, 5, 35, 21, 1, 100, #PB_Spin_Numeric)
  ButtonGadget(#gRECHERCHE, 230, 5, 65, 21, "Rechercher")
  ListIconGadget(#gLISTE, 5, 30, 290, 165, "Résultat", 220, #PB_ListIcon_GridLines)
  AddGadgetColumn(#gLISTE, 1, "Score", 40)
  SetGadgetState(#gPRECISION, 65)
  
  Repeat
    Select WaitWindowEvent()
      Case #PB_Event_Gadget
        Select EventGadget()
          Case #gRECHERCHE
            ButtonGadget_OnClick()
          Case #gLISTE
            ListIconGadget_OnDblClick()
        EndSelect
      Case #PB_Event_CloseWindow
        Break
    EndSelect
  ForEver
  
EndIf
Image
Avatar de l’utilisateur
Jacobus
Messages : 1559
Inscription : mar. 06/avr./2004 10:35
Contact :

Re: Comment trouver des mot similaires parmi une liste

Message par Jacobus »

Hello Flype.

Pour accélérer la manoeuvre il faut diviser le fichier en 26. 1 par lettre.
Lancer la recherche uniquement dans le fichier concerné dès lors que l'on connaît l'initiale.

Excellent code, merci!
Quand tous les glands seront tombés, les feuilles dispersées, la vigueur retombée... Dans la morne solitude, ancré au coeur de ses racines, c'est de sa force maturité qu'il renaîtra en pleine magnificence...Jacobus.
dayvid
Messages : 1242
Inscription : mer. 11/nov./2009 18:17
Localisation : Poitiers (Vienne)

Re: Comment trouver des mot similaires parmi une liste

Message par dayvid »

Oui Jacobus, j'ai fait la même chose pour mon vérificateur d'orthographe je ne sais pas si t'as vue
j'ai tous découper en fichier lettre (a b c d e etc.)
et sa va carrément plus vite ya pas de doute :)
A part l'algo de Levenshtein (qui est certainement au minimum mille fois plus intelligent que moi),
sinon oui tout est de moi - mais bon c'est ultra-basic - écrit rapidos pour te montrer.
Ha Ha Ha !, T'es sur :lol: MDR !!!

Encore merci pour les codes :D
La vie, C'est comme, Une boitte, De startis, On en voie, De toutes, Les couleurs !

Mon forum http://purebasic.forumphp3.com/index.php
Avatar de l’utilisateur
Flype
Messages : 2431
Inscription : jeu. 29/janv./2004 0:26
Localisation : Nantes

Re: Comment trouver des mot similaires parmi une liste

Message par Flype »

Salut Jacobus,

Je suis d'accord, çà accélèrera la recherche, mais çà limitera l'intérêt.

En effet, si le but est de détecter une erreur de frappe, ce sera moins efficace.

Par exemple, si tu écris 'rothographe' au lieu de 'orthographe',
en limitant la recherche sur l'initiale comme tu proposes,
alors, la correction passera à l'as, et ce serait bien dommage.
Image
dayvid
Messages : 1242
Inscription : mer. 11/nov./2009 18:17
Localisation : Poitiers (Vienne)

Re: Comment trouver des mot similaires parmi une liste

Message par dayvid »

D'ailleurs elle est très lente la recherche mais efficace
bien plus que le code précédent que j'avais
mais c'est un membre qui me la fait ce code
et déjà c'était pas mal du tout :)
La vie, C'est comme, Une boitte, De startis, On en voie, De toutes, Les couleurs !

Mon forum http://purebasic.forumphp3.com/index.php
Avatar de l’utilisateur
Jacobus
Messages : 1559
Inscription : mar. 06/avr./2004 10:35
Contact :

Re: Comment trouver des mot similaires parmi une liste

Message par Jacobus »

Flype a écrit : si le but est de détecter une erreur de frappe, ce sera moins efficace.
Par exemple, si tu écris 'rothographe' au lieu de 'orthographe',
en limitant la recherche sur l'initiale comme tu proposes,
alors, la correction passera à l'as, et ce serait bien dommage.
Je suis tout à fait de ton avis, d'ailleurs 3 secondes pour proposer 3 résultats sur plus de 62000 possibilités, je trouve cela très acceptable comme célérité.
Quand tous les glands seront tombés, les feuilles dispersées, la vigueur retombée... Dans la morne solitude, ancré au coeur de ses racines, c'est de sa force maturité qu'il renaîtra en pleine magnificence...Jacobus.
dayvid
Messages : 1242
Inscription : mer. 11/nov./2009 18:17
Localisation : Poitiers (Vienne)

Re: Comment trouver des mot similaires parmi une liste

Message par dayvid »

Moi il en as plus de 576 000 :lol:
La vie, C'est comme, Une boitte, De startis, On en voie, De toutes, Les couleurs !

Mon forum http://purebasic.forumphp3.com/index.php
Avatar de l’utilisateur
Flype
Messages : 2431
Inscription : jeu. 29/janv./2004 0:26
Localisation : Nantes

Re: Comment trouver des mot similaires parmi une liste

Message par Flype »

576 000 mots 8O

Ton dictionnaire inclut-il de la grammaire ? (ex: montrer, montrera, montrerai, montrèrent, ...)
Si ce n'est pas le cas, je trouve çà vraiment énorme, trop même (?)

--------------------------------

Du coup, j'ai cherché le meilleur dictionnaire possible sur Google. Vraiment pas évident :?

Toutefois, je suis tombé sur une référence incontournable :
Le dictionnaire 'Hunspell' utilisé par Mozilla/Firefox, OpenOffice, Opera, entre autres :

http://www.dicollecte.org/home.php?prj=fr
http://www.dicollecte.org/download.php?prj=fr
http://www.dicollecte.org/download/fr/h ... e-v3.8.zip

Celui-ci contient 63062 mots et il est mis à jour régulièrement en plus.

A noter que ce projet 'Hunspell' semble très intéressant pour qui veut faire de la 'vraie' correction orthographique.

--------------------------------

A part çà, j'ai optimisé un peu le programme et
modifié le chargement du dictionnaire pour pouvoir lire le fichier 'fr-moderne.dic' (hunspell-fr-moderne-v3.8.zip).

Sur mon PC, l'analyse s'effectue en moyenne en 250ms (1/4 sec !)

- Avec le Debugger désactivé (avec le debugger c'est effectivement très lent - sans c'est très correct)
- Avec l'option du compilateur : Activer le support Unicode (Obligatoire car 'fr-moderne.dic' est encodé en Unicode)

--------------------------------

Code : Tout sélectionner

;===============================================
;== Algorithme de Levenshtein
;===============================================

Structure CHARS
  c.c[0]
EndStructure

Procedure Max(a, b)
  If a > b
    ProcedureReturn a
  EndIf
  ProcedureReturn b
EndProcedure

Procedure Min(a, b)
  If a < b
    ProcedureReturn a
  EndIf
  ProcedureReturn b
EndProcedure

Procedure Min3(a, b, c)
  If b < a
    a = b
  EndIf
  If c < a
    ProcedureReturn c
  EndIf
  ProcedureReturn a
EndProcedure

Procedure DistanceLevenshtein(*a.CHARS, *b.CHARS, m, n)
  
  Protected Dim d(m, n)
  Protected i, j, cost
  
  For i = 0 To m
    d(i, 0) = i
  Next
  
  For j = 0 To n
    d(0, j) = j
  Next
  
  For i = 1 To m
    For j = 1 To n
      If *a\c[i-1] = *b\c[j-1]
        cost = 0
      Else
        cost = 1
      EndIf
      d(i, j) = Min3(d(i-1, j) + 1, d(i, j-1) + 1, d(i-1, j-1) + cost)
      If i > 1 And j > 1 And *a\c[i-1] = *b\c[j-2] And *a\c[i-2] = *b\c[j-1]
        d(i, j) = Min(d(i, j), d(i-2, j-2) + cost)
      EndIf
    Next
  Next
  
  ProcedureReturn d(m, n)
  
EndProcedure

;======================================================================
;== Chargement du dictionnaire
;== http://www.dicollecte.org/download.php?prj=fr
;== http://www.dicollecte.org/download/fr/hunspell-fr-moderne-v3.8.zip
;======================================================================

Global NewList dict.s()

If ReadFile(0, "fr-moderne.dic")
  ReadString(0)
  While Not Eof(0)
    If AddElement(dict())
      dict() = LCase(StringField(ReadString(0), 1, "/"))
    EndIf
  Wend
  CloseFile(0)
Else
  MessageRequester("Erreur", "Vous devez posséder un dictionnaire !")
  End
EndIf

;===============================================
;== Interface graphique
;===============================================

Enumeration
  #gSAISIE
  #gSCORE
  #gRECHERCHE
  #gLISTE
EndEnumeration

Procedure ButtonGadget_OnClick()
  
  ;------------------------------
  ; Initialisation
  ;------------------------------
  
  Structure RESULTAT
    mot.s
    score.d
    distance.i
  EndStructure
  
  Protected NewList r.RESULTAT()
  Protected a.s, b.s, s.d, sc.d, d, m, n, ms
  
  a  = LCase(GetGadgetText(#gSAISIE))
  sc = GetGadgetState(#gSCORE)
  ms = ElapsedMilliseconds()
  
  ;------------------------------
  ; Analyse du dictionnaire
  ;------------------------------
  
  ForEach dict()
    b = dict()
    m = Len(a)
    n = Len(b)
    d = DistanceLevenshtein(@a, @b, m, n)
    s = ( 100.0 * ( 1.0 - ( d / Max(m, n) ) ) )
    If s >= sc
      If AddElement(r())
        r()\mot = b
        r()\score = s
        r()\distance = d
      EndIf
    EndIf
  Next
  
  ;------------------------------
  ; Tri du résultat
  ;------------------------------
  
  SortStructuredList(r(), #PB_Sort_Descending, OffsetOf(RESULTAT\score), #PB_Sort_Double)
  
  ;------------------------------
  ; Actualisation du ListView
  ;------------------------------
  
  HideGadget(#gLISTE, #True)
  ClearGadgetItems(#gLISTE)
  SetGadgetItemText(#gLISTE, -1, Str(ListSize(r())) + " résultat(s) en " + Str(ElapsedMilliseconds() - ms) + "ms")
  
  ForEach r()
    AddGadgetItem(#gLISTE, -1, r()\mot + #LF$ + Str(r()\distance) + #LF$ + StrD(r()\score, 0) + "%")
  Next
  
  HideGadget(#gLISTE, #False)
  
EndProcedure

Procedure ListIconGadget_OnDblClick()
  
  If EventType() = #PB_EventType_LeftDoubleClick
    SetGadgetText(#gSAISIE, GetGadgetItemText(#gLISTE, GetGadgetState(#gLISTE), 0))
  EndIf
  
EndProcedure

If OpenWindow(0, 0, 0, 280, 200, "Dictionnaire Levenshtein (" + Str(ListSize(dict())) + " mots)", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  
  StringGadget(#gSAISIE, 5, 5, 160, 21, "rothographe")
  SpinGadget(#gSCORE, 170, 5, 35, 21, 1, 100, #PB_Spin_Numeric)
  ButtonGadget(#gRECHERCHE, 210, 5, 65, 21, "Rechercher")
  ListIconGadget(#gLISTE, 5, 30, 270, 165, "Résultat", 155, #PB_ListIcon_FullRowSelect | #PB_ListIcon_GridLines)
  AddGadgetColumn(#gLISTE, 1, "Distance", 55)
  AddGadgetColumn(#gLISTE, 2, "Score", 40)
  SetGadgetState(#gSCORE, 70)
  
  Repeat
    Select WaitWindowEvent()
      Case #PB_Event_Gadget
        Select EventGadget()
          Case #gRECHERCHE
            ButtonGadget_OnClick()
          Case #gLISTE
            ListIconGadget_OnDblClick()
        EndSelect
      Case #PB_Event_CloseWindow
        Break
    EndSelect
  ForEver
  
EndIf
Image
Avatar de l’utilisateur
Jacobus
Messages : 1559
Inscription : mar. 06/avr./2004 10:35
Contact :

Re: Comment trouver des mot similaires parmi une liste

Message par Jacobus »

Très fort! Ca va très vite!
Le premier dico_accent a l'avantage de donner les résultats des conjuguaisons par rapport au hunspell moderne.
Activer ou non le support unicode, ça fonctionne quand même avec le fichier .dic
Quand tous les glands seront tombés, les feuilles dispersées, la vigueur retombée... Dans la morne solitude, ancré au coeur de ses racines, c'est de sa force maturité qu'il renaîtra en pleine magnificence...Jacobus.
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Re: Comment trouver des mot similaires parmi une liste

Message par Backup »

excellent !! :)
Avatar de l’utilisateur
Flype
Messages : 2431
Inscription : jeu. 29/janv./2004 0:26
Localisation : Nantes

Re: Comment trouver des mot similaires parmi une liste

Message par Flype »

Yeah ca va vite :)

J'ai modifié encore un peu pour aller au moins deux fois plus vite qu'avant.

- Ajout à la ligne 73 et 92 d'un pré-calcul de la longueur des mots du dictionnaire (on gagne un peu).
- Ajout à la ligne 140 d'un test sur les longueurs des deux chaines à comparer (on gagne pas mal).

En effet, cela permet de ne pas exécuter le calcul de la distance de Levenshtein
lorsque les longueurs des chaines sont de toutes façons trop éloignées.

@Jacobus,
Pour moi il faut activer l'Unicode sans quoi les accents ne s'affichent pas correctement dans le ListView. Pas toi ?

Code : Tout sélectionner

;======================================================================
;== Algorithme de Levenshtein
;== http://fr.wikipedia.org/wiki/Distance_de_Levenshtein
;== http://fr.wikipedia.org/wiki/Distance_de_Damerau-Levenshtein
;======================================================================

Structure CHARS
  c.c[0]
EndStructure

Procedure Max(a, b)
  If a > b
    ProcedureReturn a
  EndIf
  ProcedureReturn b
EndProcedure

Procedure Min(a, b)
  If a < b
    ProcedureReturn a
  EndIf
  ProcedureReturn b
EndProcedure

Procedure Min3(a, b, c)
  If b < a
    a = b
  EndIf
  If c < a
    ProcedureReturn c
  EndIf
  ProcedureReturn a
EndProcedure

Procedure DistanceLevenshtein(*a.CHARS, *b.CHARS, m, n)
  
  Protected Dim d(m, n)
  Protected i, j, cost
  
  For i = 0 To m
    d(i, 0) = i
  Next
  
  For j = 0 To n
    d(0, j) = j
  Next
  
  For i = 1 To m
    For j = 1 To n
      If *a\c[i-1] = *b\c[j-1]
        cost = 0
      Else
        cost = 1
      EndIf
      d(i, j) = Min3(d(i-1, j) + 1, d(i, j-1) + 1, d(i-1, j-1) + cost)
      If i > 1 And j > 1 And *a\c[i-1] = *b\c[j-2] And *a\c[i-2] = *b\c[j-1]
        d(i, j) = Min(d(i, j), d(i-2, j-2) + cost)
      EndIf
    Next
  Next
  
  ProcedureReturn d(m, n)
  
EndProcedure

;======================================================================
;== Chargement du dictionnaire
;== http://www.dicollecte.org/download.php?prj=fr
;== http://www.dicollecte.org/download/fr/hunspell-fr-moderne-v3.8.zip
;======================================================================

Structure DICO
  mot.s
  longueur.i
EndStructure

Structure RESULTAT
  mot.s
  score.d
  distance.i
EndStructure

Global NewList dict.DICO()

If ReadFile(0, "fr-moderne.dic")
  ReadString(0)
  While Not Eof(0)
    If AddElement(dict())
      dict()\mot = LCase(StringField(ReadString(0), 1, "/"))
      dict()\longueur = Len(dict()\mot)
    EndIf
  Wend
  CloseFile(0)
Else
  MessageRequester("Erreur", "Vous devez posséder un dictionnaire !")
  End
EndIf

;===============================================
;== Interface graphique
;===============================================

Enumeration
  #gSAISIE
  #gSCORE
  #gRECHERCHE
  #gLISTE
EndEnumeration

Procedure gLISTE_OnEvent()
  
  If EventType() = #PB_EventType_LeftDoubleClick And GetGadgetState(#gLISTE) > -1
    SetGadgetText(#gSAISIE, GetGadgetItemText(#gLISTE, GetGadgetState(#gLISTE), 0))
  EndIf
  
EndProcedure

Procedure gRECHERCHE_OnEvent()
  
  ;------------------------------
  ; Initialisation
  ;------------------------------
  
  Protected NewList r.RESULTAT()
  Protected a.s, b.s, s.d, sc.d, d, m, n, ms
  
  ms = ElapsedMilliseconds()
  sc = GetGadgetState(#gSCORE)
  a  = LCase(GetGadgetText(#gSAISIE))
  m  = Len(a)
  
  ;------------------------------
  ; Analyse du dictionnaire
  ;------------------------------
  
  ForEach dict()
    n = dict()\longueur
    If Abs(m - n) < 3 ; <-------------- NOUVEAU
      b = dict()\mot
      d = DistanceLevenshtein(@a, @b, m, n)
      s = ( 100.0 * ( 1.0 - ( d / Max(m, n) ) ) )
      If s >= sc
        If AddElement(r())
          r()\mot = b
          r()\score = s
          r()\distance = d
        EndIf
      EndIf
    EndIf
  Next
  
  ;------------------------------
  ; Tri du résultat
  ;------------------------------
  
  SortStructuredList(r(), #PB_Sort_Descending, OffsetOf(RESULTAT\score), #PB_Sort_Double)
  
  ;------------------------------
  ; Actualisation du ListView
  ;------------------------------
  
  ClearGadgetItems(#gLISTE)
  SetGadgetItemText(#gLISTE, -1, Str(ListSize(r())) + " résultat(s) en " + Str(ElapsedMilliseconds() - ms) + "ms")
  
  ForEach r()
    AddGadgetItem(#gLISTE, -1, r()\mot + #LF$ + Str(r()\distance) + #LF$ + StrD(r()\score, 0) + "%")
  Next
  
EndProcedure

If OpenWindow(0, 0, 0, 280, 200, "Dictionnaire Levenshtein (" + Str(ListSize(dict())) + " mots)", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  
  StringGadget(#gSAISIE, 5, 5, 160, 21, "rothographe")
  SpinGadget(#gSCORE, 170, 5, 35, 21, 1, 100, #PB_Spin_Numeric)
  ButtonGadget(#gRECHERCHE, 210, 5, 65, 21, "Rechercher")
  ListIconGadget(#gLISTE, 5, 30, 270, 165, "Résultat", 155, #PB_ListIcon_FullRowSelect | #PB_ListIcon_GridLines)
  AddGadgetColumn(#gLISTE, 1, "Distance", 55)
  AddGadgetColumn(#gLISTE, 2, "Score", 40)
  SetGadgetState(#gSCORE, 70)
  
  Repeat
    Select WaitWindowEvent()
      Case #PB_Event_Gadget
        Select EventGadget()
          Case #gLISTE     : gLISTE_OnEvent()
          Case #gRECHERCHE : gRECHERCHE_OnEvent()
        EndSelect
      Case #PB_Event_CloseWindow
        Break
    EndSelect
  ForEver
  
EndIf
Ça commence à le faire, non ? 8)
Image
Répondre