Jump to content

Huffman coding: Difference between revisions

Huffman coding (view source)

Revision as of 04:55, 29 August 2014

34 bytes removed ,  9 years ago
wrote code using example described
(→‎{{header|Scheme}}: Marked incorrect.)
(wrote code using example described)
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)))
 
<lang scheme>(define (decodechar-freq bitsport treetable)
(if
(define (choose-branch bit branch)
(cond ((= bit 0)eof-object? (leftpeek-branchchar branchport))
table
((= bit 1) (right-branch branch))▼
(char-freq port (elseadd-char (errorread-char "Rport) u kidding?" bittable))))
(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 (makeadd-leaf-setchar char pairstable)
(cond
(define (adjoin-set x set)
(cond ((null? settable) (list x(list char 1)))
((eq? (caar table) char) ((<cons (weightlist x)char (weight+ (carcadar settable) 1)) (conscdr x settable)))
(else#t (cons (car settable) (adjoinadd-setchar xchar (cdr settable))))))
(if (null? pairs) '() (let ((pair (car pairs)))
(adjoin-set (make-leaf (car pair) (cadr pair)) (make-leaf-set (cdr pairs))))))
 
▲(define (leaf?nodeify objecttable)
(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 (make-codehuffman-tree left rightnodes)
(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 (weightlist-encodings tree chars)
(for-each (lambda (c) (format #t "~a:~a~%" c (encode c tree))) chars))
 
▲(define (left-branchencode tree) (carchar tree))
(cond
▲ (if (null? bitstree) #f)
▲ ((eq? (carcaar objecttree) char) 'leaf())
(#t
(let ((left (encode char (cadr tree))) (right (encode char (caddr tree))))
(cond
▲ ((=not bit(or 1)left (right-branch)) branch)#f)
(left (cons #\1 left))
(right (cons #\0 right)))))))
 
▲(define (symbolsdecode digits tree)
(cond
((not (eq? (caar tree) 'notleaf)) (caar tree))
((eq? (car digits) #\0) (decode (cdr digits) (cadr tree)))
▲ (#t (decode-1 (cdr bitsdigits) next-branch(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))
i:(decode0 bit0 z1 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>
 
Anonymous user
Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/105068"
Cookies help us deliver our services. By using our services, you agree to our use of cookies.
More information