src/Strat1.hs

   1 -- |
   2 -- Module      : Strat1
   3 -- Copyright   : (c) 2008 Bertram Felgenhauer
   4 -- License     : BSD3
   5 --
   6 -- Maintainer  : Bertram Felgenhauer <int-e@gmx.de>
   7 -- Stability   : experimental
   8 -- Portability : portable
   9 --
  10 -- This module is part of Haskell PGMS.
  11 --
  12 -- A simple minesweeper strategy.
  13 --
  14
  15 module Strat1 (strat1) where
  16
  17 import Mine
  18
  19 import Data.Array.IArray
  20 import System.Random
  21
  22 strat1 :: Strategy
  23 strat1 = defaultStrategy {
  24     sName        = "Strategy1",
  25     sAuthor      = "Bertram Felgenhauer <int-e@gmx.de>",
  26     sDescription =
  27         "A first attempt at implementing the Single Point Strategy. It's \
  28         \missing some forced inferences though.",
  29     sRun         = \s -> getConfig >>= \c -> worker c s
  30 }
  31
  32 worker :: Config -> StdGen -> StrategyM String
  33 worker cfg@Config { cSize = Pos sX sY } gen = worker' gen []
  34   where
  35     worker' :: StdGen -> [Pos] -> StrategyM String
  36     worker' gen [] = do
  37         vw <- getView
  38         let (x, gen') = randomR (1, sX) gen
  39             (y, gen'') = randomR (1, sY) gen'
  40             p = Pos x y
  41         if vw ! p == Hidden then
  42             move p >> worker' gen'' [p]
  43           else
  44             worker' gen'' []
  45     worker' gen (p : ps) = do
  46         vw <- getView
  47         let Exposed i = vw ! p
  48             a = neighbours cfg p
  49             m = [q | q <- a, Marked <- [vw ! q]]
  50             u = [q | q <- a, Hidden <- [vw ! q]]
  51         if length m == i then do
  52             mapM_ move u
  53             worker' gen ([r | q <- u, r <- neighbours cfg q,
  54                               Exposed _ <- [vw ! r]] ++ u ++ ps)
  55          else if length u + length m == i then do
  56             mapM_ mark u
  57             worker' gen ([r | q <- u, r <- neighbours cfg q,
  58                               Exposed _ <- [vw ! r]] ++ ps)
  59          else
  60             worker' gen ps