Pourquoi mon code à l'aide des listes monades à partir du package de la liste si lent?

Question

La semaine dernière, l'utilisateur Masse a posé une question sur les fichiers liste récursive dans un répertoire Haskell. Ma première pensée était d'essayer d'utiliser des listes monades à partir du package List pour éviter de construire toute la liste en mémoire avant l'impression peut commencer. Je mis en œuvre ce comme suit:

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

Cela fonctionne très bien en ce qu'elle commence à imprimer immédiatement et utilise très peu de mémoire. Malheureusement, il est aussi des dizaines de fois plus lent qu'une version FilePath -> IO [FilePath] comparable.

Qu'est-ce que je fais mal? Je ne l'ai jamais utilisé le List de paquet ListT l'extérieur des exemples de jouets comme ça, donc je ne sais pas quel genre de performances à attendre, mais 30 secondes (par rapport à une fraction de seconde) pour traiter un répertoire avec ~ 40,000 fichiers semble beaucoup trop lent.

Answer 1

Profilage montre que join (avec doesDirectoryExists) représente la plupart du temps dans votre code. Permet de voir comment se déroule sa définition:

  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 dans le répertoire racine de la recherche, il y a des sous-répertoires k et leur contenu sont déjà calculés dans les listes: d1, d2, ... dk, puis après l'application join vous obtiendrez (environ): (...(([] ++ d1) ++ d2) ... ++ dk). Depuis x ++ y prend O(length x) temps tout cela va prendre du temps O(d1 + (d1 + d2) + ... + (d1 + ... dk-1)). Si nous supposons que le nombre de fichiers est n et ils sont répartis uniformément entre d1 ... dk alors le temps de join Compute serait O(n*k) et qui est seulement pour le premier niveau de listFiles.

, je pense, est le principal problème de performance avec votre solution.

Answer 2

Je suis curieux, comment bien écrit le même programme à utiliser logict travail pour vous? LogicT est sémantiquement la même chose que ListT, mais mis en œuvre dans le style de passage de continuation afin qu'il ne devrait pas avoir le type de problèmes liés à concat vous semblez être en cours d'exécution dans.

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'exécution sur un grand répertoire révèle une fuite de mémoire. Je soupçonne que cela a à voir avec la rigueur de getDirectoryContents, mais il pourrait y avoir plus de choses. Le profilage simple ne se est pas beaucoup, je rajouterais quelques centres de coûts supplémentaires et aller de là ...