Памятка в Хаскеле?

Question

Любые указатели на то, как эффективно решить следующую функцию в Haskell, для больших чисел (n > 108)

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

Я видел примеры запоминания в Haskell для решения чисел Фибоначчи, которые включают вычисления) все числа Фибоначчи с точностью до требуемого n.Но в этом случае для данного n нам нужно только вычислить очень мало промежуточных результатов.

Спасибо

Answer 1

Мы можем сделать это очень эффективно, создав структуру, которую мы можем индексировать за сублинейное время.

Но сначала

{-# LANGUAGE BangPatterns #-}

import Data.Function (fix)

Давайте определим f, но сделаем так, чтобы он использовал «открытую рекурсию», а не вызывал сам себя.

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)

Вы можете получить нематериальный f, используя fix f

Это позволит вам проверить, что f делает то, что вы имеете в виду для малых значений f, вызывая, например: fix f 123 = 144

Мы могли бы запомнить это, определив:

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

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

Это работает сносно хорошо и заменяет то, что должно было занять O (n ^ 3) время чем-то, что запоминает промежуточные результаты.

Но для индексации запомненного ответа для mf все еще требуется линейное время, чтобы проиндексировать. Это означает, что результаты как:

*Main Data.List> faster_f 123801
248604

допустимы, но результат не намного лучше. Мы можем сделать лучше!

Сначала давайте определим бесконечное дерево:

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)

И затем мы определим способ индексации в нем, чтобы мы могли найти узел с индексом n в O (log n) времени вместо:

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

... и мы можем найти удобное дерево, полное натуральных чисел, поэтому нам не нужно возиться с этими индексами:

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

Поскольку мы можем индексировать, вы можете просто преобразовать дерево в список:

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

Пока что вы можете проверить работу, убедившись, что toList nats дает вам [0..]

Сейчас

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

fastest_f :: Int -> Int
fastest_f = index f_tree

работает так же, как и в приведенном выше списке, но вместо того, чтобы искать каждый узел за линейное время, он может отследить его в логарифмическом времени.

Результат значительно быстрее:

*Main> fastest_f 12380192300
67652175206

*Main> fastest_f 12793129379123
120695231674999

На самом деле это намного быстрее, чем вы можете пройти и заменить Int на Integer выше и получать смехотворно большие ответы почти мгновенно

*Main> fastest_f' 1230891823091823018203123
93721573993600178112200489

*Main> fastest_f' 12308918230918230182031231231293810923
11097012733777002208302545289166620866358

Answer 2

Ответ Эдварда такой замечательный камень, что я продублировал его и представил реализации комбинаторов memoList и memoTree, которые запоминают функцию в открытой рекурсивной форме.

Answer 3

Не самый эффективный способ, но он запоминает:

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

при запросе f !! 144 проверяется, существует ли f !! 143, но его точное значение не рассчитывается.Это все еще установлено как некоторый неизвестный результат вычисления.Единственные точные рассчитанные значения - это те, которые необходимы.

Итак, изначально, насколько было рассчитано, программа ничего не знает.

f = .... 

Когда мы делаем запрос f !! 12, он начинает выполнять какое-то сопоставление с образцом:

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

Теперь он начинает вычислять

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

Это рекурсивно предъявляет другое требование к f, поэтому мы вычисляем

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

Теперь мы можем набрать немного

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

Что означает, что программа теперь знает:

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

Продолжаем набирать:

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

Что означает программутеперь знает:

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

Теперь мы продолжим наш расчет 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

Что означает, что программа теперь знает:

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

Теперь мыпродолжаем наш расчет 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

Это означает, что программа теперь знает:

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

Таким образом, вычисление выполняется довольно лениво.Программа знает, что существует какое-то значение для f !! 8, оно равно g 8, но она не знает, что такое g 8.

Answer 4

Как указано в ответе Эдварда Кметта, чтобы ускорить процесс, вам необходимо кэшировать дорогостоящие вычисления и иметь возможность быстрого доступа к ним.

Чтобы сохранить функцию не монадической, решение построения бесконечного ленивого деревас соответствующим способом индексации (как показано в предыдущих сообщениях) выполняет эту задачу.Если вы отказываетесь от немонадной природы функции, вы можете использовать стандартные ассоциативные контейнеры, доступные в Haskell, в сочетании с «подобными состоянию» монадами (такими как State или ST).

Хотя основным недостатком являетсячто вы получаете немонадную функцию, вам больше не нужно индексировать структуру самостоятельно, и вы можете просто использовать стандартные реализации ассоциативных контейнеров.

Для этого вам сначала нужно переписать свою функцию впринять любой вид монады:

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)

Для ваших тестов вы все равно можете определить функцию, которая не запоминает, используя Data.Function.fix, хотя она немного более многословна:

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

Затем вы можете использовать монаду State в сочетании с Data.Map для ускорения:

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'

С небольшими изменениями вы можете вместо этого адаптировать код для работы с Data.HashMap:

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'

Вместо постоянных структур данных вы также можете использовать изменяемые структуры данных (например, Data.HashTable) в сочетании с монадой ST:

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'

По сравнению с реализацией без какого-либо напоминания, любая из этих реализаций позволяет при больших входах получать результаты в микросекундах вместо того, чтобы ждать несколько секунд.

Используя Criterion в качестве эталона, я мог быОбратите внимание, что реализация с Data.HashMap на самом деле работала немного лучше (около 20%), чем Data.Map и Data.HashTable, для которых время было очень похожим.

Я нашел результаты теста aнемного удивительноСначала я чувствовал, что HashTable превзойдет реализацию HashMap, потому что она изменчива.В этой последней реализации может быть скрыт некоторый дефект производительности.

Answer 5

Это дополнение к прекрасному ответу Эдварда Кметта.

Когда я попробовал его код, определения nats и index казались довольно загадочными, поэтому я пишу альтернативную версию, которая мне показалась более легкой дляпонимаю.

Я определяю index и nats в терминах index' и nats'.

index' t n определяется в диапазоне [1..].(Напомним, что index t определен в диапазоне [0..].) Он выполняет поиск в дереве, обрабатывая n как строку битов и считывая биты в обратном порядке.Если бит 1, он принимает правую ветвь.Если бит 0, он принимает левую ветвь.Он останавливается, когда достигает последнего бита (который должен быть 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'

Так же, как nats определено для index, так что index nats n == n всегда истинно, nats'определено для 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

Теперь nats и index просто nats' и index', но со значениями, сдвинутыми на 1:

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

Answer 6

Пару лет спустя я посмотрел на это и понял, что есть простой способ запомнить это в линейное время, используя zipWith и вспомогательную функцию:

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

dilate имеет удобное свойство, котороеdilate n xs !! i == xs !! div i n.

Итак, предположим, что нам дано f (0), это упрощает вычисление до

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

Очень похоже на наше первоначальное описание проблемы и дает линейное решение(sum $ take n fs займет O (n)).

Answer 7

Решение без индексации и не основанное на Эдварде КМЕТТ.

Я выделяю общие поддеревья для общего родителя (f(n/4) делится между f(n/2) и f(n/4), а f(n/6) - этоделится между f(2) и f(3)).Сохраняя их как единственную переменную в родительском элементе, вычисление поддерева выполняется один раз.

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.

Код не может легко распространяться на общую функцию запоминания (по крайней мере, я бы не знал,как это сделать), и вам действительно нужно продумать, как подзадачи перекрываются, но стратегия должна работать для общих множественных нецелых параметров.(Я придумал это для двух строковых параметров.)

Памятка сбрасывается после каждого расчета.(Опять же, я думал о двух строковых параметрах.)

Я не знаю, эффективнее ли это, чем другие ответы.Технически каждый поиск состоит из одного или двух шагов («Посмотрите на вашего ребенка или ребенка вашего ребенка»), но может потребоваться много дополнительной памяти.

Редактировать: это решение не является правильнымеще.Совместное использование не завершено.

Редактировать: Теперь должно быть правильное совместное использование дочерних элементов, но я понял, что эта проблема имеет много нетривиального совместного использования: n/2/2/2 и n/3/3 могут быть одинаковыми.Проблема не подходит для моей стратегии.

Answer 8

Еще одно дополнение к ответу Эдварда Кметта: отдельный пример:

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 

Используйте его следующим образом, чтобы запомнить функцию с одним целочисленным аргументом (например, Фибоначчи):

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

Кешируются только значения для неотрицательных аргументов.

Чтобы также кэшировать значения для отрицательных аргументов, используйте memoInt, определяемый следующим образом:

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

Для кэширования значений для функций с двумя целочисленными аргументами используйте memoIntInt, определяемые следующим образом:

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