V
vothanhthu
Guest
1. Giới thiệu hàm
Trong lúc lập hàm sử dụng cho các bài toán, chúng ta không ít lần muốn có một hàm có thể so sánh sự giống/khác nhau giữa 2 chuỗi kí tự, mình cũng đã gặp rất nhiều lần như thế, nên hôm nay mình xin chia sẽ lại bài viết của Alain bằng cách áp dụng Levenshtein Distance để so sánh sự giống và khác nhau giữa 2 chuỗi kí tự
Toàn bộ code của Function này:
2. Một số ví dụ minh họa cho dễ hiểu
2.1. Hàm valuePhrase
Hàm sẽ có dạng valuePhrase(Chuỗi 1,Chuỗi 2)
Hàm này sẽ so sánh khác nhau giữa 2 chuỗi kí tự, kết quả trả về sẽ là số kí tự khác nhau trong 2 chuỗi, xem ví dụ minh họa cho dễ hiểu nha.
2.2. Hàm valueWords
Hàm sẽ có dạng valueWords(Chuỗi 1,Chuỗi 2)
Hàm này sẽ so sánh khác nhau giữa các kí tự trong một chuỗi kí tự liền nhau nằm giữa các khoảng trống. kết quả trả về sẽ là số kí tự khác nhau giữa 2 chuỗi này. Xem ví dụ mình sẽ giải thích kỹ hơn.
Ở ví vụ, mình tô màu xanh là 2 sự giống nhau của 2 chuỗi, màu đỏ và đen là sự khác nhau giữa 2 chuỗi.
Mình ví dụ công thức ở ô D3, Bạn thấy 2 chuỗi này có chuỗi tuhoc là giống nhau, và có 3 ki tự khác nhau (vba và _vb), kết quả là 3.
Ở ví dụ ô D4, dù trong chuỗi 2 có .net là khác chuỗi 1, nhưng chuỗi tuhocvba là chuỗi nhiều kí tự liên tiếp giống nhau nhất (không tính khoảng trống). Có nghĩ là, bên chuỗi 2 CÓ CHỨA chuỗi tuhocvba giống hoàn toàn với chuỗi tuhocvba bên chuỗi 1, nên kết quả =0.
Tất cả giải thích về nguyên lý hoạt động code nằm hết trong nguồn, các bạn đọc tham khảo nhé.
Nguồn:
Trong lúc lập hàm sử dụng cho các bài toán, chúng ta không ít lần muốn có một hàm có thể so sánh sự giống/khác nhau giữa 2 chuỗi kí tự, mình cũng đã gặp rất nhiều lần như thế, nên hôm nay mình xin chia sẽ lại bài viết của Alain bằng cách áp dụng Levenshtein Distance để so sánh sự giống và khác nhau giữa 2 chuỗi kí tự
Toàn bộ code của Function này:
Mã:
Public Function valuePhrase#(ByRef S1$, ByRef S2$)
valuePhrase = LevenshteinDistance(S1, S2)
End Function
Public Function valueWords#(ByRef S1$, ByRef S2$)
Dim wordsS1$(), wordsS2$()
wordsS1 = SplitMultiDelims(S1, " _-")
wordsS2 = SplitMultiDelims(S2, " _-")
Dim Word1%, Word2%, thisD#, wordbest#
Dim wordsTotal#
For Word1 = LBound(wordsS1) To UBound(wordsS1)
wordbest = Len(S2)
For Word2 = LBound(wordsS2) To UBound(wordsS2)
thisD = LevenshteinDistance(wordsS1(Word1), wordsS2(Word2))
If thisD < wordbest Then wordbest = thisD
If thisD = 0 Then GoTo foundbest
Next Word2
foundbest:
wordsTotal = wordsTotal + wordbest
Next Word1
valueWords = wordsTotal
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' SplitMultiDelims
' This function splits Text into an array of substrings, each substring
' delimited by any character in DelimChars. Only a single character
' may be a delimiter between two substrings, but DelimChars may
' contain any number of delimiter characters. It returns a single element
' array containing all of text if DelimChars is empty, or a 1 or greater
' element array if the Text is successfully split into substrings.
' If IgnoreConsecutiveDelimiters is true, empty array elements will not occur.
' If Limit greater than 0, the function will only split Text into 'Limit'
' array elements or less. The last element will contain the rest of Text.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function SplitMultiDelims(ByRef Text As String, ByRef DelimChars As String, _
Optional ByVal IgnoreConsecutiveDelimiters As Boolean = False, _
Optional ByVal Limit As Long = -1) As String()
Dim ElemStart As Long, N As Long, M As Long, Elements As Long
Dim lDelims As Long, lText As Long
Dim Arr() As String
lText = Len(Text)
lDelims = Len(DelimChars)
If lDelims = 0 Or lText = 0 Or Limit = 1 Then
ReDim Arr(0 To 0)
Arr(0) = Text
SplitMultiDelims = Arr
Exit Function
End If
ReDim Arr(0 To IIf(Limit = -1, lText - 1, Limit))
Elements = 0: ElemStart = 1
For N = 1 To lText
If InStr(DelimChars, Mid(Text, N, 1)) Then
Arr(Elements) = Mid(Text, ElemStart, N - ElemStart)
If IgnoreConsecutiveDelimiters Then
If Len(Arr(Elements)) > 0 Then Elements = Elements + 1
Else
Elements = Elements + 1
End If
ElemStart = N + 1
If Elements + 1 = Limit Then Exit For
End If
Next N
'Get the last token terminated by the end of the string into the array
If ElemStart <= lText Then Arr(Elements) = Mid(Text, ElemStart)
'Since the end of string counts as the terminating delimiter, if the last character
'was also a delimiter, we treat the two as consecutive, and so ignore the last elemnent
If IgnoreConsecutiveDelimiters Then If Len(Arr(Elements)) = 0 Then Elements = Elements - 1
ReDim Preserve Arr(0 To Elements) 'Chop off unused array elements
SplitMultiDelims = Arr
End Function
'Calculate the Levenshtein Distance between two strings (the number of insertions,
'deletions, and substitutions needed to transform the first string into the second)
Public Function LevenshteinDistance(ByRef S1 As String, ByVal S2 As String) As Long
Dim L1 As Long, L2 As Long, D() As Long 'Length of input strings and distance matrix
Dim i As Long, j As Long, cost As Long 'loop counters and cost of substitution for current letter
Dim cI As Long, cD As Long, cS As Long 'cost of next Insertion, Deletion and Substitution
L1 = Len(S1): L2 = Len(S2)
ReDim D(0 To L1, 0 To L2)
For i = 0 To L1: D(i, 0) = i: Next i
For j = 0 To L2: D(0, j) = j: Next j
For j = 1 To L2
For i = 1 To L1
cost = Abs(StrComp(Mid$(S1, i, 1), Mid$(S2, j, 1), vbTextCompare))
cI = D(i - 1, j) + 1
cD = D(i, j - 1) + 1
cS = D(i - 1, j - 1) + cost
If cI <= cD Then 'Insertion or Substitution
If cI <= cS Then D(i, j) = cI Else D(i, j) = cS
Else 'Deletion or Substitution
If cD <= cS Then D(i, j) = cD Else D(i, j) = cS
End If
Next i
Next j
LevenshteinDistance = D(L1, L2)
End Function2.1. Hàm valuePhrase
Hàm sẽ có dạng valuePhrase(Chuỗi 1,Chuỗi 2)
Hàm này sẽ so sánh khác nhau giữa 2 chuỗi kí tự, kết quả trả về sẽ là số kí tự khác nhau trong 2 chuỗi, xem ví dụ minh họa cho dễ hiểu nha.
Bạn cần đăng nhập để thấy hình ảnh
2.2. Hàm valueWords
Hàm sẽ có dạng valueWords(Chuỗi 1,Chuỗi 2)
Hàm này sẽ so sánh khác nhau giữa các kí tự trong một chuỗi kí tự liền nhau nằm giữa các khoảng trống. kết quả trả về sẽ là số kí tự khác nhau giữa 2 chuỗi này. Xem ví dụ mình sẽ giải thích kỹ hơn.
Bạn cần đăng nhập để thấy hình ảnh
Ở ví vụ, mình tô màu xanh là 2 sự giống nhau của 2 chuỗi, màu đỏ và đen là sự khác nhau giữa 2 chuỗi.
Mình ví dụ công thức ở ô D3, Bạn thấy 2 chuỗi này có chuỗi tuhoc là giống nhau, và có 3 ki tự khác nhau (vba và _vb), kết quả là 3.
Ở ví dụ ô D4, dù trong chuỗi 2 có .net là khác chuỗi 1, nhưng chuỗi tuhocvba là chuỗi nhiều kí tự liên tiếp giống nhau nhất (không tính khoảng trống). Có nghĩ là, bên chuỗi 2 CÓ CHỨA chuỗi tuhocvba giống hoàn toàn với chuỗi tuhocvba bên chuỗi 1, nên kết quả =0.
Tất cả giải thích về nguyên lý hoạt động code nằm hết trong nguồn, các bạn đọc tham khảo nhé.
Nguồn:
Bạn cần đăng nhập để thấy link
Sửa lần cuối bởi điều hành viên:
