Chcete číst

14. 9. 2012

Memoizace v Haskellu

aneb zatracené monády!

Poslední dobou si znovu hraji s Haskellem. Už jsem ho zkoušel několikrát, ale vždycky jsem to vzdal. Vypadá to, že teď už s ním dovedu aspoň trochu vyjít :)

Pro mě se vyznačuje hlavně tím, že píšete program, píšete, píšete, a pak uložíte, zkusíte spustit/zkompilovat, a zjistíte, že máte chyby v typech. Začnete opravovat chyby v typech, ty se zatím promítnou do všech možných částí kódu, a když potom konečně opravíte i tu poslední, program funguje přesně tak, jak jste chtěli. Haskell z run-time chyb dělá compile-time chyby.

Kvůli jednomu Project Euler problému jsem chtěl použít memoizaci. Což o to, na internetu je spousta článků, jak v Haskellu udělat memoizaci, problém je v tom, že jsem chtěl memoizovat funkci s více argumenty!

Našel jsem víceméně srozumitelný článek a jal se ho upravovat pro své potřeby. No ani za nic. Prostě ne. Skončilo to chybovou hláškou "Pro tuto funkci potřebujete Math level 41 a Monad level 73" (dobře, přeháním... jen 70). Vydal jsem se na IRC (#haskell), kde mě rychle uvedli na pravou míru. A protože bych řešení zapomněl, zvěčním si to tady (a tady).

-- from http://www.nadineloveshenry.com/haskell/memofib.html#memoize
-- had some problems when function had more arguments though, so saving this for future me :)

import Debug.Trace
import Data.Map as Map
import Control.Monad.State.Lazy as State

--------------------------------------------

type StateMap a b = State (Map a b) b

memoizeM :: (Show a, Show b, Ord a) => 
            ((a -> StateMap a b) -> (a -> StateMap a b)) -> (a -> b)
memoizeM t x = evalState (f x) Map.empty where
  g x = do
    y <- t f x  
    m <- get
    put $ Map.insert x y m
    newM <- get
    return y
    --return $ trace ("Map now containsn" ++ Map.showTree newM) y
  f x = get >>= m -> maybe (g x) return (Map.lookup x m)


--------------------------------------------
{-

how to do it:

 - type:
     :: Type1 -> Type2 -> Endtype
   rewrite into
     :: Monad m =>
        ((Type1, Type2) -> m Endtype)
      -> (Type1, Type2) -> m Endtype

 - definition:
     myFun x y
   rewrite into
     myFun f (x,y)

 - call:
     myFun x y
   rewrite into
     f (x,y)
   and probably inside return or its own var (cause it's monad)

-}
--------------------------------------------

-- one argument

normalFib :: Integer -> Integer
normalFib 0 = 1
normalFib 1 = 1
normalFib n = normalFib (n-1) + normalFib (n-2)

fibM :: Monad m =>
        (Integer -> m Integer)
      -> Integer -> m Integer
fibM f 0 = return 1
fibM f 1 = return 1
fibM f n = do
  a <- f (n-1)
  b <- f (n-2)
  return (a+b)

fib n = memoizeM fibM n

--------------------------------------------

-- more arguments

normalAdd :: Int -> Int -> Int
normalAdd 0 y = y
normalAdd x y = normalAdd (x-1) (y+1)

addM :: Monad m =>
        ((Int, Int) -> m Int)
      -> (Int, Int) -> m Int
addM f (0,y) = return y
addM f (x,y) = do
  answer <- f ((x-1), (y+1))
  return answer

add x y = memoizeM addM (x,y)

--------------------------------------------

main = do
        print $ normalFib 10
        print $ fib 10
        print $ normalAdd 5 6
        print $ add 5 6

Napište komentář