8

ディレクトリ ツリーをたどってみます。単純な深さ優先トラバーサルでは、遅延した方法でデータが生成されないようで、メモリが不足します。次に、同じ問題を示す幅優先アプローチを試しました。使用可能なすべてのメモリを使用してからクラッシュします。

私が持っているコードは次のとおりです。

getFilePathBreadtFirst :: FilePath -> IO [FilePath]
getFilePathBreadtFirst fp = do
  fileinfo <- getInfo fp 
  res :: [FilePath]  <- if isReadableDirectory fileinfo
          then do
                children  <- getChildren fp 
                lower    <-  mapM getFilePathBreadtFirst children  
                return (children ++  concat lower)
           else return [fp]        -- should only return the files? 
  return res 

getChildren :: FilePath -> IO [FilePath]
getChildren path = do 
          names <- getUsefulContents path
          let namesfull = map (path </>) names
          return namesfull

testBF fn = do  -- crashes for /home/frank, does not go to swap 
  fps <- getFilePathBreadtFirst fn
  putStrLn $ unlines fps

すべてのコードは線形または末尾再帰のいずれかであると思います。ファイル名のリストがすぐに開始されることを期待しますが、実際にはそうではありません。私のコードと私の考えのどこにエラーがありますか? 遅延評価はどこで失われましたか?

4

2 に答える 2

7

私はあなたの質問を解決するために3つの別々のトリックを使用します。

  • 秘訣1：pipesライブラリを使用して、ツリーのトラバースと同時にファイル名をストリーミングします。
  • 秘訣2：StateT (Seq FilePath)トランスフォーマーを使用して幅優先探索を実行します。
  • 秘訣3：MaybeTループを書き込んで終了するときに手動で再帰しないように、トランスフォーマーを使用します。

次のコードは、これら3つのトリックを1つのモナド変換子スタックに組み合わせたものです。

import Control.Monad
import Control.Monad.Trans
import Control.Monad.Trans.Maybe
import Control.Monad.State.Lazy
import Control.Pipe
import Data.Sequence
import System.FilePath.Posix
import System.Directory

loop :: (Monad m) => MaybeT m a -> m ()
loop = liftM (maybe () id) . runMaybeT . forever

quit :: (Monad m) => MaybeT m a
quit = mzero

getUsefulContents :: FilePath -> IO [FilePath]
getUsefulContents path
  = fmap (filter (`notElem` [".", ".."])) $ getDirectoryContents path

permissible :: FilePath -> IO Bool
permissible file
  = fmap (\p -> readable p && searchable p) $ getPermissions file

traverseTree :: FilePath -> Producer FilePath IO ()
traverseTree path = (`evalStateT` empty) $ loop $ do
    -- All code past this point uses the following monad transformer stack:
    -- MaybeT (StateT (Seq FilePath) (Producer FilePath IO)) ()
    let liftState = lift
        liftPipe  = lift . lift
        liftIO    = lift . lift . lift
    liftState $ modify (|> path)
    forever $ do
        x <- liftState $ gets viewl
        case x of
            EmptyL    -> quit
            file :< s -> do
                liftState $ put s
                liftPipe $ yield file
                p <- liftIO $ doesDirectoryExist file
                when p $ do
                    names <- liftIO $ getUsefulContents file
                    -- allowedNames <- filterM permissible names
                    let namesfull = map (path </>) names
                    liftState $ forM_ namesfull $ \name -> modify (|> name)

これにより、ツリートラバーサルと同時に使用できる幅優先ファイル名のジェネレーターが作成されます。次を使用して値を消費します。

printer :: (Show a) => Consumer a IO r
printer = forever $ do
    a <- await
    lift $ print a

>>> runPipe $ printer <+< traverseTree path
<Prints file names as it traverses the tree>

すべての値を要求しないことを選択することもできます。

-- Demand only 'n' elements
take' :: (Monad m) => Int -> Pipe a a m ()
take' n = replicateM_ n $ do
    a <- await
    yield a

>> runPipe $ printer <+< take' 3 <+< traverseTree path
<Prints only three files>

さらに重要なことに、この最後の例では、3つのファイルを生成するために必要なだけツリーをトラバースし、その後停止します。これにより、必要な結果が3つだけの場合に、ツリー全体を無駄にトラバースすることを防ぎます。

pipesライブラリのトリックの詳細については、のパイプチュートリアルを参照してくださいControl.Pipes.Tutorial。

ループトリックの詳細については、このブログ投稿をお読みください。

幅優先探索のキュートリックの適切なリンクは見つかりませんでしたが、どこかにあることはわかっています。他の誰かがこれに適したリンクを知っている場合は、私の答えを編集して追加してください。

于 2012-09-26T22:16:40.327 に答える
0

パイプの管理とツリー トラバーサルを分離しました。ここで最初にパイプのコード (本質的にはゴンザレスのコード - ありがとう!):

traverseTree :: FilePath -> Producer FilePath IO ()
-- ^ traverse a tree in breadth first fashion using an external doBF function 
traverseTree path = (`evalStateT` empty) $ loop $ do
-- All code past this point uses the following monad transformer stack:
-- MaybeT (StateT (Seq FilePath) (Producer FilePath IO)) ()
let liftState = lift
    liftPipe  = lift . lift
    liftIO    = lift . lift . lift
liftState $ modify (|> path)
forever $ do
    x <- liftState $ gets viewl
    case x of
        EmptyL    -> quit
        file :< s -> do
            (yieldval, nextInputs) <- liftIO $ doBF file 
            liftState $ put s
            liftPipe $ yield yieldval
            liftState $ forM_ nextInputs $ \name -> modify (|> name)

次は、ツリー トラバーサルのコードです。

doBF :: FilePath -> IO (FilePath, [FilePath])
doBF file = do 
    finfo <- getInfo file
    let p =  isReadableDirectoryNotLink finfo
    namesRes <- if p then do
        names :: [String] <- liftIO $ getUsefulContents file
        let namesSorted = sort names
        let namesfull = map (file </>) namesSorted
        return namesfull
        else return []          
    return (file, namesRes)

doBF を同様の関数に置き換えて、最初に深度をトラバースすることを望んでいます。FilePath ~ String だけでなく、traverseTree をより一般的にすることができると仮定しましたが、シーケンスの空の関数がどのクラスにあるのかわかりません。一般的に役立つ可能性があります。

于 2012-09-28T13:26:19.483 に答える