Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   Varios (https://www.clubdelphi.com/foros/forumdisplay.php?f=11)
-   -   Comparar cadenas y sacar su semejanza en % (https://www.clubdelphi.com/foros/showthread.php?t=56316)

CamiloVI 14-05-2008 14:03:24

Comparar cadenas y sacar su semejanza en %
 
Buenas.

Estoy haciendo una migración, resulta que tengo la mala suerte de que
varias tablas tienen el mismo campo pero resulta que están algo alterados.
Osea que dos campos aparentemente iguales, que tendrian que tener el mismo contenido lo tienen algo diferente, tienen acento o alguna barra etc...

¿Como podria hacer para comparar esos dos campos,
y mediante una funcion me devuelva el % de similitud.

Ejm:

texto1= Garcia Leonidas Solomillero
texto2= Garci a Leonidas-Solomilléro


Pues que la funcion de marcase que hay un 85% de que ambos textos son coincidentes...

Estoy probando con separar las palabras guardar su longitud y posicion y despues ir comparando una a una... pero vamos que por salir no me sale.

Un empujoncin please??

cHackAll 14-05-2008 15:43:38

Se me ocurre que puedes eliminar los símbolos "inutiles" ['\','-','.',' '] (incluyendo espacios), convertir la cadena en minúsculas y convertir todas las letras acentuadas a normales (á->a; é->e; ñ->n).

Con esto la verificacion será posible

texto1='Garcia Leonidas Solomillero' -> garcialeonidassolomillero
texto2='Garci a Leonidas-Solomilléro' -> garcialeonidassolomillero

Nota; es necesario que decidas bien en qué momento eliminar el espacio para casos especiales.

Saludos

duilioisola 14-05-2008 15:48:35

Yo hice algo así hace un tiempo... si lo encuentro te lo envío.

- Pasa todo a mayúsculas (o minúsculas si lo prefieres)
- Convierte algunas cosas: Ñ->N, vocales acentuadas a vocales,
- Elimina todo lo que no sea una letra o un número o un espacio.
- Elimina espacios dobles. (Gacia__jose = Garcia_Jose)

En mi procedimiento :
- comparaba primero si eran iguales. --> 100%
- Luego comparaba cadenas de 5 caracteres
- Luego de 4
- Luego de 3
Si había coincidencias daba más puntos
Con esto JOSE GARCIA es muy parecido a GARCIA JOSE.

CamiloVI 14-05-2008 16:04:40

He estado planteando precisamente lo que me habeis expuesto,
limpiar ambos textos y despues compararlos insitu.

Muchas gracias por la ayuda y por el empujón.



Saludos

duilioisola 14-05-2008 22:54:09

Estaba aburrido e hice esta funcion:

Las primeras comprobaciones devuelven de 100% a 94% y son simples.
La segunda comprobación evalúa palabras y devuelva valores entre 0% 93%
Duilio Juan, ISOLA HOMOLA - Original
Duilio Juan, ISOLA HOMOLA - 100%
ISOLA HOMOLA, Duilio Juan - 93%
ISOLA HOMOLA, Duilio - 80%
Isola, Duilio - 56%
Isola, DuilioJuan - 10%


Código Delphi [-]
function Similitud(s1,s2 : string) : integer;
var
   a1, a2,a3 ,a4 : string;
   i, p : integer;

function QuitaEspacios(s : string) : string;
var
   i : integer;
begin
   {Quita todos los espacios}
   Result := '';
   for i := 1 to length(s) do
      if (s[i]<>' ') then
         Result := Result + s[i];
end;

function QuitaMultipleEspacio(s : string) : string;
var
   i : integer;
   espacio : boolean;
begin
   {Quita espacios repetidos.}
   Result := '';
   espacio := False;
   for i := 1 to length(s) do
      if (s[i]<>' ') then
      begin
         Result := Result + s[i];
         espacio := False;
      end else
         if (not espacio) then
         begin
            Result := Result + s[i];
            espacio := true;
         end;
end;

function Reemplaza(s : string; o,d : string) : string;
var
   i : integer;
begin
   {Reemplaza un caracter por otro}
   Result := '';
   for i := 1 to length(s) do
      if (s[i]=o) then
         Result := Result + d
      else
         Result := Result + s[i];
end;

function SoloAlfanumericos(s : string) : string;
var
   i : integer;
begin
   {Devuelve solo los caracteres alfanumericos (minusculas) y espacio}
   Result := '';
   for i := 1 to length(s) do
      if (s[i] in ['a'..'z','0'..'9',' ']) then
         Result := Result + s[i];
end;

begin
  Result := 0;
  {Si son iguales}
  if (s1=s2) then Result := 100
  else
  begin
    {Pruebo quitando espacios delante y detras}
    s1 := Trim(s1);
    s2 := Trim(s2);
    if (s1=s2) then Result := 99
    else
    begin
      {Pruebo poniendo todo en minusculas}
      s1 := lowercase(s1);
      s2 := lowercase(s2);
      if (s1=s2) then Result := 98
      else
      begin
        {Pruebo quitando espacios repetidos}
        s1 := QuitaMultipleEspacio(s1);
        s2 := QuitaMultipleEspacio(s2);
        {auxiliares para guardar el texto en este estado}
        a1 := s1;
        a2 := s2;
        if (s1=s2) then Result := 97
        else
        begin
          {Pruebo quitando todos los espacios}
          s1 := QuitaEspacios(s1);
          s2 := QuitaEspacios(s2);
          if (s1=s2) then Result := 96
          else
          begin
             {Pruebo transformando caracteres}
             s1 := Reemplaza(s1,'á','a');
             s1 := Reemplaza(s1,'é','e');
             s1 := Reemplaza(s1,'í','i');
             s1 := Reemplaza(s1,'ó','o');
             s1 := Reemplaza(s1,'ú','u');
             s1 := Reemplaza(s1,'ñ','n');
             s2 := Reemplaza(s2,'á','a');
             s2 := Reemplaza(s2,'é','e');
             s2 := Reemplaza(s2,'í','i');
             s2 := Reemplaza(s2,'ó','o');
             s2 := Reemplaza(s2,'ú','u');
             s2 := Reemplaza(s2,'ñ','n');
             if (s1=s2) then Result := 95
             else
             begin
                {Pruebo quitando caracteres no alfanumericos}
                s1 := SoloAlfanumericos(s1);
                s2 := SoloAlfanumericos(s2);
                {Guardo para comparar al final}
                a3 := s1;
                a4 := s2;
                if (s1=s2) then Result := 94
                else
                begin
                   {recupero las cadenas originales en minusculas y sin caracteres raros}
                   {agrego un espacio final para buscar palabras}
                   s1 := QuitaMultipleEspacio(SoloAlfanumericos(a1))+' ';
                   s2 := QuitaMultipleEspacio(SoloAlfanumericos(a2))+' ';
                   a1 := '';
                   i := 1;
                   while i < length(s2) do
                   begin
                      {cargo en a2 la palbra}
                      a2 := '';
                      while s2[i]<>' ' do
                      begin
                         a2 := a2 + s2[i];
                         inc(i);
                      end;
                      inc(i);
                      a2 := a2+' ';
                      p := pos(a2,s1);
                      if (p>0) then
                         {si la encuentro la quito de s1}
                         s1 := copy(s1,1,p-1)+copy(s1,p+length(a2),length(s1)-p+1)
                      else
                         {guardo en a1 las palabras que no coinciden}
                         a1 := a1 + a2;
                   end;
                   {s1 - Las palabras de s1 que no estan en s2}
                   {s2 - s2}
                   {a1 - Las palabras de s2 que no estan en s1}
                   {a2 - ultima palabra}
                   {a3 - Original de s1}
                   {a4 - Original de s2}
                   {a3+a4 ---- 93%}
                   {s1+a1 ----  x%}
                   if (length(s2)>0) then
                      Result := 93 - ((length(s1)+length(a1))*100) div (length(a3)+length(a4))
                   else
                      Result := -1;
                   if (Result < 0) then
                      Result := 0;
                end;
             end;
          end;
        end;
      end;
    end;
  end;
end;

CamiloVI 15-05-2008 08:27:30

He de expresar mi agradecimiento, pues la función es una obra de arte.
Ya tenía avanzada la idea original, pero no me queda mas remedio que quitarme el sombrero. Chapo!!!


Gracias por tu tarde aburrida. Espero poder devolver algún dia tan magna función.


Saludos


PD: Yalastoy probando


La franja horaria es GMT +2. Ahora son las 09:52:22.

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2026, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi