1 #Region "Microsoft.VisualBasic::d947932cb5a26ac93c2116ef99dc82e9, Microsoft.VisualBasic.Core\Text\StringSimilarity\Similarity.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     '     Delegate Function
35     
36     
37     '     Module Evaluations
38     
39     '         Function: Evaluate, tokenEquals, tokenEqualsIgnoreCase
40     '         Delegate Function
41     
42     '             Function: (+4 OverloadsIsOrdered, LevenshteinEvaluate, StringSelection, (+3 OverloadsTokenOrders
43     
44     
45     
46     
47     
48     ' /********************************************************************************/
49
50 #End Region
51
52 Imports System.Runtime.CompilerServices
53 Imports Microsoft.VisualBasic.GenericLambda(Of String)
54 Imports Microsoft.VisualBasic.Language
55 Imports Microsoft.VisualBasic.Language.Default
56 Imports Microsoft.VisualBasic.Text.Levenshtein
57
58 Namespace Text.Similarity
59
60     ''' <summary>
61     ''' Summary description for StringMatcher.
62     ''' </summary>
63     ''' 
64     Public Delegate Function ISimilarity(s1 As String, s2 As StringAs Double
65
66     Public Module Evaluations
67
68         ReadOnly ignoreCase As New DefaultValue(Of IEquals)(AddressOf tokenEqualsIgnoreCase)
69
70         ''' <summary>
71         ''' 两个字符串之间是通过单词的排布的相似度来比较相似度的
72         ''' </summary>
73         ''' <param name="s1"></param>
74         ''' <param name="s2"></param>
75         ''' <param name="ignoreCase"></param>
76         ''' <param name="cost#"></param>
77         ''' <param name="dist"></param>
78         ''' <returns></returns>
79         Public Function Evaluate(s1$, s2$,
80                                  Optional ignoreCase As Boolean = True,
81                                  Optional cost# = 0.7,
82                                  Optional ByRef dist As DistResult = NothingAs Double
83
84             If String.Equals(s1, s2, If(ignoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal)) Then
85                 Return 1
86             End If
87
88             Dim tokenEquals As IEquals = New IEquals(AddressOf Evaluations.tokenEquals) Or Evaluations.ignoreCase.When(ignoreCase)
89
90             dist = LevenshteinDistance.ComputeDistance(
91                 s1.Split,
92                 s2.Split,
93                 tokenEquals,
94                 Function(s) s.FirstOrDefault,
95                 cost)
96
97             If dist Is Nothing Then
98                 Return 0
99             Else
100                 Return dist.MatchSimilarity
101             End If
102         End Function
103
104         <MethodImpl(MethodImplOptions.AggressiveInlining)>
105         Private Function tokenEquals(w1$, w2$) As Boolean
106             Return w1$ = w2$
107         End Function
108
109         <MethodImpl(MethodImplOptions.AggressiveInlining)>
110         Private Function tokenEqualsIgnoreCase(w1$, w2$) As Boolean
111             Return String.Equals(w1, w2, StringComparison.OrdinalIgnoreCase)
112         End Function
113
114         Public Delegate Function IEvaluate(s1$, s2$, ignoreCase As Boolean, cost#, ByRef dist As DistResult) As Double
115
116         ''' <summary>
117         ''' 计算字符串,这个是直接通过计算字符而非像<see cref="Evaluate"/>方法之中计算单词的
118         ''' </summary>
119         ''' <param name="s1$"></param>
120         ''' <param name="s2$"></param>
121         ''' <param name="ignoreCase"></param>
122         ''' <param name="cost#"></param>
123         ''' <param name="dist"></param>
124         ''' <returns></returns>
125         Public Function LevenshteinEvaluate(s1$, s2$,
126                                             Optional ignoreCase As Boolean = True,
127                                             Optional cost# = 0.7,
128                                             Optional ByRef dist As DistResult = NothingAs Double
129             If ignoreCase Then
130                 s1 = s1.ToLower
131                 s2 = s2.ToLower
132             End If
133
134             If s1 = s2 Then ' 假若是大小写不敏感的,由于前面已经被转换为小写了,所以这里直接进行比较
135                 Return 1
136             End If
137
138             dist = LevenshteinDistance.ComputeDistance(s1, s2, cost)
139
140             If dist Is Nothing Then
141                 Return 0
142             Else
143                 Return dist.MatchSimilarity
144             End If
145         End Function
146
147         ''' <summary>
148         ''' 以s1为准则,将s2进行比较,返回s2之中的单词在s1之中的排列顺序
149         ''' </summary>
150         ''' <param name="s1"></param>
151         ''' <param name="s2"></param>
152         ''' <returns>序列之中的-1表示s2之中的单词在s1之中不存在</returns>
153         Public Function TokenOrders(s1 As String, s2 As StringOptional caseSensitive As Boolean = FalseAs Integer()
154             Dim t1$() = s1.Split
155             Return t1$.TokenOrders(s2, caseSensitive)
156         End Function
157
158         <MethodImpl(MethodImplOptions.AggressiveInlining)>
159         <Extension>
160         Public Function TokenOrders(s1$(), s2$, Optional caseSensitive As Boolean = FalseAs Integer()
161             Return TokenOrders(s1, s2.Split.Distinct, caseSensitive) ' 假若有重复的字符串出现,则肯定不会有顺序排布的结果,将重复的去掉
162         End Function
163
164         <Extension>
165         Public Function TokenOrders(s1$(), s2 As IEnumerable(Of String), Optional caseSensitive As Boolean = FalseOptional fuzzy As Boolean = TrueAs Integer()
166             Dim orders As New List(Of Integer)
167
168             For Each t$ In s2
169                 orders += s1.Located(t$, caseSensitive, fuzzy)
170             Next
171
172             Return orders
173         End Function
174
175         <MethodImpl(MethodImplOptions.AggressiveInlining)>
176         <Extension>
177         Public Function IsOrdered(s1$(), s2$, Optional caseSensitive As Boolean = FalseAs Boolean
178             Return s1.IsOrdered(s2.Split, caseSensitive)
179         End Function
180
181         ''' <summary>
182         ''' 查看<paramref name="s2"/>之中的字符串的顺序是否是在<paramref name="s1"/>之中按顺序排序的
183         ''' </summary>
184         ''' <param name="s1$"></param>
185         ''' <param name="s2$"></param>
186         ''' <param name="caseSensitive"></param>
187         ''' <returns></returns>
188         <Extension>
189         Public Function IsOrdered(s1$(), s2$(), Optional caseSensitive As Boolean = FalseOptional fuzzy As Boolean = TrueAs Boolean
190             Dim orders%() = s1.TokenOrders(s2, caseSensitive, fuzzy)
191             orders = orders.Where(Function(x) x <> -1).ToArray
192
193             If orders.Length = 0 Then  ' 这里是完全比对不上的情况,则肯定是False
194                 Return False
195             End If
196
197             ' 还有一个比对上的怎么办???
198             If orders.SequenceEqual(orders.OrderBy(Function(x) x)) Then
199                 ' 假若排序前和排序后的元素仍然每一个元素都相等,则是说明s2是和s1的排序是一样的
200                 Return True
201             Else
202                 Return False
203             End If
204         End Function
205
206         <MethodImpl(MethodImplOptions.AggressiveInlining)>
207         <Extension>
208         Public Function IsOrdered(s1$, s2$, Optional caseSensitive As Boolean = FalseAs Boolean
209             Return s1.Split.IsOrdered(s2$, caseSensitive)
210         End Function
211
212         <MethodImpl(MethodImplOptions.AggressiveInlining)>
213         <Extension>
214         Public Function IsOrdered(s1$, s2$(), Optional caseSensitive As Boolean = FalseOptional fuzzy As Boolean = TrueAs Boolean
215             Return s1.Split.IsOrdered(s2$, caseSensitive, fuzzy)
216         End Function
217
218         Public Function StringSelection(query As String, collection As IEnumerable(Of String), Optional cutoff# = 0.6, Optional ignoreCase As Boolean = TrueOptional tokenBased As Boolean = FalseAs String
219             Dim compare As IEvaluate
220
221             If tokenBased Then
222                 compare = AddressOf Evaluate
223             Else
224                 compare = AddressOf LevenshteinEvaluate
225             End If
226
227             Dim LQuery = From s As String
228                          In collection.AsParallel
229                          Let score As Double = compare(query, s, ignoreCase, 0.7, Nothing)
230                          Where score >= cutoff
231                          Select s,
232                              score
233                          Order By score Descending
234             Dim result = LQuery.FirstOrDefault
235
236             If result Is Nothing Then
237                 Return Nothing
238             Else
239                 Return result.s
240             End If
241         End Function
242     End Module
243 End Namespace