Lisp - modify A* to check for best cost, receive list of goal nodes

377 views Asked by At

I am trying to modify an existing Hill-climb function, which takes two node names (such as A and E), and has an optional parameter which is used recursively (a queue). I'm trying to define a function 'cheaper' that evaluates if one path is cheaper than another. Also, instead of one goal node, I'm trying to pass a list of goal nodes, which the function, upon reaching one of those nodes, stops evaluating.

The problem is my function won't return anything except the start node I've input and an empty list.

Here is my network/graph and associated costs:

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

And here is my modified Hill-climb function:

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

Finally, here are the 'cost' and 'cheaper' functions:

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


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

EDIT: Sorry, and here's 'extend':

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

There are 1 answers

0
danlei On BEST ANSWER

I'm not really sure, what the problem is here. In your expand, a neighbor property is used which is not given in your question. If this property is defined for every node, your code works.

Assuming every node that is next to another without another in between (which is the only option that seems to make sense for your data, since the alternative, namely to make only tangent nodes (i.e. nodes which are +/-1 for one or both coordinates) neighbors, would yield no neighbors at all in your example):

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

(Missing parts stay the same as in your post. Only minor adjustments, like dropping the lambda around, and the extra argument to, cheaper.)

Will give the correct results:

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)

If you may not introduce the new property, you will have to check for neighbors in your expand function (which would also mean that you'd have to pass a list of nodes).