[AccessD] "fuzzy logic" search

Stewart,

With the outlined changes, the code is working GREAT!!!  The speed is very
good on my system, which is not representative of my client unfortunately
since they are on a network with 30 people and using 500 mhz PIII computers.

I did want you to know that from very preliminary testing this code finds
two digit changes, transpositions etc.  Cool stuff!

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