Логическая задача на Lisp
Формулировка задачи:
Здравствуйте! Помогите с задачей, пожалуйста! Стол разграфлен на 6 квадратов, в каждом из которых, кроме одного, помещается какой-нибудь предмет. Можно передвигать предметы из одного квадрата в другой по определенным правилам, а именно:
1. можно перемещать предмет только в тот квадрат,
который окажется свободным;
2. нельзя передвигать предметы по диагонали квадрата;
3. нельзя переносить один предмет поверх другого;
4. нельзя также помещать в квадрат более одного предмета, даже временно.
Нужно поменять местами чайник и молочник.
Игровой стол представлен в виде списка, в котором предметы выражены числами, а их место на столе определяется индексом в списке.
Помогите, пожалуйста, решить без использования динамических переменных. У меня получается только с ними. При решении мне можно использовать только примитивные функции( без lambda, mapcan и т. д.) Буду благодарен за любую помощь.
(defconstant +initial-table+ '(1 0 2 3 4 5)
(defparameter *game-table* +initial-table+
(defparameter *turns* 0
(defun print-table ()
(format t
(elt *game-table* 0)
(elt *game-table* 1)
(elt *game-table* 2)
(elt *game-table* 3)
(elt *game-table* 4)
(elt *game-table* 5)
*turns*))
(defun test-game-win ()
(when (and (= 5 (position 2 *game-table*))
(= 2 (position 5 *game-table*))) ;;
(format t *turns*)
(setf *turns* 0
*game-table* +initial-table+)))
(defun get-available-items ()
(let ((zero (position 0 *game-table*)))
(loop for i in (list (+ zero 1)
(- zero 1)
(+ zero 3)
(- zero 3))
when (and (>= i 0)
(<= i (- (length *game-table*) 1))
(not (and (= i 2) (= zero 3)))
(not (and (= i 3) (= zero 2))))
collect i)))
(defun set-zero-position (position)
(let ((current-zero-position (position 0 *game-table*))
(replaced-element (elt *game-table* position)))
(setf (elt *game-table* current-zero-position) replaced-element
(elt *game-table* position) 0)))
(defun move-item (item)
(let* ((item-position (position item *game-table*))
(available-items (get-available-items))
(turn-valid-p (find item-position available-items)))
(if turn-valid-p
(progn
(set-zero-position item-position)
(setf *turns* (+ 1 *turns*))
(print-table)))))Решение задачи: «Логическая задача на Lisp»
textual
Листинг программы
(defn table () (defn find (x l) (defn go (n l) cond (null? l) -1 (eq? x (car l)) n (go (+ n 1) (cdr l))) (go 0 l)) (defn set-list (i x l) append (take i l) (cons x (drop (+ i 1) l))) (defn swap (i j l) set-list i (list-ref j l) (set-list j (list-ref i l) l)) (defn steps (chain) (def s (car chain)) (def i0 (find 0 s) il (- i0 1) ir (+ i0 1) iu (- i0 3) id (+ i0 3)) (def l (cond (= i0 0) nil (= i0 3) nil (swap i0 il s))) (def r (cond (= i0 2) nil (= i0 5) nil (swap i0 ir s))) (def u (cond (< iu 0) nil (swap i0 iu s))) (def d (cond (> i0 2) nil (swap i0 id s))) (def nexts (filter (lambda (x) not (null? x)) (cons l r u d nil))) (map (lambda (n) cons n chain) (filter (lambda (v) not (elem v chain)) nexts))) (defn solved? (state) (match (car state) '(_ _ a _ _ b)) (and (= a 3) (= b 2))) (def start-state '((1 0 2 1 1 3))) (defn show-res (l i) (print \n "Вариант " i ":" \n) (defn go (l) cond (null? l) (+ i 1) ((print (car l) \n) (go (cdr l)) )) (go l)) (print "Поиск в глубину:") (show-res (reverse (solve-depth steps solved? start-state)) 1) (print \n "Поиск в ширину:" \n) (foldl (lambda (l a) show-res (reverse l) a) 1 (solve-wide steps solved? start-state)) ) (table)