Chapter5.tex

\newpage
%----------------------------------------------------------------------------------------------------
\section{Grouping Cards} 
%----------------------------------------------------------------------------------------------------
\vspace{10cm}
\hrule

\lhQ So far, our hand comparisons are correct as long as we compare \emph{High Cards} hands or compare a \emph{High Card} to a \emph{Pair}. What's the next step?
\lhA Comparing \emph{Pairs}.
\lhN Ok. Here's a test:
\begin{lstlisting}[frame=single]
,"5♥ 4♦ 3♥ 2♦ 3♣" `beat` "5♥ 2♦ 3♥ 4♦ 2♥"]
    where beat h g = comparing hand h g ~?= GT
\end{lstlisting}
The hand on the left should win, since a pair of 3 beats a pair of 2s. But the test fails, we get \il!EQ! instead of \il!GT!.
\lhA \failure We can solve this by storing cards along with the \il!Pair! value in the \il!Hand! type:
\begin{lstlisting}[frame=single]
data Hand = HighCard [Card]
          | Pair     [Card]
            deriving (Ord,Eq)
\end{lstlisting}
\lhN And we must complete the \il!hand! function, too.
\lhA \error Yes:
\begin{lstlisting}[frame=single]
hand :: String -> Hand
hand s = case length gs  of
           4 -> Pair cs
           5 -> HighCard cs 
       where cs = sortBy (flip compare) $ cards s
             gs = groupBy (same value) cs
\end{lstlisting} %$
\success And now the test passes.
\lhN We have a problem, though. Can you see it?
\lhA Not yet.
\lhN Look at the \il!hand! function. \\ What is the value of \il!cs! when \il!s! equals \il!"5♥ 4♦ 3♥ 2♦ 3♣"!?
\lhA That's \il![5, 4, 3, 3, 2]!.
\lhN And what would be the value of \il!cs! if \il!s! was equal to  \il!"5♥ 2♦ 3♥ 7♦ 2♦"!?
\lhA \il![7,5,3,2,2]!. Ouch.
\lhN Let's write a new test:
\begin{lstlisting}[frame=single]
    ,"5♥ 4♦ 3♥ 3♣ 2♥" `beat` "7♦ 5♥ 3♦ 2♠ 2♦"]
\end{lstlisting}
\failure and sure enough the test is failing.
\lhA \failure I see. The value of the pair should beat the value of the remaining cards.
\lhN Do you know how to solve this?
\lhA No. 
\lhN What is the simplest possible thing that would make the tests pass?
\lhA Using the \emph{fake it} strategy. We can arrange the cards according to their place in the groups list.
\lhN Well, do this, then.
\lhA I want to refactor the code, first. 
\lhN Ok I'm removing my last test
\lhA \success Thanks. Here's my refactoring:
\begin{lstlisting}[frame=single]
hand :: String -> Hand
hand s = case gs  of
           [_,_,_,_]   -> Pair cs
           [_,_,_,_,_] -> HighCard cs 
       where cs = sortBy (flip compare) $ cards s
             gs = groupBy (same value) cs
\end{lstlisting} %$
\success Everything is still working fine.
\lhN What's the use of these patterns?
\lhA \success Describing the two cases of \emph{Pair} that we have so far:
\begin{lstlisting}[frame=single]
hand :: String -> Hand
hand s = case gs  of
           [[a],[b],[c],[d,e]] -> Pair cs
           [[a],[b],[c,d],[e]] -> Pair cs
           [_,_,_,_,_] -> HighCard cs 
       where cs = sortBy (flip compare) $ cards s
             gs = groupBy (same value) cs
\end{lstlisting} %$
\success Please put your last test back in the code.
\lhN Here it is :
\begin{lstlisting}[frame=single]
    ,"5♥ 4♦ 3♥ 3♣ 2♥" `beat` "7♦ 5♥ 3♦ 2♠ 2♦"]
\end{lstlisting}
\failure Still failing.
\lhA \failure The \il!a,b,c,d,e! variables will be used to rearrange the \il!Pair! value. 
\begin{lstlisting}[frame=single]
hand :: String -> Hand
hand s = case gs  of
           [[a],[b],[c],[d,e]] -> Pair [d,e,a,b,c]
           [[a],[b],[c,d],[e]] -> Pair [c,d,a,b,e]
           [_,_,_,_,_] -> HighCard cs 
       where cs = sortBy (flip compare) $ cards s
             gs = groupBy (same value) cs
\end{lstlisting} %$
\success And now the pairs are correctly compared.
\lhN Ok. What if we have pairs on the highest values? It wouldn't match our two patterns. 
\lhA I told you it was a \emph{fake}. In fact, comparing pairs would always work if we had only one pattern for pairs: \il![[a,b],[c],[d],[e]]!
\lhN How can we ensure we always have this pattern for pairs?
\lhA By sorting the groups by size, in reverse order:
\begin{lstlisting}[frame=single]
hand :: String -> Hand
hand s = case gs  of
           [[a],[b],[c],[d,e]] -> Pair [d,e,a,b,c]
           [[a],[b],[c,d],[e]] -> Pair [c,d,a,b,e]
           [_,_,_,_,_] -> HighCard cs 
       where cs = sortBy (flip compare) $ cards s
             gs = sortBy (flip groupSize) $ groupBy (same value) cs
             groupSize  = comparing length 
\end{lstlisting}
\failure That's what the \il!sortBy (flip groupSize)! does. But we're still in red.
\lhN Yes, we now have non-exhaustive patterns in our three last tests.
\lhA \failure Let's replace the previous pair patterns with the only remaining possible one:
\begin{lstlisting}[frame=single]
hand :: String -> Hand
hand s = case gs  of
           [[a,b],[c],[d],[e]] -> Pair [a,b,c,d,e]
           [_,_,_,_,_] -> HighCard cs 
       where cs = sortBy (flip compare) $ cards s
             gs = sortBy (flip groupSize) $ groupBy (same value) cs
             groupSize  = comparing length 
\end{lstlisting}
\success And we're back to green.
\lhN How can we make this code more legible?
\lhA We can put some symmetry into the patterns:
\begin{lstlisting}[frame=single]
hand :: String -> Hand
hand s = case gs  of
           [[a,b],[c],[d],[e]]  -> Pair [a,b,c,d,e]
           [[a],[b],[c],[d],[e]]-> HighCard [a,b,c,d,e] 
    where cs = sortBy (flip compare) $ cards s
          gs = sortBy (flip groupSize) $ groupBy (same value) cs
          groupSize  = comparing length 
\end{lstlisting}
\lhN The function is quite long; can you split it into two parts, one for grouping cards, one for finding the ranking?
\lhA \success Sure:
\begin{lstlisting}[frame=single]
hand :: String -> Hand
hand s = ranking gs
    where cs = sortBy (flip compare) $ cards s
          gs = sortBy (flip groupSize) $ groupBy (same value) cs
          groupSize  = comparing length 

ranking :: [[Card]] -> Hand
ranking [[a,b],[c],[d],[e]]   = Pair     [a,b,c,d,e]
ranking [[a],[b],[c],[d],[e]] = HighCard [a,b,c,d,e] 
\end{lstlisting}
\success Done.
\newpage
\lhN Then, write a clearer version of \il!hand!.
\lhA Here we go:
\begin{lstlisting}[frame=single]
hand :: String -> Hand
hand = ranking .
       sortBy (flip (comparing length)) .
       groupBy (same value) .
       sortBy (flip compare) .
       cards

ranking :: [[Card]] -> Hand
ranking [[a,b],[c],[d],[e]]   = Pair     [a,b,c,d,e]
ranking [[a],[b],[c],[d],[e]] = HighCard [a,b,c,d,e] 
\end{lstlisting}
\success Done.
\lhN The \il!sortBy (flip (..))! construct is a bit complicated. Can you make the code more legible?
\lhA Yes. 
\begin{lstlisting}[frame=single]
hand :: String -> Hand
hand = ranking . 
       rSortBy (comparing length) .
       groupBy (same value) . 
       rSortBy (comparing value) . cards

rSortBy :: (Ord a) => (a -> a -> Ordering) -> [a] -> [a]
rSortBy f = sortBy (flip f)
\end{lstlisting}
\success For \il!Card!s, \il!compare! and \il!comparing value! are equivalent, so we can use the latter form for symmetry.
\lhN The function we use for ranking is quite powerful. How easily do you think it could handle new rankings?
\lhA Write a new test, and we will see.
\lhN Allright. Here's a test saying that the lowest \emph{Two Pairs} can beat the highest possible \emph{Pair}.
\begin{lstlisting}[frame=single]
       ,"2♦ 2♣ 3♣ 3♠ 4♥" `beat` "A♥ A♠ K♣ Q♦ J♠"]
\end{lstlisting}
This test is in error with the following message: \\
\begin{small}
\begin{verbatim}
non-exhaustive pattern in function ranking
\end{verbatim}
\end{small}
Can you make it pass?
\lhA \error Let's begin by adding the pattern for \emph{Two Pairs}:
\begin{lstlisting}[frame=single]
ranking :: [[Card]] -> Hand
ranking [[a,b],[c,d],[e]]     = TwoPairs [a,b,c,d,e]
ranking [[a,b],[c],[d],[e]]   = Pair     [a,b,c,d,e]
ranking [[a],[b],[c],[d],[e]] = HighCard [a,b,c,d,e] 
\end{lstlisting}
\error We're not done yet.
\lhN Here's what the error message says: \\
\begin{small}
\begin{verbatim}
Not in scope: data constructor `TwoPairs'
\end{verbatim}
\end{small}
\lhA Let's insert the constructor into the \il!Hand! type:
\begin{lstlisting}[frame=single]
data Hand = HighCard [Card]
          | Pair     [Card]
          | TwoPairs [Card]
            deriving (Ord,Eq)
\end{lstlisting}
\success And now we can detect and compare \emph{Two Pairs} hands. 
\newpage
\lhN Good. Now, here's a test saying that the lowest \emph{Three of a Kind} can beat the highest possible \emph{Two Pairs}.
\begin{lstlisting}[frame=single]
       ,"2♦ 2♣ 2♠ 3♥ 4♦" `beat` "A♥ A♠ K♣ K♦ J♠"]
\end{lstlisting}
The fails with a message similar to the previous one: \\
\begin{small}
\begin{verbatim}
non-exhaustive pattern in function ranking
\end{verbatim}
\end{small}
\lhA \error Let's add the pattern for \emph{Three of a Kind}:
\begin{lstlisting}[frame=single]
ranking :: [[Card]] -> Hand
ranking [[a,b,c],[d],[e]]     = ThreeOfAKind [a,b,c,d,e]
ranking [[a,b],[c,d],[e]]     = TwoPairs [a,b,c,d,e]
ranking [[a,b],[c],[d],[e]]   = Pair     [a,b,c,d,e]
ranking [[a],[b],[c],[d],[e]] = HighCard [a,b,c,d,e] 
\end{lstlisting}
\error And you should have a new message.
\lhN Indeed: \\
\begin{small}
\begin{verbatim}
Not in scope: data constructor `ThreeOfAKind'
\end{verbatim}
\end{small}
\lhA Here I go:
\begin{lstlisting}[frame=single]
data Hand = HighCard [Card]
          | Pair     [Card]
          | TwoPairs [Card]
          | ThreeOfAKind [Card]
            deriving (Ord,Eq)
\end{lstlisting}
\success And now we can also detect and compare \emph{Three of a Kind} hands. 
\lhN Great. What other ranking can we add that would use different group patterns?
\lhA Let's go for \emph{Full House} and \emph{Four of a Kind}.
\lhN What about \emph{Straight} and \emph{Flush}?
\lhA There's no new grouping involved in those. We can add them later.
\lhN Ok. Here's a test:
\begin{lstlisting}[frame=single]
       ,"2♦ 2♠ 2♥ 2♣ 3♦" `beat` "A♥ A♦ A♠ K♥ K♠"]
\end{lstlisting}
It states that the lowest \emph{Four of a Kind} beats the highest \emph{Full House}.
\lhA \error Let's begin with adding the constructors:
\begin{lstlisting}[frame=single]
data Hand = HighCard [Card]
          | Pair     [Card]
          | TwoPairs [Card]
          | ThreeOfAKind [Card]
          | FullHouse [Card]
          | FourOfAKind [Card]
            deriving (Ord,Eq)
\end{lstlisting}
\lhN Good.
\lhA \error Then we add the group patterns:
\begin{lstlisting}[frame=single]
ranking :: [[Card]] -> Hand
ranking [[a,b,c,d],[e]]       = FourOfAKind [a,b,c,d,e]
ranking [[a,b,c],[d,e]]       = FullHouse [a,b,c,d,e]
ranking [[a,b,c],[d],[e]]     = ThreeOfAKind [a,b,c,d,e]
ranking [[a,b],[c,d],[e]]     = TwoPairs [a,b,c,d,e]
ranking [[a,b],[c],[d],[e]]   = Pair     [a,b,c,d,e]
ranking [[a],[b],[c],[d],[e]] = HighCard [a,b,c,d,e] 
\end{lstlisting}
\success And it's done.
\newpage
\lhN Great. Here's the test code so far:
\begin{lstlisting}[frame=single]
module Tests
where 
import Test.HUnit
import PokerHand
import Data.Ord (comparing)
import Data.List (sort,sortBy)

ud = words "A♣ 2♣ T♣ K♣ 9♣ Q♣ J♣"
sd = words "2♣ 9♣ T♣ J♣ Q♣ K♣ A♣"

main = runTestTT $ TestList 
       [sortBy (comparing card) ud  ~?= sd
       ,map suit (cards "A♣ A♦ A♥ A♠") ~?= ['♣','♦','♥','♠']
       ,flush (cards "A♣ T♣ 3♣ 4♣ 2♣") ~?= True
       ,flush (cards "A♠ T♣ 3♣ 4♣ 2♣") ~?= False
       ,flush (cards "A♠ T♠ 3♠ 4♠ 2♠") ~?= True
       ,"6♣ 4♦ A♣ 3♠ K♠" `beat` "8♥ J♥ 7♦ 5♥ 6♣"
       ,"5♥ 2♦ 3♥ 4♦ 2♥" `beat` "A♥ K♥ Q♦ J♦ 9♥"
       ,"5♥ 4♦ 3♥ 2♦ 3♣" `beat` "A♥ K♥ Q♦ J♦ 9♥"
       ,"5♥ 4♦ 3♥ 3♣ 2♥" `beat` "7♦ 5♥ 3♦ 2♠ 2♦"
       ,"2♦ 2♣ 3♣ 3♠ 4♥" `beat` "A♥ A♠ K♣ Q♦ J♠"  
       ,"2♦ 2♣ 2♠ 3♥ 4♦" `beat` "A♥ A♠ K♣ K♦ J♠"
       ,"2♦ 2♠ 2♥ 2♣ 3♦" `beat` "A♥ A♦ A♠ K♥ K♠"]
    where beat h g = comparing hand h g ~?= GT
\end{lstlisting} %$
\lhA And here's the tested code:
\begin{lstlisting}[frame=single]
module PokerHand
where
import Char
import Data.Ord
import Data.List

data Card = C { value :: Value, suit :: Suit } 
            deriving (Ord,Eq)
type Value = Int
type Suit = Char

data Hand = HighCard [Card]
          | Pair     [Card]
          | TwoPairs [Card]
          | ThreeOfAKind [Card]
          | FullHouse [Card]
          | FourOfAKind [Card]
            deriving (Ord,Eq)

card :: String -> Card
card [v,s] = C (toValue v) s
    where 
      toValue 'A' = 14
      toValue 'K' = 13
      toValue 'Q' = 12
      toValue 'J' = 11
      toValue 'T' = 10
      toValue  c  = ((ord c) - (ord '0'))

same :: (Eq a) => (t -> a) -> t -> t -> Bool
same f a b = f a == f b

flush :: [Card] -> Bool
flush (c:cs) = all (same suit c) cs

hand :: String -> Hand
hand = ranking . 
       rSortBy (comparing length) .
       groupBy (same value) . 
       rSortBy (comparing value) . cards

rSortBy :: (Ord a) => (a -> a -> Ordering) -> [a] -> [a]
rSortBy f = sortBy (flip f)

ranking :: [[Card]] -> Hand
ranking [[a,b,c,d],[e]]       = FourOfAKind [a,b,c,d,e]
ranking [[a,b,c],[d,e]]       = FullHouse [a,b,c,d,e]
ranking [[a,b,c],[d],[e]]     = ThreeOfAKind [a,b,c,d,e]
ranking [[a,b],[c,d],[e]]     = TwoPairs [a,b,c,d,e]
ranking [[a,b],[c],[d],[e]]   = Pair     [a,b,c,d,e]
ranking [[a],[b],[c],[d],[e]] = HighCard [a,b,c,d,e] 

cards :: String -> [Card]
cards = map card . words 
\end{lstlisting}
\lhN Now is a good time to pause.
\lhA I'll have a \emph{croque monsieur} with salad.
\lhend