Algorithm Implementation/String searching/Match Rating Approach
 | Wikipedia has related information at Match Rating Approach. |
VB.NET
[edit | edit source]'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