Page 1 of 1

## Boggle The DAWG Rate Topic: //<![CDATA[ rating = new ipb.rating( 'topic_rate_', { url: 'http://www.dreamincode.net/forums/index.php?app=forums&module=ajax&section=topics&do=rateTopic&t=283066&amp;s=21b26335515c6cd1f31246ba4c76aad7&md5check=' + ipb.vars['secure_hash'], cur_rating: 0, rated: 0, allow_rate: 0, multi_rate: 1, show_rate_text: true } ); //]]>

• MrCupOfT

Reputation: 2298
• Posts: 9,535
• Joined: 29-May 08

Posted 17 June 2012 - 03:30 PM

Boggle The DAWG

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
While Not (sr.EndOfStream)
line.Trim()
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())
While Not (sr.EndOfStream)
Dim Faces = line.Split({" "c}, StringSplitOptions.RemoveEmptyEntries)
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 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 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
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
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

Module Module1

Sub Main()
' Create SOWPOD DAWG
Console.WriteLine("Dictionary Created")
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)")
Loop Until k = "Y" Or k = "N"
Loop Until k = "N"
End Sub
Dim WordList As New DAWG.DAWGList
While Not (sr.EndOfStream)
line.Trim()
End While
End Using
Return WordList
End Function

Public Function LoadDice() As List(Of String())
Dim dice As New List(Of String())
While Not (sr.EndOfStream)
Dim Faces = line.Split({" "c}, StringSplitOptions.RemoveEmptyEntries)
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)