-- ACM Pacific NW Region Programming Contest, 11 November 2000 -- Problem C, Solitaire Cribbage -- Sergio Antoy -- Sat Dec 1 14:00:21 PST 2001 -- updated: Mon Sep 23 15:22:15 PDT 2002 import Char import Read import List import SetRBT import Combinatorial two hc = if length hc == 2 then two1 hc else 0 where two1 [x,y] = if x==y then 2 else 0 run hc = run1 hc 0 where run1 [] 0 = 0 run1 [_] n = if n>=2 then n+1 else 0 run1 (a:b:c) n = if ord a + 1 == ord b then run1 (b:c) (n+1) else 0 fifteen hc = if foldl (\x y -> x + rank y) 0 hc == 15 then 2 else 0 where rank c = if isDigit c then ord c - ord '0' else 10 score hc = accum parts + accumRuns (sortedRuns parts) where parts = allSubsets hc accum parts = foldl (\x y -> x + score1 y) 0 parts score1 x = two x + fifteen x sortedRuns parts = sortRBT (>) (map run parts) accumRuns (s:ss) = foldl (+) 0 (takeWhile (== s) (s:ss)) prettyPrint count extra ((h,c),(sh,sc)) = putStrLn ("Deal #" ++ (show count) ++ ":") >> putStrLn ("Extra Card: " ++ [extra]) >> putStrLn ("Hand: " ++ hand ++ " = " ++ (show2 sh) ++ " points") >> putStrLn ("Crib: " ++ crib ++ " = " ++ (show2 sc) ++ " points") >> putStrLn ("Best Score = " ++ (show2 (sh + sc))) >> putStrLn "" where hand = delete extra h crib = delete extra c show2 n = if n < 10 then " "++show n else show n doOne d count = prettyPrint count extra (findMax allSplits allScores) where (deal,[extra]) = splitAt 8 d allSplits = findall (\x -> partition deal =:= x) partition deal | A++[P]++B++[Q]++C++[R]++D++[S]++E =:= deal = (sort [extra,P,Q,R,S], sort (extra:A++B++C++D++E)) where A,B,C,D,E,P,Q,R,S free sort = sortRBT (\x y -> pos x <= pos y) pos c = if isDigit c then ord c - ord '1' else disp c where disp 'T' = 10 disp 'J' = 11 disp 'Q' = 12 disp 'K' = 13 allScores = map (\(x,y) -> (score x, score y)) allSplits findMax (hc:hcs) (s:ss) = fm1 hc hcs s ss where fm1 hc [] s [] = (hc,s) fm1 hc (hc1:hcs) (sh,sc) ((sh1,sc1):ss) = if (sh1+sc1>sh+sc) then fm1 hc1 hcs (sh1,sc1) ss else fm1 hc hcs (sh, sc) ss doAll (d:ds) c = if d=="000000000" then return () else doOne d c >> doAll ds (c+1) main = do input <- readFile "c.dat" doSolve (input=:=input) doAll (words input) 1