How to match word patterns with Visual Basic
Someone recently asked a question about solving crypto class="content-fragment-top fiji-content-fragment-top">
Someone recently asked a question about solving crypto class="content-fragment-top fiji-content-fragment-top">
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
">AsLabel =
Nothing
) _
&nbs
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
'Assemble the encrypted word's pattern
WordPattern = WordPattern & P.ID :
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
For
Each
S
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 returnary word, the pattern that they were matched with)
Item.SubItems.AddRange({S, WordPattern})
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
Please view my other wiki articles!
Please update this article if you see any mistakes.