;; The recursive search example with the graph represented by
;; means of two structs: arc and node. To initiate the search,
;; you must indicates nodes, for example
;; (breadth-first node1 node7). Notice the big differences
;; between this representation and the other two.

(defstruct (arc (:print-function print-arc))
	(input-node nil)
	(output-node nil))

(defun print-arc (structure &rest ignore)
	(format t "<arc structure>"))

(defstruct (node (:print-function print-node))
	(name 'unknown)
	(input-arcs nil)
	(output-arcs nil))

(defun print-node (structure &rest ignore)
	(format t "<node structure for ~a>" (node-name structure)))

(defun connect (node outputs inputs)
	(setf (node-input-arcs node) inputs)
	(dolist (arc inputs)
	   (setf (arc-output-node arc) node))
	(setf (node-output-arcs node) outputs)
	(dolist (arc outputs)
	   (setf (arc-input-node arc) node)))

(setf node1 (make-node :name 's))
(setf node2 (make-node :name 'a))
(setf node3 (make-node :name 'd))
(setf node4 (make-node :name 'b))
(setf node5 (make-node :name 'e))
(setf node6 (make-node :name 'c))
(setf node7 (make-node :name 'f))

(setf arc1 (make-arc))
(setf arc2 (make-arc))
(setf arc3 (make-arc))
(setf arc4 (make-arc))
(setf arc5 (make-arc))
(setf arc6 (make-arc))
(setf arc7 (make-arc))
(setf arc8 (make-arc))
(setf arc9 (make-arc))
(setf arc10 (make-arc))
(setf arc11 (make-arc))
(setf arc12 (make-arc))
(setf arc13 (make-arc))
(setf arc14 (make-arc))
(setf arc15 (make-arc))
(setf arc16 (make-arc))
  
(connect node1 (list arc1 arc2) (list arc9 arc12))
(connect node2 (list arc3 arc4 arc9) (list arc1 arc10 arc13))
(connect node3 (list arc5 arc12 arc13) (list arc2 arc4 arc15))
(connect node4 (list arc6 arc7 arc10) (list arc3 arc11 arc14))
(connect node5 (list arc8 arc14 arc15) (list arc5 arc7 arc16))
(connect node6 (list arc11) (list arc6))
(connect node7 (list arc16) (list arc8))
 
(defun breadth-first (start finish &optional
                       (queue (list (list start))))
     (cond ((endp queue) nil)
	   ((equal finish (first (first queue)))
	       (reverse (first queue)))
	   (t (breadth-first start finish
                             (append (rest queue)
			             (extend (first queue)))))))

(defun extend (path)
	(print (reverse path))
	(setf neighbors nil)
        (dolist (arc (node-output-arcs (first path)))
	    (push arc neighbors))
        (mapcar #'(lambda (new-node) (cons new-node path))
          (remove-if #'(lambda (neighbor) (containsp neighbor path))
             (mapcar #'(lambda (arc) (arc-output-node arc))
                                   neighbors))))

(defun containsp (neighbor current-path)
	(cond ((endp current-path) nil)
	      ((equal (node-name neighbor) (node-name (first current-path))) t)
   	      (t (containsp neighbor (rest current-path)))))