"5-Puzzle" Common LISP с использованием разных поисков - PullRequest
Новая
       78

"5-Puzzle" Common LISP с использованием разных поисков

1 голос
/ 16 февраля 2020

Я пытаюсь использовать программу профессора «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]

Я не уверен, что я правильно вызываю функцию с правильными параметрами или мне нужно обновить что-то еще в программе, чтобы она работала правильно.

...