initial commit
This commit is contained in:
commit
23b40032d9
5 changed files with 209 additions and 0 deletions
11
.gitignore
vendored
Normal file
11
.gitignore
vendored
Normal file
|
|
@ -0,0 +1,11 @@
|
|||
dist
|
||||
cabal-dev
|
||||
*.o
|
||||
*.hi
|
||||
*.chi
|
||||
*.chs.h
|
||||
.virtualenv
|
||||
.hsenv
|
||||
.cabal-sandbox/
|
||||
cabal.sandbox.config
|
||||
cabal.config
|
||||
30
LICENSE
Normal file
30
LICENSE
Normal file
|
|
@ -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.
|
||||
2
Setup.hs
Normal file
2
Setup.hs
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
import Distribution.Simple
|
||||
main = defaultMain
|
||||
145
ZombieDice.hs
Normal file
145
ZombieDice.hs
Normal file
|
|
@ -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
|
||||
21
zombiedice.cabal
Normal file
21
zombiedice.cabal
Normal file
|
|
@ -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.*
|
||||
Loading…
Add table
Add a link
Reference in a new issue