Building Huffman tree using min-heap in Haskell

Question

I am having a huge problem with this. I don't have any idea how to make Huffman tree since it is being built bottom-up (from the liefs to the root).

I am new to Haskell and functional programming. I have seen there are other posts similar to mine, but they did not help me.

This is my code

    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

I am thinking about this data structure for Huffman tree

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

but i have no idea how to make Huffman tree from min heap.

After this line of code in ghci min heap is made from input string

 *Main> huffmanEntry "Aasdqweqweasd"

Answer 1

You need to make a Huffman Tree with a min heap, and you said "I have no idea how to make Huffman Tree from min heap". Let's figure out what you need to do before you start coding, especially in a language that you might not be familiar with.

I suppose we should check the internet for a way to make a Huffman Tree. How about the Wikipedia page on Huffman Coding? (https://en.wikipedia.org/wiki/Huffman_coding)

The simplest construction algorithm uses a priority queue where the node with lowest probability is given highest priority:

1. Create a leaf node for each symbol and add it to the priority queue.
2. While there is more than one node in the queue:
   • Remove the two nodes of highest priority (lowest probability) from the queue
   • Create a new internal node with these two nodes as children and with probability equal to the sum of the two nodes' probabilities.
   • Add the new node to the queue.
3. The remaining node is the root node and the tree is complete.

You already have code in place to find the frequency of each symbol in a given string - that's your frequencyOfCharacters function.

All you need now is a priority queue! You can definitely find a way to implement a priority queue using a min heap.

I hope this helps you piece the logic together.

If you want to deal with the problem step-by-step, why don't you start by trying to make a Huffman Tree using a working implementation of a priority queue (http://hackage.haskell.org/package/PSQueue)?

Once you're done with that, you can try to replace this readymade module with a small queue module of your own using a working implementation of a min heap (http://hackage.haskell.org/package/heap).

Finally, you can write a barebones min heap module by yourself (you have a lot of the code already) and replace the external heap module with that.

Update: Some more concrete suggestions on how to build the tree. This requires a little setup, so please bear with me. Suppose you have a Tree.hs module that allows you to work with binary trees:

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

and you also have a Queue.hs module which lets you work with priority queues (I'm assuming you have a working min-heap module)

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

Then this is how you might try to make a Huffman.hs module using the tools at your disposal.

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

Since the types check out, I successfully compiled a stack project with these modules. When you think you have the Huffman Tree-building code you want, you can just fill in the undefined functions with what they're actually supposed to do and you're good!