dicepath.hs

import qualified Data.Map as M
import Debug.Trace

valid_states = [(1, 2, 3),(6, 2, 3),(1, 5, 3),(6, 5, 3),(1, 2, 4),(6, 2, 4),(1, 5, 4),(6, 5, 4),
                (1, 3, 2),(6, 3, 2),(1, 4, 2),(6, 4, 2),(1, 3, 5),(6, 3, 5),(1, 4, 5),(6, 4, 5),
                (2, 1, 3),(5, 1, 3),(2, 6, 3),(5, 6, 3),(2, 1, 4),(5, 1, 4),(2, 6, 4),(5, 6, 4),
                (2, 3, 1),(5, 3, 1),(2, 4, 1),(5, 4, 1),(2, 3, 6),(5, 3, 6),(2, 4, 6),(5, 4, 6),
                (3, 1, 2),(4, 1, 2),(3, 6, 2),(4, 6, 2),(3, 1, 5),(4, 1, 5),(3, 6, 5),(4, 6, 5),
                (3, 2, 1),(4, 2, 1),(3, 5, 1),(4, 5, 1),(3, 2, 6),(4, 2, 6),(3, 5, 6),(4, 5, 6)]

max_value :: (Int, Int) -> (Int, Int, Int) -> M.Map ((Int, Int), (Int, Int, Int)) Int
             -> (Int, M.Map ((Int, Int), (Int, Int, Int)) Int)
max_value crd@(x, y) ds@(top, right, front) memo
    | crd == (1, 1) && ds == (1, 4, 2) = (top, memo)
    | crd == (1, 1)                    = (-1000000000, memo)
    | (x < 1) || (y < 1)               = (-1000000000, memo)
    | (crd, ds) `M.member` memo = let ans = M.findWithDefault 0 (crd, ds) memo
                                  in (ans, memo)
    | otherwise                 = let (ans', memo') = max_value ((x - 1), y) (right, (7 - top), front) memo
                                      (ans'', memo'') = max_value (x, (y - 1)) (front, right, (7 - top)) memo'
                                      ans = top + max ans' ans''
                                      memoF = M.insert (crd, ds) ans memo''
                                  in (ans, memoF)

solve_single :: M.Map ((Int, Int), (Int, Int, Int)) Int -> String
                -> (Int, M.Map ((Int, Int), (Int, Int, Int)) Int)
solve_single memo mn = try_states memo valid_states 0
                       where (m:n:_) = map (read :: String -> Int) $ words mn
                             try_states memo [] best = (best, memo)
                             try_states memo (s:r) best = let (ans, memo') = max_value (n, m) s memo
                                                              best' = max best ans
                                                          in try_states memo' r best'

solve :: M.Map ((Int, Int), (Int, Int, Int)) Int -> [String] -> [Int]
solve _ [] = []
solve memo (t:r) = let (ans, memo') = solve_single memo t
                   in ans : (solve memo' r)


main = do
    _ <- getLine
    pairs <- getContents
    mapM_ putStrLn $ map show $ solve M.empty $ lines pairs