Added methods to obtain arcs from edges in undirected graphs.

Pascal J. Bourguignon [2012-01-31 21:31]
Added methods to obtain arcs from edges in undirected graphs.
Filename
p80.lisp
diff --git a/p80.lisp b/p80.lisp
index 6bfc8d7..21cbd74 100644
--- a/p80.lisp
+++ b/p80.lisp
@@ -162,21 +162,12 @@ directed-graph and undirected-graph that can be represented in several
 ways.
 "))

-(defmethod print-object ((self graph) stream)
-  (print-unreadable-object (self stream :identity t :type t)
-    (let ((rep-name  (class-name (class-of (slot-value self 'representation)))))
-     (format stream "as a~:[~;n~] ~A" (find (char (string rep-name) 0) "AEIOUY") rep-name))
-    (format stream " with ~A node~:*~P and ~A edge~:*~P"
-            (length (nodes self)) (length (edges self))))
-  self)
-
 (defclass undirected-graph (graph)
   ()
   (:documentation "
 Undirected graphs can have only representations with edges.
 "))

-
 (defclass attributes ()
   ((property-list :initform '()
                   :accessor property-list :initarg :property-list
@@ -190,6 +181,15 @@ An undirected edge. The order of the two nodes in the edge-nodes list
 is irrelevant.
 "))

+(defmethod print-object ((self undirected-graph) stream)
+  (print-unreadable-object (self stream :identity t :type t)
+    (let ((rep-name  (class-name (class-of (slot-value self 'representation)))))
+     (format stream "as a~:[~;n~] ~A" (find (char (string rep-name) 0) "AEIOUY") rep-name))
+    (format stream " with ~A node~:*~P and ~A edge~:*~P"
+            (length (nodes self)) (length (edges self))))
+  self)
+
+
 (defgeneric edges-with-node (graph node)
   (:documentation "Returns a list of the edges in GRAPH associating the given NODE.")
   (:method ((g graph) node) (edges-with-node (slot-value g 'representation) node)))
@@ -210,6 +210,14 @@ A directed arc, from the FROM node to the TO node.
 Note: the API allow for unidrected
 "))

+(defmethod print-object ((self directed-graph) stream)
+  (print-unreadable-object (self stream :identity t :type t)
+    (let ((rep-name  (class-name (class-of (slot-value self 'representation)))))
+     (format stream "as a~:[~;n~] ~A" (find (char (string rep-name) 0) "AEIOUY") rep-name))
+    (format stream " with ~A node~:*~P and ~A arc~:*~P"
+            (length (nodes self)) (length (arcs self))))
+  self)
+

 (defgeneric arcs-from-node (graph node)
   (:documentation "Returns a list of the arcs in GRAPH from the  NODE.
@@ -432,6 +440,17 @@ Returns GR.
   (remove-if-not (lambda (edge) (member node (edge-nodes edge))) (edges gr)))


+(defmethod arcs-from-node ((gr edge-list-representation) from)
+  (mapcar (lambda (edge)
+            (make-instance 'arc :from from :to (first (remove from (edge-nodes edge)))))
+          (edges-with-node gr from)))
+
+(defmethod arcs-to-node ((gr edge-list-representation) to)
+  (mapcar (lambda (edge)
+            (make-instance 'arc :to to :from (first (remove to (edge-nodes edge)))))
+          (edges-with-node gr to)))
+
+
 ;;; Edge list and nodes representation
 ;;; In this representation in addition to the list of edge, we
 ;;; maintain a list of nodes, so we may have isolated nodes too.
ViewGit