Elogio de vez em quando vai bem, eheh.
Bom, tá aí o código, testado por aqui e funcionando. No meu cálculo manual
deu diferença ao comparar os nomes JOÃO e JONAS porque não considerei a
diferença de tamanho das strings.
Não é um componente, é uma função.
--------
unit GStrings;
interface
/// Obtém a similaridade entre duas strings retornando um valor entre 0 e 1
function Similaridade(Origem, Destino: string): Single;
implementation
uses
SysUtils, GuioUtils;
function Similaridade(Origem, Destino: string): Single;
var
i: Integer;
SimCar: Integer; // Similaridade de caracteres
SimOrd: Integer; // Similaridade de ordem
Lista: array of string;
function Validacao: Boolean;
begin
Result := (Length(Origem) > 0) and (Length(Destino) > 0);
end;
procedure SimilaridadeCaracter;
var
j: Integer;
begin
SimCar := 0;
for j := 1 to Length(Origem) do
if Pos(Origem[j], Destino) > 0 then
Inc(SimCar);
end;
procedure RemoveNaoCoincidentes(var s1, s2: string);
begin
i := 1;
while i <= Length(s1) do
if Pos(s1[i], s2) = 0 then
Delete(s1, i, 1)
else
Inc(i);
end;
procedure GeraLista;
var
npalavras: Integer; // Número de "palavras"
j, k: Integer;
begin
npalavras := (Sqr(Length(Origem)) + Length(Origem)) div 2;
SetLength(Lista, npalavras);
i := 0;
for j := 1 to Length(Origem) do // j recebe o tamanho de cada palavra
for k := 1 to Length(Origem) - j + 1 do
// k recebe a posicao de cada palavra
begin
Lista[i] := Copy(Origem, k, j);
Inc(i);
end;
end;
procedure SimilaridadeOrdem;
var
j: Integer;
begin
SimOrd := 0;
for j := 0 to Length(Lista) - 1 do
if Pos(Lista[j], Destino) > 0 then
Inc(SimOrd);
Result := Result * (SimOrd / Length(Lista));
SetLength(Lista, 0);
end;
begin
// 1. Transformar os textos para a mesma caixa e remover espaços em branco
Origem := AnsiUpperCase(Trim(RemoveAcentos(Origem)));
Destino := AnsiUpperCase(Trim(RemoveAcentos(Destino)));
// 2a. Verificar se os textos são vazios: se forem, similaridade 0 e sai
if not Validacao then
begin
Result := 0;
Exit;
end;
// 2b. Verificar se os textos são iguais: se forem, similaridade 100%
// e termina o processo
if SameText(Origem, Destino) then
begin
Result := 1;
Exit;
end;
// 3. para cada caracter do texto origem verificar se ele existe no texto
// destino, e em caso positivo, incrementar 1 no contador de similaridade.
SimilaridadeCaracter;
// 4. o quociente contador / número de caracteres no destino indica a
// similaridade sem considerar a ordem dos caracteres.
Result := SimCar / Length(Destino);
if Result = 0 then
Exit;
// 5. considerando a ordem, remove-se os caracteres da origem que não
// existem no destino e os caracteres do destino que não existem na
// origem, igualando os dois textos
RemoveNaoCoincidentes(Origem, Destino);
RemoveNaoCoincidentes(Destino, Origem);
// 6. agora, com uma função que gere uma lista de "palavras" formadas
// pelos caracteres da origem, da seguinte forma:
// origem ajustada: "peto", com os caracteres não coincidentes removidos,
// a lista gerada seria a seguinte
// p, e, t, o, pe, et, to, pet, eto, peto: 4 caracteres = 10 palavras
// map = m, a, p, ma, ap, map: 3 caracteres = 6 palavras
// jorge = j, o, r, g, e, jo, or, rg, ge, jor, org, rge, jorg, orge,
// jorge: 5 caracteres = 15 palavras
// O número de "palavras" dentro da lista é definido pela fórmula
// 0,5j^2+0,5j, onde j é o número de caracteres do texto origem ajustado.
GeraLista;
// Cada palavra da lista encontrada dentro da palavra destino ajustada
// incrementa uma unidade no contador de similaridade de ordem.
// A similaridade de ordem é o quociente do contador sobre o número de
// palavras da lista.
SimilaridadeOrdem;
end;
end.
---------
PS: Duas referências no código (guioutils e RemoveAcentos) não estão
disponíveis. É que minha função de remoção de acentos usa uma tecnologia
avançadíssima com algoritmos genéticos e inteligência artificial, portanto
não disponibilizarei de grátis aqui. :-)
2008/10/8 Roberto <[EMAIL PROTECTED]>:
> Guionardo, tu tá de sacanagem, né..
>
> Quando descansar bem, completa a explanação com um componente aqui prá
nois,
>
> Matou a cobra, agora mostra o componente (se ainda houver fosfato).
>
> Parabéns e entenda a brincadeira como elogio
>
> Abraço
> Roberto (RJ)
>
> ----- Original Message -----
> From: Guionardo Furlan
> To: delphi-br@yahoogrupos.com.br
> Sent: Tuesday, October 07, 2008 10:13 PM
> Subject: Re: [delphi-br] Similaridade entre duas Strings
>
> um bom exercício, vou dar meu palpite:
>
> 1. transformar os textos para a mesma caixa (alta ou baixa)
> 2. Verificar se os textos são iguais: se forem, similaridade 100% e
> termina o processo.
> 3. para cada caracter do texto origem verificar se ele existe no texto
> destino, e em caso positivo, incrementar 1 no contador de
> similaridade.
> 4. o quociente contador / número de caracteres no destino indica a
> similaridade sem considerar a ordem dos caracteres.
>
> Por exemplo, "pedto" e "pedro" são similares 4 caracteres em 5,
> indicando 80% de similaridade sem verificação de ordem.
>
> 5. considerando a ordem, remove-se os caracteres da origem que não
> existem no destino e os caracteres do destino que não existem na
> origem, igualando os dois textos
> 6. agora, com uma função que gere uma lista de "palavras" formadas
> pelos caracteres da origem, da seguinte forma:
> origem ajustada: "peto", com os caracteres não coincidentes removidos,
> a lista gerada seria a seguinte
> p, e, t, o, pe, et, to, pet, eto, peto: 4 caracteres = 10 palavras
> map = m, a, p, ma, ap, map: 3 caracteres = 6 palavras
> jorge = j, o, r, g, e, jo, or, rg, ge, jor, org, rge, jorg, orge,
> jorge: 5 caracteres = 15 palavras
> O número de "palavras" dentro da lista é definido pela fórmula
> 0,5j^2+0,5j, onde j é o número de caracteres do texto origem ajustado.
> Cada palavra da lista encontrada dentro da palavra destino ajustada
> incrementa uma unidade no contador de similaridade de ordem.
> A similaridade de ordem é o quociente do contador sobre o número de
> palavras da lista.
> No exemplo acima, temos a mesma ordem dos caracteres e portanto, 100%
> de similaridade por ordem.
>
> Multiplicando os dois quocientes, teríamos um fator de similaridade
> entre as palavras, neste caso, 80% x 100% = 80%
>
> com outro exemplo, poderíamos ter:
> JOAO e JONAS
>
> As letras J, O, A e O existem todas dentro de JONAS, portanto temos
> 100% até aqui
> Fazendo a intersecção, temos os dois textos ajustados:
> JOAO e JOA
>
> com a lista de palavras temos
> J (1), O (1), A (1), O (1), JO (1), OA (1), AO (0), JOA (1), OAO (0),
> JOAO (0), somando 7 coincidências em 10 possibilidades, resultando em
> 70%.
>
> Multiplicando os dois quocientes, temos 70% de similaridade.
>
> Agora é só codificar pra OP e ver se a coisa serve.
>
> PS: fiz isso depois da janta, e meio cansado. Provavelmente deve haver
> um algoritmo mais elaborado, usando redes neurais, ou até mesmo uma
> função do delphi que resolve a parada. Mas é legal pra gente queimar
> um pouco de fosfato fora dos problemas comuns.
>
> 2008/10/7 Osmar Souza <[EMAIL PROTECTED]>:
>> Olá Pessoal,
>>
>> Alguem já precisou comparar a similaridade entre duas strings e
>> supor a porcetagem de similaridade entre elas?
>>
>> Exemplo:
>>
>> Em uma caixa de texto a pessoa digitou "pedto". O sistema analisou
>> e pergunta se o que ele esta procurando não é "pedro". Como no Google.
>>
>> Estou precisando de um algoritimo desses para tentar diminuir o
>> número de erros no cadastro. Como os requisitos do sistema diz que o
>> nome é o mais importante e que o resto não é necessário, vemos uma
>> mesma pessoa jurídica, por exemplo, cadastradas de 10 formas diferentes.
--
Timeo hominem unius libri
Cogito ergo sum - Carpe diem
[]s
Guionardo Furlan
http://guionardo.blogspot.com
[As partes desta mensagem que não continham texto foram removidas]
