BMakeitSmooth.hs

BMakeitSmooth.hs

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -cpp #-}
module Main where
import Data.List (zipWith4, foldl', genericLength)
import Control.Monad
import Data.Array 
import Control.Applicative
import Text.Printf

applyDP edits edge xs y = applyDP'
    where
      applyDP' = edge : zipWith4 apply xs  edits (tail edits) applyDP' 
      apply x skew up left | x == y    = skew
                           | otherwise = minimum . map (+1) $ [skew, up, left]
editDistance xs ys =
    last $ foldl' (\dp (i,y) -> applyDP dp i xs y) [0..] $ zip [0..] ys

levenshteinDistance del ins ub xs  = tbl
    where
      ys  = [0 .. 255]
      n   = genericLength xs 
      m   = genericLength ys - 1
      tbl = listArray ((0,0),(n,m)) [ let x =  xs!!i
                                      in
                                        if i==n then 0 --min ins . abs $ (j-i)
                                             else  
                                                 minimum 
                                                        ( map (\a -> let tmp = tbl!(i+1, a ) 
                                                                     in  tmp + abs(a-x) )                                                         
                                                                         [ d| d<-[0..255], abs(d-j)        <= ub ] ++      -- 置換     

                                                          map (\a -> ins + tbl!(i,   a )) 
                                                                         [ d| d<-(between j x) , abs(d-j)  <= ub ] ++     -- 挿入

                                                                         [ tbl!(i+1,   j) + del ]                         -- 削除
                                                        )
                                      | (i,j)<-range((0,0),(n,m))
                                    ]
solve :: Int -> Int -> Int -> [Int] -> Int
solve del ins ub xs = minimum [arr!(0,i)|i<-[0..255]]
    where arr = levenshteinDistance del ins ub xs

output xs = unlines . (zipWith (\ c n -> "Case #"++ show c ++": "++ show n) [1..]) $ xs
put = writeFile "output.txt"

rr :: String -> Int
rr = read
between a b = [min a b + 1 .. max a b - 1]
main = do { n <- rr <$> getLine
          ; forM_ [1..n] (\ i -> do { [del,ins,m,n] <- (map rr) . words <$> getLine 
                                    ;  xs           <- (map rr) . words <$> getLine
                                    ; printf "%s\n" $ ("Case #" ++ show i ++ ": " ++ show (solve del ins m xs))
                                    }
                         )
          }