Почему мой код с использованием монадических списков из пакета List настолько медленный?

На прошлой неделе пользователь Masse задал вопрос о рекурсивном перечислении файлов в каталоге в Haskell. Моя первая мысль заключалась в том, чтобы попытаться использовать монадические списки из List package, чтобы избежать создания всего списка в памяти до начала печати. Я реализовал это следующим образом:

module Main where

import Prelude hiding (filter) 
import Control.Applicative ((<$>))
import Control.Monad (join)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.ListT (ListT)
import Data.List.Class (cons, execute, filter, fromList, mapL)
import System (getArgs)
import System.Directory (getDirectoryContents, doesDirectoryExist)
import System.FilePath ((</>))

main = execute . mapL putStrLn . listFiles =<< head <$> getArgs

listFiles :: FilePath -> ListT IO FilePath
listFiles path = liftIO (doesDirectoryExist path) >>= listIfDir
  where
    valid "."  = False
    valid ".." = False
    valid _ = True
    listIfDir False = return path
    listIfDir True
      =  cons path
      $  join
      $  listFiles
     <$> (path </>)
     <$> (filter valid =<< fromList <$> liftIO (getDirectoryContents path))

Это прекрасно работает, когда он начинает печатать сразу и использует очень мало памяти. К сожалению, он также в десятки раз медленнее, чем сопоставимая версия FilePath -> IO [FilePath].

Что я делаю неправильно? Я никогда не использовал List package ListT за пределами таких игрушечных примеров, поэтому я не знаю, какую производительность ожидать, но 30 секунд (против доли секунды) для обработки каталога с помощью ~ 40 000 файлов кажется слишком медленными.

ОТВЕТЫ

Ответ 1

Профилирование показывает, что join (вместе с doesDirectoryExists) занимает большую часть времени в вашем коде. Давайте посмотрим, как разворачивается его определение:

  join x
=> (definition of join in Control.Monad)
  x >>= id
=> (definition of >>= in Control.Monad.ListT)
  foldrL' mappend mempty (fmap id x)
=> (fmap id = id)
  foldrL' mappend mempty x

Если в корневой директории поиска есть подкаталоги k, и их содержимое уже вычислено в списках: d1, d2, ... dk, то после применения join вы получите (примерно): (...(([] ++ d1) ++ d2) ... ++ dk). Поскольку x ++ y занимает время O(length x), все это займет время O(d1 + (d1 + d2) + ... + (d1 + ... dk-1)). Если предположить, что количество файлов n, и они равномерно распределены между d1 ... dk, тогда время для вычисления join будет O(n*k), и это только для первого уровня listFiles.

Это, я думаю, является основной проблемой производительности вашего решения.

Ответ 2

Мне любопытно, насколько хорошо работает одна и та же программа, написанная для использования logict? LogicT семантически то же самое, что и ListT, но реализована в стиле продолжения, так что у него не должно быть проблем с concat -связанным типом, с которым вы, похоже, работаете.

import Prelude hiding (filter)
import Control.Applicative
import Control.Monad
import Control.Monad.Logic
import System (getArgs)
import System.Directory (getDirectoryContents, doesDirectoryExist)
import System.FilePath ((</>))

main = sequence_ =<< observeAllT . fmap putStrLn . listFiles =<< head <$> getArgs

cons :: MonadPlus m => a -> m a -> m a
cons x xs = return x `mplus` xs

fromList :: MonadPlus m => [a] -> m a
fromList = foldr cons mzero

filter :: MonadPlus m => (a -> Bool) -> m a -> m a
filter f xs = do
  x <- xs
  guard $ f x
  return x

listFiles :: FilePath -> LogicT IO FilePath
listFiles path = liftIO (doesDirectoryExist path) >>= listIfDir
  where
    valid "."  = False
    valid ".." = False
    valid _ = True
    listIfDir False = return path
    listIfDir True
      =  cons path
      $  join
      $  listFiles
     <$> (path </>)
     <$> (filter valid =<< fromList <$> liftIO (getDirectoryContents path))

Ответ 3

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