Huffman coding: Difference between revisions

Content added Content deleted

Inline

@@ Line 4,572: / Line 4,572: @@
 </pre>
 =={{header|Scheme}}==
-{{incorrect|Scheme|... Using the characters and their frequency from the string "this is an example for huffman encoding", ...}}
-{{works with|scala|2.8}}
-<lang scheme>(define (make-leaf symbol weight)
-  (list 'leaf symbol weight))
-(define (leaf? object)
-  (eq? (car object) 'leaf))
-(define (symbol-leaf x) (cadr x))
-(define (weight-leaf x) (caddr x))
-(define (make-code-tree left right)
-  (list left right (append (symbols left) (symbols right)) (+ (weight left) (weight right))))
-(define (left-branch tree) (car tree))
-(define (right-branch tree) (cadr tree))
-(define (symbols tree)
-  (if (leaf? tree) (list (symbol-leaf tree)) (caddr tree)))
-(define (weight tree)
-  (if (leaf? tree) (weight-leaf tree) (cadddr tree)))
-(define (decode bits tree)
+<lang scheme>(define (char-freq port table)
+  (if
-  (define (choose-branch bit branch)
-    (cond ((= bit 0) (left-branch branch))
+   (eof-object? (peek-char port))
+   table
-          ((= bit 1) (right-branch branch))
-          (else (error "R u kidding?" bit))))
+   (char-freq port (add-char (read-char port) table))))
-  (define (decode-1 bits current-branch)
-    (if (null? bits)
-        '()
-        (let ((next-branch
-               (choose-branch (car bits) current-branch)))
-          (if (leaf? next-branch)
-              (cons (symbol-leaf next-branch) (decode-1 (cdr bits) tree))
-              (decode-1 (cdr bits) next-branch)))))
-  (decode-1 bits tree))
-(define (make-leaf-set pairs)
+(define (add-char char table)
+  (cond
-  (define (adjoin-set x set)
-   (cond ((null? set) (list x))
+   ((null? table) (list (list char 1)))
-         ((< (weight x) (weight (car set))) (cons x set))
+   ((eq? (caar table) char) (cons (list char (+ (cadar table) 1)) (cdr table)))
-         (else (cons (car set) (adjoin-set x (cdr set))))))
+   (#t (cons (car table) (add-char char (cdr table))))))
-  (if (null? pairs) '() (let ((pair (car pairs)))
-                          (adjoin-set (make-leaf (car pair) (cadr pair)) (make-leaf-set (cdr pairs))))))
+(define (nodeify table)
-(define dictionary (list (list 'A 4) (list 'B 2) (list 'C 1)(list 'D 1)))
+  (map (lambda (x) (list x '() '())) table))
-(define bit (list 0 1 1 0 1 1 0 1 1 0 0 0 1 1 0 1))
-(decode z (make-leaf-set dictionary))
+(define node-freq cadar)
-</lang>
+(define (huffman-tree nodes)
+  (let ((queue (sort nodes (lambda (x y) (< (node-freq x) (node-freq y))))))
+    (if
+     (null? (cdr queue))
+     (car queue)
+     (huffman-tree
+      (cons
+       (list
+        (list 'notleaf (+ (node-freq (car queue)) (node-freq (cadr queue))))
+        (car queue)
+        (cadr queue))
+       (cddr queue))))))
+(define (list-encodings tree chars)
+  (for-each (lambda (c) (format #t "~a:~a~%" c (encode c tree))) chars))
+(define (encode char tree)
+  (cond
+   ((null? tree) #f)
+   ((eq? (caar tree) char) '())
+   (#t
+    (let ((left (encode char (cadr tree))) (right (encode char (caddr tree))))
+      (cond
+       ((not (or left right)) #f)
+       (left (cons #\1 left))
+       (right (cons #\0 right)))))))
+(define (decode digits tree)
+  (cond
+   ((not (eq? (caar tree) 'notleaf)) (caar tree))
+   ((eq? (car digits) #\0) (decode (cdr digits) (cadr tree)))
+   (#t (decode (cdr digits) (caddr tree)))))
+(define input "this is an example for huffman encoding")
+(define freq-table (char-freq (open-input-string input) '()))
+(define tree (huffman-tree (nodeify freq-table)))
+(list-encodings tree (map car freq-table))</lang>
 Output:
 <pre>
+t:(1 0 0 1 1)
-z:
+h:(1 0 0 0)
-((leaf d 1) (leaf c 1) (leaf b 2) (leaf a 4))
-(decode bit z):
+i:(0 0 1 1)
+s:(1 0 1 1)
-(d c c d c c d c c d d d c c d c)
+ :(0 0 0)
+a:(0 0 1 0)
+n:(1 1 0)
+e:(0 1 0 1)
+x:(1 0 0 1 0)
+m:(1 0 1 0)
+p:(1 1 1 0 1)
+l:(1 1 1 0 0)
+f:(0 1 0 0)
+o:(0 1 1 1)
+r:(1 1 1 1 1)
+u:(1 1 1 1 0)
+c:(0 1 1 0 0 1)
+d:(0 1 1 0 0 0)
+g:(0 1 1 0 1)
 </pre>