水の移し替えパズル
Posted feedbacks - Emacs Lisp
kozima
#3616()
[
Emacs Lisp
]
解くプロセスを Emacs で表示してみました。 もっときれいに書けるかも……
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 | (eval-when-compile (require 'cl))
(defun water-puzzle (a b c)
(let ((cups (list a b c)))
(destructuring-bind ((i p) (j q) (k r))
(sort `((0 ,a) (1 ,b) (2 ,c))
(lambda (x y) (< (cadr x) (cadr y))))
(cond ((zerop (mod (- p q) 3)) (show-strategy cups i j k))
((zerop (mod (- p r) 3)) (show-strategy cups i k j))
((zerop (mod (- q r) 3)) (show-strategy cups j k i))
(t (message "Cannot solve!"))))))
(defun show-strategy (cups i j k)
(let ((buf (get-buffer-create "*water puzzle*"))
(mover (lambda (di dj dk)
(incf (nth i cups) di) (redraw-cup i di)
(incf (nth j cups) dj) (redraw-cup j dj)
(incf (nth k cups) dk) (redraw-cup k dk)))
(counter 0))
(switch-to-buffer buf)
(show-init-state cups)
(while (> (nth j cups) 0)
(sit-for 1)
(apply mover (if (zerop (nth i cups)) '(2 -1 -1) '(-1 -1 2)))
(incf counter))
(message "Solved in %d step%s."
counter (if (= counter 1) "" "s"))))
(defun show-init-state (cups)
(delete-region (point-min) (point-max))
(redraw-cup 0 (car cups)) (insert ?\n)
(redraw-cup 1 (cadr cups)) (insert ?\n)
(redraw-cup 2 (caddr cups)) (insert ?\n))
(defun redraw-cup (i d)
(goto-line (1+ i))
(if (plusp d) (dotimes (x d) (insert ?|)) (delete-char (- d))))
;;; test
(water-puzzle 4 2 10)
|
にしお
#3547()
Rating0/2=0.00
A, B, Cの容器があり，それぞれ水が4L, 2L, 10L入っている． ここで次の操作を繰り返す．
(*)「A, B, Cのどれか二つの容器から水を1Lずつくみ上げ，残りの容器に移す．」
たとえばA, Bから1Lずつくみ上げて移せばA=3L, B=1L, C=12Lとなる． くみ上げる前の容器には必ず水が入っているとする．
(*)を繰り返してどれか一つの容器にのみ水がはいっている状態にする最小手数を求めよ．
可能ならA=827392L，B=65536L，C=122880Lのときも求めよ．
このお題は光成さんの投稿を元に作成しました。ご協力ありがとうございます。
[ reply ]