¿Por qué mi código utilizando listas monádicos del paquete de lista es tan lenta?

Question

La semana pasada usuario Masse hizo una pregunta acerca de de forma recursiva el listado de archivos en un directorio en el Haskell. Mi primera idea fue tratar de usar listas monádicos de la List paquete para evitar la construcción de toda la lista de la memoria antes de la impresión puede comenzar. He implementado de la siguiente manera:

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

Esto funciona muy bien, ya que comienza a imprimir inmediatamente y utiliza muy poca memoria. Por desgracia, es también decenas de veces más lento que una versión FilePath -> IO [FilePath] comparables.

¿Qué estoy haciendo mal? Nunca he usado fuera List del paquete ListT de ejemplos de juguetes de este tipo, así que no sé qué tipo de rendimiento que puede esperar, pero 30 segundos (frente a una fracción de segundo) para procesar un directorio con ~ 40.000 archivos parece demasiado lento.

Answer 1

Perfiles muestra que join (junto con doesDirectoryExists) representa la mayor parte del tiempo en el código. Vamos a ver cómo se desarrolla su definición:

  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

Si en el directorio raíz de la búsqueda no son subdirectorios k y sus contenidos ya se computan en las listas: d1, d2, ... dk, a continuación, después de aplicar join que obtendrá (más o menos): (...(([] ++ d1) ++ d2) ... ++ dk). Desde x ++ y toma O(length x) tiempo de todo el asunto se llevará a O(d1 + (d1 + d2) + ... + (d1 + ... dk-1)) tiempo. Si suponemos que el número de archivos es n y se distribuyen uniformemente entre d1 ... dk entonces el tiempo de cómputo a join sería O(n*k) y que es sólo para el primer nivel de listFiles.

Esto, creo, es el principal problema de rendimiento con su solución.

Answer 2

Tengo curiosidad, ¿qué tan bien el mismo programa escrito para usar logict trabajo para usted? LogicT es semánticamente lo mismo que ListT, pero implementado en el estilo de continuación pasar por lo que no debería tener el tipo concat relacionada con los problemas que parece estar corriendo en.

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

Al ejecutarlo en un directorio grande revela una pérdida de memoria. Sospecho que esto tiene que ver con el rigor de getDirectoryContents, pero podría haber más en juego. perfilado simple no apareció mucho, me gustaría añadir algunos centros de costos adicionales e ir de allí ...