Data commit

Task/Huffman-coding/Ol/huffman-coding-1.ol

@@ -0,0 +1,38 @@
+(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)))

Task/Huffman-coding/Ol/huffman-coding-2.ol

@@ -0,0 +1,10 @@
+(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))