Olá pessoal, Guionardo, você não é brincadeira não, matou a dúvida e mostrou a função, rsrsrsrsrsrsrs. Desse jeito os 2 demos que coloquei na 4shared vão virar sarcófagos, rsrsrsrsrsrsrs. Você é fera, isso não é um elogio, é a realidade. Funções úteis para strings (as que iniciam com 'sc' foram escritas por mim): ----------------------------------------------------------------------- function scRemoveAllChars(Ch: Char; S: string): string; var I: Integer; begin I := Length(S); while (Length(S) > 0) and (I > 0) do begin if S[I] = Ch then Delete(S, I, 1); Dec(I); end; Result := S; end; ----------------------------------------------------------------------- function scRemoveCharactersOfString(Chrs: array of Char; Str: string): string; var I: Integer; S: string; begin S := Str; for I := 0 to High(Chrs) do S := scRemoveAllChars(Chrs[I], S); Result := S; end; ----------------------------------------------------------------------- function RemovesAccent1(S: string): string; const WithAccent = 'àâêôûãõáéíóúçüÀÂÊÔÛÃÕÁÉÍÓÚÇÜ'; Stressless = 'aaeouaoaeioucuAAEOUAOAEIOUCU'; var I: Integer; begin for I := 1 to Length(S) do if Pos(S[I], WithAccent) <> 0 then S[I] := Stressless[Pos(S[I], WithAccent)]; Result := S; end; ----------------------------------------------------------------------- function RemovesAccents2(S: string ): string; var I: Integer; begin for I := 1 to Length(S) do case S[I] of 'á': S[I] := 'a'; 'é': S[I] := 'e'; 'í': S[I] := 'i'; 'ó': S[I] := 'o'; 'ú': S[I] := 'u'; 'à': S[I] := 'a'; 'è': S[I] := 'e'; 'ì': S[I] := 'i'; 'ò': S[I] := 'o'; 'ù': S[I] := 'u'; 'â': S[I] := 'a'; 'ê': S[I] := 'e'; 'î': S[I] := 'i'; 'ô': S[I] := 'o'; 'û': S[I] := 'u'; 'ä': S[I] := 'a'; 'ë': S[I] := 'e'; 'ï': S[I] := 'i'; 'ö': S[I] := 'o'; 'ü': S[I] := 'u'; 'ã': S[I] := 'a'; 'õ': S[I] := 'o'; 'ñ': S[I] := 'n'; 'ç': S[I] := 'c'; 'Á': S[I] := 'A'; 'É': S[I] := 'E'; 'Í': S[I] := 'I'; 'Ó': S[I] := 'O'; 'Ú': S[I] := 'U'; 'À': S[I] := 'A'; 'È': S[I] := 'E'; 'Ì': S[I] := 'I'; 'Ò': S[I] := 'O'; 'Ù': S[I] := 'U'; 'Â': S[I] := 'A'; 'Ê': S[I] := 'E'; 'Î': S[I] := 'I'; 'Ô': S[I] := 'O'; 'Û': S[I] := 'U'; 'Ä': S[I] := 'A'; 'Ë': S[I] := 'E'; 'Ï': S[I] := 'I'; 'Ö': S[I] := 'O'; 'Ü': S[I] := 'U'; 'Ã': S[I] := 'A'; 'Õ': S[I] := 'O'; 'Ñ': S[I] := 'N'; 'Ç': S[I] := 'C'; end; Result := S; end; Um abraço! Silvio Clécio Contatos/Blog Skype: silvioprog Yahoo! Messenger: [EMAIL PROTECTED] MSN (Hotmail): [EMAIL PROTECTED] BlogSpot: http://silvioclecio.blogspot.com/
----- Mensagem original ---- De: Guionardo Furlan <[EMAIL PROTECTED]> Para: delphi-br@yahoogrupos.com.br Enviadas: Quarta-feira, 8 de Outubro de 2008 17:34:22 Assunto: Re: [delphi-br] Similaridade entre duas Strings 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 SimilaridadeCaracte r; var j: Integer; begin SimCar := 0; for j := 1 to Length(Origem) do if Pos(Origem[j] , Destino) > 0 then Inc(SimCar); end; procedure RemoveNaoCoincident es(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(RemoveAcent os(Origem) )); Destino := AnsiUpperCase( Trim(RemoveAcent os(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. SimilaridadeCaracte r; // 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 RemoveNaoCoincident es(Origem, Destino); RemoveNaoCoincident es(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] br>: > 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: [EMAIL PROTECTED] os.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 <osmar_listas@ yahoo.com. br>: >> 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 . Novos endereços, o Yahoo! que você conhece. Crie um email novo com a sua cara @ymail.com ou @rocketmail.com. http://br.new.mail.yahoo.com/addresses [As partes desta mensagem que não continham texto foram removidas]
