{- |
Description: Crossword puzzles
Copyright: Copyright (C) 2023 Yoo Chung
License: GPL-3.0-or-later
Maintainer: dev@chungyc.org

Some solutions to "Problems.P99" of Ninety-Nine Haskell "Problems".
-}
module Solutions.P99 (solveCrossword, randomSolveCrossword) where

import           Control.Monad
import           Control.Monad.State.Lazy
import           Data.List                (delete, sortOn, transpose)
import           Data.Map.Lazy            (Map, (!))
import qualified Data.Map.Lazy            as Map
import           Data.Maybe               (fromJust, isNothing)
import           Data.Tuple               (swap)
import           Problems.Crosswords
import           Problems.P25
import           System.Random

-- | Solve a crossword puzzle.
solveCrossword :: Crossword -> Maybe [[Maybe Char]]
solveCrossword :: Crossword -> Maybe [[Maybe Char]]
solveCrossword Crossword
p = (Maybe [[Maybe Char]], StdGen) -> Maybe [[Maybe Char]]
forall a b. (a, b) -> a
fst ((Maybe [[Maybe Char]], StdGen) -> Maybe [[Maybe Char]])
-> (Maybe [[Maybe Char]], StdGen) -> Maybe [[Maybe Char]]
forall a b. (a -> b) -> a -> b
$ Crossword -> StdGen -> (Maybe [[Maybe Char]], StdGen)
forall g.
RandomGen g =>
Crossword -> g -> (Maybe [[Maybe Char]], g)
randomSolveCrossword Crossword
p (StdGen -> (Maybe [[Maybe Char]], StdGen))
-> StdGen -> (Maybe [[Maybe Char]], StdGen)
forall a b. (a -> b) -> a -> b
$ Int -> StdGen
mkStdGen Int
99

-- | Solves a crossword puzzle.
--
-- When there is a need to make a guess, the given source of randomness is used.
randomSolveCrossword :: RandomGen g => Crossword -> g -> (Maybe [[Maybe Char]], g)
randomSolveCrossword :: forall g.
RandomGen g =>
Crossword -> g -> (Maybe [[Maybe Char]], g)
randomSolveCrossword Crossword
p g
gen = (Maybe Partial -> Maybe [[Maybe Char]]
fromPartial Maybe Partial
solution, g
gen')
  where (Maybe Partial
solution, g
gen') = Partial -> g -> (Maybe Partial, g)
forall g. RandomGen g => Partial -> g -> (Maybe Partial, g)
build (Crossword -> Partial
toPartial Crossword
p) g
gen

{- |
Partial solution being built up, and associated data supporting the buildup.

Instead of trying fill the grid directly,
the crossword puzzle is turned into a graph of sites,
where each site is associated with the list of possible words,
partially filled in characters, and definite words if found.
The edges are formed by the crossover points between sites,
and are labeled by how they cross over.

The solver will try to prune candidate words from sites,
or guess what the word for a site in a solution may be.
When a site is filled with a word, it updates its neighbors in the graph
to fill additional characters in crossing sites.

Maps are indexed by numbers which identify individual sites.
-}
data Partial = Partial
  { Partial -> (Int, Int)
sizes        :: (Int,Int)             -- ^ Number of rows and columns
  , Partial -> Map Int Site
sites        :: Map Int Site          -- ^ Sites, indexed by numbers identifiying sites

  -- The above is a static description of the puzzle.
  -- The below will be updated as the solution is built up.
  -- 'candidates' and 'partialWords' have the same keys,
  -- while 'fullWords' is keyed by their complement.

  , Partial -> Map Int [String]
candidates   :: Map Int [String]      -- ^ Possible words for each site
  , Partial -> Map Int [Maybe Char]
partialWords :: Map Int [Maybe Char]  -- ^ Partially constructed words for sites
  , Partial -> Map Int String
fullWords    :: Map Int String        -- ^ Fully constructed words for sites
  }

-- | Structure of a site in a crossword puzzle to be filled with a word.
data Site = Site
  { Site -> Int
size        :: Int               -- ^ Lenth of word that should fill the site
  , Site -> (Int, Int)
position    :: (Int,Int)         -- ^ Position in grid in (row,column)
  , Site -> Orientation
orientation :: Orientation       -- ^ Whether site is horizontal or vertical
  , Site -> [CrossoverPoint]
crossovers  :: [CrossoverPoint]  -- ^ How the site crosses over with other sites
  }

-- | Orientation of a site.
data Orientation = Horizontal | Vertical deriving Orientation -> Orientation -> Bool
(Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Bool) -> Eq Orientation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Orientation -> Orientation -> Bool
== :: Orientation -> Orientation -> Bool
$c/= :: Orientation -> Orientation -> Bool
/= :: Orientation -> Orientation -> Bool
Eq

-- | Information about a crossover point between sites.
--
-- Holds position inside site, position inside the other site, and index of other site.
data CrossoverPoint = CrossoverPoint Int Int Int

-- Functions related to turning the puzzle and solution to and from internal and external forms.

-- | Translate the crossword puzzle into a form used internally to solve the puzzle.
toPartial :: Crossword -> Partial
toPartial :: Crossword -> Partial
toPartial Crossword{ word :: Crossword -> [String]
word = [String]
ws, grid :: Crossword -> [[Either Bool Char]]
grid = [[Either Bool Char]]
g } =
  Partial { sizes :: (Int, Int)
sizes = ([[Either Bool Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Either Bool Char]]
g, [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ([Either Bool Char] -> Int) -> [[Either Bool Char]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Either Bool Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Either Bool Char]]
g)
          , sites :: Map Int Site
sites = Map Int Site
ss
          , candidates :: Map Int [String]
candidates = (Site -> [String]) -> Map Int Site -> Map Int [String]
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\Site
s -> [String] -> Int -> Map Int [String] -> [String]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] (Site -> Int
size Site
s) Map Int [String]
sizedWords) Map Int Site
ss
          , partialWords :: Map Int [Maybe Char]
partialWords = Map Int [Maybe Char]
pws
          , fullWords :: Map Int String
fullWords = Map Int String
forall k a. Map k a
Map.empty
          }
  where (Map Int Site
ss, Map Int [Maybe Char]
pws) = [[Either Bool Char]] -> (Map Int Site, Map Int [Maybe Char])
toSites [[Either Bool Char]]
g
        sizedWords :: Map Int [String]
sizedWords = ([String] -> [String] -> [String])
-> [(Int, [String])] -> Map Int [String]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
(++) ([(Int, [String])] -> Map Int [String])
-> [(Int, [String])] -> Map Int [String]
forall a b. (a -> b) -> a -> b
$ (String -> (Int, [String])) -> [String] -> [(Int, [String])]
forall a b. (a -> b) -> [a] -> [b]
map (\String
w -> (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
w, [String
w])) [String]
ws

-- | Convert a grid to sites and possible characters.
-- The latter will be 'Nothing' unless there is a prefilled character in a spot.
toSites :: [[Either Bool Char]] -> (Map Int Site, Map Int [Maybe Char])
toSites :: [[Either Bool Char]] -> (Map Int Site, Map Int [Maybe Char])
toSites [[Either Bool Char]]
g = (Map Int Site -> Map Int Site
markCrossovers Map Int Site
indexedSites, Map Int [Maybe Char]
indexedWords)
  where sitesList :: [(Site, [Maybe Char])]
sitesList = [[Either Bool Char]] -> Orientation -> [(Site, [Maybe Char])]
findSites [[Either Bool Char]]
g Orientation
Horizontal [(Site, [Maybe Char])]
-> [(Site, [Maybe Char])] -> [(Site, [Maybe Char])]
forall a. [a] -> [a] -> [a]
++ [[Either Bool Char]] -> Orientation -> [(Site, [Maybe Char])]
findSites ([[Either Bool Char]] -> [[Either Bool Char]]
forall a. [[a]] -> [[a]]
transpose [[Either Bool Char]]
g) Orientation
Vertical
        indexedSites :: Map Int Site
indexedSites = [(Int, Site)] -> Map Int Site
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Int, Site)] -> Map Int Site) -> [(Int, Site)] -> Map Int Site
forall a b. (a -> b) -> a -> b
$ [Int] -> [Site] -> [(Int, Site)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] ([Site] -> [(Int, Site)]) -> [Site] -> [(Int, Site)]
forall a b. (a -> b) -> a -> b
$ ((Site, [Maybe Char]) -> Site) -> [(Site, [Maybe Char])] -> [Site]
forall a b. (a -> b) -> [a] -> [b]
map (Site, [Maybe Char]) -> Site
forall a b. (a, b) -> a
fst [(Site, [Maybe Char])]
sitesList
        indexedWords :: Map Int [Maybe Char]
indexedWords = [(Int, [Maybe Char])] -> Map Int [Maybe Char]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Int, [Maybe Char])] -> Map Int [Maybe Char])
-> [(Int, [Maybe Char])] -> Map Int [Maybe Char]
forall a b. (a -> b) -> a -> b
$ [Int] -> [[Maybe Char]] -> [(Int, [Maybe Char])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] ([[Maybe Char]] -> [(Int, [Maybe Char])])
-> [[Maybe Char]] -> [(Int, [Maybe Char])]
forall a b. (a -> b) -> a -> b
$ ((Site, [Maybe Char]) -> [Maybe Char])
-> [(Site, [Maybe Char])] -> [[Maybe Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Site, [Maybe Char]) -> [Maybe Char]
forall a b. (a, b) -> b
snd [(Site, [Maybe Char])]
sitesList

-- | From the rows in the grid, find the sites and their prefilled characters.
findSites :: [[Either Bool Char]] -> Orientation -> [(Site, [Maybe Char])]
findSites :: [[Either Bool Char]] -> Orientation -> [(Site, [Maybe Char])]
findSites [[Either Bool Char]]
g Orientation
orient = ((Int, [Either Bool Char]) -> [(Site, [Maybe Char])])
-> [(Int, [Either Bool Char])] -> [(Site, [Maybe Char])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (State FindSitesState [(Site, [Maybe Char])]
-> FindSitesState -> [(Site, [Maybe Char])]
forall s a. State s a -> s -> a
evalState State FindSitesState [(Site, [Maybe Char])]
find (FindSitesState -> [(Site, [Maybe Char])])
-> ((Int, [Either Bool Char]) -> FindSitesState)
-> (Int, [Either Bool Char])
-> [(Site, [Maybe Char])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, [Either Bool Char]) -> FindSitesState
initial) ([(Int, [Either Bool Char])] -> [(Site, [Maybe Char])])
-> [(Int, [Either Bool Char])] -> [(Site, [Maybe Char])]
forall a b. (a -> b) -> a -> b
$ [Int] -> [[Either Bool Char]] -> [(Int, [Either Bool Char])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [[Either Bool Char]]
g
  where
    find :: State FindSitesState [(Site, [Maybe Char])]
find = do
      [Either Bool Char]
s <- (FindSitesState -> [Either Bool Char])
-> StateT FindSitesState Identity [Either Bool Char]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FindSitesState -> [Either Bool Char]
fssSpots
      [(Site, [Maybe Char])]
ls <- (FindSitesState -> [(Site, [Maybe Char])])
-> State FindSitesState [(Site, [Maybe Char])]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FindSitesState -> [(Site, [Maybe Char])]
fssLocs
      case [Either Bool Char]
s of
        []               -> [(Site, [Maybe Char])]
-> State FindSitesState [(Site, [Maybe Char])]
forall a. a -> StateT FindSitesState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [(Site, [Maybe Char])]
ls
        (Left Bool
False : [Either Bool Char]
_) -> StateT FindSitesState Identity ()
step StateT FindSitesState Identity ()
-> State FindSitesState [(Site, [Maybe Char])]
-> State FindSitesState [(Site, [Maybe Char])]
forall a b.
StateT FindSitesState Identity a
-> StateT FindSitesState Identity b
-> StateT FindSitesState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> State FindSitesState [(Site, [Maybe Char])]
find
        [Either Bool Char]
_                -> State FindSitesState [(Site, [Maybe Char])]
startLocation

    startLocation :: State FindSitesState [(Site, [Maybe Char])]
startLocation = do
      (FindSitesState -> FindSitesState)
-> StateT FindSitesState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((FindSitesState -> FindSitesState)
 -> StateT FindSitesState Identity ())
-> (FindSitesState -> FindSitesState)
-> StateT FindSitesState Identity ()
forall a b. (a -> b) -> a -> b
$ \FindSitesState
s -> FindSitesState
s { fssStart = fssPos s
                       , fssSize = 0
                       , fssChars = []
                       }
      State FindSitesState [(Site, [Maybe Char])]
extract

    extract :: State FindSitesState [(Site, [Maybe Char])]
extract = do
      [Either Bool Char]
s <- (FindSitesState -> [Either Bool Char])
-> StateT FindSitesState Identity [Either Bool Char]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FindSitesState -> [Either Bool Char]
fssSpots
      case [Either Bool Char]
s of
        Right Char
c : [Either Bool Char]
_   -> Maybe Char -> State FindSitesState [(Site, [Maybe Char])]
addSpot (Maybe Char -> State FindSitesState [(Site, [Maybe Char])])
-> Maybe Char -> State FindSitesState [(Site, [Maybe Char])]
forall a b. (a -> b) -> a -> b
$ Char -> Maybe Char
forall a. a -> Maybe a
Just Char
c
        Left Bool
True : [Either Bool Char]
_ -> Maybe Char -> State FindSitesState [(Site, [Maybe Char])]
addSpot Maybe Char
forall a. Maybe a
Nothing
        [Either Bool Char]
_             -> State FindSitesState [(Site, [Maybe Char])]
endLocation

    addSpot :: Maybe Char -> State FindSitesState [(Site, [Maybe Char])]
addSpot Maybe Char
s =  do
      (FindSitesState -> FindSitesState)
-> StateT FindSitesState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((FindSitesState -> FindSitesState)
 -> StateT FindSitesState Identity ())
-> (FindSitesState -> FindSitesState)
-> StateT FindSitesState Identity ()
forall a b. (a -> b) -> a -> b
$ \FindSitesState
st -> FindSitesState
st { fssSize = 1 + fssSize st
                         , fssChars = s : fssChars st
                         }
      StateT FindSitesState Identity ()
step
      State FindSitesState [(Site, [Maybe Char])]
extract

    endLocation :: State FindSitesState [(Site, [Maybe Char])]
endLocation = do
      FindSitesState
st <- StateT FindSitesState Identity FindSitesState
forall s (m :: * -> *). MonadState s m => m s
get
      let s :: Site
s = Site { size :: Int
size = FindSitesState -> Int
fssSize FindSitesState
st
                   , position :: (Int, Int)
position = case Orientation
orient of
                       Orientation
Horizontal -> (FindSitesState -> Int
fssRow FindSitesState
st, FindSitesState -> Int
fssStart FindSitesState
st)
                       Orientation
Vertical   -> (FindSitesState -> Int
fssStart FindSitesState
st, FindSitesState -> Int
fssRow FindSitesState
st)
                   , orientation :: Orientation
orientation = Orientation
orient
                   , crossovers :: [CrossoverPoint]
crossovers = []
                   }
      Bool
-> StateT FindSitesState Identity ()
-> StateT FindSitesState Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FindSitesState -> Int
fssSize FindSitesState
st Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (StateT FindSitesState Identity ()
 -> StateT FindSitesState Identity ())
-> StateT FindSitesState Identity ()
-> StateT FindSitesState Identity ()
forall a b. (a -> b) -> a -> b
$
        FindSitesState -> StateT FindSitesState Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put FindSitesState
st { fssLocs = (s, reverse $ fssChars st) : fssLocs st }
      State FindSitesState [(Site, [Maybe Char])]
find

    initial :: (Int, [Either Bool Char]) -> FindSitesState
initial (Int
row, [Either Bool Char]
line) = FindSitesState { fssSpots :: [Either Bool Char]
fssSpots = [Either Bool Char]
line
                                         , fssRow :: Int
fssRow = Int
row
                                         , fssPos :: Int
fssPos = Int
0
                                         , fssStart :: Int
fssStart = Int
0
                                         , fssSize :: Int
fssSize = Int
0
                                         , fssChars :: [Maybe Char]
fssChars = []
                                         , fssLocs :: [(Site, [Maybe Char])]
fssLocs = []
                                         }
    step :: StateT FindSitesState Identity ()
step = (FindSitesState -> FindSitesState)
-> StateT FindSitesState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((FindSitesState -> FindSitesState)
 -> StateT FindSitesState Identity ())
-> (FindSitesState -> FindSitesState)
-> StateT FindSitesState Identity ()
forall a b. (a -> b) -> a -> b
$ \FindSitesState
st -> FindSitesState
st { fssSpots = case fssSpots st of
                                  [] -> String -> [Either Bool Char]
forall a. HasCallStack => String -> a
error String
"no more spots"
                                  (Either Bool Char
_:[Either Bool Char]
xs) -> [Either Bool Char]
xs
                              , fssPos = 1 + fssPos st
                              }

-- | Monadic state for findSites.
data FindSitesState = FindSitesState
  { FindSitesState -> [Either Bool Char]
fssSpots :: [Either Bool Char]
  , FindSitesState -> Int
fssRow   :: Int
  , FindSitesState -> Int
fssPos   :: Int
  , FindSitesState -> Int
fssStart :: Int
  , FindSitesState -> Int
fssSize  :: Int
  , FindSitesState -> [Maybe Char]
fssChars :: [Maybe Char]
  , FindSitesState -> [(Site, [Maybe Char])]
fssLocs  :: [(Site, [Maybe Char])]
  }

-- | Mark the crossover points in each site.
markCrossovers :: Map Int Site -> Map Int Site
markCrossovers :: Map Int Site -> Map Int Site
markCrossovers Map Int Site
sitesMap = (Map Int Site -> (Int, Int) -> [Int] -> Map Int Site)
-> Map Int Site -> Map (Int, Int) [Int] -> Map Int Site
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey Map Int Site -> (Int, Int) -> [Int] -> Map Int Site
mark Map Int Site
sitesMap Map (Int, Int) [Int]
crossoverSpots
  where taggedSpots :: Map (Int, Int) [Int]
taggedSpots = Map Int Site -> Map (Int, Int) [Int]
tagSpots Map Int Site
sitesMap
        crossoverSpots :: Map (Int, Int) [Int]
crossoverSpots = ([Int] -> Bool) -> Map (Int, Int) [Int] -> Map (Int, Int) [Int]
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(<) Int
1 (Int -> Bool) -> ([Int] -> Int) -> [Int] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) Map (Int, Int) [Int]
taggedSpots
        mark :: Map Int Site -> (Int, Int) -> [Int] -> Map Int Site
mark Map Int Site
sitesMap' (Int, Int)
pos [Int]
siteIndexes = (Site -> Site -> Site)
-> Map Int Site -> Map Int Site -> Map Int Site
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Site -> Site -> Site
mergeSite (Map Int Site -> (Int, Int) -> [Int] -> Map Int Site
markedSites Map Int Site
sitesMap' (Int, Int)
pos [Int]
siteIndexes) Map Int Site
sitesMap'
        mergeSite :: Site -> Site -> Site
mergeSite s :: Site
s@Site{ crossovers :: Site -> [CrossoverPoint]
crossovers = [CrossoverPoint]
c } Site{ crossovers :: Site -> [CrossoverPoint]
crossovers = [CrossoverPoint]
c' } = Site
s { crossovers = c ++ c' }
        markedSites :: Map Int Site -> (Int, Int) -> [Int] -> Map Int Site
markedSites Map Int Site
m (Int, Int)
p [Int]
is = [(Int, Site)] -> Map Int Site
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Int, Site)] -> Map Int Site) -> [(Int, Site)] -> Map Int Site
forall a b. (a -> b) -> a -> b
$ (Int -> (Int, Site)) -> [Int] -> [(Int, Site)]
forall a b. (a -> b) -> [a] -> [b]
map (Map Int Site -> (Int, Int) -> [Int] -> Int -> (Int, Site)
markSite Map Int Site
m (Int, Int)
p [Int]
is) [Int]
is
        markSite :: Map Int Site -> (Int, Int) -> [Int] -> Int -> (Int, Site)
markSite Map Int Site
m (Int, Int)
pos [Int]
indexes Int
index =
          let site :: Site
site = Map Int Site
m Map Int Site -> Int -> Site
forall k a. Ord k => Map k a -> k -> a
! Int
index
              indexes' :: [Int]
indexes' = Int -> [Int] -> [Int]
forall a. Eq a => a -> [a] -> [a]
delete Int
index [Int]
indexes
              cs :: [CrossoverPoint]
cs = (Int -> CrossoverPoint) -> [Int] -> [CrossoverPoint]
forall a b. (a -> b) -> [a] -> [b]
map (Map Int Site -> (Int, Int) -> Site -> Int -> CrossoverPoint
getCrossover Map Int Site
m (Int, Int)
pos Site
site) [Int]
indexes'
          in (Int
index, Site
site { crossovers = cs })
        getCrossover :: Map Int Site -> (Int, Int) -> Site -> Int -> CrossoverPoint
getCrossover Map Int Site
m (Int
row,Int
column) Site
site Int
index =
          let otherSite :: Site
otherSite = Map Int Site
m Map Int Site -> Int -> Site
forall k a. Ord k => Map k a -> k -> a
! Int
index
              offset :: Site -> Int
offset Site {position :: Site -> (Int, Int)
position = (Int
_,Int
c), orientation :: Site -> Orientation
orientation = Orientation
Horizontal} = Int
column Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
c
              offset Site {position :: Site -> (Int, Int)
position = (Int
r,Int
_), orientation :: Site -> Orientation
orientation = Orientation
Vertical}   = Int
row Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
r
          in Int -> Int -> Int -> CrossoverPoint
CrossoverPoint (Site -> Int
offset Site
site) (Site -> Int
offset Site
otherSite) Int
index

-- | Tag each spot in the grid with the sites located on the spot.
tagSpots :: Map Int Site -> Map (Int,Int) [Int]
tagSpots :: Map Int Site -> Map (Int, Int) [Int]
tagSpots = (Map (Int, Int) [Int] -> Int -> Site -> Map (Int, Int) [Int])
-> Map (Int, Int) [Int] -> Map Int Site -> Map (Int, Int) [Int]
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey Map (Int, Int) [Int] -> Int -> Site -> Map (Int, Int) [Int]
forall {a}. Map (Int, Int) [a] -> a -> Site -> Map (Int, Int) [a]
tag Map (Int, Int) [Int]
forall k a. Map k a
Map.empty
  where tag :: Map (Int, Int) [a] -> a -> Site -> Map (Int, Int) [a]
tag Map (Int, Int) [a]
taggedSpots a
index Site
site = ([a] -> [a] -> [a])
-> Map (Int, Int) [a] -> Map (Int, Int) [a] -> Map (Int, Int) [a]
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) Map (Int, Int) [a]
taggedSpots (Map (Int, Int) [a] -> Map (Int, Int) [a])
-> Map (Int, Int) [a] -> Map (Int, Int) [a]
forall a b. (a -> b) -> a -> b
$ a -> Site -> Map (Int, Int) [a]
forall {a}. a -> Site -> Map (Int, Int) [a]
siteSpots a
index Site
site
        siteSpots :: a -> Site -> Map (Int, Int) [a]
siteSpots a
index Site
site = [((Int, Int), [a])] -> Map (Int, Int) [a]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([((Int, Int), [a])] -> Map (Int, Int) [a])
-> [((Int, Int), [a])] -> Map (Int, Int) [a]
forall a b. (a -> b) -> a -> b
$ ((Int, Int) -> ((Int, Int), [a]))
-> [(Int, Int)] -> [((Int, Int), [a])]
forall a b. (a -> b) -> [a] -> [b]
map (,[a
index]) ([(Int, Int)] -> [((Int, Int), [a])])
-> [(Int, Int)] -> [((Int, Int), [a])]
forall a b. (a -> b) -> a -> b
$ Site -> [(Int, Int)]
positions Site
site
        positions :: Site -> [(Int, Int)]
positions Site { size :: Site -> Int
size = Int
n, position :: Site -> (Int, Int)
position = (Int, Int)
pos, orientation :: Site -> Orientation
orientation = Orientation
o } = Int -> (Int, Int) -> Orientation -> [(Int, Int)]
forall {a}.
(Enum a, Num a) =>
a -> (a, a) -> Orientation -> [(a, a)]
getPositions Int
n (Int, Int)
pos Orientation
o
        getPositions :: a -> (a, a) -> Orientation -> [(a, a)]
getPositions a
n (a
row,a
column) Orientation
Horizontal = [(a
row, a
columna -> a -> a
forall a. Num a => a -> a -> a
+a
i) | a
i <- [a
0..a
na -> a -> a
forall a. Num a => a -> a -> a
-a
1]]
        getPositions a
n (a
row,a
column) Orientation
Vertical   = [(a
rowa -> a -> a
forall a. Num a => a -> a -> a
+a
i, a
column) | a
i <- [a
0..a
na -> a -> a
forall a. Num a => a -> a -> a
-a
1]]

-- | Convert the internal form used for solving the puzzle to the form returned by 'solveCrossword'.
fromPartial :: Maybe Partial -> Maybe [[Maybe Char]]
fromPartial :: Maybe Partial -> Maybe [[Maybe Char]]
fromPartial Maybe Partial
Nothing  = Maybe [[Maybe Char]]
forall a. Maybe a
Nothing
fromPartial (Just Partial
s) = [[Maybe Char]] -> Maybe [[Maybe Char]]
forall a. a -> Maybe a
Just [[Maybe Char]]
g'
  where (Int
rowCount, Int
columnCount) = Partial -> (Int, Int)
sizes Partial
s
        blank :: [[Maybe a]]
blank = Int -> [Maybe a] -> [[Maybe a]]
forall a. Int -> a -> [a]
replicate Int
rowCount ([Maybe a] -> [[Maybe a]]) -> [Maybe a] -> [[Maybe a]]
forall a b. (a -> b) -> a -> b
$ Int -> Maybe a -> [Maybe a]
forall a. Int -> a -> [a]
replicate Int
columnCount Maybe a
forall a. Maybe a
Nothing
        wordSites :: [(Site, String)]
wordSites = [Site] -> [String] -> [(Site, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Map Int Site -> [Site]
forall k a. Map k a -> [a]
Map.elems (Map Int Site -> [Site]) -> Map Int Site -> [Site]
forall a b. (a -> b) -> a -> b
$ Partial -> Map Int Site
sites Partial
s) (Map Int String -> [String]
forall k a. Map k a -> [a]
Map.elems (Map Int String -> [String]) -> Map Int String -> [String]
forall a b. (a -> b) -> a -> b
$ Partial -> Map Int String
fullWords Partial
s)
        horizWordSites :: [(Site, String)]
horizWordSites = ((Site, String) -> Bool) -> [(Site, String)] -> [(Site, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Orientation -> Orientation -> Bool
forall a. Eq a => a -> a -> Bool
(==) Orientation
Horizontal (Orientation -> Bool)
-> ((Site, String) -> Orientation) -> (Site, String) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Site -> Orientation
orientation (Site -> Orientation)
-> ((Site, String) -> Site) -> (Site, String) -> Orientation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Site, String) -> Site
forall a b. (a, b) -> a
fst) [(Site, String)]
wordSites
        vertWordSites :: [(Site, String)]
vertWordSites = ((Site, String) -> Bool) -> [(Site, String)] -> [(Site, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Orientation -> Orientation -> Bool
forall a. Eq a => a -> a -> Bool
(==) Orientation
Vertical (Orientation -> Bool)
-> ((Site, String) -> Orientation) -> (Site, String) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Site -> Orientation
orientation (Site -> Orientation)
-> ((Site, String) -> Site) -> (Site, String) -> Orientation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Site, String) -> Site
forall a b. (a, b) -> a
fst) [(Site, String)]
wordSites
        g :: [[Maybe Char]]
g  = ([[Maybe Char]] -> (Site, String) -> [[Maybe Char]])
-> [[Maybe Char]] -> [(Site, String)] -> [[Maybe Char]]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [[Maybe Char]] -> (Site, String) -> [[Maybe Char]]
incorporateWord [[Maybe Char]]
forall {a}. [[Maybe a]]
blank [(Site, String)]
horizWordSites
        g' :: [[Maybe Char]]
g' = [[Maybe Char]] -> [[Maybe Char]]
forall a. [[a]] -> [[a]]
transpose ([[Maybe Char]] -> [[Maybe Char]])
-> [[Maybe Char]] -> [[Maybe Char]]
forall a b. (a -> b) -> a -> b
$ ([[Maybe Char]] -> (Site, String) -> [[Maybe Char]])
-> [[Maybe Char]] -> [(Site, String)] -> [[Maybe Char]]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [[Maybe Char]] -> (Site, String) -> [[Maybe Char]]
incorporateWord ([[Maybe Char]] -> [[Maybe Char]]
forall a. [[a]] -> [[a]]
transpose [[Maybe Char]]
g) [(Site, String)]
vertWordSites

-- | Incorporate the given word at the given site into the crossword grid.
incorporateWord :: [[Maybe Char]] -> (Site, String) -> [[Maybe Char]]
incorporateWord :: [[Maybe Char]] -> (Site, String) -> [[Maybe Char]]
incorporateWord [[Maybe Char]]
g (Site
s, String
w) = Int -> [[Maybe Char]] -> [[Maybe Char]]
forall a. Int -> [a] -> [a]
take Int
r [[Maybe Char]]
g [[Maybe Char]] -> [[Maybe Char]] -> [[Maybe Char]]
forall a. [a] -> [a] -> [a]
++ [[Maybe Char]
row'] [[Maybe Char]] -> [[Maybe Char]] -> [[Maybe Char]]
forall a. [a] -> [a] -> [a]
++ Int -> [[Maybe Char]] -> [[Maybe Char]]
forall a. Int -> [a] -> [a]
drop (Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [[Maybe Char]]
g
  where (Int
r,Int
c) = case Site -> Orientation
orientation Site
s of
          Orientation
Horizontal -> Site -> (Int, Int)
position Site
s
          Orientation
Vertical   -> (Int, Int) -> (Int, Int)
forall a b. (a, b) -> (b, a)
swap ((Int, Int) -> (Int, Int)) -> (Int, Int) -> (Int, Int)
forall a b. (a -> b) -> a -> b
$ Site -> (Int, Int)
position Site
s
        row :: [Maybe Char]
row = [[Maybe Char]]
g [[Maybe Char]] -> Int -> [Maybe Char]
forall a. HasCallStack => [a] -> Int -> a
!! Int
r
        row' :: [Maybe Char]
row' = Int -> [Maybe Char] -> [Maybe Char]
forall a. Int -> [a] -> [a]
take Int
c [Maybe Char]
row [Maybe Char] -> [Maybe Char] -> [Maybe Char]
forall a. [a] -> [a] -> [a]
++ (Char -> Maybe Char) -> String -> [Maybe Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Maybe Char
forall a. a -> Maybe a
Just String
w [Maybe Char] -> [Maybe Char] -> [Maybe Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Maybe Char] -> [Maybe Char]
forall a. Int -> [a] -> [a]
drop (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
w) [Maybe Char]
row

-- Functions that are responsible for actually solving a crossword puzzle.

{- |
High-level driving function for solving the crossword puzzle.

1. Determine as many letters and word placements that are definite.

2. If all blank spots are filled, we have a solution.
   If we are in a state where a contradiction is inevitable,
   there is no solution.

3. If there are no more letters or words that can be placed definitely,
   guess a word placement and go back to 1.
-}
build :: RandomGen g => Partial -> g -> (Maybe Partial, g)
build :: forall g. RandomGen g => Partial -> g -> (Maybe Partial, g)
build Partial
partial g
gen
  | Map Int [Maybe Char] -> Bool
forall k a. Map k a -> Bool
Map.null Map Int [Maybe Char]
pws           = (Partial -> Maybe Partial
forall a. a -> Maybe a
Just Partial
partial, g
gen)
  | Maybe Partial -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Partial
maybePartial = (Maybe Partial
forall a. Maybe a
Nothing, g
gen)
  | Bool
isUnchanged            = Partial -> g -> (Maybe Partial, g)
forall g. RandomGen g => Partial -> g -> (Maybe Partial, g)
guess Partial
partial g
gen
  | Bool
otherwise              = Partial -> g -> (Maybe Partial, g)
forall g. RandomGen g => Partial -> g -> (Maybe Partial, g)
build Partial
partial' g
gen
  where cs :: Map Int [String]
cs = Partial -> Map Int [String]
candidates Partial
partial
        pws :: Map Int [Maybe Char]
pws = Partial -> Map Int [Maybe Char]
partialWords Partial
partial
        fws :: Map Int String
fws = Partial -> Map Int String
fullWords Partial
partial
        maybePartial :: Maybe Partial
maybePartial = Partial -> Maybe Partial
infer Partial
partial
        partial' :: Partial
partial' = Maybe Partial -> Partial
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Partial
maybePartial
        isUnchanged :: Bool
isUnchanged = (Map Int [String]
cs, Map Int [Maybe Char]
pws, Map Int String
fws) (Map Int [String], Map Int [Maybe Char], Map Int String)
-> (Map Int [String], Map Int [Maybe Char], Map Int String) -> Bool
forall a. Eq a => a -> a -> Bool
== (Partial -> Map Int [String]
candidates Partial
partial', Partial -> Map Int [Maybe Char]
partialWords Partial
partial', Partial -> Map Int String
fullWords Partial
partial')

-- | Infer further placements of letters and words.
infer :: Partial -> Maybe Partial
infer :: Partial -> Maybe Partial
infer Partial
partial = (Partial -> Int -> Maybe Partial)
-> Partial -> [Int] -> Maybe Partial
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Partial -> Int -> Maybe Partial
pruneSiteCandidateWords Partial
partial ([Int] -> Maybe Partial) -> [Int] -> Maybe Partial
forall a b. (a -> b) -> a -> b
$ Map Int [String] -> [Int]
forall k a. Map k a -> [k]
Map.keys (Map Int [String] -> [Int]) -> Map Int [String] -> [Int]
forall a b. (a -> b) -> a -> b
$ Partial -> Map Int [String]
candidates Partial
partial

-- | Prune candidate words that are not possible from the given site.
pruneSiteCandidateWords :: Partial -> Int -> Maybe Partial
pruneSiteCandidateWords :: Partial -> Int -> Maybe Partial
pruneSiteCandidateWords Partial
partial Int
index = case [String]
cs' of
  []  -> Maybe Partial
forall a. Maybe a
Nothing
  [String
c] -> Partial -> Maybe Partial
forall a. a -> Maybe a
Just (Partial -> Maybe Partial) -> Partial -> Maybe Partial
forall a b. (a -> b) -> a -> b
$ Partial -> Int -> String -> Partial
affixWord Partial
partial Int
index String
c
  [String]
_   -> Partial -> Maybe Partial
forall a. a -> Maybe a
Just (Partial -> Maybe Partial) -> Partial -> Maybe Partial
forall a b. (a -> b) -> a -> b
$ Partial
partial { candidates = Map.insert index cs' $ candidates partial }
  where cs' :: [String]
cs' = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Maybe Char] -> String -> Bool
isConsistentWord [Maybe Char]
pw) [String]
cs
        cs :: [String]
cs = Partial -> Map Int [String]
candidates Partial
partial Map Int [String] -> Int -> [String]
forall k a. Ord k => Map k a -> k -> a
! Int
index
        pw :: [Maybe Char]
pw = Partial -> Map Int [Maybe Char]
partialWords Partial
partial Map Int [Maybe Char] -> Int -> [Maybe Char]
forall k a. Ord k => Map k a -> k -> a
! Int
index

-- | Whether a word is consistent with the characters that have been determined so far.
isConsistentWord :: [Maybe Char] -> String -> Bool
isConsistentWord :: [Maybe Char] -> String -> Bool
isConsistentWord [] []                   = Bool
True
isConsistentWord (Maybe Char
Nothing : [Maybe Char]
xs) (Char
_ : String
ys) = [Maybe Char] -> String -> Bool
isConsistentWord [Maybe Char]
xs String
ys
isConsistentWord (Just Char
x : [Maybe Char]
xs) (Char
y : String
ys)  = Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
y Bool -> Bool -> Bool
&& [Maybe Char] -> String -> Bool
isConsistentWord [Maybe Char]
xs String
ys
isConsistentWord [Maybe Char]
_ String
_                     = Bool
False

-- | Affix a word to a site, and all the other changes this entails.
affixWord :: Partial -> Int -> String -> Partial
affixWord :: Partial -> Int -> String -> Partial
affixWord Partial
p Int
i String
w = (Partial -> CrossoverPoint -> Partial)
-> Partial -> [CrossoverPoint] -> Partial
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Partial -> CrossoverPoint -> Partial
fill Partial
p' ([CrossoverPoint] -> Partial) -> [CrossoverPoint] -> Partial
forall a b. (a -> b) -> a -> b
$ Site -> [CrossoverPoint]
crossovers (Site -> [CrossoverPoint]) -> Site -> [CrossoverPoint]
forall a b. (a -> b) -> a -> b
$ Partial -> Map Int Site
sites Partial
p' Map Int Site -> Int -> Site
forall k a. Ord k => Map k a -> k -> a
! Int
i
  where p' :: Partial
p' = Partial
p { candidates = Map.delete i $ remove $ candidates p
               , partialWords = Map.delete i $ partialWords p
               , fullWords = Map.insert i w $ fullWords p
               }
        fill :: Partial -> CrossoverPoint -> Partial
fill Partial
q (CrossoverPoint Int
pos Int
pos' Int
i') =
          case Int -> Map Int [Maybe Char] -> Maybe [Maybe Char]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
i' (Map Int [Maybe Char] -> Maybe [Maybe Char])
-> Map Int [Maybe Char] -> Maybe [Maybe Char]
forall a b. (a -> b) -> a -> b
$ Partial -> Map Int [Maybe Char]
partialWords Partial
q of
            Maybe [Maybe Char]
Nothing -> Partial
q
            Just [Maybe Char]
w' -> let w'' :: [Maybe Char]
w'' = Int -> [Maybe Char] -> [Maybe Char]
forall a. Int -> [a] -> [a]
take Int
pos' [Maybe Char]
w' [Maybe Char] -> [Maybe Char] -> [Maybe Char]
forall a. [a] -> [a] -> [a]
++ [Char -> Maybe Char
forall a. a -> Maybe a
Just (Char -> Maybe Char) -> Char -> Maybe Char
forall a b. (a -> b) -> a -> b
$ String
w String -> Int -> Char
forall a. HasCallStack => [a] -> Int -> a
!! Int
pos] [Maybe Char] -> [Maybe Char] -> [Maybe Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Maybe Char] -> [Maybe Char]
forall a. Int -> [a] -> [a]
drop (Int
pos'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [Maybe Char]
w'
                       in Partial
q { partialWords = Map.insert i' w'' $ partialWords q }
        remove :: Map k [String] -> Map k [String]
remove = ([String] -> [String]) -> Map k [String] -> Map k [String]
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (String -> [String] -> [String]
forall a. Eq a => a -> [a] -> [a]
delete String
w)

-- | If no further sites can be definitely filled,
-- pick a site and guess a word to fill it with,
-- and continue to definitely fill the puzzle.
guess :: RandomGen g => Partial -> g -> (Maybe Partial, g)
guess :: forall g. RandomGen g => Partial -> g -> (Maybe Partial, g)
guess Partial
p = State g (Maybe Partial) -> g -> (Maybe Partial, g)
forall s a. State s a -> s -> (a, s)
runState (Partial -> State g (Maybe Partial)
forall g. RandomGen g => Partial -> State g (Maybe Partial)
guess' Partial
p)

guess' :: RandomGen g => Partial -> State g (Maybe Partial)
guess' :: forall g. RandomGen g => Partial -> State g (Maybe Partial)
guess' Partial
p = do
  [Int]
tiebreakers <- do g
gen <- (g -> (g, g)) -> StateT g Identity g
forall a. (g -> (a, g)) -> StateT g Identity a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state g -> (g, g)
forall g. RandomGen g => g -> (g, g)
split
                    [Int] -> StateT g Identity [Int]
forall a. a -> StateT g Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (g -> [Int]
forall g. RandomGen g => g -> [Int]
forall a g. (Random a, RandomGen g) => g -> [a]
randoms g
gen :: [Int])
  let sitePicks :: [(Int, Int)]
sitePicks = ((Int, Int) -> (Int, Int, Int)) -> [(Int, Int)] -> [(Int, Int)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Int, Int) -> (Int, Int, Int)
forall {c}. (c, Int) -> (Int, Int, c)
count ([(Int, Int)] -> [(Int, Int)]) -> [(Int, Int)] -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
tiebreakers ([Int] -> [(Int, Int)]) -> [Int] -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ Map Int [String] -> [Int]
forall k a. Map k a -> [k]
Map.keys (Map Int [String] -> [Int]) -> Map Int [String] -> [Int]
forall a b. (a -> b) -> a -> b
$ Partial -> Map Int [String]
candidates Partial
p
  let siteIndex :: Int
siteIndex = (Int, Int) -> Int
forall a b. (a, b) -> b
snd ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ case [(Int, Int)]
sitePicks of
        ((Int, Int)
x:[(Int, Int)]
_) -> (Int, Int)
x
        [] -> String -> (Int, Int)
forall a. HasCallStack => String -> a
error String
"no more sites"
  [String]
wordList <- (g -> ([String], g)) -> StateT g Identity [String]
forall a. (g -> (a, g)) -> StateT g Identity a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state ((g -> ([String], g)) -> StateT g Identity [String])
-> (g -> ([String], g)) -> StateT g Identity [String]
forall a b. (a -> b) -> a -> b
$ [String] -> g -> ([String], g)
forall g a. RandomGen g => [a] -> g -> ([a], g)
randomPermute ([String] -> g -> ([String], g)) -> [String] -> g -> ([String], g)
forall a b. (a -> b) -> a -> b
$ Partial -> Map Int [String]
candidates Partial
p Map Int [String] -> Int -> [String]
forall k a. Ord k => Map k a -> k -> a
! Int
siteIndex
  (g -> (Maybe Partial, g)) -> State g (Maybe Partial)
forall a. (g -> (a, g)) -> StateT g Identity a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state ((g -> (Maybe Partial, g)) -> State g (Maybe Partial))
-> (g -> (Maybe Partial, g)) -> State g (Maybe Partial)
forall a b. (a -> b) -> a -> b
$ Partial -> Int -> [String] -> g -> (Maybe Partial, g)
forall g.
RandomGen g =>
Partial -> Int -> [String] -> g -> (Maybe Partial, g)
tryGuesses Partial
p Int
siteIndex [String]
wordList
  where
    count :: (c, Int) -> (Int, Int, c)
count (c
tag, Int
i) =
      -- Try sites with fewer candidates first.
      ( [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([String] -> Int) -> [String] -> Int
forall a b. (a -> b) -> a -> b
$ Partial -> Map Int [String]
candidates Partial
p Map Int [String] -> Int -> [String]
forall k a. Ord k => Map k a -> k -> a
! Int
i
      -- If above equal, try sites with fewer indefinite spots first.
      , [Maybe Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Maybe Char] -> Int) -> [Maybe Char] -> Int
forall a b. (a -> b) -> a -> b
$ (Maybe Char -> Bool) -> [Maybe Char] -> [Maybe Char]
forall a. (a -> Bool) -> [a] -> [a]
filter Maybe Char -> Bool
forall a. Maybe a -> Bool
isNothing ([Maybe Char] -> [Maybe Char]) -> [Maybe Char] -> [Maybe Char]
forall a b. (a -> b) -> a -> b
$ Partial -> Map Int [Maybe Char]
partialWords Partial
p Map Int [Maybe Char] -> Int -> [Maybe Char]
forall k a. Ord k => Map k a -> k -> a
! Int
i
      -- Random tiebreaker.
      , c
tag)

-- | Try each guess for a site in the given order.
-- It will return the first solution it can find, if any.
tryGuesses :: RandomGen g => Partial -> Int -> [String] -> g -> (Maybe Partial, g)
tryGuesses :: forall g.
RandomGen g =>
Partial -> Int -> [String] -> g -> (Maybe Partial, g)
tryGuesses Partial
_ Int
_ [] g
gen = (Maybe Partial
forall a. Maybe a
Nothing, g
gen)
tryGuesses Partial
p Int
i (String
w:[String]
ws) g
gen =
  case Partial -> g -> (Maybe Partial, g)
forall g. RandomGen g => Partial -> g -> (Maybe Partial, g)
build (Partial -> Int -> String -> Partial
affixWord Partial
p Int
i String
w) g
gen of
    (Maybe Partial
Nothing, g
gen') -> Partial -> Int -> [String] -> g -> (Maybe Partial, g)
forall g.
RandomGen g =>
Partial -> Int -> [String] -> g -> (Maybe Partial, g)
tryGuesses Partial
p Int
i [String]
ws g
gen'
    (Maybe Partial, g)
solution        -> (Maybe Partial, g)
solution