Code : Tout sélectionner
EnableExplicit
Procedure.b Min(A.b,B.b,C.b)
If A>B : A=B : EndIf
If A>C : A=C : EndIf
ProcedureReturn A
EndProcedure
Procedure.b LD(Str1$,Str2$,IgnoreCase.b)
;Ignorer ou non la casse
If IgnoreCase
Str1$=UCase(Str1$)
Str2$=UCase(Str2$)
EndIf
;Identité parfaite, cas trivial
If Str1$=Str2$
ProcedureReturn 0
EndIf
;Longueur des chaînes
Protected Len1.b,Len2.b
Len1=Len(Str1$)
Len2=Len(Str2$)
;Une des deux chaînes est vide, cas trivial
If Str1$=""
ProcedureReturn Len2
ElseIf Str2$=""
ProcedureReturn Len1
EndIf
;Matrice pour les calculs
Protected Dim Matrix.b(Len1+1,Len2+1)
Protected Dim Cost.b(Len1,Len2)
Protected i.b,j.b
Protected Insertion.b,Deletion.b,Substitution.b
;Initialisation de la matrice principale
For i=1 To Len1
Matrix(i,0)=i
Next i
For j=1 To Len2
Matrix(0,j)=j
Next j
;Remplissage de la matrice secondaire qui détermine les lettres identiques
For i=0 To Len1-1
For j=0 To Len2-1
If Mid(Str1$,i+1,1)=Mid(Str2$,j+1,1)
Cost(i,j)=0
Else
Cost(i,j)=1
EndIf
Next j
Next i
;On remplit la matrice principale
For j=1 To Len2
For i=1 To Len1
Insertion=Matrix(i-1,j)+1
Deletion=Matrix(i,j-1)+1
Substitution=Matrix(i-1,j-1)+Cost(i-1,j-1)
Matrix(i,j)=Min(Insertion,Deletion,Substitution)
Next i
Next j
;La solution est à la fin de la matrice
ProcedureReturn Matrix(Len1,Len2)
EndProcedure
