Functional Programming

hw02misc_task02.hs

import Control.Monad.State
import qualified Data.Map as Map


-- Мини-фреймворк для автоматической мемоизации рекурсивных функций.
-- Построен с помощью монады State.

-- Чтобы воспользоваться фреймворком, нужно описать требуемое вычисление
-- в монадической форме и с открытой рекурсией. Последнее означает,
-- что пользовательская функция должна в качестве первого дополнительного
-- параметра принимать функцию self и делегировать ей все рекурсивные
-- вызовы. Тип пользовательской функции должен быть равен OpenFunction a r,
-- где a - тип единственного аргумента вычисляемой функции, r - тип
-- результата вычисления. Например, для вычисления n-ого числа Фибоначчи
-- можно сделать следующие определения:

-- openFibonacci :: OpenFunction Int Integer
-- openFibonacci self n = do
--   if n < 2
--   then return (fromIntegral n)
--   else do
--     prev1 <- self (n - 1)
--     prev2 <- self (n - 2)
--     return (prev1 + prev2)

-- fibonacci :: Int -> Integer
-- fibonacci = memoized openFibonacci

-- Ту же самую функцию, однако, можно записать существенно короче:

-- fibonacci :: Int -> Integer
-- fibonacci = memoized $ \self n ->
--   if n < 2
--   then return (fromIntegral n)
--   else liftM2 (+) (self (n - 1)) (self (n - 2))

-- Как видно, мемоизированную версию пользовательской функции можно получить
-- применив комбинатор memoized :: Ord a => OpenFunction a r -> a -> r.


recall :: Ord a => a -> State (Map.Map a r) (Maybe r)
recall arg = do
  memory <- get
  return (Map.lookup arg memory)

memorize :: Ord a => a -> r -> State (Map.Map a r) ()
memorize arg result = do
  memory <- get
  put (Map.insert arg result memory)

type MemorizedResult a r = State (Map.Map a r) r
type ClosedFunction a r = a -> MemorizedResult a r
type OpenFunction a r = ClosedFunction a r -> ClosedFunction a r

memoized :: Ord a => OpenFunction a r -> a -> r
memoized client arg = evalState (closeThroughMemory client arg) Map.empty

closeThroughMemory :: Ord a => OpenFunction a r -> ClosedFunction a r
closeThroughMemory client arg = do
  recalled <- recall arg
  case recalled of
    Just result -> return result
    Nothing -> do
      result <- client (closeThroughMemory client) arg
      memorize arg result
      return result



nseq :: Int -> Int
nseq n = memoized generalized (1, n)
  where generalized _ (_, 0) = return 1
        generalized self (lowerBound, total) = foldr add (return 0) [lowerBound .. total]
          where add nextTerm = liftM2 (+) $ self (nextTerm + 1, total - nextTerm)