A* search algorithm implementation in CLIPS

Question

The problem is how to implement the A* search algorithm in a weighted graph using a list to keep track of the already visited (or expanded) nodes.
The following program (which is not mine, but which I have slightly modified) allows implementing the A* algorithm without using a list to keep track of the nodes we have already visited.

Templates for graph representation and heuristic function calculation:

(deftemplate emplacement ; node's identification and location 
  (slot nom) ; id-node
  (slot x (type NUMBER)) ; node x-position 
  (slot y (type NUMBER)) ; node y-position
  (multislot voisins (default nil))) ; node neighbors

(deftemplate but ; goal node
  (slot nom) ; id-node
  (slot x (type NUMBER)) ; node x-position
  (slot y (type NUMBER))) ; node y-position

(deftemplate depart ; start node
  (slot nom) ; id-node
  (slot x (type NUMBER)) ; node x-position
  (slot y (type NUMBER))) ; node y-position

(deftemplate node 
   (slot nom (default nil))
   (slot status) ; open (ouvert), closed (ferme), active (actif)
   (slot pere) ; ascendant node 
   (slot f (type NUMBER)) ; node evaluation function (f = g + h)
   (slot g (type NUMBER)) ; cost of partial paths
   (slot h (type NUMBER)) ; node heuristic 
   (slot x (type NUMBER)) ; node x-position
   (slot y (type NUMBER))); node y-position 

;;; h (heuristic) function calculation 
  (deffunction estimation (?x1 ?y1 ?x2 ?y2)
    (bind ?dx (- ?x1 ?x2))
    (bind ?dy (- ?y1 ?y2))
    (sqrt (+ (* ?dx ?dx ) (* ?dy ?dy ))))

Undirected graph representation is giving by deffacts list:


(deffacts liste-emplacements
    (emplacement (nom A) (x 0) (y 0) (voisins B C))
    (emplacement (nom B) (x 0) (y 1) (voisins A E D))
    (emplacement (nom C) (x 1) (y 0) (voisins A I)) 
    (emplacement (nom D) (x 1) (y 1) (voisins B F))
    (emplacement (nom E) (x 0) (y 2) (voisins B F)) 
    (emplacement (nom F) (x 1) (y 2) (voisins E D G))
    (emplacement (nom G) (x 2) (y 2) (voisins F H)) 
    (emplacement (nom H) (x 2) (y 1) (voisins G))
    (emplacement (nom I) (x 2) (y 0) (voisins C))
    
    (depart (nom A) (x -1) (y -1))
    (but (nom H) (x -1) (y -1))
    (phase initiale)
)

Rules base:

;;;;;;
;;; Goal and Start nodes allocation
;;;;;;

;;; Goal node allocation

(defrule affecter-emplacement-but 
(declare (salience 100)) 
(phase initiale)
?b<-(but (nom ?but) (x -1) (y -1)) 
    (emplacement (nom ?but) (x ?x) (y ?y))
 => 
(modify ?b (x ?x) (y ?y)))

;;; Start node allocation

(defrule affecter-emplacement-depart 
(declare (salience 90))
?c<-(phase initiale)
?d<-(depart (nom ?depart) (x -1) (y -1)) 
    (emplacement (nom ?depart) (x ?x) (y ?y))  
    (but (x ?x2) (y ?y2))
=> 
(modify ?d (x ?x) (y ?y)) 
(assert (noeud (nom ?depart) (status actif) (x ?x) (y ?y)
               (h =(estimation ?x ?y ?x2 ?y2)) 
               (f =(estimation ?x ?y ?x2 ?y2))))
(retract ?c)
(assert (phase developpement)))

;;;;;;  
;;; Rules for developing a node
;;;;;;

;;; Rule to generate neighbors

(defrule genere-voisins    
(declare (salience 80))
(phase developpement)  
(noeud (nom ?p)  (status actif)(g ?g)) 
(emplacement (nom ?p) (voisins $? ?v $?))
=> 
(assert (noeud (nom ?v) (status ouvert)(pere ?p)(g =(+ ?g 1))(h -1)(x -1)(y -1))))


;;;; Rule to close an active node 

(defrule fermer-noeud  
(declare (salience 70))
(phase developpement)  
?n<-(noeud (status actif)) 
=> 
(modify ?n (status ferme))) 
  
;;; Rule to calculate h and f functions

(defrule calcul-estimation
(declare (salience 60))
(phase developpement)  
?n<-(noeud (nom ?v)(status ouvert) (h -1) (g ?g) (x -1) (y -1))
    (emplacement (nom ?v) (x ?x1) (y ?y1))  
    (but (x ?x2) (y ?y2))
=>
(modify ?n (x ?x1) (y ?y1)
           (h =(estimation ?x1 ?y1 ?x2 ?y2))
           (f =(+ ?g (estimation ?x1 ?y1 ?x2 ?y2))))
 )

;;; Transition to the next phase

(defrule transition-phase-suivante
(declare (salience -10))
?p<-(phase developpement)
=>  
(retract ?p)
(assert (phase activation)))

 
;;;;;;
;;; Rules for choosing the minimum estimation node
;;;;;;

;;; A open node becames active

(defrule noeud-minimum
(declare (salience 50))
(phase activation)  
(not (noeud (status actif)))
?n<-(noeud (nom ?nom)(status ouvert))
=>
(modify ?n (status actif)))

;;; Node-min search 

(defrule recherche-noeud-min
(declare (salience 40))
(phase activation)  
?n1<-(noeud (nom ?nom-1)(status actif)(f ?f-1))
?n2<-(noeud (nom ?nom-2)(status ouvert)(f ?f-2&:(< ?f-2 ?f-1)))
=>
(modify ?n1 (status ouvert))
(modify ?n2 (status actif)))

;;; Print active node

(defrule noeud-min
(declare (salience 30))
?p<-(phase activation)  
(noeud (nom ?nom) (status actif) )
=>
(printout t " Le noeud " ?nom " devient le noeud actif." crlf )
(retract ?p)
(assert (phase developpement)))


;;;;;; 
;;;  Rule to stopping search
;;;;;;

(defrule noeud-final
(declare (salience 35))
?p<-(phase activation)  
?n<-(noeud (nom ?nom) (status actif) (g ?gopt) )
(but (nom ?but&: (eq ?nom ?but)))
(depart (nom ?depart))
=>
(modify ?n (status fin))
(printout t " " ?nom " FINI: but atteint" crlf )
(retract ?p)
(assert (phase finale))
(printout t "Le chemin optimal entre: " ?depart "  (Depart) et "  ?nom "  (But) = " ?gopt crlf)
(assert (chemin ?gopt ?nom)))


;;; Rule to construct path  

(defrule composer-chemin  
(phase finale)
?c<-(chemin ?gopt ?n $?q)
?d<-(noeud (nom ?n)(pere ?p&:(neq ?p nil)) (g ?gmin&:(= ?gopt ?gmin)))
    (noeud (nom ?p)(status ferme)(g ?g&:(= (- ?gmin 1) ?g)))
 => 
(retract ?c ?d)
(assert (chemin ?g ?p ?n $?q))) 
 
 
;;;; Rule to print path 

(defrule imprimer-chemin            
(phase finale)
(chemin 0 ?depart $?q ?but)
 => 
(printout t "Le chemin de " ?depart " a " ?but " passe par " $?q crlf)
(halt))

The execution of the program gives:

CLIPS> (reset)
CLIPS> (run)
 Le noeud C devient le noeud actif.
 Le noeud I devient le noeud actif.
 Le noeud B devient le noeud actif.
 Le noeud D devient le noeud actif.
 Le noeud A devient le noeud actif.
 Le noeud E devient le noeud actif.
 Le noeud A devient le noeud actif.
 Le noeud C devient le noeud actif.
 Le noeud F devient le noeud actif.
 Le noeud C devient le noeud actif.
 Le noeud F devient le noeud actif.
 Le noeud C devient le noeud actif.
 Le noeud I devient le noeud actif.
 Le noeud D devient le noeud actif.
 Le noeud G devient le noeud actif.
 H FINI: but atteint
Le chemin optimal entre: A  (Depart) et H  (But) = 5
Le chemin de A a H passe par (B D F G)
CLIPS>

From the results obtained, we can see that more than one node has been visited more than once, which is the case for nodes C, D, F, and I.

The question is: how to implement in this program a list to keep track of the nodes already visited, and then do not pass over the same node more than once?

A* search algorithm implementation in CLIPS

Answers (1)

Related Questions