从 Haskell 中的（预序）位串重建哈夫曼树

Question

我有以下 Haskell 多态数据类型：

data Tree a = Leaf Int a | Node Int (Tree a) (Tree a)

树将被压缩为 0 和 1 的位串。 “0”表示一个节点，它后面是左子树的编码，然后是右子树的编码。 “1”表示叶子，后面跟着 7 位信息（例如，它可能是一个字符）。每个 node/leaf 应该还包含存储信息的频率，但这对于这个问题并不重要（所以我们可以在那里放任何东西）。

例如从这棵编码树开始

[0,0,0,1,1,1,0,1,0,1,1,1,1,1,1,0,1,0,0,0,0,1,1,1,1,0,0,0,1,1,1,
 1,0,0,1,1,1,1,1,1,1,0,0,1,0,0,1,1,1,1,0,1,1,1,1,1,1,0,0,0,0,1]

它应该回馈这样的东西

Node 0 (Node 0 (Node 0 (Leaf 0 'k') (Leaf 0 't')) 
       (Node 0 (Node 0 (Leaf 0 'q') (Leaf 0 'g')) (Leaf 0 'r'))) 
(Node 0 (Leaf 0 'w') (Leaf 0 'a'))

（间距不重要，但它不适合一行）。

我几乎没有使用树的经验，尤其是在实现代码时。我对如何在纸上解决这个问题有一个模糊的想法（使用类似于堆栈的东西来处理 depth/levels），但我仍然有点迷茫。

感谢任何帮助或想法！

Answer 1

右折：

import Data.Char (chr)

data Tree a = Leaf a | Node (Tree a) (Tree a)
  deriving Show

build :: [Int] -> [Tree Char]
build xs = foldr go (\_ _ -> []) xs 0 0
  where
  nil = Leaf '?'
  go 0 run 0 0 = case run 0 0 of
    []     -> Node nil nil:[]
    x:[]   -> Node x   nil:[]
    x:y:zs -> Node x   y  :zs

  go 1 run 0 0 = run 0 1
  go _ _   _ 0 = error "this should not happen!"
  go x run v 7 = (Leaf $ chr (v * 2 + x)): run 0 0
  go x run v k = run (v * 2 + x) (k + 1)

然后：

\> head $ build [0,0,0,1,1,1,0, ...] -- the list of 01s as in the question
Node (Node (Node (Leaf 'k') (Leaf 't'))
      (Node (Node (Leaf 'q') (Leaf 'g')) (Leaf 'r')))
 (Node (Leaf 'w') (Leaf 'a'))

Answer 2

好吧，您正在尝试从比特流中解析字节树。解析是需要设置某种结构的情况之一：我们将以 How to Replace Failure by a List of Successes 的风格编写一个微型解析器组合器库，这将允许我们以惯用的函数式风格编写代码并委托很多工作交给机器。

将 the old rhyme 翻译成 monad 转换器的语言，并将 "string" 读为 "bit-string"，我们有

newtype Parser a = Parser (StateT [Bool] [] a)
    deriving (Functor, Applicative, Monad, Alternative)

runParser :: Parser a -> [Bool] -> [(a, [Bool])]
runParser (Parser m) = runStateT m

解析器是一种单子计算，它在布尔流上有状态地运行，产生成功解析的 a 的集合。 GHC 的 GeneralizedNewtypeDeriving 超能力允许我省略 Monad 等人的样板实例

然后，目标是编写一个 Parser (Tree SevenBits) - 一个解析器，其中 returns 一棵布尔值的七元组树。（您可以在闲暇时通过 deriving a Functor instance 将 Tree 转换为 Word8 并使用 fmap。）我将使用以下 [= 的定义23=] 因为它更简单 - 我相信您可以弄清楚如何根据自己的目的调整此代码。

data Tree a = Leaf a | Node (Tree a) (Tree a) deriving Show

type SevenBits = (Bool, Bool, Bool, Bool, Bool, Bool, Bool)

这是一个解析器，它尝试从输入流中消耗单个位，如果它为空则失败：

one :: Parser Bool
one = Parser $ do
    stream <- get
    case stream of
        [] -> empty
        (x:xs) -> put xs *> return x

这是一个尝试从输入流中消耗特定位，如果不匹配则失败：

bit :: Bool -> Parser ()
bit b = do
    i <- one
    guard (i == b)

在这里，我使用 replicateM 从输入流中提取一个包含七个布尔值的序列，并将它们打包到一个元组中。我们将使用它来填充 Leaf 个节点的内容。

sevenBits :: Parser SevenBits
sevenBits = pack7 <$> replicateM 7 one
    where pack7 [a,b,c,d,e,f,g] = (a, b, c, d, e, f, g)

现在我们终于可以编写解析树结构本身的代码了。我们将使用 <|>.

在 Node 和 Leaf 选项之间进行选择

tree :: Parser (Tree SevenBits)
tree = node <|> leaf
    where node = bit False *> liftA2 Node tree tree
          leaf = bit True *> fmap Leaf sevenBits

如果node成功从流的头部解析低位，它继续递归解析左子树的编码，然后是右子树，将应用操作排序为liftA2.诀窍是 node 如果在输入流的头部没有遇到低位，它会失败，这告诉 <|> 放弃 node 并尝试 leaf相反。

请注意 tree 的结构如何反映 Tree 类型本身的结构。这是工作中的应用程序解析。我们也可以单子地构造这个解析器，首先使用 one 来解析任意位，然后对该位使用 case 分析来确定我们是否应该继续解析一对树或一片叶子。在我看来，这个版本更简单、更明确、更简洁。

还将此代码的清晰度与@behzad.nouri 基于 foldr 的解决方案的低级风格进行比较。我的设计允许您使用 liftA2 和 <|> 等标准函数以声明方式向机器描述语法，而不是构建一个在解析节点和叶子之间切换的显式有限状态机 - 一个命令式的想法并相信抽象会做正确的事。

无论如何，这里我正在解析一个简单的树，该树由一对包含（二进制编码）数字 0 和 1 的 Leaf 组成。如您所见，它 returns 一次成功的解析和一个空的剩余位流。

ghci> runParser tree $ map (>0) [0, 1, 0,0,0,0,0,0,0, 1, 0,0,0,0,0,0,1]
[(Node (Leaf (False, False, False, False, False, False, False)) (Leaf (False, False, False, False, False, False, True)),[])]

Answer 3

好的，这是一个简单的（临时的，但更容易理解）的方法。

我们需要构建一个函数 parse，类型如下：

parse  :: [Int] -> Tree Char

您提到的堆栈方法是势在必行的方法。这里我们只关注递归调用。堆栈将由编译器构建，它只会将每个递归调用存储在其中（至少你可以这样想象，如果你愿意，或者直接忽略这一段）。

因此，思路如下：每当找到 0 时，您需要对算法进行两次递归调用。第一次递归调用将读取树的一个分支（左侧）。第二个需要以列表的其余部分作为参数调用。第一次递归调用留下的其余部分。因此，我们需要一个具有以下类型的辅助函数 parse'（现在我们 return 一对，作为列表的其余部分的第二个值）：

parse' :: [Int] -> (Tree Char, [Int])

接下来可以看到一段代码，其中0的情况和之前描述的一样
对于 1 的情况，我们只需要取接下来的 7 个数字并以某种方式将它们变成一个字符（我将 toChar 的定义留给你），然后，只需 return a Leaf 和列表的其余部分。

parse' (0:xs) = let (l, xs')    = parse' xs
                    (r, xs'')   = parse' xs' in (Node 0 l r, xs'') --xs'' should be []
parse' (1:xs) = let w = toChar (take 7 xs) in (Leaf 0 w , drop 7 xs)

最后，我们的解析函数只调用辅助解析函数和 return 对的第一个元素。

parse xs = fst $ parse' xs

从 Haskell 中的（预序）位串重建哈夫曼树

Reconstructing Huffman tree from (preorder) bitstring in Haskell

haskell

recursion

encoding

tree

huffman-code