Difference Algorithms

[dandoescode]

Anybody have any experience with writing difference algorithms in Access? I'd like to come up with one to compare a column of hash values. I havent been able to find any examples or information thus far, but maybe I'm just looking in the wrong places.

[June7]

Google: VB difference algorithm

Is this what you are looking for: http://www.codeproject.com/Articles/...sual-Basic-NET

[dandoescode]

Very cool! Turns out what I was looking for wasnt as much a difference algorithm as a Levenshtein distance formula. So far I've come up with a form that computes the distance between two input strings, now to figure out how to compare one value against an entire column of data.

Heres the form code in case anyones interested, please excuse the poor formatting.

Option Compare Database

Private Sub Go_Click()

Dim hash1 As String
Dim hash2 As String
Dim s As Variant
Dim t As Variant
Dim d As Variant
Dim m, n
Dim i, j, k
Dim a(2), r
Dim cost

hash1 = Me.hashOne
hash2 = Me.hashTwo
If StrComp(hash1, hash2) = 0 Then
    MsgBox "Identical hash."
End If
If StrComp(hash1, hash2) > 0 Then
    MsgBox "Hash codes non identical."
End If
If StrComp(hash1, hash2) < 0 Then
    MsgBox "Hash codes non identical."
End If
m = Len(hash1)
n = Len(hash2)
ReDim s(m) ' Dimension Array
ReDim t(n)
ReDim d(m, n)
For i = 1 To m
    s(i) = Mid(hash1, i, 1)
Next
For i = 1 To n
    t(i) = Mid(hash2, i, 1)
Next
For i = 0 To m
    d(i, 0) = i
Next
For j = 0 To n
    d(0, j) = j
Next
For i = 1 To m
    For j = 1 To n
        If s(i) = t(j) Then 'Char Values identical
            cost = 0
        Else
            cost = 1
        End If
        a(0) = d(i - 1, j) + 1 '' deletion
        a(1) = d(i, j - 1) + 1 '' insertion
        a(2) = d(i - 1, j - 1) + cost '' substitution
        r = a(0)
        For k = 1 To UBound(a)
            If a(k) < r Then r = a(k)
        Next
        d(i, j) = r
    Next
Next

Distance = d(m, n)

MsgBox ("Distance " & Distance)

End Sub

[June7]

Use code tags as my edit of your post shows and indentation will be preserved when you paste code.

You want to compare result to values in table field? A simple DLookup might be all you need.

[dandoescode]

I used a while loop over the Tables Index, probably not the most efficient way to do it haha.

[dandoescode]

And heres the code I've come up with to evaluate two find matches between two coloumns of strings. It works on small data sets but when I try to apply it to the data I'm interested in, where each table has about 1500 string entries Access becomes unresponsive.

Option Compare Database

Private Sub Go_Click()

Dim tableOne, tableTwo As String
Dim tableOneId, tableTwoId As Integer
Dim strOne, strTwo As String                'Declare Variables
Dim s As Variant
Dim t As Variant
Dim d As Variant
Dim m, n
Dim i, j, k
Dim a(2), r
Dim cost
Dim maxIdOne, maxIdTwo As Integer
Dim mydb As Database
Dim rst As DAO.Recordset
Dim Distance, MinDistance

tableOne = Me.tableOne                              'Grab Table Values from Form
tableTwo = Me.tableTwo                              ' And Initialize Variables

maxIdOne = DMax("ID", tableOne)
maxIdTwo = DMax("ID", tableTwo)

Set mydb = CurrentDb()
Set rst = mydb.OpenRecordset("strValueAn")

tableOneId = 1
tableTwoId = 1

        Do While tableOneId < maxIdOne + 1          ' Outer Do Loop cycles through strOne values
        
                strOne = Nz(DLookup("strValue", tableOne, "ID = " & tableOneId), 0)
                m = Len(strOne)
                
                Do While tableTwoId < maxIdTwo + 1  ' Inner Do Loop compares each strOne value against all strTwo values, looking for the closest match
                
                        strTwo = Nz(DLookup("strValue", tableTwo, "ID = " & tableTwoId), 0)
                        n = Len(strTwo)
                        
                         ReDim s(m)                       ' Dimension Array
           ReDim t(n)
           ReDim d(m, n)
        
           For i = 1 To m
               s(i) = Mid(strOne, i, 1)
           Next
        
           For i = 1 To n
               t(i) = Mid(strTwo, i, 1)
           Next
        
           For i = 0 To m
               d(i, 0) = i
           Next
        
           For j = 0 To n
               d(0, j) = j
           Next
        
        
           For i = 1 To m
               For j = 1 To n
        
                   If s(i) = t(j) Then                'Char Values identical
                       cost = 0
                   Else
                       cost = 1
                   End If
        
                   a(0) = d(i - 1, j) + 1             '' deletion
                   a(1) = d(i, j - 1) + 1             '' insertion
                   a(2) = d(i - 1, j - 1) + cost      '' substitution
        
                   r = a(0)
        
                   For k = 1 To UBound(a)
                       If a(k) < r Then r = a(k)
                   Next
        
                   d(i, j) = r
        
               Next
        
           Next
        
           Distance = d(m, n)
           
           If tableTwoId = 1 Then
               
               MinDistance = Distance
               strImportant = strTwo
               
               End If
               
               If tableTwoId > 1 Then
               
               If Distance < MinDistance Then
               
               MinDistance = Distance
                strImportant = strTwo
                        
                        
                        
                        End If
                        End If
                        
                        rst.AddNew
                        rst![tableOneId] = tableOneId
                        rst![tableTwoId] = tableTwoId
                        rst![strOne] = strOne
                        rst![strTwo] = strImportant
                        rst![Distance] = Distance
                        rst.Update
                        
                tableTwoId = tableTwoId + 1
                
                Loop
        
        tableTwoId = 1
        
        tableOneId = tableOneId + 1
        
        Loop


End Sub

[June7]

Don't know data so can't say, but 1500 isn't very many so don't know why the code fails. Still wonder if simple DLookup would serve.
If you want to provide project, I will look at. Follow instructions at bottom of my post.