minesweeper-0.9: Core/SquareConstraints.lhs

> {-# LANGUAGE TypeFamilies, FlexibleContexts, UndecidableInstances, ScopedTypeVariables, EmptyDataDecls #-}

-- | Core data type for the game.

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

> import Data.SetClass
> import Core.Square
> import Core.Constraint 
> import qualified Core.Constraints as B

> import Prelude hiding (null)

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

> type SquareConstraints 
>   = B.CachedSize
>       (Maybe 
>           (B.DetachExtreme B.Const0Fun
>               (B.DetachExtreme B.IdFun
>                   [Constraint SquareSet]
>               )
>           )
>       )

> solutions :: SquareConstraints -> Integer
> solutions = B.solutions

> setSum :: SquareSet -> Int -> SquareConstraints -> SquareConstraints
> setSum s i = B.addConstraint $ constraint s i

> initConstraints :: BoardSize -> Int -> SquareConstraints
> initConstraints s m 
>     = setSum (squares s) m B.emptyConstraints

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

> distribution :: SquareSet -> SquareConstraints -> [SquareConstraints]
> distribution ps cs 
>     = at ((/=0) . solutions) 
>          (takeWhile ((/=0) . solutions))
>          [setSum ps i cs | i<-[0..size ps]]


Auxiliary
---------

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

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