fix all the bugs (which suprisingly turned out to be in the naive imp…

…lementation

CactusKevEvaluator.hs

@@ -11,11 +11,14 @@ import Lookup (lookupFlushes, lookupUnique5, getValueFromProduct)
 -- Should perhaps keep the lookup tables in here?  Again, something not right
 data CactusKev = CactusKev
 
-cactusKev :: CactusKev
-cactusKev = CactusKev
+cactusKevEvaluator :: CactusKev
+cactusKevEvaluator = CactusKev
+
+maxScore :: Int
+maxScore = 10000
 
 instance Evaluator CactusKev where
-  scoreHand _ hand = evaluate hand
+  scoreHand _ hand = maxScore - evaluate hand
   getCategory _ hand = (handRankFrom . evaluate) hand
 
 -- |A hand consists of five cards
@@ -34,11 +37,11 @@ handRankFrom x
 -- |Hands evaluate to a score, higher score = better
 evaluate :: Hand -> Int
 evaluate (Hand ((Card a),(Card b),(Card c),(Card d),(Card e)))
-  | isFlush = lookupFlushes q 
+  | isFlush =  lookupFlushes q 
   | isHighCardHand /= 0 = isHighCardHand
   | otherwise = getValueFromProduct combinedPrimes
     where
-      isFlush = 0 /= a .&. b .&. c .&. d .&. e .&. 0xF00
+      isFlush = 0 /= a .&. b .&. c .&. d .&. e .&. 0xF000
       -- This is the index for flushes and high card hands
       q = fromEnum ((a .|. b .|. c .|. d .|. e) `shiftR` 16 ) -- TODO eliminate fromEnum
       -- This is a very big number, we need to find the index within products and then lookup in values

Hand.hs

@@ -15,12 +15,13 @@ module Hand (
     isThreeTwoGroup,
     isTwoTwoOneGroup,
     isTwoOneOneOneGroup,
+    isThreeOneOneGroup,
     groupSize,
     mkHand,
     allSameSuit,
     contiguousRanks,
     maxRankInStraight,
-    getGroupedRanks
+    getGroupedRanks,
   ) where
 
 import Card (Card,getRank,getSuit,Rank(..))
@@ -40,25 +41,29 @@ mkHand x = Hand y
 
 data GroupedRanks = FourOneGroup Rank Rank    
                   | ThreeTwoGroup Rank Rank
+                  | ThreeOneOneGroup Rank Rank Rank
                   | TwoTwoOneGroup Rank Rank Rank
                   | TwoOneOneOneGroup Rank Rank Rank Rank
                   | OneOneOneOneOneGroup Rank Rank Rank Rank Rank
 
 biggestValue :: GroupedRanks -> Rank                    
 biggestValue (FourOneGroup a _) = a
 biggestValue (ThreeTwoGroup a _) = a
+biggestValue (ThreeOneOneGroup a _ _) = a
 biggestValue (TwoTwoOneGroup a _ _) = a
 biggestValue (TwoOneOneOneGroup a _ _ _) = a
 biggestValue (OneOneOneOneOneGroup a _ _ _ _ ) = a
 
 secondBiggestValue :: GroupedRanks -> Rank
 secondBiggestValue (FourOneGroup _ a) = a
 secondBiggestValue (ThreeTwoGroup _ a) = a
+secondBiggestValue (ThreeOneOneGroup _ a _) = a
 secondBiggestValue (TwoTwoOneGroup _ a _) = a
 secondBiggestValue (TwoOneOneOneGroup _ a _ _) = a
 secondBiggestValue (OneOneOneOneOneGroup _ a _ _ _ ) = a
 
 thirdBiggestValue :: GroupedRanks -> Rank
+thirdBiggestValue (ThreeOneOneGroup _ _ a) = a
 thirdBiggestValue (TwoTwoOneGroup _ _ a) = a
 thirdBiggestValue (TwoOneOneOneGroup _ _ a _) = a
 thirdBiggestValue (OneOneOneOneOneGroup _ _ a _ _) = a
@@ -67,6 +72,7 @@ thirdBiggestValue _ = error "There is no third biggest value"
 smallestValue :: GroupedRanks -> Rank
 smallestValue (FourOneGroup _ a) = a
 smallestValue (ThreeTwoGroup _ a) = a
+smallestValue (ThreeOneOneGroup _ _ a) = a
 smallestValue (TwoTwoOneGroup _ _ a) = a
 smallestValue (TwoOneOneOneGroup _ _ _ a) = a
 smallestValue (OneOneOneOneOneGroup _ _ _ _ a) = a
@@ -75,6 +81,7 @@ smallestValue (OneOneOneOneOneGroup _ _ _ _ a) = a
 groupSize :: GroupedRanks -> Int
 groupSize (FourOneGroup _ _) = 2
 groupSize (ThreeTwoGroup _ _) = 2
+groupSize (ThreeOneOneGroup _ _ _) = 3
 groupSize (TwoTwoOneGroup _ _ _) = 3
 groupSize (TwoOneOneOneGroup _ _ _ _) = 4
 groupSize (OneOneOneOneOneGroup _ _ _ _ _) = 5
@@ -92,6 +99,10 @@ biggestGroup (TwoTwoOneGroup _ _ _) = 2
 biggestGroup (TwoOneOneOneGroup _ _ _ _) = 2
 biggestGroup (OneOneOneOneOneGroup _ _ _ _ _) = 1
 
+isThreeOneOneGroup :: GroupedRanks -> Bool
+isThreeOneOneGroup (ThreeOneOneGroup _ _ _) = True
+isThreeOneOneGroup _ = False
+
 isThreeTwoGroup :: GroupedRanks -> Bool
 isThreeTwoGroup (ThreeTwoGroup _ _) = True
 isThreeTwoGroup _ = False
@@ -104,22 +115,24 @@ isTwoOneOneOneGroup :: GroupedRanks -> Bool
 isTwoOneOneOneGroup (TwoOneOneOneGroup _ _ _ _) = True
 isTwoOneOneOneGroup _ = False
 
-
 -- Take advantage that they are already sorted by rank
 getGroupedRanks :: Hand -> GroupedRanks
 getGroupedRanks (Hand (a',b',c',d',e')) 
   | allEqual4 a b c d = FourOneGroup a e
   | allEqual4 b c d e = FourOneGroup e a
   | allEqual3 a b c && d == e = ThreeTwoGroup a e
   | allEqual3 c d e && a == b = ThreeTwoGroup c a
+  | allEqual3 a b c && d /= e = ThreeOneOneGroup a e d
+  | allEqual3 b c d && a /= e = ThreeOneOneGroup b e a
+  | allEqual3 c d e && a /= b = ThreeOneOneGroup c b a
   | a == b && c == d = TwoTwoOneGroup a c e
   | a == b && d == e = TwoTwoOneGroup a d c
   | b == c && d == e = TwoTwoOneGroup b d a
-  | a == b = TwoOneOneOneGroup a c d e
-  | b == c = TwoOneOneOneGroup b a d e
-  | c == d = TwoOneOneOneGroup c a b e
-  | d == e = TwoOneOneOneGroup d a b c
-  | otherwise = OneOneOneOneOneGroup a b c d e 
+  | a == b = TwoOneOneOneGroup a e d c
+  | b == c = TwoOneOneOneGroup b e d a
+  | c == d = TwoOneOneOneGroup c e b a
+  | d == e = TwoOneOneOneGroup d c b a
+  | otherwise = OneOneOneOneOneGroup e d c b a
     where
       a = getRank a'
       b = getRank b'

Main.hs

@@ -6,7 +6,7 @@ import Hand (Category(..),Hand(..),mkHand)
 import Choose (combinations)
 
 import SimpleEvaluator (NaiveEvaluator(..), naiveEvaluator)
-import CactusKevEvaluator (CactusKev(..), cactusKev)
+import CactusKevEvaluator (CactusKev(..), cactusKevEvaluator)
 import HandEvaluator (Evaluator(..))
 
 import Data.Map (Map)
@@ -30,7 +30,7 @@ main = do
   let d = createOrderedDeck
       cards = map (mkHand . tupleUp d) $ combinations (5 :: Int) 52
       naiveCategories = getCategories naiveEvaluator cards
-      cactusKevCategories = getCategories cactusKev cards
+      cactusKevCategories = getCategories cactusKevEvaluator cards
 
   print naiveCategories
   print cactusKevCategories

Properties.hs

@@ -1,11 +1,11 @@
 module Properties where
 
 import HandEvaluator (Evaluator(..))
-import CactusKevEvaluator (CactusKev(..), cactusKev)
+import CactusKevEvaluator (CactusKev(..), cactusKevEvaluator)
 import SimpleEvaluator (NaiveEvaluator(..), naiveEvaluator)
 
 import Card (Card,mkCard,Suit(..),Rank(..))
-import Hand (Hand(..), Category(..), mkHand)
+import Hand (Hand(..), Category(..), mkHand, getGroupedRanks)
 
 import Test.QuickCheck
 
@@ -21,11 +21,27 @@ instance Arbitrary Card where
     rank <- arbitrary
     return (mkCard suit rank)
 
+-- |Note that mkHand is only needed for the case when 
 instance Arbitrary Hand where
   arbitrary = do
     a <- arbitrary
-    b <- arbitrary
-    c <- arbitrary
-    d <- arbitrary
-    e <- arbitrary
-    return (Hand (a,b,c,d,e))
+    b <- suchThat arbitrary (/= a)
+    c <- suchThat arbitrary (\x -> not $ x `elem` [a,b])
+    d <- suchThat arbitrary (\x -> not $ x `elem` [a,b,c])
+    e <- suchThat arbitrary (\x -> not $ x `elem` [a,b,c,d])
+    return (mkHand (a,b,c,d,e))
+
+-- Does the model implementation (naive) match the cactus kev implementation?
+prop_modelHandCategory :: Hand -> Bool
+prop_modelHandCategory hand = categoryNaive == categoryCactus
+  where
+    categoryNaive  = getCategory naiveEvaluator hand
+    categoryCactus = getCategory cactusKevEvaluator hand
+
+prop_modelScoreAgree :: Hand -> Hand -> Bool
+prop_modelScoreAgree a b = (compare n1 n2) == (compare c1 c2)
+  where
+    n1 = scoreHand naiveEvaluator a
+    n2 = scoreHand naiveEvaluator b
+    c1 = scoreHand cactusKevEvaluator a
+    c2 = scoreHand cactusKevEvaluator b

SimpleEvaluator.hs

@@ -12,6 +12,7 @@ import Hand (
   secondBiggestValue,
   thirdBiggestValue,
   isThreeTwoGroup,
+  isThreeOneOneGroup,
   isTwoTwoOneGroup,
   isTwoOneOneOneGroup,
   allSameSuit,
@@ -135,7 +136,7 @@ mkStraight :: Hand -> BestHand
 mkStraight hand = Straight (maxRankInStraight hand)
 
 isThreeOfAKind :: GroupedRanks -> Bool
-isThreeOfAKind groupedRanks = groupSize groupedRanks == 3 && isThreeTwoGroup groupedRanks
+isThreeOfAKind groupedRanks = groupSize groupedRanks == 3 && isThreeOneOneGroup groupedRanks
 
 mkThreeOfAKind :: GroupedRanks -> BestHand
 mkThreeOfAKind groupedRanks = ThreeOfAKind (biggestValue groupedRanks) (secondBiggestValue groupedRanks) (thirdBiggestValue groupedRanks)