디렉토리 트리의 너비 우선 탐색이 게으르지 않습니다.

Question

디렉토리 트리를 탐색하려고합니다. 순진한 깊이 우선 탐색은 게으른 방식으로 데이터를 생성하지 않고 메모리가 부족한 것처럼 보입니다. 다음으로 동일한 문제를 보여주는 폭 넓은 첫 번째 방법을 시도했습니다. 사용 가능한 모든 메모리를 사용하고 충돌합니다.

내가 가지고있는 코드는 다음과 같습니다

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 

나는 모든 코드는 하나의 선형 또는 꼬리 재귀 생각, 나는 파일 이름의 목록이 즉시 시작 것을 기대하지만, 사실은 그렇지 않습니다. 내 코드와 생각에 오류가 어디 있습니까? 나는 게으른 평가를 어디에서 잃어 버렸는가?

Answer 1

3 가지 별도의 트릭을 사용하여 질문을 해결하겠습니다.

• 트릭 1는 : 트리를 통과 동시 파일 이름을 스트리밍 할 pipes 라이브러리를 사용합니다.
• 트릭 2 : 가로 너비 우선 탐색을 수행하려면 StateT (Seq FilePath) 변환기를 사용하십시오.
• 트릭 3 : 루프를 작성하고 종료 할 때 수동 재귀를 피하려면 MaybeT 변환기를 사용하십시오.

다음 코드는 이러한 세 가지 트릭을 하나의 모나드 변환기 스택에 결합합니다.

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 개의 결과 일 때 불필요하게 전체 트리를 가로 지르는 것을 방지 할 수 있습니다!

pipes 라이브러리 트릭에 대해 자세히 알아 보려면 pipes tutorial (Control.Pipes.Tutorial)을 참조하십시오.

루프 트릭에 대해 자세히 알아 보려면 blog post을 읽어보십시오.

너비가 첫 번째 탐색을위한 대기열 트릭에 대한 좋은 링크를 찾을 수 없지만 어딘가에 있다는 것을 알고 있습니다. 다른 사람이이 링크를 잘 알고 있다면 내 대답을 편집하여 추가하십시오.

Answer 2

나는 파이프와 나무 순회의 managemetn을 분리했다. 파이프 (! 곤잘레스의 본질적 코드 - 감사합니다) 여기를 먼저 코드 :

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를 대체 할 수 있도록 노력하겠습니다 먼저 깊이를 횡단합니다.나는 TraverseTree를 FilePath ~ String뿐만 아니라 더 일반적인 것으로 만들 수 있다고 가정했지만 시퀀스의 빈 함수가 어떤 클래스에 있는지를 보지 못했습니다. 일반적으로 유용 할 수 있습니다.