Chapter7.tex

\newpage
%----------------------------------------------------------------------------------------------------
\section{Printing} 
%----------------------------------------------------------------------------------------------------
\vspace{10cm}
\hrule

\lhQ What should we work on, now ?
\lhA Let's do something that is easy, for a change.
\lhN What about printing the rankings ?
\lhA That will be short and sweet.
\lhN Do you remember what the program is expected to print?
\lhA Not much.
\lhN Here's an example:
\begin{alltt}
\clubs{K} \spades{9} \spades{K} \diamonds{K} \diamonds{9} \clubs{3} \diamonds{6} Full House (winner)
\clubs{9} \hearts{A} \spades{K} \diamonds{K} \diamonds{9} \clubs{3} \diamonds{6} Two Pair
\clubs{A} \clubs{Q} \spades{K} \diamonds{K} \diamonds{9} \clubs{3} 
\hearts{9} \spades{5} 
\diamonds{4} \diamonds{2} \spades{K} \diamonds{K} \diamonds{9} \clubs{3} \diamonds{6} Flush
\spades{7} \spades{T} \spades{K} \diamonds{K} \diamonds{9} 
\end{alltt}
\lhA I see. We need to print:
\begin{itemize}
\item the line of cards we have in input
\item the ranking of the hand found in the line
\item the mention \il!"(winner)"! along with the best ranking
\end{itemize}
\hspace*{\fill}\vspace*{\fill}
\lhN Let's take care of your second item: showing the ranking.
\lhA Ok.
\lhN  Here's a test:
\begin{lstlisting}[frame=single]
showRanking (hand "6♣ 4♦ A♣ 3♠ K♠") ~?= "High Card"
\end{lstlisting}
\lhA Easy:
\begin{lstlisting}[frame=single]
showRanking :: Hand -> String
showRanking _ = "High Card"
\end{lstlisting}
\success And the test passes.
\lhN Here's another test, then:
\begin{lstlisting}[frame=single]
showRanking (hand "5♥ 2♦ 3♥ 4♦ 2♥") ~?= "Pair"
\end{lstlisting}
\lhA 
\begin{lstlisting}[frame=single]
showRanking :: Hand -> String
showRanking (Pair _) = "Pair"
showRanking _ = "High Card"
\end{lstlisting}
\success Done. That's easy.
\lhN Yes, easy, and tedious. Could we skip the testing part on that feature?
\lhA Not if we abide by the rule \#1 of TDD.
\lhN Which is?
\lhA You are not allowed to write any production code unless it is to make a failing unit test pass.
\lhN But I don't want to create all these hands just so that we can test the label given to the ranking.
\lhA Then just test the label given to the ranking.
\lhN You mean I should write my tests like this:
\begin{lstlisting}[frame=single]
  ,showRanking HighCard ~?= "High Card"
  ,showRanking Pair ~?= "Pair"
\end{lstlisting}
It doesn't sound right, though. Look at the message:
\begin{small}
\begin{verbatim}
Couldn't match expected type `Hand'
against inferred type `[Card] -> Hand'
\end{verbatim}
\end{small}
\lhA \error No, that's not right. You can't use these data constructors without a list of \il!Card!s.
But an empty list should do the trick.
\lhN Let's try:
\begin{lstlisting}[frame=single]
       ,showRanking (HighCard []) ~?= "High Card"
       ,showRanking (Pair []) ~?= "Pair"
\end{lstlisting}
\lhA \success Yes, that's better.
\lhN In that case, I'd rather create a single test for all ranking labels:
\begin{lstlisting}[frame=single]
map showRanking [HighCard [],
                   Pair [],
                   TwoPairs [],
                   ThreeOfAKind [],
                   Straight [],
                   Flush [],
                   FullHouse [],
                   FourOfAKind [],
                   StraightFlush []] ~?=
     ["High Card","Pair","Two Pairs","Three of a Kind",
      "Straight","Flush","Full House",
      "Four of a Kind","Straight Flush"]
\end{lstlisting}
\lhA Ok. Here the function \il!showRanking!:
\begin{lstlisting}[frame=single]
showRanking :: Hand -> String
showRanking (HighCard)        = "High Card"
showRanking (Pair _)          = "Pair" 
showRanking (TwoPairs _)      = "Two Pairs" 
showRanking (ThreeOfAKind _)  = "Three of a Kind" 
showRanking (Straight _)      = "Straight" 
showRanking (Flush _)         = "Flush" 
showRanking (FullHouse _)     = "Full House" 
showRanking (FourOfAKind _)   = "Four of a Kind"
showRanking (StraightFlush _) = "Straight Flush"
\end{lstlisting}
\success And your big test is passing. But this is not quite satisfying.
\lhN Agreed. The test is not as expressive as it should be. What we want to express is that, for example: \\
\emph{the keyword \il!FourOfAKind! should be displayed as \il!"Four of a Kind"!.}
\lhA Then you can change the tests.
\lhN Allright.
\begin{lstlisting}[frame=single]
 TestList [show HighCard ~?= "High Card",
           show Pair ~?= "Pair",
           show TwoPairs ~?=  "Two Pairs",
           show ThreeOfAKind ~?= "Three of a Kind",
           show Straight ~?= "Straight",
           show Flush ~?= "Flush",
           show FullHouse ~?= "Full House",
           show FourOfAKind ~?= "Four of a Kind",
           show StraightFlush ~?= "Straight Flush"] 
\end{lstlisting}
\error This provokes an error:
\begin{small}
\begin{verbatim}
No instance for (Show ([Card] -> Hand))
\end{verbatim}
\end{small}
\lhA \error Data constructor like \il!HighCard! or \il!Pair! are really functions. And we cannot make a function \il!Show!able.
\lhN What should we do then?
\lhA Create a data type for these values:
\begin{lstlisting}[frame=single]
data Ranking = HighCard
              | Pair
              | TwoPairs
              | ThreeOfAKind
              | Straight
              | Flush
              | FullHouse
              | FourOfAKind
              | StraightFlush
            deriving (Ord,Eq)
\end{lstlisting}
\error This is only the first step.
\lhN Indeed. Now we have \emph{multiple declarations} errors: each value is declared in both \il!Hand! type and \il!Ranking! type.
\lhA We don't need any more to have them in the \il!Hand! type. 
\begin{lstlisting}[frame=single]
data Hand = H Ranking [Card]
            deriving (Ord,Eq)
\end{lstlisting}            
\error Now creating a \il!Hand! is done with the data constructor \il!H!, followed by a \il!Ranking! and a list of \il!Card!s. \\ Of course this is only the second step.
\lhN The \il!ranking! function is broken: \\
\begin{small}
\begin{verbatim}
Couldn't match expected type `[Card] -> Hand'
against inferred type `Ranking'
In the expression: FourOfAKind [a, b, c, d, ....]
\end{verbatim}
\end{small}
\lhA \error To fix this, we need to use \il!H!, the new data constructor:
\begin{lstlisting}[frame=single]
ranking :: [[Card]] -> Hand
ranking [[a,b,c,d],[e]]  = H FourOfAKind [a,b,c,d,e]
ranking [[a,b,c],[d,e]]  = H FullHouse [a,b,c,d,e]
ranking [[a,b,c],[d],[e]]= H ThreeOfAKind [a,b,c,d,e]
ranking [[a,b],[c,d],[e]]= H TwoPairs [a,b,c,d,e]
ranking [[a,b],[c],[d],[e]]  = H Pair     [a,b,c,d,e]
ranking [[a],[b],[c],[d],[e]]= H HighCard [a,b,c,d,e] 
\end{lstlisting} \newpage
\lhN We have the same error in functions \il!promoteStraight! and \il!promoteFlush!.
\lhA \error We'll apply the same fix:
\begin{lstlisting}[frame=single]
promoteStraight :: Hand -> Hand
promoteStraight (H HighCard [a,b,c,d,e]) 
    | value a - value e == 4 = H Straight [a,b,c,d,e]
promoteStraight (H HighCard [a,b,c,d,e]) 
    | value a == 14 &&  value b == 5 = H Straight [b,c,d,e,a]
promoteStraight h = h

promoteFlush :: Hand -> Hand
promoteFlush (H HighCard cs) | flush cs = H Flush cs
promoteFlush (H Straight cs) | flush cs = H StraightFlush cs
promoteFlush h = h
\end{lstlisting}
\error But we still have remaining errors.
\lhN Yes: \\
\begin{small}
\begin{verbatim}
Couldn't match expected type `Hand' 
   against inferred type `Ranking'
In the pattern: HighCard _
In the definition of `showRanking': 
   showRanking (HighCard _) = "High Card"
\end{verbatim}
\end{small}
\lhA Yes, \il!showRanking! is not correct any more. First we have to declare \il!Ranking! to be an instance of the class \il!Show!. Then we have to override the \il!show! function for \il!Ranking! values.
\begin{lstlisting}[frame=single]
instance (Show) Ranking
    where
      show HighCard      = "High Card"
      show Pair          = "Pair" 
      show TwoPairs      = "Two Pairs" 
      show ThreeOfAKind  = "Three of a Kind" 
      show Straight      = "Straight" 
      show Flush         = "Flush" 
      show FullHouse     = "Full House" 
      show FourOfAKind   = "Four of a Kind"
      show StraightFlush = "Straight Flush"
\end{lstlisting}
\success And we're done.
\lhN Now that the tests are passing, we should refactor the code.
\lhA You are right. Let's begin with the \il!ranking! function. Here it is:
\begin{lstlisting}[frame=single]
ranking :: [[Card]] -> Hand
ranking [[a,b,c,d],[e]] = H FourOfAKind [a,b,c,d,e]
ranking [[a,b,c],[d,e]] = H FullHouse [a,b,c,d,e]
ranking [[a,b,c],[d],[e]] = H ThreeOfAKind [a,b,c,d,e]
ranking [[a,b],[c,d],[e]] = H TwoPairs [a,b,c,d,e]
ranking [[a,b],[c],[d],[e]]   = H Pair     [a,b,c,d,e]
ranking [[a],[b],[c],[d],[e]] = H HighCard [a,b,c,d,e] 
\end{lstlisting}
\lhN We should change its name, because a function called \il!ranking! should be about extracting the \il!Ranking! value from a \il!Hand!. 
\lhA I agree. \newpage
\lhN What would be a good name for a function that ranks a list of cards ?
\lhA That would be \il!rank!:.
\begin{lstlisting}[frame=single]
hand :: String -> Hand
hand =     cards
       >>. rSortBy (comparing value)
       >>. groupBy (same value)
       >>. rSortBy (comparing length)
       >>. rank
       >>. promoteStraight
       >>. promoteFlush    

rank :: [[Card]] -> Hand
rank [[a,b,c,d],[e]]       = H FourOfAKind [a,b,c,d,e]
rank [[a,b,c],[d,e]]       = H FullHouse [a,b,c,d,e]
rank [[a,b,c],[d],[e]]     = H ThreeOfAKind [a,b,c,d,e]
rank [[a,b],[c,d],[e]]     = H TwoPairs [a,b,c,d,e]
rank [[a,b],[c],[d],[e]]   = H Pair     [a,b,c,d,e]
rank [[a],[b],[c],[d],[e]] = H HighCard [a,b,c,d,e] 
\end{lstlisting}
\success There.
\lhN Something is bothering me: the \il!rank! function is not $DRY$.
\lhA Yes. Since we list the cards along with every \il!Ranking! value, we can do that once in the main body of the function, and calculate the ranking in an auxiliary function. Thus we are separating concerns.
\begin{lstlisting}[frame=single]
rank :: [[Card]] -> Hand
rank gs = H (calcRank gs) (concat gs)  
    where calcRank [[_,_,_,_],_]   = FourOfAKind 
          calcRank [[_,_,_],_]     = FullHouse
          calcRank [[_,_,_],_,_]   = ThreeOfAKind
          calcRank [[_,_],[_,_],_] = TwoPairs
          calcRank [[_,_],_,_,_]   = Pair    
          calcRank [_,_,_,_,_]     = HighCard 
\end{lstlisting}
\success As you probably know, \il!concat! concatenates several lists into one.
\newpage
\lhN Ok. Here's the test code:
\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♠"
       ,"6♠ 5♦ 4♣ 3♦ 2♥" `beat` "A♣ A♥ A♦ K♣ Q♠"
       ,"5♠ 4♦ 3♣ 2♦ A♥" `beat` "A♣ A♥ A♦ K♣ Q♠"
       ,"6♥ 4♥ 3♥ 2♥ A♥" `beat` "A♠ K♣ Q♥ J♠ T♦"
       ,"5♥ 4♥ 3♥ 2♥ A♥" `beat` "A♦ A♠ A♥ A♠ K♥"
       ,"6♥ 5♥ 4♥ 3♥ 2♥" `beat` "A♦ A♠ A♥ A♠ K♥"
       ,TestList [show HighCard ~?= "High Card",
                  show Pair ~?= "Pair",
                  show TwoPairs ~?=  "Two Pairs",
                  show ThreeOfAKind ~?= "Three of a Kind",
                  show Straight ~?= "Straight",
                  show Flush ~?= "Flush",
                  show FullHouse ~?= "Full House",
                  show FourOfAKind ~?= "Four of a Kind",
                  show StraightFlush ~?= "Straight Flush"] 
       ]
    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 = H Ranking [Card]
            deriving (Ord,Eq)

data Ranking = HighCard
             | Pair
             | TwoPairs
             | ThreeOfAKind
             | Straight
             | Flush
             | FullHouse
             | FourOfAKind
             | StraightFlush
            deriving (Ord,Eq)

instance (Show) Ranking
    where
      show HighCard      = "High Card"
      show Pair          = "Pair" 
      show TwoPairs      = "Two Pairs" 
      show ThreeOfAKind  = "Three of a Kind" 
      show Straight      = "Straight" 
      show Flush         = "Flush" 
      show FullHouse     = "Full House" 
      show FourOfAKind   = "Four of a Kind"
      show StraightFlush = "Straight Flush"

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

rSortBy :: (Ord a) => (a -> a -> Ordering) -> [a] -> [a]
rSortBy f = sortBy (flip f)
\end{lstlisting}
\lhN \lhA
\begin{lstlisting}[frame=single]


(>>.) :: (a -> b) -> (b -> c) -> (a -> c)
(>>.) = flip (.)

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

rank :: [[Card]] -> Hand
rank gs = H (calcRank gs) (concat gs)  
    where calcRank [[_,_,_,_],_]   = FourOfAKind 
          calcRank [[_,_,_],_]     = FullHouse
          calcRank [[_,_,_],_,_]   = ThreeOfAKind
          calcRank [[_,_],[_,_],_] = TwoPairs
          calcRank [[_,_],_,_,_]   = Pair    
          calcRank [_,_,_,_,_]     = HighCard 

cards :: String -> [Card]
cards = map card . words 

promoteStraight :: Hand -> Hand
promoteStraight (H Straight [a,b,c,d,e]) 
    | value a - value e == 4 = 
        H Straight [a,b,c,d,e]
promoteStraight (H HighCard [a,b,c,d,e]) 
    | value a == 14 && value b == 5 = 
        H Straight [b,c,d,e,a]
promoteStraight h = h


promoteFlush :: Hand -> Hand
promoteFlush (H HighCard cs) 
    | flush cs = H Flush cs
promoteFlush (H Straight cs) 
    | flush cs = H StraightFlush cs
promoteFlush h = h
\end{lstlisting}
\lhend