Fonction renvoyant le pourcentage de similitude entre 2 chaines

Commenter

Contenu du snippet

On peut être amener a effectuer une recherche de chaine sans être sûr de l'orthographe de la chaine recherchée. Cette fonction retourne un pourcentage de ressemblance entre 2 chaines, et ainsi vous pouvez fournir des résultats plus ou moins proche de la chaine recherchée. J'ai utilisé ce code dans un petit utilitaire de recherche de chaines dans des fichiers.

Source / Exemple : 


// ----------------------------------------------------------------------------------------
Function ComparerChaines(s1,s2:String):Integer;
{ Fonction comparaison chaînes de texte:
  Entrée:
    S1 = première chaîne a comparer, taille limitée a 2048 caractères
    S2 = deuxième chaîne a comparer, taille limitée a 2048 caractères
  Sortie:
    INTEGER, de 0 a 100, % de ressemblance entre les 2 chaînes }
Var identiques,                        // Nombre de caractères identiques
    p1,p2,                             // Indicateurs de position
    l1,l2,                             // Longueurs des chaînes
    pt,                                // Compteur de boucle
    diff : Integer;                    // Facteur d égalisation
    hstr : String;                     // Variable temporaire d échange des chaînes
    test : Array [1..2048] Of Boolean; // Tableau d indicateur pour suivre les positions déjà testées
Begin
  // Tester les longueurs et échanger si S1 est plus courte, on teste toujours par rapport a la chaîne la plus longue
  If Length(s1)<Length(s2) Then Begin
    hstr := s2;
    s2   := s1;
    s1   := hstr;
  End;
  // Stocker les longueurs des chaînes
  l1 := Length(s1);
  l2 := Length(s2);
  // Une chaîne a vide ? alors la comparaison est de 0%
  If (l1=0) Or (l2=0) Then
    Result := 0
  Else Begin
    p1         := 1;
    p2         := 1;
    identiques := 0;
    // Calculer le facteur d égalisation dépendant de la longueur de la chaîne, en général c est 1/3 de la longueur maximale
    diff       := Max(l1,l2) Div 3 + Abs(l1-l2);
    // Initialiser le tableau de suivi
    For pt := 1 To l1 Do
      test[pt] := False;
    // Parcours de la chaîne
    Repeat
      // Position testée ?
      If Not test[p1] Then Begin
        // Caractère identique ?
        If (s1[p1]=s2[p2]) And (Abs(p1-p2)<=diff) Then Begin
          test[p1] := True;
          // Augmenter le compteur de caractères identiques
          Inc(identiques);
          // Positions suivantes
          Inc(p1);
          Inc(p2);
          // Boucler
          If p1>l1 Then p1:=1;
        End Else Begin
          Test[p1] := False;
          Inc(p1);
          // Boucler a la prochaine position de test si on arrive a la fin de la chaîne
          If p1>l1 Then Begin
            While (p1>1) And Not (test[p1]) Do
              Dec(p1);
            Inc(p2)
          End;
        End;
      End Else Begin
        Inc(p1);
        // Boucler a la prochaine position de test si on arrive a la fin de la chaîne
        If p1>l1 Then Begin
          Repeat
            Dec(p1);
          Until (p1=1) Or test[p1];
          Inc(p2);
        End;
      End;
    Until p2>Length(s2);
    // Calculer la valeur en pourcentage
    Result := 100 * identiques Div l1;
  End;
End;

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (qoprek)