Haskell избежать переполнения стека в складках без ущерба для производительности

Question

Следующий фрагмент кода испытывает переполнение стека для больших входов:

{-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-} 
import qualified Data.ByteString.Lazy.Char8 as L 


genTweets :: L.ByteString -> L.ByteString 
genTweets text | L.null text = "" 
       | otherwise = L.intercalate "\n\n" $ genTweets' $ L.words text 
    where genTweets' txt = foldr p [] txt 
      where p word [] = [word] 
       p word words@(w:ws) | L.length word + L.length w <= 139 = 
             (word `L.append` " " `L.append` w):ws 
            | otherwise = word:words 

Я предполагаю, что мой предикат строит список санков, но я не знаю, почему , или как его исправить.

Эквивалентный код с использованием foldl' работает нормально, но берет навсегда, поскольку он постоянно добавляется и использует тонну памяти.

import Data.List (foldl') 

genTweetsStrict :: L.ByteString -> L.ByteString 
genTweetsStrict text | L.null text = "" 
        | otherwise = L.intercalate "\n\n" $ genTweetsStrict' $ L.words text 
    where genTweetsStrict' txt = foldl' p [] txt 
      where p [] word = [word] 
       p words word | L.length word + L.length (last words) <= 139 = 
           init words ++ [last words `L.append` " " `L.append` word] 
          | otherwise = words ++ [word] 

Что вызывает первый сниппет, чтобы создать грозди, и его можно избежать? Можно ли написать второй фрагмент, чтобы он не полагался на (++)?

Answer 1

L.length word + L.length (last words) <= 139 

Это проблема. На каждой итерации вы перемещаете список аккумуляторов, а затем

init words ++ [last words `L.append` " " `L.append` word] 

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

Следующая версия вашей программы обрабатывает относительно большой файл (/usr/share/dict/words) в рамках 1 во второй раз, в то время как с использованием O (1) пространство:

{-# LANGUAGE OverloadedStrings, BangPatterns #-} 

module Main where 

import qualified Data.ByteString.Lazy.Char8 as L 
import Data.Int (Int64) 

genTweets :: L.ByteString -> L.ByteString 
genTweets text | L.null text = "" 
       | otherwise = L.intercalate "\n\n" $ toTweets $ L.words text 
    where 

    -- Concatenate words into 139-character tweets. 
    toTweets :: [L.ByteString] -> [L.ByteString] 
    toTweets []  = [] 
    toTweets [w] = [w] 
    toTweets (w:ws) = go (L.length w, w) ws 

    -- Main loop. Notice how the output tweet (cur_str) is generated as soon as 
    -- possible, thus enabling L.writeFile to consume it before the whole 
    -- input is processed. 
    go :: (Int64, L.ByteString) -> [L.ByteString] -> [L.ByteString] 
    go (_cur_len, !cur_str) []  = [cur_str] 
    go (!cur_len, !cur_str) (w:ws) 
     | lw + cur_len <= 139  = go (cur_len + lw + 1, 
             cur_str `L.append` " " `L.append` w) ws 
     | otherwise     = cur_str : go (lw, w) ws 
     where 
     lw = L.length w 

-- Notice the use of lazy I/O. 
main :: IO() 
main = do dict <- L.readFile "/usr/share/dict/words" 
      L.writeFile "tweets" (genTweets dict) 

Answer 2

p word words@(w:ws)

Это сопоставление с образцом вызывает оценку «хвоста», который, конечно, результат foldr р [] (ш: WS), который является результатом PW WS, который вызывает WS чтобы снова совпадало с рисунком и т. д.

Обратите внимание, что foldr и foldl 'разнят текст по-разному. foldr будет иметь самый короткий твит, который появится первым, foldl 'сделает самый короткий твит последним.

---

Я бы об этом так:

genTweets' = unfoldr f where 
    f [] = Nothing 
    f (w:ws) = Just $ g w ws $ L.length w 
    g w [] _ = (w, []) 
    g w ws@(w':_) len | len+1+(L.length w') > 139 = (w,ws) 
    g w (w':ws') len = g (w `L.append` " " `L.append` w') ws' $ len+1+(L.length w')