├── .gitignore ├── cl-zerodl.asd ├── core ├── initializer.lisp ├── optimizer │ ├── base.lisp │ ├── sgd.lisp │ ├── momentum-sgd.lisp │ ├── adagrad.lisp │ └── aggmo.lisp ├── initializer │ ├── base.lisp │ ├── he-initializer.lisp │ ├── gaussian-initializer.lisp │ └── xavier-initializer.lisp ├── optimizer.lisp ├── layer.lisp ├── layer │ ├── base.lisp │ ├── sigmoid.lisp │ ├── relu.lisp │ ├── dropout.lisp │ ├── affine.lisp │ ├── softmax.lisp │ ├── batch-normalization.lisp │ └── conv2d.lisp ├── utils.lisp └── network.lisp ├── main.lisp ├── cl-zerodl-test.asd ├── README.org ├── book ├── argmax.lisp ├── 2-perceptron.lisp ├── 3-neural-networks.lisp ├── 3-neural-networks-mgl.lisp ├── 5-layers.lisp ├── conv.lisp └── matrix.lisp ├── tests ├── layer │ ├── relu.lisp │ ├── sigmoid.lisp │ └── affine.lisp ├── dataset │ ├── iris.scale.shuf.t │ └── iris.scale.shuf └── cl-zerodl.lisp └── example ├── cifar10.lisp └── mnist.lisp /.gitignore: -------------------------------------------------------------------------------- 1 | *.fasl 2 | *.dx32fsl 3 | *.dx64fsl 4 | *.lx32fsl 5 | *.lx64fsl 6 | *.x86f 7 | *~ 8 | .#* -------------------------------------------------------------------------------- /cl-zerodl.asd: -------------------------------------------------------------------------------- 1 | (defsystem cl-zerodl 2 | :class :package-inferred-system 3 | :author "Satoshi Imai" 4 | :version "0.3" 5 | :license "MIT" 6 | :depends-on ("mgl-mat" 7 | "cl-libsvm-format" 8 | "alexandria" 9 | "cl-zerodl/main") 10 | :description "Common Lisp implementation of 'deep-learning-from-scratch'" 11 | :in-order-to ((test-op (test-op "cl-zerodl/tests")))) 12 | -------------------------------------------------------------------------------- /core/initializer.lisp: -------------------------------------------------------------------------------- 1 | (uiop:define-package #:cl-zerodl/core/initializer 2 | (:use #:cl) 3 | (:nicknames :initializer) 4 | (:use-reexport #:cl-zerodl/core/initializer/base 5 | #:cl-zerodl/core/initializer/gaussian-initializer 6 | #:cl-zerodl/core/initializer/xavier-initializer 7 | #:cl-zerodl/core/initializer/he-initializer)) 8 | 9 | (in-package #:cl-zerodl/core/initializer) 10 | -------------------------------------------------------------------------------- /core/optimizer/base.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:cl-zerodl/core/optimizer/base 2 | (:use #:cl) 3 | (:nicknames :zerodl.optimizer) 4 | (:import-from #:cl-zerodl/core/utils 5 | #:define-class) 6 | (:export #:optimizer 7 | #:update!)) 8 | 9 | (in-package #:cl-zerodl/core/optimizer/base) 10 | 11 | ;;; Optimizer 12 | 13 | (define-class optimizer ()) 14 | 15 | (defgeneric update! (optimizer parameter gradient)) 16 | -------------------------------------------------------------------------------- /core/initializer/base.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:cl-zerodl/core/initializer/base 2 | (:use #:cl) 3 | (:nicknames :zerodl.initializer) 4 | (:import-from #:cl-zerodl/core/utils 5 | #:define-class) 6 | (:export #:initializer 7 | #:initialize!)) 8 | 9 | (in-package #:cl-zerodl/core/initializer/base) 10 | 11 | ;;; Initializer 12 | (define-class initializer ()) 13 | 14 | (defgeneric initialize! (initializer parameter)) 15 | -------------------------------------------------------------------------------- /core/optimizer.lisp: -------------------------------------------------------------------------------- 1 | (uiop:define-package #:cl-zerodl/core/optimizer 2 | (:use #:cl) 3 | (:nicknames :optimizer) 4 | (:use-reexport #:cl-zerodl/core/optimizer/base 5 | #:cl-zerodl/core/optimizer/sgd 6 | #:cl-zerodl/core/optimizer/momentum-sgd 7 | #:cl-zerodl/core/optimizer/adagrad 8 | #:cl-zerodl/core/optimizer/aggmo)) 9 | 10 | (in-package #:cl-zerodl/core/optimizer) 11 | -------------------------------------------------------------------------------- /core/layer.lisp: -------------------------------------------------------------------------------- 1 | (uiop:define-package #:cl-zerodl/core/layer 2 | (:use #:cl) 3 | (:nicknames :layer) 4 | (:use-reexport #:cl-zerodl/core/layer/base 5 | #:cl-zerodl/core/layer/affine 6 | #:cl-zerodl/core/layer/relu 7 | #:cl-zerodl/core/layer/sigmoid 8 | #:cl-zerodl/core/layer/softmax 9 | #:cl-zerodl/core/layer/conv2d 10 | #:cl-zerodl/core/layer/batch-normalization 11 | #:cl-zerodl/core/layer/dropout)) 12 | 13 | (in-package #:cl-zerodl/core/layer) 14 | -------------------------------------------------------------------------------- /main.lisp: -------------------------------------------------------------------------------- 1 | (uiop:define-package #:cl-zerodl/main 2 | (:use #:cl 3 | #:mgl-mat) 4 | (:nicknames :cl-zerodl) 5 | (:use-reexport #:cl-zerodl/core/utils 6 | #:cl-zerodl/core/layer 7 | #:cl-zerodl/core/optimizer 8 | #:cl-zerodl/core/initializer 9 | #:cl-zerodl/core/network)) 10 | 11 | (in-package #:cl-zerodl/main) 12 | 13 | ;;; settings ------------- 14 | 15 | (setf *default-mat-ctype* :float 16 | *cuda-enabled* t 17 | *print-mat* t 18 | *print-length* 100 19 | *print-level* 10) 20 | -------------------------------------------------------------------------------- /core/initializer/he-initializer.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:cl-zerodl/core/initializer/he-initializer 2 | (:use #:cl 3 | #:mgl-mat 4 | #:cl-zerodl/core/initializer/base) 5 | (:nicknames :zerodl.initializer.he-initializer) 6 | (:import-from #:cl-zerodl/core/utils 7 | #:define-class) 8 | (:export #:he-initializer)) 9 | 10 | (in-package #:cl-zerodl/core/initializer/he-initializer) 11 | 12 | (define-class he-initializer (initializer)) 13 | 14 | (defmethod initialize! ((initializer he-initializer) parameter) 15 | (gaussian-random! parameter :stddev (sqrt (/ 2.0 (mat-dimension parameter 0))))) 16 | -------------------------------------------------------------------------------- /core/optimizer/sgd.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:cl-zerodl/core/optimizer/sgd 2 | (:use #:cl 3 | #:mgl-mat 4 | #:cl-zerodl/core/optimizer/base) 5 | (:nicknames :zerodl.optimizer.sgd) 6 | (:import-from #:cl-zerodl/core/utils 7 | #:define-class) 8 | (:export #:sgd 9 | #:make-sgd)) 10 | 11 | (in-package #:cl-zerodl/core/optimizer/sgd) 12 | 13 | (define-class sgd (optimizer) 14 | (learning-rate :initform 0.1 :type single-float)) 15 | 16 | (defun make-sgd (learning-rate) 17 | (make-instance 'sgd :learning-rate learning-rate)) 18 | 19 | (defmethod update! ((optimizer sgd) parameter gradient) 20 | (axpy! (- (learning-rate optimizer)) gradient parameter)) 21 | -------------------------------------------------------------------------------- /core/initializer/gaussian-initializer.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:cl-zerodl/core/initializer/gaussian-initializer 2 | (:use #:cl 3 | #:mgl-mat 4 | #:cl-zerodl/core/initializer/base) 5 | (:nicknames :zerodl.initializer.gaussian-initializer) 6 | (:import-from #:cl-zerodl/core/utils 7 | #:define-class) 8 | (:export #:gaussian-initializer)) 9 | 10 | (in-package #:cl-zerodl/core/initializer/gaussian-initializer) 11 | 12 | (define-class gaussian-initializer (initializer) 13 | (weight-init-std :initform 0.01 :type single-float)) 14 | 15 | (defmethod initialize! ((initializer gaussian-initializer) parameter) 16 | (gaussian-random! parameter :stddev (weight-init-std initializer))) 17 | -------------------------------------------------------------------------------- /cl-zerodl-test.asd: -------------------------------------------------------------------------------- 1 | #| 2 | This file is a part of cl-zerodl project. 3 | |# 4 | 5 | (in-package :cl-user) 6 | (defpackage cl-zerodl-test-asd 7 | (:use :cl :asdf)) 8 | (in-package :cl-zerodl-test-asd) 9 | 10 | (defsystem cl-zerodl-test 11 | :author "" 12 | :license "" 13 | :depends-on (:cl-zerodl 14 | :prove) 15 | :components ((:module "tests" 16 | :components 17 | ((:test-file "cl-zerodl")))) 18 | :description "Test system for cl-zerodl" 19 | 20 | :defsystem-depends-on (:prove-asdf) 21 | :perform (test-op :after (op c) 22 | (funcall (intern #.(string :run-test-system) :prove-asdf) c) 23 | (asdf:clear-system c))) 24 | -------------------------------------------------------------------------------- /core/initializer/xavier-initializer.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:cl-zerodl/core/initializer/xavier-initializer 2 | (:use #:cl 3 | #:mgl-mat 4 | #:cl-zerodl/core/initializer/base) 5 | (:nicknames :zerodl.initializer.xavier-initializer) 6 | (:import-from #:cl-zerodl/core/utils 7 | #:define-class) 8 | (:export #:xavier-initializer)) 9 | 10 | (in-package #:cl-zerodl/core/initializer/xavier-initializer) 11 | 12 | (define-class xavier-initializer (initializer)) 13 | 14 | (defmethod initialize! ((initializer xavier-initializer) parameter) 15 | (gaussian-random! parameter :stddev (sqrt (/ 2.0 (+ (mat-dimension parameter 0) 16 | (mat-dimension parameter 1)))))) 17 | -------------------------------------------------------------------------------- /README.org: -------------------------------------------------------------------------------- 1 | * cl-zerodl 2 | 3 | ** Install 4 | 5 | #+BEGIN_SRC 6 | $ sudo apt install libblas-dev liblapack-dev 7 | $ ros install cl-cuda melisgl/mgl-mat masatoi/cl-zerodl 8 | #+END_SRC 9 | 10 | In config files of common lisp implementations such ~/.sbclrc, 11 | 12 | #+BEGIN_SRC lisp 13 | (defvar *lla-configuration* 14 | '(:libraries ("/usr/lib/x86_64-linux-gnu/libblas.so.3"))) 15 | #+END_SRC 16 | 17 | *** for openblas 18 | 19 | #+BEGIN_SRC 20 | $ sudo apt install libopenblas-base libopenblas-dev 21 | $ locate libblas.so.3 22 | /usr/lib/x86_64-linux-gnu/openblas/libblas.so.3 23 | #+END_SRC 24 | 25 | In ~/.sbclrc, 26 | 27 | #+BEGIN_SRC lisp 28 | (defvar *lla-configuration* 29 | '(:libraries ("/usr/lib/x86_64-linux-gnu/openblas/libblas.so.3"))) 30 | #+END_SRC 31 | 32 | ** Usage 33 | 34 | See example/mnist.lisp 35 | -------------------------------------------------------------------------------- /core/layer/base.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:cl-zerodl/core/layer/base 2 | (:use :cl 3 | :mgl-mat) 4 | (:nicknames :zerodl.layer) 5 | (:import-from #:cl-zerodl/core/utils 6 | #:define-class) 7 | (:export #:layer 8 | #:input-dimensions 9 | #:output-dimensions 10 | #:forward-out 11 | #:backward-out 12 | #:updatable-layer 13 | #:updatable-parameters 14 | #:gradients 15 | #:forward 16 | #:backward 17 | #:*batch-size*)) 18 | 19 | (in-package #:cl-zerodl/core/layer/base) 20 | 21 | (defvar *batch-size* 100) 22 | 23 | (define-class layer () 24 | (input-dimensions :initform (list *batch-size* 1) :type list) 25 | (output-dimensions :initform (list *batch-size* 1) :type list) 26 | (forward-out :initform (make-mat (list *batch-size* 1)) :type mat) 27 | backward-out) 28 | 29 | (define-class updatable-layer (layer) 30 | (updatable-parameters :type list) 31 | (gradients :type list)) 32 | 33 | (defgeneric forward (layer &rest inputs)) 34 | (defgeneric backward (layer dout)) 35 | -------------------------------------------------------------------------------- /book/argmax.lisp: -------------------------------------------------------------------------------- 1 | (in-package :mgl-mat) 2 | 3 | (defun blas-isamax (n x &key (incx 1)) 4 | (cffi:with-foreign-object (len :int) 5 | (setf (cffi:mem-ref len :int) n) 6 | (with-facets ((mat-ptr (x 'foreign-array :direction :io))) 7 | (let ((mat-ptr (offset-pointer mat-ptr))) 8 | (cffi:with-foreign-object (offset :int) 9 | (setf (cffi:mem-ref offset :int) incx) 10 | (cffi:foreign-funcall "isamax_" 11 | (:pointer :int) len 12 | (:pointer :float) mat-ptr 13 | (:pointer :int) offset 14 | :int ; return type 15 | )))))) 16 | 17 | (defun argmax! (mat result) 18 | (let ((len (mat-dimension mat 0)) 19 | (dim (mat-dimension mat 1)) 20 | (dis (mat-displacement mat))) 21 | (loop for i from 0 below len do 22 | (reshape-and-displace! mat dim (+ (* i dim) dis)) 23 | (setf (aref result i) (1- (blas-isamax dim mat)))) 24 | (reshape-and-displace! mat (list len dim) dis) 25 | result)) 26 | -------------------------------------------------------------------------------- /core/layer/sigmoid.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:cl-zerodl/core/layer/sigmoid 2 | (:use #:cl 3 | #:mgl-mat 4 | #:cl-zerodl/core/layer/base) 5 | (:nicknames :zerodl.layer.sigmoid) 6 | (:import-from #:cl-zerodl/core/utils 7 | #:define-class) 8 | (:export #:sigmoid-layer 9 | #:make-sigmoid-layer)) 10 | 11 | (in-package #:cl-zerodl/core/layer/sigmoid) 12 | 13 | ;; 5.5.2 Sigmoid 14 | 15 | (define-class sigmoid-layer (layer)) 16 | 17 | (defun make-sigmoid-layer (input-dimension) 18 | (let ((input-dimensions (list *batch-size* input-dimension))) 19 | (make-instance 'sigmoid-layer 20 | :input-dimensions input-dimensions 21 | :output-dimensions input-dimensions 22 | :forward-out (make-mat input-dimensions) 23 | :backward-out (make-mat input-dimensions)))) 24 | 25 | (defmethod forward ((layer sigmoid-layer) &rest inputs) 26 | (let ((out (forward-out layer))) 27 | (copy! (car inputs) out) 28 | (.logistic! out))) 29 | 30 | (defmethod backward ((layer sigmoid-layer) dout) 31 | (let ((y (forward-out layer)) 32 | (out (backward-out layer))) 33 | (copy! y out) 34 | (.+! -1.0 out) ; (-1 + y) 35 | (geem! -1.0 y out 0.0 out) ; -y * (-1 + y) 36 | (.*! dout out))) ; dout * -y * (-1 + y) 37 | -------------------------------------------------------------------------------- /core/optimizer/momentum-sgd.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:cl-zerodl/core/optimizer/momentum-sgd 2 | (:use #:cl 3 | #:mgl-mat 4 | #:cl-zerodl/core/optimizer/base 5 | #:cl-zerodl/core/network) 6 | (:nicknames :zerodl.optimizer.momentum-sgd) 7 | (:import-from #:cl-zerodl/core/utils 8 | #:define-class) 9 | (:import-from #:cl-zerodl/core/optimizer/sgd 10 | #:sgd) 11 | (:export #:momentum-sgd 12 | #:make-momentum-sgd)) 13 | 14 | (in-package #:cl-zerodl/core/optimizer/momentum-sgd) 15 | 16 | ;; Momentum SGD 17 | (define-class momentum-sgd (sgd) 18 | velocities decay-rate) 19 | 20 | (defun make-momentum-sgd (learning-rate decay-rate network) 21 | (let ((opt (make-instance 'momentum-sgd 22 | :learning-rate learning-rate 23 | :velocities (make-hash-table :test 'eq) 24 | :decay-rate decay-rate))) 25 | (do-updatable-layer (layer network) 26 | (dolist (param (updatable-parameters layer)) 27 | (setf (gethash param (velocities opt)) 28 | (make-mat (mat-dimensions param) :initial-element 0.0)))) 29 | opt)) 30 | 31 | (defmethod update! ((optimizer momentum-sgd) parameter gradient) 32 | (let ((velocity (gethash parameter (velocities optimizer)))) 33 | (scal! (decay-rate optimizer) velocity) 34 | (axpy! (- (learning-rate optimizer)) gradient velocity) 35 | (axpy! 1.0 velocity parameter))) 36 | -------------------------------------------------------------------------------- /book/2-perceptron.lisp: -------------------------------------------------------------------------------- 1 | ;;; 2.3 パーセプトロンの実装 2 | 3 | ;; 2.3.1 簡単な実装 4 | (defun pand (x1 x2) 5 | (let ((w1 0.5) 6 | (w2 0.5) 7 | (theta 0.7)) 8 | (if (<= (+ (* w1 x1) (* w2 x2)) theta) 9 | 0 1))) 10 | 11 | (pand 1 0) ; => 0 12 | (pand 0 1) ; => 0 13 | (pand 1 1) ; => 1 14 | (pand 0 0) ; => 0 15 | 16 | ;; 2.3.2 重みとバイアスの導入 17 | 18 | (defun elementwise-* (lst1 lst2) 19 | (mapcar #'* lst1 lst2)) 20 | 21 | (defun sum (lst) 22 | (reduce #'+ lst)) 23 | 24 | (let* ((x '(0 1)) 25 | (w '(0.5 0.5)) 26 | (b -0.7) 27 | (w*x (elementwise-* x w))) ; => 0.5 28 | (+ (sum w*x) b)) ; => -0.19999999 29 | 30 | ;; 2.3.3 重みとバイアスによる実装 31 | 32 | (defun pand (x1 x2) 33 | (let ((x (list x1 x2)) 34 | (w (list 0.5 0.5)) 35 | (b -0.7)) 36 | (if (<= (+ (sum (elementwise-* x w)) b) 0) 37 | 0 1))) 38 | 39 | (defun pnand (x1 x2) 40 | (let ((x (list x1 x2)) 41 | (w (list -0.5 -0.5)) ; 重みとバイアスだけが AND と違う! 42 | (b 0.7)) 43 | (if (<= (+ (sum (elementwise-* x w)) b) 0) 44 | 0 1))) 45 | 46 | (defun por (x1 x2) 47 | (let ((x (list x1 x2)) 48 | (w (list 0.5 0.5)) ; 重みとバイアスだけが AND と違う! 49 | (b -0.2)) 50 | (if (<= (+ (sum (elementwise-* x w)) b) 0) 51 | 0 1))) 52 | 53 | ;; 2.5.2 XORゲートの実装 54 | 55 | (defun pxor (x1 x2) 56 | (let* ((s1 (pnand x1 x2)) 57 | (s2 (por x1 x2)) 58 | (y (pand s1 s2))) 59 | y)) 60 | 61 | (pxor 1 0) ; => 1 62 | (pxor 0 1) ; => 1 63 | (pxor 1 1) ; => 0 64 | (pxor 0 0) ; => 0 65 | -------------------------------------------------------------------------------- /core/layer/relu.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:cl-zerodl/core/layer/relu 2 | (:use #:cl 3 | #:mgl-mat 4 | #:cl-zerodl/core/layer/base) 5 | (:nicknames :zerodl.layer.relu) 6 | (:import-from #:cl-zerodl/core/utils 7 | #:define-class) 8 | (:export #:relu-layer 9 | #:zero 10 | #:mask 11 | #:make-relu-layer)) 12 | 13 | (in-package #:cl-zerodl/core/layer/relu) 14 | 15 | ;; 5.5 Activation function layer 16 | ;; 5.5.1 Relu 17 | 18 | (define-class relu-layer (layer) 19 | (zero :initform (make-mat '(1 1)) :type mat) 20 | (mask :initform (make-mat '(1 1)) :type mat)) 21 | 22 | (defun make-relu-layer (input-dimension) 23 | (check-type input-dimension alexandria:positive-integer) 24 | (let ((input-dimensions (list *batch-size* input-dimension))) 25 | (make-instance 'relu-layer 26 | :input-dimensions input-dimensions 27 | :output-dimensions input-dimensions 28 | :forward-out (make-mat input-dimensions) 29 | :backward-out (make-mat input-dimensions) 30 | :zero (make-mat input-dimensions :initial-element 0.0) 31 | :mask (make-mat input-dimensions :initial-element 0.0)))) 32 | 33 | (defmethod forward ((layer relu-layer) &rest inputs) 34 | (let ((zero (zero layer)) 35 | (mask (mask layer)) 36 | (out (forward-out layer))) 37 | ;; set mask 38 | (copy! (car inputs) mask) 39 | (. x 0) 1 0)) 7 | 8 | ;; 3.2.3 ステップ関数のグラフ 9 | 10 | ;; $ ros install masatoi/clgplot 11 | (ql:quickload :clgplot) 12 | 13 | (let* ((x (clgp:seq -5.0 5.0 0.1)) 14 | (y (mapcar #'step-function x))) 15 | (clgp:plot y :x-seq x :y-range '(-0.1 1.1))) 16 | 17 | ;; 3.2.4 シグモイド関数の実装 18 | 19 | (defun sigmoid (x) 20 | (/ 1 (+ 1 (exp (- x))))) 21 | 22 | (mapcar #'sigmoid '(-1.0 1.0 2.0)) ; => (0.26894143 0.7310586 0.880797) 23 | 24 | (let* ((x (clgp:seq -5.0 5.0 0.1)) 25 | (y (mapcar #'sigmoid x))) 26 | (clgp:plot y :x-seq x :y-range '(-0.1 1.1))) 27 | 28 | ;; 3.2.5 シグモイド関数とステップ関数の比較 29 | 30 | (let* ((x (clgp:seq -5.0 5.0 0.1)) 31 | (y1 (mapcar #'step-function x)) 32 | (y2 (mapcar #'sigmoid x))) 33 | (clgp:plots (list y1 y2) :x-seqs (list x x) :y-range '(-0.1 1.1))) 34 | 35 | ;; 3.2.7 ReLU関数 36 | 37 | (defun relu (x) 38 | (max x 0)) 39 | 40 | (let* ((x (clgp:seq -5.0 5.0 0.1)) 41 | (y (mapcar #'relu x))) 42 | (clgp:plot y :x-seq x :y-range '(-1 5))) 43 | 44 | ;; 3.3.2 行列の内積 45 | 46 | (defparameter ma (mat '((1 2) (3 4)))) 47 | (array-dimensions ma) ; => (2 2) 48 | 49 | (defparameter mb (mat '((5 6) (7 8)))) 50 | (array-dimensions mb) ; => (2 2) 51 | 52 | (m* ma mb) ; => #2A((19 22) (43 50)) 53 | 54 | (defparameter ma (mat '((1 2 3) (4 5 6)))) 55 | (defparameter mb (mat '((1 2) (3 4) (5 6)))) 56 | 57 | (m* ma mb) ; => #2A((22 28) (49 64)) 58 | 59 | (defparameter ma (mat '((1 2) (3 4) (5 6)))) 60 | (defparameter mb (vec 7 8)) 61 | 62 | (m* ma mb) ; => #2A((23) (53) (83)) 63 | 64 | ;; 3.4 3層ニューラルネットワークの実装 65 | 66 | (defparameter x (mat '((1.0) (0.5)))) 67 | (defparameter W1 (mat '((0.1 0.2) (0.3 0.4) (0.5 0.6)))) 68 | (defparameter b1 (vec 0.1 0.2 0.3)) 69 | (defparameter a1 (m+ (m* W1 x) b1)) ; => #2A((0.3) (0.7) (1.1)) 70 | (defparameter z1 (mapmat #'sigmoid a1)) ; => #2A((0.5744425) (0.66818774) (0.7502601)) 71 | 72 | (defparameter W2 (mat '((0.1 0.2 0.3) (0.4 0.5 0.6)))) 73 | (defparameter b2 (vec 0.1 0.2)) 74 | 75 | (array-dimensions z1) ; => (3 1) 76 | (array-dimensions W2) ; => (2 3) 77 | (array-dimensions b2) ; => (2 1) 78 | 79 | (defparameter a2 (m+ (m* W2 z1) b2)) 80 | (defparameter z2 (mapmat #'sigmoid a2)) 81 | 82 | (defparameter W3 (mat '((0.1 0.2) (0.3 0.4)))) 83 | (defparameter b3 (vec 0.1 0.2)) 84 | 85 | (defparameter a3 (m+ (m* W3 z2) b3)) 86 | 87 | (defun identity-function (x) x) 88 | 89 | (defparameter z3 (mapmat #'identity-function a3)) 90 | 91 | ;; 3.4.3 実装のまとめ 92 | (defun init-network () 93 | (let ((network (make-hash-table))) 94 | (setf (gethash 'W1 network) (mat '((0.1 0.2) (0.3 0.4) (0.5 0.6))) 95 | (gethash 'b1 network) (vec 0.1 0.2 0.3) 96 | (gethash 'W2 network) (mat '((0.1 0.2 0.3) (0.4 0.5 0.6))) 97 | (gethash 'b2 network) (vec 0.1 0.2) 98 | (gethash 'W3 network) (mat '((0.1 0.2) (0.3 0.4))) 99 | (gethash 'b3 network) (vec 0.1 0.2)) 100 | network)) 101 | 102 | (defun forward (network x) 103 | (destructuring-bind (W1 b1 W2 b2 W3 b3) 104 | (list (gethash 'W1 network) (gethash 'b1 network) 105 | (gethash 'W2 network) (gethash 'b2 network) 106 | (gethash 'W3 network) (gethash 'b3 network)) 107 | (let* ((a1 (m+ (m* W1 x) b1)) 108 | (z1 (mapmat #'sigmoid a1)) 109 | (a2 (m+ (m* W2 z1) b2)) 110 | (z2 (mapmat #'sigmoid a2)) 111 | (a3 (m+ (m* W3 z2) b3)) 112 | (y (mapmat #'identity-function a3))) 113 | y))) 114 | 115 | (defparameter network (init-network)) 116 | (forward network x) ; => #2A((0.3168271) (0.6962791)) 117 | 118 | ;;; 3.5 出力層の設計 119 | -------------------------------------------------------------------------------- /book/3-neural-networks-mgl.lisp: -------------------------------------------------------------------------------- 1 | (defparameter ma (make-mat '(2 2) :initial-contents '((1 -2) (-3 4)))) 2 | (defparameter mb (make-mat '(2 2) :initial-contents '((5 6) (7 8)))) 3 | (defparameter mc (make-mat '(2 2) :initial-element 0.0)) 4 | 5 | ;; mc = 1.0 * ma * mb + 0.0 * mc 6 | (gemm! 1.0 ma mb 0.0 mc) ; => # 7 | mc ; => # 8 | 9 | ;;; When use CUDA 10 | (setf *print-length* 10 11 | *print-level* 10) 12 | 13 | (defparameter ma (make-mat '(10000 10000))) 14 | (defparameter mb (make-mat '(10000 10000))) 15 | (defparameter mc (make-mat '(10000 10000))) 16 | 17 | (uniform-random! ma) 18 | (uniform-random! mb) 19 | 20 | (time (gemm! 1.0 ma mb 0.0 mc)) 21 | 22 | ;; Evaluation took: 23 | ;; 6.539 seconds of real time 24 | ;; 26.092000 seconds of total run time (25.744000 user, 0.348000 system) 25 | ;; 399.02% CPU 26 | ;; 22,180,377,236 processor cycles 27 | ;; 0 bytes consed 28 | 29 | (with-cuda* () 30 | (time (gemm! 1.0 ma mb 0.0 mc))) 31 | 32 | ;; Evaluation took: 33 | ;; 0.427 seconds of real time 34 | ;; 0.424000 seconds of total run time (0.424000 user, 0.000000 system) 35 | ;; 99.30% CPU 36 | ;; 1,447,343,752 processor cycles 37 | ;; 0 bytes consed 38 | 39 | (defparameter va (make-mat '(3 1) :initial-contents '((1) (2) (3)))) 40 | (defparameter vb (make-mat '(3 1) :initial-contents '((10) (20) (30)))) 41 | 42 | (defparameter x (make-mat '(3 1) :initial-contents '((1) (-2) (3)))) 43 | (defparameter r (make-mat '(3 1) :initial-element 0)) 44 | 45 | (. # 49 | vb ; => # 50 | 51 | ;; Sigmoid 52 | (defun sigmoid! (v) 53 | (.logistic! v)) 54 | 55 | ;; ReLU 56 | (defun relu! (v) 57 | (.max! 0.0 v)) 58 | 59 | ;; 3.4 3層ニューラルネットワークの実装 60 | 61 | (defparameter x (make-mat '(2 1) :initial-contents '((1.0) (0.5)))) 62 | (defparameter W1 (make-mat '(3 2) :initial-contents '((0.1 0.2) 63 | (0.3 0.4) 64 | (0.5 0.6)))) 65 | (defparameter b1 (make-mat '(3 1) :initial-contents '((0.1) (0.2) (0.3)))) 66 | (defparameter z1 (make-mat '(3 1) :initial-element 0.0)) 67 | 68 | ;; calc z1 69 | (gemm! 1.0 W1 x 0.0 z1) 70 | (axpy! 1.0 b1 z1) ; => # 71 | (sigmoid! z1) ; => # 72 | 73 | (defparameter W2 (make-mat '(2 3) :initial-contents '((0.1 0.2 0.3) 74 | (0.4 0.5 0.6)))) 75 | (defparameter b2 (make-mat '(2 1) :initial-contents '((0.1) (0.2)))) 76 | (defparameter z2 (make-mat '(2 1) :initial-element 0.0)) 77 | 78 | (gemm! 1.0 W2 z1 0.0 z2) 79 | (axpy! 1.0 b2 z2) 80 | (sigmoid! z2) 81 | 82 | (defparameter W3 (make-mat '(2 2) :initial-contents '((0.1 0.2) 83 | (0.3 0.4)))) 84 | (defparameter b3 (make-mat '(2 1) :initial-contents '((0.1) (0.2)))) 85 | (defparameter z3 (make-mat '(2 1) :initial-element 0.0)) 86 | 87 | (gemm! 1.0 W3 z2 0.0 z3) 88 | (axpy! 1.0 b3 z3) ; => # 89 | 90 | (time 91 | (loop repeat 1000 do 92 | (gemm! 1.0 W1 x 0.0 z1) 93 | (axpy! 1.0 b1 z1) 94 | (sigmoid! z1) 95 | (gemm! 1.0 W2 z1 0.0 z2) 96 | (axpy! 1.0 b2 z2) 97 | (sigmoid! z2) 98 | (gemm! 1.0 W3 z2 0.0 z3) 99 | (axpy! 1.0 b3 z3))) 100 | 101 | ;; Evaluation took: 102 | ;; 0.000 seconds of real time 103 | ;; 0.000000 seconds of total run time (0.000000 user, 0.000000 system) 104 | ;; 100.00% CPU 105 | ;; 691,968 processor cycles 106 | ;; 0 bytes consed 107 | -------------------------------------------------------------------------------- /core/utils.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:cl-zerodl/core/utils 2 | (:use #:cl 3 | #:mgl-mat 4 | #:cl-libsvm-format) 5 | (:nicknames :zerodl.utils) 6 | (:export #:define-class 7 | #:read-data 8 | #:average!)) 9 | 10 | (in-package #:cl-zerodl/core/utils) 11 | 12 | (defmacro define-class (class-name superclass-list &body body) 13 | "Simplified definition of classes which similar to definition of structure. 14 | [Example] 15 | (define-class agent (superclass1 superclass2) 16 | currency 17 | position-list 18 | (position-upper-bound :initform 1 :type single-float) 19 | log 20 | money-management-rule) 21 | => #" 22 | (alexandria:with-gensyms (class initargs) 23 | `(prog1 24 | (defclass ,class-name (,@superclass-list) 25 | ,(mapcar (lambda (slot) 26 | (let* ((slot-symbol (if (listp slot) (car slot) slot)) 27 | (slot-name (symbol-name slot-symbol)) 28 | (slot-initval (if (listp slot) 29 | (getf (cdr slot) :initform) 30 | nil)) 31 | (slot-type (if (listp slot) 32 | (getf (cdr slot) :type) 33 | t))) 34 | (list slot-symbol 35 | :accessor (intern slot-name) 36 | :initarg (intern slot-name :keyword) 37 | :initform slot-initval 38 | :type slot-type))) 39 | body)) 40 | 41 | (defmethod initialize-instance :before ((,class ,class-name) 42 | &rest ,initargs 43 | &key ,@(mapcar (lambda (slot) 44 | (etypecase slot 45 | (list (if (getf (cdr slot) :initform) 46 | (list (car slot) 47 | (getf (cdr slot) :initform)) 48 | (car slot))) 49 | (symbol slot))) 50 | body) 51 | &allow-other-keys) 52 | (declare (ignorable ,initargs 53 | ,@(mapcar (lambda (slot) 54 | (etypecase slot 55 | (list (car slot)) 56 | (symbol slot))) 57 | body))) 58 | ,@(remove nil 59 | (mapcar (lambda (slot) 60 | (when (and (listp slot) (getf (cdr slot) :type)) 61 | `(check-type ,(car slot) ,(getf (cdr slot) :type)))) 62 | body)))))) 63 | 64 | ;;; Read data 65 | 66 | (defmacro do-index-value-list ((index value list) &body body) 67 | (let ((iter (gensym)) 68 | (inner-list (gensym))) 69 | `(labels ((,iter (,inner-list) 70 | (when ,inner-list 71 | (let ((,index (car ,inner-list)) 72 | (,value (cadr ,inner-list))) 73 | ,@body) 74 | (,iter (cddr ,inner-list))))) 75 | (,iter ,list)))) 76 | 77 | (defun read-data (data-path data-dimension n-class &key (most-min-class 1)) 78 | (let* ((data-list (svmformat:parse-file data-path)) 79 | (len (length data-list)) 80 | (target (make-array (list len n-class) 81 | :element-type 'single-float 82 | :initial-element 0.0)) 83 | (datamatrix (make-array (list len data-dimension) 84 | :element-type 'single-float 85 | :initial-element 0.0))) 86 | (loop for i fixnum from 0 87 | for datum in data-list 88 | do (setf (aref target i (- (car datum) most-min-class)) 1.0) 89 | (do-index-value-list (j v (cdr datum)) 90 | (setf (aref datamatrix i (- j most-min-class)) v))) 91 | (values (array-to-mat datamatrix) (array-to-mat target)))) 92 | 93 | ;;; Calculation utilities 94 | 95 | (defun average! (a batch-size-tmp &key (axis 0)) 96 | (sum! a batch-size-tmp :axis axis) 97 | (scal! (/ 1.0 (mat-dimension a axis)) batch-size-tmp)) 98 | -------------------------------------------------------------------------------- /tests/cl-zerodl.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage cl-zerodl-test 3 | (:use :cl 4 | :cl-zerodl 5 | :prove)) 6 | (in-package :cl-zerodl-test) 7 | 8 | ;; NOTE: To run this test file, execute `(asdf:test-system :cl-zerodl)' in your Lisp. 9 | 10 | (plan nil) 11 | 12 | ;;; ReLU 13 | 14 | (defparameter mask (make-mat '(1 1) :initial-element 0.0)) 15 | (defparameter zero (make-mat '(1 1) :initial-element 0.0)) 16 | 17 | (defparameter relu-layer1 (make-relu-layer '(1 3))) 18 | (defparameter relu-input (make-mat '(1 3) :initial-contents '((3.0 -1.0 0.0)))) 19 | (forward relu-layer1 relu-input) 20 | 21 | ;; # 22 | 23 | (defparameter drelu (make-mat '(1 3) :initial-element 2.0)) 24 | (backward relu-layer1 drelu) 25 | 26 | ;; # 27 | 28 | ;;; Sigmoid 29 | 30 | (defparameter sigmoid-layer1 (make-sigmoid-layer '(1 3))) 31 | (defparameter sigmoid-input (make-mat '(1 3) :initial-contents '((3.0 -1.0 0.0)))) 32 | (forward sigmoid-layer1 sigmoid-input) 33 | 34 | (defparameter dsigmoid (make-mat '(1 3) :initial-element 2.0)) 35 | (backward sigmoid-layer1 dsigmoid) 36 | 37 | ;;; Affine 38 | 39 | (defparameter affine-layer1 (make-affine-layer '(2 4) '(2 3))) 40 | 41 | (setf (weight affine-layer1) 42 | (make-mat '(4 3) :initial-contents '((1 2 3) 43 | (4 5 6) 44 | (7 8 9) 45 | (10 11 12)))) 46 | 47 | (setf (bias affine-layer1) (make-mat 3 :initial-contents '(1 2 3))) 48 | 49 | (defparameter x-affine (make-mat '(2 4) :initial-contents '((10 20 30 40) 50 | (50 60 70 80)))) 51 | 52 | (print (forward affine-layer1 x-affine)) 53 | 54 | ;; # 55 | 56 | (defparameter dout-affine (make-mat '(2 3) :initial-contents '((1 2 3) 57 | (1 2 3)))) 58 | (print (backward affine-layer1 dout-affine)) 59 | 60 | ;; (# 61 | ;; # 65 | ;; #) 66 | 67 | ;;; softmax! 68 | 69 | (defparameter a (make-mat '(2 3) :initial-contents '((0.3 2.9 4.0) 70 | (1010 1000 990)))) 71 | (defparameter result (make-mat '(2 3))) 72 | (defparameter batch-size-tmp (make-mat 2)) 73 | 74 | (softmax! a result batch-size-tmp) 75 | 76 | ;; # 78 | 79 | ;;; cross-entropy! 80 | 81 | (defparameter y (make-mat '(2 3) :initial-contents '((1.1 1.2 1.3) 82 | (3.1 5.1 0.1)))) 83 | 84 | (defparameter target0 (make-mat '(2 3) :initial-contents '((1 0 0) 85 | (0 1 0)))) 86 | 87 | (defparameter tmp (make-mat '(2 3))) 88 | (defparameter batch-size-tmp (make-mat 2)) 89 | (defparameter size-1-tmp (make-mat '(1 1))) 90 | 91 | (cross-entropy! y target0 tmp batch-size-tmp) ; (/ (+ (log (+ 1.1 1e-7)) (log (+ 5.1 1e-7))) 2) 92 | 93 | ;;; Softmax-with-loss 94 | 95 | (defparameter softmax/loss-layer1 (make-softmax/loss-layer '(2 3))) 96 | 97 | (defparameter x-softmax/loss 98 | (make-mat '(2 3) :initial-contents '((0.3 2.9 4.0) 99 | (1010 1000 990)))) 100 | 101 | (defparameter target (make-mat '(2 3) :initial-contents '((1 0 0) 102 | (0 1 0)))) 103 | 104 | (forward softmax/loss-layer1 x-softmax/loss target) 105 | ;; => -7.0017767 106 | 107 | (backward softmax/loss-layer1 1.0) 108 | 109 | ;; # 111 | 112 | ;;; Neural Network 113 | 114 | (defparameter network1 115 | (make-network '((affine :in 3 :out 4) 116 | (relu :in 4) 117 | (affine :in 4 :out 2) 118 | (softmax :in 2)) 119 | 2)) 120 | 121 | (defparameter x1 122 | (make-mat '(2 3) :initial-contents '((1.1 1.2 1.3) 123 | (10.1 10.2 10.3)))) 124 | 125 | (defparameter target1 (make-mat '(2 2) :initial-contents '((1 0) 126 | (0 1)))) 127 | 128 | (predict network1 x1) 129 | 130 | (loss network1 x1 target1) 131 | 132 | ;; Calculate gradient 133 | (print (set-gradient! network1 x1 target1)) 134 | 135 | 136 | (finalize) 137 | -------------------------------------------------------------------------------- /example/cifar10.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- coding:utf-8; mode:lisp -*- 2 | 3 | (in-package :cl-zerodl) 4 | 5 | ;;; load dataset ========================================================= 6 | 7 | ;; Download CIFAR-10 binary version and extract to directory. 8 | ;; http://www.cs.toronto.edu/~kriz/cifar.html 9 | (defparameter dir #P"/home/wiz/datasets/cifar-10-batches-bin/") 10 | 11 | (defparameter dim 3072) 12 | (defparameter n-class 10) 13 | 14 | (defparameter x 15 | (make-array '(50000 3072) :element-type 'single-float)) 16 | 17 | (defparameter y 18 | (make-array '(50000 10) :element-type 'single-float)) 19 | 20 | (defparameter x.t 21 | (make-array '(10000 3072) :element-type 'single-float)) 22 | 23 | (defparameter y.t 24 | (make-array '(10000 10) :element-type 'single-float)) 25 | 26 | (defun load-cifar (file datamatrix target n) 27 | (with-open-file (s file :element-type '(unsigned-byte 8)) 28 | (loop for i from (* n 10000) below (* (1+ n) 10000) do 29 | (setf (aref target i (read-byte s)) 1.0) 30 | (loop for j from 0 below 3072 do 31 | (setf (aref datamatrix i j) (coerce (read-byte s) 'single-float)))) 32 | 'done)) 33 | 34 | (loop for i from 0 to 4 do 35 | (load-cifar (merge-pathnames (format nil "data_batch_~A.bin" (1+ i)) dir) x y i)) 36 | 37 | (load-cifar (merge-pathnames "test_batch.bin" dir) x.t y.t 0) 38 | 39 | ;;; Normalize 40 | 41 | (defparameter x.ave (make-array 3072 :element-type 'single-float)) 42 | 43 | (loop for i from 0 below 50000 do 44 | (loop for j from 0 below 3072 do 45 | (incf (aref x.ave j) (aref x i j)))) 46 | 47 | (loop for j from 0 below 3072 do 48 | (setf (aref x.ave j) (/ (aref x.ave j) 50000))) 49 | 50 | (defun square (x) 51 | (* x x)) 52 | 53 | (defparameter x.std (make-array 3072 :element-type 'single-float)) 54 | 55 | (loop for i from 0 below 50000 do 56 | (loop for j from 0 below 3072 do 57 | (incf (aref x.std j) (square (- (aref x i j) (aref x.ave j)))))) 58 | 59 | (loop for j from 0 below 3072 do 60 | (setf (aref x.std j) (/ (aref x.std j) 50000))) 61 | 62 | (loop for j from 0 below 3072 do 63 | (setf (aref x.std j) (sqrt (aref x.std j)))) 64 | 65 | (defparameter x.norm 66 | (make-array '(50000 3072) :element-type 'single-float)) 67 | 68 | (defparameter x.t.norm 69 | (make-array '(10000 3072) :element-type 'single-float)) 70 | 71 | (loop for i from 0 below 50000 do 72 | (loop for j from 0 below 3072 do 73 | (setf (aref x.norm i j) 74 | (/ (- (aref x i j) (aref x.ave j)) 75 | (aref x.std j))))) 76 | 77 | (loop for i from 0 below 10000 do 78 | (loop for j from 0 below 3072 do 79 | (setf (aref x.t.norm i j) 80 | (/ (- (aref x.t i j) (aref x.ave j)) 81 | (aref x.std j))))) 82 | 83 | (defparameter cifar-dataset (array-to-mat x.norm)) 84 | (defparameter cifar-target (array-to-mat y)) 85 | 86 | (defparameter cifar-test (array-to-mat x.t.norm)) 87 | (defparameter cifar-target-test (array-to-mat y.t)) 88 | 89 | ;;; Define network 90 | 91 | (defparameter cifar-network 92 | (make-network '((affine :in 3072 :out 256) 93 | (relu :in 256) 94 | (affine :in 256 :out 256) 95 | (relu :in 256) 96 | (affine :in 256 :out 10) 97 | (softmax :in 10)) 98 | :batch-size 100 99 | :initializer (make-instance 'he-initializer))) 100 | 101 | ;;; Momentum optimizer 102 | 103 | (setf (optimizer cifar-network) 104 | (make-momentum-sgd 0.01 0.9 cifar-network)) 105 | 106 | (setf (optimizer cifar-network) 107 | (make-adagrad 0.01 0.9 cifar-network)) 108 | 109 | (setf (optimizer cifar-network) 110 | (make-aggmo 0.01 '(0.0 0.9 0.99) cifar-network)) 111 | 112 | (defparameter train-acc-list nil) 113 | (defparameter test-acc-list nil) 114 | 115 | (with-cuda* () 116 | (loop for i from 1 to (* 500 15) do 117 | (let* ((batch-size (batch-size cifar-network)) 118 | (rand (random (- 50000 batch-size)))) 119 | (set-mini-batch! cifar-dataset rand batch-size) 120 | (set-mini-batch! cifar-target rand batch-size) 121 | (train cifar-network cifar-dataset cifar-target) 122 | (when (zerop (mod i 500)) 123 | (let ((train-acc (accuracy cifar-network cifar-dataset cifar-target)) 124 | (test-acc (accuracy cifar-network cifar-test cifar-target-test))) 125 | (format t "cycle: ~A~,15Ttrain-acc: ~A~,10Ttest-acc: ~A~%" i train-acc test-acc) 126 | (push train-acc train-acc-list) 127 | (push test-acc test-acc-list)))))) 128 | 129 | (clgp:plots (list (reverse train-acc-list) 130 | (reverse test-acc-list) 131 | ) 132 | :title-list '("train(adagrad)" "test(adagrad)" 133 | 134 | ;;"train(momentum)" "test(momentum)" 135 | ;; "train(SGD+BN)" "test(SGD+BN)" 136 | ) 137 | :x-label "n-epoch" 138 | :y-label "accuracy") 139 | -------------------------------------------------------------------------------- /tests/dataset/iris.scale.shuf: -------------------------------------------------------------------------------- 1 | 1 1:-0.611111 2:0.0833333 3:-0.864407 4:-0.916667 2 | 1 1:-0.666667 2:-0.0833334 3:-0.830508 4:-1 3 | 1 1:-0.5 2:0.166667 3:-0.864407 4:-0.916667 4 | 2 1:-0.611111 2:-1 3:-0.152542 4:-0.25 5 | 3 1:0.222222 3:0.38983 4:0.583333 6 | 2 1:-0.666667 2:-0.666667 3:-0.220339 4:-0.25 7 | 3 1:0.166667 3:0.457627 4:0.833333 8 | 1 1:-0.833333 2:0.166667 3:-0.864407 4:-0.833333 9 | 2 1:-0.5 2:-0.416667 3:-0.0169491 4:0.0833333 10 | 2 1:-0.611111 2:-0.75 3:-0.220339 4:-0.25 11 | 1 1:-0.944444 3:-0.898305 4:-0.916667 12 | 3 1:0.0555554 2:-0.333333 3:0.288136 4:0.416667 13 | 3 1:0.222222 2:-0.166667 3:0.627119 4:0.75 14 | 2 1:0.388889 2:-0.333333 3:0.288136 4:0.0833333 15 | 2 1:-0.222222 2:-0.333333 3:0.186441 4:-4.03573e-08 16 | 2 1:-0.166667 2:-0.416667 3:0.0508474 4:-0.25 17 | 3 1:0.222222 2:-0.166667 3:0.525424 4:0.416667 18 | 1 1:-0.555556 2:0.416667 3:-0.830508 4:-0.75 19 | 2 1:-1.32455e-07 2:-0.166667 3:0.220339 4:0.0833333 20 | 3 1:-0.277778 2:-0.333333 3:0.322034 4:0.583333 21 | 3 1:-0.111111 2:-0.166667 3:0.38983 4:0.416667 22 | 2 1:-0.0555556 2:-0.833333 3:0.0169491 4:-0.25 23 | 3 1:0.666667 2:-0.25 3:0.79661 4:0.416667 24 | 3 1:-1.32455e-07 2:-0.5 3:0.559322 4:0.0833333 25 | 3 1:0.333333 2:0.0833333 3:0.59322 4:1 26 | 1 1:-0.555556 2:0.5 3:-0.694915 4:-0.75 27 | 1 1:-0.166667 2:0.666667 3:-0.932203 4:-0.916667 28 | 3 1:0.111111 2:-0.333333 3:0.38983 4:0.166667 29 | 1 1:-0.722222 2:0.166667 3:-0.79661 4:-0.916667 30 | 1 1:-0.944444 2:-0.25 3:-0.864407 4:-0.916667 31 | 3 1:0.444444 2:-0.0833334 3:0.38983 4:0.833333 32 | 3 1:0.333333 2:-0.0833334 3:0.559322 4:0.916667 33 | 1 1:-0.333333 2:0.25 3:-0.898305 4:-0.916667 34 | 2 1:0.333333 2:-0.0833334 3:0.254237 4:0.166667 35 | 1 1:-0.666667 2:-0.0833334 3:-0.830508 4:-1 36 | 1 1:-0.666667 2:-0.166667 3:-0.864407 4:-0.916667 37 | 3 1:0.888889 2:-0.166667 3:0.728813 4:0.833333 38 | 2 1:0.166667 2:-0.25 3:0.118644 4:-4.03573e-08 39 | 3 1:0.611111 2:-0.166667 3:0.627119 4:0.25 40 | 1 1:-0.5 2:0.25 3:-0.830508 4:-0.916667 41 | 3 1:0.555555 2:-0.166667 3:0.661017 4:0.666667 42 | 2 1:-0.333333 2:-0.583333 3:0.0169491 4:-4.03573e-08 43 | 3 1:0.333333 2:0.0833333 3:0.59322 4:0.666667 44 | 2 1:-0.0555556 2:0.166667 3:0.186441 4:0.25 45 | 3 1:0.888889 2:0.5 3:0.932203 4:0.75 46 | 3 1:-0.0555556 2:-0.833333 3:0.355932 4:0.166667 47 | 1 1:-0.611111 3:-0.932203 4:-0.916667 48 | 2 1:0.166667 3:0.186441 4:0.166667 49 | 3 1:-0.166667 2:-0.416667 3:0.38983 4:0.5 50 | 1 1:-0.555556 2:0.0833333 3:-0.762712 4:-0.666667 51 | 3 1:0.888889 2:-0.5 3:1 4:0.833333 52 | 2 1:-0.277778 2:-0.25 3:-0.118644 4:-4.03573e-08 53 | 2 1:0.111111 2:-0.75 3:0.152542 4:-4.03573e-08 54 | 1 1:-0.722222 2:0.166667 3:-0.694915 4:-0.916667 55 | 3 1:0.166667 2:-0.333333 3:0.559322 4:0.75 56 | 1 1:-0.611111 2:0.166667 3:-0.830508 4:-0.916667 57 | 2 1:-0.166667 2:-0.416667 3:-0.0169491 4:-0.0833333 58 | 1 1:-0.611111 2:0.25 3:-0.79661 4:-0.583333 59 | 1 1:-0.333333 2:0.833333 3:-0.864407 4:-0.916667 60 | 1 1:-0.833333 3:-0.864407 4:-0.916667 61 | 2 1:-0.333333 2:-0.5 3:0.152542 4:-0.0833333 62 | 1 1:-0.611111 2:-0.166667 3:-0.79661 4:-0.916667 63 | 2 1:-0.277778 2:-0.166667 3:0.0508474 4:-4.03573e-08 64 | 3 1:0.111111 2:-0.25 3:0.559322 4:0.416667 65 | 2 1:-0.555556 2:-0.583333 3:-0.322034 4:-0.166667 66 | 2 1:-0.222222 2:-0.166667 3:0.0847457 4:-0.0833333 67 | 3 1:-0.666667 2:-0.583333 3:0.186441 4:0.333333 68 | 2 1:-0.111111 3:0.288136 4:0.416667 69 | 2 1:-0.333333 2:-0.75 3:0.0169491 4:-4.03573e-08 70 | 1 1:-0.777778 3:-0.79661 4:-0.916667 71 | 3 1:0.611111 3:0.694915 4:0.416667 72 | 2 1:-0.222222 2:-0.25 3:0.0847457 4:-4.03573e-08 73 | 3 1:-0.166667 2:-0.333333 3:0.38983 4:0.916667 74 | 3 1:0.388889 2:-0.166667 3:0.525424 4:0.666667 75 | 1 1:-0.388889 2:0.166667 3:-0.830508 4:-0.75 76 | 2 1:0.0555554 2:-0.25 3:0.118644 4:-4.03573e-08 77 | 3 1:0.111111 2:0.166667 3:0.559322 4:0.916667 78 | 2 1:-0.388889 2:-0.166667 3:0.186441 4:0.166667 79 | 3 1:0.166667 2:-0.416667 3:0.457627 4:0.5 80 | 1 1:-0.777778 3:-0.898305 4:-0.916667 81 | 1 1:-0.833333 2:-0.0833334 3:-0.830508 4:-0.916667 82 | 3 1:-0.222222 2:-0.583333 3:0.355932 4:0.583333 83 | 2 1:0.333333 2:-0.0833334 3:0.152542 4:0.0833333 84 | 2 1:-0.277778 2:-0.166667 3:0.186441 4:0.166667 85 | 1 1:-0.611111 2:0.25 3:-0.898305 4:-0.833333 86 | 1 1:-0.555556 2:0.166667 3:-0.830508 4:-0.916667 87 | 3 1:0.388889 3:0.661017 4:0.833333 88 | 3 1:0.722222 2:-0.333333 3:0.728813 4:0.5 89 | 2 1:-0.222222 2:-0.333333 3:0.0508474 4:-4.03573e-08 90 | 3 1:0.166667 2:-0.333333 3:0.559322 4:0.666667 91 | 3 1:-1.32455e-07 2:-0.166667 3:0.322034 4:0.416667 92 | 2 1:-0.222222 2:-0.5 3:-0.152542 4:-0.25 93 | 2 1:-0.277778 2:-0.416667 3:0.0847457 4:-4.03573e-08 94 | 1 1:-0.666667 2:-0.0833334 3:-0.830508 4:-1 95 | 2 1:-0.0555556 2:-0.416667 3:0.38983 4:0.25 96 | 3 1:0.833333 2:-0.166667 3:0.898305 4:0.666667 97 | 2 1:0.111111 2:-0.583333 3:0.322034 4:0.166667 98 | 1 1:-0.388889 2:0.416667 3:-0.830508 4:-0.916667 99 | 2 1:-1.32455e-07 2:-0.25 3:0.254237 4:0.0833333 100 | 2 1:0.333333 2:-0.166667 3:0.355932 4:0.333333 101 | -------------------------------------------------------------------------------- /core/layer/batch-normalization.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:cl-zerodl/core/layer/batch-normalization 2 | (:use #:cl 3 | #:mgl-mat 4 | #:cl-zerodl/core/layer/base) 5 | (:nicknames :zerodl.layer.batchnorm) 6 | (:import-from #:cl-zerodl/core/utils 7 | #:define-class 8 | #:average!) 9 | (:export #:batch-normalization-layer 10 | #:make-batch-normalization-layer)) 11 | 12 | (in-package #:cl-zerodl/core/layer/batch-normalization) 13 | 14 | ;;; Batch Normalization 15 | 16 | (define-class batch-normalization-layer (updatable-layer) 17 | (epsilon :initform 1.0e-6 :type single-float) 18 | beta 19 | gamma 20 | var 21 | sqrtvar 22 | ivar 23 | x^ 24 | xmu 25 | tmp) 26 | 27 | (defun make-batch-normalization-layer (input-dimension &key (epsilon 1.0e-6)) 28 | (check-type input-dimension alexandria:positive-integer) 29 | (check-type epsilon alexandria:positive-single-float) 30 | (let* ((dim input-dimension) 31 | (input-dimensions (list *batch-size* dim)) 32 | (layer (make-instance 'batch-normalization-layer 33 | :input-dimensions input-dimensions 34 | :output-dimensions input-dimensions 35 | :forward-out (make-mat input-dimensions) 36 | :backward-out (list (make-mat input-dimensions) ; dX 37 | (make-mat dim) ; dβ 38 | (make-mat dim)) ; dγ 39 | :epsilon epsilon 40 | :beta (make-mat dim :initial-element 0.0) 41 | :gamma (make-mat dim :initial-element 1.0) 42 | :var (make-mat dim) 43 | :sqrtvar (make-mat dim) 44 | :ivar (make-mat dim) 45 | :x^ (make-mat input-dimensions) 46 | :xmu (make-mat input-dimensions) 47 | :tmp (make-mat input-dimensions)))) 48 | (setf (updatable-parameters layer) (list (beta layer) (gamma layer)) 49 | (gradients layer) (cdr (backward-out layer))) 50 | layer)) 51 | 52 | (defmethod forward ((layer batch-normalization-layer) &rest inputs) 53 | (let ((x (car inputs)) 54 | (epsilon (epsilon layer)) 55 | (beta (beta layer)) 56 | (gamma (gamma layer)) 57 | (var (var layer)) 58 | (sqrtvar (sqrtvar layer)) 59 | (ivar (ivar layer)) 60 | (x^ (x^ layer)) 61 | (xmu (xmu layer)) 62 | (tmp (tmp layer)) 63 | (out (forward-out layer))) 64 | (average! x (ivar layer)) ; use ivar as tmp 65 | ;; calc xmu 66 | (fill! 1.0 xmu) 67 | (scale-columns! ivar xmu) 68 | (axpy! -1.0 x xmu) 69 | (scal! -1.0 xmu) 70 | ;; calc var 71 | (copy! xmu x^) ; use x^ as tmp 72 | (.square! x^) 73 | (average! x^ var) 74 | ;; calc sqrtvar 75 | (copy! var sqrtvar) 76 | (.+! epsilon sqrtvar) 77 | (.sqrt! sqrtvar) 78 | ;; calc ivar 79 | (copy! sqrtvar ivar) 80 | (.inv! ivar) 81 | ;; calc x^ 82 | (fill! 1.0 x^) 83 | (scale-columns! ivar x^) 84 | (.*! xmu x^) 85 | ;; calc output 86 | (fill! 1.0 tmp) 87 | (scale-columns! gamma tmp) 88 | (.*! x^ tmp) 89 | (fill! 1.0 out) 90 | (scale-columns! beta out) 91 | (axpy! 1.0 tmp out))) 92 | 93 | (defmethod backward ((layer batch-normalization-layer) dout) 94 | (destructuring-bind (dx dbeta dgamma) (backward-out layer) 95 | (let ((epsilon (epsilon layer)) 96 | (gamma (gamma layer)) 97 | (var (var layer)) 98 | (sqrtvar (sqrtvar layer)) 99 | (ivar (ivar layer)) 100 | (x^ (x^ layer)) 101 | (xmu (xmu layer)) 102 | (tmp (tmp layer))) 103 | ;; calc dx^ -> tmp 104 | (fill! 1.0 tmp) 105 | (scale-columns! gamma tmp) 106 | (.*! dout tmp) 107 | ;; calc dxmu1 -> dx 108 | (fill! 1.0 dx) 109 | (scale-columns! ivar dx) 110 | (.*! tmp dx) 111 | ;; calc divar -> dbeta 112 | (.*! xmu tmp) 113 | (sum! tmp dbeta :axis 0) 114 | ;; calc dsqrtvar -> dbeta 115 | (copy! sqrtvar dgamma) 116 | (.square! dgamma) 117 | (.inv! dgamma) 118 | (geem! -1.0 dbeta dgamma 0.0 dbeta) 119 | ;; calc dvar -> dbeta 120 | (copy! var dgamma) 121 | (.+! epsilon dgamma) 122 | (.sqrt! dgamma) 123 | (.inv! dgamma) 124 | (geem! 0.5 dbeta dgamma 0.0 dbeta) 125 | ;; calc dsq -> tmp 126 | (fill! 1.0 tmp) 127 | (scale-columns! dbeta tmp) 128 | (scal! (/ 1.0 (mat-dimension tmp 0)) tmp) 129 | ;; calc dxmu2 -> tmp 130 | (geem! 2.0 xmu tmp 0.0 tmp) 131 | ;; calc dx1 -> dx 132 | (axpy! 1.0 tmp dx) 133 | ;; calc -dmu -> dbeta 134 | (sum! dx dbeta :axis 0) 135 | ;; calc dx2 -> tmp 136 | (fill! 1.0 tmp) 137 | (scale-columns! dbeta tmp) 138 | (scal! (/ -1.0 (mat-dimension tmp 0)) tmp) 139 | ;; calc dx 140 | (axpy! 1.0 tmp dx) 141 | ;; calc dbeta 142 | (sum! dout dbeta :axis 0) 143 | ;; calc dgamma 144 | (geem! 1.0 dout x^ 0.0 tmp) 145 | (sum! tmp dgamma :axis 0) 146 | dx))) 147 | -------------------------------------------------------------------------------- /book/5-layers.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- coding:utf-8; mode:lisp -*- 2 | 3 | (in-package :cl-zerodl) 4 | 5 | ;; 5.4 単純なレイヤーの実装 6 | 7 | (define-class layer () 8 | input-dimensions output-dimensions 9 | forward-out backward-out) 10 | 11 | ;; 5.4.1 12 | 13 | (define-class multiple-layer (layer) 14 | x y) 15 | 16 | (defun make-multiple-layer (input-dimensions) 17 | (make-instance 'multiple-layer 18 | :input-dimensions input-dimensions 19 | :output-dimensions input-dimensions 20 | :forward-out (make-mat input-dimensions) 21 | :backward-out (list (make-mat input-dimensions) ; dx 22 | (make-mat input-dimensions)) ; dy 23 | :x (make-mat input-dimensions) 24 | :y (make-mat input-dimensions))) 25 | 26 | (defmethod forward ((layer multiple-layer) &rest inputs) 27 | (bind ((out (forward-out layer)) 28 | ((x y) inputs)) 29 | (copy! x (x layer)) 30 | (copy! y (y layer)) 31 | ;; geem! is elementwise matrix multiplication 32 | (geem! 1.0 x y 0.0 out))) 33 | 34 | (defparameter mul-layer1 (make-multiple-layer '(2 3))) 35 | (defparameter x (make-mat '(2 3) :initial-contents '((1 2 3) 36 | (4 5 6)))) 37 | (defparameter y (make-mat '(2 3) :initial-contents '((10 20 30) 38 | (40 50 60)))) 39 | (forward mul-layer1 x y) 40 | 41 | ;; # 42 | ;; [standard-object] 43 | 44 | ;; Slots with :INSTANCE allocation: 45 | ;; INPUT-DIMENSIONS = 3 46 | ;; OUTPUT-DIMENSIONS = 3 47 | ;; FORWARD-OUT = # 48 | ;; BACKWARD-OUT = (# #) 49 | ;; X = # 50 | ;; Y = # 51 | 52 | (defmethod backward ((layer multiple-layer) dout) 53 | (let* ((out (backward-out layer)) 54 | (dx (car out)) 55 | (dy (cadr out))) 56 | (geem! 1.0 dout (y layer) 0.0 dx) 57 | (geem! 1.0 dout (x layer) 0.0 dy) 58 | out)) 59 | 60 | (defparameter dout (make-mat '(2 3) :initial-element 1.0)) 61 | (backward mul-layer1 dout) 62 | 63 | ;; # 64 | ;; [standard-object] 65 | 66 | ;; Slots with :INSTANCE allocation: 67 | ;; INPUT-DIMENSIONS = 3 68 | ;; OUTPUT-DIMENSIONS = 3 69 | ;; FORWARD-OUT = # 70 | ;; BACKWARD-OUT = (# #) 71 | ;; X = # 72 | ;; Y = # 73 | 74 | ;; example of multiple-layer 75 | 76 | (defparameter apple (make-mat '(1 1) :initial-element 100.0)) 77 | (defparameter n-apple (make-mat '(1 1) :initial-element 2.0)) 78 | (defparameter tax (make-mat '(1 1) :initial-element 1.1)) 79 | (defparameter mul-apple-layer (make-multiple-layer '(1 1))) 80 | (defparameter mul-tax-layer (make-multiple-layer '(1 1))) 81 | 82 | ;; forward example 83 | (let* ((apple-price (forward mul-apple-layer apple n-apple)) 84 | (price (forward mul-tax-layer apple-price tax))) 85 | (print price)) 86 | 87 | ;; # 88 | 89 | ;; backward example 90 | (defparameter dprice (make-mat '(1 1) :initial-element 1.0)) 91 | 92 | (bind (((dapple-price dtax) (backward mul-tax-layer dprice)) 93 | ((dapple dn-apple) (backward mul-apple-layer dapple-price))) 94 | (print (list dapple dn-apple dtax))) 95 | 96 | ;; (# # #) 97 | 98 | ;; add layer 99 | 100 | 101 | (define-class add-layer (layer)) 102 | 103 | (defun make-add-layer (input-dimensions) 104 | (make-instance 'add-layer 105 | :input-dimensions input-dimensions 106 | :output-dimensions input-dimensions 107 | :forward-out (make-mat input-dimensions) 108 | :backward-out (list (make-mat input-dimensions) ; dx 109 | (make-mat input-dimensions)))) ; dy 110 | 111 | (defmethod forward ((layer add-layer) &rest inputs) 112 | (let ((out (forward-out layer))) 113 | (copy! (car inputs) out) 114 | (axpy! 1.0 (cadr inputs) out))) 115 | 116 | (defmethod backward ((layer add-layer) dout) 117 | (bind ((out (backward-out layer)) 118 | ((dx dy) out)) 119 | (copy! dout dx) 120 | (copy! dout dy) 121 | out)) 122 | 123 | ;; example of add-layer and multiple-layer 124 | 125 | (defparameter orange (make-mat '(1 1) :initial-element 150.0)) 126 | (defparameter n-orange (make-mat '(1 1) :initial-element 3.0)) 127 | (defparameter mul-orange-layer (make-multiple-layer '(1 1))) 128 | (defparameter add-apple-orange-layer (make-add-layer '(1 1))) 129 | 130 | ;; forward example 131 | (let* ((apple-price (forward mul-apple-layer apple n-apple)) 132 | (orange-price (forward mul-orange-layer orange n-orange)) 133 | (all-price (forward add-apple-orange-layer apple-price orange-price)) 134 | (price (forward mul-tax-layer all-price tax))) 135 | (print price)) 136 | 137 | ;; # 138 | 139 | ;; backward example 140 | (bind ((dprice (make-mat '(1 1) :initial-element 1.0)) 141 | ((dall-price dtax) (backward mul-tax-layer dprice)) 142 | ((dapple-price dorange-price) (backward add-apple-orange-layer dall-price)) 143 | ((dorange dnorange) (backward mul-orange-layer dorange-price)) 144 | ((dapple dnapple) (backward mul-apple-layer dapple-price))) 145 | (print (list dnapple dapple dorange dnorange dtax))) 146 | 147 | ;; (# # 148 | ;; # # 149 | ;; #) 150 | -------------------------------------------------------------------------------- /core/layer/conv2d.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:cl-zerodl/core/layer/conv2d 2 | (:use #:cl 3 | #:mgl-mat 4 | #:cl-zerodl/core/layer/base) 5 | (:nicknames :zerodl.layer.conv2d) 6 | (:import-from #:cl-zerodl/core/utils 7 | #:define-class) 8 | (:import-from #:alexandria 9 | #:positive-integer) 10 | (:export #:conv2d-layer 11 | #:filter 12 | #:anchor 13 | #:stride 14 | #:make-conv2d-layer 15 | #:max-pool-layer 16 | #:pool-dimensions 17 | #:make-max-pool-layer)) 18 | 19 | (in-package #:cl-zerodl/core/layer/conv2d) 20 | 21 | ;;; 7.2 conv2d layer 22 | 23 | (defun reshape-flatten! (mat) 24 | (let ((dims (mat-dimensions mat))) 25 | (reshape! mat (list (car dims) (reduce #'* (cdr dims)))))) 26 | 27 | (define-class conv2d-layer (updatable-layer) 28 | X filter anchor stride) 29 | 30 | ;; X: (batch-size, in1-size, in2-size) 31 | ;; Y: (batch-size, out1-size, out2-size) 32 | ;; W: (filter-x, filter-y) 33 | 34 | (defun make-conv2d-layer (input-dimensions filter-size stride-size) 35 | (assert (and (listp input-dimensions) (= (length input-dimensions) 2))) 36 | (check-type filter-size positive-integer) 37 | (assert (oddp filter-size)) 38 | (check-type stride-size positive-integer) 39 | (assert (and (< stride-size (first input-dimensions)) 40 | (< stride-size (second input-dimensions)))) 41 | 42 | (let ((input-dimensions (cons *batch-size* input-dimensions)) 43 | (anchor-size (/ (1- filter-size) 2))) 44 | (flet ((out-dim (in-dim) 45 | (1+ (/ (+ in-dim (* anchor-size 2) (- filter-size)) stride-size)))) 46 | (let* ((out1 (out-dim (second input-dimensions))) 47 | (out2 (out-dim (third input-dimensions))) 48 | (layer (make-instance 'conv2d-layer 49 | :input-dimensions input-dimensions 50 | :output-dimensions (list (first input-dimensions) out1 out2) 51 | :forward-out (make-mat (list (first input-dimensions) (* out1 out2))) 52 | :backward-out (list (make-mat (list (first input-dimensions) ; dX 53 | (* (second input-dimensions) 54 | (third input-dimensions)))) 55 | (make-mat (list filter-size filter-size))) ; dW 56 | :X (make-mat input-dimensions) 57 | :filter (make-mat (list filter-size filter-size)) 58 | :anchor (list anchor-size anchor-size) 59 | :stride (list stride-size stride-size)))) 60 | (setf (updatable-parameters layer) (list (filter layer)) 61 | (gradients layer) (cdr (backward-out layer))) 62 | layer)))) 63 | 64 | (defmethod forward ((layer conv2d-layer) &rest inputs) 65 | (let* ((X (car inputs)) 66 | (W (filter layer)) 67 | (Y (forward-out layer))) 68 | 69 | (reshape! X (input-dimensions layer)) 70 | (copy! X (X layer)) 71 | (reshape! Y (output-dimensions layer)) 72 | 73 | (fill! 0.0 Y) 74 | (convolve! X W Y :start '(0 0) :stride (stride layer) :anchor (anchor layer) :batched t) 75 | 76 | (reshape-flatten! X) 77 | (reshape-flatten! Y))) 78 | 79 | (defmethod backward ((layer conv2d-layer) dout) 80 | (destructuring-bind (dX dW) (backward-out layer) 81 | (let ((X (X layer)) 82 | (W (filter layer))) 83 | 84 | (reshape! dX (input-dimensions layer)) 85 | (reshape! dout (output-dimensions layer)) 86 | 87 | (fill! 0.0 dX) 88 | (fill! 0.0 dW) 89 | 90 | (derive-convolve! X dX W dW dout 91 | :start '(0 0) :stride (stride layer) :anchor (anchor layer) :batched t) 92 | 93 | (reshape-flatten! dX) 94 | (reshape-flatten! dout) 95 | 96 | (backward-out layer)))) 97 | 98 | ;;; 7.3 max-pool layer 99 | 100 | (define-class max-pool-layer (layer) 101 | X pool-dimensions) 102 | 103 | (defun make-max-pool-layer (input-dimensions output-dimensions pool-dimensions) 104 | (assert (and (listp input-dimensions) (= (length input-dimensions) 3))) 105 | (assert (and (listp output-dimensions) (= (length output-dimensions) 3))) 106 | (assert (and (listp pool-dimensions) (= (length pool-dimensions) 2))) 107 | 108 | (make-instance 'max-pool-layer 109 | :input-dimensions input-dimensions 110 | :output-dimensions output-dimensions 111 | :forward-out (make-mat output-dimensions) 112 | :backward-out (list (make-mat input-dimensions)) 113 | :X (make-mat input-dimensions) 114 | :pool-dimensions pool-dimensions)) 115 | 116 | (defmethod forward ((layer max-pool-layer) &rest inputs) 117 | (let* ((X (car inputs)) 118 | (Y (forward-out layer))) 119 | 120 | (reshape! X (input-dimensions layer)) 121 | (copy! X (X layer)) 122 | (reshape! Y (output-dimensions layer)) 123 | 124 | (fill! 0.0 Y) 125 | (max-pool! X Y :start '(0 0) 126 | :stride (pool-dimensions layer) 127 | :anchor '(0 0) 128 | :batched t 129 | :pool-dimensions (pool-dimensions layer)) 130 | 131 | (reshape-flatten! X) 132 | (reshape-flatten! Y))) 133 | 134 | (defmethod backward ((layer max-pool-layer) dout) 135 | (destructuring-bind (dX) (backward-out layer) 136 | (let ((X (X layer)) 137 | (Y (forward-out layer))) 138 | 139 | (reshape! dX (input-dimensions layer)) 140 | (reshape! dout (output-dimensions layer)) 141 | (reshape! Y (output-dimensions layer)) 142 | 143 | (fill! 0.0 dX) 144 | 145 | (derive-max-pool! X dX Y dout :start '(0 0) 146 | :stride (pool-dimensions layer) 147 | :anchor '(0 0) 148 | :batched t 149 | :pool-dimensions (pool-dimensions layer)) 150 | 151 | (reshape-flatten! dX) 152 | (reshape-flatten! dout) 153 | (reshape-flatten! Y) 154 | 155 | (backward-out layer)))) 156 | -------------------------------------------------------------------------------- /core/network.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:cl-zerodl/core/network 2 | (:use #:cl 3 | #:mgl-mat 4 | #:cl-zerodl/core/layer) 5 | (:nicknames :zerodl.network) 6 | (:import-from #:cl-zerodl/core/utils 7 | #:define-class) 8 | (:import-from #:cl-zerodl/core/initializer 9 | #:initializer 10 | #:he-initializer 11 | #:initialize!) 12 | (:import-from #:cl-zerodl/core/optimizer/base 13 | #:optimizer 14 | #:update!) 15 | (:import-from #:cl-zerodl/core/optimizer/sgd 16 | #:sgd) 17 | (:import-from #:alexandria 18 | #:positive-integer) 19 | (:export #:network 20 | ;; Network slots 21 | #:layers 22 | #:batch-size 23 | #:initializer 24 | #:optimizer 25 | ;; Constructor 26 | #:make-network 27 | ;; Utilities 28 | #:do-layer 29 | #:do-updatable-layer 30 | #:last-layer 31 | ;; Learning interfaces 32 | #:predict 33 | #:set-mini-batch! 34 | #:train 35 | #:accuracy 36 | )) 37 | 38 | (in-package #:cl-zerodl/core/network) 39 | 40 | ;;; Network 41 | 42 | (define-class network () 43 | (layers :initform #() 44 | :type vector) 45 | (batch-size :initform 100 46 | :type positive-integer) 47 | (initializer :initform (make-instance 'he-initializer) 48 | :type initializer) 49 | (optimizer :initform (make-instance 'sgd) 50 | :type optimizer)) 51 | 52 | (defmacro do-layer ((layer network type) &body body) 53 | `(loop for ,layer across (layers ,network) do 54 | (when (eq (type-of ,layer) (quote ,type)) 55 | ,@body))) 56 | 57 | (defmacro do-updatable-layer ((layer network) &body body) 58 | `(loop for ,layer across (layers ,network) do 59 | (when (slot-exists-p ,layer 'updatable-parameters) 60 | ,@body))) 61 | 62 | (defun update-network! (network) 63 | (do-updatable-layer (layer network) 64 | (mapc (lambda (param grad) 65 | (update! (optimizer network) param grad)) 66 | (updatable-parameters layer) 67 | (gradients layer)))) 68 | 69 | (defun initialize-network! (network) 70 | (do-layer (layer network affine-layer) 71 | (initialize! (initializer network) (weight layer))) 72 | (do-layer (layer network conv2d-layer) 73 | (initialize! (initializer network) (filter layer)))) 74 | 75 | (defun make-network (layers 76 | &key (initializer (make-instance 'he-initializer)) 77 | (optimizer (make-instance 'sgd))) 78 | (assert (every (lambda (layer) (typep layer 'layer)) layers)) 79 | (let ((network (make-instance 80 | 'network 81 | :layers layers 82 | :batch-size *batch-size* 83 | :initializer initializer 84 | :optimizer optimizer))) 85 | (initialize-network! network) 86 | network)) 87 | 88 | (defun last-layer (network) 89 | (aref (layers network) (1- (length (layers network))))) 90 | 91 | (defun predict (network x) 92 | (let* ((layers (layers network)) 93 | (len (length layers))) 94 | (loop for i from 0 below (1- len) do 95 | (setf x (forward (aref layers i) x))) 96 | x)) 97 | 98 | (defun loss (network x target) 99 | (let ((y (predict network x))) 100 | (forward (last-layer network) y target))) 101 | 102 | ;; Calculate gradient 103 | 104 | (defmethod set-gradient! ((network network) x target) 105 | (let ((layers (layers network)) 106 | dout) 107 | ;; forward 108 | (loss network x target) 109 | ;; backward 110 | (setf dout (backward (last-layer network) 1.0)) 111 | (loop for i from (- (length layers) 2) downto 0 do 112 | (let ((layer (svref layers i))) 113 | (setf dout (backward layer (if (listp dout) (car dout) dout))))) 114 | ;; ;; weight-decay 115 | ;; (do-layer (layer network affine-layer) 116 | ;; (let ((dW (cadr (backward-out layer)))) 117 | ;; (axpy! 0.00001 (weight layer) dW)) 118 | ;; ) 119 | )) 120 | 121 | (defun weight-decay-network! (network regularization-rate) 122 | (do-layer (layer network affine-layer) 123 | (axpy! regularization-rate (weight layer) (weight layer)))) 124 | 125 | ;;; Set/Reset mini-batch 126 | 127 | (defun set-mini-batch! (dataset start-row-index batch-size) 128 | (let ((dim (mat-dimension dataset 1))) 129 | (reshape-and-displace! dataset 130 | (list batch-size dim) 131 | (* start-row-index dim)))) 132 | 133 | (defun reset-shape! (dataset) 134 | (let* ((dim (mat-dimension dataset 1)) 135 | (len (/ (mat-max-size dataset) dim))) 136 | (reshape-and-displace! dataset (list len dim) 0))) 137 | 138 | ;;; Training 139 | 140 | (defun train (network x target) 141 | (set-gradient! network x target) 142 | (update-network! network)) 143 | 144 | ;;; Predict class, Accuracy for dataset 145 | 146 | (defun max-position-column (arr) 147 | (declare (optimize (speed 3) (space 0) (safety 0) (debug 0)) 148 | (type (array single-float) arr)) 149 | (let ((max-arr (make-array (array-dimension arr 0) 150 | :element-type 'single-float 151 | :initial-element most-negative-single-float)) 152 | (pos-arr (make-array (array-dimension arr 0) 153 | :element-type 'fixnum 154 | :initial-element 0))) 155 | (loop for i fixnum from 0 below (array-dimension arr 0) do 156 | (loop for j fixnum from 0 below (array-dimension arr 1) do 157 | (when (> (aref arr i j) (aref max-arr i)) 158 | (setf (aref max-arr i) (aref arr i j) 159 | (aref pos-arr i) j)))) 160 | pos-arr)) 161 | 162 | (defun predict-class (network x) 163 | (max-position-column (mat-to-array (predict network x)))) 164 | 165 | (defun accuracy (network dataset target) 166 | (let* ((batch-size (batch-size network)) 167 | (dim (mat-dimension dataset 1)) 168 | (len (/ (mat-max-size dataset) dim)) 169 | (cnt 0)) 170 | (loop for n from 0 to (- len batch-size) by batch-size do 171 | (set-mini-batch! dataset n batch-size) 172 | (set-mini-batch! target n batch-size) 173 | (incf cnt 174 | (loop for pred across (predict-class network dataset) 175 | for tgt across (max-position-column (mat-to-array target)) 176 | count (= pred tgt)))) 177 | (* (/ cnt len) 1.0))) 178 | -------------------------------------------------------------------------------- /book/conv.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- coding:utf-8; mode:lisp -*- 2 | 3 | (in-package :zerodl) 4 | 5 | (ql:quickload :alexandria) 6 | 7 | ;; conv2d 8 | 9 | (defparameter x (make-mat '(2 4 4) 10 | :ctype :float 11 | :initial-contents '(((1 2 3 0) 12 | (0 1 2 3) 13 | (3 0 1 2) 14 | (2 3 0 1)) 15 | ((1 2 3 0) 16 | (0 1 2 3) 17 | (3 0 1 2) 18 | (2 3 0 1))))) 19 | 20 | (defparameter w (make-mat '(3 3) 21 | :ctype :float 22 | :initial-contents '((2 0 1) 23 | (0 1 2) 24 | (1 0 2)))) 25 | 26 | (defparameter y (make-mat '(2 4 4) 27 | :ctype :float 28 | :initial-element 0)) 29 | 30 | (defparameter conv2d1 (make-conv2d-layer '(2 4 4) 3 1)) 31 | 32 | (copy! w (filter conv2d1)) 33 | 34 | (defparameter input (reshape x '(2 16))) 35 | 36 | (forward conv2d1 input) 37 | (forward-out conv2d1) 38 | 39 | (defparameter dout (make-mat '(2 16) 40 | :ctype :float 41 | :initial-element 1.0)) 42 | 43 | (backward conv2d1 dout) 44 | 45 | (convolve! x w y :start '(0 0) :stride '(1 1) :anchor '(1 1) :batched t) 46 | 47 | (print y) 48 | 49 | ;; # 57 | 58 | ;; 59 | 60 | (defparameter xd (make-mat '(2 3 4))) 61 | (defparameter wd (make-mat '(2 2))) 62 | (defparameter yd (make-mat '(2 3 2) :initial-element 1.0)) 63 | 64 | (derive-convolve! x xd w wd yd :start '(0 0) :stride '(1 2) :anchor '(1 0) :batched t) 65 | 66 | 67 | ;; max-pooling 68 | 69 | (defparameter x (make-mat '(2 4 4) 70 | :ctype :float 71 | :initial-contents '(((1 2 1 0) 72 | (0 1 2 3) 73 | (3 0 1 2) 74 | (2 4 0 1)) 75 | ((1 2 1 0) 76 | (0 1 2 3) 77 | (3 0 1 2) 78 | (2 4 0 1))))) 79 | 80 | (defparameter y (make-mat '(2 2 2) 81 | :ctype :float 82 | :initial-element 0)) 83 | 84 | (max-pool! x y :start '(0 0) :stride '(2 2) :anchor '(0 0) :batched t :pool-dimensions '(2 2)) 85 | 86 | (print y) 87 | 88 | ;; # 89 | 90 | ;; anchor位置を変えてみる 91 | 92 | (defparameter y 93 | (make-mat '(2 3 2))) 94 | 95 | (convolve! x w y :start '(0 0) :stride '(1 2) :anchor '(0 0) :batched t) 96 | 97 | (print y) 98 | 99 | ;; # 101 | 102 | ;;; max-pool! 103 | 104 | (max-pool! x y :start '(0 0) :stride '(1 2) :anchor '(1 0) :batched t 105 | :pool-dimensions '(2 2)) 106 | 107 | ;;; ydが後のレイヤーから入ってくるbackwardの入力 108 | ;;; xd,wdには代入ではなく加算代入される 109 | 110 | (defparameter xd (make-mat '(2 3 4))) 111 | (defparameter wd (make-mat '(2 2))) 112 | (defparameter yd (make-mat '(2 3 2) :initial-element 1.0)) 113 | 114 | (derive-convolve! x xd w wd yd :start '(0 0) :stride '(1 2) :anchor '(1 0) :batched t) 115 | (print xd) 116 | ;; # 122 | 123 | (print wd) 124 | ;; # 125 | 126 | 127 | (max-pool! x y :start '(0 0) :stride '(1 2) :anchor '(1 0) :batched t 128 | :pool-dimensions '(2 2)) 129 | 130 | (ql:quickload :alexandria) 131 | (replace! yd (append (alexandria:iota 6 :start 1) 132 | (alexandria:iota 6 :start -1 :step -1))) 133 | 134 | (derive-max-pool! x xd y yd :start '(0 0) :stride '(1 2) :anchor '(1 0) :batched t :pool-dimensions '(2 2)) 135 | (print xd) 136 | (print yd) 137 | 138 | ;;; 3次元データでできるか？ 139 | 140 | (defparameter x (make-mat '(2 2 3 3))) 141 | (defparameter w (make-mat '(2 2 2))) 142 | (defparameter y (make-mat '(2 2 2 2) :initial-element 1.0)) 143 | 144 | (convolve! x w y :start '(1 1) :stride '(1 1) :anchor '(1 1) :batched t) 145 | 146 | ;;; 逆伝搬の具体例 147 | ;; https://qiita.com/bukei_student/items/a3d1bcd429f99942ace4 148 | ;; convolve!はyの値を累積していく(yの初期化が必要) 149 | ;; derive-convolve!はxdとwdを累積していく 150 | (defparameter x (make-mat '(9 9) 151 | :ctype :float 152 | :initial-element 1.0)) 153 | 154 | (defparameter w (make-mat '(3 3) 155 | :ctype :float 156 | :initial-contents '((1 2 3) 157 | (4 5 6) 158 | (7 8 9)))) 159 | 160 | (defparameter y (make-mat '(3 3) 161 | :ctype :float 162 | :initial-element 0)) 163 | 164 | (convolve! x w y :start '(0 0) :stride '(3 3) :anchor '(0 0)) 165 | 166 | (defparameter xd (make-mat '(9 9) 167 | :ctype :float 168 | :initial-element 0)) 169 | 170 | (defparameter wd (make-mat '(3 3) 171 | :ctype :float 172 | :initial-element 0)) 173 | 174 | (defparameter yd (make-mat '(3 3) 175 | :ctype :float 176 | :initial-element 1)) 177 | 178 | (derive-convolve! x xd w wd yd :start '(0 0) :stride '(3 3) :anchor '(0 0)) 179 | 180 | ;;; max-pool 181 | 182 | (defparameter x2 (make-mat '(2 4 4) 183 | :ctype :float 184 | :initial-contents '(((1 2 1 0) 185 | (0 1 2 3) 186 | (3 0 1 2) 187 | (2 4 0 1)) 188 | ((1 2 1 0) 189 | (0 1 2 3) 190 | (3 0 1 2) 191 | (2 4 0 1))))) 192 | (defparameter y2 (make-mat '(2 2 2) 193 | :ctype :float 194 | :initial-element 0)) 195 | 196 | ;; 一般的にstrideはpool-dimensionsサイズと合わせる 197 | (max-pool! x2 y2 :start '(0 0) :stride '(2 2) :anchor '(0 0) :batched t :pool-dimensions '(2 2)) 198 | 199 | y2 200 | 201 | ;; # 205 | 206 | (defparameter x2d (make-mat '(2 4 4) 207 | :ctype :float 208 | :initial-element 0)) 209 | (defparameter dout (make-mat '(2 2 2) 210 | :ctype :float 211 | :initial-element 1)) 212 | 213 | (derive-max-pool! x2 x2d y2 dout :start '(0 0) :stride '(2 2) :anchor '(0 0) :batched t :pool-dimensions '(2 2)) 214 | -------------------------------------------------------------------------------- /example/mnist.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- coding:utf-8; mode:lisp -*- 2 | 3 | (in-package :cl-zerodl) 4 | 5 | (multiple-value-bind (datamat target) 6 | (read-data "/home/wiz/datasets/mnist.scale" 784 10 :most-min-class 0) 7 | (defparameter mnist-dataset datamat) 8 | (defparameter mnist-target target)) 9 | 10 | (multiple-value-bind (datamat target) 11 | (read-data "/home/wiz/datasets/mnist.scale.t" 784 10 :most-min-class 0) 12 | (defparameter mnist-dataset-test datamat) 13 | (defparameter mnist-target-test target)) 14 | 15 | ;; バッチサイズをいちいち書きたくない。こう書きたいが・・・ 16 | ;; ダイナミック変数として外側で設定する？ 17 | ;; networkオブジェクトのバッチサイズを使っているところは現状accuracyくらいしかない 18 | ;; TODO: make-network時に前のレイヤーの出力次元数と次のレイヤーの入力次元数が合ってるかどうかのチェックを入れたい 19 | 20 | (defparameter mnist-network 21 | (let ((*batch-size* 100)) 22 | (make-network (vector 23 | (make-affine-layer 784 512) 24 | (make-batch-normalization-layer 512) 25 | (make-relu-layer 512) 26 | (make-affine-layer 512 512) 27 | (make-batch-normalization-layer 512) 28 | (make-relu-layer 512) 29 | (make-affine-layer 512 10) 30 | (make-softmax/loss-layer 10)) 31 | :initializer (make-instance 'he-initializer)))) 32 | 33 | (defparameter mnist-network 34 | (let ((*batch-size* 100)) 35 | (make-network (vector 36 | (make-affine-layer 784 512) 37 | (make-dropout-layer 512) 38 | (make-relu-layer 512) 39 | (make-affine-layer 512 512) 40 | (make-dropout-layer 512) 41 | (make-relu-layer 512) 42 | (make-affine-layer 512 10) 43 | (make-softmax/loss-layer 10)) 44 | :initializer (make-instance 'he-initializer)))) 45 | 46 | (defparameter mnist-network 47 | (let ((*batch-size* 100)) 48 | (make-network (vector 49 | (make-affine-layer 784 512) 50 | (make-relu-layer 512) 51 | (make-affine-layer 512 512) 52 | (make-relu-layer 512) 53 | (make-affine-layer 512 10) 54 | (make-softmax/loss-layer 10)) 55 | :initializer (make-instance 'he-initializer)))) 56 | 57 | (defparameter cnn-net 58 | (make-network '((affine :in 784 :out 512) 59 | (batch-norm :in 512) 60 | (relu :in 512) 61 | (affine :in 512 :out 512) 62 | (batch-norm :in 512) 63 | (relu :in 512) 64 | (affine :in 512 :out 512) 65 | (batch-norm :in 512) 66 | (relu :in 512) 67 | (affine :in 512 :out 512) 68 | (batch-norm :in 512) 69 | (relu :in 512) 70 | (affine :in 512 :out 512) 71 | (batch-norm :in 512) 72 | (relu :in 512) 73 | (affine :in 512 :out 512) 74 | (batch-norm :in 512) 75 | (relu :in 512) 76 | (affine :in 512 :out 10) 77 | (softmax :in 10)) 78 | :batch-size 100 79 | :initializer (make-instance 'he-initializer))) 80 | 81 | ;;; Momentum optimizer 82 | 83 | (setf (optimizer mnist-network) 84 | (make-momentum-sgd 0.01 0.9 mnist-network)) 85 | 86 | (setf (optimizer mnist-network) 87 | (make-momentum-sgd 0.01 0.9 mnist-network)) 88 | 89 | (setf (optimizer mnist-network) 90 | (make-adagrad 0.01 mnist-network)) 91 | 92 | (setf (optimizer mnist-network) 93 | (make-aggmo 0.01 '(0.0 0.9 0.99) mnist-network)) 94 | 95 | (setf (optimizer mnist-network) 96 | (make-aggmo 0.05 '(0.0 0.9 0.99) mnist-network)) 97 | 98 | (time 99 | (loop repeat 100 do 100 | (let* ((batch-size (batch-size mnist-network)) 101 | (rand (random (- 60000 batch-size)))) 102 | (set-mini-batch! mnist-dataset rand batch-size) 103 | (set-mini-batch! mnist-target rand batch-size) 104 | (train mnist-network mnist-dataset mnist-target)))) 105 | 106 | (loop repeat (* 600 15) do 107 | (let* ((batch-size (batch-size mnist-network)) 108 | (rand (random (- 60000 batch-size)))) 109 | (set-mini-batch! mnist-dataset rand batch-size) 110 | (set-mini-batch! mnist-target rand batch-size) 111 | (train mnist-network mnist-dataset mnist-target))) 112 | 113 | ;; CPU 114 | 115 | ;; CPU (hidden-size = 50) 116 | 117 | ;; Evaluation took: 118 | ;; 6.252 seconds of real time 119 | ;; 24.940000 seconds of total run time (16.044000 user, 8.896000 system) 120 | ;; [ Run times consist of 0.020 seconds GC time, and 24.920 seconds non-GC time. ] 121 | ;; 398.91% CPU 122 | ;; 21,206,428,661 processor cycles 123 | ;; 370,380,864 bytes consed 124 | 125 | ;; CPU (hidden-size = 256) 126 | 127 | ;; Evaluation took: 128 | ;; 13.120 seconds of real time 129 | ;; 52.396000 seconds of total run time (35.036000 user, 17.360000 system) 130 | ;; [ Run times consist of 0.020 seconds GC time, and 52.376 seconds non-GC time. ] 131 | ;; 399.36% CPU 132 | ;; 44,502,821,057 processor cycles 133 | ;; 371,635,088 bytes consed 134 | 135 | ;; CPU (hidden-size = 512) 136 | 137 | ;; Evaluation took: 138 | ;; 27.189 seconds of real time 139 | ;; 108.0000000 seconds of total run time (75.776000 user, 32.224000 system) 140 | ;; [ Run times consist of 0.024 seconds GC time, and 107.976 seconds non-GC time. ] 141 | ;; 397.22% CPU 142 | ;; 92,232,020,174 processor cycles 143 | ;; 373,157,568 bytes consed 144 | 145 | ;; GPU 146 | 147 | (with-cuda* () 148 | (time 149 | (loop repeat 10000 do 150 | (let* ((batch-size (batch-size mnist-network)) 151 | (rand (random (- 60000 batch-size)))) 152 | (set-mini-batch! mnist-dataset rand batch-size) 153 | (set-mini-batch! mnist-target rand batch-size) 154 | (train mnist-network mnist-dataset mnist-target))))) 155 | 156 | (time 157 | (loop repeat 10000 do 158 | (let* ((batch-size (batch-size mnist-network)) 159 | (rand (random (- 60000 batch-size)))) 160 | (set-mini-batch! mnist-dataset rand batch-size) 161 | (set-mini-batch! mnist-target rand batch-size) 162 | (train mnist-network mnist-dataset mnist-target)))) 163 | 164 | ;; GPU (hidden-size = 50) 165 | 166 | ;; Evaluation took: 167 | ;; 4.882 seconds of real time 168 | ;; 4.884000 seconds of total run time (4.504000 user, 0.380000 system) 169 | ;; [ Run times consist of 0.004 seconds GC time, and 4.880 seconds non-GC time. ] 170 | ;; 100.04% CPU 171 | ;; 16,561,635,611 processor cycles 172 | ;; 335,076,320 bytes consed 173 | 174 | ;; GPU (hidden-size = 256) 175 | 176 | ;; Evaluation took: 177 | ;; 6.709 seconds of real time 178 | ;; 6.712000 seconds of total run time (5.660000 user, 1.052000 system) 179 | ;; 100.04% CPU 180 | ;; 22,759,082,791 processor cycles 181 | ;; 323,884,528 bytes consed 182 | 183 | ;; GPU (hidden-size = 512) 184 | 185 | ;; Evaluation took: 186 | ;; 8.552 seconds of real time 187 | ;; 8.556000 seconds of total run time (6.932000 user, 1.624000 system) 188 | ;; [ Run times consist of 0.004 seconds GC time, and 8.552 seconds non-GC time. ] 189 | ;; 100.05% CPU 190 | ;; 29,011,606,780 processor cycles 191 | ;; 323,874,336 bytes consed 192 | 193 | (set-mini-batch! mnist-dataset 0 100) 194 | (set-mini-batch! mnist-target 0 100) 195 | 196 | (print (predict-class mnist-network mnist-dataset)) 197 | 198 | ;; #(5 0 4 1 9 2 1 3 1 4 3 5 3 6 1 7 2 8 6 9 4 0 9 1 1 2 4 3 2 7 3 8 6 9 0 5 6 0 7 199 | ;; 6 1 8 7 9 3 9 8 5 9 3 3 0 7 4 9 8 0 9 4 1 4 4 6 0 4 5 6 1 0 0 1 7 1 6 3 0 2 1 200 | ;; 1 7 0 0 2 6 7 8 3 9 0 4 6 7 4 6 8 0 7 8 3 1) 201 | 202 | ;; (time 203 | ;; (loop repeat 10000 do 204 | ;; (predict-class mnist-network mnist-dataset))) 205 | 206 | ;; Evaluation took: 207 | ;; 2.603 seconds of real time 208 | ;; 10.228000 seconds of total run time (6.408000 user, 3.820000 system) 209 | ;; 392.93% CPU 210 | ;; 8,827,408,084 processor cycles 211 | ;; 140,452,704 bytes consed 212 | 213 | (print (max-position-column (mat-to-array mnist-target))) 214 | 215 | ;; #(5 0 4 1 9 2 1 3 1 4 3 5 3 6 1 7 2 8 6 9 4 0 9 1 1 2 4 3 2 7 3 8 6 9 0 5 6 0 7 216 | ;; 6 1 8 7 9 3 9 8 5 9 3 3 0 7 4 9 8 0 9 4 1 4 4 6 0 4 5 6 1 0 0 1 7 1 6 3 0 2 1 217 | ;; 1 7 9 0 2 6 7 8 3 9 0 4 6 7 4 6 8 0 7 8 3 1) 218 | 219 | (accuracy mnist-network mnist-dataset mnist-target) 220 | (accuracy mnist-network mnist-dataset-test mnist-target-test) 221 | 222 | (defparameter train-acc-list nil) 223 | (defparameter test-acc-list nil) 224 | 225 | (defparameter train-acc-list2 nil) 226 | (defparameter test-acc-list2 nil) 227 | 228 | (defparameter train-acc-list3 nil) 229 | (defparameter test-acc-list3 nil) 230 | 231 | (defparameter train-acc-list4 nil) 232 | (defparameter test-acc-list4 nil) 233 | 234 | (defparameter train-acc-list5 nil) 235 | (defparameter test-acc-list5 nil) 236 | 237 | (with-cuda* () 238 | (loop for i from 1 to (* 600 10) do 239 | (let* ((batch-size (batch-size mnist-network)) 240 | (rand (random (- 60000 batch-size)))) 241 | (set-mini-batch! mnist-dataset rand batch-size) 242 | (set-mini-batch! mnist-target rand batch-size) 243 | (train mnist-network mnist-dataset mnist-target) 244 | (when (zerop (mod i 600)) 245 | ;; (clgp:splot-matrix (mat-to-array (gethash (weight (aref (layers mnist-network) 0)) 246 | ;; (velocities (optimizer mnist-network))))) 247 | (let ((train-acc (accuracy mnist-network mnist-dataset mnist-target)) 248 | (test-acc (accuracy mnist-network mnist-dataset-test mnist-target-test))) 249 | (format t "cycle: ~A~,15Ttrain-acc: ~A~,10Ttest-acc: ~A~%" i train-acc test-acc) 250 | (push train-acc train-acc-list) 251 | (push test-acc test-acc-list)))))) 252 | 253 | (loop for i from 1 to (* 600 100) do 254 | (let* ((batch-size (batch-size mnist-network)) 255 | (rand (random (- 60000 batch-size)))) 256 | (set-mini-batch! mnist-dataset rand batch-size) 257 | (set-mini-batch! mnist-target rand batch-size) 258 | (train mnist-network mnist-dataset mnist-target) 259 | (when (zerop (mod i 600)) 260 | (let ((train-acc (accuracy mnist-network mnist-dataset mnist-target)) 261 | (test-acc (accuracy mnist-network mnist-dataset-test mnist-target-test))) 262 | (format t "cycle: ~A~,15Ttrain-acc: ~A~,10Ttest-acc: ~A~%" i train-acc test-acc))))) 263 | 264 | (clgp:plots (list (reverse train-acc-list) 265 | (reverse test-acc-list) 266 | (reverse train-acc-list2) 267 | (reverse test-acc-list2) 268 | (reverse train-acc-list3) 269 | (reverse test-acc-list3) 270 | ) 271 | ;; :title-list '("train(momentum)" "test(momentum)" 272 | ;; ;; "train(momentum,lambda=0.00001)" "test(momentum,,lambda=0.00001)" 273 | ;; ;; "train(momentum,lambda=0.0001)" "test(momentum,,lambda=0.0001)" 274 | ;; ) 275 | :x-label "n-epoch" 276 | :y-label "accuracy" 277 | :y-range '(0.96 1.015)) 278 | 279 | ;; 6.179 seconds of real time for set-gradient! ; python: 7.0sec 280 | ;; 22.230 seconds of real time for set-mini-batch! ; python: 0.55sec 281 | ;; 1.583 seconds of real time for set-batch 282 | 283 | ;; (sb-profile:profile forward backward train softmax! set-gradient! predict loss) 284 | ;; (sb-profile:report) 285 | ;; (sb-profile:unprofile forward backward train softmax! set-gradient! predict loss) 286 | 287 | ;; seconds | gc | consed | calls | sec/call | name 288 | ;; ------------------------------------------------------------- 289 | ;; 99.143 | 6.596 | 14,728,331,056 | 1,000 | 0.099143 | SET-MINI-BATCH! 290 | ;; 2.069 | 0.000 | 32,759,808 | 4,000 | 0.000517 | FORWARD 291 | ;; 1.142 | 0.000 | 32,736 | 4,000 | 0.000285 | BACKWARD 292 | ;; 0.399 | 0.000 | 0 | 1,000 | 0.000399 | SOFTMAX! 293 | ;; 0.129 | 0.000 | 32,768 | 1,000 | 0.000129 | TRAIN 294 | ;; 0.070 | 0.000 | 0 | 1,000 | 0.000070 | CALC-GRADIENT 295 | ;; ------------------------------------------------------------- 296 | ;; 102.953 | 6.596 | 14,761,156,368 | 12,000 | | Total 297 | 298 | ;; estimated total profiling overhead: 0.01 seconds 299 | ;; overhead estimation parameters: 300 | ;; 2.4e-8s/call, 1.136e-6s total profiling, 5.68e-7s internal profiling 301 | 302 | (defparameter mnist-network-sigmoid 303 | (make-network '((affine :in 784 :out 50) 304 | (sigmoid :in 50) 305 | (affine :in 50 :out 10) 306 | (softmax :in 10)) 307 | :batch-size 100)) 308 | 309 | ;; (time 310 | ;; (loop for i from 1 to 10000 do 311 | ;; (let* ((batch-size (batch-size mnist-network-sigmoid)) 312 | ;; (rand (random (- 60000 batch-size)))) 313 | ;; (set-mini-batch! mnist-dataset rand batch-size) 314 | ;; (set-mini-batch! mnist-target rand batch-size) 315 | ;; (train mnist-network-sigmoid mnist-dataset mnist-target) 316 | ;; (when (zerop (mod i 600)) 317 | ;; (format t "cycle: ~A~,15Ttrain-acc: ~A~,10Ttest-acc: ~A~%" 318 | ;; i 319 | ;; (accuracy mnist-network-sigmoid mnist-dataset mnist-target) 320 | ;; (accuracy mnist-network-sigmoid mnist-dataset-test mnist-target-test)))))) 321 | -------------------------------------------------------------------------------- /book/matrix.lisp: -------------------------------------------------------------------------------- 1 | (defun matrixp (matrix) 2 | "Test whether the argument is a matrix" 3 | (and (arrayp matrix) 4 | (= (array-rank matrix) 2))) 5 | 6 | (defun num-rows (matrix) 7 | "Return the number of rows of a matrix" 8 | (array-dimension matrix 0)) 9 | 10 | (defun num-cols (matrix) 11 | "Return the number of rows of a matrix" 12 | (array-dimension matrix 1)) 13 | 14 | (defun square-matrix? (matrix) 15 | "Is the matrix a square matrix?" 16 | (and (matrixp matrix) 17 | (= (num-rows matrix) (num-cols matrix)))) 18 | 19 | (defun make-matrix (rows &optional (cols rows)) 20 | "Create a matrix filled with zeros. If only one parameter is 21 | specified the matrix will be square." 22 | (make-array (list rows cols) :initial-element 0)) 23 | 24 | (defun make-identity-matrix (size) 25 | "Make an identity matrix of the specified size." 26 | (let ((matrix (make-array (list size size) :initial-element 0))) 27 | (dotimes (i size matrix) 28 | (setf (aref matrix i i) 1)))) 29 | 30 | (defun copy-matrix (matrix) 31 | "Return a copy of the matrix." 32 | (let* ((rows (num-rows matrix)) 33 | (cols (num-cols matrix)) 34 | (copy (make-array (list rows cols)))) 35 | (dotimes (row rows copy) 36 | (dotimes (col cols) 37 | (setf (aref copy row col) (aref matrix row col)))))) 38 | 39 | (defun print-matrix (matrix &optional (destination t) (control-string " ~$")) 40 | "Print a matrix. The optional control string indicates how each 41 | entry should be printed." 42 | (let ((rows (num-Rows matrix)) 43 | (cols (num-Cols matrix))) 44 | (dotimes (row rows) 45 | (format destination "~%") 46 | (dotimes (col cols) 47 | (format destination control-string (aref matrix row col)))) 48 | (format destination "~%"))) 49 | 50 | (defun transpose-matrix (matrix) 51 | "Transpose a matrix" 52 | (let* ((rows (num-rows matrix)) 53 | (cols (num-cols matrix)) 54 | (transpose (make-matrix cols rows))) 55 | (dotimes (row rows transpose) 56 | (dotimes (col cols) 57 | (setf (aref transpose col row) 58 | (aref matrix row col)))))) 59 | 60 | (defun multiply-scalar-matrix (scalar matrix) 61 | (let* ((rows (num-rows matrix)) 62 | (cols (num-cols matrix)) 63 | (result (make-matrix rows cols))) 64 | (dotimes (row rows result) 65 | (dotimes (col cols) 66 | (setf (aref result row col) 67 | (* scalar (aref matrix row col))))) 68 | result)) 69 | 70 | (defun multiply-matrix (&rest matrices) 71 | "Multiply matrices" 72 | (labels ((multiply-two (m1 m2) 73 | (let* ((rows1 (num-rows m1)) 74 | (cols1 (num-cols m1)) 75 | (cols2 (num-cols m2)) 76 | (result (make-matrix rows1 cols2))) 77 | (dotimes (row rows1 result) 78 | (dotimes (col cols2) 79 | (dotimes (i cols1) 80 | (setf (aref result row col) 81 | (+ (aref result row col) 82 | (* (aref m1 row i) 83 | (aref m2 i col)))))))))) 84 | (when matrices ; Empty arguments check 85 | (reduce #'multiply-two matrices)))) 86 | 87 | (defun add-matrix (&rest matrices) 88 | "Add matrices" 89 | (labels ((add-two (m1 m2) 90 | (let* ((rows (num-rows m1)) 91 | (cols (num-cols m1)) 92 | (result (make-matrix rows cols))) 93 | (dotimes (row rows result) 94 | (dotimes (col cols) 95 | (setf (aref result row col) 96 | (+ (aref m1 row col) 97 | (aref m2 row col)))))))) 98 | (when matrices ; Empty arguments check 99 | (reduce #'add-two matrices)))) 100 | 101 | (defun subtract-matrix (&rest matrices) 102 | "Subtract matrices" 103 | (labels ((subtract-two (m1 m2) 104 | (let* ((rows (num-rows m1)) 105 | (cols (num-cols m1)) 106 | (result (make-matrix rows cols))) 107 | (dotimes (row rows result) 108 | (dotimes (col cols) 109 | (setf (aref result row col) 110 | (- (aref m1 row col) 111 | (aref m2 row col)))))))) 112 | (when matrices ; Empty arguments check 113 | (reduce #'subtract-two matrices)))) 114 | 115 | (defun invert-matrix (matrix &optional (destructive T)) 116 | "Find the inverse of a matrix. By default this operation is 117 | destructive. If you want to preserve the original matrix, call this 118 | function with an argument of NIL to destructive." 119 | (let ((result (if destructive matrix (copy-matrix matrix))) 120 | (size (num-rows matrix)) 121 | (temp 0)) 122 | (dotimes (i size result) 123 | (setf temp (aref result i i)) 124 | (dotimes (j size) 125 | (setf (aref result i j) 126 | (if (= i j) 127 | (/ (aref result i j)) 128 | (/ (aref result i j) temp)))) 129 | (dotimes (j size) 130 | (unless (= i j) 131 | (setf temp (aref result j i) 132 | (aref result j i) 0) 133 | (dotimes (k size) 134 | (setf (aref result j k) 135 | (- (aref result j k) 136 | (* temp (aref result i k)))))))))) 137 | 138 | (defun exchange-rows (matrix row-i row-j) 139 | "Exchange row-i and row-j of a matrix" 140 | (let ((cols (num-cols matrix))) 141 | (dotimes (col cols) 142 | (rotatef (aref matrix row-i col) (aref matrix row-j col))))) 143 | 144 | 145 | (defun eliminate-matrix (matrix rows cols) 146 | "Gaussian elimination with partial pivoting. " 147 | ;; Evaluated for side effect. A return value of :singular indicates the 148 | ;; matrix is singular (an error). 149 | (let ((max 0)) 150 | (loop for i below rows 151 | do (setf max i) 152 | do (loop for j from (1+ i) below rows 153 | do (when (> (abs (aref matrix j i)) 154 | (abs (aref matrix max i))) 155 | (setf max j))) 156 | do (when (zerop (aref matrix max i)) 157 | (return-from eliminate-matrix :singular)) ; error "Singular matrix" 158 | do (loop for k from i below cols ; Exchange rows 159 | do (rotatef (aref matrix i k) (aref matrix max k))) 160 | do (loop for j from (1+ i) below rows 161 | do (loop for k from (1- cols) downto i 162 | do (setf (aref matrix j k) 163 | (- (aref matrix j k) 164 | (* (aref matrix i k) 165 | (/ (aref matrix j i) 166 | (aref matrix i i))))) 167 | ))) 168 | matrix)) 169 | 170 | (defun substitute-matrix (matrix rows cols) 171 | (let ((temp 0.0) 172 | (x (make-array rows :initial-element 0))) 173 | (loop for j from (1- rows) downto 0 174 | do (setf temp 0.0) 175 | do (loop for k from (1+ j) below rows 176 | do (incf temp (* (aref matrix j k) (aref x k)))) 177 | do (setf (aref x j) (/ (- (aref matrix j (1- cols)) temp) 178 | (aref matrix j j)))) 179 | x)) 180 | 181 | (defun solve-matrix (matrix &optional (destructive T) print-soln) 182 | "Solve a matrix using Gaussian elimination 183 | Matrix must be N by N+1 184 | Assume solution is stored as the N+1st column of the matrix" 185 | (let ((rows (num-rows matrix)) 186 | (cols (num-cols matrix)) 187 | (result (if destructive matrix (copy-matrix matrix)))) 188 | (unless (= (1+ rows) cols) 189 | (error "Ill formed matrix")) ; Cryptic error message 190 | (cond ((eq :singular (eliminate-matrix result rows cols))) 191 | (T (let ((soln (substitute-matrix result rows cols))) 192 | (when print-soln 193 | (loop for i below rows 194 | do (format t "~% X~A = ~A" i (aref soln i)))) 195 | soln))))) 196 | 197 | (defun trace-matrix (matrix) 198 | (if (not (square-matrix? matrix)) 199 | (error "Ill formed matrix") 200 | (let ((rows (num-rows matrix))) 201 | (loop for i from 0 to (1- rows) sum (aref matrix i i))))) 202 | 203 | (defun partial-matrix (matrix rows cols) 204 | (let ((mat (make-array (list rows cols)))) 205 | (dotimes (i rows) 206 | (dotimes (j cols) 207 | (setf (aref mat i j) (aref matrix i j)))) 208 | mat)) 209 | 210 | ;;; vector utilities ========================================================== 211 | (defun make-vector (len &key (element-type t) (initial-element 0.0d0) (initial-contents nil)) 212 | (if initial-contents 213 | (let ((ini-con (mapcar (lambda (x) (cons x ())) initial-contents))) 214 | (make-array (list len 1) :element-type element-type :initial-contents ini-con)) 215 | (make-array (list len 1) :element-type element-type :initial-element initial-element))) 216 | 217 | (defun list->vector (lst) 218 | (make-vector (length lst) :initial-contents lst)) 219 | 220 | (defun simple-vector->arrayed-vector (simple-vector &optional (vertical? t)) 221 | (if vertical? 222 | (let ((arr (make-array (list (length simple-vector) 1)))) 223 | (loop for i from 0 to (1- (length simple-vector)) do 224 | (setf (aref arr i 0) (svref simple-vector i))) 225 | arr) 226 | (let ((arr (make-array (list 1 (length simple-vector))))) 227 | (loop for j from 0 to (1- (length simple-vector)) do 228 | (setf (aref arr 0 j) (svref simple-vector j))) 229 | arr))) 230 | 231 | (defun vector-cat (v1 v2) 232 | (let* ((v1-len (array-dimension v1 0)) 233 | (v2-len (array-dimension v2 0)) 234 | (len (+ v1-len v2-len)) 235 | (v-new (make-array (list len 1)))) 236 | (loop for i from 0 to (1- v1-len) do 237 | (setf (aref v-new i 0) (aref v1 i 0))) 238 | (loop for i from v1-len to (1- len) do 239 | (setf (aref v-new i 0) (aref v2 (- i v1-len) 0))) 240 | v-new)) 241 | 242 | (defun vector-cat2 (v1 v2) 243 | (let ((gv1 (if (arrayp v1) v1 (make-vector 1 :initial-element v1))) 244 | (gv2 (if (arrayp v2) v2 (make-vector 1 :initial-element v2)))) 245 | (vector-cat gv1 gv2))) 246 | 247 | (defun vector-length (vec) 248 | (if (numberp vec) 1 249 | (array-dimension vec 0))) 250 | 251 | (defun euclidean-norm (vec) 252 | (sqrt 253 | (summation (i 0 (1- (vector-length vec))) 254 | (let ((elem (aref vec i 0))) 255 | (* elem elem))))) 256 | 257 | 258 | ;;; matrix utilities ========================================================== 259 | 260 | (defmacro nlet (tag var-vals &body body) 261 | `(labels ((,tag ,(mapcar #'car var-vals) ,@body)) 262 | (declare (optimize (speed 3))) ; for tail recursion optimization 263 | (,tag ,@(mapcar #'cadr var-vals)))) 264 | 265 | (defun m* (&rest args) 266 | (nlet itf ((prod (car args)) 267 | (args (cdr args))) 268 | (if (null args) 269 | prod 270 | (cond ((and (numberp prod) (numberp (car args))) 271 | (itf (* prod (car args)) (cdr args))) 272 | ((numberp prod) 273 | (itf (multiply-scalar-matrix prod (car args)) (cdr args))) 274 | ((numberp (car args)) 275 | (itf (multiply-scalar-matrix (car args) prod) (cdr args))) 276 | (t (itf (multiply-matrix prod (car args)) (cdr args))))))) 277 | 278 | (defun m+ (&rest matrices) 279 | (apply #'add-matrix matrices)) 280 | 281 | (defun ssum-vec (vec-lst) 282 | (reduce #'m+ vec-lst :initial-value (make-vector (length vec-lst) :initial-element 0.0d0))) 283 | 284 | (defun m- (&rest matrices) 285 | (apply #'subtract-matrix matrices)) 286 | 287 | (defun m-t (mat) 288 | (transpose-matrix mat)) 289 | 290 | (defun umat (size) 291 | (let ((matrix (make-array (list size size) 292 | :initial-element 0d0 :element-type 'double-float))) 293 | (dotimes (i size matrix) 294 | (setf (aref matrix i i) 1d0)))) 295 | 296 | (defun zero-mat (size) 297 | (make-array (list size size) :initial-element 0d0)) 298 | 299 | (defun m-1 (mat) 300 | (invert-matrix mat NIL)) 301 | 302 | (defun m-append-horizon (m1 m2) 303 | (let* ((m1-dims (array-dimensions m1)) 304 | (m2-dims (array-dimensions m2)) 305 | (product (make-array (list (car m1-dims) (+ (cadr m1-dims) (cadr m2-dims)))))) 306 | (if (not (= (car m1-dims) (car m2-dims))) 307 | (print "Error: wrong matrix size.") 308 | (progn 309 | (loop for i from 0 to (1- (car m1-dims)) do 310 | (loop for j from 0 to (1- (cadr m1-dims)) do 311 | (setf (aref product i j) (aref m1 i j))) 312 | (loop for j from (cadr m1-dims) to (1- (+ (cadr m1-dims) (cadr m2-dims))) do 313 | (setf (aref product i j) (aref m2 i (- j (cadr m1-dims)))))) 314 | product)))) 315 | 316 | (defun vec (&rest elements) 317 | (make-vector (length elements) :initial-contents elements)) 318 | 319 | (defun mat (contents-list &key (element-type t)) 320 | (let ((row-len (length contents-list)) 321 | (col-len (length (car contents-list)))) 322 | (make-array (list row-len col-len) 323 | :element-type element-type 324 | :initial-contents contents-list))) 325 | 326 | (defun mapmat (proc matrix) 327 | (let ((m (make-array (array-dimensions matrix)))) 328 | (loop for i from 0 to (1- (array-dimension matrix 0)) do 329 | (loop for j from 0 to (1- (array-dimension matrix 1)) do 330 | (setf (aref m i j) (funcall proc (aref matrix i j))))) 331 | m)) 332 | 333 | (defun mapvec (proc &rest vectors) 334 | (let ((v (make-array (array-dimensions (car vectors))))) 335 | (loop for i from 0 to (1- (array-dimension (car vectors) 0)) 336 | do (setf (aref v i 0) 337 | (apply proc (mapcar (lambda (vec) (aref vec i 0)) vectors)))) 338 | v)) 339 | --------------------------------------------------------------------------------