Another update from ingydotnet^djgoku

Task/Huffman-coding/Clojure/huffman-coding-1.clj

@@ -1,7 +1,7 @@
-(use 'clojure.contrib.seq-utils)
+(require '[clojure.pprint :refer :all])
 
-(defn probs [items]
-  (let [freqs (frequencies items) sum (reduce + (vals freqs))]
+(defn probs [s]
+  (let [freqs (frequencies s) sum (apply + (vals freqs))]
     (into {} (map (fn [[k v]] [k (/ v sum)]) freqs))))
 
 (defn init-pq [weighted-items]
@@ -13,24 +13,22 @@
 
 (defn huffman-tree [pq]
   (while (> (.size pq) 1)
-    (let [a (.poll pq) b (.poll pq) new-node { :priority (+ (:priority a) (:priority b)), :left a, :right b }]
+    (let [a (.poll pq) b (.poll pq)
+	  new-node {:priority (+ (:priority a) (:priority b)) :left a :right b}]
       (.add pq new-node)))
   (.poll pq))
 
 (defn symbol-map
-  ([t] (into {} (symbol-map t [])))
-  ([{:keys [symbol,left,right] :as t} code]
-    (if symbol [[symbol code]]
-      (concat (symbol-map left (conj code 0))
-              (symbol-map right (conj code 1))))))
+  ([t] (symbol-map t ""))
+  ([{:keys [symbol priority left right] :as t} code]
+    (if symbol [{:symbol symbol :weight priority :code code}]
+      (concat (symbol-map left (str code \0))
+              (symbol-map right (str code \1))))))
 
 (defn huffman-encode [items]
   (-> items probs init-pq huffman-tree symbol-map))
 
 (defn display-huffman-encode [s]
-  (println "SYMBOL\tWEIGHT\tHUFFMAN CODE")
-  (let [probs (probs (seq s))]
-    (doseq [[char code] (huffman-encode (seq s))]
-      (printf "%s:\t\t%s\t\t%s\n" char (probs char) (apply str code)))))
+  (->> s huffman-encode (sort-by :weight >) print-table))
 
 (display-huffman-encode "this is an example for huffman encoding")

Task/Huffman-coding/Clojure/huffman-coding-2.clj

@@ -0,0 +1,38 @@
+(require '[clojure.data.priority-map :refer [priority-map-keyfn-by]])
+(require '[clojure.pprint :refer [print-table]])
+
+(defn init-pq [s]
+  (let [c (count s)]
+    (->> s frequencies
+	(map (fn [[k v]] [k {:sym k :weight (/ v c)}]))
+	(into (priority-map-keyfn-by :weight <)))))
+
+(defn huffman-tree [pq]
+  (letfn [(build-step
+	   [pq]
+	   (let [a (second (peek pq)) b (second (peek (pop pq)))
+		 nn {:sym (str (:sym a) (:sym b))
+		     :weight (+ (:weight a) (:weight b))
+		     :left a :right b}]
+	     (assoc (pop (pop pq)) (:sym nn) nn)))]
+    (->> (iterate build-step pq)
+	 (drop-while #(> (count %) 1))
+	 first vals first)))
+
+(defn symbol-map [m]
+  (letfn [(sym-step
+	   [{:keys [sym weight left right] :as m} code]
+	   (cond (and left right) #(vector (trampoline sym-step left (str code \0))
+					   (trampoline sym-step right (str code \1)))
+		 left #(sym-step left (str code \0))
+		 right #(sym-step right (str code \1))
+		 :else {:sym sym :weight weight :code code}))]
+    (trampoline sym-step m "")))
+
+(defn huffman-encode [s]
+  (->> s init-pq huffman-tree symbol-map flatten))
+
+(defn display-huffman-encode [s]
+  (->> s huffman-encode (sort-by :weight >) print-table))
+
+(display-huffman-encode "this is an example for huffman encoding")

Task/Huffman-coding/OCaml/huffman-coding.ocaml

@@ -13,7 +13,7 @@ module HSet = Set.Make
    end);;
 
 let build_tree charFreqs =
-  let leaves = List.fold_left (fun z (c,f) -> HSet.add (f, Leaf c) z) HSet.empty charFreqs in
+  let leaves = HSet.of_list (List.map (fun (c,f) -> (f, Leaf c)) charFreqs) in
   let rec aux trees =
     let f1, a = HSet.min_elt trees in
     let trees' = HSet.remove (f1,a) trees in

Task/Huffman-coding/Perl-6/huffman-coding-1.pl6

@@ -3,7 +3,7 @@ sub huffman ($s) {
     my @q = $s.comb.classify({$_}).map({[+.value / $de, .key]}).sort;
     while @q > 1 {
 	my ($a,$b) = @q.splice(0,2);
-	@q = sort [$a[0] + $b[0], [$a[1], $b[1]]], @q;
+	@q = sort flat $[$a[0] + $b[0], [$a[1], $b[1]]], @q;
     }
     sort *.value, gather walk @q[0][1], '';
 }

Task/Huffman-coding/Perl-6/huffman-coding-2.pl6

@@ -5,5 +5,5 @@ say $str;
 my $huf = %enc{$str.comb}.join;
 say $huf;
 my $rx = join('|', map { "'" ~ .key ~ "'" }, %dec);
-$rx = eval '/' ~ $rx ~ '/';
+$rx = EVAL '/' ~ $rx ~ '/';
 say $huf.subst(/<$rx>/, -> $/ {%dec{~$/}}, :g);

Task/Huffman-coding/Racket/huffman-coding.rkt

@@ -14,19 +14,11 @@
 (define (node<=? x y)
   (<= (node-freq x) (node-freq y)))
 
-;; We keep a private sentinel-val under our own control.
-(define sentinel-val (cons 'sentinel 'sentinel))
-
 ;; make-huffman-tree: (listof leaf) -> interior-node
-;; Makes the huffman tree with basic priority-queue operations.
-;; Note: we ensure that make-huffman-tree always returns an interior node.
 (define (make-huffman-tree leaves)
   (define a-heap (make-heap node<=?))
   (heap-add-all! a-heap leaves)
-  ;; To ensure that we always get tree with at least one interior node,
-  ;; we also inject a sentinel leaf node with zero frequency.
-  (heap-add! a-heap (leaf 0 sentinel-val))
-  (for ([i (in-range (length leaves))])
+  (for ([i (sub1 (length leaves))])
     (define min-1 (heap-min a-heap))
     (heap-remove-min! a-heap)
     (define min-2 (heap-min a-heap))
@@ -42,7 +34,7 @@
   (define ht (make-hash))
   (define n (sequence-length str))
   (for ([ch str])
-    (hash-set! ht ch (add1 (hash-ref ht ch 0))))
+     (hash-update! ht ch add1 (λ () 0)))
   (make-huffman-tree
    (for/list ([(k v) (in-hash ht)])
      (leaf (/ v n) k))))
@@ -65,8 +57,8 @@
        (loop (interior-left a-node) (cons #f path/rev))
        (loop (interior-right a-node) (cons #t path/rev))]
       [(leaf? a-node)
-       (unless (eq? (leaf-val a-node) sentinel-val)
-         (hash-set! ht (reverse path/rev) (leaf-val a-node)))]))
+        (hash-set! ht (reverse path/rev) (leaf-val a-node))]))
+
   (for/hash ([(k v) ht])
     (values v k)))