Links und Funktionen
Sprachumschaltung

Navigationspfad
Sie sind hier: Startseite / Lehre / WS 2014/15 / Fortgeschrittene Funktionale Programmierung / Material / Memoizing Ackermann


Inhaltsbereich

Memoizing Ackermann

Beschleunigung der Ackermann Funktion durch Memoisation. Einmal mit Lazy Lists und einmal mit einer Hash-Table in einer Zustandsmonade. Zur Demonstration implementieren wir die Zustandsmonade komplett zu Fuss, ohne Verwendung der Standardbibliothek für Zustandsmonaden.

Haskell source code icon AckerMemo.hs — Haskell source code, 2 KB (3017 bytes)

Dateiinhalt

--
-- Fortgeschrittene Funktionale Programmierung, 
--   LMU, TCS, Wintersemester 2014/15
--   Steffen Jost
--

{- Code Beispiel live aus der Vorlesung

   Wir beschleunigen die aufwendige Ackermann Funktion 
   durch Memoisation.
   
   * ackerL :
   Einmal mithilfe von Lazy Listen

   * ackerM :
   Einmal mit einer Zustansmonade.
   Anstatt die State Monade aus der Standardbibliothek zu verwenden,
   programmieren wir die Monade zur Demonstration
   komplett zu Fuss!   
-}  

import qualified Data.Map as Map
import Control.Monad

type Map = Map.Map

-- Normal
ackermann :: Integer -> Integer -> Integer
ackermann 0 m = m+1
ackermann n 0 = ackermann (n-1) 1
ackermann n m = ackermann (n-1) (ackermann n (m-1))             

-- Memoisation mit Lazy Lists
ackerL  :: Integer -> Integer -> Integer
ackerL 0 m = m + 1          -- nicht notwendig, beschleunigt Berechnung aber
ackerL n m = (ackerTable !! (fromIntegral n)) !! (fromIntegral m)

ackerTable :: [[Integer]]
ackerTable = [1..] : 
              [ (ackerL nm1 1) : 
                [ackerL nm1 (ackerL n mm1) 
                | m <- [1..], let mm1 = m-1 
                ] 
              | n <- [1..], let nm1 = n-1 ]
                                 
--

type Memory = Map (Integer,Integer) Integer

newtype StateM a = StateM (Memory -> (a,Memory))

unwrap :: StateM a -> (Memory -> (a,Memory))
unwrap (StateM f) = f

instance Monad StateM where
  -- return :: a -> StateM a
  return x = StateM $ \m -> (x,m)
  
  -- (>>=) :: StateM a -> (a -> StateM b) -> StateM b
  (>>=) mx f = StateM $ \m0 -> 
                let (x,m1) = (unwrap mx) m0
                in unwrap (f x) m1

getState :: StateM Memory
getState = StateM $ \m -> (m,m)

putState :: Memory -> StateM ()
putState m = StateM $ \_ -> ((),m)

insertState :: (Integer,Integer) -> Integer -> StateM ()
insertState k v = do
  s <- getState
  putState $ Map.insert k v s


runState :: Memory -> StateM a -> a
runState m f = fst $ unwrap f m
  
run :: StateM a -> (a,Memory)
run = runWith Map.empty

runWith :: Memory -> StateM a -> (a,Memory)
runWith m f = unwrap f m 


ackerM :: Integer -> Integer -> StateM Integer
ackerM 0 m = return $ m+1
ackerM n 0 = ackerM (n-1) 1
ackerM n m = do
  state0 <- getState
  case Map.lookup (n,m) state0 of
    (Just result) -> return result
    Nothing -> do
      m'     <- ackerM n (m-1)
      result <- ackerM (n-1) m'
---- ALTERNATIVE 1:
--       state1 <- getState -- NICHT VERGESSEN! ZUSTAND KANN SICH INZWISCHEN VERÄNDERT HABEN DURCH DIE BEIDEN AKTIONEN DAVOR!
--       let state2 = Map.insert (n,m) result state1
--       putState state2
--   ALTERNATIVE 2 mit insertState:
      insertState (n,m) result
--      
      return result

{- Beispiele:      

> fst $ run $ ackerM 4 1
65533
it :: Integer
(1.78 secs, 624051016 bytes)

> run $ ackerM 1 4
(6,fromList [((1,1),3),((1,2),4),((1,3),5),((1,4),6)])
it :: (Integer, Memory)
(0.00 secs, 1544288 bytes)

-- Im zweiten Beispiel sehen wir, dass die Wertetabelle bereits 4 Ergebnisse beinhaltet!

-}

Artikelaktionen


Funktionsleiste