是什么导致我的Wavefront Obj解析器消耗比输入多10倍的内存？

Question

我正在尝试为Wavefront .obj file format编写一个解析器，这是一种非常愚蠢的基于行的格式。希望维基百科的那篇文章能总结一下它是如何工作的，但本质上你有记录顶点、法线和其他数组中的条目的行。最后，人脸定义是这些独立数组中的三重(或更多)索引。

我的解析器是

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
module WavefrontObj where

import Control.Applicative
import Data.Attoparsec.Text
import Data.Foldable (toList)
import Data.List (foldl')
import Data.List.Split
import Data.Monoid
import Data.NonEmpty ((!:))
import Data.Sequence (Seq)
import Geometry
import Graphics.GL
import Linear
import Linear.Affine
import qualified Data.Sequence as Seq

data Obj =
  Obj {objVertices :: !(Seq (V3 Double))
      ,objNormals :: !(Seq (V3 Double))
      ,objFaces :: !(Seq (V2 (V3 Int)))}
  deriving (Show)

instance Monoid Obj where
  mempty = Obj mempty mempty mempty
  Obj a b c `mappend` Obj x y z =
    Obj (a <> x)
        (b <> y)
        (c <> z)

parseLine :: Parser Obj
parseLine =
  vertex <|> normal <|> face <|>
  (mempty <$ skipWhile (not . isEndOfLine))
  where vertex =
          do string "v"
             skipSpace
             v <- v3
             return $!
               Obj (Seq.singleton v) mempty mempty
        normal =
          do string "vn"
             skipSpace
             v <- v3
             return $!
               Obj mempty (Seq.singleton v) mempty
        face =
          do string "f"
             skipSpace
             let v =
                   (,) <$> decimal <* char '/' <* decimal <* char '/' <*> decimal
             (v1,n1) <- v
             skipSpace
             (v2,n2) <- v
             skipSpace
             (v3,n3) <- v
             mv4 <-
               optional (do skipSpace
                            v)
             return $!
               Obj mempty
                   mempty
                   (Seq.singleton
                      (V2 (V3 v1 v2 v3)
                          (V3 n1 n2 n3)) <>
                    case mv4 of
                      Just (v4,n4) ->
                        Seq.singleton
                          (V2 (V3 v1 v3 v4)
                              (V3 n1 n3 n4))
                      Nothing -> mempty)
        v3 =
          do x <- double
             skipSpace
             y <- double
             skipSpace
             z <- double
             return $! V3 x y z

parseObj :: Parser Obj
parseObj = go mempty
  where go !acc =
          do !l <- parseLine
             acc' <- return $! acc <> l
             endOfLine *> go acc' <|> acc' <$ endOfInput

用一个36MB的obj文件运行它可以成功解析，但是

  21,342,866,200 bytes allocated in the heap
   1,263,590,520 bytes copied during GC
     290,617,624 bytes maximum residency (10 sample(s))
      56,958,112 bytes maximum slop
             547 MB total memory in use (0 MB lost due to fragmentation)

                                     Tot time (elapsed)  Avg pause  Max pause
  Gen  0     41177 colls,     0 par    0.711s   0.708s     0.0000s    0.0008s
  Gen  1        10 colls,     0 par    0.241s   0.241s     0.0241s    0.1669s

  INIT    time    0.000s  (  0.000s elapsed)
  MUT     time    5.071s  (  5.077s elapsed)
  GC      time    0.952s  (  0.949s elapsed)
  RP      time    0.000s  (  0.000s elapsed)
  PROF    time    0.000s  (  0.000s elapsed)
  EXIT    time    0.020s  (  0.020s elapsed)
  Total   time    6.055s  (  6.046s elapsed)

  %GC     time      15.7%  (15.7% elapsed)

  Alloc rate    4,208,709,362 bytes per MUT second

  Productivity  84.3% of total user, 84.4% of total elapsed

虽然效率很高，但6秒打开一个总内存为547MB的.obj文件似乎有点过了。我已经上传了一个堆档案here。.prof文件是

    Fri Jun  5 22:36 2015 Time and Allocation Profiling Report  (Final)

       Deferred +RTS -p -RTS

    total time  =        5.17 secs   (5173 ticks @ 1000 us, 1 processor)
    total alloc = 13,142,553,520 bytes  (excludes profiling overheads)

COST CENTRE      MODULE                %time %alloc

parseLine.v3     WavefrontObj           69.8   69.5
parseLine.face.v WavefrontObj            8.4   13.7
parseLine.face   WavefrontObj            7.0    6.1
timeLog          Deferred                3.3    1.2
parseLine        WavefrontObj            2.8    1.7
parseLine.normal WavefrontObj            2.5    3.6
readTextDevice   Data.Text.Internal.IO   2.2    0.1
parseLine.vertex WavefrontObj            1.7    2.6
mappend          WavefrontObj            1.4    1.1


                                                                           individual     inherited
COST CENTRE              MODULE                          no.     entries  %time %alloc   %time %alloc

MAIN                     MAIN                             85           0    0.0    0.0   100.0  100.0
 main                    Deferred                        171           0    0.0    0.0   100.0  100.0
  timeLog                Deferred                        173           0    3.3    1.2   100.0  100.0
   parseObj              WavefrontObj                    178           0    0.0    0.0    94.4   98.7
    parseObj.go          WavefrontObj                    179     1080806    0.6    0.5    94.4   98.7
     parseLine           WavefrontObj                    181           0    2.8    1.7    93.8   98.2
      parseLine.v3       WavefrontObj                    190           0   69.7   69.5    70.8   70.3
       mappend           WavefrontObj                    191      667027    1.0    0.8     1.0    0.8
      parseLine.face     WavefrontObj                    187           0    7.0    6.1    16.9   21.3
       parseLine.face.v  WavefrontObj                    195           0    8.4   13.7     9.7   15.2
        parseLine.normal WavefrontObj                    196           0    0.9    1.3     1.2    1.5
         mappend         WavefrontObj                    197      127769    0.3    0.3     0.3    0.3
       parseLine.normal  WavefrontObj                    193           0    0.0    0.0     0.0    0.0
       mappend           WavefrontObj                    188      286011    0.1    0.0     0.1    0.0
      parseLine.normal   WavefrontObj                    185           0    1.5    2.3     1.6    2.3
       parseLine.v3      WavefrontObj                    192           0    0.1    0.0     0.1    0.0
      parseLine.vertex   WavefrontObj                    183           0    1.7    2.6     1.7    2.6
   readTextDevice        Data.Text.Internal.IO           174       18260    2.2    0.1     2.2    0.1
 CAF                     Deferred                        169           0    0.0    0.0     0.0    0.0
  main                   Deferred                        170           1    0.0    0.0     0.0    0.0
   timeLog               Deferred                        172           1    0.0    0.0     0.0    0.0
 CAF                     WavefrontObj                    166           0    0.0    0.0     0.0    0.0
  parseLine              WavefrontObj                    180           1    0.0    0.0     0.0    0.0
   parseLine.v3          WavefrontObj                    189           1    0.0    0.0     0.0    0.0
   parseLine.face        WavefrontObj                    186           1    0.0    0.0     0.0    0.0
    parseLine.face.v     WavefrontObj                    194           1    0.0    0.0     0.0    0.0
   parseLine.normal      WavefrontObj                    184           1    0.0    0.0     0.0    0.0
   parseLine.vertex      WavefrontObj                    182           1    0.0    0.0     0.0    0.0
  mempty                 WavefrontObj                    176           1    0.0    0.0     0.0    0.0
  parseObj               WavefrontObj                    175           1    0.0    0.0     0.0    0.0
   parseObj.go           WavefrontObj                    177           1    0.0    0.0     0.0    0.0
 CAF                     Data.Attoparsec.Text.Internal   153           0    0.0    0.0     0.0    0.0
 CAF                     Data.Scientific                 152           0    0.0    0.0     0.0    0.0
 CAF                     Data.Text.Array                 150           0    0.0    0.0     0.0    0.0
 CAF                     Data.Text.Internal              148           0    0.0    0.0     0.0    0.0
 CAF                     GHC.Err                         135           0    0.0    0.0     0.0    0.0
 CAF                     GHC.IO.Handle.FD                132           0    0.0    0.0     0.0    0.0
 CAF                     GHC.IO.Handle.Internals         131           0    0.0    0.0     0.0    0.0
 CAF                     GHC.Conc.Signal                 125           0    0.0    0.0     0.0    0.0
 CAF                     GHC.IO.Encoding                 121           0    0.0    0.0     0.0    0.0
 CAF                     GHC.IO.FD                       120           0    0.0    0.0     0.0    0.0
 CAF                     GHC.Conc.Sync                   108           0    0.0    0.0     0.0    0.0
 CAF                     GHC.IO.Encoding.Iconv           106           0    0.0    0.0     0.0    0.0
 CAF                     GHC.Integer.Type                 92           0    0.0    0.0     0.0    0.0

我有一个猜想，因为我的热点是v3解析器，这可能只是与使用double解析器有关。

Answer 1

我相信你的问题出在Obj的定义上

data Obj =
  Obj {objVertices :: !(Seq (V3 Double))
      ,objNormals :: !(Seq (V3 Double))
      ,objFaces :: !(Seq (V2 (V3 Int)))}
  deriving (Show)

在您的解析器中，您只使用三个字段中的一个，但是您计算WHNF并为每个Obj分配一个空序列的空间。与纯文本文件中的Obj大小相比，这几乎是内存中它的空间的三倍。对于每个元素，您也总是有一个Seq.singleton实例(计算结果也是WHNF)。您正在为此付出时间和内存的代价。

您可能会说，“但我所有的时间都花在v3上了”，您可能是对的。然而，所有这些时间都花在了内存分配上，这(我想？)包括运行垃圾回收器的成本。从统计上看，您最有可能在进行最多分配的地方捕获GC周期。

我的建议：

• 看看如果去掉Obj的严格性会发生什么它可能不是一个完整的解决方案，但是它会告诉你这是否是删除三个!的成本的问题。如果我错了，你已经失去了非常little.
• Convert的Obj类型，而不是产品类型。
• 使用更传统的解析器。当涉及到清晰的表达能力和它可以处理的语法的复杂性时，Parsec是令人敬畏的，但在性能方面与其他更有限的解析技术是不同的。

Obj的可能的求和类型

data Obj =
    Empty 
  | Vertex (V3 Double)
  | Normal (V3 Double)
  | Face   (V2 (V3 Int))
  | Obj {objVertices :: !(Seq (V3 Double))
        ,objNormals  :: !(Seq (V3 Double))
        ,objFaces    :: !(Seq (V2 (V3 Int)))}

Instance Monoid Obj where
  mempty = Empty
  mappend Empty x = x
  mappend x Empty = x
  mappend (Face v) (obj@Obj{objFaces = vs}) = obj{objFaces = v<|vs}
  mappend (obj@Obj{objFaces = vs}) (Face v) = obj{objFaces = vs |> v}
  ...

Answer 2

根据我的经验，基于行的格式解析的答案是使用Data.ByteString.Char8中的BS.lines和BS.words。它不是很漂亮，但没有解析器组合子方法，尽管它非常快或内存效率很高。类似于：

parseLine :: BS.ByteString -> [Either Xxx Obj]
parseLine = map prs . BS.lines

prs :: BS.ByteString -> Either Xxx Obj
prs l = case BS.words l of
         ["v", x, y, z] -> do
             v <- V3 <$> parseDouble x <*> parseDouble y <*> parseDouble z
             return $ Obj (Seq.singleton v) mempty mempty
         ...
         _ -> Left "blah"

这是为了提高性能。对于内存使用，您可能希望使用原始向量，并且通常使用未打包的数据类型。在您的示例中似乎不是这样，但是您还需要检查您正在使用的库是如何实现其数据类型的。例如，time包中的UTCTime使用大量内存。

最后一点提示:我通常使用数据类型所使用的"string“类型来参数我的数据类型。我的解析器函数返回Foo ByteString，然后我将保留在内存中并操作的子集转换为Foo Text。