Well, here it is. The amazing! The stupendous! The … erm … fishy! That’s right, it’s “Go Fish!”, the amazing and riveting card game we all played as children! (Suzy, do you have any eights? Nope, GO FISH!)
Welcome to the first in a series of blog post using games to explore functional programming code. In this first code, I’ve programmed up “Go Fish” as a multi-player game. Play takes place on the console in this version and there is currently no computer artificial intelligence (AI) so arguably as a game, this leaves much to be desired. However, it has merit in terms of allowing me to get practice writing functional code. I also thought this might be worthwhile sharing to compare insights … so … here goes!
This will be implemented as a single literate haskell module called “GoFish.lhs”. First, let’s load the required functions from other modules.
> import Random(randomR, StdGen, mkStdGen, newStdGen)
> import Data.Map(Map, fromList, (!), empty, insert, keys)
> import Data.List(foldl', partition, group, sort, sortBy,
> intercalate)
> import Data.Char(isSpace, toLower)
One thing I like to do is explicitly load functions from other modules. This preference is heavily influenced by Python’s “from import ”. This type of importing makes it crystal clear what functions from what modules are being used. It is also useful when trying to follow someone else’s code (or your own code several months down the road). Any functions not appearing in the above import list are either defined in the module or part of Haskell’s standard Prelude. The Prelude is essentially a module which is always imported and contains the most useful core functions. A listing of what’s in Haskell’s Prelude can be found here.
I’ve been studying F# recently and have grown to love the forward pipe operator as well as the forward composition order. These operators better support a left to right data flow which is how my brain wants to work. It’s totally cool that Haskell has the power to define these useful operators “on the fly”.
As you can see, the pipe operator (|>) is infix left while the forward function composition operator (.>) binds to the right.
> infixl 0 |>
> infixr 9 .>
And here are the definitions:
> (|>) :: a -> (a -> b) -> b
> (|>) x f = f x
> (.>) :: (a -> b) -> (b -> c) -> a -> c
> (.>) f g = g . f
Now, let’s get to the cards! I have a data type for card suit and card value and a final data type just for Cards. I’ve derived several type classes for convenience. If you’re not familiar with these, we get free type class implementations through this mechanism (without having to write code). For example, deriving from the type class, Show, allows us to use the “show” function on the type and turn it into a string.
> data Suit = Spades | Clubs | Hearts | Diamonds
> deriving (Eq, Show, Enum, Ord)
> data CardValue = Ace | V2 | V3 | V4 | V5 | V6 | V7
> | V8 | V9 | V10 | Jack | Queen | King
> deriving (Eq, Enum, Ord)
I’ve implemented a custom value of Show for CardValue in order to get string representations more to my liking for each card value.
> instance Show CardValue where
> show Ace = "Ace"
> show V2 = "2"
> show V3 = "3"
> show V4 = "4"
> show V5 = "5"
> show V6 = "6"
> show V7 = "7"
> show V8 = "8"
> show V9 = "9"
> show V10 = "10"
> show Jack = "Jack"
> show Queen = "Queen"
> show King = "King"
The following two functions are used to manipulate and “standardize” input strings. Note that in the definition below, dropSpace is written in the so-called “point free” format where arguments are not explicitly shown. Because of the potential confusion, I’ve also chosen to write the type signature. The strip function also demonstrates the usage of my custom “forward pipe” implementation. Thus, to strip white space from a string, we take the string, drop spaces from the front, reverse the string, drop spaces from the front again (which is now the rear since the string is reversed), and finally reverse the string so that it is “right way forward” again.
> strip :: String -> String
> strip s =
> let dropSpace :: String -> String
> dropSpace = dropWhile isSpace
> in s |> dropSpace |> reverse |> dropSpace |> reverse
The fixStr function takes a string and strips and lower cases it to make comparisons easier.
> fixStr :: String -> String
> fixStr s = s |> strip |> map toLower
The purpose of strToCard is to match potential strings and return card values from that. There is probably a more elegant way to do this using the Read type class but this seemed straight forward enough.
> strToCard :: String -> CardValue
> strToCard s =
> case fixStr s of
> "ace" -> Ace
> "jack" -> Jack
> "queen" -> Queen
> "king" -> King
> "2" -> V2
> "3" -> V3
> "4" -> V4
> "5" -> V5
> "6" -> V6
> "7" -> V7
> "8" -> V8
> "9" -> V9
> "10" -> V10
> otherwise -> error "unknown string"
Finally, the card and a few helper functions:
> data Card = Card CardValue Suit
> deriving (Eq, Ord)
> value :: Card -> CardValue
> value (Card v _) = v
> suit :: Card -> Suit
> suit (Card _ s) = s
> instance Show Card where
> show (Card v s) = show v ++ " of " ++ show s
> type Deck = [Card]
> type ShuffledDeck = Deck
> type Hand = Deck
> type Name = String
> type Books = [[Card]]
The rules I looked up on the net for “Go Fish” talked about matching “books” of 4 of the same card value so I’ve used that same terminology here.
A player datatype will contain the player’s hand and any matched books thus far. The functions “hand”, “addCardToHand”, and “books” are convenience functions to make it easier to manipulate the Player datatype.
> data Player = Player Hand Books
> deriving (Eq, Show)
> hand :: Player -> Hand
> hand (Player h _) = h
> addCardToHand :: Card -> Player -> Player
> addCardToHand c p =
> let h = hand p
> h' = c : h
> bks = books p
> in Player h' bks
> books :: Player -> Books
> books (Player _ bs) = bs
Finally, a few more convenient type synonyms:
> type PlayerMap = Map Name Player
> type Message = String
> type PlayerNames = [Name]
> type PlayerState = (Bool, Message, PlayerMap)
> data GameState = ContinueTurn | NextPlayer
> | GameOver deriving (Eq, Show)
Below, I’m using a Haskell list comprehension to build a pack of cards. Because I had the CardValue inherit from Enum (Enumeration), we get these great functions “enumFrom” which allow me to iterate through the potential (finite) card values and suits without having to write any custom code. Brilliant!
> deck :: Deck
> deck =
> [Card v s |
> v <- enumFrom Ace,
> s <- enumFrom Spades]
Pop is a convenience function used in the shuffle function. Can you guess what shuffle does? Actually, what might not be immediately apparent is the method Haskell uses to perform random number generation. A standard random number generator (StdGen) type is needed. The variable “rng” stands for “random number generator”.
>
>
> pop :: Int -> [a] -> (a, [a])
> pop idx xs =
> if null xs
> then error "cannot pop a null list"
> else
> let len = length xs
> n = idx `mod` (len + 1)
> in (xs !! (n - 1),
> take (n - 1) xs ++ drop n xs)
> shuffle :: StdGen -> Deck -> (ShuffledDeck, StdGen)
> shuffle rng d =
> let iterPick rng d shuffled =
> if null d
> then (shuffled, rng)
> else
> let (n, rng') =
> randomR (1, length d) rng
> (nextCard, d') = pop n d
> in iterPick rng' d' $
> nextCard : shuffled
> in iterPick rng deck []
Deal takes a deck of cards and deals five to each player.
> numCardsToDeal :: Int
> numCardsToDeal = 5
> deal :: Deck -> [Name] -> (Deck, PlayerMap)
> deal deck_ names =
> let f (d, pm) n =
> (drop numCardsToDeal d,
> insert n
> (Player (take numCardsToDeal d) [])
> pm)
> in foldl' f (deck_, empty) names
The function “groupBy” is actually a standard function available from Data.List. However, it didn’t do what I wanted it to. Specifically, I was hoping groupBy would group all like terms in a list together. Instead, it groups like “continuous” terms together. In other words, group by will only keep grouping until it runs into something outside of the group, then it will start a new group. The “groupBy’” function I wrote below has the desired effect which is to group all terms in the list that meet a criterion together.
>
> groupBy' :: (a -> a -> Bool) -> [a] -> [[a]]
> groupBy' f [] = []
> groupBy' f (x:xs) =
> let (matched, unmatched) = partition (f x) xs
> gr = x : matched
> in if null unmatched
> then [gr]
> else [gr] ++ groupBy' f unmatched
The functions coming up below are used to perform specific game actions during the “Go Fish” card game turn. The function “askCards” simulates a player asking another player if they have any of a specific card value.
>
> askCards ::
> Name -> CardValue -> Name -> PlayerMap -> PlayerState
> askCards asker val target pm =
> let askingPlayer = pm ! asker
> targetPlayer = pm ! target
> hAsker = hand askingPlayer
> hTarget = hand targetPlayer
> matchingCards =
> [Card val s | s <- enumFrom Spades]
> (matched, hTarget') =
> partition (`elem` matchingCards) hTarget
> targetHadCards = length matched > 0
> msg = if targetHadCards
> then
> let numCards = length matched
> plural = if numCards > 1
> then "s"
> else ""
> in asker ++ " got " ++ show numCards
> ++ " " ++ show val ++ plural
> ++ " from " ++ target
> ++ " ... Continue!"
> else
> target ++ " doesn't have any "
> ++ show val ++ "s, " ++ "Go Fish!"
> askingPlayer' =
> let hnd = hAsker ++ matched
> bks = books askingPlayer
> in Player hnd bks
> targetPlayer' =
> Player hTarget' (books targetPlayer)
> pm' = pm
> |> insert asker askingPlayer'
> |> insert target targetPlayer'
> in (targetHadCards, msg, pm')
The function “getValidResponse” is used to continually prompt the user until a valid string is returned.
> getValidatedResponse ::
> (String -> Bool) -> String -> String -> IO String
> getValidatedResponse f prompt onFail = do
> putStrLn prompt
> response <- getLine
> if f response
> then
> return $ strip response
> else do
> putStrLn onFail
> getValidatedResponse f prompt onFail
The function “checkForBooks” is used to check if a player has a matching set of four of one card value in their hand.
> checkForBooks :: Player -> (Bool, Message, Player)
> checkForBooks p =
> let cs = hand p
> valGrs =
> let f = \c1 c2 -> (value c1) == (value c2)
> in groupBy' f cs
> grLens = map length valGrs
> lenVals = zip grLens valGrs
> (bks, remainder) =
> partition (\(len, _) -> len == 4) lenVals
> bks' = map snd bks
> bkVals = map (\cs -> cs |> head |> value) bks'
> remainder' = map snd remainder
> anyBks = length bks' > 0
> msg =
> if anyBks
> then "You've matched " ++
> show (length bkVals) ++ " books: "
> ++ show bkVals
> else "No books matched..."
> in (anyBks, msg,
> Player (concat remainder') (bks' ++ books p))
The function unique groups all in a given list together and takes the head of each group so that there is only one of each kind of element in the list.
> unique :: (Eq a) => [a] -> [a]
> unique xs = xs |> group |> map head
The “announceWinner” helper function counts the number of books matched by each player to yield the final scores.
> announceWinner :: PlayerMap -> IO ()
> announceWinner pm = do
> let ks = keys pm
> nBks = map (pm !) ks |> map books |> map length
> score = zip ks nBks
> putStrLn $ "Final score:\n\t" ++ show score
The following two convenience functions prompt the active player as to which other player they should target to trade cards and prompt the active player to ask what kind of card they want.
> askForTarget :: Name -> [Name] -> IO Name
> askForTarget playerName validNames = do
> let msg = "* Who will you ask for cards? "
> ++ (show validNames)
> errMsg = "... that cat doesn't exist, try again"
> getValidatedResponse (`elem` validNames) msg errMsg
> askForValue :: Name -> [Name] -> IO Name
> askForValue target validRanks = do
> let msg = "* What will you ask " ++ target
> ++ " for? " ++ show validRanks
> errMsg = "...Not a valid rank or you don't hold\
> \ that card"
> getValidatedResponse (`elem` validRanks) msg errMsg
The function isGameOver checks if conditions for Game Over have been reached: namely, if a player has matched all the cards in their hand.
> isGameOver :: Name -> PlayerMap -> Bool
> isGameOver playerName pm =
> if (playerName |> (pm !) |> hand |> length) == 0
> then True
> else False
The function “goFish” simulates having to fish for a card out of the main deck.
> goFish ::
> Name -> Deck -> CardValue -> PlayerMap ->
> (GameState, Message, Deck, PlayerMap)
> goFish playerName playDeck val pm =
> let playDeck' = tail playDeck
> fishedCard = head playDeck
> player =
> addCardToHand fishedCard (pm ! playerName)
> (hadBooks, bkMsg, player') = checkForBooks player
> pm' = insert playerName player' pm
> in if val == (value fishedCard)
> then
> let msg = "\nYou caught a "
> ++ show fishedCard
> ++ ", just what you were fishing "
> ++ "for!\n" ++ bkMsg
> in if isGameOver playerName pm'
> then (GameOver, msg,
> playDeck', pm')
> else (ContinueTurn, msg,
> playDeck', pm')
> else
> let msg = "\nYou caught a " ++
> show fishedCard ++
> ", not what you wanted..." ++
> "\nNext cat up!"
> in (NextPlayer, msg, playDeck', pm')
The function “allHands” is a convenient debugger function used to show the value of all player’s hands. It should only be used for debugging purposes.
> allHands :: PlayerMap -> IO ()
> allHands pm = do
> let ks = keys pm
> ps = map (pm !) ks
> vs = map (hand .> map value .> sort) ps
> sortFun = \(k1, _) (k2, _) -> compare k1 k2
> kvs = sortBy sortFun $ zip ks vs
> putStrLn $ show kvs
Finally, “play’”, “play”, “playerNames”, and “main” are all used to implement the actual game and set up useful defaults so one can just get started without having to define players.
> play' :: PlayerNames -> Deck -> PlayerMap -> IO ()
> play' ns playDeck pm = do
> let playerName = head ns
> validNames = tail $ ns
> yourHand = playerName |> (pm !) |> hand |> sort
> yourRanks = map value yourHand
> validRanks = yourRanks |> unique |> map show
> hbar = take 40 $ repeat '-'
> putStrLn $ hbar ++ "\nCurrent Cat: " ++ playerName
> ++ "\n" ++ hbar
> putStrLn $ "Your Hand: "
> ++ (intercalate ", " $ map show yourRanks)
>
> target <- askForTarget playerName validNames
> valStr <- askForValue target validRanks
> let val = strToCard valStr
> (gotCardFromTarget, msg, pm') =
> askCards playerName val target pm
> nextPlayers =
> target : filter (\n -> n /= target) ns
>
> putStrLn msg
> if gotCardFromTarget
> then do
>
> let (hadBooks, bkMsg, player) =
> checkForBooks (pm' ! playerName)
> pm2 = insert playerName player pm'
>
> putStrLn bkMsg
> if (player |> hand |> length) == 0
> then announceWinner pm2
> else play' ns playDeck pm2
> else
> if null playDeck
> then play' nextPlayers playDeck pm'
> else
> let (gameState, msg, playDeck', pm2) =
> goFish playerName playDeck
> val pm'
> in case gameState of
> GameOver -> do
> putStrLn msg
>
> announceWinner pm2
> ContinueTurn -> do
> putStrLn msg
>
> play' ns playDeck' pm2
> NextPlayer -> do
> putStrLn msg
>
> play' nextPlayers
> playDeck' pm2
> play :: PlayerNames -> IO ()
> play ns = do
> rng <- newStdGen
> let ns' = map strip ns
> (shuffledDeck, rng') = shuffle rng deck
> (playDeck, pm) = deal shuffledDeck ns'
> play' ns' playDeck pm
As you read my blog, you’ll probably learn to expect this. It turns out that the players are all cats (except for Michael). Come now, haven’t you wanted to play go fish with cats?
> playerNames :: [Name]
> playerNames = ["Moonlight", "Mew", "Michael", "Cali"]
From ghci, you can merely type “main” to start the program and try this out!
> main :: IO ()
> main = do
> play playerNames
