Knapsack algorithm

knapsack.hs

import qualified Data.Array.IArray as IArray
import qualified Control.Monad.ST as ST
import qualified Data.HashTable.Class as HT
import qualified Data.HashTable.ST.Cuckoo as Cuckoo

type HashTable s k v = Cuckoo.HashTable s k v

knapsack :: IArray.Array Int (Int,Int) -> (Int, Int) -> Int
knapsack items (i,x) = ST.runST $
   do ht <- HT.new :: ST.ST s (HashTable s (Int,Int) Int)
      memoF ht (i,x)
   where
      memoF :: HashTable s (Int,Int) Int -> (Int, Int) -> ST.ST s Int
      memoF ht (i',x') = do
         k <- HT.lookup ht (i',x')
         case k of
            Just k' -> return k'
            Nothing -> do
               k' <- solve (memoF ht) items (i',x')
               HT.insert ht (i',x') k'
               return k'

solve :: Monad m => ((Int, Int) -> m Int) -> IArray.Array Int (Int,Int) -> (Int,Int) -> m Int
solve _ _ (0,_) = return 0
solve _ _ (_,0) = return 0
solve memoF items (i,x) = do
  val1 <- memoF (i-1,x)
  val2 <- if x < w then
            return 0
          else
            fmap ((+) v) $ memoF (i-1,x-w)
  return $ max val1 val2
  where
    (v,w) = (IArray.!) items i