-- 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