;;; ---------------------------------------------------------------------------
-(defmethod find-edge-between-vertexes ((graph basic-graph) (value-1 t) (value-2 t)
- &key (error-if-not-found? t))
- (let ((v1 (find-vertex graph value-1 error-if-not-found?))
- (v2 (find-vertex graph value-2 error-if-not-found?)))
- (aif (and v1 v2 (find-edge-between-vertexes graph v1 v2))
- it
- (when error-if-not-found?
- (error 'graph-edge-not-found-error :vertex-1 v1 :vertex-2 v2)))))
+(defmethod find-edge-between-vertexes
+ ((graph basic-graph) (value-1 t) (value-2 t)
+ &key (error-if-not-found? t))
+ (let* ((v1 (find-vertex graph value-1 error-if-not-found?))
+ (v2 (find-vertex graph value-2 error-if-not-found?)))
+ (or (and v1 v2 (find-edge-between-vertexes graph v1 v2)))
+ (when error-if-not-found?
+ (error 'graph-edge-not-found-error :vertex-1 v1 :vertex-2 v2))))
;;; ---------------------------------------------------------------------------
(defmethod find-vertex ((graph basic-graph) (value t)
&optional (error-if-not-found? t))
- (aif (find-item (graph-vertexes graph) (funcall (vertex-key graph) value))
- it
- (when error-if-not-found?
- (error 'graph-vertex-not-found-error :vertex value :graph graph))))
+ (or (find-item (graph-vertexes graph) (funcall (vertex-key graph) value))
+ (when error-if-not-found?
+ (error 'graph-vertex-not-found-error :vertex value :graph graph))))
-;;; ---------------------------------------------------------------------------
+(defmethod find-vertex ((graph basic-graph) (vertex basic-vertex)
+ &optional (error-if-not-found? t))
+ (cond ((eq graph (graph vertex))
+ vertex)
+ (t
+ (when error-if-not-found?
+ (error 'graph-vertex-not-found-error
+ :vertex vertex :graph graph)))))
(defmethod find-vertex ((edge basic-edge) (value t)
&optional (error-if-not-found? t))
(when error-if-not-found?
(error 'graph-vertex-not-found-in-edge-error :vertex value :edge edge)))
-;;; ---------------------------------------------------------------------------
-
-(defmethod search-for-vertex ((graph basic-graph) (value t)
- &key (key (vertex-key graph)) (test 'equal)
- (error-if-not-found? t))
- (aif (search-for-node graph value :test test :key key)
- it
- (when error-if-not-found?
- (error "~S not found in ~A using key ~S and test ~S" value graph key
- test))))
-
-;;; ---------------------------------------------------------------------------
(defmethod search-for-vertex ((graph basic-graph) (vertex basic-vertex)
&key (key (vertex-key graph)) (test 'equal)
(error-if-not-found? t))
- (aif (search-for-node (graph-vertexes graph) vertex :test test :key key)
- it
- (when error-if-not-found?
- (error "~A not found in ~A" vertex graph))))
+ (or (search-for-node (graph-vertexes graph) vertex :test test :key key)
+ (when error-if-not-found?
+ (error "~A not found in ~A" vertex graph))))
-;;; ---------------------------------------------------------------------------
-;; TODO !!! dispatch is the same as the second method above
(defmethod search-for-vertex ((graph basic-graph) (vertex t)
&key (key (vertex-key graph)) (test 'equal)
(error-if-not-found? t))
- (aif (search-for-element (graph-vertexes graph) vertex :test test :key key)
- it
- (when error-if-not-found?
- (error "~A not found in ~A" vertex graph))))
-
-;;; ---------------------------------------------------------------------------
+ (or (search-for-element (graph-vertexes graph) vertex :test test :key key)
+ (when error-if-not-found?
+ (error "~A not found in ~A" vertex graph))))
(defmethod iterate-elements ((graph basic-graph) fn)
(iterate-elements (graph-vertexes graph)
(defmethod traverse-elements-helper ((thing basic-vertex) (style (eql :depth)) marker fn)
(when (eq (tag thing) marker)
- (nilf (tag thing))
+ (setf (tag thing) nil)
(iterate-children
thing
(lambda (vertex)
(defmethod traverse-elements-helper ((thing basic-vertex) (style (eql :breadth)) marker fn)
(when (eq (tag thing) marker)
- (nilf (tag thing))
+ (setf (tag thing) nil)
(funcall fn thing))
(iterate-neighbors
thing
(lambda (vertex)
(when (eq (tag vertex) marker)
- (nilf (tag vertex))
+ (setf (tag vertex) nil)
(traverse-elements-helper vertex style marker fn)))))
;;; ---------------------------------------------------------------------------
(list start-vertex)
(lambda (v)
(if first-time?
- (nilf first-time?)
+ (setf first-time? nil)
(eq (find-vertex graph v) start-vertex)))
(lambda (v)
(child-vertexes v))
&optional (marked (make-container 'simple-associative-container))
(previous nil))
(block do-it
- (tf (item-at-1 marked current))
+ (setf (item-at-1 marked current) t)
(iterate-children current
(lambda (child)
(cond
(defmethod make-filtered-graph ((old-graph basic-graph)
test-fn
- &optional
+ &key
(graph-completion-method nil)
- (depth nil))
- (let ((new-graph
- (copy-template old-graph)))
- (ecase graph-completion-method
- ((nil
- :complete-links)
- (iterate-vertexes old-graph
- (lambda (vertex)
- (when (funcall test-fn vertex)
- (add-vertex new-graph (value vertex))))))
- ((:complete-closure-nodes-only
- :complete-closure-with-links)
- (let* ((old-graph-vertexes (collect-items old-graph :filter test-fn))
- (closure-vertexes
- (get-transitive-closure old-graph-vertexes depth)))
- (dolist (vertex closure-vertexes)
- (add-vertex new-graph (copy-template vertex))))))
-
- (ecase graph-completion-method
+ (depth nil)
+ (new-graph
+ (copy-template old-graph)))
+ (ecase graph-completion-method
+ ((nil
+ :complete-links)
+ (iterate-vertexes old-graph
+ (lambda (vertex)
+ (when (funcall test-fn vertex)
+ (add-vertex new-graph (value vertex))))))
+ ((:complete-closure-nodes-only
+ :complete-closure-with-links)
+ (let* ((old-graph-vertexes (collect-items old-graph :filter test-fn))
+ (closure-vertexes
+ (get-transitive-closure old-graph-vertexes depth)))
+ (dolist (vertex closure-vertexes)
+ (add-vertex new-graph (copy-template vertex))))))
+ (ecase graph-completion-method
((nil :complete-closure-nodes-only) nil)
((:complete-links
:complete-closure-with-links)
(complete-links new-graph old-graph)))
-
- new-graph))
+ new-graph)
;;; ---------------------------------------------------------------------------
(defmethod subgraph-containing ((graph basic-graph) (vertex basic-vertex)
- &optional (depth nil))
- (make-filtered-graph graph
- #'(lambda (v)
- (equal v vertex))
- :complete-closure-with-links
- depth))
+ &rest args &key (depth nil) (new-graph nil))
+ (declare (ignore depth new-graph))
+ (apply #'make-filtered-graph
+ graph
+ #'(lambda (v)
+ (equal v vertex))
+ :graph-completion-method :complete-closure-with-links
+ args))
;;; ---------------------------------------------------------------------------