こんな問題が出ました。

• 3つのコップがあります。容積はそれぞれ16,9,7
• 容積16のコップには水が一杯で、容積9と7のコップは空です
• コップ間で水を移動して、容積16と9にそれぞれ8ずつになるようにしなさい
• コップ間の水の移動は、移動先が一杯になるか、移動元が空になる単位でのみ可能です

言葉では冗長なので、少し形式化します。

容積Nのコップに水量nがある状態を、(n/N)と表現すると、

(16/16) (0/9) (0/7)
が初期状態で、
(8/16) (8/9) (0/7)
がゴールです。

遷移の具体例
(16/16) (0/9) (0/7)
から一回で遷移できる状態は、
(7/16) (9/9) (0/7)  と  (9/16) (0/9) (7/7)
のふたつです。

自分で解くのは簡単すぎるので、Emacsにやらせます。

(defun get-transitions (bins)
  (list (trans bins 0 1) (trans bins 0 2) (trans bins 1 0) (trans bins 1 2) (trans bins 2 0) (trans bins 2 1)))

(defun trans (bins src-pos dest-pos)
  (let ((src (nth src-pos bins)) (dest (nth dest-pos bins)))
    (if (and (> (cdr src) 0) (> (car dest) (cdr dest)))
        (let* ((bins-dup (copy-alist bins)) 
               (move (min (cdr src) (- (car dest) (cdr dest))))
               (src-on-dup (nth src-pos bins-dup)) (dest-on-dup (nth dest-pos bins-dup)))
          (setcdr src-on-dup (- (cdr src-on-dup) move))
          (setcdr dest-on-dup (+ (cdr dest-on-dup) move))
          bins-dup)
      bins)))

(defun my-search (bins goal history route output-buf)
  (if (equal bins goal)
      (print-route (reverse (cons bins route)) output-buf)
    (if (not (member bins history))
        (progn 
          (setq history (cons bins history))
          (setq route (cons bins route))
          (let ((trans-lst (get-transitions bins)))
            (while trans-lst
              (my-search (car trans-lst) goal history route output-buf)
              (setq trans-lst (cdr trans-lst))))
          (setq route (cdr route))))))

(defun print-bins (bins buf &optional indent msg)
  (with-current-buffer buf
    (goto-char (point-max))
    (if (and (boundp 'msg) msg)
        (insert msg))
    (if (and (boundp 'indent) indent)
        (insert (make-string indent ?\040)))
    (insert (number-to-string (cdr (nth 0 bins))) " " (number-to-string (cdr (nth 1 bins))) " " (number-to-string (cdr (nth 2 bins))) "\n")))
 
(defun print-route (route buf)
  (with-current-buffer buf
    (goto-char (point-max))
    (insert "Route ")
    (insert (number-to-string (length route)))
    (insert "\n")
    (while route
      (print-bins (car route) buf)
      (setq route (cdr route)))))

出力系の処理が半分近くありますが(後者ふたつの関数)、本質では無いので無視してください。

問題は次のようにして解けます(出力用バッファ#outを指定)。

(let ((output-buf (get-buffer-create "#out")))
  (my-search '((16 . 16) (9 . 0) (7 . 0)) '((16 . 8) (9 . 8) (7 . 0)) nil nil output-buf)
  (switch-to-buffer-other-window output-buf))

最小パスは次のようになりました(16はパスの長さ。遷移回数は15回)。

Route 16
16 0 0
7 9 0
7 2 7
14 2 0
14 0 2
5 9 2
5 4 7
12 4 0
12 0 4
3 9 4
3 6 7
10 6 0
10 0 6
1 9 6
1 8 7
8 8 0

my-searchがメイン関数で、get-transitionsが下請け関数、transが更にその下請け関数です。

使い方を見てデータ構造の予想はついていると思いますが、(16/16) (0/9) (0/7)を((16 . 16) (0 . 9) (0 . 7))で表しています(=連想リストを要素にもつリスト)。

trans関数の実装がうまくありません。破壊的操作(setcdr)もしていますし、冗長なわりに読みやすくもありません。そもそも、本当にやりたいことはget-transitions関数で、現在の状態から一回で遷移可能な状態のリストを返すことです。0 1や0 2などのハードコードを無くせそうな気がします(副次的にtransも無くなる)。それは堀北真希さんへの宿題にします。

ぼくの目標は、問題を解くより速く、問題を解くEmacs lispのコードを書けるようになることです。