解読

一時間半もかかったが解読できたのでメモ。腕力がない…

• 相異点
  • 最初にtransposeしてColor視点にはしない*1

module D050115_2 where
import Data.List

type Color = Int
type Box   = [Int]

tama :: [Box] -> (Int, [[Color]])
tama = head . tamas
tamas boxes
  = map (\(n, p) -> (sum (map sum boxes) - n, p))
    . filter (not . null . snd) 
    . map (appSnd (concatMap sanitize_comb)) 
    . bundle . make_pattern . map sanitize_box
    $ boxes

sanitize_comb [] = [[]]
sanitize_comb (x:xs) 
    = [(y:ys) | y <- x, ys <- sanitize_comb $ map (delete y) xs]

make_pattern ::[[(Int, [Color])]] -> [(Int, [[Color]])]
make_pattern 
  = foldr (\b bs -> mergeFoldr1 (dapp (>=) fst) 
      [ [(n + m, cs:css) | (m, css) <- bs] | (n, cs) <- b]) [(0, [])]

sanitize_box :: [Int] -> [(Int, [Color])]
sanitize_box
  = bundle
    . sortBy (dapp (flip compare) fst)
    . flip zip [0..]

bundle = map (\xs -> (fst $ head xs, map snd xs)) 
        . groupBy (dapp (==) fst) 

--  Test
boxes :: [Box]
boxes = [[5,10,5],[20,10,5],[10,20,10]]

test = tama boxes

--  Generally useful functions
dapp f g x y = f (g x) (g y)

appSnd f (x, y) = (x, f y)

mergeFoldr1 f = foldr1 (\(x:xs) y -> x:merge f xs y)

merge f xs [] = xs
merge f [] ys = ys
merge f xxs@(x:xs) yys@(y:ys)
  | x `f` y = x:merge f xs yys
  | otherwise = y:merge f xxs ys

*1:意味が見出せない