Add solutions for problems 52-54.

Problem052.hs

@@ -0,0 +1,14 @@
+-- It can be seen that the number, 125874, and its double, 251748, contain
+-- exactly the same digits, but in a different order.
+--
+-- Find the smallest positive integer, x, such that 2x, 3x, 4x, 5x, and 6x,
+-- contain the same digits.
+
+import Euler
+import Debug.Trace
+
+main = print $ head $ do
+   n <- [1..]
+   let xs = map (sort . toDigits . (n *)) [2,3,4,5,6] :: [[Int]]
+   guard $ all (== head xs) (tail xs)
+   return n

Problem053.hs

@@ -0,0 +1,19 @@
+-- There are exactly ten ways of selecting three from five, 12345:
+--
+-- 123, 124, 125, 134, 135, 145, 234, 235, 245, and 345
+--
+-- In combinatorics, we use the notation, 5C3 = 10.
+--
+-- In general,
+--
+-- nCr = n!/(r!(n−r)!), where r ≤ n, n! = n×(n−1)×...×3×2×1, and 0! = 1.
+--
+-- It is not until n = 23, that a value exceeds one-million: 23C10 = 1144066.
+--
+-- How many, not necessarily distinct, values of nCr, for 1 ≤ n ≤ 100, are
+-- greater than one-million?
+
+import Euler
+
+n `nCr` r = product [max r (n-r) + 1 .. n] `div` product [1 .. min r (n-r)]
+main = print $ length [ () | n <- [1..100], r <- [1..n], n `nCr` r > 1000000 ]

Problem054.hs

@@ -0,0 +1,73 @@
+{-# LANGUAGE ViewPatterns, LambdaCase #-}
+
+-- The file, poker.txt, contains one-thousand random hands dealt to two
+-- players. Each line of the file contains ten cards (separated by a single
+-- space): the first five are Player 1's cards and the last five are Player 2's
+-- cards. You can assume that all hands are valid (no invalid characters or
+-- repeated cards), each player's hand is in no specific order, and in each
+-- hand there is a clear winner.
+--
+-- How many hands does Player 1 win?
+
+import Euler
+import Data.Attoparsec.Text
+import Data.Maybe
+import Data.Monoid
+
+import qualified Data.Text    as T
+import qualified Data.Text.IO as T
+
+type Rank = Int
+type Suit = Char
+data Card = Card { cardRank :: Rank, cardSuit :: Suit } deriving (Eq,Show)
+
+data HandRank = HighCard | Pair | TwoPair | Triple | Straight | Flush
+              | FullHouse | Quad | StraightFlush | RoyalFlush
+              deriving (Eq,Ord,Enum,Bounded,Show)
+
+handRank (sortBy (compare `on` cardRank) -> cards)
+   | same suits, ranks == [10 .. 14]         = (RoyalFlush, 14)
+   | same suits, consecutive ranks           = (StraightFlush, maximum ranks)
+   | Just a <- nSame 4 ranks                 = (Quad, a)
+   | Just a <- nSame 3 ranks,
+     Just b <- nSame 2 (filter (/= a) ranks) = (FullHouse, a)
+   | same suits                              = (Flush, maximum ranks)
+   | consecutive ranks                       = (Straight, maximum ranks)
+   | Just a <- nSame 3 ranks                 = (Triple, a)
+   | Just a <- nSame 2 ranks,
+     Just b <- nSame 2 (filter (/= a) ranks) = (TwoPair, max a b)
+   | Just a <- nSame 2 ranks                 = (Pair, a)
+   | otherwise                               = (HighCard, maximum ranks)
+   where
+      ranks = map cardRank cards
+      suits = map cardSuit cards
+
+same :: Eq a => [a] -> Bool
+same xs = and $ zipWith (==) xs (tail xs)
+
+nSame :: Eq a => Int -> [a] -> Maybe a
+nSame n cs = listToMaybe $ do
+   c <- nub cs
+   guard $ length (filter (== c) cs) >= n
+   return c
+
+consecutive :: (Eq a, Enum a) => [a] -> Bool
+consecutive xs = and $ zipWith (\a b -> succ a == b) xs (tail xs)
+
+rankP = flip fmap (satisfy (`elem` "23456789TJQKA")) $ \case
+   'T' -> 10; 'J' -> 11; 'Q' -> 12; 'K' -> 13; 'A' -> 14; c -> read [c]
+suitP = satisfy (`elem` "CDHS")
+
+cardP = Card <$ skipSpace <*> rankP <*> suitP
+handP = sequenceA $ replicate 5 cardP
+lineP = (,) <$> handP <*> handP
+fileP = (lineP `sepBy` endOfLine) <* optional endOfLine <* endOfInput
+
+compareHands :: [Card] -> [Card] -> Ordering
+compareHands xs ys = (handRank  xs `compare` handRank  ys)
+                  <> (descRanks xs `compare` descRanks ys)
+   where descRanks = sortBy (flip compare) . map cardRank
+
+main = do
+   hands <- either error id . parseOnly fileP <$> T.readFile "p054_poker.txt"
+   print $ length $ filter (== GT) $ map (uncurry compareHands) hands