Memoizace v Haskellu
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