minesweeper-0.8.8: Core/Constraints.lhs

-- | Core data type for the game.

> module Core.Constraints
>     ( Constraints
>     , initConstraints
>     , setSum
>     , solutions
>     , distribution
>     , clearProb
>     ) where

> import Core.Square
> import Core.BitField
> import Data.PContainer
> import qualified Data.Set as S

--------------------------------

> type Constraints 
>     = CachedSize 
>         (Maybe 
>            (EitherC (EmptyEqual Square)
>              (Tr (S.Set Square) (SetAsEmptyEqual Square))
>              (EitherC (SmallStuff (Equal Square))
>                (Index (Equal Square))
>                [Equal Square]
>              )
>            )
>         )

> solutions :: Constraints -> Integer
> solutions = subsetsNum

> setSum :: [Square] -> Int -> Constraints -> Constraints
> setSum ps v c
>     = setSum' (Equal (S.fromList ps) v) c


> initConstraints :: Board -> Int -> Constraints
> initConstraints s m 
>     = setSum (squares s) m $ emptySubsets S.empty

> clearProb :: Square -> Constraints -> Rational
> clearProb p g
>    = fromIntegral (solutions $ setSum [p] 0 g) / fromIntegral (solutions g)

> distribution :: [Square] -> Constraints -> [Constraints]
> distribution ps cs 
>     = at ((/=0) . solutions) 
>          (takeWhile ((/=0) . solutions))
>          [setSum ps i cs | i<-[0..length ps]]


Auxiliary
---------

> foldrTill :: (a -> Bool) -> (a -> b -> b) -> ([a] -> b) -> [a] -> b
> foldrTill p c n (x:xs) | p x = x `c` foldrTill p c n xs
> foldrTill _ _ n xs = n xs

> at :: (a -> Bool) -> ([a] -> [a]) -> [a] -> [a]
> at p = foldrTill (not . p) (:)