Perché il mio codice utilizzando liste monadici dal pacchetto List così lento?

Question

La settimana scorsa utente Masse ha fatto una domanda su ricorsivamente l'elenco dei file in una directory in Haskell. Il mio primo pensiero è stato quello di provare a utilizzare gli elenchi monadici dal List pacchetto per evitare di costruire l'intero elenco in la memoria prima della stampa può iniziare. Ho implementato in questo modo:

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

Questo funziona in modo bello nel senso che inizia a stampare immediatamente e usi molto poca memoria. Purtroppo è anche decine di volte più lento di una versione FilePath -> IO [FilePath] paragonabile.

Che cosa sto facendo di sbagliato? Non ho mai usato List al di fuori del pacchetto di ListT di esempi giocattolo come questo, quindi non so che tipo di prestazioni aspettarsi, ma 30 secondi (contro una frazione di secondo) per elaborare una directory con ~ 40.000 file sembra troppo lento.

Answer 1

spettacoli Profiling che join (insieme con doesDirectoryExists) rappresenta per la maggior parte del tempo nel codice. Vediamo come si svolge la sua definizione:

  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

Se nella directory principale della ricerca ci sono sottodirectory k e il loro contenuto sono già calcolate nelle liste: d1, d2, ... dk, poi dopo l'applicazione join si otterrà (approssimativamente): (...(([] ++ d1) ++ d2) ... ++ dk). Dal momento che richiede tempo x ++ y O(length x) il tutto ci vorrà tempo O(d1 + (d1 + d2) + ... + (d1 + ... dk-1)). Se assumiamo che il numero di file è n e non è distribuito tra d1 ... dk poi il momento di join calcolo sarebbe O(n*k) e che è solo per il primo livello di listFiles.

Questa, credo, è il problema principale delle prestazioni con la soluzione.

Answer 2

Sono curioso, quanto bene fa lo stesso programma scritto per usare lavoro logict per voi? LogicT è semanticamente uguale a ListT, ma implementato in stile continuazione-passing in modo che non dovrebbe avere il tipo concat-correlata di problemi ti sembra di essere in esecuzione in.

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

Answer 3

L'esecuzione su una directory di grandi dimensioni rivela una perdita di memoria. Ho il sospetto questo ha a che fare con il rigore di getDirectoryContents, ma ci potrebbe essere più in corso. Semplice profiling non si presentò molto, mi piacerebbe aggiungere alcuni centri di costo in più e passare da lì ...