やってみた，というか書いてみた．

遅いなー 

import Data.List
import Data.Array
import Control.Monad
import Text.Printf
import Data.Bits
main = do
(n:_) <- getList :: IO [Int]
forM_ [1..n] $ i -> do
(k:_) <- getList
cs <- getLine
printf "Case #%d: %dn" i (minArray k cs)
split :: Int -> [a] -> [[a]]
split k xs = takeWhile (not.null).map (take k).iterate (drop k) $ xs
cost, lastCost :: (Eq a) => [[a]] -> Int -> Int -> Int
cost ccs p q = length.filter (uncurry (/=)) $ zip ps qs
where ps = map (!!p) ccs
qs = map (!!q) ccs
lastCost ccs p q = length.filter (uncurry (/=)) $ zip ps qs
where ps = map (!!p) ccs
qs = map (!!q) $ tail ccs
minArray :: (Eq a) => Int -> [a] -> Int
minArray k cs = succ.minimum $ [size i j| i <- [..k-1], j <- [..k-1], i /= j]
where ccs = split k cs
fill = (2::Int) ^ k - 1
costA = fArray (uncurry $ cost ccs) ((,),(k-1,k-1))
size s t = sA ! (fill, t) + lastCost ccs s t
where sA = fArray spart ((,),(fill,k-1))
spart (u,v) | null ws   = costA!(s, v)
| otherwise = minimum [sA!(clearBit u w, w) + costA !(w, v) | w <- ws]
where ws = filter (testBit u) $ delete s [..k-1]
fArray :: (Ix i) => (i -> b) -> (i, i) -> Array i b
fArray f (l,u) = listArray (l,u).map f.range $ (l,u)
getList :: Read a => IO [a]
getList = liftM (map read.words) getLine

うーん，これは書きかたが悪いのか，それとも，Haskellだから遅いのか．

どっちでも，困るなー．

ちなみに，MemoTrieだと遅すぎた．

計算量は O(2^k * k ^2)ぐらいなはず，なんだが． k <= 16だから，10^7ぐらい．

トラクタブルなはずだが，遅い．