-- ACM Pacific NW Region Programming Contest, 11 November 2000
-- Problem D, Poker Solitarie
-- Sergio Antoy
-- Wed Nov 14 16:37:08 PST 2001
-- updated: Mon Sep 23 15:22:15 PDT 2002

import SetRBT

groups = [[ 0, 1, 2, 3, 4]
         ,[ 5, 6, 7, 8, 9]
         ,[10,11,12,13,14]
         ,[15,16,17,18,19]
         ,[20,21,22,23,24]
         ,[ 0, 5,10,15,20]
         ,[ 1, 6,11,16,21]
         ,[ 2, 7,12,17,22]
         ,[ 3, 8,13,18,23]
         ,[ 4, 9,14,19,24]
         ,[ 0, 6,12,18,24]
         ,[ 4, 8,12,16,20]
         ]

combinations = [(straight_flush,50)
               ,(four,25)
               ,(full,12)
               ,(flush,10)
               ,(straight,7)
               ,(three,5)
               ,(two_pairs,3)
               ,(pair,1)
               ]

rank 'A' = 0
rank 'K' = 1
rank 'Q' = 2
rank 'J' = 3
rank 'T' = 4
rank '9' = 5
rank '8' = 6
rank '7' = 7
rank '6' = 8
rank '5' = 9
rank '4' = 10
rank '3' = 11
rank '2' = 12

pair [[a1,_],[a2,_],[a3,_],[a4,_],[a5,_]] = 
  a1==a2 || a2==a3 || a3==a4 || a4==a5
two_pairs [[a1,_],[a2,_],[a3,_],[a4,_],[a5,_]] = 
  a1==a2 && a3==a4 || a1==a2 && a4==a5 || a2==a3 && a4==a5
three [[a1,_],[a2,_],[a3,_],[a4,_],[a5,_]] = 
  a1==a2 && a2==a3 || a2==a3 && a3==a4 || a3==a4 && a4==a5
four [[a1,_],[a2,_],[a3,_],[a4,_],[a5,_]] = 
  a1==a2 && a2==a3 && a3==a4 || a2==a3 && a3==a4 && a4==a5
straight p = consecutive (map (\[x,_] -> rank x) p)
  where consecutive [_] = True
        consecutive (a:b:c) = a+1==b && consecutive (b:c)
flush [[_,x1],[_,x2],[_,x3],[_,x4],[_,x5]] =
  x1==x2 && x2==x3 && x3==x4 && x4==x5
full [[a1,_],[a2,_],[a3,_],[a4,_],[a5,_]] =
  a1==a2 && a3==a4 && a4==a5 || a1==a2 && a2==a3 && a4==a5
straight_flush p = straight p && flush p

indices = [(i,j) | i <- [0..23], j <- [i+1..24]]

score p = score1 groups
  where score1 [] = 0
        score1 (g:gs) = score2 combinations + score1 gs
          where pg = sort (map (\x -> p !! x) (map (\y -> g !! y) [0..4]))
                sort = sortRBT (\[r,_] [s,_] -> rank r < rank s)
                score2 [] = 0
                score2 ((c,v):cs) = if (c pg) then v else score2 cs

maximize (p,sp) n = if f==p then (n,sp) else maximize (f,sf) (n+1)
  where (f,sf) = best indices (p,sp)
        best [] (q,sq) = (q,sq)
        best ((i,j):rest) (q,sq) = best rest if sr > sq then (r,sr) else (q,sq)
           where sr = score r
                 r  = swap ()
                 swap () | p =:= x++ki:y++kj:z &>
                           i =:= length x &>
                           j =:= length y+i+1
                         = x++kj:y++ki:z where x,y,z,ki,kj free

doOne p = putStrLn ("Initial score = " ++ show initial) >>
          putStrLn ("Steps = " ++ show steps) >>
          putStrLn ("Final score = " ++ show final) >>
          putStrLn ("") >>
          return ()
        where initial = score p
              (steps,final) =  maximize (p,initial) 0

doAll t | head (head t) == '0' = return ()
        | otherwise = doOne grid >> doAll rest
        where (grid,rest) = splitAt 25 t

main = do input <- readFile "d.dat"
          doSolve (input=:=input)
          doAll (words input)

-- end of program