Huffman coding: Difference between revisions

=={{header|Ol}}==

<lang scheme>

(define phrase "this is an example for huffman encoding")

; prepare initial probabilities table

(define table (ff->list

(fold (lambda (ff x)

(put ff x (+ (ff x 0) 1)))

{}

(string->runes phrase))))

; just sorter...

(define (resort l)

(sort (lambda (x y) (< (cdr x) (cdr y))) l))

; ...to sort table

(define table (resort table))

; build huffman tree

(define tree

(let loop ((table table))

(if (null? (cdr table))

(car table)

(loop (resort (cons

(cons

{ 1 (car table) 0 (cadr table)}

(+ (cdar table) (cdadr table)))

(cddr table)))))))

; huffman codes

(define codes

(map (lambda (i)

(call/cc (lambda (return)

(let loop ((prefix #null) (tree tree))

(if (ff? (car tree))

(begin

(loop (cons 0 prefix) ((car tree) 0))

(loop (cons 1 prefix) ((car tree) 1)))

(if (eq? (car tree) i)

(return (reverse prefix))))))))

(map car table)))

</lang>

{{Out}}

<lang scheme>

(print "weights: ---------------------------")

(for-each (lambda (ch)

(print (string (car ch)) ": " (cdr ch)))

(reverse table))

(print "codes: -----------------------------")

(map (lambda (char code)

(print (string char) ": " code))

(reverse (map car table))

(reverse codes))

</lang>

<pre>

weights: ---------------------------

: 6

n: 4

i: 3

f: 3

e: 3

a: 3

s: 2

o: 2

m: 2

h: 2

x: 1

u: 1

t: 1

r: 1

p: 1

l: 1

g: 1

d: 1

c: 1

codes: -----------------------------

: (0 0 0)

n: (1 1 0)

i: (0 1 0 0)

f: (0 1 0 1)

e: (0 0 1 0)

a: (0 0 1 1)

s: (0 1 1 1)

o: (1 0 1 0)

m: (1 0 1 1)

h: (1 0 0 0)

x: (0 1 1 0 1)

u: (0 1 1 0 0 0)

t: (0 1 1 0 0 1)

r: (1 1 1 1 0)

p: (1 1 1 1 1)

l: (1 1 1 0 0)

g: (1 1 1 0 1)

d: (1 0 0 1 0)

c: (1 0 0 1 1)

</pre>