Algorithm Implementation/String searching/Match Rating Approach

VB.NET

'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