Pattern Matching Words With Visual Basic

Pattern Matching Words With Visual Basic

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

Please view my other wiki articles!

Please update this article if you see any mistakes.

Leave a Comment
  • Please add 6 and 2 and type the answer here:
  • Post
Wiki - Revision Comment List(Revision Comment)
Sort by: Published Date | Most Recent | Most Useful
Comments
  • Carsten Siemens edited Revision 1. Comment: fixed typo

Page 1 of 1 (1 items)
Wikis - Comment List
Sort by: Published Date | Most Recent | Most Useful
Posting comments is temporarily disabled until 10:00am PST on Saturday, December 14th. Thank you for your patience.
Comments
Page 1 of 1 (3 items)