Archive for 2010年10月27日|Daily archive page

newLISP で GUI する。。。または、自己組織化マップを表示してみる

 池谷裕二氏の著作、“単純な脳、複雑な「私」”(ISBIN:4255004323)に載っていた自己組織化マップを newLISP で書いてみました。
 スクリプトは、こんな感じ。

; utility
(define *newlispDir* (env "NEWLISPDIR"))
(load (append *newlispDir* "/guiserver.lsp"))
(include "macro.lsp")
(include "newlisp-utility.lsp")
; define global values
(define width 60)
(define cnts (/ 600 width))
(define alpha .4)
(define times 20)
; define handoler
(define (learn x m h)
  (map add m (map (curry mul h) (map sub x m))))
(define (draw tag)
  (dotimes (i cnts)
    (dotimes (j cnts)
      (gs:fill-rect tag (* i width) (* j width) width width (vectors i j))))
  (gs:update))
(define (mouse-clicked-action x y button cnt modifiers tags)
  (case button
    (1 (time (let (new-v (random 0 1 3)
             min-d 3 sel-i 0 sel-j 0)
         (dotimes (i cnts)
           (dotimes (j cnts)
             (let (ps (apply add (map (hayashi pow 2)
                                      (map sub (vectors i j) new-v))))
                (when (< ps min-d)
                  (setq min-d ps sel-i i sel-j j)))))
         (dotimes (i cnts)
           (dotimes (j cnts)
             (let (diff-i (abs (- sel-i i)) diff-j (abs (- sel-j j)))
             (cond ((zero? (+ diff-i diff-j))
                    (setf (vectors i j) (learn new-v $it alpha))
                    (setf (vectors i j) (learn new-v $it alpha))
                    (setf (vectors i j) (learn new-v $it alpha)))
                   ((or (< (+ diff-i diff-j) 2) (= diff-i diff-j 1))
                    (setf (vectors i j) (learn new-v $it alpha))
                    (setf (vectors i j) (learn new-v $it alpha)))
                   ((and (< diff-i 3) (< diff-j 3))
                    (setf (vectors i j) (learn new-v $it alpha)))
                   (true)))))) times))
    (3 (gs:set-text 'Frame 
         (string " clicked row: " (/ y width) " col:" (/ x width)
                 " vector: " (vectors  (/ x width) (/ y width)))))
    (true))
  (gs:delete-tag "R")
  (draw "R"))
; initialization
(gs:init) 
(gs:frame 'Frame 100 100 610 630 "Self-Organizing Maps Demo")
(gs:canvas 'MyCanvas 'Frame)
(gs:add-to 'Frame 'MyCanvas)
(gs:set-background 'MyCanvas gs:white)
(gs:set-anti-aliasing true)
(setq vectors (array-list (array cnts cnts)))
(dotimes (i cnts)
  (dotimes (j cnts)
    (setf (vectors i j) (random 0 1 3))))
(draw "R")
(gs:mouse-clicked 'MyCanvas 'mouse-clicked-action true)
(gs:set-visible 'Frame true)
; main
(gs:listen)
(exit)

 池谷裕二氏のプログラムと違って、二つ隣まで色を展開しています。
 動作させると、最初に

 と表示されます。
 画面を左クリックすると、
 一回目 二回目
 こんな風に、色が集まってきます。これで合ってる?
 “自己組織化マップ(Self-Organizing Maps)の基礎”を参考にして書いたのですが、私の理解が違っているかもしれません。
 
 これを何に使うのか、、、実は、試してみたかっただけ(汗)。

 以上、如何でしょうか?