From db6fb90aeac76c4b8319034a7ba4530eb5a106f0 Mon Sep 17 00:00:00 2001
From: "Pascal J. Bourguignon"
Date: Tue, 19 Jul 2011 21:34:50 +0200
Subject: [PATCH] Added a few methods.

p80.lisp  67 ++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 50 insertions(+), 17 deletions()
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 edgenodes list
is irrelevant.
"))
+(defgeneric edgeswithnode (graph node)
+ (:documentation "Returns a list of the edges in GRAPH associating the given NODE.")
+ (:method ((g graph) node) (edgeswithnode (slotvalue g 'representation) node)))
+
+
(defclass directedgraph (graph)
()
@@ 206,6 +211,20 @@ Note: the API allow for unidrected
"))
+(defgeneric arcsfromnode (graph node)
+ (:documentation "Returns a list of the arcs in GRAPH from the NODE.
+\(the adjacency list).")
+ (:method ((g graph) node) (arcsfromnode (slotvalue g 'representation) node)))
+
+(defgeneric arcstonode (graph node)
+ (:documentation "Returns a list of the arcs in GRAPH to the NODE.")
+ (:method ((g graph) node) (arcstonode (slotvalue g 'representation) node)))
+
+
+
+
+
+
(defclass graphrepresentation ()
()
@@ 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 directedgraph) node) (removearc (slotvalue g 'representation) arc)))


+ (:method ((g directedgraph) arc) (removearc (slotvalue g 'representation) arc)))
(defgeneric tosexp (object)
@@ 369,10 +387,10 @@ Returns GR.
(declare (ignore key test testnot))
(multiplevaluebind (vars vals storevars writerform readerform)
(getsetfexpansion sequenceplace)
+ (when (cdr storevars)
+ (error "Cannot DELETE from a place with multiple values."))
`(let* (,@(mapcar (function list) vars vals)
(,(car storevars) ,readerform))
 (when (cdr storevars)
 (error "Cannot DELETE from a place with multiple values."))
(setf ,(car storevars) (delete ,item ,(car storevars) ,@args))
,writerform)))
@@ 403,12 +421,15 @@ Returns GR.
:collect (first nodes) :collect (second nodes))))
(defmethod addnode ((gr edgelistrepresentation) node)
+ (declare (ignore gr node))
(error "Cannot add isolated nodes to a graph represented by a list of edges."))
(defmethod removenode ((gr edgelistrepresentation) node)
(setf (edges gr) (deleteif (lambda (edge) (member node (edgenodes edge))) (edges gr)))
node)
+(defmethod edgeswithnode ((gr edgelistrepresentation) node)
+ (removeifnot (lambda (edge) (member node (edgenodes edge))) (edges gr)))
;;; Edge list and nodes representation
@@ 472,16 +493,19 @@ Returns GR.
node)
+(defun makeadjacencylistarcsfrom (from)
+ (lambda (to)
+ (makeinstance 'arc
+ :from from
+ :to (linknode to)
+ :properties (copylist (properties to)))))
+
+
(defmethod arcs ((gr adjacencylistrepresentation))
(let ((arcs '()))
(maphash (lambda (from adjacents)
 (setf arcs (nconc (mapcar (lambda (to)
 (makeinstance 'arc
 :from from
 :to (linknode to)
 :properties (copylist (properties to))))
 adjacents)
 arcs)))
+ (setf arcs (nconc (mapcar (makeadjacencylistarcsfrom from)
+ adjacents) arcs)))
(adjacencylist gr))
arcs))
@@ 495,10 +519,20 @@ Returns GR.
:properties (copylist properties)))
(defmethod removearc ((gr adjacencylistrepresentation) arc)
 (deletef to (gethash (arcfrom arc) (adjacencylist gr)))
+ (deletef arc (gethash (arcfrom arc) (adjacencylist gr)))
arc)
+(defmethod arcsfromnode ((gr adjacencylistrepresentation) from)
+ (mapcar (makeadjacencylistarcsfrom from)
+ (gethash from (adjacencylist gr))))
+(defmethod arcstonode ((gr adjacencylistrepresentation) to)
+ (let ((arcs '()))
+ (maphash (lambda (from adjacents)
+ (when (member to adjacents)
+ (setf arcs (nconc (funcall (makeadjacencylistarcsfrom from) to) arcs))))
+ (adjacencylist gr))
+ arcs))
;;;
@@ 549,14 +583,13 @@ Returns GR.
(defmethod copyfrom ((g graph) (other graph))
"Make G a graph equal to OTHER"
 (clearrepresentation)
+ (clearrepresentation g)
;; Just out of lazyness, we go thru sexps.
(fromsexp (slotvalue g 'representation) (tosexp 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 ;;;;

2.1.4