Pascal J. Bourguignon [2011-07-19 19:34]
```Added a few methods.
```
Filename
p80.lisp
```diff --git a/p80.lisp b/p80.lisp
index 29e60ed..6bfc8d7 100644
--- a/p80.lisp
+++ b/p80.lisp
@@ -190,6 +190,11 @@ An undirected edge. The order of the two nodes in the edge-nodes list
is irrelevant.
"))

+(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)))
+
+

(defclass directed-graph (graph)
()
@@ -206,6 +211,20 @@ Note: the API allow for unidrected
"))

+(defgeneric arcs-from-node (graph node)
+  (:documentation "Returns a list of the arcs in GRAPH from the  NODE.
+  (:method ((g graph) node) (arcs-from-node (slot-value g 'representation) node)))
+
+(defgeneric arcs-to-node (graph node)
+  (:documentation "Returns a list of the arcs in GRAPH to the  NODE.")
+  (:method ((g graph) node) (arcs-to-node (slot-value g 'representation) node)))
+
+
+
+
+
+

(defclass graph-representation ()
()
@@ -270,6 +289,7 @@ Return EDGE.")

+
(defgeneric arcs (gr)
(:documentation "Returns the list of arcs in the graph or graph representation.
If the graph or graph representation is undirected, then each edge produces two arcs.")
@@ -297,9 +317,7 @@ then it's added before.  Return the new ARC.")
(:documentation "
If ARC is an arc of the graph or graph representation,then remove it.
The nodes are not changed.  Return ARC.")
-  (:method ((g directed-graph) node) (remove-arc (slot-value g 'representation) arc)))
-
-
+  (:method ((g directed-graph) arc) (remove-arc (slot-value g 'representation) arc)))

(defgeneric to-sexp (object)
@@ -369,10 +387,10 @@ Returns GR.
(declare (ignore key test test-not))
(multiple-value-bind (vars vals store-vars writer-form reader-form)
(get-setf-expansion sequence-place)
+    (when (cdr store-vars)
+      (error "Cannot DELETE from a place with multiple values."))
`(let* (,@(mapcar (function list) vars vals)
-       (when (cdr store-vars)
-         (error "Cannot DELETE from a place with multiple values."))
(setf ,(car store-vars) (delete ,item ,(car store-vars) ,@args))
,writer-form)))

@@ -403,12 +421,15 @@ Returns GR.
:collect (first nodes) :collect (second nodes))))

+  (declare (ignore gr node))
(error "Cannot add isolated nodes to a graph represented by a list of edges."))

(defmethod remove-node ((gr edge-list-representation) node)
(setf (edges gr) (delete-if (lambda (edge) (member node (edge-nodes edge))) (edges gr)))
node)

+(defmethod edges-with-node ((gr edge-list-representation) node)
+  (remove-if-not (lambda (edge) (member node (edge-nodes edge))) (edges gr)))

;;; Edge list and nodes representation
@@ -472,16 +493,19 @@ Returns GR.
node)

+  (lambda (to)
+    (make-instance 'arc
+        :from from
+        :properties (copy-list (properties to)))))
+
+
(let ((arcs '()))
-               (setf arcs (nconc (mapcar (lambda (to)
-                                           (make-instance 'arc
-                                               :from from
-                                               :properties (copy-list (properties to))))
-                                 arcs)))
+               (setf arcs (nconc (mapcar (make-adjacency-list-arcs-from from)
arcs))

@@ -495,10 +519,20 @@ Returns GR.
:properties (copy-list properties)))

-  (deletef to (gethash (arc-from arc) (adjacency-list gr)))
+  (deletef arc (gethash (arc-from arc) (adjacency-list gr)))
arc)

+  (let ((arcs '()))
+                 (setf arcs (nconc (funcall (make-adjacency-list-arcs-from from) to) arcs))))
+    arcs))

;;;

@@ -549,14 +583,13 @@ Returns GR.

(defmethod copy-from ((g graph) (other graph))
"Make G a graph equal to OTHER"
-  (clear-representation)
+  (clear-representation g)
;; Just out of lazyness, we go thru sexps.
(from-sexp (slot-value g 'representation) (to-sexp other))
;; if a faster conversion is required, we could get (nodes other)
-  ;; and (edges other) or (arcs other) and loop of them to add them to
+  ;; and (edges other) or (arcs other) and loop on them to add them to
;; the target graph.
g)

-;;; THE END ;;;
-
+;;;; THE END ;;;;```
ViewGit