Text.WordSearchSolver
Contents
Description
A word search solver library
This solver is case sensitive; users should map data consistently to one case before using this library when such behavior is desired.
- data WordSearch a
- ws_grid :: forall a[a1Pa]. :-> (WordSearch a[a1Pa]) (Grid a[a1Pa])
- ws_search :: forall a[a1Pa]. :-> (WordSearch a[a1Pa]) (Search a[a1Pa])
- data Grid a
- data Search a
- newtype Pos = Pos (PosIndex, PosIndex)
- type PosIndex = Integer
- data Match = Match {}
- m_dir :: :-> Match Dir
- m_len :: :-> Match Integer
- m_pos :: :-> Match Pos
- data Dir
- readWordSearch :: String -> Maybe (WordSearch Char)
- wordSearch :: Grid a -> Search a -> WordSearch a
- solveWordSearch :: (Eq a, Ord a) => WordSearch a -> (Set Match, Search a)
- search :: Eq a => Grid a -> [a] -> Pos -> Maybe Match
- tryMatch :: Eq a => Grid a -> [a] -> Pos -> Dir -> Maybe Match
- readGrid :: [String] -> Grid Char
- arrayToGrid :: Ord a => Array Pos a -> Grid a
- setToSearch :: Set [a] -> Search a
- searchToSet :: Search a -> Set [a]
- fillMatches :: (Foldable t, Ord e) => e -> Grid e -> t Match -> Grid e
- showGridInsert :: a -> Grid a -> [a]
- dirs :: [Dir]
- dirs' :: Set Dir
- dirsPos :: Map Dir Pos
- dirsOpposite :: Map Dir Dir
- dirToOffset :: Dir -> Pos
- dirOpposite :: Dir -> Dir
- dirUpdatePos :: Dir -> Pos -> Pos
- inRangeOf :: Ix a => a -> Array a e -> Bool
- posPlus :: Pos -> Pos -> Pos
Types and containers
data WordSearch a Source
Abstract container of a word search puzzle
This can be created either from a Search
and a Grid
by the
wordSearch
function or from a properly formatted String
by the
readWordSearch
function.
Instances
Typeable1 WordSearch | |
Eq a => Eq (WordSearch a) | |
(Data a, Ord a) => Data (WordSearch a) | |
Ord a => Ord (WordSearch a) | |
(Ord a, Read a) => Read (WordSearch a) | |
Show a => Show (WordSearch a) |
ws_grid :: forall a[a1Pa]. :-> (WordSearch a[a1Pa]) (Grid a[a1Pa])Source
ws_search :: forall a[a1Pa]. :-> (WordSearch a[a1Pa]) (Search a[a1Pa])Source
A grid in which to search
Constructors of this container usually assume that the grid is rectangular and properly sized; this precondition is not checked.
A set of words or lists to search
A position of a grid
An individual value describing a match
WordSearch
puzzles
readWordSearch :: String -> Maybe (WordSearch Char)Source
Constructs a WordSearch
container from a properly formatted String
The String
should contain two sections, separated by at least one empty
line. The first section represents the grid, and thus is formatted as the
String that readGrid
expects. The second section represents the search
words; it contains each word on its own separate line. In the case that
is ill-formed, Nothing is returned. The precondition that each grid row
has equal length is not checked.
wordSearch :: Grid a -> Search a -> WordSearch aSource
Constructs a WordSearch
container from a Grid
and a Search
solveWordSearch :: (Eq a, Ord a) => WordSearch a -> (Set Match, Search a)Source
Solves a WordSearch
and returns a set of matches together with a set of search terms for which a match was not found in a tuple
This algorithm solves word search puzzles by looking at the first cell of each search term, and looking for a match by checking each direction from each position whose cell contains the starting cell of the search term until a match is found. The dictionary of individual cell values and sets of positions is part of the Grid
container; arrayToGrid
creates this dictionary automatically.
search :: Eq a => Grid a -> [a] -> Pos -> Maybe MatchSource
Determines whether a given Search
term can be matched at a given position of a grid
This is done by trying each direction for a match from the given location.
Grid
and Search
containers
setToSearch :: Set [a] -> Search aSource
Constructs a Search
from a set of lists
searchToSet :: Search a -> Set [a]Source
Returns the set of search terms from a Search
container
Operations on solutions and rendering Grid
s
fillMatches :: (Foldable t, Ord e) => e -> Grid e -> t Match -> Grid eSource
Creates a Grid
in which every cell that does not match is set to a default value
showGridInsert :: a -> Grid a -> [a]Source
Renders a Grid
, appending a cell, usually a newline character, after every row
Dir
s
dirsOpposite :: Map Dir DirSource
Bidirectional Map
of opposite directions
dirToOffset :: Dir -> PosSource
Returns the appropriate offset of a direction
dirOpposite :: Dir -> DirSource
Returns the opposite direction
dirUpdatePos :: Dir -> Pos -> PosSource
Updates a position by one step in the given direction