Warum ist mein Code mit monadischen Listen aus dem Listen Paket so langsam?

Question

Letzte Woche Benutzer Masse gebeten, eine Frage zu rekursiv Auflistung Dateien in einem Verzeichnis in Haskell. Mein erster Gedanke war aus mit monadischen Listen, um zu versuchen dem List Paket Aufbau die gesamte Liste zu vermeiden, Speicher vor dem Drucken beginnen kann. Ich implementiert diese wie folgt:

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

Das funktioniert wunderbar, dass es beginnt mit dem Drucken sofort und Speicher sehr wenig Gebrauch. es ist auch Dutzende Male leider langsamer als eine vergleichbare FilePath -> IO [FilePath] Version.

Was mache ich falsch? Ich habe noch nie das List Paket ListT außerhalb von Spielzeug Beispielen wie diese, so dass ich weiß nicht, Art der Leistung zu erwarten, aber 30 Sekunden (im Vergleich zu einem Bruchteil einer Sekunde) verwendet, was ein Verzeichnis zu verarbeiten mit ~ 40.000 Dateien scheinen viel zu langsam.

Answer 1

Profilieren zeigt, dass join (zusammen mit doesDirectoryExists) ist für die meiste Zeit in Ihrem Code. Mal sehen, wie seine Definition entfaltet:

  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

Wenn im Stammverzeichnis der Suche gibt es k Verzeichnisse und deren Inhalte sind bereits in den Listen berechnet: d1, d2, ... dk, dann nach join Anwendung Sie (grob) erhalten: (...(([] ++ d1) ++ d2) ... ++ dk). Seit x ++ y Zeit O(length x) nimmt das Ganze wird einige Zeit O(d1 + (d1 + d2) + ... + (d1 + ... dk-1)) nehmen. Wenn wir, dass die Anzahl der Dateien übernehmen ist n und sie sind gleichmäßig zwischen d1 ... dk dann die Zeit zu berechnen join verteilt wäre O(n*k) und das ist nur für die erste Ebene von listFiles.

Das, denke ich, ist das wichtigste Performance-Problem mit Ihrer Lösung.

Answer 2

Ich bin gespannt, wie gut funktioniert das gleiche Programm geschrieben logict Arbeit für Sie? LogicT ist semantisch gleich wie ListT, aber in Fortsetzung Umgehung Stil implementiert, so dass es nicht die concat bezogene Art von Problemen haben, sollten Sie scheinen in zu laufen.

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

es auf einem großen Verzeichnis Lauf zeigt ein Speicherleck. Ich vermute, dass dies mit der Strenge der getDirectoryContents zu tun hat, aber es könnte sein, mehr los. Einfache Profilierung aufdrehen nicht viel, würde ich einige zusätzliche Kostenstellen hinzufügen und geht von dort aus ...