0-1ナップサック問題その２（重さWが巨大な場合） in Elisp

プログラミングコンテストチャレンジブック演習「ナップサック問題その２」 - 日々精進にも書いてある、動的計画法の問題。重さの総和Wが非常に大きい場合、重さを変数とする漸化式で n * W のテーブルを作ると計算量の制限を越えてしまうことがある。そういう場合は発想を変えて、価値を変数とする漸化式を考えよう、という話。すると、計算量は

と表されるようになり、巨大な W の値に依存しなくなる。

コード（Elisp）

配列は使わず、メモ化再帰で作る（メモ化の機能は後で付加する）。

solve-with-knapsack*がお膳立てをしてから、再帰的関数knapsack*を実行する。knapsack*が全て実行し終わると、再びsolve-with-knapsack*のほうが結果を整理して、最終的な解を出す。

;; 価値 v を満たす最小の重さを求める関数。
;; 解が無い場合は異常値（999999）を返す。
(defun knapsack* (lst v)
  (cond
   ;; v がゼロでないということは、解なし
   ((null lst) (if (zerop v) 0 999999))
   ;; 品物の価値が大き過ぎる場合
   ((< v (cadar lst)) (knapsack* (cdr lst) v))
   ;; 品物を入れない場合と入れる場合を試し、軽いほうを採用
   (t (min
       (knapsack* (cdr lst) v)
       (+ (caar lst) (knapsack* (cdr lst) (- v (cadar lst))))))))
knapsack*

;;; ちょっと確認
(knapsack* '((10 1) (15 2) (30 3)) 0)
=> 0
(knapsack* '((10 1) (15 2) (30 3)) 3)
=> 25
(knapsack* '((10 1) (15 2) (30 3)) 7)
=> 999999

;;; knapsack* を利用して問題を解く関数
(defun solve-with-knapsack* (lst w)
  (apply 'max                           ;価値が最大のものを選択
         (mapcar 'car                   ;価値だけを抽出
                 (remove-if             ;重過ぎる結果は削除
                  (lambda (x) (> (cdr x) w))
                  (mapcar
                   ;; （0 1 2 ... Sum vi）を満たす重さを求めて、(価値 . 重さ) のドット対にする
                   (lambda (v) (cons v (knapsack* lst v)))
                   ;; 0 から 価値の総和までの数列（0 1 2 ... Sum vi）
                   (loop
                    for i from 0 to (apply '+ (mapcar 'second lst))
                    collect i))))))
=> solve-with-knapsack*

;;; 確認
(solve-with-knapsack* '((50 1) (40 2) (30 3) (20 4) (10 5)) 60)
=> 12

実行時間をざっと調べる

;;; 計測するための関数
(defun profile (func &rest args)
  (let ((start (current-time)))
    (apply func args)
    (time-to-seconds (time-subtract (current-time) start))))
=> profile

;;; 重さと価値のリストを乱数で作り *lst* という変数に入れる
(defun gen-lst (n)
  (setf *lst*
        (loop for i from 1 to n collect (list (random 1000) (random 10)))))
=> gen-lst

;;; リストの要素数 n と実行時間の関係をざっと見る。Wは1000で固定。
;;; まだ再帰的関数をメモ化していないので、 2のn乗で増えていく。
(gen-lst 12)
=> ((801 6) (262 7) (923 5) (131 6) (221 0) (520 5) (221 9) (41 5) (209 6) (743 2) (791 2) (583 0))
(profile 'solve-with-knapsack* *lst* 1000)
=> 0.247282

(gen-lst 13)
=> ((977 2) (756 1) (256 3) (628 9) (743 2) (497 3) (551 0) (101 1) (51 4) (882 6) (181 4) (492 6) (649 4))
(profile 'solve-with-knapsack* *lst* 1000)
=> 0.451455

(gen-lst 14)
=> ((387 5) (154 5) (316 1) (803 0) (330 0) (450 9) (41 1) (257 5) (550 8) (575 6) (988 6) (69 8) (294 2) (330 7))
(profile 'solve-with-knapsack* *lst* 1000)
=> 1.229625

;;; 以下はメモ化した場合。nに対して鈍感になる。
(defun memo (fn name key test)
  "Return a memo-function of fn."
  (lexical-let ((_fn fn) (_key key) (table (make-hash-table :test test)))
    ;(setf (get name 'memo) table)
    #'(lambda (&rest args)
        (let ((k (funcall _key args)))
          (if (gethash k table)
              (gethash k table)
            (setf (gethash k table) (apply _fn args)))))))
=> memo

(defun* memoize (fn-name &key (key #'first) (test #'eql))
  "Replace fn-name's global definition with a memoized version."
  (setf (symbol-function fn-name)
        (memo (symbol-function fn-name) fn-name key test)))
=> memoize

(memoize 'knapsack* :key 'identity :test 'equal)
=> (lambda (&rest --cl-rest--) (apply (lambda (G6503 G6504 G6505 &rest args) (let ... ...)) (quote --table--) (quote --_key--) (quote --_fn--) --cl-rest--))

(gen-lst 14)
=> ((909 9) (234 2) (563 3) (890 8) (520 6) (951 8) (754 4) (810 7) (596 0) (334 1) (876 9) (799 8) (537 8) (735 8))
(profile 'solve-with-knapsack* *lst* 1000)
=> 0.011307

(gen-lst 15)
=> ((557 5) (365 2) (66 2) (794 7) (616 2) (9 1) (237 7) (364 2) (405 6) (976 5) (356 2) (558 7) (224 7) (876 0) (348 6))
(profile 'solve-with-knapsack* *lst* 1000)
=> 0.010048

参考

• Amazon.co.jp： プログラミングコンテストチャレンジブック: 秋葉 拓哉, 岩田 陽一, 北川 宜稔: 本