In this tutorial I'll be building the DAWG we created in the previous tutorial The DAWG (Directed Acyclic Word Graph). To help us find all possible words contained on a Boggle Board.
Scoring
The score for the Boggle board is based on the following points system.
Word length => Points <= 2 - 0 pts 3 - 1 4 - 1 5 - 2 6 - 3 7 - 5 >= 8 - 11 pts *Words using the "Qu" die will count the full 2 letters for their word, not just the 1 die.
The Boggle Die
A A E E G N E L R T T Y A O O T T W A B B J O O E H R T V W C I M O T U D I S T T Y E I O S S T D E L R V Y A C H O P S H I M N Qu U E E I N S U E E G H N W A F F K P S H L N N R Z D E I L R X
Building The DAWG
Public Function LoadSOWPODS() As DAWG.DAWGList
Dim WordList As New DAWG.DAWGList
Using sr As New IO.StreamReader("SOWPODS.txt")
While Not (sr.EndOfStream)
Dim line = sr.ReadLine()
line.Trim()
WordList.Add(line)
End While
End Using
Return WordList
End Function
Creating The Die
Public Function LoadDice() As List(Of String())
Dim dice As New List(Of String())
Using sr As New IO.StreamReader("BoogleDieFaces.txt")
While Not (sr.EndOfStream)
Dim line = sr.ReadLine
Dim Faces = line.Split({" "c}, StringSplitOptions.RemoveEmptyEntries)
dice.Add(Faces)
End While
End Using
Return dice
End Function
Face
Public Class Face
Private _Chars As String = ""
Public Sub New(Chars As String)
Me._Chars = Chars
End Sub
Public Overrides Function ToString() As String
Return String.Format("{0}{1}", _Chars, If(_Chars.Length < 2, " ", ""))
End Function
Public ReadOnly Property Value As String
Get
Return _Chars
End Get
End Property
End Class
Die
Public Class Die
Private _Faces(5) As Face
Private _FaceUp As Integer
Shared _RND As New Random
Public Sub New(Faces As String())
For i = 0 To 5
_Faces(i) = New Face(Faces(i))
Next
End Sub
Public Overrides Function ToString() As String
Return FaceUp.ToString
End Function
Public Sub Shake()
_FaceUp = _RND.Next(6)
End Sub
Public ReadOnly Property FaceUp As Face
Get
Return _Faces(_FaceUp)
End Get
End Property
End Class
Scoring the Board
Public Class BoardScore
Public ReadOnly Board As BoggleBoard
Public ReadOnly Score As Integer
Public ReadOnly Words As New List(Of String)
Public Sub New(b As BoggleBoard, words As List(Of String))
Me.Board = b
Me.Words = words
Score = Me.Words.Sum(Function(w)
Select Case w.Length
Case Is < 3 : Return 0
Case 3, 4 : Return 1
Case 5 : Return 2
Case 6 : Return 3
Case 7 : Return 5
Case Else
Return 11
End Select
End Function)
End Sub
End Class
Creating the Board
Public Class BoggleBoard
Private _Die(15) As Die
Public Sub New(Dies As List(Of String()))
For i = 0 To 15
_Die(i) = New Die(Dies(i))
Next
End Sub
Private _Rng As New Random
Public Sub shake()
For i = 0 To _Rng.Next(1000)
_Die(_Rng.Next(16)).SwapWith(_Die(_Rng.Next(16)))
Next
For Each d In _Die
d.Shake()
Next
End Sub
Public Overrides Function ToString() As String
Dim sb As New Text.StringBuilder
sb.AppendFormat("{0} {1} {2} {3}", _Die(0), _Die(1), _Die(2), _Die(3)).AppendLine()
sb.AppendFormat("{0} {1} {2} {3}", _Die(4), _Die(5), _Die(6), _Die(7)).AppendLine()
sb.AppendFormat("{0} {1} {2} {3}", _Die(8), _Die(9), _Die(10), _Die(11)).AppendLine()
sb.AppendFormat("{0} {1} {2} {3}", _Die(12), _Die(13), _Die(14), _Die(15)).AppendLine()
Return sb.ToString
End Function
Public Function ScoreBoard(dic As DAWG.DAWGList) As BoardScore
Dim found As New HashSet(Of String)
Parallel.For(0, 16, Sub(i) search(dic, "", i, 0, found))
Return New BoardScore(Me, found.ToList)
End Function
Public Sub search(dic As DAWG.DAWGList, PreviousWord As String, Index As Integer, Mask As Integer, FoundWords As HashSet(Of String))
Dim BitToSet = 1 << Index
If (Mask And BitToSet) <> 0 Then Exit Sub
Dim NewMask = Mask Or BitToSet
Dim FormedWord = PreviousWord & _Die(Index).FaceUp.Value
Dim Result As DAWG.CharNodeBase
SyncLock dic
Result = dic.Retrive(FormedWord)
End SyncLock
If Result Is Nothing Then Exit Sub
If Result.EndOfWord Then
SyncLock FoundWords
If Not FoundWords.Contains(FormedWord) Then
FoundWords.Add(FormedWord)
End If
End SyncLock
End If
If Result.Next IsNot Nothing Then
Dim x = Index Mod 4
Dim y = Index \ 4
Parallel.Invoke({Sub() If y > 0 AndAlso x > 0 Then search(dic, FormedWord, Index - 5, NewMask, FoundWords),
Sub() If y > 0 Then search(dic, FormedWord, Index - 4, NewMask, FoundWords),
Sub() If y > 0 AndAlso x < 3 Then search(dic, FormedWord, Index - 3, NewMask, FoundWords),
Sub() If x < 3 Then search(dic, FormedWord, Index + 1, NewMask, FoundWords),
Sub() If y < 3 AndAlso x < 3 Then search(dic, FormedWord, Index + 5, NewMask, FoundWords),
Sub() If y < 3 Then search(dic, FormedWord, Index + 4, NewMask, FoundWords),
Sub() If y < 3 AndAlso x > 0 Then search(dic, FormedWord, Index + 3, NewMask, FoundWords),
Sub() If x > 0 Then search(dic, FormedWord, Index - 1, NewMask, FoundWords)})
End If
End Sub
End Class
Breakdown of the Search
Parallel search the board, starting with at different die.
Public Function ScoreBoard(dic As DAWG.DAWGList) As BoardScore
Dim found As New HashSet(Of String)
Parallel.For(0, 16, Sub(i) search(dic, "", i, 0, found))
Return New BoardScore(Me, found.ToList)
End Function
Public Sub search(dic As DAWG.DAWGList, PreviousWord As String, Index As Integer, Mask As Integer, FoundWords As HashSet(Of String))
Dim BitToSet = 1 << Index
If (Mask And BitToSet) <> 0 Then Exit Sub
The Mask and BitToSet is used to check to see if a node has been visited before, which not allowed by the rules of boggle.
Dim NewMask = Mask Or BitToSet
Dim FormedWord = PreviousWord & _Die(Index).FaceUp.Value
Dim Result As DAWG.CharNodeBase
SyncLock dic
Result = dic.Retrive(FormedWord)
End SyncLock
If Result Is Nothing Then Exit Sub
Formedword hasn't found a node
If Result.EndOfWord Then
Check to see the found node is the end of word, if it is the word is in the DAWG
SyncLock FoundWords
If Not FoundWords.Contains(FormedWord) Then
FoundWords.Add(FormedWord)
End If
End SyncLock
End If
If Result.Next IsNot Nothing Then
The above If-Statement is the most important part of the search algorithm, as it allows use the check to see if the FoundWord start of any other words. If it is then continue searching deeper.
Dim x = Index Mod 4
Dim y = Index \ 4
Parallel.Invoke({Sub() If y > 0 AndAlso x > 0 Then search(dic, FormedWord, Index - 5, NewMask, FoundWords),
Sub() If y > 0 Then search(dic, FormedWord, Index - 4, NewMask, FoundWords),
Sub() If y > 0 AndAlso x < 3 Then search(dic, FormedWord, Index - 3, NewMask, FoundWords),
Sub() If x < 3 Then search(dic, FormedWord, Index + 1, NewMask, FoundWords),
Sub() If y < 3 AndAlso x < 3 Then search(dic, FormedWord, Index + 5, NewMask, FoundWords),
Sub() If y < 3 Then search(dic, FormedWord, Index + 4, NewMask, FoundWords),
Sub() If y < 3 AndAlso x > 0 Then search(dic, FormedWord, Index + 3, NewMask, FoundWords),
Sub() If x > 0 Then search(dic, FormedWord, Index - 1, NewMask, FoundWords)})
End If
End Sub
Console Application Demo
Imports System.Threading.Tasks.Task
Imports System.Threading.Tasks
Module Module1
Sub Main()
' Create SOWPOD DAWG
Dim w = LoadSOWPODS()
Console.WriteLine("Dictionary Created")
Dim dice = LoadDice()
Console.WriteLine("Created Dice")
Dim boggle As New BoggleBoard(dice)
Dim k As Char
Do
Console.WriteLine("Shaking Board")
boggle.shake()
Console.WriteLine("Board Shaken")
Console.WriteLine("")
Console.WriteLine(boggle.ToString)
Dim sw As New Diagnostics.Stopwatch
sw.Start()
Dim s = boggle.ScoreBoard(w)
sw.Stop()
Console.WriteLine("Score: {0}", s.Score)
Console.WriteLine("Words: {0}", s.Words.Count)
Dim ggg = From g In (From ww In s.Words
Group By ww.Length Into Group) Order By g.Length Descending
For Each gr In ggg
For Each FoundWords In gr.Group
Console.Write("{0} ", FoundWords)
Next
Console.WriteLine()
Next
Console.WriteLine("Taken: {0}ms", sw.ElapsedMilliseconds)
Console.WriteLine()
Do
Console.WriteLine("Another? (Y/N)")
k = Char.ToUpper(Console.ReadKey.KeyChar)
Loop Until k = "Y" Or k = "N"
Loop Until k = "N"
End Sub
Public Function LoadSOWPODS() As DAWG.DAWGList
Dim WordList As New DAWG.DAWGList
Using sr As New IO.StreamReader("SOWPODS.txt")
While Not (sr.EndOfStream)
Dim line = sr.ReadLine()
line.Trim()
WordList.Add(line)
End While
End Using
Return WordList
End Function
Public Function LoadDice() As List(Of String())
Dim dice As New List(Of String())
Using sr As New IO.StreamReader("BoogleDieFaces.txt")
While Not (sr.EndOfStream)
Dim line = sr.ReadLine
Dim Faces = line.Split({" "c}, StringSplitOptions.RemoveEmptyEntries)
dice.Add(Faces)
End While
End Using
Return dice
End Function
<Runtime.CompilerServices.Extension()>
Public Sub SwapWith(Of T)(ByRef x As T, ByRef y As T)
Dim tmp = x
x = y
y = tmp
End Sub
End Module
Conclusion
Using the DAWG method and pruning of branches let use search the board in ~50ms (on my machine).
sowpods.txt (1.99MB)
Number of downloads: 4325
BoogleDieFaces.txt (286bytes)
Number of downloads: 133
This post has been edited by AdamSpeight2008: 22 June 2012 - 05:08 PM
MultiQuote
| 