How to match word patterns with Visual Basic

Someone recently asked a question about solving cryptograms and I had recalled reading an article about MIT students creating a cryptogram solver that used some kind of pattern matching. i figured it was interesting enough to give a go at it. Below is my result, and can be improved up.

Commented Source Code

This code is the core of the example linked in the section below, in order to see an example of it's implementation, you will need to download the example project below.

''' <summary>

''' This function calculates likely word matches for cryptogram words.

''' </summary>

''' <param name="Word">The encrypted word</param>

''' <param name="Dictionary">A list of words to match the encrypted word against.</param>

''' <param name="Filter">A filter pattern for reducing results.</param>

''' <param name="PB">Optional Progressbar to report progress.</param>

''' <param name="UpdateLabel">Optional Label to report current match count.</param>

''' <returns></returns>

''' <remarks></remarks>

Function GetWordPatternMatches(Word As String, _

                           Dictionary As List(Of String), _

                           Optional Filter As String = "*", _

                           Optional PB As ProgressBar = Nothing, _

                           Optional UpdateLabel As Label = Nothing) _

                    As ListViewItem()

    'If the user specified a progressbar, then update the values

    If Not PB Is Nothing Then PB.Value = 0

    If Not PB Is Nothing Then PB.Maximum = 0

    'A list of identifications for pattern matching

    Const Legend As String = "01234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ"

    'return an empty array if there is no word to match

    If Word.Length = 0 Then Return {}

    'Create a new pattern table

    Dim map As New List(Of pt), I = 0, WordPattern As String = ""

    'If the user specified a progressbar, then update the values

    If Not PB Is Nothing Then PB.Maximum += Word.Count

    'Examine each letter in the encrypted word

    For Each S As String In Word

        'If the user specified a progressbar, then update the values

        If Not PB Is Nothing Then PB.Increment(1)

        'search the pattern table to see if the letter was already assigned an identification

        Dim Q1 = From P In map Where P.Letter = S Select P

        'If it has then use the same identification for that letter

        If Not Q1.ToArray.Count = 0 Then map.Add(New pt(Q1.ToArray(0).ID, S)) : Continue For

        'If it has not, then assign a new pattern identification

        map.Add(New pt((Legend)(I), S))

        'Increment the next pattern id index number

        I += 1

    Next

    'If the user specified a progressbar, then update the values

    If Not PB Is Nothing Then PB.Maximum += map.Count

    'Go through each mapped letter

    For Each P As pt In map

        'If the user specified a progressbar, then update the values

        If Not PB Is Nothing Then PB.Increment(1)

        'Assemble the encrypted word's pattern

        WordPattern = WordPattern & P.ID : Next

    'Get all word from the dictionary that are:

    'A.) The same length of the bord

    'B.) Match the FILTER specified

    Dim Q2 = From W In Dictionary Where (W.Length = Word.Length) And (W Like Filter) Select W

    'Create a list for holding the result

    Dim results As New List(Of String)

    'If the user specified a progressbar, then update the values

    If Not PB Is Nothing Then PB.Maximum += Q2.ToArray.Count

    'Go through each dictionary word from the LINQ result

    For Each W In Q2.ToArray

        'If the user specified a progressbar, then update the values

        If Not PB Is Nothing Then PB.Increment(1)

        'Create a pattern map for each word from the LINQ result, create a

        ' legend index counter, create a dictionary word pattern to compare against the encrypted word pattern

        Dim map2 As New List(Of pt), I2 = 0, DictPattern As String = ""

        'Go through each character, of each word from the LINQ result

        For Each S As String In W

            'search the pattern table to see if the letter was already assigned an identification

            Dim Q3 = From P In map2 Where P.Letter = S Select P

            'If it has then use the same identification for that letter

            If Not Q3.ToArray.Count = 0 Then map2.Add(New pt(Q3.ToArray(0).ID, S)) : Continue For

            'If it has not, then assign a new pattern identification

            map2.Add(New pt((Legend)(I2), S))

            'Increment the next pattern id index number

            I2 += 1 : Next

        'Go through each mapped letter

        For Each P As pt In map2

            'Assemble the dictionary word's pattern

            DictPattern = DictPattern & P.ID

        Next

        'Compare the encrypted word's pattern to the pattern of each result from the LINQ query(Q2)

        If DictPattern = WordPattern Then results.Add(W)

        'If the user provided a label to update status

        If Not UpdateLabel Is Nothing Then

            'Change the label's text to reflect the current matches found

            UpdateLabel.Text = results.Count & " matches found so far..."

            'refresh the label/app

            Application.DoEvents()

        End If

    Next

    'Create a list for returning the final results

    Dim Items As New List(Of ListViewItem)

    'If the user specified a progressbar, then update the values

    If Not PB Is Nothing Then PB.Maximum += results.Count

    For Each S As String In results

        'If the user specified a progressbar, then update the values

        If Not PB Is Nothing Then PB.Increment(1)

        'Create a new listview item with subitem(0) being the encrypted word

        Dim Item As New ListViewItem(Word)

        'Add 2 subitems to the item(Dictionary word, the pattern that they were matched with)

        Item.SubItems.AddRange({S, WordPattern})

        'Add the item to the final results

        Items.Add(Item)

    Next

    'convert the resuts and return it as an array of Listviewitem

    Return Items.ToArray

End Function

Private Class pt ' Pattern Table

    'I.e. The letter can only receive this ID, this ID can only represent this letter

    Public ID, Letter As String

    Sub New(ID As String, Letter As String)

        'Populate the ID and Letter values of this pattern table

        Me.ID = ID : Me.Letter = Letter

    End Sub

End Class

Example Project

Click Here To Download The Example Project

Please view my other wiki articles!

Please update this article if you see any mistakes.