[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: Tensorflow bindings
From: |
Jan Wedekind |
Subject: |
Re: Tensorflow bindings |
Date: |
Sat, 15 Dec 2018 13:58:46 +0000 (GMT) |
User-agent: |
Alpine 2.20 (DEB 67 2015-01-07) |
I updated the MNIST example some more and added a bit of documentation:
(use-modules (oop goops)
(ice-9 binary-ports)
(ice-9 format)
(srfi srfi-1)
(rnrs bytevectors)
(system foreign)
(aiscm core)
(aiscm xorg)
(aiscm util)
(aiscm tensorflow))
(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)))))
; Load MNIST data set available at http://yann.lecun.com/exdb/mnist/
(define images (read-images "train-images-idx3-ubyte"))
(define labels (read-labels "train-labels-idx1-ubyte"))
(define n (car (shape images)))
; Create Tensorflow session
(define s (make-session))
; Define placeholders for features (images) and labels
(define x (tf-placeholder #:dtype <ubyte> #:shape '(-1 28 28)))
(define y (tf-placeholder #:dtype <ubyte> #:shape '(-1)))
; Determine parameters for feature scaling
(define (sqr x) (* x x))
(define count (apply * (shape images)))
(define average (exact->inexact (/ (sum images) count)))
(define stddev (sqrt (/ (sum (sqr (- images average))) count)))
; Scale features and reshape to 4D array
(define (flt x) (tf-cast x #:DstT <float>))
(define r1 (tf-reshape (tf-mul (flt (/ 1 stddev)) (tf-sub (flt x) (flt average)))
(arr <int> -1 28 28 1)))
; First convolutional layer with max-pooling and ReLU activation function.
(define k1 (tf-variable #:dtype <float> #: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)))
; Second convolutional layer with max-pooling and ReLU activation function.
(define k2 (tf-variable #:dtype <float> #: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)))
; Reshape to 2D array
(define d (* 5 5 16))
(define r2 (tf-reshape p2 (to-array <int> (list -1 d))))
; First fully connected layer with bias units and ReLU activation function.
(define m1 (tf-variable #:dtype <float> #:shape (list d 40)))
(define b1 (tf-variable #:dtype <float> #:shape '(40)))
(define l1 (tf-relu (tf-add (tf-mat-mul r2 m1) b1)))
; Second fully connected layer with bias units and softmax activation
function.
(define m2 (tf-variable #:dtype <float> #:shape '(40 10)))
(define b2 (tf-variable #:dtype <float> #:shape '(10)))
(define l (tf-softmax (tf-add (tf-mat-mul l1 m2) b2)))
; Classification result of neural network.
(define prediction (tf-arg-max l 1 #:name "prediction"))
; Random initialization of network parameters
(define initializers
(list (tf-assign k1 (tf-mul (flt (/ 1 9)) (tf-random-uniform (arr <int> 3 3 1
4) #:dtype <float>)))
(tf-assign k2 (tf-mul (flt (/ 1 9)) (tf-random-uniform (arr <int> 3 3 4
16) #:dtype <float>)))
(tf-assign m1 (tf-mul (flt (/ 1 n)) (tf-random-uniform (to-array <int>
(list d 40)) #:dtype <float>)))
(tf-assign b1 (fill <float> '(40) 0.0))
(tf-assign m2 (tf-mul (flt (/ 1 40)) (tf-random-uniform (arr <int> 40 10)
#:dtype <float>)))
(tf-assign b2 (fill <float> '(10) 0.0))))
(run s '() initializers)
; List of all network parameters
(define vars (list k1 k2 m1 b1 m2 b2))
; Logistic loss function
(define yh (tf-one-hot y 10 (flt 1.0) (flt 0.0)))
(define (safe-log x) (tf-log (tf-maximum x (flt 1e-10))))
(define (invert x) (tf-sub (flt 1.0) x))
(define loss (tf-neg (tf-mean (tf-add (tf-mul yh (safe-log l)) (tf-mul (invert
yh) (safe-log (invert l)))) (arr <int> 0 1))))
; Regularization term
(define regularization (tf-add (tf-mean (tf-square (tf-abs m1)) (arr <int> 0 1))
(tf-mean (tf-square (tf-abs m2)) (arr <int> 0 1))))
; Overall cost
(define la 0.02)
(define cost (tf-add loss (tf-mul (flt la) regularization)))
; Implement gradient descent step
(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 (flt
alpha))))) vars gradients))
; Perform gradient descent
(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))
(format #t "~&")
; Load MNIST test data.
(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)))
; Display cost function result for (part of) training and test data
(define j (run s (list (cons x (unroll (get images '(0 . 10000)))) (cons y
(get labels '(0 . 10000)))) loss))
(define jt (run s (list (cons x test-images) (cons y test-labels)) loss))
(format #t "train: ~6,4f; test: ~6,4f~&" j jt)
; Determine error rate
(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)))
; Display individual results
(define time (clock))
(define i -1)
(show
(lambda (dsp)
(set! i (1+ i))
(let* [(image (get test-images (modulo i 10000)))
(pred (get (run s (list (cons x image)) prediction) 0))]
(synchronise image (- i (elapsed time)) (event-loop dsp))
(format #t "~a~&" pred)
image))
#:width 280)