ti3-sampler

Sample random locations on a TI3 board.
git clone git://git.jtobin.io/ti3-sampler.git
Log | Files | Refs | README | LICENSE

Main.hs (3441B)

      1 {-# OPTIONS_GHC -Wall #-}
      2 
      3 import Control.Monad.Primitive
      4 import qualified Data.Map.Strict as MS
      5 import System.Random.MWC
      6 import System.Random.MWC.Distributions (bernoulli)
      7 import System.Environment
      8 
      9 data Players =
     10     Three
     11   | Four
     12   | Five
     13   | Six
     14 
     15 data Coord =
     16     Rex
     17   | Inner Int
     18   | Mid Int
     19   | Outer Int
     20   deriving (Show, Eq, Ord)
     21 
     22 data Tile =
     23     Special
     24   | Plain Bool
     25   deriving Show
     26 
     27 type Board = MS.Map Coord Tile
     28 
     29 empty :: Board
     30 empty = MS.fromList (zip coords (repeat (Plain False))) where
     31   coords = mconcat [rex, inner, mid, outer]
     32   rex    = [Rex]
     33   inner  = fmap Inner [1..6]
     34   mid    = fmap Mid [1..12]
     35   outer  = fmap Outer [1..18]
     36 
     37 board :: Players -> Board
     38 board players = case players of
     39     Three -> MS.alter special Rex
     40            $ MS.alter special (Outer 4)
     41            $ MS.alter special (Outer 5)
     42            $ MS.alter special (Outer 6)
     43            $ MS.alter special (Outer 9)
     44            $ MS.alter special (Outer 10)
     45            $ MS.alter special (Outer 11)
     46            $ MS.alter special (Outer 15)
     47            $ MS.alter special (Outer 16)
     48            $ MS.alter special (Outer 17)
     49            $ MS.alter special (Outer 1)
     50            $ MS.alter special (Outer 7)
     51            $ MS.alter special (Outer 13)
     52            empty
     53 
     54     Four -> MS.alter special Rex
     55           $ MS.alter special (Outer 3)
     56           $ MS.alter special (Outer 8)
     57           $ MS.alter special (Outer 12)
     58           $ MS.alter special (Outer 17)
     59           empty
     60 
     61     Five -> MS.alter special Rex
     62           $ MS.alter special (Outer 3)
     63           $ MS.alter special (Outer 7)
     64           $ MS.alter special (Outer 10)
     65           $ MS.alter special (Outer 13)
     66           $ MS.alter special (Outer 17)
     67           empty
     68 
     69     Six  -> MS.alter special Rex
     70           $ MS.alter special (Outer 1)
     71           $ MS.alter special (Outer 4)
     72           $ MS.alter special (Outer 7)
     73           $ MS.alter special (Outer 10)
     74           $ MS.alter special (Outer 13)
     75           $ MS.alter special (Outer 16)
     76           empty
     77   where
     78     special :: Maybe Tile -> Maybe Tile
     79     special tile = case tile of
     80       Just Plain {} -> Just Special
     81       _             -> tile
     82 
     83 primsample :: Double -> Board -> Gen RealWorld -> IO Board
     84 primsample prob brd gen = loop gen mempty (MS.toList brd)
     85   where
     86     loop prng acc tiles = case tiles of
     87       []     -> return (MS.fromList acc)
     88       (t:ts) -> case t of
     89         (c, Plain False) -> do
     90           coin <- bernoulli prob prng
     91           loop prng ((c, Plain coin):acc) ts
     92 
     93         _ -> loop prng (t:acc) ts
     94 
     95 sample :: Players -> Double -> IO Board
     96 sample players prob = withSystemRandom . asGenIO $
     97   primsample prob (board players)
     98 
     99 render :: Board -> [Coord]
    100 render brd = loop mempty (MS.toList brd) where
    101   loop acc tiles = case tiles of
    102     []     -> acc
    103     (t:ts) -> case t of
    104       (Rex, _)        -> loop (Rex:acc) ts
    105       (c, Plain True) -> loop (c:acc) ts
    106       _               -> loop acc ts
    107 
    108 main :: IO ()
    109 main = do
    110   args <- getArgs
    111   case args of
    112     (n:p:_) -> do
    113       let players = case (read n :: Int) of
    114             3 -> Just Three
    115             4 -> Just Four
    116             5 -> Just Five
    117             6 -> Just Six
    118             _ -> Nothing
    119 
    120           prob    = read p :: Double
    121 
    122       case players of
    123         Nothing  -> putStrLn "invalid number of players"
    124         Just nps -> do
    125           brd <- sample nps prob
    126           mapM_ print (render brd)
    127 
    128     _ -> putStrLn "USAGE: ./sample <NPLAYERS> <PROBABILITY>"
    129