Логическая задача на 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)
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д