[[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;