Dlaczego mój kod używa list monadycznych z pakietu List tak wolno?

Question

W zeszłym tygodniu użytkownik Masse zapytał o numer question about recursively listing files w katalogu w Haskell. Moją pierwszą myślą było spróbuj użyć monadycznych list od List package, aby uniknąć budowania całej listy w pamięci przed rozpoczęciem drukowania. Zaimplementowałem to w następujący sposób:

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)) 

Działa to pięknie, ponieważ natychmiast rozpoczyna drukowanie i zużywa bardzo mało pamięci. Niestety jest również kilkadziesiąt razy wolniejsza niż porównywalna wersja FilePath -> IO [FilePath].

Co robię źle? Nigdy nie używałem pakietu List poza tymi przykładami zabawek, więc nie wiem, jakiego rodzaju wydajności można się spodziewać, ale wydaje mi się, że 30 sekund (w ułamku sekundy) do przetworzenia katalogu z ~ 40 000 plików o wiele za wolno.

Answer 1

Profilowanie pokazuje, że join (wraz z doesDirectoryExists) stanowią większość czasu w kodzie. Pozwala zobaczyć, jak rozwija się jego definicja:

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 

Jeśli w katalogu głównym poszukiwaniu istnieją k podkatalogi i ich zawartość są już obliczone na listach: d1, d2, ... dk, następnie po zastosowaniu join dostaniesz (w przybliżeniu): (...(([] ++ d1) ++ d2) ... ++ dk). Od x ++ y wymaga czasu O(length x) całość zajmie trochę czasu O(d1 + (d1 + d2) + ... + (d1 + ... dk-1)). Jeśli przyjmiemy, że liczba plików to n i są one równomiernie rozłożone między d1 ... dk, wówczas czas na obliczenie join będzie wynosił O(n*k) i będzie to tylko pierwszy poziom listFiles.

Jest to, moim zdaniem, główny problem z wydajnością rozwiązania.

Answer 2

Uruchamianie go w dużym katalogu ujawnia wyciek pamięci. Podejrzewam, że ma to związek ze ścisłością getDirectoryContents, ale może być więcej. Proste profilowanie nie pojawiło się zbyt wiele, dodałem dodatkowe centra kosztowe i od tego miejsca ...

Answer 3

Ciekawi mnie, jak dobrze działa ten sam program napisany do pracy pod numerem logict? LogicT jest semantycznie taki sam jak ListT, ale zaimplementowany w stylu przekazywania kontynuacji, tak aby nie miał problemów związanych z concat-zależnych, do których zdaje się być uruchomiony.

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))