いつのまに？
Common Lisp Interface Manager CLIM II Specification
http://bauhh.dyndns.org:8000/clim-spec/index.html
Apropos がいい。
2009/02/22
[Common Lisp][McCLIM] まるでも描くか
手を動かそう。
(require :mcclim)
(in-package :clim-user)
(defun draw (frame stream)
(declare (ignore frame))
(loop for i from 1 to 100 by (random 10)
do (draw-circle* stream (+ 100 i) (+ 100 i i) 30
:filled nil
:ink (make-rgb-color
(random 1.0) (random 1.0) (random 1.0)))))
(define-application-frame nn-frame ()
()
(:menu-bar t)
(:panes
(canvas :application
:min-width 500
:min-height 500
:scroll-bars nil
:display-time :command-loop ; command の度に描画する
:display-function 'draw))
(:layouts
(defalut (horizontally () canvas))))
(define-nn-frame-command (com-quit :menu t) ()
(frame-exit *application-frame*))
(define-nn-frame-command (com-redraw :menu t) ()
;; :display-time :command-loop なので何もする必要なし
)
(defun run ()
(run-frame-top-level
(make-application-frame 'nn-frame)))
;;(run)
2009/02/21
[Common Lisp][ニューラルネットワーク] 教師つきの単純なニューラルネットワーク
前回はランダムな重みづけてネットワークを作りなおしていたが、今回は期待した出力でない場合に重みをちょっとずつ修正するネットワークにした。『脳 回路網のなかの精神』の次のステップね。
ロジックは適当、実装もぐぐちゃべただけど、ちゃんと学習しているよね？だいたい10回くらいの繰り返しで、学習が完了して、期待したネットワークができあがる。
グラフィカルな表示が欲しいな。Context Free とか Processing とかだと簡単にできるのかな。
#|
単純なネットワーク
教師つき学習バージョン。
期待するネットワーク
パターン1
● ●
○ -> ○
● ○
パターン2
● ○
● -> ●
● ○
パターン3
○ ○
● -> ○
○ ●
|#
(defparameter *threshold* 0.8 "閾値")
(defparameter *delta* 0.1)
(defclass value-mixin ()
((value :initarg :value :initform nil :accessor value-of)))
(defclass name-mixin ()
((name :initarg :name :initform "unknown" :accessor name-of)))
(defclass 2layer-network ()
((input :initarg :input :initform nil :accessor input-of)
(output :initarg :ouput :initform nil :accessor output-of)))
(defclass connection ()
((from :initarg :from :accessor from-of)
(to :initarg :to :accessor to-of)
(weight :initarg :weight :accessor weight-of)))
(defclass neuron (value-mixin name-mixin)
((froms :initarg :froms :initform nil :accessor froms-of)
(tos :initarg :tos :initform nil :accessor tos-of))
(:default-initargs :value 0.0))
(defmethod print-object ((x connection) stream)
(print-unreadable-object (x stream)
(format stream "~a *~d ~a" (name-of (from-of x)) (weight-of x)
(name-of (to-of x)))))
(defmethod print-object ((x neuron) stream)
(print-unreadable-object (x stream)
(mapc (lambda (connection) (print-object connection stream))
(tos-of x))))
(defmethod fire ((neuron neuron))
(mapc #'fire (tos-of neuron)))
(defmethod fire ((connection connection))
(fired (to-of connection) (weight-of connection)))
(defmethod fired ((neuron neuron) weight)
(incf (value-of neuron) weight))
(defmethod fire-p ((neuron neuron))
(< *threshold* (value-of neuron)))
(defmethod clear ((neuron neuron))
(setf (value-of neuron) 0.0))
(defun init-random-weight ()
(- (random 0.4) 0.2))
(defmethod connect ((from neuron) (to neuron)
&optional (weight (init-random-weight)))
(let ((connection
(make-instance 'connection :from from :to to :weight weight)))
(push connection (tos-of from))
(push connection (froms-of to))))
(defmethod get-connection ((from neuron) (to neuron))
(find to (tos-of from) :key #'to-of))
(defmacro with-2layer-network ((inputs outputs) &body body)
`(let ,(mapcar (lambda (x) `(,x (make-instance 'neuron :name ',x)))
(append inputs outputs))
(loop for i in (list ,@inputs)
do (loop for j in (list ,@outputs)
do (connect i j)))
,@body))
(defun ensure-fire (from to)
(if (fire-p to)
t
(prog1 nil
(let ((delta *delta*)
(connection (get-connection from to)))
(incf (weight-of connection) delta)))))
(defun ensure-not-fire (from to)
(if (not (fire-p to))
t
(prog1 nil
(let ((delta *delta*)
(connection (get-connection from to)))
(decf (weight-of connection) delta)))))
(defun all-t-p (&rest args)
(every #'identity args))
(defun main ()
(with-2layer-network ((a b c) (x y z))
(loop
for i from 1
until (all-t-p
(not (sleep 0.5))
(print (list i a b c))
(prog1 (all-t-p (mapc #'fire (list a c))
(print (list (mapcar #'fire-p (list x y z))))
(ensure-fire a x)
(ensure-fire c x)
(ensure-not-fire a y)
(ensure-not-fire c y)
(ensure-not-fire a z)
(ensure-not-fire c z))
(clear x) (clear y) (clear z))
(prog1 (all-t-p (mapc #'fire (list a b c))
(print (list (mapcar #'fire-p (list x y z))))
(ensure-fire a y)
(ensure-fire b y)
(ensure-fire c y)
(ensure-not-fire a x)
(ensure-not-fire b x)
(ensure-not-fire c x)
(ensure-not-fire a z)
(ensure-not-fire b z)
(ensure-not-fire c z))
(clear x) (clear y) (clear z))
(prog1 (all-t-p (mapc #'fire (list b))
(print (list (mapcar #'fire-p (list x y z))))
(ensure-fire b z)
(ensure-not-fire b x)
(ensure-not-fire b y))
(clear x) (clear y) (clear z))))))
[Common Lisp][ニューラルネットワーク] 単純なニューラルネットワーク
『脳 回路網のなかの精神』を読んだ。
おもしろい。ニューラルネットワークで遊んでみたくなった。まずはしめは、この本にも出てくる3つの入力と3つの出力からなる単純なネットワークを作ってみる。
重みづけを学習するのは次のステップとして、今回は期待する出力が得らるれまで、ランダムで重みづけをしながらネットワーク作成する。
#|
パターン1
● ●
○ -> ○
● ○
パターン2
● ○
● -> ●
● ○
パターン3
○ ○
● -> ○
○ ●
|#
(defclass value-mixin ()
((value :initarg :value :initform nil :accessor value-of)))
(defclass name-mixin ()
((name :initarg :name :initform "unknown" :accessor name-of)))
(defclass 2layer-network ()
((input :initarg :input :initform nil :accessor input-of)
(output :initarg :ouput :initform nil :accessor output-of)))
(defclass connection ()
((from :initarg :from :accessor from-of)
(to :initarg :to :accessor to-of)
(weight :initarg :weight :accessor weight-of)))
(defclass neuron (value-mixin name-mixin)
((connections :initarg :connections :initform nil :accessor connections-of))
(:default-initargs :value 0.0))
(defmethod print-object ((x connection) stream)
(print-unreadable-object (x stream)
(format stream "~a *~d ~a" (name-of (from-of x)) (weight-of x)
(name-of (to-of x)))))
(defmethod print-object ((x neuron) stream)
(print-unreadable-object (x stream)
(mapc (lambda (connection) (print-object connection stream))
(connections-of x))))
(defmethod fire ((neuron neuron))
(mapc #'fire (connections-of neuron)))
(defmethod fire ((connection connection))
(fired (to-of connection) (weight-of connection)))
(defmethod fired ((neuron neuron) weight)
(incf (value-of neuron) weight))
(defmethod fire-p ((neuron neuron))
(prog1 (< 0.8 (value-of neuron))
(setf (value-of neuron) 0.0)))
(defun init-random-weight ()
(1- (random 2.0)))
(defmethod connect ((from neuron) (to neuron)
&optional (weight (init-random-weight)))
(let ((connection
(make-instance 'connection :from from :to to :weight weight)))
(push connection (connections-of from))))
(defmacro with-2layer-network ((inputs outputs) &body body)
`(let ,(mapcar (lambda (x) `(,x (make-instance 'neuron :name ',x)))
(append inputs outputs))
(loop for i in (list ,@inputs)
do (loop for j in (list ,@outputs)
do (connect i j)))
,@body))
(defun main ()
(loop
until (with-2layer-network ((a b c) (x y z))
(let* ((r1 (progn (mapc #'fire (list a c))
(list (fire-p x) (fire-p y) (fire-p z))))
(r2 (progn (mapc #'fire (list a b c))
(list (fire-p x) (fire-p y) (fire-p z))))
(r3 (progn (mapc #'fire (list b))
(list (fire-p x) (fire-p y) (fire-p z)))))
(and (equal r1 '(t nil nil))
(equal r2 '(nil t nil))
(equal r3 '(nil nil t))
(print (list r1 r2 r3))
(print (list a b c)))))))
登録:
投稿 (Atom)
