pig (empty) → 0.0.1
raw patch · 5 files changed
+292/−0 lines, 5 filesdep +basedep +containersdep +randomsetup-changed
Dependencies added: base, containers, random, random-shuffle
Files
- LICENSE.md +23/−0
- Setup.hs +2/−0
- pig.cabal +40/−0
- src/CLI.hs +21/−0
- src/Pig.hs +206/−0
+ LICENSE.md view
@@ -0,0 +1,23 @@+FreeBSD License++Copyright 2011 Andrew Pennebaker. All rights reserved.++Redistribution and use in source and binary forms, with or without modification,+are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright notice,+this list of conditions and the following disclaimer in the documentation and/or+other materials provided with the distribution.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS "AS IS" AND ANY EXPRESS OR IMPLIED+WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT+SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR+PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF+ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ pig.cabal view
@@ -0,0 +1,40 @@+name: pig+version: 0.0.1+category: Math+synopsis: dice game+description: A dice game simulator+license: BSD3+license-file: LICENSE.md+author: Andrew Pennebaker+maintainer: andrew.pennebaker@gmail.com+build-type: Simple+cabal-version: >=1.8++source-repository head+ type: git+ location: git://github.com/mcandre/pig.git++library+ build-depends:+ base >= 4.3.1.0 && < 5,+ containers >= 0.5.11.0 && < 0.6,+ random >= 1.1 && < 2,+ random-shuffle >= 0.0.4 && < 0.0.5++ exposed-modules: Pig++ ghc-options: -Wall -fwarn-tabs+ hs-source-dirs: src++executable pig+ build-depends:+ base >= 4.3.1.0 && < 5,+ containers >= 0.5.11.0 && < 0.6,+ random >= 1.1 && < 2,+ random-shuffle >= 0.0.4 && < 0.0.5++ other-modules: Pig++ main-is: CLI.hs+ hs-source-dirs: src+ ghc-options: -Wall -fwarn-tabs
+ src/CLI.hs view
@@ -0,0 +1,21 @@+module Main where++import Control.Monad (replicateM)++import Pig++main :: IO ()+main = do+ let ps = [ah, ar, hob, ro, r5, r6, rk, rb]+ let n = 10000++ putStrLn $ "Running " ++ show n ++ " games..."++ winners <- replicateM n (test ps)++ putStrLn "Totaling wins...\n"++ let winners' = stats winners+ let winners'' = addLosers ps winners'++ mapM_ (\(name', wins) -> putStrLn $ name' ++ "\t" ++ show (100 * wins `div` n) ++ "%") winners''
+ src/Pig.hs view
@@ -0,0 +1,206 @@+-- Andrew Pennebaker+-- 13 Dec 2011++{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE NoImplicitPrelude #-}++-- | Pig simulates a dice game.+module Pig where++import Prelude hiding (lookup)++import Data.List (sortBy)+import Data.Ord (comparing)+import Data.Map+import Data.Maybe (fromMaybe)++import qualified System.Random as Random+import qualified System.Random.Shuffle as Shuffle++-- | roll simulates a six-sided die.+roll :: IO Int+roll = Random.getStdRandom $ Random.randomR (1, 6)++-- | Move models valid game actions.+data Move = Roll | Hold++-- | Strategy models player tactics.+type Strategy = [Player] -> [Int] -> Move++-- | Player models information available to combatants.+data Player = Player {+ name :: String,+ strategy :: Strategy,+ score :: Int+ }++-- | sayN provides a debugging hook during development.+sayN :: Int -> Int -> String -> String -> IO ()+sayN _ _ _ _ = return ()+-- sayN playerCount turn name message = putStrLn $ "[Round " ++ show (turn `div` playerCount) ++ "] " ++ name ++ " " ++ message++-- | play executes a game of Pig and returns the winner.+play :: [Player] -> Int -> [Int] -> IO Player+play [] _ _ = return Player { name = "", strategy = alwaysHold, score = 0 }+play (p:ps) t r = do+ let n = name p+ let s = strategy p+ let m = s (p:ps) r++ case m of+ Hold -> do+ say t n "holds."++ let score' = score p + sum r+ let p' = p { score = score' }++ say t n $ "has " ++ show score' ++ " total points."++ if score' >= 100 then do+ say t n "wins!"+ return p'+ else do+ let ps' = ps ++ [p']+ play ps' (t+1) []+ Roll -> do+ pips <- roll+ say t n ("rolled " ++ show pips ++ ".")++ if pips == 1 then do+ say t n "pigged."+ say t n $ "has " ++ show (score p) ++ " total points."++ let ps' = ps ++ [p]+ play ps' (t+1) []+ else do+ let r' = r ++ [pips]+ play (p:ps) t r'+ where+ say = sayN (length ps + 1)++-- | alwaysHold models a simple player who always holds.+alwaysHold :: Strategy+alwaysHold _ _ = Hold++-- | alwaysRoll models a simple player who always rolls.+alwaysRoll :: Strategy+alwaysRoll _ _ = Roll++-- | hundredOrBust models a player who strives for 100 points.+hundredOrBust :: Strategy+hundredOrBust [] _ = Hold+hundredOrBust (p:_) rs+ | score p + sum rs >= 100 = Hold+ | otherwise = Roll++-- | rollOnce models a player who rolls only once.+rollOnce :: Strategy+rollOnce _ [] = Roll+rollOnce _ _ = Hold++-- | roll5 models a player who rolls up to five times.+roll5 :: Strategy+roll5 [] _ = Hold+roll5 (p:_) rs+ | score p + sum rs >= 100 = Hold+ | length rs < 5 = Roll+ | otherwise = Hold++-- | roll6 models a player who rolls up to six times.+roll6 :: Strategy+roll6 [] _ = Hold+roll6 (p:_) rs+ | score p + sum rs >= 100 = Hold+ | length rs < 6 = Roll+ | otherwise = Hold++-- | rollK rolls to keep up with the current top player.+rollK :: Strategy+rollK [] _ = Hold+rollK (p:ps) rs+ | score p + sum rs >= 100 = Hold+ | winning && (length rs < 2) = Roll+ | length rs < 6 = Roll+ | otherwise = Hold+ where+ challengers = sortBy (comparing score) (p:ps)+ winning = name (last challengers) == name p++-- | rollBadK is a poor player+rollBadK :: Strategy+rollBadK [] _ = Hold+rollBadK (p:ps) rs+ | score p + sum rs >= 100 = Hold+ | winning && (length rs < 6) = Roll+ | length rs < 2 = Roll+ | otherwise = Hold+ where+ challengers = sortBy (comparing score) (p:ps)+ winning = name (last challengers) == name p++-- | defaultPlayer constructs a new player.+defaultPlayer :: Player+defaultPlayer = Player {+ name = "Player",+ strategy = roll5,+ score = 0+ }++-- | ah always holds.+ah :: Player+ah = defaultPlayer { name = "Always Hold", strategy = alwaysHold }++-- | ar always rolls.+ar :: Player+ar = defaultPlayer { name = "Always Roll", strategy = alwaysRoll }++-- | hob busts at 100.+hob :: Player+hob = defaultPlayer { name = "100 or Bust", strategy = hundredOrBust }++-- | ro rolls once.+ro :: Player+ro = defaultPlayer { name = "Roll Once", strategy = rollOnce }++-- | r5 rolls five times.+r5 :: Player+r5 = defaultPlayer { name = "Roll Five", strategy = roll5 }++-- | r6 rolls six times.+r6 :: Player+r6 = defaultPlayer { name = "Roll Six", strategy = roll6 }++-- | rk rolls to keep up with the top player.+rk :: Player+rk = defaultPlayer { name = "Roll K Times", strategy = rollK }++-- | rb is a bad player.+rb :: Player+rb = defaultPlayer { name = "Roll Bad K", strategy = rollBadK }++-- | test executes multiple games.+test :: [Player] -> IO Player+test ps = do+ stdGen <- Random.getStdGen+ let ps' = Shuffle.shuffle' ps (length ps) stdGen+ play ps' 1 []++-- | track records player wins across games.+track :: [Player] -> Map String Int -> Map String Int+track [] m = m+track (p:ps) m = track ps m'+ where+ n = name p+ wins = fromMaybe 0 (lookup n m)+ m' = insert n (wins + 1) m++-- | stats sorts game scores.+stats :: [Player] -> [(String, Int)]+stats = sortBy (flip (comparing snd)) . toList . flip track empty++-- | addLosers identifies consistently low-scoring strategies.+addLosers :: [Player] -> [(String, Int)] -> [(String, Int)]+addLosers [] results = results+addLosers (p:ps) results+ | not (any (\(n, _) -> n == name p) results) = addLosers ps $ results ++ [(name p, 0)]+ | otherwise = addLosers ps results