Как сохранить древовидную структуру данных в бинарный файл в Haskell

Question

Я пытаюсь сохранить простую (но довольно большую) древовидную структуру в двоичный файл, используя Haskell. Структура выглядит примерно так:

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

А вот как мне нужно, чтобы данные выглядели на диске:

1. Каждый узел начинается с четырех 32-битных смещений своих потомков, затем следует за потомками.
2. Меня не волнуют листья, скажем, это просто n последовательных 32-битных чисел.
3. Для практических целей мне потребуются некоторые метки узлов или некоторые другие дополнительные данные. но сейчас меня это тоже не волнует.

Мне кажется, что Haskellers первым выбором при написании бинарных файлов является библиотека Data.Binary.Put. Но с этим у меня есть проблема в пуле # 1. В частности, когда я собираюсь записать Node в файл, чтобы записать дочерние смещения, мне нужно знать мое текущее смещение и размер каждого дочернего элемента.

Это не то, что предоставляет Data.Binary.Put, поэтому я подумал, что это должно быть идеальное применение трансформаторов Монад. Но несмотря на то, что это звучит круто и функционально, до сих пор мне не удался этот подход.

Я задал два других вопроса, которые, как мне казалось, помогут мне решить проблему здесь и здесь . Я должен сказать, что каждый раз, когда я получал очень хорошие ответы, которые помогли мне прогрессировать дальше, но, к сожалению, я все еще не могу решить проблему в целом.

Здесь - это то, что у меня так далеко, оно все еще теряет слишком много памяти для практического применения.

Я бы хотел иметь решение, которое использует такой функциональный подход, но был бы благодарен за любое другое решение.

Answer 1

Вот реализация, использующая Builder , которая является частью «двоичного» пакета.Я не профилировал его должным образом, но согласно «top» он сразу выделяет 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

Answer 2

Я думаю, что вы хотите получить явное двухпроходное решение. Первый преобразует ваше дерево в аннотированное дерево размера. Этот проход заставляет дерево, но на самом деле он может быть выполнен без какого-либо монадического механизма, если завязать узел. Второй проход в простой старой монаде Пут, и, учитывая, что аннотации размеров уже рассчитаны, должен быть очень простым.

Answer 3

Вот реализация двухпроходного решения, предложенного 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 в памяти, поэтому стоит сделать его более компактным (например, заменить 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 4

Есть два основных подхода, которые я бы рассмотрел.Если вся сериализованная структура будет легко помещаться в памяти, вы можете сериализовать каждый узел в ленивую строку и просто использовать длины для каждого из них, чтобы вычислить смещение из текущей позиции.

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 в правильных местах.