minesweeper-0.9: Step.hs

module Step
    ( step
    , RevealResult (..)
    , SquareConstraints
    ) where

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

import Configuration
import Core.Square
import Core.SquareConstraints

import Data.Ratio
import Data.List
import Data.SetClass (fromList)
import Data.Maybe
import Random
import Data.Binary


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

data RevealResult = RevealResult
    { safety        :: !Probability
    , squareState   :: !(Maybe Int)
    , rrConstraints :: !SquareConstraints
    , rrSeed        :: !RandomSeed
    }
        deriving (Show)

instance Eq RevealResult where _ == _ = True
instance Ord RevealResult where _ `compare` _ = EQ


instance Binary RevealResult where
    put = error "put on RevealResult"
    get = error "get on RevealResult"

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

step :: Configuration -> Square -> SquareConstraints -> RandomSeed -> RevealResult
step conf p cs r 
    | dead = RevealResult prob Nothing (setSum (fromList [p]) 1 cs) r'
    | otherwise = x `seq` RevealResult prob (Just x) (l !! x) r''
 where
    cs' = setSum (fromList [p]) 0 cs

    l = distribution (neighbours (size conf) p) cs'

    (dead, r') = appDeath (deathProbRange conf) (1-prob) r
    (x, r'') = appStrat (strategy conf) (map solutions l) r'

    prob = fromIntegral (solutions cs') / fromIntegral (solutions cs)


appDeath _ 0 r = (False, r)
appDeath _ 1 r = (True, r)
appDeath (a, _) p r | p <= a = (False, r)
appDeath (_, b) p r | p >= b = (True, r)
appDeath (a, b) p r = (i==0, r') where 
    (i, r') = integerDomino [c, d] r
    (c, d) = ff (p - a, b - p)

    ff (x, y) = (numerator (d*x), numerator (d*y))  where d = fromInteger $ denominator (x*y)

-- appStrat _ l r = (0, r)
appStrat Random l r 
    = integerDomino l r
appStrat HighestProb l r 
    = (fromJust $ findIndex (==y) l, r) where
        y = maximum l