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

时间：2011-06-23 12:53:40

标签： haskell attoparsec

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

第一个“模式”只是所有已解析字节的简单总和。第二个是地图上的折叠（Data.Map），使用insertWith (+) 1'来计算出现次数。

第一个按照我的预期运行，大部分时间都是在恒定空间中进行解析。

  

分配了42,359,709,344个字节   堆         GC期间复制了72,405,840个字节            最大驻留时间为113,712字节（1553个样本）            最大斜率145,872字节                  正在使用的总内存为2 MB（由于碎片导致丢失0 MB）

     

第0代：76311集合，
  0平行，0.89秒，0.99秒   第1代：1553系列，0   平行，0.21s，0.22s已经过去

     

INIT时间0.00s（0.00s   已过去）MUT时间21.76s（   经过24.82秒）GC时间1.10秒（经过1.20秒）退出时间
  0.00秒（已过去0.00秒）总时间22.87秒（已过去26.02秒）

     

％GC时间4.8％（已过去4.6％）

     

Alloc率1,946,258,962字节   每MUT秒

     

生产力占总用户的95.2％，   总耗时的83.6％

然而，第二个没有！

  

分配49,398,834,152字节   堆        GC期间复制了580,579,208个字节        最大驻留时间为718,385,088字节（15个样本）        最大斜率为134,532,128字节               正在使用的总内存为1393 MB（由于碎片而丢失了172 MB）

     

第0代：91275集合，
  0平行，252.65秒，254.46秒过去了   第1代：15个收藏，0   并行，0.12秒，0.12秒

     

INIT时间0.00s（0.00s   已过去）MUT时间41.11s（   经过48.87秒）GC时间252.77s（经过254.58s）退出时间
  0.00s（已过去0.01秒）总时间293.88s（经过303.45s）

     

％GC时间86.0％（已过去83.9％）

     

Alloc率1,201,635,385字节   每MUT秒

     

生产力占总用户的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

编辑：

添加+ RTS -A16M可将GC降低至20％。内存使用当然没有改变。

2 个答案:

答案 0 :(得分：3)

我建议对代码进行以下更改：

@@ -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

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

我创建了LogLine严格的字段，以避免它们包含引用与解析相关的表达式的thunk。除非你真的需要它们是懒惰的，否则最好严格控制字段。

我确保尽快创建解析结果（这是更改的$!部分），也是为了避免在实际检查LogLine的各个字段之前延迟解析。

最后，我从unordered-containers package切换到了更好的数据结构HashMap。请注意，Data.HashMap.Strict中的所有函数都是值严格的，这意味着我们可以使用普通insertWith变体。

请注意，由于共享底层存储，获取ByteString的子字符串会强制原始字符串保留在内存中（这与Java的String相同）。如果要确保不保留额外的内存，请使用copy包中的bytestring功能。您可以尝试在copy的结果上调用(getIP x)，看看是否有任何区别。这里的权衡是使用一些额外的计算来复制字符串以换取更低的空间使用。

请注意，使用-A<high number>往往会提高短期运行程序（即基准）的性能，但不一定会提高实际程序的性能。同样适用于-H。至少较高的-H值（例如1G）不会影响程序的性能。

答案 1 :(得分：0)

最明显的一点是，你的第一个脚本可以在看到数据后立即丢弃数据，而第二个脚本必须保留它所看到的所有内容。因此，您希望第二个脚本至少占用O（N）内存，而第一个脚本可以在恒定空间中运行。

您是否尝试过打开堆配置文件？我可以对代码中可能发生的超额分配进行一些尝试，但是硬数据无法替代。

我自己会怀疑Data.Map.insertWith'调用'，因为每个人都会将现有的Map剩余部分渲染到需求中并需要复制和重新平衡，但这对我来说是纯粹的猜测。如果insertWith'调用是责备，那么因为你不需要插页式地图条目，所以可能更快地在一次传递中构建整个地图（没有任何增量来计算IP）然后做第二次通过计数。这样你就不会浪费时间重新平衡地图。您还可以利用您的关键数据类型适合Int的事实（好吧，如果它至少是IPv4地址），并使用Data.IntMap，它具有更低的内存开销。

相关问题
最新问题