优化 Haskell 文本处理

Question

我正在 Haskell 中编写一些简单的字符计数例程，将统计信息存储在新的数据类型中：

data Stat = Stat {
    stChars    :: !Int,
    stVowels   :: !Int,
    stPairEL   :: !Int,
    stWords    :: !Int
}

我在成百上千个纯文本文件上运行此程序，每个文件大约 50K--100K。

tabulateFile :: FilePath -> IO Stat
tabulateFile path = do
  putStrLn path
  contents <- L.readFile path
  return $! tabulateText ' ' contents defaultStat

我没有使用左折叠，而是使用原始递归，这样我就可以保留前一个字符。

tabulateText :: Char -> L.ByteString -> Stat -> Stat
tabulateText lastChr bs stat =
  case U.uncons bs of
    Nothing -> stat
    Just (chr, newBs) ->
      tabulateText lchr newBs (countChar lastChr lchr stat)
        where lchr = toLower chr

{-# INLINE countChar #-}
countChar :: Char -> Char -> Stat -> Stat
countChar !lastChr !chr !(Stat stChars stVowels stPairEL stWords) =
  Stat
    (stChars  + 1)
    (stVowels + (countIf $ isVowel chr))
    (stPairEL + (countIf (lastChr == 'e' && chr == 'l')))
    (stWords  + (countIf ((not $ isLetter lastChr) && isLetter chr)))

isVowel :: Char -> Bool
isVowel c = Set.member c vowels

vowels = Set.fromAscList ['a', 'e', 'i', 'o', 'u', ...] -- rest of vowels elided

现在，它比运行cat * | wc 慢两倍多，但我的直觉告诉我，文件 I/O 应该远远超过所需的 CPU 时间。简单地使用 cat * | wc 处理大约 20MB/s 的热缓存，但使用我的 Haskell 程序（使用 -O 编译）运行速度低于 10MB/s，即使经过一些基本优化。 Profiling告诉我大部分时间都花在tabulateText和countChar上。

我有什么遗漏的地方可以在这​​里优化吗？

编辑：完整的文件粘贴到http://hpaste.org/74638

Answer 1

您应该提供导入，以便有人可以编译代码。但是，这里有几件事看起来很可能：

• 使用-O2 -funbox-strict-fields 编译（以获得严格字段的​​好处）
• tabulateText 在lastChr 和stat 中应该是严格的
• Set.member 似乎是一种非常昂贵的相等比较方法。使用跳转表。

例如

isSpaceChar8 :: Char -> Bool
isSpaceChar8 c =
    c == ' '     ||
    c == '\t'    ||
    c == '\n'    ||
    c == '\r'    ||
    c == '\f'    ||
    c == '\v'    ||
    c == '\xa0'

这将很好地内联和优化。

不确定countIf 做了什么，但它看起来很糟糕。我怀疑它是if 而你返回 0？ 怎么样：

Stat
   (a + 1)
   (if isVowel c then a + 1 else a)
   ...

然后看看核心。

Answer 2

{-# LANGUAGE BangPatterns #-}
import qualified Data.ByteString.Lazy.Char8 as U
import qualified Data.ByteString.Lazy as L
import Data.Word
import Data.Char
import Control.Applicative 

data Stat = Stat {
    stChars    :: !Int,
    stVowels   :: !Int,
    stPairEL   :: !Int,
    stWords    :: !Int
} deriving Show
defaultStat = Stat 0 0 0 0

{-# INLINE  tabulateFile #-}
tabulateFile :: FilePath -> IO Stat
tabulateFile path = newTabulate <$> L.readFile path

{-#  INLINE newTabulate #-}
newTabulate :: L.ByteString -> Stat 
newTabulate = snd . U.foldl' countIt (' ',defaultStat) 
    where 
        {-#  INLINE countIt #-}
        countIt :: (Char,Stat) -> Char -> (Char,Stat)
        countIt (!lastChr,!Stat stChars stVowels stPairEL stWords) !chr = 
            (chr,Stat
                (stChars  + 1)
                (if isVowel chr then stVowels + 1 else stVowels)
                (if (lastChr == 'e' && chr == 'l') then stPairEL + 1 else stPairEL)
                (if ((isSpace lastChr) && isLetter chr) then stWords+1 else stWords))

{-# INLINE isVowel #-}
isVowel :: Char -> Bool
isVowel c = 
    c == 'e' ||
    c == 'a' ||
    c == 'i' ||
    c == 'o' ||
    c == 'u' 



main:: IO ()
main = do 
    stat <- tabulateFile "./test.txt"
    print stat

Don 建议的大多数优化都包含在使用有效的 foldl' 中。 性能比 cat + wc 稍慢，但没关系，因为您正在进行更多计算。我没有在非常大的文件上测试过它，但它应该可以与 cat + wc 媲美。

使用-O2 -funbox-strict-fields 编译以获得优化的代码。

我会在查看核心后对其进行更多更改，看看是否可以进行更多优化。 一个可能的优化点是在构造 stat 时在构造函数之外设置 if 条件，例如，如果 chr 是元音，那么它已经是 letter 所以如果在 stWords 等中你不需要另一个，但这将真的炸毁了你的代码，但你可以尝试看看它是否真的对大文件有帮助。

Answer 3

在测试了其他替代方案后，似乎 CPU 使用率高主要是因为我使用的是 Data.ByteString.Lazy.UTF8。我通过修改tabulateText 中的数据结构以在UTF8 ByteString 上使用foldl，从而节省了可以忽略不计的运行时间。

鉴于此，我在文件上并行化了程序，并且有时能够在我的机器上获得 7 倍的加速。

我首先用unsafePerformIO 包裹tabulateFile：

unsafeTabulateFile :: FilePath -> Stat
unsafeTabulateFile f =
  unsafePerformIO $ tabulateFile f

然后用Control.Parallel.Strategies做parMap rseq unsafeTabulateFile files。