guile-user
[Top][All Lists]
Advanced

[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)



reply via email to

[Prev in Thread] Current Thread [Next in Thread]