如何將樹數據結構保存到Haskell中的二進制文件

Question

我試圖用Haskell將簡單（但非常大）的樹結構保存到二進制文件中。結構看起來是這樣的：

 
-- For simplicity assume each Node has only 4 childs 
data Tree = Node [Tree] | Leaf [Int] 

這裏是我所需要的數據看磁盤上：

1. 每個節點有4個32位偏移到它的孩子，然後按照孩子的開始。
2. 我不太在乎葉子，假設它只有n個連續的32位數字。
3. 對於實踐目的，我需要一些節點標籤或其他附加數據 但現在我不關心那麼多。

對我來說Haskellers編寫二進制文件時的首選是Data.Binary.Put庫。但是，由於我在第一號子彈中遇到了問題。特別是，當我要將節點寫入文件時，要寫下子偏移量，我需要知道當前的偏移量和每個子項的大小。

這不是Data.Binary.Put提供的東西，所以我認爲這必須是Monad變形金剛的完美應用。但即使聽起來很酷且功能強大，但迄今爲止，我還沒有采用這種方法取得成功。

我問了另外兩個問題，我認爲這會幫助我解決問題here和here。我必須說，每次我收到非常好的答案，都會幫助我進一步取得進展，但不幸的是，我仍然無法解決整個問題。

Here是我到目前爲止，它仍然泄漏太多的內存是實用的。

我很想擁有使用這種功能的方法的解決方案，但也會感激任何其他解決方案。

Answer 1

這裏是由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 words替換Ints）。

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

SizeTree在內存中可以以流媒體的方式序列化原始樹。

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 

Answer 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工作到正確的位置。

Answer 3

我想你想要的是一個明確的雙通解決方案。第一個將您的樹轉換爲大小注釋樹。這通過強制樹，但事實上，可以完成，沒有任何monadic機器通過綁結。第二遍是在樸素的舊Put單元中，並且考慮到大小注釋已經被計算出來，應該是非常簡單的。

Answer 4

下面是使用Builder一實現中，這是「二進制」包的一部分。我沒有正確地分析它，但根據「頂部」它立即分配108兆字節，然後掛在其餘的執行。

請注意，我還沒有嘗試讀取數據，因此在我的大小和偏移量計算中可能存在潛在的錯誤。

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