[AccessD] "fuzzy logic" search

Stewart,

The code doesn't compile.  Loopcount doesn't exist and basestring in
checksum.

I dimmed the loopcount as int local, and am assuming that basestr is
actually teststr?

And of course an actual match should also match which it currently doesn't.
Cool function though!  I'm testing it now.

John W. Colby
www.colbyconsulting.com

-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com]On Behalf Of Stuart
McLachlan
Sent: Wednesday, October 22, 2003 8:01 AM
To: Access Developers discussion and problem solving
Subject: Re: [AccessD] "fuzzy logic" search


On 21 Oct 2003 at 22:58, MartyConnelly wrote:

> Why not use a weighted checksum like the ISBN number, it will also
> indicated the position of a single substitution error and I think the
> location of a single transposition error.
>

Too many potential false matches

Combining HammingDistance with a straight Checksum seems to work
quite well though. Here's what I've come up with to test for a single
miskey or a transposition error:

Function HammingDistance(BaseString As String, TestString As String) As Long
Dim lngHamCount As Long
Dim lngLen As Long
lngLen = Len(BaseString)
If Len(TestString) <> lngLen Then
    HammingDistance = -1
    Exit Function
Else
  For loopcount = 1 To lngLen
     If Mid$(BaseString, loopcount, 1) <> Mid$(TestString, loopcount, 1)
Then
        lngHamCount = lngHamCount + 1
     End If
  Next
End If
HammingDistance = lngHamCount
End Function

Function CheckSum(TestString) As Long
Dim lngCheck As Long
For loopcount = 1 To Len(BaseString)
   lngCheck = lngCheck + Asc(Mid$(TestString, loopcount, 1))
Next
End Function

Function PossibleMatch(BaseString As String, TestString As String) As
Boolean
Select Case HammingDistance(BaseString, TestString)
    Case 1 ' Miskey?
       PossibleMatch = True
    Case 2  'Possible transposition?
       If CheckSum(BaseString) = CheckSum(TestString) Then
           PossibleMatch = True
       End If
    Case Else
       PossibleMatch = False
End Select
End Function
--
Lexacorp Ltd
http://www.lexacorp.com.pg
Information Technology Consultancy, Software Development,System Support.



_______________________________________________
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com