csys improvements: make-neuron, update-neuron, ...
This commit is contained in:
parent
78be34bfae
commit
8e66cd63ed
2 changed files with 21 additions and 22 deletions
|
|
@ -10,11 +10,11 @@
|
||||||
(:shape :scopes/shape)
|
(:shape :scopes/shape)
|
||||||
(:util :scopes/util)
|
(:util :scopes/util)
|
||||||
(:alx :alexandria))
|
(:alx :alexandria))
|
||||||
(:export #:environment #:*environment* #:actions #:set-action
|
(:export #:environment #:*environment*
|
||||||
#:init-zero
|
#:init
|
||||||
#:send #:send-message
|
#:send #:send-message
|
||||||
#:neuron #:synapse
|
#:neuron #:synapse
|
||||||
#:std-proc))
|
#:create-neuron #:update-neuron))
|
||||||
|
|
||||||
(in-package :scopes/csys)
|
(in-package :scopes/csys)
|
||||||
|
|
||||||
|
|
@ -27,16 +27,10 @@
|
||||||
|
|
||||||
(defvar *environment* (make-instance 'environment))
|
(defvar *environment* (make-instance 'environment))
|
||||||
|
|
||||||
(defun action (env key &optional default)
|
|
||||||
(gethash key (actions env) default))
|
|
||||||
|
|
||||||
(defun set-action (env key act)
|
|
||||||
(setf (gethash key (actions env)) act))
|
|
||||||
|
|
||||||
;;;; sensors: automatically created actors (neuron), addressable via message head
|
;;;; sensors: automatically created actors (neuron), addressable via message head
|
||||||
|
|
||||||
(defun init-zero (probe)
|
(defun init (probe)
|
||||||
(set-action *environment* :sensor #'create-sensor)
|
(setf (gethash :sensor (actions *environment*)) #'create-sensor)
|
||||||
(let ((zero (actor:create (neuron #'std-proc 0 (list (synapse probe))))))
|
(let ((zero (actor:create (neuron #'std-proc 0 (list (synapse probe))))))
|
||||||
(setf (gethash '(:init :zero) (sensors *environment*)) (list zero))))
|
(setf (gethash '(:init :zero) (sensors *environment*)) (list zero))))
|
||||||
|
|
||||||
|
|
@ -52,7 +46,7 @@
|
||||||
(defun find-sensors (msg)
|
(defun find-sensors (msg)
|
||||||
(let* ((key (cddr (shape:head msg)))
|
(let* ((key (cddr (shape:head msg)))
|
||||||
(sns (gethash key (sensors *environment*))))
|
(sns (gethash key (sensors *environment*))))
|
||||||
(util:lgi key sns)
|
;(util:lgi key sns)
|
||||||
sns))
|
sns))
|
||||||
|
|
||||||
;;;; neurons (= behavior factories) and synapses (connection factories)
|
;;;; neurons (= behavior factories) and synapses (connection factories)
|
||||||
|
|
@ -65,10 +59,17 @@
|
||||||
(lambda (msg)
|
(lambda (msg)
|
||||||
(actor:send rcvr (funcall op msg))))
|
(actor:send rcvr (funcall op msg))))
|
||||||
|
|
||||||
|
(defun make-neuron (syn-target &key (proc #'std-proc) state
|
||||||
|
(syn-op #'identity) (env *environment*))
|
||||||
|
(actor:create (neuron proc state (list (synapse syn-target syn-op)) env)))
|
||||||
|
|
||||||
|
(defun update-neuron (proc state syns &optional (env *environment*))
|
||||||
|
(actor:become (neuron proc state syns env)))
|
||||||
|
|
||||||
;;;; predefined neuron processors and helper / utility funtions
|
;;;; predefined neuron processors and helper / utility funtions
|
||||||
|
|
||||||
(defun std-proc (msg state syns env)
|
(defun std-proc (msg state syns env)
|
||||||
(util:lgi msg state)
|
;(util:lgi msg state)
|
||||||
(destructuring-bind (nmsg nst syns)
|
(destructuring-bind (nmsg nst syns)
|
||||||
(handle-action msg state syns env :default #'remember)
|
(handle-action msg state syns env :default #'remember)
|
||||||
(forward nmsg syns)
|
(forward nmsg syns)
|
||||||
|
|
@ -78,18 +79,15 @@
|
||||||
(dolist (s syns)
|
(dolist (s syns)
|
||||||
(funcall s msg)))
|
(funcall s msg)))
|
||||||
|
|
||||||
(defun handle-action (msg state syns env &key default)
|
(defun handle-action (msg state syns env &key (default #'no-op))
|
||||||
(let* ((key (shape:head-value msg :action))
|
(let* ((key (shape:head-value msg :action))
|
||||||
(act (action env key default)))
|
(act (gethash key (actions env) default)))
|
||||||
(funcall act msg state syns env)
|
(funcall act msg state syns env)))
|
||||||
;(or (and act (funcall act msg state syns env))
|
|
||||||
;(list msg state syns)))
|
|
||||||
))
|
|
||||||
|
|
||||||
;;;; predefined neuron actions
|
;;;; predefined neuron actions
|
||||||
|
|
||||||
(defun no-op (msg state syns env)
|
(defun no-op (msg state syns env)
|
||||||
(list msg (shape:data msg) syns))
|
(list msg state syns))
|
||||||
|
|
||||||
(defun remember (msg state syns env)
|
(defun remember (msg state syns env)
|
||||||
(list msg (shape:data msg) syns))
|
(list msg (shape:data msg) syns))
|
||||||
|
|
|
||||||
|
|
@ -26,9 +26,10 @@
|
||||||
(defun probe (msg state syns env)
|
(defun probe (msg state syns env)
|
||||||
(let ((t:*test-suite* (test-suite env))
|
(let ((t:*test-suite* (test-suite env))
|
||||||
(val (shape:data msg)))
|
(val (shape:data msg)))
|
||||||
|
(util:lgi msg state)
|
||||||
(unless (consp val)
|
(unless (consp val)
|
||||||
(let ((nst (in-seq val state :remove t)))
|
(let ((nst (in-seq val state :remove t)))
|
||||||
(actor:become (csys:neuron #'probe nst syns env))))))
|
(csys:update-neuron #'probe nst syns env)))))
|
||||||
|
|
||||||
(defvar *probe* nil)
|
(defvar *probe* nil)
|
||||||
|
|
||||||
|
|
@ -54,7 +55,7 @@
|
||||||
(t:show-result))))
|
(t:show-result))))
|
||||||
|
|
||||||
(deftest test-init ()
|
(deftest test-init ()
|
||||||
(csys:init-zero *probe*)
|
(csys:init *probe*)
|
||||||
(csys:send-message '(:csys :sensor :init :zero) '(:std :s1))
|
(csys:send-message '(:csys :sensor :init :zero) '(:std :s1))
|
||||||
(csys:send-message '(:csys :sensor :init :zero) '(:std :s2))
|
(csys:send-message '(:csys :sensor :init :zero) '(:std :s2))
|
||||||
(sleep 0.1)
|
(sleep 0.1)
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue