Haskell 使用map和ByteString键对折叠进行性能分析

我有一个小脚本，可以从apache日志文件中读入、解析和导出一些有趣的（不是真正的）统计信息。到目前为止，我已经做了两个简单的选择，日志文件中所有请求中发送的字节总数，以及最常见的前10个IP地址

第一个“模式”只是所有解析字节的简单总和。第二种方法是折叠贴图（Data.map），使用

insertWith（+）1'

计算出现次数

第一个按照我的预期运行，大部分时间花在解析上，在常量空间中

在中分配的42359709344字节 堆 GC期间复制的72405840字节 113712字节的最大驻留空间（1553个样本） 145872字节最大斜率 2 MB总内存在使用中（0 MB因碎片而丢失）

第0代：76311个集合，
0平行、0.89秒、0.99秒经过
第1代：1553个集合，0 平行，0.21秒，0.22秒

初始时间0.00s（0.00s 已用时间）MUT时间21.76s( 经过24.82秒）GC时间1.10秒（经过1.20秒）退出时间
0.00s（经过0.00s）总时间22.87s（经过26.02s）

%GC时间4.8%（已用4.6%）

分配速率1946258962字节 每秒

生产力占总用户的95.2%， 占总运行时间的83.6%

然而，第二个没有

在中分配的49398834152字节 堆 GC期间复制的580579208字节 718385088字节最大驻留时间（15个示例） 134532128字节最大斜率 使用的内存总量为1393 MB（由于碎片而丢失172 MB）

第0代：91275个集合，
0平行，252.65秒，254.46秒经过
第1代：15个集合，0 并行，0.12秒，经过0.12秒

初始时间0.00s（0.00s 已用时间）MUT时间41.11s( 经过48.87秒）GC时间252.77秒（经过254.58秒）退出时间
0.00s（经过0.01s）总时间293.88s（经过303.45s）

%GC时间86.0%（已用83.9%）

分配速率1201635385字节 每秒

生产力占总用户的14.0%， 总运行时间的13.5%

这是代码

{-# LANGUAGE OverloadedStrings #-}

module Main where

import qualified Data.Attoparsec.Lazy as AL
import Data.Attoparsec.Char8 hiding (space, take)
import qualified Data.ByteString.Char8 as S
import qualified Data.ByteString.Lazy.Char8 as L
import Control.Monad (liftM)
import System.Environment (getArgs)
import Prelude hiding (takeWhile)
import qualified Data.Map as M
import Data.List (foldl', sortBy)
import Text.Printf (printf)
import Data.Maybe (fromMaybe)

type Command = String

data LogLine = LogLine {
    getIP     :: S.ByteString,
    getIdent  :: S.ByteString,
    getUser   :: S.ByteString,
    getDate   :: S.ByteString,
    getReq    :: S.ByteString,
    getStatus :: S.ByteString,
    getBytes  :: S.ByteString,
    getPath   :: S.ByteString,
    getUA     :: S.ByteString
} deriving (Ord, Show, Eq)

quote, lbrack, rbrack, space :: Parser Char
quote  = satisfy (== '\"')
lbrack = satisfy (== '[')
rbrack = satisfy (== ']')
space  = satisfy (== ' ')

quotedVal :: Parser S.ByteString
quotedVal = do
    quote
    res <- takeTill (== '\"')
    quote
    return res

bracketedVal :: Parser S.ByteString
bracketedVal = do
    lbrack
    res <- takeTill (== ']')
    rbrack
    return res

val :: Parser S.ByteString
val = takeTill (== ' ')

line :: Parser LogLine
l    ine = do
    ip <- val
    space
    identity <- val
    space
    user <- val
    space
    date <- bracketedVal
    space
    req <- quotedVal
    space
    status <- val
    space
    bytes <- val
    (path,ua) <- option ("","") combined
    return $ LogLine ip identity user date req status bytes path ua

combined :: Parser (S.ByteString,S.ByteString)
combined = do
    space
    path <- quotedVal
    space
    ua <- quotedVal
    return (path,ua)

countBytes :: [L.ByteString] -> Int
countBytes = foldl' count 0
    where
        count acc l = case AL.maybeResult $ AL.parse line l of
            Just x  -> (acc +) . maybe 0 fst . S.readInt . getBytes $ x
            Nothing -> acc

countIPs :: [L.ByteString] -> M.Map S.ByteString Int
countIPs = foldl' count M.empty
    where
        count acc l = case AL.maybeResult $ AL.parse line l of
            Just x -> M.insertWith' (+) (getIP x) 1 acc
            Nothing -> acc

---------------------------------------------------------------------------------

main :: IO ()
main = do
  [cmd,path] <- getArgs
  dispatch cmd path

pretty :: Show a => Int -> (a, Int) -> String
pretty i (bs, n) = printf "%d: %s, %d" i (show bs) n

dispatch :: Command -> FilePath -> IO ()
dispatch cmd path = action path
    where
        action = fromMaybe err (lookup cmd actions)
        err    = printf "Error: %s is not a valid command." cmd

actions :: [(Command, FilePath -> IO ())]
actions = [("bytes", countTotalBytes)
          ,("ips",  topListIP)]

countTotalBytes :: FilePath -> IO ()
countTotalBytes path = print . countBytes . L.lines =<< L.readFile path

topListIP :: FilePath -> IO ()
topListIP path = do
    f <- liftM L.lines $ L.readFile path
    let mostPopular (_,a) (_,b) = compare b a
        m = countIPs f
    mapM_ putStrLn . zipWith pretty [1..] . take 10 . sortBy mostPopular . M.toList $ m

{-#语言重载字符串}
模块主要在哪里
将限定的Data.Attoparsec.Lazy作为AL导入
导入Data.Attoparsec.Char8隐藏（空格，take）
将限定数据.ByteString.Char8作为S导入
将限定数据.ByteString.Lazy.Char8作为L导入
进口管制.Monad（liftM）
导入System.Environment（getArgs）
导入前奏隐藏（takeWhile）
导入符合条件的数据。映射为M
导入数据列表（foldl'，排序）
导入Text.Printf（Printf）
导入数据。可能（来自可能）
类型命令=字符串
数据对数线=对数线{
getIP:：S.ByteString，
GetIdentit:：S.ByteString，
getUser:：S.ByteString，
getDate:：S.ByteString，
getReq:：S.ByteString，
getStatus:：S.ByteString，
getBytes:：S.ByteString，
getPath:：S.ByteString，
getUA:：S.ByteString
}推导（Ord、Show、Eq）
quote、lbrack、rbrack、space:：解析器字符
quote=满足（=“\”）
lbrack=满足（='['））
rbrack=满足（=']'）
空格=满足（=''）
quotedVal:：解析器S.ByteString
quotedVal=do
引用
res最明显的一点是，第一个脚本一看到数据就可以扔掉，而第二个脚本必须保留所看到的所有内容。因此，您希望第二个脚本至少占用O（N）内存，而第一个脚本可以在恒定空间中运行

您是否尝试过在启用堆分析的情况下运行？我可以尝试一下代码中可能出现过多分配的地方，但硬数据是无法替代的

我自己也会怀疑Data.Map.insertWith'调用，因为每个调用都会使现有映射的一部分超出需求，需要复制和重新平衡，但这纯粹是我的猜测。如果是insertWith'调用造成的，那么由于不需要中间映射条目，构建整个映射可能会更快一次通过ap（不增加IP数），然后再通过第二次进行计数。这样，您就不会浪费时间重新平衡映射。您还可以利用这样一个事实，即您的密钥数据类型适合整数（如果它至少是IPv4地址，则会这样做）并改用Data.IntMap，它具有更低的内存开销。
我建议对代码进行以下更改：

@@ -1,4 +1,4 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE BangPatterns, OverloadedStrings #-}

 module Main where

@@ -9,7 +9,7 @@
 import Control.Monad (liftM)
 import System.Environment (getArgs)
 import Prelude hiding (takeWhile)
-import qualified Data.Map as M
+import qualified Data.HashMap.Strict as M
 import Data.List (foldl', sortBy)
 import Text.Printf (printf)
 import Data.Maybe (fromMaybe)
@@ -17,15 +17,15 @@
 type Command = String

 data LogLine = LogLine {
-    getIP     :: S.ByteString,
-    getIdent  :: S.ByteString,
-    getUser   :: S.ByteString,
-    getDate   :: S.ByteString,
-    getReq    :: S.ByteString,
-    getStatus :: S.ByteString,
-    getBytes  :: S.ByteString,
-    getPath   :: S.ByteString,
-    getUA     :: S.ByteString
+    getIP     :: !S.ByteString,
+    getIdent  :: !S.ByteString,
+    getUser   :: !S.ByteString,
+    getDate   :: !S.ByteString,
+    getReq    :: !S.ByteString,
+    getStatus :: !S.ByteString,
+    getBytes  :: !S.ByteString,
+    getPath   :: !S.ByteString,
+    getUA     :: !S.ByteString
 } deriving (Ord, Show, Eq)

 quote, lbrack, rbrack, space :: Parser Char
@@ -39,14 +39,14 @@
     quote
     res <- takeTill (== '\"')
     quote
-    return res
+    return $! res

 bracketedVal :: Parser S.ByteString
 bracketedVal = do
     lbrack
     res <- takeTill (== ']')
     rbrack
-    return res
+    return $! res

 val :: Parser S.ByteString
 val = takeTill (== ' ')
@@ -67,14 +67,14 @@
     space
     bytes <- val
     (path,ua) <- option ("","") combined
-    return $ LogLine ip identity user date req status bytes path ua
+    return $! LogLine ip identity user date req status bytes path ua

 combined :: Parser (S.ByteString,S.ByteString)
 combined = do
     space
-    path <- quotedVal
+    !path <- quotedVal
     space
-    ua <- quotedVal
+    !ua <- quotedVal
     return (path,ua)

 countBytes :: [L.ByteString] -> Int
@@ -84,11 +84,11 @@
             Just x  -> (acc +) . maybe 0 fst . S.readInt . getBytes $ x
             Nothing -> acc

-countIPs :: [L.ByteString] -> M.Map S.ByteString Int
+countIPs :: [L.ByteString] -> M.HashMap S.ByteString Int
 countIPs = foldl' count M.empty
     where
         count acc l = case AL.maybeResult $ AL.parse line l of
-            Just x -> M.insertWith' (+) (getIP x) 1 acc
+            Just x -> M.insertWith (+) (getIP x) 1 acc
             Nothing -> acc

 ---------------------------------------------------------------------------------

@@-1,4+1,4@@
-{-#语言重载字符串}
+{-#语言模式，重载字符串#-}
模块主要在哪里
@@ -9,7 +9,7 @@
进口管制.Monad（liftM）
导入System.Environment（getArgs）
导入前奏隐藏（takeWhile）
-导入符合条件的数据。映射为M
+将限定的Data.HashMap.Strict导入为M
导入数据列表（foldl'，排序）
导入Text.Printf（Printf）
导入数据。可能（来自可能）
@@ -17,15 +17,15 @@
类型命令=字符串
数据对数线=对数线{
-getIP:：S.ByteString，
-GetIdentit:：S.ByteString，
-getUser:：S.ByteString，
-getDate:：S.ByteString，
-getReq:：S.ByteString，
-getStatus:：S.ByteString，
-getBytes:：S.ByteString，
-getPath:：S.ByteString，
-getUA:：S.ByteString
+getIP:：！S.ByteString，
+GetIdentit:：！S.ByteString，
+getUser:：！S.ByteString，
+getDate:：！S.ByteString，
+getReq:：！S.ByteString，
+getStatus:：！S.ByteString，
+getBytes:：！S.ByteString，
+getPath:：！S.ByteString，
+格图亚：：！S.ByteString
}推导（Ord、Show、Eq）
quote、lbrack、rbrack、space:：解析器字符
@@ -39,14 +39,14 @@
引用
res acc
---------------------------------------------------------------------------------

我将
LogLine
的字段设置得很严格，以避免它们包含thunks referri