Lisp - modifier A * pour vérifier le meilleur coût, recevoir la liste des noeuds

Question

J'essaie de modifier une fonction de montée en côte existante, qui prend deux noms de noeuds (tels que A et E), et dispose d'un paramètre optionnel est utilisé de manière récursive (une file d'attente). J'essaie de définir une fonction «moins chère» qui évalue si un chemin est moins cher qu'un autre. Aussi, au lieu d'un nœud d'objectif, j'essaie de passer une liste de nœuds d'objectif, que la fonction, en atteignant l'un de ces nœuds, arrête d'évaluer.

Le problème est que ma fonction ne retournera rien sauf le noeud de départ que j'ai entré et une liste vide.

Voici mon réseau/graphique et les coûts associés:

(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) 

Et voici ma fonction modifiée de montée Hill:

(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)))))) 

Enfin, voici le « coût » et « meilleur marché » fonctions:

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


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

EDIT: Désolé, et est ici 'étendre':

(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)))) 

Answer 1

Je ne suis pas vraiment sûr, quel est le problème ici. Dans votre expand, une propriété neighbor est utilisée, ce qui n'est pas indiqué dans votre question. Si cette propriété est définie pour chaque noeud, votre code fonctionne. En supposant que chaque nœud est à côté d'un autre sans autre entre les deux (ce qui est la seule option qui semble logique pour vos données, puisque l'alternative, à savoir faire seulement des nœuds tangents (ie les nœuds qui sont +/- 1 pour une ou deux coordonnées) voisins, donnerait pas de voisins du tout dans votre exemple):

(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)))))) 

(parties manquantes restent les mêmes que dans votre post que des ajustements mineurs, comme laisser tomber le lambda autour, et le supplément. argument to, cheaper.)

donnera les résultats corrects:

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) 

Si vous ne pouvez pas introduire la nouvelle propriété, vous devrez vérifier les voisins dans votre fonction expand (qui signifie également que vous auriez à passer une liste de nœuds).