Fuzzy Logic

7 May 2005 9:20 PM

Kinders David

Hello i'm looking for a sample code, for comparing 2 strings. and return the
% off identical.

Thx.

7 May 2005 10:33 PM

Jim Edgar

"Kinders David" <dav***@home.nl> wrote in message
news:tiafe.84699$qN4.5315708@phobos.telenet-ops.be...
> Hello i'm looking for a sample code, for comparing 2 strings. and return
the
> % off identical.
>
> Thx.
>
>

Here's something that will get you started. See if you follow the logic
then see if you can condense and shorten the code.

Option Explicit

Private Sub Form_Load()
    MsgBox "%" & CompStrings("abc efg", "abcdefghi")
End Sub

Function CompStrings(strFirst As String, _
                     strSecond As String) _
                     As Single
    Dim lLenFirst As Long
    Dim lLenSecond As Long
    Dim lCnt As Long, lCntr As Long
    lLenFirst = Len(strFirst)
    lLenSecond = Len(strSecond)
    If lLenFirst = lLenSecond Then
        CompStrings = 100
    Else
        If lLenFirst > lLenSecond Then
            If lLenSecond > 0 Then
                For lCnt = 1 To lLenSecond
                    If Mid$(strFirst, lCnt, 1) = Mid$(strSecond, lCnt, 1)
Then
                        lCntr = lCntr + 1
                    End If
                Next
                CompStrings = (lCntr / lLenFirst) * 100
            End If
        Else
            If lLenFirst > 0 Then
                For lCnt = 1 To lLenFirst
                    If Mid$(strFirst, lCnt, 1) = Mid$(strSecond, lCnt, 1)
Then
                        lCntr = lCntr + 1
                    End If
                Next
                CompStrings = (lCntr / lLenSecond) * 100
            End If
        End If
    End If
End Function

HTH,

Jim Edgar

8 May 2005 1:02 PM

Kinders David

Show quote

"Jim Edgar @cox.net>" <djedgar<removethis> schreef in bericht
news:OKYSWT1UFHA.3544@TK2MSFTNGP10.phx.gbl...
>
> "Kinders David" <dav***@home.nl> wrote in message
> news:tiafe.84699$qN4.5315708@phobos.telenet-ops.be...
>> Hello i'm looking for a sample code, for comparing 2 strings. and return
> the
>> % off identical.
>>
>> Thx.
>>
>>
> Here's something that will get you started. See if you follow the logic
> then see if you can condense and shorten the code.
>
> Option Explicit
>
> Private Sub Form_Load()
>    MsgBox "%" & CompStrings("abc efg", "abcdefghi")
> End Sub
>
> Function CompStrings(strFirst As String, _
>                     strSecond As String) _
>                     As Single
>    Dim lLenFirst As Long
>    Dim lLenSecond As Long
>    Dim lCnt As Long, lCntr As Long
>    lLenFirst = Len(strFirst)
>    lLenSecond = Len(strSecond)
>    If lLenFirst = lLenSecond Then
>        CompStrings = 100
>    Else
>        If lLenFirst > lLenSecond Then
>            If lLenSecond > 0 Then
>                For lCnt = 1 To lLenSecond
>                    If Mid$(strFirst, lCnt, 1) = Mid$(strSecond, lCnt, 1)
> Then
>                        lCntr = lCntr + 1
>                    End If
>                Next
>                CompStrings = (lCntr / lLenFirst) * 100
>            End If
>        Else
>            If lLenFirst > 0 Then
>                For lCnt = 1 To lLenFirst
>                    If Mid$(strFirst, lCnt, 1) = Mid$(strSecond, lCnt, 1)
> Then
>                        lCntr = lCntr + 1
>                    End If
>                Next
>                CompStrings = (lCntr / lLenSecond) * 100
>            End If
>        End If
>    End If
> End Function
>
> HTH,
>
> Jim Edgar
>

First, thanks for the code.

The code works fine with small strings, but when i using someting like.
"Will Tura - Sill en de baby" and compare it with "Wil Tura - Sill en de
baby" i get a identical % off 14,81481%.
But this is almost the same.

Thanks,
David

9 May 2005 12:03 AM

Jim Edgar

> First, thanks for the code.
>
> The code works fine with small strings, but when i using someting like.
> "Will Tura - Sill en de baby" and compare it with "Wil Tura - Sill en de
> baby" i get a identical % off 14,81481%.
> But this is almost the same.
>
> Thanks,
> David
>

From your original post I thought you were comparing strings, not sentences.
It gets a lot more complicated as Juergen points out because you need to
compare each word of the sentence. Here's something to get you started. The
code needs more conditional testing and error checking. Watch for
word-wrapping.

Option Explicit

Private Sub Form_Load()
    MsgBox "%" & CompSentences("Will Tura - Sill en de baby", _
                               "Wil Tura - Sill en de baby")
End Sub

Function CompSentences(ByVal strFirst As String, _
                       ByVal strSecond As String) _
                       As Single
    Dim lLenFirst As Long
    Dim lLenSecond As Long
    Dim lCnt As Long, lCntr As Long, sngTotal As Single
    Dim vFirst
    Dim vSecond
    Do While InStr(strFirst, " ") > 1
        strFirst = Replace(strFirst, " ", " ")
    Loop
    Do While InStr(strSecond, " ") > 1
        strSecond = Replace(strSecond, " ", " ")
    Loop
    vFirst = Split(strFirst)
    vSecond = Split(strSecond)
    lLenFirst = UBound(vFirst)
    lLenSecond = UBound(vSecond)
    If lLenFirst = 0 And lLenSecond = 0 Then
        CompSentences = 100
    Else
        If lLenFirst > lLenSecond Then
            If lLenSecond > 0 Then
                For lCnt = LBound(vSecond) To lLenSecond
                    sngTotal = sngTotal + CompStrings(vFirst(lCnt), _
                                                    vSecond(lCnt))
                Next
            End If
            CompSentences = sngTotal / (lCnt + 1)
        Else
            If lLenFirst > 0 Then
                For lCnt = LBound(vFirst) To lLenFirst
                    sngTotal = sngTotal + CompStrings(vFirst(lCnt), _
                                                    vSecond(lCnt))
                Next
            End If
            CompSentences = sngTotal / (lCnt + 1)
        End If
    End If
End Function

Function CompStrings(ByVal strFirst As String, _
                     ByVal strSecond As String) _
                     As Single
    Dim lLenFirst As Long
    Dim lLenSecond As Long
    Dim lCnt As Long, lCntr As Long
    lLenFirst = Len(strFirst)
    lLenSecond = Len(strSecond)
    If lLenFirst = 0 And lLenSecond = 0 Then
        CompStrings = 100
    Else
        If lLenFirst > lLenSecond Then
            If lLenSecond > 0 Then
                For lCnt = 1 To lLenSecond
                    If Mid$(strFirst, lCnt, 1) = Mid$(strSecond, lCnt, 1) Then
                        lCntr = lCntr + 1
                    End If
                Next
                CompStrings = (lCntr / lLenFirst) * 100
            End If
        Else
            If lLenFirst > 0 Then
                For lCnt = 1 To lLenFirst
                    If Mid$(strFirst, lCnt, 1) = Mid$(strSecond, lCnt, 1) Then
                        lCntr = lCntr + 1
                    End If
                Next
                CompStrings = (lCntr / lLenSecond) * 100
            End If
        End If
    End If
End Function

Jim Edgar

12 May 2005 10:19 PM

Kinders David

Show quote

"Jim Edgar" <JimEd***@discussions.microsoft.com> schreef in bericht
news:0F4F652F-BFA2-427F-906C-DD870ADC665B@microsoft.com...
>> First, thanks for the code.
>>
>> The code works fine with small strings, but when i using someting like.
>> "Will Tura - Sill en de baby" and compare it with "Wil Tura - Sill en de
>> baby" i get a identical % off 14,81481%.
>> But this is almost the same.
>>
>> Thanks,
>> David
>>
>
> From your original post I thought you were comparing strings, not
> sentences.
> It gets a lot more complicated as Juergen points out because you need to
> compare each word of the sentence. Here's something to get you started.
> The
> code needs more conditional testing and error checking. Watch for
> word-wrapping.
>
> Option Explicit
>
> Private Sub Form_Load()
>    MsgBox "%" & CompSentences("Will Tura - Sill en de baby", _
>                               "Wil Tura - Sill en de baby")
> End Sub
>
> Function CompSentences(ByVal strFirst As String, _
>                       ByVal strSecond As String) _
>                       As Single
>    Dim lLenFirst As Long
>    Dim lLenSecond As Long
>    Dim lCnt As Long, lCntr As Long, sngTotal As Single
>    Dim vFirst
>    Dim vSecond
>    Do While InStr(strFirst, " ") > 1
>        strFirst = Replace(strFirst, " ", " ")
>    Loop
>    Do While InStr(strSecond, " ") > 1
>        strSecond = Replace(strSecond, " ", " ")
>    Loop
>    vFirst = Split(strFirst)
>    vSecond = Split(strSecond)
>    lLenFirst = UBound(vFirst)
>    lLenSecond = UBound(vSecond)
>    If lLenFirst = 0 And lLenSecond = 0 Then
>        CompSentences = 100
>    Else
>        If lLenFirst > lLenSecond Then
>            If lLenSecond > 0 Then
>                For lCnt = LBound(vSecond) To lLenSecond
>                    sngTotal = sngTotal + CompStrings(vFirst(lCnt), _
>                                                    vSecond(lCnt))
>                Next
>            End If
>            CompSentences = sngTotal / (lCnt + 1)
>        Else
>            If lLenFirst > 0 Then
>                For lCnt = LBound(vFirst) To lLenFirst
>                    sngTotal = sngTotal + CompStrings(vFirst(lCnt), _
>                                                    vSecond(lCnt))
>                Next
>            End If
>            CompSentences = sngTotal / (lCnt + 1)
>        End If
>    End If
> End Function
>
> Function CompStrings(ByVal strFirst As String, _
>                     ByVal strSecond As String) _
>                     As Single
>    Dim lLenFirst As Long
>    Dim lLenSecond As Long
>    Dim lCnt As Long, lCntr As Long
>    lLenFirst = Len(strFirst)
>    lLenSecond = Len(strSecond)
>    If lLenFirst = 0 And lLenSecond = 0 Then
>        CompStrings = 100
>    Else
>        If lLenFirst > lLenSecond Then
>            If lLenSecond > 0 Then
>                For lCnt = 1 To lLenSecond
>                    If Mid$(strFirst, lCnt, 1) = Mid$(strSecond, lCnt, 1)
> Then
>                        lCntr = lCntr + 1
>                    End If
>                Next
>                CompStrings = (lCntr / lLenFirst) * 100
>            End If
>        Else
>            If lLenFirst > 0 Then
>                For lCnt = 1 To lLenFirst
>                    If Mid$(strFirst, lCnt, 1) = Mid$(strSecond, lCnt, 1)
> Then
>                        lCntr = lCntr + 1
>                    End If
>                Next
>                CompStrings = (lCntr / lLenSecond) * 100
>            End If
>        End If
>    End If
> End Function
>
> Jim Edgar
Thaks Jim,

This is the same, de sentences are 100% identical but the program say's
"87.5%".
i don't get it, whats wrong?.

David

13 May 2005 9:18 AM

Ben Amada

Kinders David wrote:

>> Private Sub Form_Load()
>> MsgBox "%" & CompSentences("Will Tura - Sill en de baby", _
>> "Wil Tura - Sill en de baby")
>> End Sub

> This is the same, de sentences are 100% identical but the program say's
> "87.5%".
> i don't get it, whats wrong?.

The first sentence starts off "Will" and the second sentence starts off
"Wil"
(they're not identical) :)

Ben

13 May 2005 9:21 AM

Ben Amada

Ben Amada wrote:

> The first sentence starts off "Will" and the second sentence starts off
> "Wil"
> (they're not identical) :)

Oops, I spoke too early! You're right, even if you make the sentences the
same, you get 87.5%.

15 May 2005 6:00 PM

Jim Edgar

<snip>

> Thaks Jim,
>
> This is the same, de sentences are 100% identical but the program say's
> "87.5%".
> i don't get it, whats wrong?.
>
> David
>

The problem was with the counter variable. This should work. By the way,
I'm typing this code off the top of my head and it probably needs extra
testing and validation. Feel free to use it any way you want but if you're
going to include it in a production application then you'll need to do
further testing and tweaking. Hope this helps.

Option Explicit

Private Sub Form_Load()
    MsgBox "%" & CompSentences("Will Tura - Sill en de baby", _
                               "Wil Tura - Sill en de baby")
End Sub

Function CompSentences(ByVal strFirst As String, _
                       ByVal strSecond As String) _
                       As Single
    Dim lLenFirst As Long
    Dim lLenSecond As Long
    Dim lCnt As Long, lCntr As Long, sngTotal As Single, lCounter As Long
    Dim vFirst
    Dim vSecond
    Do While InStr(strFirst, " ") > 1
        strFirst = Replace(strFirst, " ", " ")
    Loop
    Do While InStr(strSecond, " ") > 1
        strSecond = Replace(strSecond, " ", " ")
    Loop
    vFirst = Split(strFirst)
    vSecond = Split(strSecond)
    lLenFirst = UBound(vFirst)
    lLenSecond = UBound(vSecond)
    If lLenFirst = 0 And lLenSecond = 0 Then
        CompSentences = 100
    Else
        If lLenFirst > lLenSecond Then
            If lLenSecond > 0 Then
                For lCnt = LBound(vSecond) To lLenSecond
                    sngTotal = sngTotal + CompStrings(vFirst(lCnt), _
                                                    vSecond(lCnt))
                Next
            End If
            CompSentences = sngTotal / (lCnt + 1)
        Else
            If lLenFirst > 0 Then
                For lCnt = LBound(vFirst) To lLenFirst
                    lCounter = lCounter + 1
                    sngTotal = sngTotal + CompStrings(vFirst(lCnt), _
                                                    vSecond(lCnt))
                Next
            End If
            CompSentences = sngTotal / lCounter
        End If
    End If
End Function

Function CompStrings(ByVal strFirst As String, _
                     ByVal strSecond As String) _
                     As Single
    Dim lLenFirst As Long
    Dim lLenSecond As Long
    Dim lCnt As Long, lCntr As Long
    lLenFirst = Len(strFirst)
    lLenSecond = Len(strSecond)
    If lLenFirst = 0 And lLenSecond = 0 Then
        CompStrings = 100
    Else
        If lLenFirst > lLenSecond Then
            If lLenSecond > 0 Then
                For lCnt = 1 To lLenSecond
                    If Mid$(strFirst, lCnt, 1) = Mid$(strSecond, lCnt, 1) Then
                        lCntr = lCntr + 1
                    End If
                Next
                CompStrings = (lCntr / lLenFirst) * 100
            End If
        Else
            If lLenFirst > 0 Then
                For lCnt = 1 To lLenFirst
                    If Mid$(strFirst, lCnt, 1) = Mid$(strSecond, lCnt, 1) Then
                        lCntr = lCntr + 1
                    End If
                Next
                CompStrings = (lCntr / lLenSecond) * 100
            End If
        End If
    End If
End Function

Jim Edgar

16 May 2005 3:14 AM

Kinders David

Show quote

"Jim Edgar" <JimEd***@discussions.microsoft.com> schreef in bericht
news:56922FC9-1F0C-44F5-8988-D6EA6333623A@microsoft.com...
> <snip>
>> Thaks Jim,
>>
>> This is the same, de sentences are 100% identical but the program say's
>> "87.5%".
>> i don't get it, whats wrong?.
>>
>> David
>>
>
> The problem was with the counter variable. This should work. By the way,
> I'm typing this code off the top of my head and it probably needs extra
> testing and validation. Feel free to use it any way you want but if
> you're
> going to include it in a production application then you'll need to do
> further testing and tweaking. Hope this helps.
>
> Option Explicit
>
> Private Sub Form_Load()
>    MsgBox "%" & CompSentences("Will Tura - Sill en de baby", _
>                               "Wil Tura - Sill en de baby")
> End Sub
>
> Function CompSentences(ByVal strFirst As String, _
>                       ByVal strSecond As String) _
>                       As Single
>    Dim lLenFirst As Long
>    Dim lLenSecond As Long
>    Dim lCnt As Long, lCntr As Long, sngTotal As Single, lCounter As Long
>    Dim vFirst
>    Dim vSecond
>    Do While InStr(strFirst, " ") > 1
>        strFirst = Replace(strFirst, " ", " ")
>    Loop
>    Do While InStr(strSecond, " ") > 1
>        strSecond = Replace(strSecond, " ", " ")
>    Loop
>    vFirst = Split(strFirst)
>    vSecond = Split(strSecond)
>    lLenFirst = UBound(vFirst)
>    lLenSecond = UBound(vSecond)
>    If lLenFirst = 0 And lLenSecond = 0 Then
>        CompSentences = 100
>    Else
>        If lLenFirst > lLenSecond Then
>            If lLenSecond > 0 Then
>                For lCnt = LBound(vSecond) To lLenSecond
>                    sngTotal = sngTotal + CompStrings(vFirst(lCnt), _
>                                                    vSecond(lCnt))
>                Next
>            End If
>            CompSentences = sngTotal / (lCnt + 1)
>        Else
>            If lLenFirst > 0 Then
>                For lCnt = LBound(vFirst) To lLenFirst
>                    lCounter = lCounter + 1
>                    sngTotal = sngTotal + CompStrings(vFirst(lCnt), _
>                                                    vSecond(lCnt))
>                Next
>            End If
>            CompSentences = sngTotal / lCounter
>        End If
>    End If
> End Function
>
> Function CompStrings(ByVal strFirst As String, _
>                     ByVal strSecond As String) _
>                     As Single
>    Dim lLenFirst As Long
>    Dim lLenSecond As Long
>    Dim lCnt As Long, lCntr As Long
>    lLenFirst = Len(strFirst)
>    lLenSecond = Len(strSecond)
>    If lLenFirst = 0 And lLenSecond = 0 Then
>        CompStrings = 100
>    Else
>        If lLenFirst > lLenSecond Then
>            If lLenSecond > 0 Then
>                For lCnt = 1 To lLenSecond
>                    If Mid$(strFirst, lCnt, 1) = Mid$(strSecond, lCnt, 1)
> Then
>                        lCntr = lCntr + 1
>                    End If
>                Next
>                CompStrings = (lCntr / lLenFirst) * 100
>            End If
>        Else
>            If lLenFirst > 0 Then
>                For lCnt = 1 To lLenFirst
>                    If Mid$(strFirst, lCnt, 1) = Mid$(strSecond, lCnt, 1)
> Then
>                        lCntr = lCntr + 1
>                    End If
>                Next
>                CompStrings = (lCntr / lLenSecond) * 100
>            End If
>        End If
>    End If
> End Function
>
> Jim Edgar

This works file, THANKS Jim.

Reg,
David