誤差逆伝搬法

大学の課題でニューラルネットワークの誤差逆伝搬法*1による学習を作ったので載せてみる。課題自体はC++で作るものだが、適当に書く分にはlispの方がずっと楽である。C++で書いた方はひどいことになってるので載せない。

適当に書いたので、層とユニットの数は任意に入るようにしたが、出力関数がシグモイドに特化していて一般的になっていない。

(defun sigmoid (x)
  "シグモイド関数"
  (/ 1 (+ 1 (exp (- x)))))

(defun neural-network (layers &optional init)
  "入力層から出力層まで適当にレイヤ数を入れるとNN用のリストを作る。
   initはパラメータ初期化用の関数を入れる。閾値も重みも同じ扱い。"
  (unless init
    (setq init (lambda () 0)))
  (let ((i (pop layers))
        j nn)
    (while (setq j (pop layers))
      (push (let (ll)
              (dotimes (_ j ll)
                (push
                 (let (l)
                   (dotimes (_ (1+ i) l) ;パラメータ数＝閾値１+入力数
                     (push (funcall init) l))) ll))) nn)
      (setq i j))
    (reverse nn)))

(defun nn-output (nn inputs)
  "NNの応答を得る。入力層のパラメータを入れると，各層の出力をリストで返す。
   並びは最終出力から順になり，入力層も付く。"
  (let ((l (list inputs)))
    (dolist (layer nn l)
      (let ((i-lst (car l)))
        (push (mapcar (lambda (unit-param)
                        (sigmoid (apply '+ (mapcar '* unit-param (append (list 1) i-lst)))))
                      layer)
              l)))))

(defun transverse (lst)
  "行と列の関係を入れ替える。転置。"
  (let (l) (apply 'mapcar 'list lst)))

(defun bp-sigma (nn outputs model)
  "BPのσを返す。出力層から順の並び。"
  (let ((weights (reverse nn))
        (l (list (mapcar (lambda (o m) (* (- m o) o (- 1 o)))
                         (car outputs) model)))) ;最終層
    (dolist (o-lst (cdr (butlast outputs)) (reverse l))
      (let ((weight (transverse (pop weights))))
        (push (mapcar (lambda (o w) (* o (- 1 o) (apply '+ (mapcar '* w (car l)))))
                      o-lst weight) ;中間層
              l)))))

(defun bp-delta (eta sigma outputs)
  "BPのΔを返す。NNのパラメータと同じ並び。"
  (pop outputs)
  (let (l ou su)
    (while (and (setq ou (pop outputs)) (setq su (pop sigma)))
      (push (mapcar (lambda (s)
                      (mapcar (lambda (x) (* eta x s))
                              (append (list 1) ou)))
                    su)
            l))
    l))

(defun back-propagation (nn eta pattern)
  "BPを適用したNNを返す。"
  ;pattern {inputs model}
  (let ((res (copy-tree nn)))
    (dolist (p pattern res)
      (let* ((outputs (nn-output nn (car p)))
             (sigma (bp-sigma nn outputs (cadr p))))
        (setq res
              (mapcar (lambda (ru du)
                        (mapcar (lambda (r d)
                                  (mapcar '+ r d))
                                ru du))
                      res (bp-delta eta sigma outputs)))))))

neural-network関数でNNを初期化して、手動で指定した学習パターンをback-propagationに突っ込んで学習させる。内部では細かい数値が現れるので、倍精度の数値が必要なようである。

;実行例
(series 1 compile ;非標準(とりあえずコンパイルすべし)
  'sigmoid 'neural-network 'nn-output 'bp-sigma 'bp-delta 'back-propagation)

;数値が細かいので結果を見やすく表示する関数を用意
(defun test (nn pattern)
  (map nil (lambda (x)
             (format t "~{~A ~}~%"
               (mapcar (lambda (x)
                         (if (< x 0.1) 'l
                           (if (> x 0.9) 'h
                             'm)))
                 (car (nn-output nn (car x)))))) pattern))

;学習パターン。せっかくだから3入力3出力
(let ((l 0.05) (h 0.95))
  (setq pattern-3xor
        (list `((,l ,l ,l) (,l ,l ,l))
              `((,l ,l ,h) (,l ,h ,h))
              `((,l ,h ,l) (,h ,h ,l))
              `((,l ,h ,h) (,h ,l ,h))
              `((,h ,l ,l) (,h ,l ,h))
              `((,h ,l ,h) (,h ,h ,l))
              `((,h ,h ,l) (,l ,h ,h))
              `((,h ,h ,h) (,l ,l ,l)))))

(setq nn (neural-network '(3 9 3) (lambda () (- 1.0d0 (random 2.0d0)))))

;学習前の出力
(test nn pattern-3xor)
|
m m m 
m m m 
m m m 
m m m 
m m m 
m m m 
m m m 
m m m 

(dotimes (_ 10000)
  (do-events)
  (setq nn (back-propagation nn 0.8 pattern-3xor)))

;学習後の出力
(test nn pattern-3xor)
|
l l l 
l h h 
h h l 
h l h 
h l h 
h h l 
l h h 
l l l 

ちゃんと学習できましたー。

は良いのだが、中間層を多めに取っても確実に学習できるわけではなくて、割と不安定。大方精度に問題がある気がする。

*1:error back propergationだが単純にBPと言われることもある。