Двойной поток для предотвращения ненужной memoization?

Я новичок в Haskell и пытаюсь внедрить Euler Sieve в стиле потоковой обработки.

Когда я проверил страницу Haskell Wiki о простых числах, я обнаружил загадочную технику оптимизации для потоков. В 3.8 Линейное слияние этой вики:

primesLME = 2 : ([3,5..] 'minus' joinL [[p*p, p*p+2*p..] | p <- primes']) 
  where
    primes' = 3 : ([5,7..] 'minus' joinL [[p*p, p*p+2*p..] | p <- primes'])

joinL ((x:xs):t) = x : union xs (joinL t)

И это говорит

" Двойной простой поток введен здесь, чтобы предотвратить ненужное запоминание и, таким образом, предотвратить утечку памяти, согласно коду Мелиссы О'Нил".

Как это могло произойти? Я не могу понять, как это работает.

Ответы

Ответ 1

Обычно определение потока простых чисел в формулировке Ричарда Берда сита Эратосфена является самореферентным:

import Data.List.Ordered (minus, union, unionAll)

ps = ((2:) . minus [3..] . foldr (\p r -> p*p : union [p*p+p, p*p+2*p..] r) []) ps

Простые числа ps, созданные этим определением, используются в качестве входных данных для него. Чтобы предотвратить порочный круг, определение основано на начальном значении 2. Это соответствует математическому определению решета Эратосфена как нахождение простых в промежутках между композитами, перечисляемых для каждого простого p, подсчитывая по шагам p, P= {2} U ({3,4,...}\ U {{p 2 p 2 + p, p 2 + 2p,...} | p в P}).

Полученный поток используется как вход в его собственном определении. Это приводит к сохранению всего потока простых чисел в памяти (или в большинстве случаев в любом случае). Фиксированная точка здесь делится, corecursive:

fix f  = xs where xs = f xs                    -- a sharing fixpoint combinator
ps     = fix ((2:) . minus [3..] . foldr (...) [])
    -- = xs where xs = 2 : minus [3..] (foldr (...) [] xs)

Идея (из-за Мелиссы О'Нил) состоит в том, чтобы разделить это на два потока, причем внутренняя петля подает во второй поток простых чисел "выше":

fix2 f  = f xs where xs = f xs                 -- double-staged fixpoint combinator
ps2     = fix2 ((2:) . minus [3..] . foldr (...) [])
     -- = 2 : minus [3..] (foldr (...) [] xs) where
     --                                   xs = 2 : minus [3..] (foldr (...) [] xs)

Таким образом, когда ps2 создает несколько простых p, его внутренний поток xs "основных" простых чисел должен быть создан только до sqrt p, и любые простые числа, которые производятся с помощью ps2, могут получить сбрасывается и мусор, собранный системой сразу после этого:

    \
     \
      <- ps2 <-.
                \
                 \
                  <- xs <-.
                 /         \ 
                 \_________/ 

Ошибки, создаваемые внутренним циклом xs, не могут быть немедленно отброшены, поскольку они необходимы для потока xs. Когда xs произвело простую q, только ее часть ниже sqrt q может быть отброшена сразу после того, как она была потреблена частью вычисления foldr. Другими словами, эта последовательность поддерживает обратный указатель на себя вплоть до sqrt своего самого большого производимого значения (поскольку он потребляется его потребителем, например print).

Таким образом, с одним контуром подачи (с fix) почти вся последовательность должна быть сохранена в памяти, тогда как при двойной подаче (с fix2) необходимо сохранить только основной цикл, который только увеличивается к квадратному корню из текущего значения, создаваемого основным потоком. Таким образом, общая пространственная сложность уменьшается примерно от O (N) до примерно O (sqrt (N)) - резкое сокращение.

Для этого код должен быть скомпилирован с оптимизацией, т.е. с помощью переключателя -O2 и запускаться автономно. Вам также может потребоваться использовать переключатель -fno-cse. И в тестовом коде должна быть только одна ссылка на ps2:

main = getLine >>= (read >>> (+(-1)) >>> (`drop` ps2) >>> print . take 5)

Фактически, при тестировании в Ideone он показывает практически постоянное потребление памяти.


И это сито Эратосфена, а не сито Эйлера.

Исходные определения:

eratos (x:xs) = x : eratos (minus xs $ map (*x) [x..] )    -- ps = eratos [2..]
eulers (x:xs) = x : eulers (minus xs $ map (*x) (x:xs))    -- ps = eulers [2..]

Оба очень неэффективны из-за преждевременного обращения с кратными. Легко исправить первое определение, сплавляя map, и перечисление в одно перечисление перемещается дальше (от x до x*x, т.е. [x*x, x*x+x..]), так что его обработка может быть отложена - потому что здесь каждый простой кратный генерируется независимо (перечисляется с фиксированными интервалами):

eratos (p:ps) xs | (h,t) <- span (< p*p) xs =                 -- ps = 2 : eratos ps [2..]
                    h ++ eratos ps (minus t [p*p, p*p+p..])   -- "postponed sieve"

который является таким же, как сито птицы в верхней части этого сообщения, по сегментам:

ps = 2 : [n | (r:q:_, px) <- (zip . tails . (2:) . map (^2) <*> inits) ps,
              n           <- [r+1..q-1] `minus` foldr union [] 
                               [[s+p, s+2*p..q-1] | p <- px, let s = r`div`p*p]]

((f <*> g) x = f x (g x) используется здесь как стенография.)

Нет никакого легкого исправления для второго определения, т.е. eulers.


дополнение: вы можете увидеть ту же идею, реализованную с генераторами Python, для сравнения здесь.

Фактически, в коде Python используется телескопическая многоступенчатая рекурсивная генерация потоков эфемерных простых чисел; в Haskell мы можем договориться об этом с комбинацией несовместимых многоэтапных комбинаций исправлений _Y:

primes = 2 : _Y ((3:) . sieve 5 . unionAll . map (\p -> [p*p, p*p+2*p..]))
  where
    _Y g = g (_Y g)                                   -- == g . g . g . g . ....

    sieve k [email protected](x:xs) | k < x = k : sieve (k+2) s      -- == [k,k+2..] \\ s,
                     | True  =     sieve (k+2) xs     --    when s ⊂ [k,k+2..]