Логическая задача на Lisp

Узнай цену своей работы

Формулировка задачи:

Здравствуйте! Помогите с задачей, пожалуйста! Стол разграфлен на 6 квадратов, в каждом из которых, кроме одного, помещается какой-нибудь предмет. Можно передвигать предметы из одного квадрата в другой по определенным правилам, а именно: 1. можно перемещать предмет только в тот квадрат, который окажется свободным; 2. нельзя передвигать предметы по диагонали квадрата; 3. нельзя переносить один предмет поверх другого; 4. нельзя также помещать в квадрат более одного предмета, даже временно. Нужно поменять местами чайник и молочник. Игровой стол представлен в виде списка, в котором предметы выражены числами, а их место на столе определяется индексом в списке. Помогите, пожалуйста, решить без использования динамических переменных. У меня получается только с ними. При решении мне можно использовать только примитивные функции( без lambda, mapcan и т. д.) Буду благодарен за любую помощь.
Листинг программы
  1. (defconstant +initial-table+ '(1 0 2 3 4 5)
  2. (defparameter *game-table* +initial-table+
  3. (defparameter *turns* 0
  4. (defun print-table ()
  5. (format t
  6. (elt *game-table* 0)
  7. (elt *game-table* 1)
  8. (elt *game-table* 2)
  9. (elt *game-table* 3)
  10. (elt *game-table* 4)
  11. (elt *game-table* 5)
  12. *turns*))
  13. (defun test-game-win ()
  14. (when (and (= 5 (position 2 *game-table*))
  15. (= 2 (position 5 *game-table*))) ;;
  16. (format t *turns*)
  17. (setf *turns* 0
  18. *game-table* +initial-table+)))
  19. (defun get-available-items ()
  20. (let ((zero (position 0 *game-table*)))
  21. (loop for i in (list (+ zero 1)
  22. (- zero 1)
  23. (+ zero 3)
  24. (- zero 3))
  25. when (and (>= i 0)
  26. (<= i (- (length *game-table*) 1))
  27. (not (and (= i 2) (= zero 3)))
  28. (not (and (= i 3) (= zero 2))))
  29. collect i)))
  30. (defun set-zero-position (position)
  31. (let ((current-zero-position (position 0 *game-table*))
  32. (replaced-element (elt *game-table* position)))
  33. (setf (elt *game-table* current-zero-position) replaced-element
  34. (elt *game-table* position) 0)))
  35. (defun move-item (item)
  36. (let* ((item-position (position item *game-table*))
  37. (available-items (get-available-items))
  38. (turn-valid-p (find item-position available-items)))
  39. (if turn-valid-p
  40. (progn
  41. (set-zero-position item-position)
  42. (setf *turns* (+ 1 *turns*))
  43. (print-table)))))

Решение задачи: «Логическая задача на Lisp»

textual
Листинг программы
  1. (defn table ()
  2.  
  3.     (defn find (x l)
  4.         (defn go (n l)
  5.             cond (null? l) -1
  6.                  (eq? x (car l)) n
  7.                  (go (+ n 1) (cdr l)))
  8.         (go 0 l))
  9.  
  10.     (defn set-list (i x l) append (take i l) (cons x (drop (+ i 1) l)))
  11.     (defn swap (i j l)
  12.         set-list i (list-ref j l) (set-list j (list-ref i l) l))
  13.  
  14.     (defn steps (chain)
  15.         (def s (car chain))
  16.         (def i0 (find 0 s) il (- i0 1) ir (+ i0 1) iu (- i0 3) id (+ i0 3))
  17.         (def l (cond (= i0 0) nil (= i0 3) nil (swap i0 il s)))
  18.         (def r (cond (= i0 2) nil (= i0 5) nil (swap i0 ir s)))
  19.         (def u (cond (< iu 0) nil (swap i0 iu s)))
  20.         (def d (cond (> i0 2) nil (swap i0 id s)))
  21.         (def nexts (filter (lambda (x) not (null? x)) (cons l r u d nil)))
  22.         (map (lambda (n) cons n chain) (filter (lambda (v) not (elem v chain)) nexts)))
  23.  
  24.     (defn solved? (state)
  25.         (match (car state) '(_ _ a _ _ b))
  26.         (and (= a 3) (= b 2)))
  27.  
  28.     (def start-state '((1 0 2 1 1 3)))
  29.  
  30.     (defn show-res (l i)
  31.         (print \n "Вариант " i ":" \n)
  32.         (defn go (l) cond (null? l) (+ i 1) ((print (car l) \n) (go (cdr l)) ))
  33.         (go l))
  34.  
  35.     (print "Поиск в глубину:")
  36.     (show-res (reverse (solve-depth steps solved? start-state)) 1)
  37.  
  38.     (print \n "Поиск в ширину:" \n)
  39.     (foldl (lambda (l a) show-res (reverse l) a) 1 (solve-wide steps solved? start-state)) )
  40.  
  41. (table)

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


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

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

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

Нужна аналогичная работа?

Оформи быстрый заказ и узнай стоимость

Бесплатно
Оформите заказ и авторы начнут откликаться уже через 10 минут