3.4 8パズルの解の存在

昨日の続き。また、同内容の問が3.4にあったりする。
15パズル - Wikipediaの「不可能な配置」の項目にあるように、「14 と 15 を入れ替えた状態」は解が存在しないパターンである。このように、任意の隣り合うピースを奇数回入れ替えると解なしとなり、一方、偶数回の入れ替えでは解が存在する。

というわけで、解の存在をチェックするには入れ替えの回数を数えて、奇数か偶数かで判定すればよい。この方法はパリティチェックの一種ではあるが、転倒数を数えるのとは少し違うようだ。

入れ替えの回数を数えるには、実際に並び替えて入れ替えた回数を調べればよい。今回はすべてのピースを動かして良いので、まともに解こうとすると後者が膨大になってしまうので、*goal*の最初から順に合わせていくことにする。この方法では最短手はでないが、入れ替えの偶奇には影響しないので今回は良しとする。入れ替えには前回作ったものがそのまま使える・・・といいたいところだが、中途半端な手抜きをしたので全然使えない^^;

(defun swap-piece (state piece move-to)
  (rotatef (cdr piece) (cdr (rassoc move-to state)))
  state)

(defun move-piece (state piece path)
  (let ((mover (member (cdr piece) path :key 'car)))
    (if mover (swap-piece state piece (cdar mover)))
    mover))

(defun unmove-piece (state piece path)
  (swap-piece state piece (caar path)))

(defun distance-sub (state piece goal path)
  (do ((depth 0) (cur-depth 0)
       (mover) (cur-mover)
       (len (length goal)))
      ((subsetp goal state :test 'equal)
       depth)
    (while (setq cur-mover (pop mover))
      (unmove-piece state piece cur-mover)
      (let ((next-mover (move-piece state piece (cdr cur-mover))))
        (if next-mover (return (push next-mover mover))
          (decf cur-depth))))
    (unless cur-mover (incf depth))
    (while (> depth cur-depth)
      (push (move-piece state piece path) mover)
      (incf cur-depth))))

(defun distance (state goal path)
  (let ((copy-state (copy-tree state))
        (phase 1) (step 0))
    (distance-sub copy-state (car copy-state) (subseq goal 0 1) path)
    (dolist (a (cdr copy-state) step)
      (incf step (distance-sub copy-state a (subseq goal 0 (incf phase)) path)))))

;解ける状態を作る。
(progn
  (do-init 3)
  (if (oddp (distance *state* *goal* 3x3path))
      (move-piece *state* (cadr *state*) (remove (cddr *state*) 3x3path :key 'cdr)))
  *state*)

もし解けない状態が生成されたら、生成をやりなおすのではなく、一度ピース同士を入れ替えれば良い。