How to make this Haskell code snippet more concise?

Question

As a practice, I'm trying to write a simulation for a war game at Haskell Casino.

http://en.wikipedia.org/wiki/Casino_war

This is a very simple game with a few rules. Otherwise, a very simple problem would be written in any imperative language that I know, however I am struggling to write it in Haskell.

The code I have so far is:

-- Simulation for the Casino War import System.Random import Data.Map ------------------------------------------------------------------------------- -- stolen from the internet fisherYatesStep :: RandomGen g => (Map Int a, g) -> (Int, a) -> (Map Int a, g) fisherYatesStep (m, gen) (i, x) = ((insert jx . insert i (m ! j)) m, gen') where (j, gen') = randomR (0, i) gen fisherYates :: RandomGen g => g -> [a] -> ([a], g) fisherYates gen [] = ([], gen) fisherYates gen l = toElems $ Prelude.foldl fisherYatesStep (initial (head l) gen) (numerate (tail l)) where toElems (x, y) = (elems x, y) numerate = zip [1..] initial x gen = (singleton 0 x, gen) ------------------------------------------------------------------------------- data State = Deal | Tie deriving Show -- state: game state -- # cards to deal -- # cards to burn -- cards on the table -- indices for tied players -- # players -- players winning -- dealer winning type GameState = (State, Int, Int, [Int], [Int], Int, [Int], Int) gameRound :: GameState -> Int -> GameState gameRound (Deal, toDeal, toBurn, inPlay, tied, numPlayers, pWins, dWins) card | toDeal > 0 = -- not enough card, deal a card (Deal, toDeal - 1, 0, card:inPlay, tied, numPlayers, pWins, dWins) | toDeal == 0 = -- enough cards in play now -- here should detemine whether or not there is any ties on the table, -- and go to the tie state let dealerCard = head inPlay p = zipWith (+) pWins $ (tail inPlay) >>= (\x -> if x < dealerCard then return (-1) else return 1) d = if dealerCard == (maximum inPlay) then dWins + 1 else dWins - 1 in (Deal, numPlayers + 1, 0, [], tied, numPlayers, p, d) gameRound (Tie, toDeal, toBurn, inPlay, tied, numPlayers, pWins, dWins) card -- i have no idea how to write the logic for the tie state AKA the "war" state | otherwise = (Tie, toDeal, toBurn, inPlay, tied, numPlayers, pWins, dWins) ------------------------------------------------------------------------------- main = do rand <- newStdGen -- create the shuffled deck (deck, _) <- return $ fisherYates rand $ [2 .. 14] >>= (replicate 6) -- fold the state updating function over the deck putStrLn $ show $ Prelude.foldl gameRound (Deal, 7, 0, [], [], 6, [0 ..], 0) deck ------------------------------------------------------------------------------- 

I understand why additional work should go on creating random numbers, but I'm sure that I am missing a basic design or concept. It should not be inconvenient to store a collection of states and run branching logic above the input list. I could not even figure out how to write logic for the case when there are connections on the table.

I am not asking for complete solutions. It would be very nice if someone could indicate what I am doing wrong, or some good reading materials that are relevant.

Thanks in advance.

Answer 1

A useful design pattern for maintaining the state of an application is the so-called state monad. You can find a description and some introductory examples here . In addition, you may need to use a data type with named fields instead of a tuple for GameState , for example:

 data GameState = GameState { state :: State, toDeal :: Int -- and so on } 

This will make it easier to access / update individual fields using the syntax of the entries .

Answer 2

To make the code more readable, you must break down the structure of the game into meaningful components and rebuild your code accordingly. What you have done is to include the entire state of the game in one data structure. As a result, you have to deal with all the details of the game all the time.

The game tracks scores for each player and dealer. Sometimes he adds 1 or subtracts 1 from the account. Ratings are not used for anything else. Separate account management from another code:

 -- Scores for each player and the dealer data Score = Score [Int] Int -- Outcome for each player and the dealer. 'True' means a round was won. data Outcome = Outcome [Bool] Bool startingScore :: Int -> Score startingScore n = Score (replicate n 0) 0 updateScore :: Outcome -> Score -> Score updateScore (Outcome ps d) (Score pss ds) = Score (zipWith upd pss pos) (update ds d) where upd s True = s+1 upd s False = s-1 

Revealed cards are also associated with players and the dealer. Winning or losing a round is based only on map values. Separate invoice calculation from another code:

 type Card = Int data Dealt = Dealt [Card] Card scoreRound :: Dealt -> Outcome scoreRound (Dealt ps dealerCard) = Outcome (map scorePlayer ps) (dealerCard == maximumCard) where maximumCard = maximum (dealerCard : ps) scorePlayer p = p >= dealerCard 

I would say that a game round consists of all the steps necessary to create a single Outcome . Reorganize the code accordingly:

 type Deck = [Card] deal :: Int -> Deck -> (Dealt, Deck) deal nd = (Dealt (take nd) (head $ drop nd), drop (n+1) d) -- Should check whether deck has enough cards -- The 'input-only' parts of GameState type GameConfig = GameConfig {nPlayers :: Int} gameRound :: GameConfig -> Deck -> (Deck, Outcome) gameRound config deck = let (dealt, deck') = deal (nPlayers config) deck outcome = scoreRound dealt in (deck', outcome) 

This covers most of what was in the source code. You can approach the rest in a similar way.

---

The basic idea you should get is that Haskell makes it easy to break programs into small pieces that make sense on their own . This makes it easier to work with code.

Instead of putting everything in the GameState , I created Score , Outcome , Dealt and Deck . Some of these data types came from the original GameState . Others were not in the source code at all; they were hidden in how complex cycles were organized. Instead of putting the whole game in gameRound , I created updateScore , scoreRound , deal and other functions. Each of them interacts with several pieces of data.

Answer 3

It occurred to me that the “use StateT” recommendation might be a bit opaque, so I redid this jargon a bit, hoping you can see how to get there. It’s best to include the deck state in the game state. gameround below simply recounts your function in StateT lingo. The previous definition of game uses the deck of the game state deck , continuously reduced and contains the entire game. I present the IO actions just to show how this is done, and so you can see the sequence of states if you call main in ghci. You raise the “IO actions” to the StateT machine to level them up with hit and put. Notice that in the mose sub-sections we put in a new state and then call the action to be repeated so that the do block contains the full recursive operation. (Tie and the empty deck immediately end the game.) Then, in the last line of main we runStateT on this self-updating game , the function GameState → IO (GameState, ()) appears; then we pass this with a certain starting state, including a randomly defined deck, in order to get an IO action, which is the main business. (I don't follow how the game should work, but mechanically moved things to get this idea.)

 import Control.Monad.Trans.State import Control.Monad.Trans import System.Random import Data.Map data Stage = Deal | Tie deriving Show data GameState = GameState { stage :: Stage , toDeal :: Int , toBurn :: Int , inPlay :: [Int] , tied :: [Int] , numPlayers :: Int , pWins :: [Int] , dWins :: Int , deck :: [Int]} deriving Show -- deck field is added for the `game` example type GameRound ma = StateT GameState ma main = do rand <- newStdGen let deck = fst $ fisherYates rand $ concatMap (replicate 6) [2 .. 14] let startState = GameState Deal 7 0 [] [] 6 [0 ..100] 0 deck runStateT game startState game :: GameRound IO () game = do st <- get lift $ putStrLn "Playing: " >> print st case deck st of [] -> lift $ print "no cards" (card:cards) -> case (toDeal st, stage st) of (0, Deal) -> do put (first_case_update st card cards) game -- <-- recursive call with smaller deck (_, Deal) -> do put (second_case_update st card cards) game (_, Tie) -> do lift $ putStrLn "This is a tie" lift $ print st where -- state updates: -- I separate these out hoping this will make the needed sort -- of 'logic' above clearer. first_case_update s card cards= s { numPlayers = numPlayers s + 1 , pWins = [if x < dealerCard then -1 else 1 | x <- zipWith (+) (pWins s) (tail (inPlay s)) ] , dWins = if dealerCard == maximum (inPlay s) then dWins s + 1 else dWins s - 1 , deck = cards } where dealerCard = head (inPlay s) second_case_update s card cards = s { toDeal = toDeal s - 1 , toBurn = 0 , inPlay = card : inPlay s , deck = cards} -- a StateTified formulation of your gameRound gameround :: Monad m => Int -> GameRound m () gameround card = do s <- get case (toDeal s, stage s) of (0, Deal) -> put $ s { toDeal = numPlayers s + 1 , pWins = [if x < dealerCard then -1 else 1 | x <- zipWith (+) (pWins s) (tail (inPlay s)) ] , dWins = if dealerCard == maximum (inPlay s) then dWins s + 1 else dWins s - 1} where dealerCard = head (inPlay s) (_, Deal) -> put $ s { toDeal = toDeal s - 1 , toBurn = 0 , inPlay = card : inPlay s} (_, Tie) -> return () fisherYatesStep :: RandomGen g => (Map Int a, g) -> (Int, a) -> (Map Int a, g) fisherYatesStep (m, gen) (i, x) = ((insert jx . insert i (m ! j)) m, gen') where (j, gen') = randomR (0, i) gen fisherYates :: RandomGen g => g -> [a] -> ([a], g) fisherYates gen [] = ([], gen) fisherYates gen l = toElems $ Prelude.foldl fisherYatesStep (initial (head l) gen) (numerate (tail l)) where toElems (x, y) = (elems x, y) numerate = zip [1..] initial x gen = (singleton 0 x, gen)