CLでハフマン木

寝起きにはプログラミングが一番！というわけで、とりあえず起きてから寝むたかったので
眠けをさますために5分くらいで片手間に書いてみました。

(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 huffman (list)
  (labels ((huffman% (list acc)
	     (if (= (length list) 2)
		 (cons  list 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))))))
    (huffman% list nil)))

眠たいまま書いているので、ほとんど適当です。minをとってremoveしてとやっているところが冗長ですね。どうにかしたいところです。
こんな感じになります。

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

リストで、最終結果を先頭に各段階が帰ってきます。このデータを元にgraphvizなどに流してやると
木を視覚化する事もできるとおもいます。