Files
Data_ScienceUse_Cases/VBA/CosineSimilarity.bas
2023-11-01 13:03:28 +07:00

51 lines
1.6 KiB
QBasic

Attribute VB_Name = "Module4"
Function SimilarityCosine(s1 As String, s2 As String) As Double
Dim words1 As Object
Set words1 = CreateObject("Scripting.Dictionary")
Dim words2 As Object
Set words2 = CreateObject("Scripting.Dictionary")
Dim i As Integer
Dim j As Integer
Dim dotProduct As Double
Dim magnitude1 As Double
Dim magnitude2 As Double
' Split the strings into words and create vectors
Dim words As Variant
words = Split(s1 & " " & s2, " ")
For i = LBound(words) To UBound(words)
If Trim(words(i)) <> "" Then
words1(Trim(words(i))) = 0
words2(Trim(words(i))) = 0
End If
Next i
' Populate the vectors
For i = LBound(words) To UBound(words)
If Trim(words(i)) <> "" Then
If i <= UBound(Split(s1, " ")) Then
words1(Trim(words(i))) = words1(Trim(words(i))) + 1
Else
words2(Trim(words(i))) = words2(Trim(words(i))) + 1
End If
End If
Next i
' Calculate dot product and magnitudes
For Each Key In words1.Keys
dotProduct = dotProduct + (words1(Key) * words2(Key))
magnitude1 = magnitude1 + (words1(Key) * words1(Key))
magnitude2 = magnitude2 + (words2(Key) * words2(Key))
Next Key
' Calculate cosine similarity
If magnitude1 * magnitude2 = 0 Then
SimilarityCosine = 0
Else
SimilarityCosine = dotProduct / (Sqr(magnitude1) * Sqr(magnitude2))
End If
End Function