4

我正在尝试使用 Haskell 将一个简单（但相当大）的树结构保存到二进制文件中。结构看起来像这样：

-- 为简单起见，假设每个节点只有 4 个子节点
数据树 = 节点 [树] | 叶 [诠释]
这就是我需要磁盘上的数据的方式：

  1. 每个节点都以其子节点的四个 32 位偏移量开始，然后跟随子节点。
  2. 我不太关心叶子，假设它只是 n 个连续的 32 位数字。
  3. 出于实际目的，我需要一些节点标签或其他一些额外的数据，但现在我也不关心那么多。

在我看来，Haskellers 在编写二进制文件时的首选是 Data.Binary.Put 库。但是这样一来，我在第 1 个项目符号中遇到了问题。特别是，当我将节点写入文件时，要记下子偏移量，我需要知道我当前的偏移量和每个子节点的大小。

这不是 Data.Binary.Put 提供的东西，所以我认为这一定是 Monad 转换器的完美应用。但是，尽管它听起来很酷而且很实用，但到目前为止我还没有成功地使用这种方法。

我问了另外两个问题，我认为它们可以帮助我解决这里和这里的问题。我必须说，每次我收到非常好的答案，帮助我进一步进步，但不幸的是我仍然无法整体解决问题。

这是我到目前为止所得到的，它仍然泄漏太多内存而不实用。

我很想拥有使用这种功能方法的解决方案，但也会感谢任何其他解决方案。

4

4 回答 4

2

我会考虑两种基本方法。如果整个序列化结构很容易放入内存，您可以将每个节点序列化为惰性字节串，并使用每个节点的长度来计算与当前位置的偏移量。

serializeTree (Leaf nums)  = runPut (mapM_ putInt32 nums)
serializeTree (Node subtrees) = mconcat $ header : childBs
 where
  childBs = map serializeTree subtrees
  offsets = scanl (\acc bs -> acc+L.length bs) (fromIntegral $ 2*length subtrees) childBs
  header = runPut (mapM_ putInt32 $ init offsets)

另一种选择是，在序列化节点之后，返回并使用适当的数据重新写入偏移字段。如果树很大，这可能是唯一的选择，但我不知道支持这个的序列化库。这将涉及在正确的位置工作IO和工作。seek

于 2011-03-01T20:39:32.143 回答
2

我认为您想要的是明确的两遍解决方案。第一个将您的树转换为大小注释树。这个 pass 迫使树，但实际上可以通过打结来完成，而不需要任何单子机器。第二遍是在普通的旧 Put monad 中，并且鉴于已经计算了大小注释，应该非常简单。

于 2011-03-02T16:00:23.013 回答
2

这是sclv提出的两遍解决方案的实现。

import qualified Data.ByteString.Lazy as L
import Data.Binary.Put
import Data.Word
import Data.List (foldl')

data Tree = Node [Tree] | Leaf [Word32] deriving Show

makeTree 0 = Leaf $ replicate 100 0xdeadbeef
makeTree n = Node $ replicate 4 $ makeTree $ n-1

SizeTree 模仿原始树，它不包含数据，但在每个节点它存储相应子树的大小。
我们需要在内存中拥有 SizeTree，因此值得让它更紧凑（例如用 uboxed 单词替换 Ints）。

data SizeTree
  = SNode {sz :: Int, chld :: [SizeTree]}
  | SLeaf {sz :: Int}
  deriving Show

在内存中使用 SizeTree 可以以流方式序列化原始 Tree。

putTree :: Tree -> SizeTree -> Put
putTree (Node xs) (SNode _ ys) = do
  putWord8 $ fromIntegral $ length xs          -- number of children
  mapM_ (putWord32be . fromIntegral . sz) ys   -- sizes of children
  sequence_ [putTree x y | (x,y) <- zip xs ys] -- children data
putTree (Leaf xs) _ = do
  putWord8 0                                   -- zero means 'leaf'
  putWord32be $ fromIntegral $ length xs       -- data length
  mapM_ putWord32be xs                         -- leaf data


mkSizeTree :: Tree -> SizeTree
mkSizeTree (Leaf xs) = SLeaf (1 + 4 + 4 * length xs)
mkSizeTree (Node xs) = SNode (1 + 4 * length xs + sum' (map sz ys)) ys
  where
    ys = map mkSizeTree xs
    sum' = foldl' (+) 0

防止 GHC 将两个通道合并为一个非常重要（在这种情况下，它将把树保存在内存中）。在这里，它不是通过向函数提供树而是树生成器来完成的。

serialize mkTree size = runPut $ putTree (mkTree size) treeSize
  where
    treeSize = mkSizeTree $ mkTree size

main = L.writeFile "dump.bin" $ serialize makeTree 10
于 2011-03-06T12:40:10.423 回答
2

这是一个使用Builder的实现，它是“二进制”包的一部分。我没有正确地分析它，但根据“顶部”它立即分配 108 MB，然后在其余的执行中挂起。

请注意，我还没有尝试读回数据，因此我的大小和偏移计算中可能存在潜在的错误。

-- Paste this into TreeBinary.hs, and compile with
--    ghc -O2 --make TreeBinary.hs -o TreeBinary

module Main where


import qualified Data.ByteString.Lazy as BL
import qualified Data.Binary.Builder as B

import Data.List (init)
import Data.Monoid
import Data.Word


-- -------------------------------------------------------------------
-- Test data.

data Tree = Node [Tree] | Leaf [Word32] deriving Show

-- Approximate size in memory (ignoring laziness) I think is:
-- 101 * 4^9 * sizeof(Int) + 1/3 * 4^9 * sizeof(Node)

-- This version uses [Word32] instead of [Int] to avoid having to write
-- a builder for Int.  This is an example of lazy programming instead
-- of lazy evaluation. 

makeTree :: Tree
makeTree = makeTree1 9
  where makeTree1 0 = Leaf [0..100]
        makeTree1 n = Node [ makeTree1 $ n - 1
                           , makeTree1 $ n - 1
                           , makeTree1 $ n - 1
                           , makeTree1 $ n - 1 ]

-- --------------------------------------------------------------------
-- The actual serialisation code.


-- | Given a tree, return a builder for it and its estimated length in bytes.
serialiseTree :: Tree -> (B.Builder, Word32)
serialiseTree (Leaf ns) = (mconcat (B.singleton 2 : map B.putWord32be ns), fromIntegral $ 4 * length ns + 1)
serialiseTree (Node ts) = (mconcat (B.singleton 1 : map B.putWord32be offsets ++ branches), 
                           baseLength + sum subLengths)
   where
      (branches, subLengths) = unzip $ map serialiseTree ts
      baseLength = fromIntegral $ 1 + 4 * length ts
      offsets = init $ scanl (+) baseLength subLengths


main = do
   putStrLn $ "Length = " ++ show (snd $ serialiseTree makeTree)
   BL.writeFile "test.bin" $ B.toLazyByteString $ fst $ serialiseTree makeTree
于 2011-03-06T21:17:10.520 回答