haskell - 在 Haskell 中使用最小堆构建 Huffman 树

Question

我对此有很大的问题。我不知道如何制作霍夫曼树，因为它是自下而上构建的（从谎言到根）。

我是 Haskell 和函数式编程的新手。我看到还有其他类似的帖子，但它们对我没有帮助。

这是我的代码

    import Data.Map

type Value = Int
type Key = [Char]
type NodeValue = (Key,Value)

data Heap_ a = Empty
        | Node a (Heap_ a) (Heap_ a)
        deriving(Show, Eq)

type Heap a = Heap_ NodeValue

frequencyOfCharacters :: [Char] -> Map Key Value
frequencyOfCharacters [] = Data.Map.empty
frequencyOfCharacters (character:text) = insertWith (+) [character] 1 (frequencyOfCharacters text)

makeLeaf :: NodeValue -> Heap a
makeLeaf a = Node a Empty Empty

mergeHeaps :: Heap a -> Heap a -> Heap a
mergeHeaps Empty rightHeap = rightHeap
mergeHeaps leftHeap Empty = leftHeap
mergeHeaps leftHeap@(Node a lefta righta) rightHeap@(Node b leftb rightb)
    | snd a < snd b = Node a (mergeHeaps lefta rightHeap) righta
    | otherwise = Node b leftb (mergeHeaps leftHeap rightb)

addToHeap :: Heap a->NodeValue->Heap a
addToHeap Empty a =  makeLeaf a
addToHeap h a = mergeHeaps h (makeLeaf a)


takeHeadFromHeap :: Heap a -> (NodeValue,Heap a)
takeHeadFromHeap Empty = (("",-1), Empty)
takeHeadFromHeap (Node a leftBranch rightBranch) = (a, mergeHeaps leftBranch rightBranch)

makeHeap :: Map Key Value -> Heap a
makeHeap map_ = makeHeap_ $ toList map_

makeHeap_ :: [(Key,Value)] -> Heap a
makeHeap_ [] = Empty
makeHeap_ (x:xs) = addToHeap (makeHeap_ xs) x


huffmanEntry :: [Char]-> Heap a
huffmanEntry text = makeHeap $ frequencyOfCharacters text

我正在考虑霍夫曼树的这种数据结构

data HuffmanTree h = Leaf [Char]
                   | NodeHuff [Char] (HuffmanTree h) (HuffmanTree h)
                   deriving(Show, Eq)

但我不知道如何从最小堆中制作霍夫曼树。

在 ghci min heap 中的这行代码由输入字符串组成之后

 *Main> huffmanEntry "Aasdqweqweasd"

标签： haskellheaphuffman-code

Answer 1

你需要用最小堆制作一棵霍夫曼树，你说“我不知道如何从最小堆制作霍夫曼树”。在开始编码之前，让我们弄清楚您需要做什么，尤其是在您可能不熟悉的语言中。

我想我们应该在互联网上寻找一种制作霍夫曼树的方法。关于霍夫曼编码的维基百科页面怎么样？（https://en.wikipedia.org/wiki/Huffman_coding）

最简单的构造算法使用优先级队列，其中概率最低的节点被赋予最高优先级：

1. 为每个符号创建一个叶节点并将其添加到优先级队列中。
2. 当队列中有多个节点时：
   • 从队列中移除最高优先级（最低概率）的两个节点
   • 创建一个新的内部节点，将这两个节点作为子节点，概率等于两个节点概率之和。
   • 将新节点添加到队列中。
3. 剩下的节点是根节点，树是完整的。

您已经有了代码来查找给定字符串中每个符号的频率 - 这就是您的frequencyOfCharacters功能。

您现在只需要一个优先队列！您绝对可以找到一种使用最小堆实现优先级队列的方法。

我希望这可以帮助您将逻辑拼凑在一起。

如果您想逐步解决问题，为什么不尝试使用优先级队列的有效实现来制作霍夫曼树（http://hackage.haskell.org/package/PSQueue） ?

完成此操作后，您可以尝试使用最小堆的工作实现（http://hackage.haskell.org/package/heap）将这个现成的模块替换为您自己的小型队列模块。

最后，您可以自己编写一个准系统最小堆模块（您已经有很多代码）并用它替换外部堆模块。

更新：关于如何构建树的一些更具体的建议。这需要一些设置，所以请多多包涵。假设您有一个Tree.hs允许您使用二叉树的模块：

module Tree where

-- Binary Tree
data Tree k v =
    Empty
  | Node (k, v) (Tree k v) (Tree k v)
    deriving ( Show )

-- takes a (key, value) pair and returns a binary tree
-- containing one node with that pair
singleton :: (k, v) -> Tree k v
singleton = undefined

-- takes three things: a (key, value) pair, a binary tree t1
-- and another binary tree t2
-- then it constructs the tree
--    (key, val)
--   /         \
-- t1           t2
joinWith :: (k, v) -> Tree k v -> Tree k v -> Tree k v
joinWith = undefined

-- returns the value associated with the (key, value) pair
-- stored in the root node of the binary tree
value :: Tree k v -> v
value = undefined

你还有一个Queue.hs模块可以让你使用优先级队列（我假设你有一个工作的最小堆模块）

module Queue where

import Heap

-- a priority queue
type Queue k v = Heap k v

-- returns an empty queue
empty :: (Ord v)  => Queue k v
empty = undefined

-- adds a (key, value) pair to the queue and returns a
-- new copy of the queue containing the inserted pair
enqueue :: (Ord v) => (k, v) -> Queue k v -> Queue k v
enqueue = undefined

-- removes the lowest-value (key, value) pair from the queue
-- and returns a tuple consisting of the removed pair
-- and a copy of the queue with the pair removed
dequeue :: (Ord v) => Queue k v -> ((k, v), Queue k v)
dequeue = undefined

-- returns the number of elements in the queue
size :: (Ord v) => Queue k v -> Int
size = undefined

那么这就是您可以尝试使用您可以Huffman.hs使用的工具制作模块的方式。

module Huffman where

import Queue
import Tree

type HuffmanTree = Tree Char Int

-- takes a list of (character, frequency) pairs and turns them into
-- a Huffman Tree
makeHuffmanTree :: [(Char, Int)] -> HuffmanTree
makeHuffmanTree pairs = let
  nodeList = map (\pair -> (singleton pair, snd pair)) pairs
  nodeQueue = foldr enqueue empty nodeList
    in
  reduceNodes nodeQueue

-- takes pairs of nodes from the queue and combines them
-- till only one node containing the full Huffman Tree is
-- present in the queue
-- then this last node is dequeued and returned
reduceNodes :: Queue HuffmanTree Int -> HuffmanTree
reduceNodes q
  | size q == 0 = error "no nodes!" 
  | size q == 1 = fst (fst (dequeue q))
  | otherwise   = let
      ((tree1, freq1), q') = dequeue q
      ((tree2, freq2), q'') = dequeue q'
      freqSum = freq1 + freq2
      newTree = joinWith ('.', freqSum) tree1 tree2
        in
      reduceNodes (enqueue (newTree, freqSum) q'')

由于类型检出，我成功地用这些模块编译了一个堆栈项目。当你认为你有你想要的 Huffman 树构建代码时，你可以undefined用它们实际应该做的来填充函数，你很好！