1. Accueil
  2. Tous les snippets
  3. Snippets Delphi / Pascal
  4. Fonction renvoyant le pourcentage de similitude entre 2 chaines

Fonction renvoyant le pourcentage de similitude entre 2 chaines

Soyez le premier à donner votre avis sur cette source.

Snippet vu 12 952 fois - Téléchargée 32 fois

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

Ajouter un commentaire Commentaires
Signaler
Messages postés
152
Date d'inscription
lundi 3 avril 2006
Statut
Membre
Dernière intervention
2 juin 2008
 1
Le code marche super bien si les deux chaines diffèrent a leurs extrémité droite. Par contre si on change seulement la premiere lettre, on a automatiquement un resultat de 0 %.
Signaler
Messages postés
4202
Date d'inscription
samedi 16 octobre 2004
Statut
Modérateur
Dernière intervention
13 juin 2020
 37
pour eviter les bugs de colorisation il faut mettre les commentaires entre {} et non //
Signaler
Messages postés
157
Date d'inscription
dimanche 19 novembre 2000
Statut
Membre
Dernière intervention
14 avril 2009
Ton code a l'air intéressant, je le regarderai plus en détaille en rentrant de vaccance...
Il va surment m'être utile pour la recherche dans les fichiers d'aide

Bonne continuation ;)
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)