From 23b40032d99290fb9953a8fc256879748ecb2396 Mon Sep 17 00:00:00 2001 From: Barak Michener Date: Thu, 15 May 2014 18:06:27 -0400 Subject: [PATCH] initial commit --- .gitignore | 11 +++++ LICENSE | 30 ++++++++++++ Setup.hs | 2 + ZombieDice.hs | 145 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ zombiedice.cabal | 21 ++++++++ 5 files changed, 209 insertions(+) create mode 100644 .gitignore create mode 100644 LICENSE create mode 100644 Setup.hs create mode 100644 ZombieDice.hs create mode 100644 zombiedice.cabal diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..01e585a --- /dev/null +++ b/.gitignore @@ -0,0 +1,11 @@ +dist +cabal-dev +*.o +*.hi +*.chi +*.chs.h +.virtualenv +.hsenv +.cabal-sandbox/ +cabal.sandbox.config +cabal.config diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..14d12d8 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2014, Barak Michener + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * 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. + + * Neither the name of Barak Michener nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"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 COPYRIGHT +OWNER 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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/ZombieDice.hs b/ZombieDice.hs new file mode 100644 index 0000000..2e59db6 --- /dev/null +++ b/ZombieDice.hs @@ -0,0 +1,145 @@ +import Control.Monad.Random +import Control.Applicative +import Control.Monad +import Control.Monad.Trans.Maybe +import Data.List +import Data.Maybe + +data Cup = Cup { + green :: Int, + yellow :: Int, + red :: Int + } deriving (Show) + +data Outcome = Brain | Runner | Shotgun deriving (Show) +data Color = Red | Yellow | Green deriving (Show) + +data OutDie = OutDie Outcome Color deriving (Show) + +data PlayerState = PlayerState { + brains :: Int, + shotguns :: Int, + cup :: Cup, + hand :: Hand + } deriving (Show) + +type Hand = [Color] + + +defaultCup = Cup 6 4 3 +defaultPlayer = PlayerState 0 0 defaultCup [] + + +takeGreen (Cup g y r) = Cup (g - 1) y r +takeYellow (Cup g y r) = Cup g (y - 1) r +takeRed (Cup g y r) = Cup g y (r - 1) + +die :: (RandomGen g) => Rand g Int +die = getRandomR (1,6) + +redDie 1 = OutDie Shotgun Red +redDie 2 = OutDie Shotgun Red +redDie 3 = OutDie Shotgun Red +redDie 4 = OutDie Runner Red +redDie 5 = OutDie Runner Red +redDie 6 = OutDie Brain Red + +yellowDie 1 = OutDie Shotgun Yellow +yellowDie 2 = OutDie Shotgun Yellow +yellowDie 3 = OutDie Runner Yellow +yellowDie 4 = OutDie Runner Yellow +yellowDie 5 = OutDie Brain Yellow +yellowDie 6 = OutDie Brain Yellow + +greenDie 1 = OutDie Shotgun Green +greenDie 2 = OutDie Runner Green +greenDie 3 = OutDie Runner Green +greenDie 4 = OutDie Brain Green +greenDie 5 = OutDie Brain Green +greenDie 6 = OutDie Brain Green + +diceInCup (Cup x y z) = x + y + z + +pickDie cup = + if cupN == 0 + then pickDie defaultCup + else + do + v <- (getRandomR (1, cupN)) + if v <= green cup then return (takeGreen cup, Green) + else if v <= (green cup) + (yellow cup) then return (takeYellow cup, Yellow) + else return (takeRed cup, Red) + where cupN = diceInCup cup + +takeDieFromPlayerCup :: (RandomGen g) => PlayerState -> Rand g PlayerState +takeDieFromPlayerCup player = + do + (newcup, color) <- pickDie (cup player) + return $ PlayerState (brains player) (shotguns player) newcup (color : (hand player)) + +fillHand :: (RandomGen g) => PlayerState -> Rand g PlayerState +fillHand player = + if length (hand player) == 3 + then return player + else takeDieFromPlayerCup player >>= fillHand + +zombieDie :: (RandomGen g) => Color -> Rand g OutDie +zombieDie Red = redDie <$> die +zombieDie Green = greenDie <$> die +zombieDie Yellow = yellowDie <$> die + +clearHand player = PlayerState (brains player) (shotguns player) (cup player) [] + +rollHand :: (RandomGen g) => PlayerState -> Rand g [OutDie] +rollHand player = sequence (map zombieDie (hand player)) + +{-playerRoll :: (RandomGen g) => PlayerState -> Rand g PlayerState-} +{-playerRoll player = do-} + {-player <- fillHand player-} + {-outcomes <- rollHand player-} + +updateOutcome :: PlayerState -> OutDie -> PlayerState +updateOutcome player (OutDie Shotgun _) = PlayerState (brains player) (1 + (shotguns player)) (cup player) (hand player) +updateOutcome player (OutDie Brain _ ) = PlayerState (1 + (brains player)) (shotguns player) (cup player) (hand player) +updateOutcome player (OutDie Runner color) = PlayerState (brains player) (shotguns player) (cup player) (color : (hand player)) + +acceptOutcome :: PlayerState -> [OutDie] -> PlayerState +acceptOutcome player outcomes = foldl updateOutcome (clearHand player) outcomes + +report :: [Int] -> [(Int, Int)] +report input = zip id counts + where + sorted = sort input + grouped = group sorted + id = map (\x -> x !! 0) grouped + counts = map length grouped + +playNRounds n player = foldl' (>>=) (return $ Just player) (take n $ repeat playRound) + +playRound :: (RandomGen g) => (Maybe PlayerState) -> Rand g (Maybe PlayerState) +playRound Nothing = return Nothing +playRound (Just player) = do + playerWithHand <- fillHand player + outcome <- rollHand playerWithHand + let newPlayer = acceptOutcome playerWithHand outcome in + if (shotguns newPlayer) >= 3 + then return Nothing + else return $ Just newPlayer + +{-firstRound = do-} + {-playerWithHand <- fillHand defaultPlayer-} + {-outcome <- rollHand playerWithHand-} + {-return $ acceptOutcome playerWithHand outcome-} + +main = mainN 8 100000 + +mainN n x = do + outcomeStates <- replicateM x (evalRandIO $ playNRounds n defaultPlayer) + print "brains" + print $ report $ map brains $ catMaybes outcomeStates + print "shotguns" + print $ report $ map shotguns $ catMaybes outcomeStates + print "successes" + print $ length $ filter isJust outcomeStates + print "failures" + print $ length $ filter isNothing outcomeStates diff --git a/zombiedice.cabal b/zombiedice.cabal new file mode 100644 index 0000000..9b0057b --- /dev/null +++ b/zombiedice.cabal @@ -0,0 +1,21 @@ +-- Initial zombiedice.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +name: zombiedice +version: 0.1.0.0 +synopsis: Some zombie dice numbers +-- description: +homepage: tbd +license: BSD3 +license-file: LICENSE +author: Barak Michener +maintainer: me@barakmich.com +-- copyright: +category: Game +build-type: Simple +cabal-version: >=1.8 + +executable zombiedice + -- main-is: + -- other-modules: + build-depends: base ==4.6.* \ No newline at end of file