Page 1 of 1

Boggle The DAWG Rate Topic: -----

#1 AdamSpeight2008  Icon User is offline

  • MrCupOfT
  • member icon


Reputation: 2262
  • View blog
  • Posts: 9,466
  • 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
    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).

Attached File  sowpods.txt (1.99MB)
Number of downloads: 9447
Attached File  BoogleDieFaces.txt (286bytes)
Number of downloads: 220

This post has been edited by AdamSpeight2008: 22 June 2012 - 05:08 PM


Is This A Good Question/Topic? 2
  • +

Page 1 of 1