Lisp - модифицируйте A * для проверки наилучшей стоимости, получите список целевых узлов

Я пытаюсь изменить существующую функцию Hill-climb, которая принимает два имени узла (например, A и E) и имеет необязательный параметр, который используется рекурсивно (очередь). Я пытаюсь определить функцию «дешевле», которая оценивает, дешевле ли один путь, чем другой. Кроме того, вместо одного целевого узла я пытаюсь передать список целевых узлов, которые функция, достигнув одного из этих узлов, перестает оценивать.

Проблема в том, что моя функция не вернет ничего, кроме начального узла, который я ввел, и пустого списка.

Вот моя сеть/график и связанные с этим расходы:

(setf (get 's 'coordinates) '(0 3)
      (get 'a 'coordinates) '(4 6)
      (get 'b 'coordinates) '(7 6)
      (get 'c 'coordinates) '(11 9)
      (get 'd 'coordinates) '(2 0)
      (get 'e 'coordinates) '(9 2)
      (get 'f 'coordinates) '(11 3))


(setf (get 's 'cost) 0
      (get 'a 'cost) 16
      (get 'b 'cost) 4
      (get 'c 'cost) 10
      (get 'd 'cost) 5
      (get 'e 'cost) 12
      (get 'f 'cost) 14)

А вот моя модифицированная функция подъема в гору:

(defun hill-climb (start finish &optional (queue (list (list start))))
  (cond ((endp queue) nil)
        ((member (first (first queue)) finish)
         (reverse (first queue)))
        (t (hill-climb start finish (append (sort (extend (first queue))
                                                  #'(lambda (p1 p2)
                                                      (cheaper p1 p2 
                                                               finish)))
                                            (rest queue))))))

Наконец, вот функции «стоимость» и «дешевле»:

(defun cost (path)
  (apply '+ (mapcar #'(lambda (x) (get x 'cost)) path)))


(defun cheaper (p1 p2)
  (< (cost p1)
     (cost p2)))

РЕДАКТИРОВАТЬ: Извините, а вот «расширить»:

(defun extend (path)
  (print (reverse path))
  (mapcar #'(lambda (new-node) (cons new-node path))
          (remove-if #'(lambda (neighbor) (member neighbor path))
                     (get (first path) 'neighbors))))

search lisp common-lisp clisp hill-climbing
person Sean Glover    schedule 11.10.2011    source источник
comment
Где extend? Обратите внимание, что вы передаете неправильное количество аргументов в cheaper. Кроме того, использование одиночных связанных списков в качестве очередей, вероятно, не лучшая идея.   -  person danlei    schedule 11.10.2011
comment
Извините, добавлено расширение. Заметил более дешевую вещь, раньше использовал функцию, которая принимала 3 аргумента. Настройка очереди как бы продиктована назначением. Итак, я знаю, что проблема в том, что, поскольку я использую список возможных целевых узлов вместо одного, когда я вызываю функцию рекурсивно, я не уверен, как это сработает с точки зрения того, что Я возвращаюсь к нему из «финишного» списка. Возможно, если я просто изменю "дешевле", то получится лучше...   -  person Sean Glover    schedule 11.10.2011
comment
Откуда же взялось свойство neighbors? Планировали ли вы добавить это свойство на отдельном шаге? Я не знаю ваших спецификаций, но я бы хотел, чтобы сосед был +/- 1 для каждой координаты (?). Кроме того, поскольку это домашнее задание, пожалуйста, отметьте его как таковое.   -  person danlei    schedule 11.10.2011

Ответы (1)


arrow_upward
2
arrow_downward

Я не совсем уверен, в чем здесь проблема. В вашем expand используется свойство neighbor, которое не указано в вашем вопросе. Если это свойство определено для каждого узла, ваш код работает.

Предполагая, что каждый узел, который находится рядом с другим, без другого между ними (что является единственным вариантом, который, кажется, имеет смысл для ваших данных, поскольку альтернатива, а именно создание только касательных узлов (т. е. узлов, которые +/- 1 для одного или обоих координаты) соседей, в вашем примере вообще не будет соседей):

(setf (get 's 'neighbors) '(a d)
      (get 'a 'neighbors) '(s b d)
      (get 'b 'neighbors) '(a c e)
      (get 'c 'neighbors) '(b)
      (get 'd 'neighbors) '(s a e)
      (get 'e 'neighbors) '(b d f)
      (get 'f 'neighbors) '(e))

(defun hill-climb (start finish &optional (queue (list (list start))))
  (cond ((endp queue) nil)
        ((member (first (first queue)) finish)
         (reverse (first queue)))
        (t (hill-climb start finish (append (sort (extend (first queue))
                                                  #'cheaper)
                                            (rest queue))))))

(Отсутствующие части остаются такими же, как и в вашем сообщении. Только незначительные изменения, такие как удаление lambda вокруг и дополнительный аргумент cheaper.)

Даст правильные результаты:

CL-USER> (hill-climb 's '(b))

(S) 
(S D) 
(S D E) 
(S D E B)
CL-USER> (hill-climb 's '(b d))

(S) 
(S D)

Если вы не можете ввести новое свойство, вам придется проверять наличие соседей в вашей функции expand (что также будет означать, что вам придется передать список узлов).

person danlei    schedule 11.10.2011