Source

cl-fgraph / source / edge / labeled-edge.lisp

Full commit
(in-package #:fgraph)

(defclass labeled-edge ()
  ((%edge :type (or set cons)
	  :initarg :edge
	  :reader edge)
   (%label :initarg :label
	   :reader label)))

(defun make-labeled-edge (edge label)
  (make-instance 'labeled-edge
		 :edge edge
		 :label label))

(defmethod print-object ((object labeled-edge)
			 stream)
  (format stream "#<LABELED-EDGE ~A label:~A>"
	  (let ((edgestring (format nil "~A"
				    (edge object))))
	    (string-trim " #(<{[|]}>)" edgestring))
	  (label object)))

(defmethod source? ((edge labeled-edge)
		    source)
  (source? (edge edge)
	   source))

(defmethod target? ((edge labeled-edge)
		    target)
  (target? (edge edge)
	   target))

(defmethod target-of ((edge labeled-edge)
		      source)
  (target-of (edge edge)
	     source))

(defmethod edge-properties? ((edge labeled-edge)
			     &rest properties &key source target
			     (label nil label?))
  (declare (ignore source target))
  (and (or (not label?)
	   (equal? (label edge)
		   label))
       (apply #'edge-properties?
	      (edge edge)
	      properties)))

(defmethod replace-ends ((edge labeled-edge)
			 (replacement map))
  (make-instance 'labeled-edge
		 :label (label edge)
		 :edge (replace-ends (edge edge)
				     replacement)))

(defmethod make-edge ((type (eql :labeled))
		      source target &rest properties &key subedge-type
		      label &allow-other-keys)
  (declare (ignore type))
  (make-instance 'labeled-edge
		 :edge (apply #'make-edge subedge-type source target
			      properties)
		 :label label))

(defmethod valid-edge? ((edge labeled-edge)
			(nodes set))
  (valid-edge? (edge edge)
	       nodes))