続)CLでハフマン木

とりあえず、先程の関数を変更しまして返り値を

• 最終結果
• 途中の各段階のリスト
• ノード間の接続

という3つのリストを返却するようにしました。
そして、そのノード間の接続から、DOTを吐きだすようにしまして、graphvizで視覚化できるように
してみました。

(defun last1 (list)
  (car (reverse list)))

(defun but-last (list)
  (reverse (cdr (reverse list))))

(defun merge-node (node1 node2)
  `(,@(append (but-last node1)
	     (but-last node2))
     ,(+ (last1 node1) (last1 node2))))

(defun merge-nodes (nodes-list)
  (labels ((merge-nodes% (nodes-list acc)
	     (if (null nodes-list)
		 acc
		 (merge-nodes% (cdr nodes-list) (merge-node acc (car nodes-list))))))
    (merge-nodes% (cdr nodes-list) (car nodes-list))))

(defun huffman (list)
  (labels ((huffman% (list acc con-acc)
	     (if (= (length list) 2)
		 (list  list acc  (cons (list (funcall #'merge-nodes list) (cadr list)) (cons (list (funcall #'merge-nodes list) (car list)) con-acc)))
		 (let* ((min1
			 (car (sort (copy-list list) #'< :key #'last1)))
			(rest-list
			 (remove min1 list :test #'equal ))
			(min2
			 (car
			  (sort (copy-list rest-list) #'< :key #'last1)))
			(rest
			 (remove min2 rest-list :test #'equal)))
		   (huffman%
		    (cons (merge-node min1 min2) rest)
		    (cons list acc)
		    (cons (list (merge-node min1 min2) min2) (cons (list (merge-node min1 min2) min1)  con-acc))
		    )))))
    (huffman% list nil nil)))o
(defun node-name (node)
  (format nil "~{~A~^_~}" (but-last node)))

(defun to-dot (graph-name stream con-acc)
  (format stream "graph ~A {~%" graph-name)
  (loop for con in con-acc
       collect
       (format stream "   ~A -- ~A;~%" (node-name (car con)) (node-name (cadr con))))
  (format stream "}~%"))

動作はこんな感じです。

CL-USER> (huffman '((:a 0.1) (:b 0.5) (:c 0.4) (:d 0.1)))
(((:A :D :C 0.6) (:B 0.5))
 (((:A :D 0.2) (:B 0.5) (:C 0.4)) ((:A 0.1) (:B 0.5) (:C 0.4) (:D 0.1)))
 (((:A :D :C :B 1.1) (:B 0.5)) ((:A :D :C :B 1.1) (:A :D :C 0.6))
  ((:A :D :C 0.6) (:C 0.4)) ((:A :D :C 0.6) (:A :D 0.2)) ((:A :D 0.2) (:D 0.1))
  ((:A :D 0.2) (:A 0.1))))

で、

CL-USER> (to-dot "huffman"  t (caddr (huffman '((:a 0.1) (:b 0.5) (:c 0.4) (:d 0.1)))))
graph huffman {
   A_D_C_B -- B;
   A_D_C_B -- A_D_C;
   A_D_C -- C;
   A_D_C -- A_D;
   A_D -- D;
   A_D -- A;
}
NIL

これをdotを利用して出力すると。以下のような感じになります。