Почему мой код использует монадические списки из пакета List так медленно? - PullRequest
13 голосов
/ 12 октября 2010

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

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

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

Ответы [ 3 ]

3 голосов
/ 12 октября 2010

Профилирование показывает, что 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 и их содержимое уже вычислено в списках: d<sub>1</sub>, d<sub>2</sub>, ... d<sub>k</sub>, то после применения join вы получите (примерно): (...(([] ++ d<sub>1</sub>) ++ d<sub>2</sub>) ... ++ d<sub>k</sub>). Поскольку x ++ y занимает время O(length x), все это займет время O(d<sub>1</sub> + (d<sub>1</sub> + d<sub>2</sub>) + ... + (d<sub>1</sub> + ... d<sub>k</sub>-1)). Если предположить, что число файлов n и они равномерно распределены между d<sub>1</sub> ... d<sub>k</sub>, тогда время для вычисления join будет O(n*k), и это только для первого уровня listFiles.

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

2 голосов
/ 14 октября 2010

Мне любопытно, насколько хорошо работает та же программа, написанная для использования 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))
1 голос
/ 12 октября 2010

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

...