HaskellでDP(2)

import Control.Monad.State (State,get,put,evalState)
import Control.Monad
import Prelude hiding(lookup)
import Data.Map (Map,lookup,insert,empty)
import IO
import System
import Data.List(sortBy)

-- ====動的計画法====
type Table k v = Map k v
type Memo a b = State (Table a b) b
type Capacity = Int
type Item = (Int,Int)
-- メモ化のテクニック
memoise :: Ord a => (a -> Memo a b) -> a -> Memo a b
memoise f x = do
  table <- get
  case (lookup x table) of
    Just y -> return y
    Nothing -> do fx <- f x
                  table' <- get
                  put(insert x fx table')
                  return fx

runM :: (a -> Memo a b) -> a -> b
runM m v = evalState (m v) empty

-- 動的計画法本体
knap_dp ::(Capacity,[Item]) -> Memo (Capacity,[Item]) Int
knap_dp (0,_)= return 0
knap_dp (b,[])
    | b < 0 = return $ -1
    | otherwise = return 0
knap_dp (b,i:is)
    | b < 0 = return $ -1
    | otherwise = memoise knap_dp' (b,i:is)
    where 
      knap_dp' (b,i:is) = 
          do x <- knap_dp(b,is)
             y <- knap_dp(b- snd i,is)
             return $ if y < 0 then x  else max x $ y+fst i

run_dp = runM knap_dp

-- ====分枝限定法====
itemSort = sortBy g
    where g (a,b) (c,d)
              | a*d - b*c == 0 =EQ
              | a*d - b*c > 0 =LT
              | otherwise = GT

-- 連続緩和問題を貪欲法で解く
relax ::(Capacity,[Item])->Int
relax (c,is) = relax' (c,itemSort is)

relax' ::(Capacity,[Item])->Int
relax'(_,[])=0
relax'(c,i:is)
    | c < snd i = fst i * c `div` snd i
    | otherwise = relax'(c-snd i,is) + fst i

-- 分枝限定法本体
knap_bb ::(Capacity,[Item])->Int->Int->Int
knap_bb (c,[]) v s 
    | c < 0 = s
    | otherwise = v
knap_bb (c,i:is) v s
    | ((+v) $! relax' (c,i:is)) <= s = s
    | c < 0 = s
    | otherwise = let !s1 =knap_bb(c-snd i,is) (v+ fst i) s
                      !s2 =knap_bb(c,is) v s1
                  in max s1 s2

run_bb (c,is) = knap_bb (c,itemSort is') 0 v
    where is' = filter ((<=c).snd) is
          v = foldl1 max . map fst $ is'

-- テストデータ
items ::[Item]
items =[(10,2),(6,19),(29,13),(12,7)]

-- 入出力
getInts = liftM (map read .words) getLine :: IO [Int]
getItem = liftM (toTuple . tail . map read . words) getLine :: IO Item
    where toTuple (x:y:zs) = (x,y)
main :: IO ()
main = do
  arg <- getArgs
  [num,capacity] <- getInts
  items <- replicateM num getItem
  case head arg of
    "bb" -> putStrLn.show $ run_bb (capacity,items)
    "dp" -> putStrLn.show $ run_dp (capacity,items)
    _  -> putStrLn "I need algorithm type"