Haskell'de not mu?

Haskell'de aşağıdaki fonksiyonun etkili bir şekilde nasıl çözüleceğine dair işaretler, çok sayıda (n > 108)

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

Gerekli n'ye kadar tüm fibonacci sayılarının hesaplanmasını (tembel olarak) içeren fibonacci sayılarını çözmek için Haskell'de hatırlama örnekleri gördüm. Ancak bu durumda, belirli bir n için, sadece çok az ara sonuç hesaplamamız gerekir.

Teşekkürler

Alt doğrusal zamanda indeksleyebileceğimiz bir yapı yaparak bunu çok verimli bir şekilde yapabiliriz.

Ama önce,

{-# LANGUAGE BangPatterns #-}

import Data.Function (fix)

Tanımlayalım f, ancak kendisini doğrudan çağırmak yerine 'açık özyineleme' kullanmasını sağlayın.

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)

Bir unmemoized alabilirsiniz fkullanarakfix f

Bu, çağırarak fküçük değerleri için ne demek istediğinizi test etmenizi sağlar f, örneğin:fix f 123 = 144

Bunu şu şekilde tanımlayabiliriz:

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

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

Bu başarılı bir şekilde iyi performans gösterir ve O (n ^ 3) zamanını alacak olanı ara sonuçları hatırlayan bir şeyle değiştirir.

Ancak, not edilen cevabı bulmak için sadece endekslemek doğrusal zaman alır mf. Bu şu şekilde sonuçlandığı anlamına gelir:

*Main Data.List> faster_f 123801
248604

tolere edilebilir, ancak sonuç bundan daha iyi ölçeklenmez. Daha iyisini yapabiliriz!

İlk olarak, sonsuz bir ağaç tanımlayalım:

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)

Biz indeksi bir düğüm bulabilmesi Sonra, onun içine endeksi için bir yol tanımlarsınız niçinde O (log n) zaman yerine:

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

... ve uygun olması için doğal sayılarla dolu bir ağaç bulabiliriz, bu yüzden bu endekslerle uğraşmak zorunda değiliz:

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

Dizine ekleyebildiğimiz için, bir ağacı listeye dönüştürebilirsiniz:

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

Bunu şimdiye kadar doğrulayarak çalışmalarını kontrol edebilirsiniz toList natsverir[0..]

Şimdi,

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

fastest_f :: Int -> Int
fastest_f = index f_tree

yukarıdaki listede olduğu gibi çalışır, ancak her düğümü bulmak için doğrusal zaman almak yerine, logaritmik zamanda kovalayabilir.

Sonuç oldukça hızlı:

*Main> fastest_f 12380192300
67652175206

*Main> fastest_f 12793129379123
120695231674999

Aslında o kadar çok daha hızlı geçmesi ve değiştirme olmasıdır Intile Integeryukarıda ve neredeyse anında gülünç büyük cevap almak

*Main> fastest_f' 1230891823091823018203123
93721573993600178112200489

*Main> fastest_f' 12308918230918230182031231231293810923
11097012733777002208302545289166620866358

Edward'ın cevabı o kadar harika bir mücevher ki, onu kopyaladım ve bir işlevi açık-özyinelemeli formda hatırlatan birleştiriciler memoListve memoTreebirleştiriciler sağladım.

{-# 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

En etkili yol değil, ama şunu hatırlıyor:

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

talep edildiğinde f !! 144, f !! 143mevcut olup olmadığı kontrol edilir , ancak kesin değeri hesaplanmaz. Hala hesaplamanın bilinmeyen bir sonucu olarak belirlendi. Hesaplanan kesin değerler sadece gerekli olanlardır.

Yani başlangıçta, ne kadar hesaplandığı kadarıyla, program hiçbir şey bilmiyor.

f = .... 

İsteği f !! 12yaptığımızda, bazı desen eşleşmeleri yapmaya başlar:

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 : ...

Şimdi hesaplamaya başlar

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

Bu, yinelemeli olarak f'ye başka bir talepte bulunur, bu nedenle

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

Şimdi biraz geri damlatabiliriz

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

Yani program artık biliyor:

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 : ...

Damlatmaya devam ediyor:

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

Yani program artık biliyor:

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

Şimdi şu hesaplamaya devam ediyoruz 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

Yani program artık biliyor:

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

Şimdi şu hesaplamaya devam ediyoruz 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

Yani program artık biliyor:

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

Böylece hesaplama oldukça tembel olarak yapılır. Program, bir değer f !! 8olduğunu, bunun eşit olduğunu biliyor g 8, ancak ne g 8olduğu hakkında hiçbir fikri yok .

Bu Edward Kmett'in mükemmel cevabının bir ekidir.

Kodunu denediğimde, tanımları oldukça gizemli görünüyordu natsve indexbu yüzden daha kolay anladığım alternatif bir versiyon yazıyorum.

Tanımlamam indexve natsaçısından index've nats'.

index' t naralık içinde tanımlanır [1..]. ( index tAralık üzerinde tanımlanan hatırlayın [0..].) Bu n, bir bit dizisi olarak davranarak ve bitleri tersine okuyarak ağacı arar . Eğer bit ise 1, sağ kolu alır. Bit ise 0, sol dalı alır. Son bite ulaştığında durur (a olmalıdır 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'

Tıpkı natsiçin tanımlanan indexşekilde index nats n == ndaima doğrudur nats'için tanımlanır 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

Şimdi, natsve indexbasit nats've index'ancak değerler 1 ile değiştirildi:

index t n = index' t (n+1)
nats = fmap (\n -> n-1) nats'

Edward Kmett'in cevabında belirtildiği gibi, işleri hızlandırmak için maliyetli hesaplamaları önbelleğe almanız ve bunlara hızlı bir şekilde erişebilmeniz gerekir.

İşlevi monadik tutmak için, endekslemek için uygun bir yolla (önceki yazılarda gösterildiği gibi) sonsuz bir tembel ağaç oluşturma çözümü bu hedefi yerine getirir. Fonksiyonun monadik olmayan yapısından vazgeçerseniz, Haskell'de bulunan standart ilişkilendirilebilir kapları “devlet benzeri” monadlarla (Eyalet veya ST gibi) birlikte kullanabilirsiniz.

Ana dezavantajı, monadik olmayan bir fonksiyona sahip olmanız olsa da, artık yapıyı kendiniz endekslemenize gerek yoktur ve sadece ilişkilendirilebilir kapların standart uygulamalarını kullanabilirsiniz.

Bunu yapmak için, önce herhangi bir monad türünü kabul etmek için işlevinizi yeniden yazmanız gerekir:

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)

Testleriniz için, Data.Function.fix'i kullanarak herhangi bir not oluşturmayan bir işlev tanımlayabilirsiniz, ancak biraz daha ayrıntılı olsa da:

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

Daha sonra işleri hızlandırmak için State monad'ı Data.Map ile birlikte kullanabilirsiniz:

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'

Küçük değişikliklerle kodu Data.HashMap ile çalışacak şekilde uyarlayabilirsiniz:

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'

Kalıcı veri yapıları yerine, ST monad ile birlikte değiştirilebilir veri yapılarını da (Data.HashTable gibi) deneyebilirsiniz:

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'

Herhangi bir not olmadan uygulamaya kıyasla, bu uygulamalardan herhangi biri, büyük girdiler için, birkaç saniye beklemek yerine mikro saniye içinde sonuç elde etmenizi sağlar.

Ölçüt olarak ölçüt olarak kullanarak, Data.HashMap ile uygulamanın, zamanlamaları çok benzer olan Data.Map ve Data.HashTable'dan biraz daha iyi performans gösterdiğini (yaklaşık% 20) gözlemledim.

Benchmark'ın sonuçlarını biraz şaşırtıcı buldum. Benim ilk hissim, HashTable'ın değiştirilebilir olduğu için HashMap uygulamasından daha iyi performans göstereceğiydi. Bu son uygulamada gizli bazı performans hataları olabilir.

Birkaç yıl sonra, buna baktım ve bunu kullanarak doğrusal zamanda zipWithve yardımcı bir fonksiyonda hatırlamanın basit bir yolu olduğunu fark ettim :

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

dilatekullanışlı özelliği vardır dilate n xs !! i == xs !! div i n.

Yani, f (0) verildiğimizi varsayarsak, bu hesaplamayı basitleştirir

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

Orijinal problem açıklamamıza çok benziyor ve doğrusal bir çözüm veriyor ( sum $ take n fsO (n) alacak).

Edward Kmett'in cevabına bir başka ek: bağımsız bir örnek:

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 

Tek bir tamsayı arg (örneğin fibonacci) ile bir işlevi not etmek için aşağıdaki gibi kullanın:

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

Yalnızca negatif olmayan bağımsız değişkenlerin değerleri önbelleğe alınır.

Negatif bağımsız değişkenlerin değerlerini de önbelleğe almak için memoInt, aşağıdaki gibi tanımlanan kullanın :

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

İki tamsayı bağımsız değişkeni olan işlevlerin değerlerini önbelleğe almak için şunu kullanın memoIntInt:

memoIntInt f = memoInt (\n -> memoInt (f n))

Endekslemeyen ve Edward KMETT'lere dayalı olmayan bir çözüm.

Ortak bir ebeveyn için ortak alt ağaçlar dışarı ben faktörü ( f(n/4)arasında paylaşılır f(n/2)ve f(n/4)ve f(n/6)arasında paylaşılır f(2)ve f(3)). Bunları üst öğeye tek bir değişken olarak kaydederek, alt ağacın hesaplanması bir kez yapılır.

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.

Kod kolayca genel bir not işlevine uzanmaz (en azından nasıl yapılacağını bilemezdim) ve gerçekten alt problemlerin nasıl çakıştığını düşünmeniz gerekir , ancak strateji genel çoklu tamsayı olmayan parametreler için çalışmalıdır . (İki dize parametresi için düşündüm.)

Not, her hesaplamadan sonra atılır. (Yine, iki dize parametresini düşünüyordum.)

Bunun diğer cevaplardan daha verimli olup olmadığını bilmiyorum. Her arama teknik olarak yalnızca bir veya iki adımdır ("Çocuğunuza veya çocuğunuzun çocuğuna bakın"), ancak çok fazla bellek kullanımı olabilir.

Düzenleme: Bu çözüm henüz doğru değil. Paylaşım tamamlanmadı.

Düzenleme: Şimdi düzgün bir şekilde alt çocukları paylaşıyor olmalı, ancak bu sorunun önemsiz paylaşım çok şey olduğunu fark etti: n/2/2/2ve n/3/3aynı olabilir. Sorun benim stratejime uygun değil.