LinkBack URL
About LinkBacksAlguien tiene alguna función que permita determinar, en alguna escala definida, el nivel de similitud de dos cadenas?, osea algo asi:
nivel = compara(“hola mundo”,”hola mund”)
luego de esta instrucción nivel vale digamos 0.9 (90%) o 4 en escala de 1 al 5
Como deducen necesito comparar cadenas para determinar el grado en que se asemejan, lo real es porque en la tarea que estoy desarrollando tengo una base de datos con una tabla de muchísimas personas, me traen un disco (a cada rato) con un archivo y tengo q determinar si las personas del disco las tengo en base o no.
Ya se, mejor pido un dato como Documento de identidad y solucionado, pero ya lo traen con documento de identidad, lo q pasa es que la comparación de cadenas seria mi segunda confrontación y realmente lo necesito, muchos errores me hacen hacer este tipo de cosas..
Gracias por su tiempo…
Recursos Visual Basic.NET, VB.NET, Manuales de programación, Tutoriales, Foros de programación, Comunidad de programadores
Usuarios activos: 53
Foros de programación, recursos, tutoriales, sistemas operativos...
Bienvenido a la zona de foros. Participa en alguno de nuestros foros: Foros de visual basic, foros de visual basic.net foros de Crystal reports, programas gratis, foros de C++ - C# , foros de Java, foros de PHP, foros de ASP.net. Seguro que hay un foro que te servirá de gran utilidad y si no lo encuentras avísanos y crearemos uno nuevo.
Resultados 1 al 25 de 25
Tema: Comparar Cadenas
-
04/03/2009, 19:37 #1
Junior Member
Iniciad@
- Fecha de ingreso
- 04 mar, 09
- Ubicación
- Peru
- Mensajes
- 7
=======================
Jesus Sierra
-
05/03/2009, 05:41 #2
Moderador
Veteran@
- Fecha de ingreso
- 09 dic, 05
- Mensajes
- 740
mmm... es medio complicado lo que pedís.
El ejemplo que ponés es muy fácil:
nivel = compara(“hola mundo”,”hola mund”)
Pero... ¿que pasa con?
nivel = compara(“hola mundo”,”hola mndo”)
Acá es más dificil
Yo lo que haría es:
1º Pasar todo el texto a minúsculas (o mayúsculas)
2º Hacer una comparación caracter a caracter
3º En cuanto encuentre una diferencia, que llame nuevamente a la función (recursiva obviamente) por el resto de la cadena.
4º Contar las veces que se ejecutó la función: Luego, el nivel será: "Cantidad de letras" / "Cantidad de veces que se ejecutó la función" * 100
Saludos
-
05/03/2009, 06:38 #3
Junior Member
Iniciad@
- Fecha de ingreso
- 04 mar, 09
- Ubicación
- Peru
- Mensajes
- 7
Si, tambien lo pense, esa y otras opciones, pero lo que me queria evitar es programarlo, y pense que talvez alguien sepa de alguna funcion, dll u oxc que lo haga, pues supongo q alguien ya lo creo y consistencio
este problemita. En fin sigo esperando, a ver si alguien se apiade de mi alma..
GRACIAS A TODOS.....=======================
Jesus Sierra
-
05/03/2009, 09:06 #4
Senior Member
Veteran@
- Fecha de ingreso
- 09 may, 08
- Ubicación
- Spain
- Mensajes
- 516
Lo de la recursión es posible...pero hay que tener en cuenta que si falta una letra... el error sera TERRIBLE en cuanto al porcentaje:
Imaginemos esto:
"hola mundo" vs "ola mundo"
..Si bien las cadenas son casi identicas, el error será del 100%...
siento de todo corazón si he aguado la fiesta...
Un abrazo desde Espa.a
-
05/03/2009, 10:37 #5
Moderador
Veteran@
- Fecha de ingreso
- 09 dic, 05
- Mensajes
- 740
No veo el porqué.
Iniciado por Knossos
El ejemplo que ponés es EXACTAMENTE igual al que yo trabajé de base:
Saludos.Código:nivel = compara(“hola mundo”,”hola mndo”)
PD: También otra forma puede ser:
1º Verificar las letras (independientemente del orden) de uno y del otro
2º Verificar el orden (de modo relativo y no absoluto, es decir: La "o" de hola está luego de la "h" y antes de la "l")
-
05/03/2009, 13:15 #6
Junior Member
Iniciad@
- Fecha de ingreso
- 04 mar, 09
- Ubicación
- Peru
- Mensajes
- 7
sep, creo que no queda otra que hacer la función, lo q realmente esperaba es que si alguien ya tubo esta necesidad antes y lo consiguió, de todas maneras son muy gentiles en responder y darse un tiempo en ayudar a los demás, gracias...
PD>: si alguien encuentra alguna dll con esto me lo postea por favor.... GRACIAS A TODOS=======================
Jesus Sierra
-
06/03/2009, 02:25 #7
Senior Member
Expert@
- Fecha de ingreso
- 23 feb, 09
- Ubicación
- Spain
- Mensajes
- 316
¡Qué tema interesante! Muchas gracias por la idea. Le llevo dando vueltas desde ayer y ya tengo la versión 1.0:
Y algunos resultados:Public Function StringCompRatio(ByVal sCad1 As String, ByVal sCad2 As String) As Double
'Preparación previa
If Len(sCad1) > Len(sCad2) Then
Dim sAux As String
sAux = sCad1
sCad1 = sCad2
sCad2 = sAux
End If
Dim lLong As Long
lLong = Len(sCad2)
If lLong = 0 Then
StringCompRatio = 1
Exit Function
End If
sCad1 = sCad1 + Space(lLong - Len(sCad1))
'Recorremos las cadenas
Dim sChar As String * 1
Dim i As Integer, j As Integer, iPos As Integer, iDist As Integer, iTotDist As Integer
For i = 1 To lLong
sChar = Mid(sCad1, i, 1)
iDist = lLong
For j = 1 To lLong
'Si coinciden 2 caracteres vemos la distancia y nos quedamos con la menor
If sChar = Mid(sCad2, j, 1) And Abs(j - i) < iDist Then
iDist = Abs(j - i)
iPos = j
End If
Next
'Eliminamos el caracter para que no se "multicompare"
'Se cambia por "~", caracter que no debe estar en las cadenas que se comparan
If iDist < lLong Then sCad2 = Left(sCad2, iPos - 1) & "~" & Mid(sCad2, iPos + 1)
iTotDist = iTotDist + iDist
Next
'La fórmula
StringCompRatio = 1 - iTotDist / (lLong ^ 2)
End Function
Seguro que se pueden hacer montones de mejoras... y también seguro que esto ya está hecho desde hace mucho. Si alguien encuentra o descubre esas mejoras agradecería que lo posteara.? StringCompRatio("Hola Mundo", "Hola Mundo")
1
? StringCompRatio("Hola Mundo", "Hola Mund")
0,9
? StringCompRatio("ola Mundo", "Hola Mundo")
0,81
? StringCompRatio("Hola Mundo", "Hola xxxxx")
0,5
? StringCompRatio("Hola Mundo", "gdfg hdhhd")
0,19
? StringCompRatio("Hola Mundo", "xxxxxxxxxx")
0
? StringCompRatio("Hola Mundo", "Hola Mundo Mundial")
0,611111111111111
? StringCompRatio("Hola Mundo", "Hola Mundooooooooooooooooooooooooooo")
0,277777777777778
? StringCompRatio("Hola Mundo", "Hola Mundoooo")
0,769230769230769
? StringCompRatio("Hola Mundo", "Mundo Hola")
0,56
? StringCompRatio("Hola Mundo", "odnuM aloH")
0,64
Saludos.La doctrina en cuestión es la siguiente: no es deseable creer una proposición cuando no existe fundamento para suponer que sea cierta. [Bertrand Russell]
-
06/03/2009, 05:18 #8
Moderador
Veteran@
- Fecha de ingreso
- 09 dic, 05
- Mensajes
- 740
Excelente trabajo HAL9000,
Muevo tu trabajo hasta la guía de recursos ya que sin duda no es algo para perder!
Saludos
-
06/03/2009, 08:51 #9
Junior Member
Iniciad@
- Fecha de ingreso
- 04 mar, 09
- Ubicación
- Peru
- Mensajes
- 7
=======================
Jesus Sierra
-
06/03/2009, 09:33 #10
Senior Member
Veteran@
- Fecha de ingreso
- 09 may, 08
- Ubicación
- Spain
- Mensajes
- 516
Añado las felicitaciones pertinentes a la tarea..!!!!!!!!!!!!!! y me parece genial que muevan el código a la sección de Recursos. Seguramente es algo que mucha gente podrá aprovechar.
un abrazo desde España..!
-
06/03/2009, 10:26 #11
Senior Member
Expert@
- Fecha de ingreso
- 23 feb, 09
- Ubicación
- Spain
- Mensajes
- 316
Vaya, muchas gracias a todos. De verdad.La doctrina en cuestión es la siguiente: no es deseable creer una proposición cuando no existe fundamento para suponer que sea cierta. [Bertrand Russell]
-
06/03/2009, 10:42 #12
Senior Member
Expert@
- Fecha de ingreso
- 23 feb, 09
- Ubicación
- Spain
- Mensajes
- 316
Se me fue la tecla y contesté antes de lo que quería... jeje
Pero bueno, reitero el agradecimiento aunque está claro que el código no es precisamente el colmo de la elegancia... y además el algoritmo tiene algún que otro fallito (habrá que corregirlo o cambiarlo por otro más estadísticamente significativo)
Aún así da valores medianamente coherentes, por lo que he probado y la función (o otra mejor) puede ser potencialmente útil para muchas cosas, que se me ocurran ahora
como:
- Para búsquedas más "inteligentes" sustituyendo o complementando a cosas como Like *...
- Para corregir entradas de usuario sobre la marcha.
- Para hacer sugerencias del tipo "¿No habrá querido usted decir...?"
...
Saludos a todos.La doctrina en cuestión es la siguiente: no es deseable creer una proposición cuando no existe fundamento para suponer que sea cierta. [Bertrand Russell]
-
08/03/2009, 09:03 #13
Junior Member
Iniciad@
- Fecha de ingreso
- 04 mar, 09
- Ubicación
- Peru
- Mensajes
- 7
al final termine la función que estube desarrollando, sin desmerecer el excelente trabajo de HAL9000, aqui le pongo lo q hice, q en realidad solo seria usado para comparar apellidos y nombres y no, como bien dice HAL9000, para esas otras utilidades q bien ha mencionado.
Public Function COMPARA_APN(ByVal CAD1 As String, ByVal CAD2 As String) As Double
On Error GoTo ErrorFunction
'VALOR INICIAL
COMPARA_APN = 0
'EN CAD1 EL DE MAYOR LARGO, ORDENAR
If Len(CAD2) > Len(CAD1) Then
AUX = CAD1
CAD1 = CAD2
CAD2 = AUX
End If
DIF = Len(CAD1) - Len(CAD2)
For j = 0 To DIF
For POS = 0 To Len(CAD2) - 1
Q = 0
AUX = Left(CAD2, POS) & Space(j) & Right(CAD2, Len(CAD2) - POS) & Space(DIF - j)
'1 COMPARAMOS LETRA A LETRA
For i = 1 To Len(CAD1)
If Mid(CAD1, i, 1) = Mid(AUX, i, 1) Then Q = Q + 1
Next
If Q / Len(CAD1) > COMPARA_APN Then COMPARA_APN = Q / Len(CAD1)
Next
Next
ErrorFunction:
MsgBox Err.Description, vbCritical
Err.Clear
End Function
Para probar los resultados , lo he enviado a Excel y veanlos:
<TABLE style="WIDTH: 394pt; BORDER-COLLAPSE: collapse" cellSpacing=0 cellPadding=0 width=526 border=0 x:str>
<COLGROUP>
<COL style="WIDTH: 191pt; mso-width-source: userset; mso-width-alt: 9325" width=255>
<COL style="WIDTH: 60pt" width=80>
<COL style="WIDTH: 143pt; mso-width-source: userset; mso-width-alt: 6985" width=191>
<T>
<TR style="HEIGHT: 12.75pt" height=17>
<TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; WIDTH: 191pt; BORDER-BOTTOM: #ece9d8; HEIGHT: 12.75pt; : transparent" width=255 height=17>GUTIERREZ ALARCON FIDEL ALFONSO</TD>
<TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; WIDTH: 60pt; BORDER-BOTTOM: #ece9d8; : transparent" width=80></TD>
<TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; WIDTH: 143pt; BORDER-BOTTOM: #ece9d8; : transparent" width=191></TD></TR>
<TR style="HEIGHT: 12.75pt" height=17>
<TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 12.75pt; : transparent" height=17></TD>
<TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; : transparent"></TD>
<TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; : transparent"></TD></TR>
<TR style="HEIGHT: 12.75pt" height=17>
<TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 12.75pt; : transparent" height=17>GUTIERREZ ALARCON FIDEL ALFONSO</TD>
<TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; : transparent" align=right x:num>1</TD>
<TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; : transparent">=COMPARA_APN($B$3,B6)</TD></TR>
<TR style="HEIGHT: 12.75pt" height=17>
<TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 12.75pt; : transparent" height=17>GUTIERREZ ALARCON FIDEL</TD>
<TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; : transparent" align=right x:num="0.77419354838709675">0.77419355</TD>
<TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; : transparent">=COMPARA_APN($B$3,B7)</TD></TR>
<TR style="HEIGHT: 12.75pt" height=17>
<TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 12.75pt; : transparent" height=17>GUTIERREZ ALARCON ALFONSO</TD>
<TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; : transparent" align=right x:num="0.83870967741935487">0.83870968</TD>
<TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; : transparent" x:str=" =COMPARA_APN($B$3,B8) ">=COMPARA_APN($B$3,B8)</TD></TR>
<TR style="HEIGHT: 12.75pt" height=17>
<TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 12.75pt; : transparent" height=17>GUTIERREZ ALARCON FIDEL A.</TD>
<TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; : transparent" align=right x:num="0.80645161290322576">0.80645161</TD>
<TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; : transparent">=COMPARA_APN($B$3,B9)</TD></TR>
<TR style="HEIGHT: 12.75pt" height=17>
<TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 12.75pt; : transparent" height=17>GUTIERRES ALARCON FIDEL ALFONSO</TD>
<TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; : transparent" align=right x:num="0.967741935483871">0.96774194</TD>
<TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; : transparent" x:str=" =COMPARA_APN($B$3,B10) ">=COMPARA_APN($B$3,B10)</TD></TR>
<TR style="HEIGHT: 12.75pt" height=17>
<TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 12.75pt; : transparent" height=17>GUTIERRES ALARCON FIDEL</TD>
<TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; : transparent" align=right x:num="0.74193548387096775">0.74193548</TD>
<TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; : transparent" x:str=" =COMPARA_APN($B$3,B11) ">=COMPARA_APN($B$3,B11)</TD></TR>
<TR style="HEIGHT: 12.75pt" height=17>
<TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 12.75pt; : transparent" height=17>GUTIERREZ FIDEL</TD>
<TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; : transparent" align=right x:num="0.54838709677419351">0.5483871</TD>
<TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; : transparent">=COMPARA_APN($B$3,B12)</TD></TR>
<TR style="HEIGHT: 12.75pt" height=17>
<TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 12.75pt; : transparent" height=17>GUTIEREZ ALARCON FIDEL ALFONSO</TD>
<TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; : transparent" align=right x:num="0.967741935483871">0.96774194</TD>
<TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; : transparent">=COMPARA_APN($B$3,B13)</TD></TR>
<TR style="HEIGHT: 12.75pt" height=17>
<TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 12.75pt; : transparent" height=17>GUTIERREZALARCON FIDEL ALFONSO</TD>
<TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; : transparent" align=right x:num>1</TD>
<TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; : transparent">=COMPARA_APN($B$3,B14)</TD></TR></T></TABLE>
ojala les sirva para algo........
=======================
Jesus Sierra
-
08/03/2009, 09:33 #14
Junior Member
Iniciad@
- Fecha de ingreso
- 04 mar, 09
- Ubicación
- Peru
- Mensajes
- 7
me falto colocar el exit function antes de la etiqueta de la error de la funcion.... jejeje
=======================
Jesus Sierra
-
06/04/2009, 09:37 #15
Senior Member
Expert@
- Fecha de ingreso
- 23 feb, 09
- Ubicación
- Spain
- Mensajes
- 316
Le sigo dando vueltas al tema, para conseguir un algoritmo más "serio",y acabo de encontrar esto:
Distancia de Levenshtein
Parecería que calculando la Distancia de Levenshtein (DL) entre dos cadenas sólo nos faltaría calcular la máxima DL posible y dividiendo ya obtenemos el ratio que buscamos... ¿nop?
No tengo tiempo ahorade ponerme a calcular esa DLmax, pero es que hay otra duda: en el texto se menciona la Distancia de Damerau-Levenshtein (DDL) que parece bastante mejor en principìo.
Iba a dejar el mensaje aquí, pero he seguido el enlace a la Wiki en inglés, que es este:
Distancia de Demerau-Levenshtein
Bueno, la idea es la misma: calcular DDLmax y dividir.
Como ahora no ando sobrado de tiempo, dejo ahí la idea a ver si alguno encuentra algo mejor... o hace el trabajo sucio y traduce el algoritmo DL o el DDL a VB6... jajaja... Bueno, traducir el código parece facilito, aunque no parecetan fácilentenderlo...a mípor lo menos.
Saludos.
La doctrina en cuestión es la siguiente: no es deseable creer una proposición cuando no existe fundamento para suponer que sea cierta. [Bertrand Russell]
-
07/04/2009, 08:06 #16
Senior Member
Expert@
- Fecha de ingreso
- 23 feb, 09
- Ubicación
- Spain
- Mensajes
- 316
Se me olvidó comentar ayer que la función de jcsierrac da muy buenos resultados y además es bastante ingeniosa (¡creo que he acabdo entendiéndola!... jajaja!) Las únicas pegas que le veo son las mismas de lo que puse yo: parece innecesario (aunque cómodo) el swap del principio y también es cuestionable el relleno con espacios.
Lo que no me convence es que no tiene en cuenta la distancia entre caracteres y, por lo tanto "Hola mundo" y "Mundo hola" van a dar 0.
Otro tanto le pasa al algoritmo DDL que comenté ayer. Ya lo he pasado a VB (no os fiéis del código de la Wiki: ¡la muy ca****a tiene una errata que me volvió loco!) y queda así... salvo error por mi parte:
Lo curioso es que produce unos resultados casi clavados a los de StringCompRatio salvo en los casos ya citados de "Hola mundo"/"Mundo hola" en que da 0... y la verdad eso no me convence (Para el que quiera usarla DDLmax es la longitud de la cadena más larga, o sea Ratio = 1-DistanciaDL/MaxLen)Código:'--------------------------------------------------------------------------------------- ' Func/Proc : DistanciaDL (Function) Long ' Fecha : 07/04/2009 12:42 ' Autor : Fernando ' Finalidad : Calcula la distancia de Demerau-Levenshtein entre 2 strings '--------------------------------------------------------------------------------------- Public Function DistanciaDL(strText1 As String, strText2 As String) As Long Dim lLong1 As Long, lLong2 As Long lLong1 = Len(strText1) lLong2 = Len(strText2) Dim MatrizDL() As Long ReDim MatrizDL(lLong1, lLong2) Dim i As Long, j As Long, lCost As Long For i = 0 To lLong1 MatrizDL(i, 0) = i Next For j = 1 To lLong2 MatrizDL(0, j) = j Next For i = 1 To lLong1 For j = 1 To lLong2 If Mid(strText1, i, 1) = Mid(strText2, j, 1) Then lCost = 0 Else lCost = 1 MatrizDL(i, j) = Minim(MatrizDL(i - 1, j) + 1, _ Minim(MatrizDL(i, j - 1) + 1, _ MatrizDL(i - 1, j - 1) + lCost)) If i > 1 And j > 1 Then _ If Mid(strText1, i, 1) = Mid(strText2, j - 1, 1) And _ Mid(strText1, i - 1, 1) = Mid(strText2, j, 1) Then _ MatrizDL(i, j) = Minim((MatrizDL(i, j)), MatrizDL(i - 2, j - 2) + lCost) Next Next DistanciaDL = MatrizDL(lLong1, lLong2) End Function
Pero está bien la idea de la matriz bidimensional, que evita la solución poco elegante de ir borrando caracteres o usar cadenas auxiliares.
Desde la Wikipedia en inglés se llega a enlaces muy interesantes, a ver si les doy un vistazo y saco alguna versión mejor.
Saludos.La doctrina en cuestión es la siguiente: no es deseable creer una proposición cuando no existe fundamento para suponer que sea cierta. [Bertrand Russell]
-
22/04/2009, 00:54 #17
Senior Member
Expert@
- Fecha de ingreso
- 23 feb, 09
- Ubicación
- Spain
- Mensajes
- 316
Hola. Bueno, primero lo más importante. Os dejo aquí un enlace absolutamente impresionante sobre el tema:
http://www.dcs.shef.ac.uk/~sam/stringmetrics.html
No sólo están un montón de algoritmos perfectamente explicados sino que además ¡¡¡¡Se incluye una jerarquía de clases escrita en .NET¡¡¡
Salvo al Jaro-Winkler no he tenido tiempo de verlos en profundidad y... como no tengo .NET tampoco he podido probar como funciona la librería esa.
Como veréis algunos están orientados a la comparación de textos (y no es lo mismo una búsqueda de diccionario, que un corrector ortográfico, que una búsqueda de nombres propios... etc...) otros a comparación de secuencias de ADN, de proteínas... o sea: un mundo.
El alfabeto puede ser tanto ABC... (para texto) como AGCT (para ADN) o aminoácidos (para las proteínas), etc, etc... y algunos algoritmos está orientados para algunas necesidades y otros para otras.
En cuanto a la función anterior ya la he modificado, la he incluído en una clase junto a la función DL (y ya le añadiré más para poder usar la que quiera según lo que se pretenda) para hacer cosas como:
También le he añadido una colección para poder hacer:Código:Dim MiCadena As mcStringMetric MiCadena.Texto = "Hola" dblResult = MiCadena.MetricaSCR("Hola Mundo") dblResult2 = MiCadena.MetricaDL("Hola Mundo")
Y obviamente la colección me sale ordenada según el método elegido.Después, en base a esa colección se puede desplegar un cuadro de diálogo para que el usuario escoja de la lista la coincidencia que prefiera. Ya he incluído todo eso en una DLL, pero todavía no funciona tan bien como debiera...Código:rst.MoveFirst Do While Not (rst.EOF) MiCadena.AddSCR rst("NombreComercial"), rst("Id") rst.MoveNext Loop
A ver si a alguien se le ocurren mejoras o sujerencias... y si algún .NETero puede probar la clase del enlace ý nos informa, mejor que mejor.
Saludos.
La doctrina en cuestión es la siguiente: no es deseable creer una proposición cuando no existe fundamento para suponer que sea cierta. [Bertrand Russell]
-
25/04/2009, 12:37 #18
Senior Member
Expert@
- Fecha de ingreso
- 23 feb, 09
- Ubicación
- Spain
- Mensajes
- 316
Sigo comentando... Si las cosas no salían muy bien era porque al poner:
MiCadena.AddSCR rst("NombreComercial"), rst("Id")
así a secas, las búsquedas no daban buenos resultados. No lo voy a explicar en detalle porque el problema se explica con la solución.
Lo que hago ahora es hacer un split (dividir en palabras) tanto al texto de búsqueda como a los que se comparan, entonces las comparo una a una y la función devuelve el promedio de los mejoresresultados obtenidos (p.ej. si el usuario escribe "productos ACME" comparo las dos palabras con todas las demás y si "productos" da 60% y "ACME" 100% retorno 80%.
Obviamente esto tiene un coste en tiempo: de ser prácticamente instantáneo he pasado a unos 3-4 segundos para una búsqueda en una BD de nombres de clientes de 1099 registros (ni demasiado grande ni demasiado pequeña)... ¡Pero así los resultados son prácticamente "googlísticos"! Siempre, siempre... lo que pretendo buscar está sino de primero muy cerca, cuando antes ni siquiera salía a veces en la primera pantalla. Estoy reduciendo lo que puedo , pero no creo que pueda bajar mucho de la mitad de ese tiempo.
También he añadido opciones para diferenciar mayúsculas de minúsculas y diferenciar tildes o no (o sea "a" que sea lo mismo que "áä--...")
Saludos.La doctrina en cuestión es la siguiente: no es deseable creer una proposición cuando no existe fundamento para suponer que sea cierta. [Bertrand Russell]
-
30/04/2009, 02:22 #19
Senior Member
Expert@
- Fecha de ingreso
- 23 feb, 09
- Ubicación
- Spain
- Mensajes
- 316
Comento un par de detalles por si a alguien se le ocurren mejoras. Que algunas cosas se complican.
1. Signos de puntuación
He añadido una opción para sustituir en las cadenas los signos de puntuación por espacios, ya que variaban los resultados.
Y no sin dudas... si alguien busca números, porque puedo no encontrar siglas (google no tiene problemas con "EEUU"/"EE.UU." y yo no sé como evitarlos).
Además no tengo claro hasta donde llega el concepto "signo de puntuación" o si seria mejor, en vez de excluir caracteres definir previamente los que acepto (p. ej. letras+números)
De momento lo he puesto así:
Private Const SIGNOS_PUNTUACION = ".,;:¡!¿?()"""
2. Tiempo
- Le he añadido un temporizador a la clase para poder informar del tiempo que llevó la búsqueda. Y como hay que ser agradecidos os pongo el enlace del que he usado (funciona perfectamente y a la primera):
http://www.elguille.info/vb/utilidades/cGetTimer.htm
- Estoy haciendo pruebas con un archivo de texto plano con cerca de 8000 frases (refranes en español). La primera vez que probé el tiempo se fue a casi ¡5 minutos! cuando yo esperaba como mucho 20/25 segundos.
Ya había optimizado la función de comparación deteniendo la exploración cuando ya no se podía encontrar una distancia menor... así que el problema estaba en otro lado y como era un aumento exponencial el problema tenía que estar en la colección.
Resulta que yo según iba obteniendo resultados recorría la colección y los colocaba en su sitio correspondiente en cuanto encontraba un elemento de valor más pequeño.
Resulta que esto se llama "Ordenamiento por inserción" y tiene una complejidad que crece con el cuadrado del nº de elementos a ordenar.
Soluciones:
a. Reducir los resultados devueltos. No se retornan los 8.000 resultados si no sólo aquellos con un ratio mayor que un valor establecido.
Lo he añadido en opciones y a partir de 0.5/0.6 ya sólo se devuelven unos cientos y el tiempo cae espectacularmente. Además, por debajo de 0.6 las coincidencias ya casi nunca son significativas.
b. Cambiar el algoritmo de ordenación. Como se van ordenando los datos según se generan el algoritmo que provisionalmente me parece mejor es el "Ordenamiento por árbol binario" (se pasa de n2 a n x log n)
c. No usar collection y pasarse a un array.
Ya he hecho a. (como es configurable entre 0 y 1 no se pierde nada), tengo pendiente b. y no sé que será mejor en cuanto a c.
Ahora mismo los tiempos de respuesta están entre 2/6 segundos para esa lista de 8.000 frasesbuscando 1-3 palabras.
O sea que si alguien tiene experiencia en métodos de ordenación o sabe algo sobre el tema array/colección... pues me vendría muy bien alguna aportación... ¡sobre eso o sobre cualquier otra cosa!... jaja
Saludos.La doctrina en cuestión es la siguiente: no es deseable creer una proposición cuando no existe fundamento para suponer que sea cierta. [Bertrand Russell]
-
22/10/2010, 04:59 #20
Junior Member
Iniciad@
- Fecha de ingreso
- 22 oct, 10
- Mensajes
- 1
Ayuda
Hola Hal9000 me podrias ayudar con este tema me podrias dar el scrip para poder comparar textos ya que pegue la sintaxis que ponen pero no me funciona o que mas tengo que hacer, como comentabas tienes algunas mejoras me las podrias pasar o en donde las puedo obtener.
Saludos y de antemano gracias
-
26/10/2010, 10:13 #21
Senior Member
Expert@
- Fecha de ingreso
- 23 feb, 09
- Ubicación
- Spain
- Mensajes
- 316
Yo creo que la de arriba funciona, pero en fin: esta es la versión que estoy usando ahora:
Código:- '---------------------------------------------------------------------------------------
- ' Proc/Func.: StringCompRatio
- ' Fecha : 20/05/2009 12:09
- ' Autor : FJGD
- ' Finalidad : Calcula la similitud entre dos Strings basándose en las distancias entre
- ' los caracteres coincidentes.
- ' Retorno : Un valor entre 0 (ninguna similitud) y 1 (coincidencia exacta)
- '---------------------------------------------------------------------------------------
- Public Function StringCompRatio(ByVal sCad1 As String, ByVal sCad2 As String) As Double
- Dim lLong1 As Long, lLong2 As Long, i As Long, j As Long, lDist As Long, lTotDist As Long
- Dim sChar As String * 1, sAux As String
- If Len(sCad1) > Len(sCad2) Then
- sAux = sCad1
- sCad1 = sCad2
- sCad2 = sAux
- End If
- lLong1 = Len(sCad1)
- lLong2 = Len(sCad2)
- If lLong1 > 0 And lLong2 > 0 Then
- 'Recorremos las cadenas
- For i = 1 To lLong1
- sChar = Mid(sCad1, i, 1)
- lDist = lLong2
- j = 1
- Do While j <= lLong2 And lDist <> 0 And j - i < lDist
- 'Si coinciden 2 caracteres vemos la distancia y nos quedamos con la menor
- If sChar = Mid(sCad2, j, 1) And Abs(j - i) < lDist Then lDist = Abs(j - i)
- j = j + 1
- Loop
- lTotDist = lTotDist + lDist
- Next
- 'La fórmula
- StringCompRatio = lLong1 / lLong2 - lTotDist / (lLong2 ^ 2)
- Else
- StringCompRatio = Abs(lLong1 = 0 And lLong2 = 0)
- End If
- End Function
Es muy parecida a la otra. Desde el año pasado dejé el tema tal cual estaba, un día de estos tendré que repasarlo todo.
Un saludo.La doctrina en cuestión es la siguiente: no es deseable creer una proposición cuando no existe fundamento para suponer que sea cierta. [Bertrand Russell]
-
27/11/2010, 23:59 #22
Junior Member
Iniciad@
- Fecha de ingreso
- 27 nov, 10
- Mensajes
- 1
Gracias Brother
Mira tu brother buscando codigo en Internet y tu ya lo habias hecho
Gracias Hermano
-
08/04/2015, 07:52 #23
Junior Member
Iniciad@
- Fecha de ingreso
- 08 abr, 15
- Mensajes
- 1
Me quito el sombrero.
Gracias por compartirlo
-
20/05/2016, 17:17 #24
Junior Member
Iniciad@
- Fecha de ingreso
- 20 may, 16
- Mensajes
- 2
Misma función, 100% .net Iniciado por HAL9000
Public Function StringCompRatio(ByVal strA As String, ByVal strB As String) As Double
Dim lngA As Long, lngB As Long, i As Integer, j As Integer, lDist As Long, lTotDist As Long
Dim strChar As String = " ", strAux As String
If strA.Length > strB.Length Then
strAux = strA
strA = strB
strB = strAux
End If
lngA = strA.Length
lngB = strB.Length
If lngA > 0 And lngB > 0 Then
For i = 1 To lngA
strChar = strA.Substring(i, 1)
lDist = lngB
j = 1
Do While j <= lngB And lDist <> 0 And j - i < lDist
If strChar = strB.Substring(j, 1) And Math.Abs(j - i) < lDist Then lDist = Math.Abs(j - i)
j = j + 1
Loop
lTotDist = lTotDist + lDist
Next
Return lngA / lngB - lTotDist / (lngB ^ 2)
Else
Return Math.Abs(CDbl(lngA = 0 And lngB = 0))
End If
End Function
-
20/05/2016, 18:22 #25
Junior Member
Iniciad@
- Fecha de ingreso
- 20 may, 16
- Mensajes
- 2
* En esta función resolví el problema .substring que está basado en 0 y no en 1 al momento de ponerse a contar los caracteres Iniciado por SysProfile
* Agregé un parámetro opcional que reemplaza símbolos como punto, coma y espacio por una cadena vacía, esto mejora cuando por ejemplo se quieren comparar Mi Empresa S.A. vs Mi Empresa SA
Código:Friend Function StringCompRatio(ByVal strA As String, ByVal strB As String, Optional ByVal strReplaceChars As String = "") As Double Dim lngA As Long, lngB As Long, i As Integer, j As Integer, lDist As Long, lTotDist As Long Dim strChar As String = " ", strAux As String If strReplaceChars <> String.Empty Then If strReplaceChars = "*" Then strReplaceChars = "~`!@#$%^&*(){}[];':<>,.?/\| " & ControlChars.Quote & ControlChars.FormFeed & ControlChars.Lf & ControlChars.NewLine & ControlChars.NullChar & ControlChars.Tab & ControlChars.Back End If For Each strCahrRepl As String In strReplaceChars strA = strA.Replace(strCahrRepl, String.Empty) strB = strB.Replace(strCahrRepl, String.Empty) Next End If If strA.Length > strB.Length Then strAux = strA strA = strB strB = strAux End If lngA = strA.Length - 1 lngB = strB.Length - 1 If lngA > 0 And lngB > 0 Then For i = 0 To lngA strChar = strA.Substring(i, 1) lDist = lngB j = 0 Do While j <= lngB And lDist <> 0 And j - i < lDist If strChar = strB.Substring(j, 1) And Math.Abs(j - i) < lDist Then lDist = Math.Abs(j - i) j = j + 1 Loop lTotDist = lTotDist + lDist Next Return lngA / lngB - lTotDist / (lngB ^ 2) Else Return Math.Abs(CDbl(lngA = 0 And lngB = 0)) End If End Function
CitarTemas similares
-
Trabajar con cadenas
Por Alon en el foro Visual Basic 6.0Respuestas: 3Último mensaje: 27/03/2009, 09:53 -
cadenas de texto
Por Ja666 en el foro Visual Basic 6.0Respuestas: 2Último mensaje: 29/08/2006, 12:37 -
tratamiento de cadenas
Por Guests en el foro Visual Basic 6.0Respuestas: 0Último mensaje: 21/04/2006, 07:16 -
Cadenas de String
Por Guests en el foro Visual Basic 6.0Respuestas: 2Último mensaje: 07/04/2006, 19:49 -
Cadenas de String
Por Guests en el foro Visual Basic 6.0Respuestas: 1Último mensaje: 07/04/2006, 19:09
