Here follows another example. The MNIST handwritten digit database is a
well-known benchmark for machine learning.
The following code implements a neural network with two convolutional
layers and two fully connected layers. The example achieves an error rate
of 2.75%. I am planning to add regularization which might improve the
result a bit.
(use-modules (oop goops)
(ice-9 binary-ports)
(ice-9 format)
(srfi srfi-1)
(rnrs bytevectors)
(system foreign)
(aiscm core)
(aiscm xorg)
(aiscm tensorflow))
; Get MNIST data at http://yann.lecun.com/exdb/mnist/
(define (read-images file-name)
(let* [(f (open-file file-name "rb"))
(magic (bytevector-u32-ref (get-bytevector-n f 4) 0 (endianness
big)))
(n (bytevector-u32-ref (get-bytevector-n f 4) 0 (endianness
big)))
(h (bytevector-u32-ref (get-bytevector-n f 4) 0 (endianness
big)))
(w (bytevector-u32-ref (get-bytevector-n f 4) 0 (endianness
big)))]
(if (not (eqv? magic 2051)) (error "Images file has wrong magic
number"))
(let [(bv (get-bytevector-n f (* n h w)))]
(make (multiarray <ubyte> 3) #:memory (bytevector->pointer bv)
#:shape (list n h w)))))
(define (read-labels file-name)
(let* [(f (open-file file-name "rb"))
(magic (bytevector-u32-ref (get-bytevector-n f 4) 0 (endianness
big)))
(n (bytevector-u32-ref (get-bytevector-n f 4) 0 (endianness
big)))]
(if (not (eqv? magic 2049)) (error "Label file has wrong magic number"))
(let [(bv (get-bytevector-n f n))]
(make (multiarray <ubyte> 1) #:memory (bytevector->pointer bv)
#:shape (list n)))))
(define f (open-file "train-labels-idx1-ubyte" "rb"))
(define magic (bytevector-u32-ref (get-bytevector-n f 4) 0 (endianness
big)))
(if (not (eqv? magic 2049)) (error "Label file has wrong magic number"))
(define n2 (bytevector-u32-ref (get-bytevector-n f 4) 0 (endianness big)))
(if (not (eqv? n n2)) (error "Number of labels does not match number of
images"))
(define bv (get-bytevector-n f n))
(define labels (make (multiarray <ubyte> 1) #:memory (bytevector->pointer
bv) #:shape (list n)))
(define images (read-images "train-images-idx3-ubyte"))
(define labels (read-labels "train-labels-idx1-ubyte"))
(define n (car (shape images)))
(define s (make-session))
(define x (tf-placeholder #:dtype <ubyte> #:shape '(-1 28 28)))
(define y (tf-placeholder #:dtype <ubyte> #:shape '(-1)))
(define r1 (tf-reshape (tf-sub (tf-mul (/ 1 256) (tf-cast x #:DstT <double>))
0.5) (arr <int> -1 28 28 1)))
(define k1 (tf-variable #:dtype <double> #:shape '(3 3 1 4)))
(define c1 (tf-conv2d r1 k1 #:strides '(1 1 1 1) #:padding 'VALID))
(define p1 (tf-relu (tf-max-pool c1 #:strides '(1 2 2 1) #:ksize '(1 2 2 1)
#:padding 'VALID)))
(define k2 (tf-variable #:dtype <double> #:shape '(3 3 4 16)))
(define c2 (tf-conv2d p1 k2 #:strides '(1 1 1 1) #:padding 'VALID))
(define p2 (tf-relu (tf-max-pool c2 #:strides '(1 2 2 1) #:ksize '(1 2 2 1)
#:padding 'VALID)))
(define d (* 5 5 16))
(define r2 (tf-reshape p2 (to-array <int> (list -1 d))))
(define m1 (tf-variable #:dtype <double> #:shape (list d 40)))
(define b1 (tf-variable #:dtype <double> #:shape '(40)))
(define l1 (tf-relu (tf-add (tf-mat-mul r2 m1) b1)))
(define m2 (tf-variable #:dtype <double> #:shape '(40 10)))
(define b2 (tf-variable #:dtype <double> #:shape '(10)))
(define l (tf-softmax (tf-add (tf-mat-mul l1 m2) b2)))
(define prediction (tf-arg-max l 1 #:name "prediction"))
(run s '() (tf-assign k1 (tf-mul (/ 1 9) (tf-random-uniform (arr <int> 3 3 1 4)
#:dtype <double>))))
(run s '() (tf-assign k2 (tf-mul (/ 1 9) (tf-random-uniform (arr <int> 3 3 4 16)
#:dtype <double>))))
(run s '() (tf-assign m1 (tf-mul (/ 1 n) (tf-random-uniform (to-array <int> (list
d 40)) #:dtype <double>))))
(run s '() (tf-assign b1 (fill <double> '(40) 0.0)))
(run s '() (tf-assign m2 (tf-mul (/ 1 40) (tf-random-uniform (arr <int> 40 10)
#:dtype <double>))))
(run s '() (tf-assign b2 (fill <double> '(10) 0.0)))
(define vars (list k1 k2 m1 b1 m2 b2))
(define yh (tf-one-hot y 10 1.0 0.0))
(define cost (tf-neg (tf-mean (tf-add (tf-mul yh (tf-log l)) (tf-mul (tf-sub 1.0
yh) (tf-log (tf-sub 1.0 l)))) (arr <int> 0 1))))
(define gradients (tf-add-gradient cost vars))
(define alpha 0.4)
(define step (map (lambda (v g) (tf-assign v (tf-sub v (tf-mul g alpha))))
vars gradients))
(define j 0.0)
(for-each
(lambda (epoch)
(for-each
(lambda (i)
(let* [(range (cons i (+ i 50)))
(batch (list (cons x (unroll (get images range))) (cons y
(get labels range))))
(js (run s batch cost))]
(set! j (+ (* 0.99 j) (* 0.01 js)))
(format #t "\r~2d, ~5d/~5d: ~6,4f" epoch i n j)
(run s batch step)))
(iota (/ n 50) 0 50)))
(iota 3))
(define test-images (read-images "t10k-images-idx3-ubyte"))
(define test-labels (read-labels "t10k-labels-idx1-ubyte"))
(define n-test (car (shape test-images)))
(define predicted (run s (list (cons x test-images)) prediction))
(define n-correct (sum (where (eq predicted test-labels) 1 0)))
(format #t "error rate: ~6,4f~&" (- 1.0 (/ n-correct n-test)))
Regards
Jan