ICPC by Haskell

引き続きICPC2005 Regional, Tokyo の問題Cを Haskell で．サイコロの全パタン生成が一番面倒かも．全盛生後の比較の高速化のために色名を数字に置き換える部分は少々手抜きかも．

 -- Problem C in ACM/ICPC 2005 ASIA Regional Tokyo
 -- 2005/11/04   Brute Force (24^3)
import Control.Monad
import Debug.Trace
import List
main = getProblems >>= mapM_ (putStrLn.show.solve)
 
getProblems = 
    do
    [n] <- getNums
    if n==0 then return []
       else do
            xs <- replicateM n getEntry
            liftM (xs:) getProblems
    where 
    getEntry = liftM words getLine
    getNums = liftM (map read.words) getLine
 
solve::[[String]]->Int
solve [d] = 0
solve ds = let 
           tab = zip (nub.sort.concat $ ds) [1..]
           rep x = case (lookup x tab) of Just i -> i
           ds' = map (map rep) ds
           in foldl1 min.map cost.map (head ds':).prod.map genAll.tail $ ds'
cost = sum . map cost'. trans
cost' xs = length xs - longest (sort xs)
longest (h:ts) = foldl1 max.map snd $ scanl (\(x, c) y -> if y == x then (x, c+1) else (y, 1)) (h,1) ts
trans s] = map (\x -> [) xs
trans (xs:xss) = zipWith (:) xs $ trans xss
prod s] = map (\x->[) xs
prod (xs:xss) = concat.map (\x -> map (x:) (prod xss)) $ xs
 -- generate all dice equivalent to the die by rotation
genAll = concat . map rots2 . rots1
 -- rotations around an axis (the front surface is fixed)
rots2 [x1,x2,x3,x4,x5,x6] = [[x1,x2,x3,x4,x5,x6],
                             [x1,x3,x5,x2,x4,x6],
                             [x1,x5,x4,x3,x2,x6],
                             [x1,x4,x2,x5,x3,x6]]
 -- rotations to move each surface to the front
rots1 [x1,x2,x3,x4,x5,x6] = [[x1,x2,x3,x4,x5,x6],
                             [x2,x6,x3,x4,x1,x5],
                             [x3,x2,x6,x1,x5,x4],
                             [x4,x2,x1,x6,x5,x3],
                             [x5,x1,x3,x4,x6,x2],
                             [x6,x5,x3,x4,x2,x1]]