Comparar cadenas y sacar su semejanza en %

[CamiloVI]

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]]

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]

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