How make this piece of Haskell code more concise? - algorithm

Question

As practice, I am trying to write a simulation for the casino game "war" in Haskell.
http://en.wikipedia.org/wiki/Casino_war
It is a very simple game with a few rules. It would be an otherwise very simple problem to write in any of the imperative language I know, however I am struggling to write it in Haskell.
The code I have so far:
-- 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 j x . 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's 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 extra work has to go towards creating random numbers, but I am pretty sure I am missing some basic construct or concept. It shouldn't be this awkward to keep a collection of states, and run a branching logic over a list of input. I couldn't even figure out a good way to write the logic for the case where there are ties on the table.
I am not asking for complete solutions. It would be real nice if someone could point out what I am doing wrong, or some good reading materials that are relevant.
Thanks in advance.

Answer 1

A useful design pattern for maintaining application state is the so called state monad. You can find a description and some introductory examples here. Also, you might want to consider using 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 record syntax.

Answer 2

To make the code more readable, you should break up the structure of the game into meaningful components, and reorganizing your code accordingly. What you've done is to put all the game's state into one data structure. The result is that you have to deal with all the game details all the time.
The game keeps track of scores for each player and the dealer. Sometimes it adds 1 or subtracts 1 from a score. Scores aren't used for anything else. Separate out the score management from the other 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
The cards dealt are also associated with players and the dealer. Winning or losing a round is based only on the card values. Separate out the score computation from the other 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 a game round consists of all steps needed to produce a single Outcome. Reorganize the code accordingly:
type Deck = [Card]
deal :: Int -> Deck -> (Dealt, Deck)
deal n d = (Dealt (take n d) (head $ drop n d), 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 original code. You can approach the rest in a similar way.
The main idea you should get is that Haskell makes it easy to decompose programs into small pieces that are meaningful on their own. That is what makes code easier to work with.
Instead of putting everything into GameState, I created Score, Outcome, Dealt, and Deck. Some of these data types came from the original GameState. Others were not in the original code at all; they were implicit in the way complicated loops were organized. Instead of putting the entire game into gameRound, I created updateScore, scoreRound, deal, and other functions. Each of these interacts with only a few pieces of data.

Answer 3

It occurred to me that the recommendation 'use StateT' might be a little opaque so I translated a bit into that jargon, hoping you could see how to go from there. It might be best to include the state of the deck in the game state. gameround below just restates your function in StateT lingo. The previous definition, game uses the deck field of the game state, continuously reduced, and contains the whole game. I introduce IO actions, just to show how it's done, and so you can see the succession of states if you call main in ghci. You 'lift' IO actions into the StateT machinery, to put them on a level with the gets and puts. Note that in mose subcases, we put the new state and then call for the action to be repeated, so that the do block contains the complete recursive operation. (Tie and an empty deck end the game immediately.) Then in the last line of main we runStateT on this self-updating game yielding a function GameState -> IO (GameState,()); then we feed this with a certain starting state including the randomly determined deck to get the IO action which is the main business. (I don't follow how the game is supposed to work, but was mechanically moving things around to get the idea across.)
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 m a = StateT GameState m a
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 j x . 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)