Anonymous committed 69de9e6

INDUCED-GRAPH generic function added to GRAPH protocol.
INDUCED-GRAPH method for STANDARD-GRAPH class implemented.
VALID-EDGE? generic function added to EDGE protocol.
VALID-EDGE? method for all implemented edge types added.

  • Participants
  • Parent commits 5a056c7
  • Branches dev

Comments (0)

Files changed (5)

File source/edge/edge.lisp

 	   (first type)
 	   source target
 	   :subedge-type (rest type)
-	   properties)))
+	   properties)))
+(defgeneric valid-edge? (edge nodes)
+  (:documentation "Returns T if all ends of EDGE are in NODES, returns
+  NIL otherwise.")
+  (:method ((edge cons)
+	    (nodes set))
+    (and (contains? nodes (car edge))
+	 (contains? nodes (cdr edge))))
+  (:method ((edge set)
+	    (nodes set))
+    (= (size edge)
+       (size (intersection edge nodes)))))

File source/edge/labeled-edge.lisp

   (make-instance 'labeled-edge
 		 :edge (apply #'make-edge subedge-type source target
-		 :label label))
+		 :label label))
+(defmethod valid-edge? ((edge labeled-edge)
+			(nodes set))
+  (valid-edge? (edge edge)
+	       nodes))

File source/edge/weighted-edge.lisp

 			      subedge-type source target properties)
 		 :weight (if weight
-			     1)))
+			     1)))
+(defmethod valid-edge? ((edge weighted-edge)
+			nodes)
+  (valid-edge? (edge edge)
+	       nodes))

File source/graph/graph.lisp

 		  :source node
+(defgeneric induced-graph (graph nodes)
+  (:documentation "Returns the graph induced by NODES in GRAPH."))
 (defgeneric graph-union (graph1 graph2)
   (:documentation "Returns the union of GRAPH1 and GRAPH2."))

File source/graph/standard-graph.lisp

     (remove-duplicates (append t1 t2 (list base)))))
+(defmethod induced-graph ((graph standard-graph)
+			  (nodes collection))
+  (make-instance 'standard-graph
+		 :edge-type (edge-type graph)
+		 :nodes (intersection (nodes graph)
+				      (convert 'set
+					       nodes))
+		 :edges (filter (lambda (edge)
+				  (valid-edge? edge nodes))
+				(edges graph))))
 (defmethod graph-union ((graph1 standard-graph)
 			(graph2 standard-graph))
   (make-instance 'standard-graph