いつのまに？

Common Lisp Interface Manager CLIM II Specification

http://bauhh.dyndns.org:8000/clim-spec/index.html

Apropos がいい。

[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)

なにもかも

最低なこのごろ。どうしたものか。

[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)))))))

[Common Lisp] UCW で Arc Challenge

UCW で Arc Challenge を書いてみた。

Arc より短かいく書くのは無理なので、なるべく UCW っぽく書いてみたつもり。

UCW として今回必要だったものは次のとおり

• サーバ（standard-server）
• アプリケーション(arc-challenge-application)
• ウィンドウコンポーネント(arc-challenge-window)
• foo 入力コンポーネント(input-foo-component)
• リンク表示コンポーネント(click-here-component)
• foo 表示コンポーネント(you-said-component)
• エントリポイント(index.ucw)

また UCW はコンポーネント指向なので arc-challenge-window をウィンドウコンポーネントとして定義し、そのボディ部分としてinput-foo-component, click-here-component, you-said-componentの3つのコンポーネントを定義した。

また UCW は継続ベースなのでエントリポイントと言う入口（最初に表示するページ）を定義する。エントリポイントでは (call 'arc-challenge-window) によってarc-challenge-window を表示している。

arc-challenge-window は initialize-instance :after で input-foo-componentを設定しているので foo 入力コンポーネントが表示される。

input-foo-component のフォームの :action で、call-component で arc-challenge-window の body 部分を切り替えることで、リンクの表示と foo の入力の表示を行っている。このあたりが継続っぽいところだと思う。

#|
http://www.paulgraham.com/arcchallenge.html
(defop said req
  (aform [w/link (pr "you said: " (arg _ "foo"))
         (pr "click here")]
         (input "foo")
         (submit)))
|#
(eval-when (:compile-toplevel :load-toplevel :execute)
  (require :ucw))

(in-package :ucw-user)

;; サーバのインスタンスを生成
(defvar *arc-challenge-server*
  (make-instance 'standard-server
                 :backend (make-backend :httpd :port 9090)))

;; アプリケーションを定義
(defclass arc-challenge-application (standard-application
                                     cookie-session-application-mixin)
  ()
  (:default-initargs
      :url-prefix "/arc-challenge/")) ; http://localhost:9090/arc-challenge/xxx

;; アプリケーションのインスタンスを生成
(defvar *arc-challenge-application* (make-instance 'arc-challenge-application))

;; サーバにアプリケーションを登録
(register-application *arc-challenge-server* *arc-challenge-application*)

;; ウィンドウコンポーネント
(defcomponent arc-challenge-window (standard-window-component)
  ()
  (:default-initargs
    :title "Arc Challenge"))

;; body の設定
(defmethod initialize-instance :after ((self arc-challenge-window) &rest rest)
  (declare (ignore rest))
  (with-slots (body) self
    (setf body (make-instance 'input-foo-component :window self))))

;; ウィンドウの描画
(defmethod render ((self arc-challenge-window))
  (<:h1 "Arc Challenge")
  (call-next-method))

;; foo 入力コンポーネント
(defcomponent input-foo-component ()
  ((window :initarg :window)))

;; その描画
(defmethod render ((self input-foo-component))
  (let ((foo ""))
    (<ucw:form
     :action (flet ((goto (&rest rest)
                      (with-slots (window) self
                        ;; arc-challenge-window の body 部分を切り替える。
                        (call-component self (apply #'make-instance rest)))))
               ;; リンク表示コンポーネント
               (goto 'click-here-component)
               ;; foo 表示コンポーネント
               (goto 'you-said-component :foo foo))
     "foo "
     (<ucw:input :type "text" :accessor foo)
     (<:submit))))

;; リンク表示コンポーネント
(defcomponent click-here-component () ())

;; その描画
(defmethod render ((self click-here-component))
  (<ucw:a :action (answer)
          "click here"))

;; foo 表示コンポーネント
(defcomponent you-said-component ()
  ((foo :initarg :foo)))

;; その描画
(defmethod render ((self you-said-component))
  (<:div "you said: "
         (<:as-html (slot-value self 'foo)))
  (<ucw:a :action (answer) "ok"))

;; エントリポイントを定義
(defentry-point "index.ucw" (:application *arc-challenge-application*)
    ()
  (call 'arc-challenge-window))

;; エラー発生時にデバッガを起動
(setf ucw-core:*debug-on-error* t)

;; サーバスタート
(defun start-arc-challenge ()
  "http://localhost:9090/arc-challenge/index.ucw
にアクセスしてください。"
  (startup-server *arc-challenge-server*))

[Common Lisp] ucw-core

ANN: UCW-CORE is ready. The future is now!

UCW が復活(?)のきざし。嬉しいな。

clbuild の my-projects に次を追加してインストールしてみた。

# UCW
ucw-core        get_darcs http://common-lisp.net/project/ucw/repos/ucw-core/
rfc2388-binary  get_darcs http://common-lisp.net/project/ucw/repos/rfc2388-binary/
rfc2109         get_darcs http://www.common-lisp.net/project/rfc2109/rfc2109/
local-time      get_darcs http://common-lisp.net/project/local-time/darcs/local-time
yaclml          get_darcs http://common-lisp.net/project/bese/repos/yaclml/
cl-mime         get_tarball http://www.bobturf.org/software/cl-mime/cl-mime-0.5.3.tar.gz
cl-qprint       get_tarball http://www.bobturf.org/software/cl-qprint/cl-qprint-0.2.1.tar.gz

(require :ucw) をしてから ./dome/dome.lisp をロードし(ucw-standard::startup-demo) とすると、サーバが起動する。

http://localhost:9090/demo/index.ucw にアクセスするとデモページが表示される。すんなりいった。

デモページの Test Form input でちゃんと日本語が通ることも確認できた。

あと ./manual/example-code.lisp にちょっとした例題があって、./manual/getting-started.txt に UCW の説明がある。

今日は動いた、ってとこまでで。