Data_ScienceUse_Cases/VBA/SorensenDiceSimilarity.bas

Attribute VB_Name = "Module3"
Function SimilaritySorensenDiceCoef(s1 As String, s2 As String) As Double
    Dim set1 As Object
    Set set1 = CreateObject("Scripting.Dictionary")
    
    Dim set2 As Object
    Set set2 = CreateObject("Scripting.Dictionary")
    
    Dim i As Integer
    
    ' Create sets of characters from both strings
    For i = 1 To Len(s1)
        set1(Mid(s1, i, 1)) = 1
    Next i
    
    For i = 1 To Len(s2)
        set2(Mid(s2, i, 1)) = 1
    Next i
    
    ' Calculate the size of the intersection of the sets
    Dim intersectionSize As Integer
    intersectionSize = 0
    
    For Each Key In set1.Keys
        If set2.Exists(Key) Then
            intersectionSize = intersectionSize + 1
        End If
    Next Key
    
    ' Calculate the Sørensen-Dice coefficient
    Dim coefficient As Double
    
    If set1.Count + set2.Count = 0 Then
        coefficient = 1
    Else
        coefficient = 2 * intersectionSize / (set1.Count + set2.Count)
    End If
    
    SimilaritySorensenDiceCoef = coefficient
End Function