DeepLearning
ISLisp

ISLispによるDeep Learningの学習

はじめに

平成28年に岡谷先生の「深層学習」を読み、数式を追いかけながら自分なりに理解、実装をしてみたのですが、どうもうまくいっていませんでした。その後、斉藤康毅先生の「ゼロから作るDeep Larning」が出たことから、この2冊をもとに再度、勉強、ISLispで小さな実験モデルを作ることにしました。以下は本を読みながら考えたことなどの記録です。随時追加していきます。

参考文献
「深層学習」 岡谷 貴之 著 講談社
「ゼロから作るDeep Larning] 斎藤 康毅 著 オライリー

行列関数

ISLispにより必要な行列関数を用意しました。コードは最後に掲載します。

ベクトルもふくめて配列として表現することとしています。例えば数学でのベクトル (1,2,3)は#2a((1 2 3))となります。

(mat+ x y) 行列x、yの加算を返します。
(mat- x y) 行列x、yの減算を返します。
(mat* x y) 行列x、yの積を返します。
(mat/ x s) 行列xの要素をスカラ-sで除した行列を返します。
(matsum x) 行列xの要素の和を返します。
(matmax x) 行列xの最大要素を返します。
(matmap f x) 行列xの関数fによる写像を返します。
(matmap f x y) 行列x、yの関数fによる写像を返します。
(matrand r c) r行、c列の行列を要素をガウス分布になる0-1の乱数で生成する。(実装は間違っているかもしれません。あとで直します)

パーセプトロン

ANDゲート

;;パーセプトロン
(defun and-gate (x1 x2)
  (if (<= (+ (* 0.5 x1)(* 0.5 x2)) 0.7)
      0
      1))

活性化関数

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


;;ReLU関数
(defun relu (x)
  (max x 0))

恒等関数identityはISLispの標準関数となっています。

3章 3.4

3層ニューラルネットワークの実装

;;3層ニューラルネットワーク
(defun forward (x)
  (let ((w1 (get-array 'w1 network))
        (w2 (get-array 'w2 network))
        (w3 (get-array 'w3 network))
        (b1 (get-array 'b1 network))
        (b2 (get-array 'b2 network))
        (b3 (get-array 'b3 network))
        (a1 nil)(a2 nil)(a3 nil)(z1 nil)(z2 nil)(y nil))
    (setq a1 (mat+ (mat* x w1) b1))
    (setq z1 (matmap #'sigmoid a1))
    (setq a2 (mat+ (mat* z1 w2) b2))
    (setq z2 (matmap #'sigmoid a2))
    (setq a3 (mat+ (mat* z2 w3) b3))
    (setq y (matmap #'identity a3))
    y))


(defglobal network
  '((w1 #2a((0.1 0.2 0.5)(0.2 0.4 0.6)))
    (b1 #2a((0.1 0.2 0.3)))
    (w2 #2a((0.1 0.4)(0.2 0.5)(0.3 0.6)))
    (b2 #2a((0.1 0.2)))
    (w3 #2a((0.1 0.3)(0.2 0.4)))
    (b3 #2a((0.1 0.2)))))

(defun get-array (name network)
  (car (cdr (assoc name network))))

> (forward #2a((1.0 0.5)))
#2a((0.3163225274865363 0.6951644573586704))
> 

ソフトマックス関数 3.5.1

;;ソフトマックス関数
(defun softmax (a)
  (let* ((c (matmax a)) ;;for over flow
         (exp-a (matmap (lambda (x) (exp (- x c))) a))
         (sum-exp-a (mapsum exp-a))
         (y (map/ exp-a sum-exp-a)))
    y))

> (softmax #2a((0.3 2.9 4.0)))
#2a((0.01821127329554753 0.2451918129350739 0.7365969137693786))

結果の要素の和は1となります。

損失関数 4.2

二乗和誤差

;;二乗和誤差
(defun mean-squared-error (y true)
  (* 0.5 (matsum
           (matmap (lambda (x) (* x x)) 
                   (mat- y true)))))

(defglobal true #2a((0 0 1 0 0 0 0 0 0 0)))
(defglobal y #2a((0.1 0.05 0.6 0.0 0.05 0.1 0.0 0.1 0.0 0.0)))

> (mean-squared-error y true)
0.09750000000000003
> 

交差エントロピー

;;交差エントロピー誤差
(defun cross-entropy-error (y true)
  (- (let ((delta 1e-7)) ;;to avoide minus infinity
       (matsum
         (matmap (lambda (y true) (* true (log (+ y delta))))
                 y true)))))

> (cross-entropy-error y true)
0.510825457099338
> 

数値微分

;;数値微分
(defun numerical-diff (f x)
  (let ((h 1e-4))
    (quotient (- (funcall f (+ x h)) (funcall f (- x h)))
              (* 2 h))))

;;一変数関数
(defun function-1 (x)
  (+ (* 0.01 (* x x)) (* 0.1 x)))

> (numerical-diff #'function-1 10)
0.2999999999986347
> (numerical-diff #'function-1 5)
0.1999999999990898
> 

偏微分 4.3.3

多変数関数

;;多変数関数
(defun function-2 (x)
  (+ (expt (aref x 0 0) 2)
     (expt (aref x 0 1) 2)))

> (function-2 #2a((2 3)))
13
> 

勾配法

;;勾配
(defun numerical-gradient (f x)
  (let* ((h 1e-4)
         (d1 (array-dimensions x))
         (d1r (elt d1 0))
         (d1c (elt d1 1))
         (grad (create-array (list d1r d1c)))
         (fxh1 nil)(fxh2 nil)(tmp-val nil))
    (for ((i 0 (+ i 1)))
         ((>= i d1r) grad)
         (for ((j 0 (+ j 1)))
              ((>= j d1c))
              (setq tmp-val (aref x i j))
              (set-aref (+ tmp-val h) x i j)
              (setq fxh1 (funcall f x))
              (set-aref (- tmp-val h) x i j)
              (setq fxh2 (funcall f x))
              (set-aref tmp-val x i j)
              (set-aref (quotient (- fxh1 fxh2) (* 2 h))
                        grad i j)))))

> (numerical-gradient #'function-2 #2a((3.0 4.0)))
#2a((6.00000000000378 7.999999999999119))
> 

勾配降下法

;;勾配法
;;学習率 lr
;;学習回数step-num
(defun gradient-descent (f init-x lr step-num)
  (let* ((x init-x)
         (d1 (array-dimensions init-x))
         (d1r (elt d1 0))
         (d1c (elt d1 1))
         (grad nil))
    (for ((n 0 (+ n 1)))
         ((> n step-num) x)
         (setq grad (numerical-gradient f x))
         (for ((i 0 (+ i 1)))
              ((>= i d1r) x)
              (for ((j 0 (+ j 1)))
                   ((>= j d1c))
                   (set-aref (- (aref x i j) (* lr (aref grad i j)))
                             x i j))))))


> (gradient-descent #'function-2 #2a((-3 4)) 0.1 100)
#2a((-4.888886343202062e-010 6.518515124246453e-010))
> 

ニューラルネットワークの勾配

;;ニューラルネットワークに対する勾配
(defglobal simple-net 
  '((w #2a((0.47355232 0.9997393 0.8468094)
           (0.85557411 0.0356366 0.69422093)))))

(defun simple-predict (x)
  (mat* x (get-array 'w simple-net)))

(defun simple-loss (x true)
  (let* ((z (simple-predict x))
         (y (softmax z))
         (loss (cross-entropy-error y true)))
    loss))

(defun f (w)
  (simple-loss x true))

(defglobal x #2a((0.6 0.9)))
(defglobal p (simple-predict x))
(defglobal true #2a((0 0 1)))

> (numerical-gradient #'f (get-array 'w simple-net))
#2a((0.2191779239973934 0.1436891473760582 -0.3628670712990667) (0.3287668860385562 0.2155337211284802 -0.5443006069144607))
> 

勾配降下法による二層ネットの実装

いままでのコードから自分なりに学習機能をもつものを作ってみました。データとしては4*4=16のものを使います。Lispでは配列は計算の都度生成されるためEISLでは28*28は荷が重いようです。

4*4は次のようにデータを作成しました。

ArcSoft_画像159.PNG

黒の部分を1、背景を0としています。同じ+記号なので同じように認識してくれれば成功です。

(batch)で訓練データを読み取りミニバッチによる一定回数の学習を繰り返します。

(test-data n) でn番目のテストデータをセットします。これで(predict) により順方向計算をして結果を見ます。

> (batch)
NIL
> (predict)
#2a((0.9657165699237299 0.9632534707841842 0.5 0.5))
> (test-set 2)
NIL
> (predict)
#2a((0.9639342769178014 0.9613282932106841 0.5 0.5))
> 

+ と □ とで区別認識できるかとやってみたのですが、どうも微妙です。さらに検証します。

(defglobal image-array 
  #2a((0 1 0 0 0 1 0 0 1 1 1 1 0 1 0 0)
      (0 1 0 0 1 1 1 1 0 1 0 0 0 1 0 0)
      (0 1 1 1 0 1 0 1 0 1 1 1 0 0 0 0)
      (1 1 1 0 1 0 1 0 1 1 1 0 0 0 0 0)
      (0 0 0 0 1 1 1 0 1 0 1 0 1 1 1 0)
      (0 0 1 0 1 1 1 1 0 0 1 0 0 0 1 0)
      (0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1)
      (1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0)
      (1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0)
      (0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1)))
(defglobal label-array
  #2a((1 0 0 0)(1 0 0 0)(0 1 0 0)
      (0 1 0 0)(0 1 0 0)(1 0 0 0)
      (0 0 1 0)(0 0 0 1)(0 0 1 0)(0 0 0 1)))
(defglobal test-array
  #2a((0 0 1 0 0 0 1 0 1 1 1 1 0 0 1 0)
      (0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0)
      (0 0 0 0 0 1 1 1 0 1 0 1 0 1 1 1)))
(defglobal result-array
  #2a((1 0 0 0)(1 0 0 0)(0 1 0 0)))

(defun foo (w)
  (set-aref 10 w 0 0))

(defglobal input (create-array (list 1 16) 0))
(defglobal w1 (create-array (list 16 8) 0))
(defglobal w2 (create-array (list 8 4) 0))
(defglobal b1 (create-array (list 1 8) 0))
(defglobal b2 (create-array (list 1 4) 0))
(defglobal teacher (create-array (list 1 4)))

(defun batch ()
  (for ((i 0 (+ i 1)))
       ((>= i 10))
       (learn i 10 0.01)))

(defun learn (n rep rate)
  (data-set n)
  (for ((i 0 (+ i 1)))
       ((> i rep))
       (let ((gradw1 (numerical-gradient #'loss w1))
             (gradw2 (numerical-gradient #'loss w2))
             (gradb1 (numerical-gradient #'loss b1))
             (gradb2 (numerical-gradient #'loss b2)))
         (update w1 gradw1 rate)
         (update w2 gradw2 rate)
         (update b1 gradb1 rate)
         (update b2 gradb2 rate)
         t)))


(defun update (w grad rate)
  (let* ((d (array-dimensions w))
         (dr (elt d 0))
         (dc (elt d 1)))
    (for ((i 0 (+ i 1)))
       ((>= i dr))
       (for ((j 0 (+ j 1)))
            ((>= j dc))
            (set-aref (- (aref w i j) (* rate (aref grad i j)))
                      w i j)))))

(defun predict ()
  (let* ((a1 (mat+ (mat* input w1) b1))
         (z1 (matmap #'sigmoid a1))
         (a2 (mat+ (mat* z1 w2) b2))
         (y  (matmap #'sigmoid a2)))
    y))

(defun loss (w)
  (cross-entropy-error (predict) teacher))

(defun data-set (n)
  (for ((i 0 (+ i 1)))
       ((>= i 16))
       (set-aref (aref image-array n i) input 0 i))
  (for ((i 0 (+ i 1)))
       ((>= i 4))
       (set-aref (aref label-array n i) teacher 0 i)))

(defun test-set (n)
  (for ((i 0 (+ i 1)))
       ((>= i 16))
       (set-aref (aref test-array n i) input 0 i))
  (for ((i 0 (+ i 1)))
       ((>= i 4))
       (set-aref (aref result-array n i) teacher 0 i)))

5*5画像で再挑戦

木村睦先生の「搭載!!人工知能」に5*5の画像で数の1,2,3を認識させるという例があったのを見つけて、これで試してみました。あれこれと試行錯誤をしてようやくそれなりの結果が得られました。

ArcSoft_画像160.PNG

学習率が重要なことがわかりました。こればかりは試行錯誤で求めるしかないようです。0.005で落ち着きました。

数字の1,2,3を学習させるのですが、当初それぞれを100回学習させていました。どうもうまくいきません。各10回を1サイクルにしてこれを10回繰り返すという方法にしたら良い結果になりました。平均的に満遍なく学習させないといけないようです。
当初シグモイド関数でやっていたのですがうまくいかないので恒等関数にしたらうまくいきました。
損失関数を交差エントロピーでやっていたのですが、二乗和誤差にしたらうまくいきました。
いずれも理屈はよくわからず、試行錯誤で求めた結果でした。

> (batch)
NIL
> (data-set 0)
NIL
> (predict)
#2a((0.6312051351342685 -0.1335777770162726 0.1106186229846893))
> (data-set 1)
NIL
> (predict)
#2a((-0.3412121546934846 0.4050349717096366 0.3943284474464501))
> (data-set 2)
NIL
> (predict)
#2a((0.002145846214715586 0.004512584713886363 0.997636743073677))
> (test-set 0)
NIL
> (predict)
#2a((0.8585253305821501 -0.0385640678447927 0.1211438981606603))
> (test-set 1)
NIL
> (predict)
#2a((-0.1994093440783443 0.1022440022499347 0.2908516351109363))
> (test-set 2)
NIL
> (predict)
#2a((0.6665765434325965 0.02977236510884699 0.8111056497917251))
> 

木村先生の本にあるようなきれいな結果にはなりませんでしたが、一応は正解を出しています。テストデータの1は不正解でした。

コードは下記の通りです。

(defglobal image-array 
  #2a((0 1 1 1 0 1 0 0 0 1 1 0 0 0 1 1 0 0 0 1 0 1 1 1 0)
      (0 0 1 0 0 0 1 1 0 0 0 0 1 0 0 0 0 1 0 0 0 0 1 0 0)
      (0 1 1 1 0 0 0 0 0 1 0 1 1 1 0 1 0 0 0 0 0 1 1 1 0)))
(defglobal label-array
  #2a((1 0 0)(0 1 0)(0 0 1)))
(defglobal test-array
  #2a((0 0 1 1 0 1 0 0 0 1 1 0 0 0 1 1 0 0 1 1 0 1 1 1 0)
      (0 0 1 0 0 0 0 1 0 0 0 0 1 0 0 0 0 1 0 0 0 0 1 1 0)
      (0 0 1 1 0 0 0 0 0 1 0 1 1 1 0 1 0 0 0 0 0 1 1 1 1)))
(defglobal result-array
  #2a((1 0 0)(0 1 0)(0 0 1)))

(defun foo (w)
  (set-aref 10 w 0 0))

(defglobal input (create-array (list 1 25) 0))
(defglobal w1 (create-array (list 25 9) 0))
(defglobal w2 (create-array (list 9 3) 0))
(defglobal b1 (create-array (list 1 9) 0))
(defglobal b2 (create-array (list 1 3) 0))
(defglobal teacher (create-array (list 1 3)))

(defun batch ()
  (initialize)
  (for ((n 0 (+ n 1)))
       ((>= n 10))
       (for ((i 0 (+ i 1)))
            ((>= i 3))
            (learn i 10 0.005))))

(defun learn (n rep rate)
  (data-set n)
  (for ((i 0 (+ i 1)))
       ((> i rep))
       (let ((gradw1 (numerical-gradient #'loss w1))
             (gradw2 (numerical-gradient #'loss w2))
             (gradb1 (numerical-gradient #'loss b1))
             (gradb2 (numerical-gradient #'loss b2)))
         (update w1 gradw1 rate)
         (update w2 gradw2 rate)
         (update b1 gradb1 rate)
         (update b2 gradb2 rate)
         t)))


(defun update (w grad rate)
  (let* ((d (array-dimensions w))
         (dr (elt d 0))
         (dc (elt d 1)))
    (for ((i 0 (+ i 1)))
       ((>= i dr))
       (for ((j 0 (+ j 1)))
            ((>= j dc))
            (set-aref (- (aref w i j) (* rate (aref grad i j)))
                      w i j)))))

(defun predict ()
  (let* ((a1 (mat+ (mat* input w1) b1))
         (z1 (matmap #'identity a1))
         (a2 (mat+ (mat* z1 w2) b2))
         (y  (matmap #'identity a2)))
    y))

(defun loss (w)
  (mean-squared-error (predict) teacher))

(defun initialize ()
  (matrand w1)
  (matrand w2))

(defun data-set (n)
  (for ((i 0 (+ i 1)))
       ((>= i 25))
       (set-aref (aref image-array n i) input 0 i))
  (for ((i 0 (+ i 1)))
       ((>= i 3))
       (set-aref (aref label-array n i) teacher 0 i)))

(defun test-set (n)
  (for ((i 0 (+ i 1)))
       ((>= i 25))
       (set-aref (aref test-array n i) input 0 i))
  (for ((i 0 (+ i 1)))
       ((>= i 3))
       (set-aref (aref result-array n i) teacher 0 i)))

コード

ISLispで書かれています。自作のEasy-ISLispで動作確認をしています。

;;行列計算
(defun mat+ (x y)
  (let* ((d1 (array-dimensions x))
         (d2 (array-dimensions y))
         (d1r (elt d1 0))
         (d1c (elt d1 1))
         (d2r (elt d2 0))
         (d2c (elt d2 1))
         (m (create-array (list d1r d1c))))
    (if (not (= d1r d2r))
        (error "size mismatch matrix" (list d1r d2r)))
    (if (not (= d1c d2c))
        (error "size mismatch matrix" (list d1c d2c)))
    (for ((i 0 (+ i 1)))   
         ((>= i d1r) m)
         (for ((j 0 (+ j 1)))
              ((>= j d1c))
              (set-aref (+ (aref x i j)(aref y i j))
                        m i j)))))

(defun mat- (x y)
  (let* ((d1 (array-dimensions x))
         (d2 (array-dimensions y))
         (d1r (elt d1 0))
         (d1c (elt d1 1))
         (d2r (elt d2 0))
         (d2c (elt d2 1))
         (m (create-array (list d1r d1c))))
    (if (not (= d1r d2r))
        (error "size mismatch matrix" (list d1r d2r)))
    (if (not (= d1c d2c))
        (error "size mismatch matrix" (list d1c d2c)))
    (for ((i 0 (+ i 1)))
         ((>= i d1r) m)
         (for ((j 0 (+ j 1)))
              ((>= j d1c))
              (set-aref (- (aref x i j)(aref y i j))
                        m i j)))))                       

(defun mat* (x y)
  (let* ((d1 (array-dimensions x))
         (d2 (array-dimensions y))
         (d1r (elt d1 0))
         (d1c (elt d1 1))
         (d2r (elt d2 0))
         (d2c (elt d2 1))
         (m (create-array (list d1r d2c))))
    (if (not (= d1c d2r))
        (error "size mismatch matrix" (list d1c d2r)))
    (for ((i 0 (+ i 1)))
         ((>= i d1r) m)
         (for ((j 0 (+ j 1)))
              ((>= j d2c))
              (for ((k 0 (+ k 1))
                    (val 0))
                   ((>= k d1c) (set-aref val m i j))
                   (setq val (+ val (* (aref x i k)
                                       (aref y k j)))))))))

(defun map/ (x y)
  (let* ((d1 (array-dimensions x))
         (d1r (elt d1 0))
         (d1c (elt d1 1))
         (m (create-array (list d1r d1c))))
    (for ((i 0 (+ i 1)))
         ((>= i d1r) m)
         (for ((j 0 (+ j 1)))
              ((>= j d1c))
              (set-aref (quotient (aref x i j) y)
                        m i j)))))

;;行列要素の和
(defun matsum (x)
  (let* ((d1 (array-dimensions x))
         (d1r (elt d1 0))
         (d1c (elt d1 1))
         (y 0))
    (for ((i 0 (+ i 1)))
         ((>= i d1r) y)
         (for ((j 0 (+ j 1)))
              ((>= j d1c))
              (setq y (+ (aref x i j) y))))))

;;行列の最大要素
(defun matmax (x)
  (let* ((d1 (array-dimensions x))
         (d1r (elt d1 0))
         (d1c (elt d1 1))
         (y 0))
    (for ((i 0 (+ i 1)))
         ((>= i d1r) y)
         (for ((j 0 (+ j 1)))
              ((>= j d1c))
              (if (> (aref x i j) y)
                  (setq y (aref x i j)))))))


;;行列の写像
(defun matmap (f :rest arg)
  (cond ((= (length arg) 1)
         (let* ((x (elt arg 0))
                (d1 (array-dimensions x))
                (d1r (elt d1 0))
                (d1c (elt d1 1))
                (m (create-array (list d1r d1c))))
           (for ((i 0 (+ i 1)))
                ((>= i d1r) m)
                (for ((j 0 (+ j 1)))
                     ((>= j d1c))
                     (set-aref (funcall f (aref x i j )) m i j)))))
        ((= (length arg) 2)
         (let* ((x (elt arg 0))
                (y (elt arg 1))
                (d1 (array-dimensions x))
                (d2 (array-dimensions y))
                (d1r (elt d1 0))
                (d1c (elt d1 1))
                (d2r (elt d2 0))
                (d2c (elt d2 1))
                (m (create-array (list d1r d1c))))
           (if (not (= d1r d2r))
               (error "size mismatch matrix" (list d1r d2r)))
           (if (not (= d1c d2c))
               (error "size mismatch matrix" (list d1c d2c)))
           (for ((i 0 (+ i 1)))
                ((>= i d1r) m)
                (for ((j 0 (+ j 1)))
                     ((>= j d1c))
                     (set-aref (funcall f (aref x i j )(aref y i j)) m i j)))))
        (t nil)))

;;ガウス分布乱数
;;ボックス・ミュラー法
;;参考https://qiita.com/sifue/items/e1dbfe671f42886e47d6
;; m 平均, s 分散
(defun normrand (m s)
  (let* ((a (- 1 (random-real)))
         (b (- 1 (random-real)))
         (c (sqrt (* -2 (log a)))))
    (if (> (- 0.5 (random-real)) 0)
        (+ (* c (sin (* *pi* 2 b)) s) m))
        (+ (* c (cos (* *pi* 2 b)) s) m)))

(defun matrand (r c)
  (let ((m (create-array (list r c))))
    (for ((i 0 (+ i 1)))
         ((>= i r) m)
         (for ((j 0 (+ j 1)))
              ((>= j c))
              (set-aref (normrand 0.5 0.2) m i j)))))