Я пытаюсь использовать программу профессора «5-Puzzle» для выполнения поиска в глубину, в первую очередь и в ширину. Я загрузил программу в Allegro CL, и мне дали finish, но мне нужно создать start для программы, а затем вызвать 3 различные функции поиска и проанализировать, что они делают в программе ... Когда я обновляюсь 5-Puzzle с моим новым start Я получаю несколько ошибок, и я слишком новичок в LISP, чтобы исправлять их. Код показан ниже:
;; The 5 puzzle with depth-first, breadth-first and best-first
;; (with heuristic function counting number of tiles in their
;; proper places) searches.
;; Written by Neli Zlatareva.
(setf start '(5 4 6 2 3 1))
(setf finish '(1 2 3 4 5 0))
;; Given two states, s1 and s2, HEURISTIC returns a number of
;; tiles in the same place.
(defun heuristic (s1 s2)
(count-equals s1 s2))
(defun count-equals (s1 s2)
(cond ((endp s1) 0)
((and (= (first s1) (first s2)) (not (= 0 (first s1))))
(+ 1 (count-equals (rest s1) (rest s2))))
(t (count-equals (rest s1) (rest s2)))))
(defun closerp (path1 path2 target-node)
(> (heuristic (first path1) target-node)
(heuristic (first path2) target-node)))
(defun best-first (start finish &optional
(queue (list (list start))))
(cond ((endp queue) nil)
((equal finish (first (first queue)))
(print (length (first queue))) (reverse (first queue)))
(t (best-first start finish
(sort (append (extend (first queue)) (rest queue))
#'(lambda (p1 p2) (closerp p1 p2 finish)))))))
(defun breadth-first (start finish &optional
(queue (list (list start))))
(cond ((endp queue) nil)
((equal finish (first (first queue)))
(print (length (first queue))) (reverse (first queue)))
(t (breadth-first start finish
(append (rest queue) (extend (first queue)))))))
(defun depth-first (start finish &optional
(queue (list (list start))))
(cond ((endp queue) nil)
((equal finish (first (first queue)))
(print (length (first queue))) (reverse (first queue)))
(t (depth-first start finish
(append (extend (first queue)) (rest queue))))))
;; The maximum path length is set to 60 -- change this
;; number as needed. When a path length becomes 60, EXTEND
;; returns NIL preventing this path from further extension.
;; Modify this arbitrary limit as needed. Note that this
;; limit is only to preserve computer memory, and may help
;; with depth-first or best-first searches.
(defun extend (path)
(if (< (length path) 60) (print (reverse path))
(return-from extend NIL))
(mapcar #'(lambda (new-node) (cons new-node path))
(remove-if #'(lambda (neighbor)
(member neighbor path :test #'equalp))
(get-new-states (first path)))))
(defun get-new-states (state)
(setf new-states '())
(locate-zero state))
(defun locate-zero (state)
(cond ((= 0 (first state)) (move-1 state))
((= 0 (second state)) (move-2 state))
((= 0 (third state)) (move-3 state))
((= 0 (fourth state)) (move-4 state))
((= 0 (fifth state)) (move-5 state))
((= 0 (sixth state)) (move-6 state))))
(defun move-1 (state)
(setf new-states (cons (append (list (second state))
(list (first state)) (nthcdr 2 state)) new-states))
(setf new-states (cons (append (list (fourth state))
(list (second state)) (list (third state))
(list (first state)) (nthcdr 4 state)) new-states)))
(defun move-2 (state)
(setf new-states (cons (append (list (second state))
(list (first state)) (nthcdr 2 state)) new-states))
(setf new-states (cons (append (list (first state))
(list (third state)) (list (second state)) (nthcdr 3 state))
new-states))
(setf new-states (cons (append (list (first state))
(list (fifth state)) (list (third state)) (list (fourth state))
(list (second state)) (last state)) new-states)))
(defun move-3 (state)
(setf new-states (cons (append (list (first state))
(list (third state)) (list (second state)) (nthcdr 3 state))
new-states))
(setf new-states (cons (append (butlast state 4) (last state)
(list (fourth state)) (list (fifth state)) (list (third state)))
new-states)))
(defun move-4 (state)
(setf new-states (cons (append (list (fourth state))
(list (second state)) (list (third state)) (list (first state))
(nthcdr 4 state)) new-states))
(setf new-states (cons (append (butlast state 3)
(list (fifth state)) (list (fourth state)) (last state))
new-states)))
(defun move-5 (state)
(setf new-states (cons (append (list (first state))
(list (fifth state)) (list (third state)) (list (fourth state))
(list (second state)) (last state)) new-states))
(setf new-states (cons (append (butlast state 3)
(list (fifth state)) (list (fourth state)) (last state))
new-states))
(setf new-states (cons (append (butlast state 2)
(last state) (list (fifth state))) new-states)))
(defun move-6 (state)
(setf new-states (cons (append (butlast state 2)
(last state) (list (fifth state))) new-states))
(setf new-states (cons (append (butlast state 4) (last state)
(list (fourth state)) (list (fifth state)) (list (third state)))
new-states)))
При вызове best-first, например, используя (best-first 'start 'finish) в allegro, я получаю сообщение об ошибке;
Error: Attempt to take the car of START which is not listp. [condition type: TYPE-ERROR]
Я не уверен, что я правильно вызываю функцию с правильными параметрами или мне нужно обновить что-то еще в программе, чтобы она работала правильно.