Suggest next move for Blackjack - Coder Radio Challenge for Episode #214

blackjack.hs

#!/usr/bin/env runhaskell

-- Coder Radio Challenge for Episode #214
-- https://www.reddit.com/r/CoderRadio/comments/4t7oyt/episode_214_coding_challenge/

-- To run make this file executable and run ./blackjask.hs
-- runhaskell and ghci are required

-- This program considers a players hand which can be more one or more cards 
-- containing one ore more Aces.

-- Only the first shown dealer card is considered.
-- Situtations where the dealer takes a hit are not calculated but the initial
-- dealer card could be changed to determine the next play. 

-- Hard hand totals are totals without an Ace in hand.
-- Soft hand totals are totals with one or more Aces in hand.
-- Ace is equal to 11 in calculating soft totals.

-- For String to Card parsing
import Text.Read
-- For better getLine input
import System.IO

-- To keep it simple, the Card can either be a number value or an Ace
data Card = C Int | Ace deriving (Show, Read)

-- A Hand is a list of cards
data Hand = H [Card] deriving (Show, Read)

-- The play can be the following Hit, Stand, Double or Split
data Play = Hit | Stand | Double | Split deriving Show

-- Totals can be Soft or Hard
data Total = Soft Int | Hard Int deriving Show

-- Monoid typeclass used for finding Hand total
instance Monoid Total where
  mempty                      = Hard 0
  mappend (Hard i1) (Hard i2) = Hard (i1 + i2)
  mappend (Hard i1) (Soft i2) = Soft (i1 + i2)
  mappend (Soft i1) (Hard i2) = Soft (i1 + i2)
  mappend (Soft i1) (Soft i2) = Soft (i1 + i2)

nextPlay :: Hand    -- ^ Players hand
  -> Card           -- ^ Dealers shown card
  -> Play
nextPlay (H (x:y:[])) = nextPlayForOpeningHand (x,y)      -- Opening hand
nextPlay h            = nextPlayForTotal $ (totalHand h)  -- Use total to determine Play

-- Determine the next play given a total
nextPlayForTotal :: Total -> Card -> Play
nextPlayForTotal (Hard p) (C d)   -- No Aces
  | p <= 8                        = Hit
  | p == 9 && (d == 2 || d > 6)   = Hit
  | p == 9 && (d > 2 || d < 7)    = Double
  | p == 10 && d < 10             = Double
  | p == 10 && d == 10            = Hit
  | p == 11                       = Double
  | p == 12 && (d < 4 || d > 6)   = Hit
  | p == 12 && (d > 3 || d < 7)   = Stand
  | (p >= 13 && p <= 16) && d < 7 = Stand
  | (p >= 13 && p <= 16) && d > 6 = Hit
  | p >= 17                       = Stand
nextPlayForTotal (Hard p) Ace     -- Dealer shows Ace
  | p < 11                        = Hit
  | p == 11                       = Double
  | p > 11 && p < 17              = Hit
  | p >= 17                       = Stand
-- If an Ace is involved then we need to consider "Soft" totals.
-- Consider Ace as an 11 for Soft totals
nextPlayForTotal (Soft p) (C d)   -- Dealer not showing ace
  | p > 21 = nextPlayForTotal (Soft (p `mod` 21)) (C d)   -- Greater than 21
  | p < 13                                      = Hit     -- Small Soft total
  | (p == 13 || p == 14) && (d < 5 || d > 6)    = Hit     -- A,2 and A,3
  | (p == 13 || p == 14) && (d == 5 || d == 6)  = Double  -- A,2 and A,3
  | (p == 15 || p == 16) && (d < 4 || d > 6)    = Hit     -- A,4 and A,5
  | (p == 15 || p == 16) && (d > 3 || d < 7)    = Double  -- A,4 and A,5
  | p == 17 && (d == 2 || d > 6)                = Hit     -- A,6
  | p == 17 && (d > 2 || d < 7)                 = Double  -- A,6
  | p == 18 && d > 8                            = Hit     -- A,7
  | p == 18 && (d < 7 && d > 2)                 = Double  -- A,7
  | p == 18 && (d == 2 || d == 7 || d == 8)     = Stand   -- A,7
  | p >= 19                                     = Stand   -- A,8 and A,9
nextPlayForTotal (Soft p) Ace =   -- Dealer shows Ace
  nextPlayForTotal (Soft p) (C 10)  -- Same results as if the Dealer had a 10

-- Determine the next play given an opening hand
nextPlayForOpeningHand :: (Card,Card) -> Card -> Play
nextPlayForOpeningHand (Ace,Ace) _ = Split  -- Dealt two Aces. You lucky duck!
nextPlayForOpeningHand (c, Ace) d =         -- Dealt Ace as second card,
  nextPlayForOpeningHand (Ace,c) d          --   same as getting Ace as the first card
nextPlayForOpeningHand (C p1, C p2) (C d)   -- Not dealt ace
  | p1 /= p2 =  -- Only consider pairs as special opening hands
      nextPlayForTotal (totalHand (H [C p1,C p2])) (C d)
  | (p1 == 2 || p1 == 3 || p1 == 7) && d < 8  = Split
  | (p1 == 2 || p1 == 3 || p1 == 7) && d > 7  = Hit
  | p1 == 4 && (d < 5 || d > 6)               = Hit
  | p1 == 4 && (d == 5 || d == 6)             = Split
  | p1 == 5 && d < 10                         = Double
  | p1 == 5 && d == 10                        = Hit
  | p1 == 6 && d < 7                          = Split
  | p1 == 6 && d > 6                          = Hit
  | p1 == 8                                   = Split
  | p1 == 9 && (d == 7 || d == 10)            = Stand
  | p1 == 9 && (d < 7 || d == 8 || d == 9)    = Split
  | p1 == 10                                  = Stand
  | otherwise =                             -- Not a special starting hand
      nextPlayForTotal (totalHand (H [C p1,C p2])) (C d)
nextPlayForOpeningHand (C p1, C p2) Ace   -- Not dealt ace and dealer shows Ace
  | p1 == p2 && p1 < 8                      = Hit
  | p1 == p2 && p1 == 8                     = Split
  | p1 == p2 && (p1 == 9 || p1 == 10)       = Stand
nextPlayForOpeningHand (p1,p2) d = nextPlayForTotal (totalHand (H [p1,p2])) d
  
-- Get the total for a hand
totalHand :: Hand -> Total
totalHand (H [])  = mempty
totalHand (H ((C i):xs))  =  (Hard i) `mappend` (totalHand (H xs))
totalHand (H ((Ace):xs))  =  (Soft 11) `mappend` (totalHand (H xs))

main :: IO ()
main = do
  putStrLn "'g' to show grid"
  putStrLn "'b' to build custom hand"
  putStrLn "'q' to quit"
  hSetBuffering stdin LineBuffering
  mainMenuInput <- getLine
  case mainMenuInput of
    "g" -> generateDecisionGrid >> putStrLn "" >> main
    "b" -> do
      putStrLn "Enter player's hand in the format [C 2,C 3,C 4,Ace]: "
      handInput <- getLine
      case (parseHand ("H " ++ handInput)) of
        Nothing -> putStrLn "Failed to parse hand.\n" >> main
        Just hand -> do
          putStrLn $ "Player has hand: " ++ show hand
          putStrLn $ "Enter card dealer is showing in the format \"C 1\" or \"Ace\":"
          dealerInput <- getLine
          case (parseCard dealerInput) of
            Nothing -> putStrLn "Failed to parse card.\n" >> main
            Just dealerCard -> do
              putStrLn $ "Dealer shows: " ++ show dealerCard
              putStrLn $ "The next play is: " ++ (show $ nextPlay hand dealerCard)
              putStrLn "" >> main
    "q" -> putStrLn "Goodbye"
    otherwise -> do
      putStrLn $ "Didn't understand '" ++ otherwise ++ "'."
      putStrLn "Please try again.\n"
      main

-- Naive String parser for Card and Hand
parseCard :: String -> Maybe Card
parseCard s = (readMaybe s) :: Maybe Card
parseHand :: String -> Maybe Hand
parseHand s = (readMaybe s) :: Maybe Hand
  
generateDecisionGrid :: IO ()
generateDecisionGrid = do
  header "Hard totals"
  mapM_ (putStrLn . show . rowHard) [8..17]
  header "\nSoft totals"
  mapM_ (putStrLn . show . rowSoft) [2..9]
  header "\n   Pairs"
  mapM_ (putStrLn . show . rowPair) [2..10]
  (putStrLn . show) $ rowPairAces
  header "\nObvious hard totals"
  mapM_ (putStrLn . show . rowHard) $ [4..7] ++ [18..21]
  header "\nUnusual soft totals (Multiple Aces in hand)" 
  mapM_ (putStrLn . show . rowSoft) $ [1] ++ [10..31]
  where
    rowHard i = (show i) ++ ": " ++ show ([nextPlayForTotal (Hard i) (C d) | d <- [2..10]])
      ++ " " ++ show (nextPlayForTotal (Hard i) Ace)
    rowSoft i = "A," ++ (show i) ++ ": "
      ++ show ([nextPlayForTotal (Soft (i+11)) (C d) | d <- [2..10]]) ++ " "
      ++ show (nextPlayForTotal (Soft (i+11)) Ace)
    rowPair i = (show i) ++ "," ++ (show i) ++ ": "
      ++ show ([nextPlayForOpeningHand (C i,C i) (C d) | d <- [2..10]]) ++ " "
      ++ show (nextPlayForOpeningHand (C i,C i) Ace)
    rowPairAces = "Ace,Ace: " 
      ++ show ([nextPlayForOpeningHand (Ace,Ace) (C d) | d <- [2..10]]) ++ " "
      ++ show (nextPlayForOpeningHand (Ace,Ace) Ace)
    header s = do
      putStrLn $ s ++ "\n==========="
      putStrLn $ "##### " ++ show [2..10] ++ " Ace"