Логическая задача на 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)

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

9   голосов , оценка 4 из 5