node.lsp
 Version 1.00  09 March 05
 Author Steven Jones

 Contact jones57@swbell.net include the word "nyquist" in subject line  

 The contents of this file are released under the terms of the GNU General
 Public License. See the file LICENSE.txt

 Provides the node class for building graphs.
 See also graph.lsp

class

 Defines a graph node. There is no separate graph class, instead graphs are
 defined by interconnecting instances of node.
 Each node has the following instance variables:
 .label     - Symbol used to identify this node.
 .payload   - Arbitrary value
 .edge-from - List of "input" edges
 .edge-to   - List of "output" edges
 .bidir     - Flag indicating if edges are bidirectional
 .multi     - Flag indicating if there may be multiple edges to same node.

method

 (send node :new label [:payload][:bidir][:multi])
 Construct new graph node object.

 label    - Symbol. The name for this node. 

 :payload - Any. The use of payload is purposefully undefined and left up 
            to the user. By default payload contains the same symbol as 
            label.
  
 :bidir   - Boolean. If true indicates that edges are bidirectional. 
            In practice a node is connected to a graph by placing adjacent 
            nodes in its edge-from and edge-to lists. The :link method takes 
            care of the mechanics of connecting nodes together. If bidir is 
            true when a node is linked it is placed in both the "from" and 
            "to" edge lists. Additionally this node is added to the 
            appropriate lists of the newly connected node. Default true

 :multi   - Boolean. If true multiple edges may connect to identical nodes. 
            Default true.

 return   - Object. A new instance of node

method

 (send  :label [val])
 Read and optionally change nodes label.

 val    - symbol. If specified change nodes label to val, default nil

 return - symbol. This nodes label

method

 (send  :payload [val])
 Read and optionally change payload

 val    - Any. The new payload value, if any. Default nil

 return - Any.

method

 (send  :get-input-edges)

 return - List. The list of nodes which link to this node.

method

 (send  :get-output-edges)

 return - List. The list of nodes which this node links to.

method

 (send  :is-bidirectional-p)
 
 return - Boolean. True if edges are bidirectional.

method

 (send  :is-multi-graph-p)

 return - True if multiple edges are allowed to the same node.

method

 (send  :links-to-p other)

 other  - Object. An instance of node

 return - Boolean. True if this node has an edge to other.

method

 (send  :links-from-p other)
 
 other  - Object. An instance of node

 return - Boolean. True if other has an edge to this node.

method

 (send  :link other)
 Add edge(s) to (from) other node.

 other  - Object. An instance of node

method

 (send  :frequency other [labtest [to]])
 Count the number of edges between this node and other.

 other   - Object | Symbol. An instance of node or a symbol 
           representing a nodes label.  

 labtest - Boolean. If true the test checks for label equality instead of 
           object identity. Default nil

 to      - Boolean. Indicates which edge set to check. If true count nodes in
           the edge-to list. If false count the edge-from list. Default True

 return  - Integer. 

method

 (send  :walk)
 Pick adjacent node at random
 return - Object. An instance of node 

method

 (send  :rep [echo])
 Produce string representation of this node.

 echo   - Boolean. If true result is dumped to standard out.
          Default True

 return - String | NIL. If echo is false return a string, otherwise 
          return nil.

function

 (node:eq lab node)
 Node equality test.

 lab    - symbol or object. If lab is a symbol it is checked against node's 
          label. If lab is an object the test uses eq to determine if lab 
          and node are identical.

 node   - object. An instance of node.

 return - Boolean. True if lab is either eq to node or is a symbol which is 
          eq to node's label.

function

 (node:member lab lst)
 Check for nodes membership in list.

 lab    - symbol or object. See node:eq

 lst    - list.

 return - list or nil. If no node matches lab using node:eq return nil. 
          If there is a match return the portion of lst starting at the 
          position of matching node.

function

 (node:locate lst lab)
 Determin the least index of node within a list.

 lst    - list.

 lab    - symbol or object. See node:eq

 return - integer or nil. If lst does not contain a matching node to 
          lab, return nil. If a matching node is located return it's 
          position within the list.

;; node.lsp
;; Version 1.00  09 March 05
;; Author Steven Jones
;;
;; Contact jones57@swbell.net include the word "nyquist" in subject line  
;;
;; The contents of this file are released under the terms of the GNU General
;; Public License. See the file LICENSE.txt
;;
;; Provides the node class for building graphs.
;; See also graph.lsp
;;

(provide 'node)
(current-file "node")


; ***************************************************************************  
;			       NODE CLASS
; ***************************************************************************  

;; @doc class node
;; Defines a graph node. There is no separate graph class, instead graphs are
;; defined by interconnecting instances of node.
;; Each node has the following instance variables:
;; .label     - Symbol used to identify this node.
;; .payload   - Arbitrary value
;; .edge-from - List of "input" edges
;; .edge-to   - List of "output" edges
;; .bidir     - Flag indicating if edges are bidirectional
;; .multi     - Flag indicating if there may be multiple edges to same node.
;;

(setf node (send class :new '(.label .edge-from .edge-to 
					   .payload .bidir .multi)))


;; @doc method node :new
;; (send node :new label [:payload][:bidir][:multi])
;; Construct new graph node object.
;;
;; label    - Symbol. The name for this node. 
;;
;; :payload - Any. The use of payload is purposefully undefined and left up 
;;            to the user. By default payload contains the same symbol as 
;;            label.
;;  
;; :bidir   - Boolean. If true indicates that edges are bidirectional. 
;;            In practice a node is connected to a graph by placing adjacent 
;;            nodes in its edge-from and edge-to lists. The :link method takes 
;;            care of the mechanics of connecting nodes together. If bidir is 
;;            true when a node is linked it is placed in both the "from" and 
;;            "to" edge lists. Additionally this node is added to the 
;;            appropriate lists of the newly connected node. Default true
;;
;; :multi   - Boolean. If true multiple edges may connect to identical nodes. 
;;            Default true.
;;
;; return   - Object. A new instance of node
;;

(send node :answer :isnew '(label &key payload (bidir 't)(multi 't))
      '((setf .label label)
	(setf .edge-from '())
	(setf .edge-to '())
	(setf .payload (or payload (->string label)))
	(setf .bidir bidir)
	(setf .multi multi)
	))


;; @doc method node :label
;; (send  :label [val])
;; Read and optionally change nodes label.
;;
;; val    - symbol. If specified change nodes label to val, default nil
;;
;; return - symbol. This nodes label
;;

(send node :answer :label '(&optional val)
      '((if val (setf .label val))
	.label))


;; @doc method node :payload
;; (send  :payload [val])
;; Read and optionally change payload
;;
;; val    - Any. The new payload value, if any. Default nil
;;
;; return - Any.
;;

(send node :answer :payload '(&optional val)
      '((if val (setf .payload val))
	.payload))


;; @doc method node :get-input-edges
;; (send  :get-input-edges)
;;
;; return - List. The list of nodes which link to this node.
;;

(send node :answer :get-input-edges '()
      '(.edge-from))


;; @doc method node :get-output-edges
;; (send  :get-output-edges)
;;
;; return - List. The list of nodes which this node links to.
;;

(send node :answer :get-output-edges '()
      '(.edge-to))


;; @doc method node :is-bidirectional-p
;; (send  :is-bidirectional-p)
;; 
;; return - Boolean. True if edges are bidirectional.
;;

(send node :answer :is-bidirectional-p '()
      '(.bidir))


;; @doc method node :is-multi-graph-p
;; (send  :is-multi-graph-p)
;;
;; return - True if multiple edges are allowed to the same node.
;;

(send node :answer :is-multi-graph-p '()
      '(.multi))


;; @doc method node :links-to-p
;; (send  :links-to-p other)
;;
;; other  - Object. An instance of node
;;
;; return - Boolean. True if this node has an edge to other.
;;

(send node :answer :links-to-p '(other)
      '((member other .edge-to)))


;; @doc method node :links-from-p
;; (send  :links-from-p other)
;; 
;; other  - Object. An instance of node
;;
;; return - Boolean. True if other has an edge to this node.
;;

(send node :answer :links-from-p '(other)
      '((member other .edge-from )))


;; private method
;;

(send node :answer :-link-to '(other)
      '((if (or (send self :is-multi-graph-p)
		(not (send self :links-to-p other)))
	    (progn
	      (setf .edge-to (cons other .edge-to))
	      t)
	  nil)))


;; private method
;;

(send node :answer :-link-from '(other)
      '((if (or (send self :is-multi-graph-p)
		(not (send self :links-from-p other)))
	    (progn 
	      (setf .edge-from (cons other .edge-from))
	      t)
	  nil)))


;; @doc method node :link
;; (send  :link other)
;; Add edge(s) to (from) other node.
;;
;; other  - Object. An instance of node
;;

(send node :answer :link '(other)
      '((if (and (send self :-link-to other)
		 (send self :is-bidirectional-p))
	    (progn 
	      (send self :-link-from other)
	      (send other :-link-to self)
	      (send other :-link-from self)
	      t)
	  nil)))



;; @doc method node :frequency
;; (send  :frequency other [labtest [to]])
;; Count the number of edges between this node and other.
;;
;; other   - Object | Symbol. An instance of node or a symbol 
;;           representing a nodes label.  
;;
;; labtest - Boolean. If true the test checks for label equality instead of 
;;           object identity. Default nil
;;
;; to      - Boolean. Indicates which edge set to check. If true count nodes in
;;           the edge-to list. If false count the edge-from list. Default True
;;
;; return  - Integer. 
;;

(send node :answer :frequency '(other &optional (labtest 'nil)(to 't))
      '((let (count test-list)
	  (setf count 0)
	  (setf test-list (if to .edge-to .edge-from))
	  (dolist (obj test-list)
	    (if labtest
		(if (eq (send other :label)(send obj :label))
		    (setf count (+ count 1)))
	      (if (eq other obj)
		  (setf count (+ count 1)))))
	  count)))



;; @doc method node :walk
;; (send  :walk)
;; Pick adjacent node at random
;; return - Object. An instance of node 
;;

(send node :answer :walk '()
      '((pick .edge-to)))
      
;; @doc method node :rep
;; (send  :rep [echo])
;; Produce string representation of this node.
;;
;; echo   - Boolean. If true result is dumped to standard out.
;;          Default True
;;
;; return - String | NIL. If echo is false return a string, otherwise 
;;          return nil.
;;

(send node :answer :rep '(&optional (echo t))
      '((let ((acc (format nil "NODE: ~a~%" .label)))
	  (dolist (obj .edge-to)
	    (if (send self :links-from-p obj)
		(setf acc (format nil "~a   ~a <-> ~a~%" acc .label (send obj :label)))
	      (setf acc   (format nil "~a   ~a  -> ~a~%" acc .label (send obj :label)))))
	  (dolist (obj .edge-from)
	    (if (not (send self :links-to-p obj))
		(setf acc (format nil "~a   ~a -> ~a~%" acc (send obj :label) .label))))
	  (format echo "~%~a" acc))))


;; @doc function node:eq
;; (node:eq lab node)
;; Node equality test.
;;
;; lab    - symbol or object. If lab is a symbol it is checked against node's 
;;          label. If lab is an object the test uses eq to determine if lab 
;;          and node are identical.
;;
;; node   - object. An instance of node.
;;
;; return - Boolean. True if lab is either eq to node or is a symbol which is 
;;          eq to node's label.
;;

(defun node:eq (lab node)
  (if (symbolp lab)
      (eq lab (send node :label))
    (eq lab node)))


;; @doc function node:member 
;; (node:member lab lst)
;; Check for nodes membership in list.
;;
;; lab    - symbol or object. See node:eq
;;
;; lst    - list.
;;
;; return - list or nil. If no node matches lab using node:eq return nil. 
;;          If there is a match return the portion of lst starting at the 
;;          position of matching node.
;;

(defun node:member (lab lst)
  (member lab lst :test #'node:eq))


;; @doc function node:locate
;; (node:locate lst lab)
;; Determin the least index of node within a list.
;;
;; lst    - list.
;;
;; lab    - symbol or object. See node:eq
;;
;; return - integer or nil. If lst does not contain a matching node to 
;;          lab, return nil. If a matching node is located return it's 
;;          position within the list.
;;

(defun node:locate (lst lab)
  (locate lst lab :test #'node:eq))