From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Jan Wedekind Newsgroups: gmane.lisp.guile.user Subject: Re: Tensorflow bindings Date: Sat, 15 Dec 2018 13:58:46 +0000 (GMT) Message-ID: References: Reply-To: Jan Wedekind NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: text/plain; format=flowed; charset=US-ASCII X-Trace: blaine.gmane.org 1544883136 21367 195.159.176.226 (15 Dec 2018 14:12:16 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Sat, 15 Dec 2018 14:12:16 +0000 (UTC) User-Agent: Alpine 2.20 (DEB 67 2015-01-07) To: guile-user@gnu.org Original-X-From: guile-user-bounces+guile-user=m.gmane.org@gnu.org Sat Dec 15 15:12:12 2018 Return-path: Envelope-to: guile-user@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1gYAfr-0005Rm-OG for guile-user@m.gmane.org; Sat, 15 Dec 2018 15:12:11 +0100 Original-Received: from localhost ([::1]:39254 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1gYAhy-0004Y5-Be for guile-user@m.gmane.org; Sat, 15 Dec 2018 09:14:22 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:39923) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1gYAhF-0003wR-GM for guile-user@gnu.org; Sat, 15 Dec 2018 09:13:42 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1gYASx-0005pn-Hb for guile-user@gnu.org; Sat, 15 Dec 2018 08:58:55 -0500 Original-Received: from wp424.webpack.hosteurope.de ([2a01:488:42:1000:50ed:85c1::]:46406) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1gYASx-0005mw-1u for guile-user@gnu.org; Sat, 15 Dec 2018 08:58:51 -0500 Original-Received: from host86-163-167-143.range86-163.btcentralplus.com ([86.163.167.143] helo=wedemob.home); authenticated by wp424.webpack.hosteurope.de running ExIM with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) id 1gYASs-0002Of-S9; Sat, 15 Dec 2018 14:58:47 +0100 X-X-Sender: jan@wedemob.home In-Reply-To: X-bounce-key: webpack.hosteurope.de;jan@wedesoft.de;1544882331;a1408a89; X-HE-SMSGID: 1gYASs-0002Of-S9 X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 2a01:488:42:1000:50ed:85c1:: X-BeenThere: guile-user@gnu.org X-Mailman-Version: 2.1.21 Precedence: list List-Id: General Guile related discussions List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-user-bounces+guile-user=m.gmane.org@gnu.org Original-Sender: "guile-user" Xref: news.gmane.org gmane.lisp.guile.user:15093 Archived-At: 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 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 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 #:shape '(-1 28 28))) (define y (tf-placeholder #:dtype #: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 )) (define r1 (tf-reshape (tf-mul (flt (/ 1 stddev)) (tf-sub (flt x) (flt average))) (arr -1 28 28 1))) ; First convolutional layer with max-pooling and ReLU activation function. (define k1 (tf-variable #:dtype #: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 #: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 (list -1 d)))) ; First fully connected layer with bias units and ReLU activation function. (define m1 (tf-variable #:dtype #:shape (list d 40))) (define b1 (tf-variable #:dtype #: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 #:shape '(40 10))) (define b2 (tf-variable #:dtype #: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 3 3 1 4) #:dtype ))) (tf-assign k2 (tf-mul (flt (/ 1 9)) (tf-random-uniform (arr 3 3 4 16) #:dtype ))) (tf-assign m1 (tf-mul (flt (/ 1 n)) (tf-random-uniform (to-array (list d 40)) #:dtype ))) (tf-assign b1 (fill '(40) 0.0)) (tf-assign m2 (tf-mul (flt (/ 1 40)) (tf-random-uniform (arr 40 10) #:dtype ))) (tf-assign b2 (fill '(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 0 1)))) ; Regularization term (define regularization (tf-add (tf-mean (tf-square (tf-abs m1)) (arr 0 1)) (tf-mean (tf-square (tf-abs m2)) (arr 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)