tree@sun.soe.clarkson.edu (Tom Emerson) (05/04/88)
For those who may be interested, I have written a SAN (Spreading Activation
Network) simulator in Common LISP (Kyoto Common LISP on a Sun 3/50) as part
of a class here at Clarkson U. I also have the documentation available in
LaTeX format for those who are interested (I could also be persuaded to supply
it in PostScript source, but the file is in excess of 240K).
The simulator, really more of a network "construction set", was written
specifically as a model of the human disambiguation process. The report
goes into the model in more detail, as well as the functions used for
activation, inhibition, and decay.
Along with the source code I have included a sample network representing the
immediate semantic knowledge needed to disambiguate the sentence "the
astronomer married a star." This file should be loaded into the LISP
listener *after* the simulator has been. To initiate the spread of
activation through the network, enter (start) at the prompt. The status
of the network will be displayed before the function prompts the user for
information. Try running the simulation for 15 time steps with the input
nodes being (astronomer marry star) with an initial value of 0.5. Hit the
Return (or Enter) key after each time step. After 15 cycles, notice which
nodes are still activate.
The code follows. It has been run both on the Sun and a PC (using David
Betz's XLISP version 2.0). Sorry for the blahness of the output, but... :-)
The source code follows
----------------------------- Cut Here ---------------------------------------
;;; ***********************************************************************
;;;
;;; The Disambiguation of English Text
;;; Through the use of Activation Networks
;;;
;;; Thomas R. Emerson (40405)
;;;
;;; A Program to fulful the project requirement of
;;; PY350 - Artificial Intelligence - Spring '88
;;; Clarkson University
;;;
;;; ***********************************************************************
;;;
;;; Program Version: 1.3
;;; Program Started: March 7, 1988
;;; Program Completed: April 13, 1988
;;;
;;; To Robin, for her constant flow of ideas and support
;;;
;;; ***********************************************************************
;; ****************************************************************
;; Set constants and global variables
;; ****************************************************************
(setq *NETWORK* '()) ; Holds all defined nodes
(setq *ACTIVE_NODES* '()) ; List holding active links
(setq *DELTA* 0.15) ; Decay constant
(setq *H* -0.40) ; Inhibition constant
(setq *ALPHA* 0.25) ; Activation constant
;; ***************************************************************
;; Macro definitions
;; ***************************************************************
; add_to_activation - will add the value supplied to the activation
; value of the node, and will put this new value in the property list.
(defmacro add_to_activation (value node)
`(putprop ,node (+ ,value (get ,node 'activation)) 'activation))
; receive - will add the value supplied to the input value of the node,
; and will put this new value back on the property list.
(defmacro receive (node value)
`(putprop ,node (+ (get ,node 'input) ,value) 'input))
; prime - a front end macro allowing the user to add value to the
; activation of the node specified.
(defmacro prime (node value)
`(add_to_activation ,value ,node))
; putprop - a hack for Kyoto Common LISP because of its lacking the
; putprop function. Written here as a macro for fun and convienience.
; Remove if the code is being run on a LISP implementation that has
; putprop.
(defmacro putprop (symbol value property)
`(setf (get ,symbol ,property) ,value))
;; ***************************************************************
;; Input/Output functions
;; ***************************************************************
; prompt - prompt the user for input and return the atom entered
(defun prompt (prompt_string)
(princ prompt_string)
(read))
; display_node - will display the node, its current activation, and
; the links originating at the node
(defun display_node (node)
(princ "Node Name: ")
(print node)
(princ "Activation: ")
(print (get node 'activation))
(princ "Activation Links: ")
(print (get node 'alinks))
(princ "Inhibition Links: ")
(princ (get node 'ilinks)) (terpri))
; graph-node - display an individual node and one of its connections
(defun graph_node (node daughter link)
(princ node) (princ "(") (princ (get node 'activation))
(princ ") ") (princ link) (princ " ") (princ daughter)
(princ "(") (princ (get daughter 'activation)) (princ ")")
(terpri))
; show_node - graphically displays a single node and all its connections
(defun show_node (node)
(dolist (each_node (get node 'alinks))
(graph_node node each_node '-->))
(dolist (each_node (get node 'ilinks))
(graph_node node each_node '--O)))
; show_net - graphically displays the entire network
(defun show_net ()
(dolist (nodes *NETWORK*) (show_node nodes)))
; show_activation - display the activation of all nodes in the network
(defun show_activation (node)
(princ node) (princ "(")
(princ (get node 'activation)) (princ ")") (terpri))
; status - displays the current status of the constants used in the network
(defun status()
(princ "Delta: ") (princ *DELTA*) (terpri)
(princ "Alpha: ") (princ *ALPHA*) (terpri)
(princ "H: ") (princ *H*) (terpri))
;; ***************************************************************
;; Functions to handle the creation, modification, and deletion
;; of individual nodes.
;; ***************************************************************
; define_node - will create the initial representation of a node, with a
; default activation value of 0 and no links. A different activation value
; can be assigned through the use of an optional parameter.
(defun define_node (node_name &optional (act_value 0))
(putprop node_name act_value 'activation) ; Store the activation value
(putprop node_name '() 'alinks) ; Activation links
(putprop node_name '() 'ilinks) ; Inhibition links
(putprop node_name 0 'input)
(setq *NETWORK* (append *NETWORK* (list node_name)))
(cons node_name '(defined)))
; add_link - will connect name with node via link
(defun add_link (name link node)
(cond ((equal link '<-->) (putprop name
(append (get name 'alinks) (list node))
'alinks)
(putprop node
(append (get node 'alinks) (list name))
'alinks))
((equal link 'O--O) (putprop name
(append (get name 'ilinks) (list node))
'ilinks)
(putprop node
(append (get node 'ilinks) (list name))
'ilinks))
((equal link '-->) (putprop name
(append (get name 'alinks) (list node))
'alinks))
((equal link '--O) (putprop name
(append (get name 'ilinks) (list node))
'ilinks))
(t '(error in function add_link))))
; reset_net - will reset the activation value of all nodes to 0
(defun reset_net ()
(dolist (node *NETWORK* 'done)
(putprop node 0 'activation)))
;; ***************************************************************
;; Functions for spreading activation
;; ***************************************************************
(defun start ()
(princ "NETWORK STATUS") (terpri)
(show_net) (terpri)
(status) (terpri)
(setq time_steps (prompt "Enter the number of time steps: "))
(setq source (prompt "Source node(s): "))
(setq input (prompt "Input value: ")) ; get c*
; allow the user to supply a list of source nodes (for multiple
; applications of c*.) The user can also supply an atom representing
; input into a sigle node. c* is constant for every node, i.e.
; each node in the list gets the same value of c*.
(cond ((listp source) (dolist (node source) ; if a list...
(putprop node
(+ input (get node 'activation))
'activation)))
(t (putprop source ; if not...
(+ input (get source 'activation))
'activation)))
(dotimes (ts time_steps)
(princ "Time Step: ") (princ (1+ ts)) (terpri)
(dolist (node *NETWORK*)
(spread node))
(update)
(decay)
(read-char))
(terpri))
(defun spread (node)
(cond ((not (zerop (get node 'activation)))
(setq c (* (get node 'activation) *ALPHA*))
(dolist (l (get node 'alinks))
(receive l c))
(setq c (* (get node 'activation) *H*))
(dolist (l (get node 'ilinks))
(receive l c)))))
(defun update ()
(dolist (node *NETWORK*)
(setq new_activation (+ (get node 'activation) (get node 'input)))
(cond ((minusp new_activation)
(putprop node 0 'activation))
(t (putprop node new_activation 'activation)))
(putprop node 0 'input)
(cond ((zerop (get node 'activation)) t)
(t (show_activation node)))))
;; ***************************************************************
;; decay function
;; ***************************************************************
(defun decay ()
(dolist (node *NETWORK*)
(putprop node
(- (get node 'activation)
(* (get node 'activation) *DELTA*))
'activation)))
; ***************************************************************
; (c) 1988 by Tom Emerson
; All rights reserved
; ***************************************************************
----------------------------- Cut Here ---------------------------------------
The code below is the sample network described above.
----------------------------- Cut Here ---------------------------------------
;;; ***********************************************************************
;;;
;;; The Disambiguation of English Text
;;; Through the use of Activation Networks
;;;
;;; Thomas R. Emerson (40405)
;;;
;;; PY350 - Artificial Intelligence - Spring '88
;;; Clarkson University
;;;
;;; ***********************************************************************
; Define the nodes
(define_node 'astronomer) (define_node 'astronomy)
(define_node 'star) (define_node 'actor)
(define_node 'astral_body) (define_node 'geometric_figure)
(define_node 'animate) (define_node 'inanimate)
(define_node 'human) (define_node 'marry)
; Set up the links
(add_link 'astronomer '<--> 'astronomy)
(add_link 'astronomy '<--> 'astral_body)
(add_link 'astral_body 'O--O 'geometric_figure)
(add_link 'astral_body 'O--O 'actor)
(add_link 'geometric_figure 'O--O 'actor)
(add_link 'star '<--> 'astral_body)
(add_link 'star '<--> 'actor)
(add_link 'star '<--> 'geometric_figure)
(add_link 'human '<--> 'actor)
(add_link 'human '<--> 'astronomer)
(add_link 'animate '<--> 'human)
(add_link 'human '<--> 'marry)
(add_link 'animate 'O--O 'inanimate)
(add_link 'inanimate '<--> 'astral_body)
(add_link 'inanimate '<--> 'geometric_figure)
; Define the values for alpha, delta, and h
(setq *DELTA* .15)
(setq *ALPHA* .20)
(setq *H* -.45)
----------------------------- Cut Here ---------------------------------------
We will be finished here in a week, and I will disappear for a couple of
months. I may post the documentation if enough people request it.
Have Fun!!!!!
-----------------------------------------------
-- --
-- Tom Emerson (Tree) --
-- tree@sun.soe.clarkson.edu --
-- --
-- ``LISP Hackers are (bound-to '(doit))'' --
-- --
-----------------------------------------------