ナップサック問題とメモ化 in Elisp

有名なナップサック問題を Emacs Lisp で勉強である。

ナップサック問題とは「重さと価値がそれぞれ w_i, v_i, である品物から、重さの総和が W を超えないように選んだときの、価値の総和の最大値を求める」問題である。

素朴なバージョン

価値の最大値を求める関数を作る。入力は ((w₁, v₁) (w₂, v₂) ... (w_n, v_n)) なる形のリストと、総和 W の2つ。

(defun knapsack (lst w)
  (cond 
   ((null lst) 0)
   (t (if (> (caar lst) w) ;先頭の品物が入らない場合
          (knapsack (cdr lst) w)
        (max  ;入れる場合と入れない場合を両方とも試し、良い結果のほうを選ぶ
         (+ (cadar lst) (knapsack (cdr lst) (- w (caar lst))))
         (knapsack (cdr lst) w))))))
;; 確認
(knapsack '((10 7) (4 2) (5 9) (1 4) (7 9) (3 7) (6 4) (3 5)) 20)
=> 34

n個の品物それぞれについて、入れる／入れないの二通りを計算する考え方であり、最大計算量は O(2ⁿ) となる。

※確認には ナップサック問題とは？ に載っている例を使っている。

※Emacs のバージョンは GNU Emacs 22.3.1

メモ化（memoization）を行うバージョン

上の関数 knapsack が再帰的に実行されるときの引数を分析すると、第一引数は長さnのリストから先頭の要素が一つずつ取り去られていくので合計 n種類になる。また、第二引数は初期値 W から何らかの整数を引いた値であるから、最大で W - 1 から 0 までの整数の数、つまりW種類になる。

第一引数が n 通りで第二引数が W 通りなので、引数の場合の数は結局のところ n * W 通り。メモ化を利用して n * W程度の領域に結果を保存すれば、最大計算量を 2ⁿ から n * W のオーダーに減らすことができるわけである。

次に、具体的にどうやってメモ化を行うかを考える。素朴な方法は、グローバル変数としてハッシュテーブルを定義しておき、knapsackの中でそれを参照するというもの。しかし、この方法は関数をグローバル変数に依存した形に書き換えなければならず、再利用やコピペがしにくくなる。

そこで、もう少し独立性を保てるよう、Yコンビネータを利用した方法を使う。この方法については、 さあ、Yコンビネータ(不動点演算子)を使おう！ - よくわかりません を参考に、YコンビネータのコードはY combinator - Rosetta Code の中のCommon Lispバージョンを参考にするとよい（Elispでも動くように let ではなく lexical-let を使った形に書き換えるなどする）。

;; メモ化機能を組み込んだ Y です
(defun Y (f)
  (lexical-let ((_f f) (cache (make-hash-table :test #'equal)))
    ((lambda (x) (funcall x x))
     (lambda (y)
       (lexical-let ((_y y))
         (funcall _f (lambda (&rest args)
                       (if (gethash args cache)
                           (gethash args cache)
                         (setf (gethash args cache)
                               (apply (funcall _y _y) args))))))))))

;; Yコンビネータ向けに、ラムダ式を返す形
(defun knapsack-memo (f)
  (lexical-let ((_f f))
    (lambda (lst w)
      (cond 
       ((null lst) 0)
       (t (if (> (caar lst) w)
              (funcall _f (cdr lst) w)
            (max
             (+ (cadar lst) (funcall _f (cdr lst) (- w (caar lst))))
             (funcall _f (cdr lst) w))))))))

;; 確認
(funcall
 (Y 'knapsack-memo)
 '((10 7) (4 2) (5 9) (1 4) (7 9) (3 7) (6 4) (3 5)) 20)
=> 34

以下は、計算時間を比較した例。

;; 時間をざっと計る関数
(defun profile (func &rest args)
  (let ((start (current-time)))
    (apply func args)
    (time-to-seconds (time-subtract (current-time) start))))
=> profile

;; 重さと価値のリスト
(setq *w-v-list* '((10 7) (4 2) (5 9) (1 4) (7 9) (3 7) (6 4) (3 5) (3 5) (5 3) (1 2) (3 4) (1 5) (2 2) (4 5) (2 2) (4 5) (3 9) (1 5)))
=> ((10 7) (4 2) (5 9) (1 4) (7 9) (3 7) (6 4) (3 5) (3 5) (5 3) (1 2) (3 4) ...)

;; 素朴なバージョンは約 0.43 秒
(profile 'knapsack *w-v-list* 30)
=> 0.438918

;; メモ化バージョンは約 0.06 秒
(profile (Y 'knapsack-memo)  *w-v-list* 30)
=> 0.063991

n をもっと増やすと劇的に差が出るはず。ちなみに手軽に時間を計る関数は実行時間の測定 どう書く？org から流用したもの。