HiveBrain v1.2.0
Get Started
← Back to all entries
patternMinor

Poker hand identifier

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
pokerhandidentifier

Problem

Inspired by this post (along with a number of other people by the looks of it), I created a poker hand identifier with a very similar format. Note that the syntax of the hands is a little different to make parsing easier - rather than "A:C K:C Q:C J:C 10:C", the input is of the form "[(A,C),(K,C),(Q,C),(J,C),(10,C)]".

The code works correctly for the sample inputs in the post, I'm more concerned about coding style and elegance. For example, I've used pointfree style and the Maybe monad (with guard and isJust) where I can so it's not very consistent. getPair doesn't seem very nice but it does save on a reasonable amount of boilerplate; am I right in thinking that returning ((Card,Card),Hand) instead of (Card,Card,Hand) would make the pattern matching on it slightly nicer?

Example usage:

identifyHand "[(5,H),(5,D),(A,S),(10,D),(5,C)]" == "Three of a kind"
identifyHand "[(2,H),(3,H),(4,H),(5,H),(A,D)]"  == "High card: A"


pokerhands.hs

```
import Data.List (sort, deleteBy, nub)
import Data.Maybe (isJust)
import Control.Monad (guard)
import Data.Function (on)

main :: IO ()
main = readFile "hands.txt" >>= putStrLn . unlines . map identifyHand . lines

-------------------------
-- Types and instances --
-------------------------

type Hand = [Card]
type Card = (Value,Suit)

-- Num n is valid for 2 String -> [(Value,String)]
-- p.s. I do not really know how readsPrec works
readsPrec _ ('J':xs) = [(Jack ,xs)]
readsPrec _ ('Q':xs) = [(Queen,xs)]
readsPrec _ ('K':xs) = [(King ,xs)]
readsPrec _ ('A':xs) = [(Ace ,xs)]
readsPrec _ xs = case reads xs of
((n,xs'):_) | n >= 2 && n [(Num n,xs')]
_ -> []

instance Show Combination where
show Royal = "Royal flush"
show StraightFlush = "Straight flush"
show Four = "Four of a kind"
show FullHouse = "Full house"
show Flush = "Flush"
show Straight = "Straight"
show Three = "Three of a kind"
sh

Solution

Some more ideas - you could have an Enum instance / isNext derived without all the boilerplate if you defined Value either as

{-# LANGUAGE GeneralizedNewtypeDeriving #-}
newtype Value = Val Int
   deriving (Eq, Ord, Enum, Bounded)


or as

data Value = Two | Three | Four | Five | Six | Seven | Eight | Nine | Ten 
           | Jack | Queen | King | Ace
    deriving (Eq, Ord, Bounded, Enum)


depending on whether that seems like a good idea to you or not. The latter representation is better than it might appear at first - after all, the Enum instance allows you to easily convert to and from numerical values using toEnum / fromEnum, so you don't have to change your Read & Show instances much.

Also, I feel like your hand matching could be simplified if you preprocessed the hand a bit:

getComb :: Hand -> Combination
getComb h
     ...
  where hg = sortBy (compare `on` length) $
             groupBy ((==) `on` fst) $
             sortBy (compare `on` fst) h


This "grouped" hand representation has the nice property that you can write hand group checks like follows:

type HandGrouped = [[Card]]

isPair :: HandGrouped -> Maybe HandGrouped
isPair ([_,_]:xs) = Just xs
isPair _          = Nothing

isTwoPair :: HandGrouped -> Maybe HandGrouped
isTwoPair h = isPair h >>= isPair


Hm, but isn't your implementation actually quite incomplete? Right now, you can't distinguish between ace-high and jack-high straights, for example, or equal pairs with different kickers.

Here's a quick (untested) sketch of how I think you could build the program to have all the mentioned features, using slightly more involved trickery:

-- Low-value combinations first, so it works well with Value
data Combination = HighCard | Pair Value | TwoPair Value Value | ...
    deriving Ord

-- Combination, remaining cards / kicker. Implicit Ord instance gives
-- you card value order!
type Evaluation = (Combination, HandGrouped)

getPair, getTwoPair :: HandGrouped -> Maybe Evaluation
getPair ([c,_]:xs) = Just (Pair (fst c), xs)
getPair _          = Nothing
getTwoPair xs      = do
  (Pair v1, xs')  Maybe Evaluation
getCombination xs = msum
  [ ...
  , getTwoPair xs
  , getPair xs
  , return (HighCard, xs)
  ]


Using that msum returns the first value in the list that is not Nothing.

Code Snippets

{-# LANGUAGE GeneralizedNewtypeDeriving #-}
newtype Value = Val Int
   deriving (Eq, Ord, Enum, Bounded)
data Value = Two | Three | Four | Five | Six | Seven | Eight | Nine | Ten 
           | Jack | Queen | King | Ace
    deriving (Eq, Ord, Bounded, Enum)
getComb :: Hand -> Combination
getComb h
     ...
  where hg = sortBy (compare `on` length) $
             groupBy ((==) `on` fst) $
             sortBy (compare `on` fst) h
type HandGrouped = [[Card]]

isPair :: HandGrouped -> Maybe HandGrouped
isPair ([_,_]:xs) = Just xs
isPair _          = Nothing

isTwoPair :: HandGrouped -> Maybe HandGrouped
isTwoPair h = isPair h >>= isPair
-- Low-value combinations first, so it works well with Value
data Combination = HighCard | Pair Value | TwoPair Value Value | ...
    deriving Ord

-- Combination, remaining cards / kicker. Implicit Ord instance gives
-- you card value order!
type Evaluation = (Combination, HandGrouped)

getPair, getTwoPair :: HandGrouped -> Maybe Evaluation
getPair ([c,_]:xs) = Just (Pair (fst c), xs)
getPair _          = Nothing
getTwoPair xs      = do
  (Pair v1, xs') <- getPair xs
  (Pair v2, xs'') <- getPair xs'
  return (TwoPair v1 v2, xs'')

getCombination :: HandGrouped -> Maybe Evaluation
getCombination xs = msum
  [ ...
  , getTwoPair xs
  , getPair xs
  , return (HighCard, xs)
  ]

Context

StackExchange Code Review Q#12112, answer score: 2

Revisions (0)

No revisions yet.