Visual Basic: Pattern Matching Words

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

Download

Click Here To Download The Example Project

See also

Please view my other wiki articles!

Please update this article if you see any mistakes.