Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
71 lines (58 sloc) 1.97 KB
;;; Huffman encoding
(ns huffman
(:use clojure.contrib.seq-utils))
(defn- sort-by-second [a b]
(< (second a)(second b)))
(defn node-sum [a b]
[\* (+ (second a) (second b))])
(defn tree-node [a b]
(list (node-sum (first a) (first b)) a b))
(defn add-to-queue
"Insert a new node, n, into an ordered list open"
[n open]
(if (nil? open)
(list n)
(let [nval (second (first n))
oval (second (first (first open)))]
(if (>= nval oval)
(lazy-cons (first open) (add-to-queue n (rest open)))
(lazy-cons n open)))))
; 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:
; 1. Remove the node of highest priority (lowest probability) twice to get two nodes.
; 2. Create a new internal node with these two nodes as children and with probability equal to the sum of the two nodes' probabilities.
; 3. Add the new node to the queue.
; 3. The remaining node is the root node and the tree is complete.
(defn coding-tree
"Given an ordered frequency list, create an encoding tree"
(if (> (count open) 1)
(let [new-node (apply tree-node (take 2 open))]
(recur (add-to-queue new-node (drop 2 open))))
(first open)))
(defn left-node [tree]
(second tree))
(defn right-node [tree]
(if (= (count tree) 3)
(nth tree 2)
(defn- lookup-helper
[tree path]
(if (nil? tree)
(let [v (first (first tree))]
(lazy-cat (if (= v \*) nil (list [v path] ))
(lookup-helper (left-node tree) (cons 0 path))
(lookup-helper (right-node tree) (cons 1 path))))))
(defn lookup
(into {} (lookup-helper tree nil)))
(defn huffman-coding-table
"Huffman encode the given sequence and return the huffman coding tree"
(let [fl (map list (sort sort-by-second (map (fn [x] [(first x) (second x)]) (frequencies s))))]
(lookup (coding-tree fl))))
(defn compress
[s table]
(mapcat (partial get table) s))