算法实现/字符串搜索/匹配评分方法
'Developed by Western Airlines in 1977
'Coded in VB.NET by Colm Rice
'Based on documentation: www.statcan.ca/english/research/85-602-XIE/85-602-XIE.pdf
'An Overview of the Issues Related to the use of Personal Identifiers" by Mark Armstrong
'HSMD, Statistics Canada - July 7 2000
'Gets the phonetic value of a name according to the Match Rating Approach by Western Airlines -'1977
Public Function getMRA(ByVal inName As String) As String
'Bulletproofing - no input
If inName.Length.Equals(0) Then
Return "***NO INPUT***"
End If
inName = inName.ToUpper
'Recommended: Pre-processing the input to remove unusual characters like:
'Hyphens, apostrophies, etc...
'Part 1 - Remove all vowels unless vowel is first
inName = Me.RemoveVowels(inName)
'Part 2 - Remove second contiguous consonant of a consonant pair
inName = Me.RemoveDoubles(inName)
'Part 3 - Retain the first 3 and last 3 characters
inName = Me.First3Last3(inName)
Return inName
End Function
'For a given string and current position - determines if the current character is a vowel
Private Function IsVowel(ByVal str As String, ByVal i As Integer) As Boolean
Try
Dim Ltr As String = str.Substring(i, 1)
If (Ltr.Equals("A") Or Ltr.Equals("E") Or Ltr.Equals("I") Or Ltr.Equals("O") Or Ltr.Equals("U")) Then
Return True
Else
Return False
End If
Catch ex As Exception
Return False
End Try
End Function
'Removes any double consonants to a single consonant
Private Function RemoveDoubles(ByVal str As String) As String
str = str.ToUpper
str = str.Replace("AA", "A")
str = str.Replace("BB", "B")
str = str.Replace("CC", "C")
str = str.Replace("DD", "D")
str = str.Replace("EE", "E")
str = str.Replace("FF", "F")
str = str.Replace("GG", "G")
str = str.Replace("HH", "H")
str = str.Replace("II", "I")
str = str.Replace("JJ", "J")
str = str.Replace("KK", "K")
str = str.Replace("LL", "L")
str = str.Replace("MM", "M")
str = str.Replace("NN", "N")
str = str.Replace("OO", "O")
str = str.Replace("PP", "P")
str = str.Replace("QQ", "Q")
str = str.Replace("RR", "R")
str = str.Replace("SS", "S")
str = str.Replace("TT", "T")
str = str.Replace("UU", "U")
str = str.Replace("VV", "V")
str = str.Replace("WW", "W")
str = str.Replace("XX", "X")
str = str.Replace("YY", "Y")
str = str.Replace("ZZ", "Z")
Return str
End Function
'Reverses a string
Private Function ReverseString(ByVal str As String) As String
Dim Chars() As Char = str.ToCharArray
Array.Reverse(Chars)
Dim Reversed As New String(Chars, 0, Chars.Length)
Return Reversed
End Function
'Retains the first 3 and last 3 characters of any string
Private Function First3Last3(ByVal str As String) As String
Dim f3l3 As String = Nothing
If str.Length > 6 Then
f3l3 = str.Substring(0, 3) + str.Substring(str.Length - 3, 3)
Else
'String length is 6 or less in which case grab all the letters
f3l3 = str
End If
Return f3l3
End Function