Auswendiglernen in Haskell?

136

Hinweise zur effizienten Lösung der folgenden Funktion in Haskell für große Zahlen (n > 108)

f(n) = max(n, f(n/2) + f(n/3) + f(n/4))

Ich habe Beispiele für das Auswendiglernen in Haskell gesehen, um Fibonacci-Zahlen zu lösen, bei denen alle Fibonacci-Zahlen (träge) bis zum erforderlichen n berechnet wurden. In diesem Fall müssen wir für ein gegebenes n nur sehr wenige Zwischenergebnisse berechnen.

Vielen Dank

Angel de Vicente
quelle
110
Nur in dem Sinne, dass es eine Arbeit ist, die ich zu Hause mache :-)
Angel de Vicente

Antworten:

256

Wir können dies sehr effizient tun, indem wir eine Struktur erstellen, die wir in sublinearer Zeit indizieren können.

Aber zuerst,

{-# LANGUAGE BangPatterns #-}

import Data.Function (fix)

Lassen Sie uns definieren f, aber lassen Sie es "offene Rekursion" verwenden, anstatt sich selbst direkt aufzurufen.

f :: (Int -> Int) -> Int -> Int
f mf 0 = 0
f mf n = max n $ mf (n `div` 2) +
                 mf (n `div` 3) +
                 mf (n `div` 4)

Sie können eine unmemoized fmit verwendenfix f

Auf diese Weise können Sie testen, fwas Sie für kleine Werte fvon tun, indem Sie beispielsweise Folgendes aufrufen:fix f 123 = 144

Wir könnten dies auswendig lernen, indem wir definieren:

f_list :: [Int]
f_list = map (f faster_f) [0..]

faster_f :: Int -> Int
faster_f n = f_list !! n

Das funktioniert passabel gut und ersetzt das, was O (n ^ 3) Zeit in Anspruch nehmen würde, durch etwas, das die Zwischenergebnisse auswendig lernt.

Es dauert jedoch immer noch eine lineare Zeit, nur um zu indizieren, um die gespeicherte Antwort für zu finden mf. Dies bedeutet, dass Ergebnisse wie:

*Main Data.List> faster_f 123801
248604

sind erträglich, aber das Ergebnis skaliert nicht viel besser. Wir können es besser machen!

Definieren wir zunächst einen unendlichen Baum:

data Tree a = Tree (Tree a) a (Tree a)
instance Functor Tree where
    fmap f (Tree l m r) = Tree (fmap f l) (f m) (fmap f r)

Und dann definieren wir einen Weg, um darin zu indizieren, damit wir stattdessen einen Knoten mit Index nin O (log n) Zeit finden können:

index :: Tree a -> Int -> a
index (Tree _ m _) 0 = m
index (Tree l _ r) n = case (n - 1) `divMod` 2 of
    (q,0) -> index l q
    (q,1) -> index r q

... und wir finden vielleicht einen Baum voller natürlicher Zahlen, damit wir nicht mit diesen Indizes herumspielen müssen:

nats :: Tree Int
nats = go 0 1
    where
        go !n !s = Tree (go l s') n (go r s')
            where
                l = n + s
                r = l + s
                s' = s * 2

Da wir indizieren können, können Sie einfach einen Baum in eine Liste konvertieren:

toList :: Tree a -> [a]
toList as = map (index as) [0..]

Sie können die bisherige Arbeit überprüfen, indem Sie überprüfen, ob toList natsSie diese erhalten[0..]

Jetzt,

f_tree :: Tree Int
f_tree = fmap (f fastest_f) nats

fastest_f :: Int -> Int
fastest_f = index f_tree

funktioniert genau wie in der obigen Liste, aber anstatt lineare Zeit zu benötigen, um jeden Knoten zu finden, kann er in logarithmischer Zeit verfolgt werden.

Das Ergebnis ist erheblich schneller:

*Main> fastest_f 12380192300
67652175206

*Main> fastest_f 12793129379123
120695231674999

In der Tat ist es so viel schneller , dass Sie durchmachen können und ersetzen Intmit Integeroben und fast augenblicklich lächerlich großen Antworten erhalten

*Main> fastest_f' 1230891823091823018203123
93721573993600178112200489

*Main> fastest_f' 12308918230918230182031231231293810923
11097012733777002208302545289166620866358
Edward KMETT
quelle
3
Ich habe diesen Code ausprobiert und interessanterweise schien f_faster langsamer als f zu sein. Ich denke, diese Listenreferenzen haben die Dinge wirklich verlangsamt. Die Definition von Nats und Index schien mir ziemlich mysteriös, deshalb habe ich meine eigene Antwort hinzugefügt, die die Dinge klarer machen könnte.
Pitarou
5
Der Fall der unendlichen Liste muss sich mit einer verknüpften Liste von 111111111 Elementen befassen. Der Baumfall befasst sich mit log n * der Anzahl der erreichten Knoten.
Edward KMETT
2
Das heißt, die Listenversion muss Thunks für alle Knoten in der Liste erstellen, während die Baumversion das Erstellen vieler Knoten vermeidet.
Tom Ellis
7
Ich weiß, dass dies ein ziemlich alter Beitrag ist, aber nicht f_treein einer whereKlausel definiert werden sollte , um zu vermeiden, dass nicht benötigte Pfade über Aufrufe hinweg im Baum gespeichert werden.
Feuer
17
Der Grund für das Einfügen in eine CAF war, dass Sie über Anrufe hinweg Memoisierung erhalten konnten. Wenn ich einen teuren Anruf hätte, den ich auswendig gelernt habe, würde ich ihn wahrscheinlich in einem CAF belassen, daher die hier gezeigte Technik. In einer realen Anwendung gibt es natürlich einen Kompromiss zwischen den Vorteilen und Kosten einer dauerhaften Erinnerung. Angesichts der Frage, wie Memoisierung erreicht werden kann, wäre es meiner Meinung nach irreführend, mit einer Technik zu antworten, die Memoisierung über Anrufe hinweg bewusst vermeidet, und wenn nichts anderes, dann wird dieser Kommentar hier die Leute auf die Tatsache hinweisen, dass es Feinheiten gibt. ;)
Edward KMETT
17

Edwards Antwort ist so ein wunderbares Juwel, dass ich sie dupliziert und Implementierungen von memoListund bereitgestellt habememoTree Kombinatoren , die eine Funktion in offen-rekursiver Form auswendig lernen.

{-# LANGUAGE BangPatterns #-}

import Data.Function (fix)

f :: (Integer -> Integer) -> Integer -> Integer
f mf 0 = 0
f mf n = max n $ mf (div n 2) +
                 mf (div n 3) +
                 mf (div n 4)


-- Memoizing using a list

-- The memoizing functionality depends on this being in eta reduced form!
memoList :: ((Integer -> Integer) -> Integer -> Integer) -> Integer -> Integer
memoList f = memoList_f
  where memoList_f = (memo !!) . fromInteger
        memo = map (f memoList_f) [0..]

faster_f :: Integer -> Integer
faster_f = memoList f


-- Memoizing using a tree

data Tree a = Tree (Tree a) a (Tree a)
instance Functor Tree where
    fmap f (Tree l m r) = Tree (fmap f l) (f m) (fmap f r)

index :: Tree a -> Integer -> a
index (Tree _ m _) 0 = m
index (Tree l _ r) n = case (n - 1) `divMod` 2 of
    (q,0) -> index l q
    (q,1) -> index r q

nats :: Tree Integer
nats = go 0 1
    where
        go !n !s = Tree (go l s') n (go r s')
            where
                l = n + s
                r = l + s
                s' = s * 2

toList :: Tree a -> [a]
toList as = map (index as) [0..]

-- The memoizing functionality depends on this being in eta reduced form!
memoTree :: ((Integer -> Integer) -> Integer -> Integer) -> Integer -> Integer
memoTree f = memoTree_f
  where memoTree_f = index memo
        memo = fmap (f memoTree_f) nats

fastest_f :: Integer -> Integer
fastest_f = memoTree f
Tom Ellis
quelle
12

Nicht der effizienteste Weg, merkt sich aber:

f = 0 : [ g n | n <- [1..] ]
    where g n = max n $ f!!(n `div` 2) + f!!(n `div` 3) + f!!(n `div` 4)

auf Anfrage f !! 144wird geprüft, obf !! 143 vorhanden, der genaue Wert wird jedoch nicht berechnet. Es ist immer noch als unbekanntes Ergebnis einer Berechnung festgelegt. Die einzigen exakten berechneten Werte sind die benötigten.

Soweit berechnet, weiß das Programm zunächst nichts.

f = .... 

Wenn wir die Anfrage stellen f !! 12, wird ein Mustervergleich durchgeführt:

f = 0 : g 1 : g 2 : g 3 : g 4 : g 5 : g 6 : g 7 : g 8 : g 9 : g 10 : g 11 : g 12 : ...

Jetzt beginnt die Berechnung

f !! 12 = g 12 = max 12 $ f!!6 + f!!4 + f!!3

Dies stellt rekursiv eine weitere Anforderung an f, also berechnen wir

f !! 6 = g 6 = max 6 $ f !! 3 + f !! 2 + f !! 1
f !! 3 = g 3 = max 3 $ f !! 1 + f !! 1 + f !! 0
f !! 1 = g 1 = max 1 $ f !! 0 + f !! 0 + f !! 0
f !! 0 = 0

Jetzt können wir einige wieder hochrinnen

f !! 1 = g 1 = max 1 $ 0 + 0 + 0 = 1

Das heißt, das Programm weiß jetzt:

f = 0 : 1 : g 2 : g 3 : g 4 : g 5 : g 6 : g 7 : g 8 : g 9 : g 10 : g 11 : g 12 : ...

Weiter rieseln:

f !! 3 = g 3 = max 3 $ 1 + 1 + 0 = 3

Das heißt, das Programm weiß jetzt:

f = 0 : 1 : g 2 : 3 : g 4 : g 5 : g 6 : g 7 : g 8 : g 9 : g 10 : g 11 : g 12 : ...

Nun fahren wir mit unserer Berechnung fort von f!!6:

f !! 6 = g 6 = max 6 $ 3 + f !! 2 + 1
f !! 2 = g 2 = max 2 $ f !! 1 + f !! 0 + f !! 0 = max 2 $ 1 + 0 + 0 = 2
f !! 6 = g 6 = max 6 $ 3 + 2 + 1 = 6

Das heißt, das Programm weiß jetzt:

f = 0 : 1 : 2 : 3 : g 4 : g 5 : 6 : g 7 : g 8 : g 9 : g 10 : g 11 : g 12 : ...

Nun fahren wir mit unserer Berechnung fort von f!!12:

f !! 12 = g 12 = max 12 $ 6 + f!!4 + 3
f !! 4 = g 4 = max 4 $ f !! 2 + f !! 1 + f !! 1 = max 4 $ 2 + 1 + 1 = 4
f !! 12 = g 12 = max 12 $ 6 + 4 + 3 = 13

Das heißt, das Programm weiß jetzt:

f = 0 : 1 : 2 : 3 : 4 : g 5 : 6 : g 7 : g 8 : g 9 : g 10 : g 11 : 13 : ...

Die Berechnung erfolgt also ziemlich träge. Das Programm weiß, dass ein Wert für f !! 8existiert, der gleich ist g 8, aber es hat keine Ahnung, was g 8ist.

Rampion
quelle
Danke für diesen einen. Wie würden Sie einen zweidimensionalen Lösungsraum erstellen und verwenden? Wäre das eine Liste von Listen? undg n m = (something with) f!!a!!b
Wikingersteve
1
Klar könntest du. Für eine echte Lösung würde ich wahrscheinlich eine Memoisierungsbibliothek
Rampion
Es ist leider O (n ^ 2).
Qumeric
8

Dies ist ein Nachtrag zu Edward Kmotts ausgezeichneter Antwort.

Als ich seinen Code ausprobierte, schienen die Definitionen von natsund indexziemlich mysteriös zu sein, also schreibe ich eine alternative Version, die ich leichter verständlich fand.

Ich definiere indexund natsin Bezug auf index'undnats' .

index' t nwird über den Bereich definiert [1..]. (Erinnern Sie sich daran, dass dies index tüber den Bereich definiert ist [0..].) Es durchsucht den Baum, indem es nals eine Folge von Bits behandelt und die Bits in umgekehrter Reihenfolge durchliest. Wenn das Bit ist 1, nimmt es den rechten Zweig. Wenn das Bit ist 0, nimmt es den linken Zweig. Es stoppt, wenn es das letzte Bit erreicht (das a sein muss 1).

index' (Tree l m r) 1 = m
index' (Tree l m r) n = case n `divMod` 2 of
                          (n', 0) -> index' l n'
                          (n', 1) -> index' r n'

Genau wie natsfür definiert, indexso dass index nats n == nimmer wahr ist, nats'ist für definiert index'.

nats' = Tree l 1 r
  where
    l = fmap (\n -> n*2)     nats'
    r = fmap (\n -> n*2 + 1) nats'
    nats' = Tree l 1 r

Nun, natsund indexsind einfach nats'und index'doch mit den um 1 verschobenen Werten:

index t n = index' t (n+1)
nats = fmap (\n -> n-1) nats'
Pitarou
quelle
Vielen Dank. Ich merke mir eine multivariate Funktion, und das hat mir wirklich geholfen herauszufinden, was Index und Nats wirklich taten.
Kittsil
8

Wie in der Antwort von Edward Kmett angegeben, müssen Sie kostspielige Berechnungen zwischenspeichern und schnell darauf zugreifen können, um die Dinge zu beschleunigen.

Um die Funktion nicht monadisch zu halten, erfüllt die Lösung des Erstellens eines unendlichen faulen Baums mit einer geeigneten Methode zum Indizieren (wie in den vorherigen Beiträgen gezeigt) dieses Ziel. Wenn Sie die nicht-monadische Natur der Funktion aufgeben, können Sie die in Haskell verfügbaren assoziativen Standardcontainer in Kombination mit „zustandsähnlichen“ Monaden (wie State oder ST) verwenden.

Während der Hauptnachteil darin besteht, dass Sie eine nicht monadische Funktion erhalten, müssen Sie die Struktur nicht mehr selbst indizieren und können nur Standardimplementierungen von assoziativen Containern verwenden.

Dazu müssen Sie zuerst Ihre Funktion neu schreiben, um jede Art von Monade zu akzeptieren:

fm :: (Integral a, Monad m) => (a -> m a) -> a -> m a
fm _    0 = return 0
fm recf n = do
   recs <- mapM recf $ div n <$> [2, 3, 4]
   return $ max n (sum recs)

Für Ihre Tests können Sie weiterhin eine Funktion definieren, die mit Data.Function.fix keine Memoisierung ausführt, obwohl sie etwas ausführlicher ist:

noMemoF :: (Integral n) => n -> n
noMemoF = runIdentity . fix fm

Sie können dann State Monad in Kombination mit Data.Map verwenden, um die Dinge zu beschleunigen:

import qualified Data.Map.Strict as MS

withMemoStMap :: (Integral n) => n -> n
withMemoStMap n = evalState (fm recF n) MS.empty
   where
      recF i = do
         v <- MS.lookup i <$> get
         case v of
            Just v' -> return v' 
            Nothing -> do
               v' <- fm recF i
               modify $ MS.insert i v'
               return v'

Mit geringfügigen Änderungen können Sie den Code so anpassen, dass er stattdessen mit Data.HashMap funktioniert:

import qualified Data.HashMap.Strict as HMS

withMemoStHMap :: (Integral n, Hashable n) => n -> n
withMemoStHMap n = evalState (fm recF n) HMS.empty
   where
      recF i = do
         v <- HMS.lookup i <$> get
         case v of
            Just v' -> return v' 
            Nothing -> do
               v' <- fm recF i
               modify $ HMS.insert i v'
               return v'

Anstelle von persistenten Datenstrukturen können Sie auch veränderbare Datenstrukturen (wie die Data.HashTable) in Kombination mit der ST-Monade ausprobieren:

import qualified Data.HashTable.ST.Linear as MHM

withMemoMutMap :: (Integral n, Hashable n) => n -> n
withMemoMutMap n = runST $
   do ht <- MHM.new
      recF ht n
   where
      recF ht i = do
         k <- MHM.lookup ht i
         case k of
            Just k' -> return k'
            Nothing -> do 
               k' <- fm (recF ht) i
               MHM.insert ht i k'
               return k'

Im Vergleich zur Implementierung ohne Memoisierung können Sie mit jeder dieser Implementierungen für große Eingaben Ergebnisse in Mikrosekunden erzielen, anstatt mehrere Sekunden warten zu müssen.

Anhand von Criterion als Benchmark konnte ich feststellen, dass die Implementierung mit der Data.HashMap tatsächlich etwas besser abschnitt (etwa 20%) als die mit der Data.Map und der Data.HashTable, für die die Timings sehr ähnlich waren.

Ich fand die Ergebnisse des Benchmarks etwas überraschend. Mein anfängliches Gefühl war, dass die HashTable die HashMap-Implementierung übertreffen würde, da sie veränderbar ist. In dieser letzten Implementierung ist möglicherweise ein Leistungsfehler verborgen.

QUentin
quelle
2
GHC optimiert sehr gut unveränderliche Strukturen. Die Intuition von C schwankt nicht immer.
John Tyree
3

Ein paar Jahre später habe ich mir das angeschaut und festgestellt, dass es eine einfache Möglichkeit gibt, dies in linearer Zeit mithilfe zipWitheiner Hilfsfunktion zu speichern :

dilate :: Int -> [x] -> [x]
dilate n xs = replicate n =<< xs

dilatehat die handliche Eigenschaft, dass dilate n xs !! i == xs !! div i n.

Angenommen, wir erhalten f (0), vereinfacht dies die Berechnung auf

fs = f0 : zipWith max [1..] (tail $ fs#/2 .+. fs#/3 .+. fs#/4)
  where (.+.) = zipWith (+)
        infixl 6 .+.
        (#/) = flip dilate
        infixl 7 #/

Sieht unserer ursprünglichen Problembeschreibung sehr ähnlich und gibt eine lineare Lösung an ( sum $ take n fsnimmt O (n)).

Rampion
quelle
2
Es handelt sich also um eine generative (corecursive?) oder dynamische Programmierlösung. Nehmen Sie sich O (1) Zeit für jeden generierten Wert, wie es bei Fibonacci üblich ist. Toll! Und die Lösung von EKMETT ist wie die logarithmische Big-Fibonacci, die viel schneller zu den großen Zahlen gelangt und viele Zwischenfälle überspringt. Ist das ungefähr richtig?
Will Ness
oder vielleicht ist es näher an der für die Hamming-Zahlen, mit den drei Rückzeigern in der Sequenz, die produziert wird, und den unterschiedlichen Geschwindigkeiten für jede von ihnen, die entlang dieser fortschreiten. wirklich schön.
Will Ness
2

Noch ein Nachtrag zu Edward Kmotts Antwort: ein in sich geschlossenes Beispiel:

data NatTrie v = NatTrie (NatTrie v) v (NatTrie v)

memo1 arg_to_index index_to_arg f = (\n -> index nats (arg_to_index n))
  where nats = go 0 1
        go i s = NatTrie (go (i+s) s') (f (index_to_arg i)) (go (i+s') s')
          where s' = 2*s
        index (NatTrie l v r) i
          | i <  0    = f (index_to_arg i)
          | i == 0    = v
          | otherwise = case (i-1) `divMod` 2 of
             (i',0) -> index l i'
             (i',1) -> index r i'

memoNat = memo1 id id 

Verwenden Sie es wie folgt, um eine Funktion mit einem einzelnen ganzzahligen Argument (z. B. Fibonacci) zu speichern:

fib = memoNat f
  where f 0 = 0
        f 1 = 1
        f n = fib (n-1) + fib (n-2)

Es werden nur Werte für nicht negative Argumente zwischengespeichert.

Verwenden Sie memoIntFolgendes , um auch Werte für negative Argumente zwischenzuspeichern :

memoInt = memo1 arg_to_index index_to_arg
  where arg_to_index n
         | n < 0     = -2*n
         | otherwise =  2*n + 1
        index_to_arg i = case i `divMod` 2 of
           (n,0) -> -n
           (n,1) ->  n

Verwenden Sie memoIntIntFolgendes, um Werte für Funktionen mit zwei ganzzahligen Argumenten zwischenzuspeichern :

memoIntInt f = memoInt (\n -> memoInt (f n))
Neal Young
quelle
2

Eine Lösung ohne Indizierung und nicht basierend auf Edward KMETTs.

Ich zähle gemeinsame Teilbäume zu einem gemeinsamen Elternteil aus ( f(n/4)wird zwischen f(n/2)und geteilt f(n/4)und f(n/6)wird zwischen f(2)und geteilt f(3)). Durch Speichern als einzelne Variable im übergeordneten Element wird die Berechnung des Teilbaums einmal durchgeführt.

data Tree a =
  Node {datum :: a, child2 :: Tree a, child3 :: Tree a}

f :: Int -> Int
f n = datum root
  where root = f' n Nothing Nothing


-- Pass in the arg
  -- and this node's lifted children (if any).
f' :: Integral a => a -> Maybe (Tree a) -> Maybe (Tree a)-> a
f' 0 _ _ = leaf
    where leaf = Node 0 leaf leaf
f' n m2 m3 = Node d c2 c3
  where
    d = if n < 12 then n
            else max n (d2 + d3 + d4)
    [n2,n3,n4,n6] = map (n `div`) [2,3,4,6]
    [d2,d3,d4,d6] = map datum [c2,c3,c4,c6]
    c2 = case m2 of    -- Check for a passed-in subtree before recursing.
      Just c2' -> c2'
      Nothing -> f' n2 Nothing (Just c6)
    c3 = case m3 of
      Just c3' -> c3'
      Nothing -> f' n3 (Just c6) Nothing
    c4 = child2 c2
    c6 = f' n6 Nothing Nothing

    main =
      print (f 123801)
      -- Should print 248604.

Der Code lässt sich nicht leicht auf eine allgemeine Memo-Funktion erweitern (zumindest würde ich nicht wissen, wie es geht), und Sie müssen wirklich darüber nachdenken, wie sich Teilprobleme überschneiden, sondern über die Strategie sollte für allgemeine mehrere nicht ganzzahlige Parameter funktionieren . (Ich habe es mir für zwei String-Parameter ausgedacht.)

Das Memo wird nach jeder Berechnung verworfen. (Wieder dachte ich über zwei String-Parameter nach.)

Ich weiß nicht, ob dies effizienter ist als die anderen Antworten. Jede Suche besteht technisch gesehen nur aus einem oder zwei Schritten ("Sehen Sie sich Ihr Kind oder das Kind Ihres Kindes an"), aber es kann viel zusätzlichen Speicherplatz geben.

Bearbeiten: Diese Lösung ist noch nicht korrekt. Die Freigabe ist unvollständig.

Bearbeiten: Es sollte jetzt Unterkinder richtig teilen, aber ich erkannte, dass dieses Problem viele nicht triviale Freigaben hat: n/2/2/2und n/3/3möglicherweise dasselbe ist. Das Problem passt nicht zu meiner Strategie.

leewz
quelle