1 #Region "Microsoft.VisualBasic::9a756ee4a6efdcb854d399d517b8a904, Microsoft.VisualBasic.Core\ComponentModel\Algorithm\Levenshtein\LevenshteinDistance.vb"
2
3     ' Author:
4     
5     '       asuka (amethyst.asuka@gcmodeller.org)
6     '       xie (genetics@smrucc.org)
7     '       xieguigang (xie.guigang@live.com)
8     
9     ' Copyright (c) 2018 GPL3 Licensed
10     
11     
12     ' GNU GENERAL PUBLIC LICENSE (GPL3)
13     
14     
15     ' This program is free software: you can redistribute it and/or modify
16     ' it under the terms of the GNU General Public License as published by
17     ' the Free Software Foundation, either version 3 of the License, or
18     ' (at your option) any later version.
19     
20     ' This program is distributed in the hope that it will be useful,
21     ' but WITHOUT ANY WARRANTY; without even the implied warranty of
22     ' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
23     ' GNU General Public License for more details.
24     
25     ' You should have received a copy of the GNU General Public License
26     ' along with this program. If not, see <http://www.gnu.org/licenses/>.
27
28
29
30     ' /********************************************************************************/
31
32     ' Summaries:
33
34     '     Module LevenshteinDistance
35     
36     '         Function: __createTable, __int32Equals, (+2 Overloads) ComputeDistance, CreateTable, GetVisulization
37     '                   SaveMatch
38     '         Delegate Function
39     
40     '             Function: __computeRoute, (+2 Overloads) ComputeDistance, Similarity
41     
42     
43     
44     ' /********************************************************************************/
45
46 #End Region
47
48 Imports Microsoft.VisualBasic.CommandLine.Reflection
49 Imports Microsoft.VisualBasic.ComponentModel.Algorithm
50 Imports Microsoft.VisualBasic.ComponentModel.Algorithm.DynamicProgramming
51 Imports Microsoft.VisualBasic.ComponentModel.DataStructures
52 Imports Microsoft.VisualBasic.Linq.Extensions
53 Imports Microsoft.VisualBasic.Net.Protocols
54 Imports Microsoft.VisualBasic.Scripting.MetaData
55 Imports Microsoft.VisualBasic.Text.Xml.Models
56 Imports sys = System.Math
57
58 Namespace Text.Levenshtein
59
60     ''' <summary>
61     ''' Levenshtein Edit Distance Algorithm for measure string distance
62     ''' </summary>
63     ''' <remarks>
64     ''' http://www.codeproject.com/Tips/697588/Levenshtein-Edit-Distance-Algorithm
65     ''' </remarks>
66     '''
67     <Package("Distance.Levenshtein",
68                   Description:="Implement the Levenshtein Edit Distance algorithm and result data visualization.",
69                   Publisher:="furkanavcu",
70                   Category:=APICategories.UtilityTools,
71                   Url:="http://www.codeproject.com/Tips/697588/Levenshtein-Edit-Distance-Algorithm")>
72     <Cite(Title:="Binary codes capable of correcting deletions, insertions, and reversals",
73       Pages:="707–710", StartPage:=707, Issue:="8", Volume:=10, Authors:="Levenshtein,
74 Vladimir I",
75       Journal:="Soviet Physics Doklady", Year:=1966)>
76     Public Module LevenshteinDistance
77
78         ''' <summary>
79         ''' Creates distance table for data visualization
80         ''' </summary>
81         ''' <param name="reference"></param>
82         ''' <param name="hypotheses"></param>
83         ''' <param name="cost"></param>
84         ''' <returns></returns>
85         Private Function __createTable(reference As Integer(), hypotheses As Integer(), cost As DoubleAs Double(,)
86             Return CreateTable(Of Integer)(reference, hypotheses, DynamicProgramming.Cost(Of Integer).DefaultCost(cost), AddressOf __int32Equals)
87         End Function
88
89         Private Function __int32Equals(a As Integer, b As IntegerAs Boolean
90             Return a = b
91         End Function
92
93         ''' <summary>
94         ''' 用于泛型的序列相似度比较
95         ''' </summary>
96         ''' <typeparam name="T"></typeparam>
97         ''' <param name="reference"></param>
98         ''' <param name="hypotheses"></param>
99         ''' <param name="cost"></param>
100         ''' <param name="equals">泛型化的元素等价性的比较方法</param>
101         ''' <returns></returns>
102         Public Function CreateTable(Of T)(reference As T(), hypotheses As T(), cost As Cost(Of T), equals As GenericLambda(Of T).IEquals) As Double(,)
103             Dim distTable As Double(,) = New Double(reference.Length, hypotheses.Length) {}
104
105             For i As Integer = 0 To reference.Length - 1
106                 distTable(i, 0) = i * cost.insert(reference(i))
107             Next
108
109             For j As Integer = 0 To hypotheses.Length - 1
110                 distTable(0, j) = j * cost.delete(hypotheses(j))
111             Next
112
113             distTable(reference.Length, 0) = cost.insert(Nothing)
114             distTable(0, hypotheses.Length) = cost.delete(Nothing)
115
116             'd[i,j] <- min( d[i-1,j] + delete.fun(source.vec[i-1]),
117             'd[i,j-1] + insert.fun(target.vec[j-1]),
118             'd[i-1,j-1] + substitute.fun(source.vec[i-1], target.vec[j-1]) );
119
120             For i As Integer = 1 To reference.Length
121                 For j As Integer = 1 To hypotheses.Length
122
123                     If equals(reference(i - 1), hypotheses(j - 1)) Then
124                         '  if the letters are same
125                         distTable(i, j) = distTable(i - 1, j - 1)
126                     Else ' if not add 1 to its neighborhoods and assign minumun of its neighborhoods
127                         Dim n As Double = sys.Min(
128                             distTable(i - 1, j - 1) + cost.substitute(reference(i - 1), hypotheses(j - 1)),
129                             distTable(i - 1, j) + cost.delete(reference(i - 1)))
130                         distTable(i, j) = sys.Min(n, distTable(i, j - 1) + cost.insert(hypotheses(j - 1)))
131                     End If
132                 Next
133             Next
134
135             Return distTable
136         End Function
137
138         ''' <summary>
139         ''' 泛型序列的相似度的比较计算方法,这个函数返回的是距离
140         ''' </summary>
141         ''' <typeparam name="T"></typeparam>
142         ''' <param name="reference"></param>
143         ''' <param name="hypotheses"></param>
144         ''' <param name="equals"></param>
145         ''' <param name="cost"></param>
146         ''' <returns></returns>
147         Public Function ComputeDistance(Of T)(reference As T(), hypotheses As T(), equals As GenericLambda(Of T).IEquals, Optional cost As Double = 0.7) As Double
148             If hypotheses Is Nothing Then hypotheses = New T() {}
149             If reference Is Nothing Then reference = New T() {}
150
151             Dim distTable#(,) = CreateTable(Of T)(reference, hypotheses, DynamicProgramming.Cost(Of T).DefaultCost(cost), equals)
152             Dim i As Integer = reference.Length, j As Integer = hypotheses.Length
153
154             Return distTable(i, j)
155         End Function
156
157         ''' <summary>
158         ''' 泛型序列的相似度的比较计算方法,这个会返回所有的数据
159         ''' </summary>
160         ''' <typeparam name="T"></typeparam>
161         ''' <param name="reference"></param>
162         ''' <param name="hypotheses"></param>
163         ''' <param name="equals"></param>
164         ''' <param name="asChar">这个只是用于进行显示输出的</param>
165         ''' <param name="cost"></param>
166         ''' <returns></returns>
167         Public Function ComputeDistance(Of T)(reference As T(), hypotheses As T(), equals As GenericLambda(Of T).IEquals, asChar As ToChar(Of T), Optional cost As Double = 0.7) As DistResult
168             If hypotheses Is Nothing Then hypotheses = New T() {}
169             If reference Is Nothing Then reference = New T() {}
170
171             Dim distTable#(,) = CreateTable(Of T)(reference, hypotheses, DynamicProgramming.Cost(Of T).DefaultCost(cost), equals)
172             Dim i As Integer = reference.Length,
173                 j As Integer = hypotheses.Length
174             Dim sHyp As String = New String(hypotheses.Select(Function(x) asChar(x)).ToArray)
175             Dim sRef As String = New String(reference.Select(Function(x) asChar(x)).ToArray)
176             Dim result As New DistResult With {
177                 .Hypotheses = sHyp,
178                 .Reference = sRef
179             }
180             Return __computeRoute(sHyp, result, i, j, distTable)
181         End Function
182
183         <ExportAPI("ToHTML"Info:="View distance evolve route of the Levenshtein Edit Distance calculation.")>
184         Public Function GetVisulization(res As DistResult) As String
185             Return res.HTMLVisualize
186         End Function
187
188         <ExportAPI("Write.Xml.DistResult")>
189         Public Function SaveMatch(result As DistResult, SaveTo As StringAs Boolean
190             Return result.GetXml.SaveTo(SaveTo)
191         End Function
192
193         Public Delegate Function ToChar(Of T)(x As T) As Char
194
195         ''' <summary>
196         ''' Implement the Levenshtein Edit Distance algorithm between string.
197         ''' </summary>
198         ''' <param name="reference">The reference string ASCII cache.</param>
199         ''' <param name="hypotheses"></param>
200         ''' <param name="cost"></param>
201         ''' <returns></returns>
202         <ExportAPI("ComputeDistance"Info:="Implement the Levenshtein Edit Distance algorithm.")>
203         Public Function ComputeDistance(reference As Integer(), hypotheses As StringOptional cost As Double = 0.7) As DistResult
204             If hypotheses Is Nothing Then hypotheses = ""
205             If reference Is Nothing Then reference = New Integer() {}
206
207             Dim distTable#(,) = __createTable(reference,
208                                               hypotheses.Select(Function(ch) Asc(ch)).ToArray,
209                                               cost)
210             Dim i As Integer = reference.Length,
211                 j As Integer = hypotheses.Length
212             Dim result As New DistResult With {
213                 .Hypotheses = hypotheses,
214                 .Reference = Nothing
215             }
216             Return __computeRoute(hypotheses, result, i, j, distTable)
217         End Function
218
219         Const a As Integer = Asc("a"c)
220
221         Public Function Similarity(Of T)(query As T(), subject As T(), Optional penalty As Double = 0.75) As Double
222             If query.IsNullOrEmpty OrElse subject.IsNullOrEmpty Then
223                 Return 0
224             End If
225
226             Dim distinct As T() =
227                 (New [Set](query) + New [Set](subject)) _
228                 .ToArray _
229                 .Select(Function(x) DirectCast(x, T)) _
230                 .ToArray
231             Dim dict = (From index As Integer
232                         In distinct.Sequence(offSet:=a)
233                         Select ch = ChrW(index),
234                             obj = distinct(index - a)) _
235                             .ToDictionary(Function(x) x.obj,
236                                           Function(x) x.ch)
237             Dim ref As String = New String(query.Select(Function(x) dict(x)).ToArray)
238             Dim sbj As String = New String(subject.Select(Function(x) dict(x)).ToArray)
239
240             If String.IsNullOrEmpty(ref) OrElse String.IsNullOrEmpty(sbj) Then
241                 Return 0
242             End If
243
244             Dim result As DistResult = ComputeDistance(ref, sbj, penalty)
245             If result Is Nothing Then
246                 Return 0
247             Else
248                 Return result.Score
249             End If
250         End Function
251
252         ''' <summary>
253         ''' 计算lev编辑的变化路径
254         ''' </summary>
255         ''' <param name="hypotheses"></param>
256         ''' <param name="result"></param>
257         ''' <param name="i"></param>
258         ''' <param name="j"></param>
259         ''' <param name="distTable"></param>
260         ''' <returns></returns>
261         Private Function __computeRoute(hypotheses$,
262                                         result As DistResult,
263                                         i%, j%,
264                                         distTable#(,)) As DistResult
265
266             Dim css As New List(Of Coordinate)
267             Dim evolve As List(Of Char) = New List(Of Char)
268             Dim edits As New List(Of Char)
269
270             While True
271
272                 Call css.Add({i - 1, j})
273
274                 If i = 0 AndAlso j = 0 Then
275                     Dim evolveRoute As Char() = evolve.ToArray
276                     Call Array.Reverse(evolveRoute)
277                     Call css.Add({i, j})
278
279                     result.DistTable = distTable _
280                         .ToVectorList _
281                         .Select(Function(vec) New Streams.Array.Double With {
282                             .Values = vec
283                         }) _
284                         .ToArray
285                     result.DistEdits = New String(evolveRoute)
286                     result.Path = css.ToArray
287                     result.Matches = New String(edits.ToArray.Reverse.ToArray)
288
289                     Exit While
290
291                 ElseIf i = 0 AndAlso j > 0 Then   ' delete
292                     Call evolve.Add("d"c)
293                     Call css.Add({i - 1, j})
294                     Call edits.Add("-"c)
295                     j -= 1
296
297                 ElseIf i > 0 AndAlso j = 0 Then
298                     Call evolve.Add("i"c)         ' insert
299                     Call css.Add({i - 1, j})
300                     Call edits.Add("-"c)
301
302                     i -= 1
303
304                 Else
305                     If distTable(i - 1, j - 1) <= distTable(i - 1, j) AndAlso
306                     distTable(i - 1, j - 1) <= distTable(i, j - 1) Then
307                         Call css.Add({i - 1, j})
308                         If distTable(i - 1, j - 1) = distTable(i, j) Then
309                             Call evolve.Add("m"c) ' match
310                             Call edits.Add(hypotheses(j - 1))
311                         Else
312                             Call evolve.Add("s"c) ' substitue
313                             Call edits.Add("-"c)
314                         End If
315
316                         i -= 1
317                         j -= 1
318
319                     ElseIf distTable(i - 1, j) < distTable(i, j - 1) Then
320                         Call css.Add({i - 1, j})
321                         Call evolve.Add("i")      ' insert
322                         Call edits.Add("-"c)
323                         i -= 1
324
325                     ElseIf distTable(i, j - 1) < distTable(i - 1, j) Then
326                         Call css.Add({i - 1, j})
327                         Call evolve.Add("d")      ' delete
328                         Call edits.Add("-"c)
329                         j -= 1
330
331                     End If
332                 End If
333
334                 If css.Count > 1024 AndAlso css.Count - evolve.Count > 128 Then
335                     ' Call $"{reference} ==> {hypotheses} stack could not be solve, operation abort!".__DEBUG_ECHO
336                     Return Nothing
337                 End If
338             End While
339
340             Return result
341         End Function
342
343         ''' <summary>
344         ''' The edit distance between two strings is defined as the minimum number of
345         ''' edit operations required to transform one string into another.
346         ''' (请注意,这函数是大小写敏感的。如果需要大小写不敏感,在使用前,请先将函数的两个字符串参数都转换为小写形式)
347         ''' </summary>
348         ''' <param name="reference"></param>
349         ''' <param name="hypotheses"></param>
350         ''' <param name="cost"></param>
351         ''' <returns></returns>
352         <ExportAPI("ComputeDistance"Info:="Implement the Levenshtein Edit Distance algorithm.")>
353         Public Function ComputeDistance(reference$, hypotheses$, Optional cost# = 0.7) As DistResult
354
355             If hypotheses Is Nothing Then hypotheses = ""
356             If reference Is Nothing Then reference = ""
357
358             Dim distTable As Double(,) = __createTable(
359                 reference.Select(Function(ch) AscW(ch)).ToArray,
360                 hypotheses.Select(Function(ch) AscW(ch)).ToArray,
361                 cost)
362             Dim i As Integer = reference.Length,
363                 j As Integer = hypotheses.Length
364             Dim result As New DistResult With {
365                 .Hypotheses = hypotheses,
366                 .Reference = reference
367             }
368
369             Return __computeRoute(hypotheses, result, i, j, distTable)
370         End Function
371     End Module
372 End Namespace