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