13

上周，用户 Masse 提出了一个关于在 Haskell 目录中递归列出文件的问题。我的第一个想法是尝试使用List包中的单子列表，以避免在打印开始之前在内存中构建整个列表。我实现了如下：

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

这很好用，因为它立即开始打印并且使用很少的内存。FilePath -> IO [FilePath]不幸的是，它也比同类版本慢了几十倍。

我究竟做错了什么？我从来没有在这样的玩具示例之外使用过这个List包ListT，所以我不知道会有什么样的性能，但是 30 秒（相对于几分之一秒）来处理一个包含 ~40,000 个文件的目录似乎太多了减缓。

4

3 回答 3

3

分析表明join（与 一起doesDirectoryExists）占代码中的大部分时间。让我们看看它的定义是如何展开的：

  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

如果在搜索的根目录中有k子目录，并且它们的内容已经在列表中计算：，那么在应用之后你会得到（大致）：。由于需要时间，所以整个事情都需要时间。如果我们假设文件的数量是并且它们之间是均匀分布的，那么计算的时间将会是并且仅适用于.d1, d2, ... dkjoin(...(([] ++ d1) ++ d2) ... ++ dk)x ++ yO(length x)O(d1 + (d1 + d2) + ... + (d1 + ... dk-1))nd1 ... dkjoinO(n*k)listFiles

我认为，这是您的解决方案的主要性能问题。

于 2010-10-12T17:46:37.500 回答
2

我很好奇，使用logict编写的同一个程序对您的工作效果如何？ LogicT在语义上与 相同ListT，但以连续传递样式实现，因此它不应该concat出现您似乎遇到的与 - 相关的问题。

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))
于 2010-10-14T00:36:57.267 回答
1

在大目录上运行它会发现内存泄漏。我怀疑这与 getDirectoryContents 的严格性有关，但可能还有更多事情要做。简单的分析并没有出现太多，我会添加一些额外的成本中心并从那里开始......

于 2010-10-12T16:46:05.780 回答