; #Ol

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

; prepare initial probabilities table
(define table (ff->alist
   (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  
(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)))

; debug print:
; --------------------------------------------
(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))

 #Ol
 prepare initial probabilities table
 just sorter...
 ...to sort table
 huffman codes
 debug print:
 --------------------------------------------

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

(define table (ff->alist
   (fold (lambda (ff x)
            (put ff x (+ (ff x 0) 1)))
      {}
      (string->runes phrase))))

(define (resort l)
   (sort (lambda (x y) (< (cdr x) (cdr y))) l))
(define table (resort table))

  build  
(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)))))))

(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)))

(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))
