> s ((a on table) (b on c) (c on table) (d on a)) > (possible-states 'd s '(b table)) (((d on b) (a on table) (b on c) (c on table)) ((d on table) (a on table) (b on c) (c on table))) > (possible-states 'b s '(d table)) (((b on d) (a on table) (c on table) (d on a)) ((b on table) (a on table) (c on table) (d on a))) > (possible-states 'a s '(b d)) (((a on b) (b on c) (c on table) (d on a)) ((a on d) (b on c) (c on table) (d on a))) > (possible-states 'a s '(b d table)) (((a on b) (b on c) (c on table) (d on a)) ((a on d) (b on c) (c on table) (d on a)) ((a on table) (b on c) (c on table) (d on a))) > (possible-states 'b s '(b d table)) (((b on b) (a on table) (c on table) (d on a)) ((b on d) (a on table) (c on table) (d on a)) ((b on table) (a on table) (c on table) (d on a))) > (possible-states 'c s '(b d table)) (((c on b) (a on table) (b on c) (d on a)) ((c on d) (a on table) (b on c) (d on a)) ((c on table) (a on table) (b on c) (d on a))) > (possible-states 'a s '(a b c d table)) (((a on a) (b on c) (c on table) (d on a)) ((a on b) (b on c) (c on table) (d on a)) ((a on c) (b on c) (c on table) (d on a)) ((a on d) (b on c) (c on table) (d on a)) ((a on table) (b on c) (c on table) (d on a))) > (possible-states 'b s '(a b c d table)) (((b on a) (a on table) (c on table) (d on a)) ((b on b) (a on table) (c on table) (d on a)) ((b on c) (a on table) (c on table) (d on a)) ((b on d) (a on table) (c on table) (d on a)) ((b on table) (a on table) (c on table) (d on a))) > (possible-states 'c s '(a b c d table)) (((c on a) (a on table) (b on c) (d on a)) ((c on b) (a on table) (b on c) (d on a)) ((c on c) (a on table) (b on c) (d on a)) ((c on d) (a on table) (b on c) (d on a)) ((c on table) (a on table) (b on c) (d on a))) > (possible-states 'd s '(a b c d table)) (((d on a) (a on table) (b on c) (c on table)) ((d on b) (a on table) (b on c) (c on table)) ((d on c) (a on table) (b on c) (c on table)) ((d on d) (a on table) (b on c) (c on table)) ((d on table) (a on table) (b on c) (c on table))) > (possible-states 'table s '(a b c d table)) (((table on a) (a on table) (b on c) (c on table) (d on a)) ((table on b) (a on table) (b on c) (c on table) (d on a)) ((table on c) (a on table) (b on c) (c on table) (d on a)) ((table on d) (a on table) (b on c) (c on table) (d on a)) ((table on table) (a on table) (b on c) (c on table) (d on a)))
(defun possible-states (block state dest) (let* ((current (assoc block state)) (other (remove current state))) (node-remove current (mapcar #'(lambda (d) (cons (list block 'on d) other)) dest))))以上の手続きを組み合わせることで,現在の状態を与えると,可能な次の 状態を作り出す手続きnext-blocks-statesを考えます.
> s ((a on table) (b on c) (c on table) (d on a)) > (next-blocks-states s) (((b on table) (a on table) (c on table) (d on a)) ((b on d) (a on table) (c on table) (d on a)) ((d on table) (a on table) (b on c) (c on table)) ((d on b) (a on table) (b on c) (c on table))) > (next-blocks-states '((a on table) (b on c) (c on table))) (((a on b) (b on c) (c on table)) ((b on table) (a on table) (c on table)) ((b on a) (a on table) (c on table))) > (next-blocks-states '((a on table) (b on c) (c on table) (d on a))) (((b on table) (a on table) (c on table) (d on a)) ((b on d) (a on table) (c on table) (d on a)) ((d on table) (a on table) (b on c) (c on table)) ((d on b) (a on table) (b on c) (c on table)))
(defun next-blocks-states (state) (let ((top-free (top-free-blocks state))) (node-remove state (mapcan #'(lambda (free-block) (possible-states free-block state (cons 'table (remove free-block top-free)))) top-free)))))