module Step ( step , RevealResult (..) ) where ------------------------------------------- import Configuration import Core.Square import Core.Constraints import Data.Ratio import Data.List import Data.Maybe import System.Random import Data.Binary ------------------------------------------- data RevealResult = RevealResult { safety :: !Probability , squareState :: !(Maybe Int) , rrConstraints :: !Constraints , rrSeed :: !StdGen } deriving (Show) instance Binary RevealResult where put = error "put on RevealResult" get = error "get on RevealResult" ------------------------------------------- step :: Configuration -> Square -> Constraints -> StdGen -> RevealResult step conf p cs r | dead = RevealResult prob Nothing (setSum [p] 1 cs) r_ | otherwise = x `seq` RevealResult prob (Just x) (l !! x) r' where cs' = setSum [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 Random l r = integerDomino l r appStrat HighestProb l r = (fromJust $ findIndex (==y) l, r) where y = maximum l ---------------------- -- | Get a value from a discrete distribution with the domino algorithm. integerDomino :: [Integer] -> StdGen -> (Int, StdGen) integerDomino (0: is) r = (x + 1, r') where (x, r') = integerDomino is r integerDomino l@(i: _) r | i == sl = (0, r) | otherwise = (j, r') where sl = sum l (x, r') = randomR (1, sl) r j = length $ takeWhile (