Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

still doesn't work

  • Loading branch information...
commit d61878d16a2f372f3122721382b4cb68d1ef05c2 1 parent 4d57fc0
authored May 04, 2008

Showing 1 changed file with 40 additions and 20 deletions. Show diff stats Hide diff stats

  1. 60  54/EulerProblem.hs
60  54/EulerProblem.hs
@@ -7,12 +7,12 @@ import Data.List
7 7
 -- Define some card types so that we can compare cards naturally
8 8
 
9 9
 data Game = Win | Loss | Tie
10  
-data Suit = Hearts | Clubs | Diamonds | Spades deriving (Eq, Ord)
11  
-data Card = Card Int Suit deriving (Eq)
  10
+data Suit = Hearts | Clubs | Diamonds | Spades deriving (Eq, Ord, Show)
  11
+data Card = Card Int Suit deriving (Eq, Show)
12 12
 type Hand = [Card]
13 13
 type Set  = [Card] -- This is something like a flush or a full house
14 14
 type HandSet = (Hand, Set)
15  
-data HandRank = HighCard | OnePair | TwoPair | ThreeKind | Straight | Flush | FullHouse | FourKind | StraightFlush | RoyalFlush deriving (Eq, Ord)
  15
+data HandRank = HighCard | OnePair | TwoPair | ThreeKind | Straight | Flush | FullHouse | FourKind | StraightFlush | RoyalFlush deriving (Eq, Ord, Show)
16 16
 
17 17
 instance Ord Card where
18 18
     compare (Card a b) (Card c d)
@@ -57,21 +57,18 @@ isFlush :: Hand -> Bool
57 57
 isFlush (c:cs) = all (== (getSuit c)) (map getSuit cs)
58 58
 
59 59
 isStraight :: Hand -> Bool
60  
-isStraight h = isStraight' h
  60
+isStraight h = isStraight'$ map getCardInt h
61 61
     where
62 62
     isStraight' []  = True
63 63
     isStraight' [x] = True
64 64
     isStraight' (c:c':cs) = (c == (c' - 1)) && (isStraight' (c':cs))
65 65
 
66  
-allSameInList :: Eq a => [a] -> Bool
67  
-allSameInList [] = True
68  
-allSameInList (c:cs) = all (== c) cs
69  
-
70  
-
  66
+-- Turn a list into a list of (item, how many times it appeared in the list)
71 67
 countSortedList :: Ord a => [a] -> [(a, Int)]
72 68
 countSortedList []     = []
73 69
 countSortedList (x:xs) = (x, ct) : (countSortedList rm)
74 70
     where
  71
+    consume x n []     = (n, [])
75 72
     consume x n (y:ys) = if y == x
76 73
                             then consume x (n+1) ys 
77 74
                             else (n, y:ys)
@@ -82,30 +79,53 @@ countList = countSortedList . sort
82 79
 
83 80
 getHandRank :: Hand -> HandRank
84 81
 getHandRank h
85  
-    | (isFlush h) && ((sort $ map getCardInt h) == [1, 10, 11, 12, 13])
  82
+    | flush_p && ((sort $ map getCardInt h) == [1, 10, 11, 12, 13])
86 83
       = RoyalFlush
87  
-    | (isFlush h) && (isStraight h) 
  84
+    | flush_p && straight_p
88 85
       = StraightFlush
89  
-    | (allSameInList $ init svals) || (allSameInList $ tail svals) 
  86
+    | any (== 4) (map snd counted)
90 87
       = FourKind
91 88
     | (length $ nub $ vals) == 2
92 89
       = FullHouse
93  
-    | isFlush h
  90
+    | flush_p
94 91
       = Flush
95  
-    | isStraight h
  92
+    | straight_p
96 93
       = Straight
  94
+    | any (== 3) (map snd counted)
  95
+      = ThreeKind
  96
+    | sort (map snd counted) == [1,2,2]
  97
+      = TwoPair
  98
+    | any (== 3) (map snd counted)
  99
+      = OnePair
  100
+    | otherwise
  101
+      = HighCard
97 102
     where
  103
+    straight_p = isStraight h
  104
+    flush_p = isFlush h
  105
+    counted = countList h
98 106
     vals = map getCardInt h
99 107
     svals = sort vals
100 108
 
101  
-pokerHands :: [(HandSet, HandSet)]
102  
-pokerHands = map lineToHands (lines pokerTxt)
  109
+pokerHands :: [(Hand, Hand)]
  110
+pokerHands = map (lineToHands . init) (lines pokerTxt)
103 111
     where
104 112
     pokerTxt = unsafePerformIO (readFile "poker.txt")
105 113
 
106  
-a :: Card
107  
-a = cardRead "4H"
  114
+highCardTieBreaker :: Hand -> Hand -> Bool
  115
+highCardTieBreaker h1 h2 = agt
  116
+    where
  117
+    m1 = maximum $ map getCardInt h1
  118
+    m2 = maximum $ map getCardInt h2
  119
+    (a1, a2) = (m1, maximum [getSuit c | c <- h1, (getCardInt c == m1)])
  120
+    (b1, b2) = (m2, maximum [getSuit c | c <- h2, (getCardInt c == m2)])
  121
+    agt = if a1 > b1 then True else (if a1 == b1 then a2 > b2 else False)
  122
+
  123
+--answer :: Int
  124
+--main = print [(getHandRank a, getHandRank b) | (a, b) <- pokerHands, getHandRank a /= HighCard]
  125
+
108 126
 
109  
-b = cardRead "TD"
  127
+ph = [([Card 1 Spades, Card 2 Spades, Card 3 Spades, Card 4 Spades, Card 5 Spades], [Card 1 Spades, Card 2 Hearts, Card 3 Spades, Card 4 Hearts, Card 5 Spades])]
110 128
 
111  
-main = print pokerHands
  129
+--main = print pokerHands
  130
+main = print $ 1 + length [(ra, rb) | (a, b) <- pokerHands, let ra = getHandRank a, let rb = getHandRank b, (ra == rb) && (highCardTieBreaker a b)]
  131
+--main = print [(getHandRank a, getHandRank b) | (a, b) <- ph]

0 notes on commit d61878d

Please sign in to comment.
Something went wrong with that request. Please try again.