Commits

Anonymous committed 6c59672

NORMAL-SPANNING-TREE and BREADTH-SPANNING-TREE methods for STANDARD-GRAPH class implemented.

  • Participants
  • Parent commits c82ffb4
  • Branches dev

Comments (0)

Files changed (2)

File package.lisp

 	   #:labeled-edge #:nodes #:edges #:make-graph-edge #:add-node
 	   #:rem-node #:add-edge #:find-edges #:rem-edge #:incident?
 	   #:neighbours #:graph-union #:graph-intersection #:graph-sum
-	   #:graph-difference #:graph-cross-product #:spanning-tree
-	   #:traverse-root-first #:traverse-root-last #:map-graph
-	   #:edge #:graph #:standard-graph #:contract-edge
-	   #:subdivide-edge #:make-standard-graph #:add-nodes
-	   #:rem-nodes #:replace-ends #:make-edge))
+	   #:graph-difference #:graph-cross-product
+	   #:normal-spanning-tree #:breadth-spanning-tree
+	   #:dijkstra-spanning-tree #:map-graph #:edge #:graph
+	   #:standard-graph #:contract-edge #:subdivide-edge
+	   #:make-standard-graph #:add-nodes #:rem-nodes
+	   #:replace-ends #:make-edge))

File source/graph/standard-graph.lisp

 			   (image (lambda (edge)
 				    (replace-ends edge replacements))
 				  (edges graph)))
-		   :edge-type (edge-type graph))))
+		   :edge-type (edge-type graph))))
+
+(defmethod normal-spanning-tree ((graph standard-graph)
+				 root &optional predicate)
+  (let* ((tree (make-standard-graph (edge-type graph)))
+	 (visited (set root))
+	 (predicate (if predicate
+			predicate
+			(constantly t)))
+	 (todo (mapcar (lambda (n)
+			 (cons n root))
+		       (sort (convert 'list
+				      (neighbours graph root))
+			     predicate))))
+    (setf tree (add-node tree root))
+    (loop while todo
+       do (let* ((curr (pop todo))
+		 (currn (car curr)))
+	    (if (not (lookup visited currn))
+		(let ((currp (cdr curr))
+		      (currns (neighbours graph currn)))
+		  (setf tree (add-edge (add-node tree currn)
+				       currp currn))
+		  (setf visited (with visited currn))
+		  (setf todo (nconc (sort (mapcar (lambda (n)
+						    (cons n currn))
+						  (convert 'list
+							   currns))
+					  predicate)
+				    todo))))))
+    tree))
+
+(defmethod breadth-spanning-tree ((graph standard-graph)
+				  root &optional predicate)
+  (let* ((tree (make-standard-graph (edge-type graph)))
+	 (ns (neighbours graph root))
+	 (visited (with ns root))
+	 (predicate (if predicate
+			predicate
+			(constantly t)))
+	 (todo (sort (mapcar (lambda (n)
+			       (cons n root))
+			     (convert 'list
+				      ns))
+		     predicate)))
+    (setf tree (add-node tree root))
+    (loop while todo
+       do (let* ((curr (pop todo))
+		 (currn (car curr))
+		 (currp (cdr curr))
+		 (currns (set-difference (neighbours graph currn)
+					 visited)))
+	    (setf tree (add-edge (add-node tree currn)
+				 currp currn))
+	    (setf visited (union visited currns))
+	    (setf todo (nconc todo (sort (mapcar (lambda (n)
+						   (cons n currn))
+						 (convert 'list
+							  currns))
+					 predicate)))))
+    tree))