Algorithm Implementation/String searching/Match Rating Approach

From Wikibooks, open books for an open world
Jump to navigation Jump to search



'Developed by Western Airlines in 1977
'Coded in VB.NET by Colm Rice
'Based on documentation:
'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
      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
         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

   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)
            'String length is 6 or less in which case grab all the letters
            f3l3 = str
        End If

        Return f3l3

End Function