ti3-sampler

Unnamed repository; edit this file 'description' to name the repository.
Log | Files | Refs | README | LICENSE

commit db78854047b4f82f1b5404ce65c4d81acdc7162d
Author: Jared Tobin <jared@jtobin.ca>
Date:   Thu, 16 Aug 2018 10:37:57 -0230

Initial commit.

Diffstat:
A.gitignore | 4++++
AREADME.md | 18++++++++++++++++++
ASampler.hs | 129+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
3 files changed, 151 insertions(+), 0 deletions(-)

diff --git a/.gitignore b/.gitignore @@ -0,0 +1,4 @@ +ti3sample +*swp +*.o +*.hi diff --git a/README.md b/README.md @@ -0,0 +1,18 @@ + +# ti-sampler + +Sample random board locations in a TI3 game. + +Useful for e.g. setting domain counters only on some limited percentage of the +board. + +## Usage + +``` +$ stack runghc -- Sampler 4 0.1 +Outer 18 +Outer 11 +Mid 6 +Rex +``` + diff --git a/Sampler.hs b/Sampler.hs @@ -0,0 +1,129 @@ +{-# OPTIONS_GHC -Wall #-} + +import Control.Monad.Primitive +import qualified Data.Map.Strict as MS +import System.Random.MWC +import System.Random.MWC.Distributions (bernoulli) +import System.Environment + +data Players = + Three + | Four + | Five + | Six + +data Coord = + Rex + | Inner Int + | Mid Int + | Outer Int + deriving (Show, Eq, Ord) + +data Tile = + Special + | Plain Bool + deriving Show + +type Board = MS.Map Coord Tile + +empty :: Board +empty = MS.fromList (zip coords (repeat (Plain False))) where + coords = mconcat [rex, inner, mid, outer] + rex = [Rex] + inner = fmap Inner [1..6] + mid = fmap Mid [1..12] + outer = fmap Outer [1..18] + +board :: Players -> Board +board players = case players of + Three -> MS.alter special Rex + $ MS.alter special (Outer 4) + $ MS.alter special (Outer 5) + $ MS.alter special (Outer 6) + $ MS.alter special (Outer 9) + $ MS.alter special (Outer 10) + $ MS.alter special (Outer 11) + $ MS.alter special (Outer 15) + $ MS.alter special (Outer 16) + $ MS.alter special (Outer 17) + $ MS.alter special (Outer 1) + $ MS.alter special (Outer 7) + $ MS.alter special (Outer 13) + empty + + Four -> MS.alter special Rex + $ MS.alter special (Outer 3) + $ MS.alter special (Outer 8) + $ MS.alter special (Outer 12) + $ MS.alter special (Outer 17) + empty + + Five -> MS.alter special Rex + $ MS.alter special (Outer 3) + $ MS.alter special (Outer 7) + $ MS.alter special (Outer 10) + $ MS.alter special (Outer 13) + $ MS.alter special (Outer 17) + empty + + Six -> MS.alter special Rex + $ MS.alter special (Outer 1) + $ MS.alter special (Outer 4) + $ MS.alter special (Outer 7) + $ MS.alter special (Outer 10) + $ MS.alter special (Outer 13) + $ MS.alter special (Outer 16) + empty + where + special :: Maybe Tile -> Maybe Tile + special tile = case tile of + Just Plain {} -> Just Special + _ -> tile + +primsample :: Double -> Board -> Gen RealWorld -> IO Board +primsample prob brd gen = loop gen mempty (MS.toList brd) + where + loop prng acc tiles = case tiles of + [] -> return (MS.fromList acc) + (t:ts) -> case t of + (c, Plain False) -> do + coin <- bernoulli prob prng + loop prng ((c, Plain coin):acc) ts + + _ -> loop prng (t:acc) ts + +sample :: Players -> Double -> IO Board +sample players prob = withSystemRandom . asGenIO $ + primsample prob (board players) + +render :: Board -> [Coord] +render brd = loop mempty (MS.toList brd) where + loop acc tiles = case tiles of + [] -> acc + (t:ts) -> case t of + (Rex, _) -> loop (Rex:acc) ts + (c, Plain True) -> loop (c:acc) ts + _ -> loop acc ts + +main :: IO () +main = do + args <- getArgs + case args of + (n:p:_) -> do + let players = case (read n :: Int) of + 3 -> Just Three + 4 -> Just Four + 5 -> Just Five + 6 -> Just Six + _ -> Nothing + + prob = read p :: Double + + case players of + Nothing -> putStrLn "invalid number of players" + Just nps -> do + brd <- sample nps prob + mapM_ print (render brd) + + _ -> putStrLn "USAGE: ./sample <NPLAYERS> <PROBABILITY>" +