Hola a todos, os presento mi utlima funcion :
Check_Similar_Words- ¿Que hace?
Busca palabras similares en una cadena de texto, obtendrias un resultado similar al tipico de Google : "Quizas quiso decir... " - ¿Como funciona?
Lo que hace es alamcenar en un array todas las palabras que encuentre en la cadena a analizar, una vez aqui, descompongo la palabra que se busca en las partes correspondientes a el número de coincidencias que queramos buscar, os voy a poner un ejemplo:
Supongamos que se desea buscar la palabra "mañana", y indicamos a la funcion que busque palabras similares con 3 coincidencias, entonces se partiria la palabra a buscar de esta manera:
mañ
aña
ñan
ana
La formula para sacar el numero de fragmentos es esta:
(x - n) + 1Donde
x es la cantidad de digitos de la palabra y
n los digitos en los que se quiere separar esa palabra...
Comprobaria si las palabras de la cadena contienen algunos de estos trozos y las guarda en mi
Collection.
Lo divertido es que segun el número de coincidencias que pongamos, la busqueda sera mas o menos estricta. :laugh:
- Bueno aqui os dejo el codigo:
'=========================================================
' *Function : Check_Similar_Words
' *Author : *PsYkE1*
' *Mail : vbpsyke1@mixmail.com
' *Date : 19/6/10
' *Purpose : Returns similar to the words entered in the
' function after the word entered
' *Recommended Websites :
' http://foro.rthacker.net/
' http://InfrAngeluX.Sytes.Net/
'=========================================================
Option Explicit
Option Base 0
Public Function Check_Similar_Words(ByVal sStringToAnalyze As String, ByVal sWord As String, ByVal bvComparationLevel As Byte) As Collection
Const sInvalidChar As String = ",'.)(=/&%?¿¡!#¨><:;""-\|{}^[]*+·ªº"
Dim cTemp As New Collection
Dim sCompareWord() As String
Dim sTextWord() As String
Dim x As Long
Dim y As Long
If (bvComparationLevel < Len(sWord)) And (InStr(sWord, Chr$(32)) = 0) And (InStr(sInvalidChar, sWord) = 0) Then
y = 1
ReDim sCompareWord((Len(sWord) - bvComparationLevel) + 1)
While x <> UBound(sCompareWord)
sCompareWord(x) = Mid$(sWord, y, bvComparationLevel)
y = y + 1: x = x + 1
Wend
For x = 1 To Len(sInvalidChar)
sStringToAnalyze = Replace$(sStringToAnalyze, Mid$(sInvalidChar, x, 1), vbNullString)
Next
sStringToAnalize = Replace$(sStringToAnalyze, vbCrLf, Chr$(32))
sTextWord() = Split(sStringToAnalyze, Chr$(32))
For x = 0 To UBound(sTextWord)
If Len(sTextWord(x)) >= bvComparationLevel Then
For y = 0 To UBound(sCompareWord) - 1
If (InStr(1, sTextWord(x), sCompareWord(y), vbTextCompare) > 0) And (sWord <> sTextWord(x)) Then
On Error Resume Next
cTemp.Add sTextWord(x), sTextWord(x)
End If
Next
End If
Next
End If
Set Check_Similar_Words = cTemp
End Function- Un ejemplo práctico:
Tengo en un TextBox(llamado Text1) esto:
La inspiración de Cervantes para componer esta obra vino, al parecer, del llamado Entremés de los romances, que era de fecha anterior (aunque esto es discutido). Su argumento ridiculiza a un labrador que enloquece creyéndose héroe de romances. El labrador abandonó a su mujer, y se echó a los caminos, como hizo Don Quijote. Este entremés posee una doble lectura: también es una crítica a Lope de Vega; quien, después de haber compuesto numerosos romances autobiográficos en los que contaba sus amores, abandonó a su mujer y marchó a la Armada Invencible. Es conocido el interés de Cervantes por el Romancero y su resentimiento por haber sido echado de los teatros por el mayor éxito de Lope de Vega, así como su carácter de gran entremesista. Un argumento a favor de esta hipótesis sería el hecho de que, a pesar de que el narrador nos dice que Don Quijote ha enloquecido a causa de la lectura de libros de caballerías, durante su primera salida recita romances constantemente, sobre todo en los momentos de mayor desvarío. Por todo ello, podría ser una hipótesis verosímil. A este influjo se agregó el de Tirante el Blanco de Joanot Martorell, el del Morgante de Luigi Pulci y el del Orlando Furioso de Ludovico Ariosto.
Para ver un ejemplo:
Private Sub Form_Load()
Dim vItem As Variant
Dim sString As String
sString = Text1.Text
For Each vItem In Check_Similar_Words(sString, "argumento", 3)
Debug.Print vItem
Next vItem
End SubY obtengo esto:
Entremés
numerosos
resentimiento
entremesista
constantemente
momentos
En cambio si en vez de
3 pongo
4 en la llamada la busqueda de palabras similares se vuelve más extricta y obtendria esto:
resentimiento
constantemente
momentos
Espero que os haya gustado!
Pd: Posteado originalmente aqui:
http://foro.rthacker.net/programacion-visual-basic/%28src%29-%28function%29-check_similar_words-%28by-*psyke1*%29/
Salu2!
