単一ニューロンを使った関数近似

unit-neuron.lisp

;; 勾配法の更新係数
(defparameter *epsilon* 0.5)

(defun grad (f dfs ws xs)
  "勾配法により更新後の重みベクトルを計算する。
f   - 誤差関数
dfs - n番目の重みの更新関数
ws  - 重みベクトル
xs  - 入力ベクトル
"
  (let* ((nws (mapcar #'(lambda (w n)
                          (- w (* *epsilon* (funcall dfs n ws xs))))
                      ws 
                      (iota (length ws)))))
    (values 
     ;; 極値の点
     nws
     ;; 極値
     (funcall f nws xs))))

;; シグモイド関数
(defun sigmoid (x &optional (a 1))
  (/ 1 (+ 1 (exp (- (* a x))))))

;; 重み付け総和
(defun weighted-sum (x w)
  (reduce #'+ (mapcar #'* x w)))

(defun unit-neuro (times ds &optional (gain 2))
  "単一ニューロンにより関数を近似する
times - 学習回数
ds    - 入力値と目標出力 (x0 ... xN-1; y) からなるリスト
gain  - シグモイド関数のゲイン"
  (let (;; 重み初期値(学習前)
        (ws (make-list (length (car ds)) :initial-element 0)))
    (dotimes (n times)
      do (let ((total-error 0))
           (loop for d in ds
              do (let ((xs (append (butlast d) (list 1))) ; 第三要素はバイアス重みをかけるため1に固定
                       (y (lastcar d)))
                   (multiple-value-bind (nws error-value)
                       (grad #'(lambda (ws xs)
                                 (expt (- y (sigmoid (weighted-sum ws xs) gain)) 2))
                             #'(lambda (n ws xs)
                                 (let ((y! (sigmoid (weighted-sum ws xs) gain)))
                                   (* -1 (- y y!) gain y! (- 1 y!) (nth n xs))))
                             ws
                             xs)
                     (incf total-error error-value)
                     (setf ws nws))))
           (format t "訓練誤差 (~a 回目) = ~a~%" (1+ n) total-error))) 
    (terpri)
    (format t "学習結果: 重み ws = ~{~a~^ ~}~%" (butlast ws))
    (format t "          閾値 theta = ~a~%" (- (lastcar ws)))
    ;; 学習結果を使って素子出力を見る
    (format t "入力値  : ~{~a~^ ~}~%" (mapcar #'butlast ds))
    (format t "目標出力: ~{~,3f~^ ~}~%" (mapcar #'lastcar ds))
    (format t "素子出力: ~{~,3f~^ ~}~%" (mapcar #'(lambda (d) 
                                                    (sigmoid (weighted-sum ws (append (butlast d) (list 1))) 
                                                             gain))
                                                ds))))

;; サンプルデータの学習(収束する)
(defun test-sample (times)
  (unit-neuro times
              '((0 1 0) (1 0 0) (0 0 0) (1 3 1) (2 1 1) (1.5 2 1))))

;; XORの学習(収束しない)
(defun test-xor (times)
  (unit-neuro times
              '((0 0 0) (0 1 1) (1 0 1) (1 1 0))) )