لماذا يتم استخدام الكود الخاص بي باستخدام قوائم Monadic من حزمة القائمة بطيئة جدًا؟

Question

سأل جماعات المستخدم الأسبوع الماضي أ سؤال حول ملفات الإدراج بشكل متكرر في دليل في هاسكل. كانت فكرتي الأولى هي محاولة استخدام قوائم أحادية من 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 ملف بطيئة للغاية.

Answer 1

التنميط يدل على ذلك 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, ... dك, ثم بعد التقديم join ستحصل على (تقريبًا): (...(([] ++ d1) ++ d2) ... ++ dك). حيث x ++ y تأخذ وقتا O(length x) كل شيء سيستغرق بعض الوقت O(d1 + (d1 + d2) + ... + (d1 + ... dك-1)). إذا افترضنا أن عدد الملفات هو n ويتم توزيعها بالتساوي بين d1 ... dك ثم الوقت للحساب join سيكون O(n*k) وهذا هو فقط للمستوى الأول من listFiles.

هذا ، على ما أعتقد ، هو مشكلة الأداء الرئيسية في الحل الخاص بك.

Answer 2

أنا فضولي ، إلى أي مدى يتم كتابة نفس البرنامج المكتوب للاستخدام تسجيل الدخول اعمل لاجلك؟ 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))

Answer 3

تشغيله على دليل كبير يكشف عن تسرب الذاكرة. أظن أن هذا يتعلق بصرامة getDirectoryContents ، ولكن قد يكون هناك المزيد. لم يظهر التنميط البسيط كثيرًا ، سأضيف بعض مراكز التكلفة الإضافية وأذهب من هناك ...