Philippos Apolinarius
2009-05-06 07:02:54 UTC
When I compare Larceny with other Scheme implementations, I notice that it excells exactly in that kind of programs that make people choose a Lisp dialect over other languages: Machine learning and induction. For instance, I wrote a neural network in Scheme that is used in a pattern recognition system written by Professor Marcus Vinicius from Ryerson University (Toronto) and Paulo Caparelli from UFU (Uberlandia). Larceny runs it as fast as compiled Gambit, but does not require a (slow) compilation step. However, Gambit has a feature that final users find very attractive: It provides a quite complete conventional language, with infix notation, and the like. Even doctors and nurses are able to modify the Gambit program, once they learn the language.
To run it in Gambit, comment the line
;;(load "ec.scm")
and uncomment
(include "ec.scm") ;; and uncomment this one
Here is how to compile the program in Gambit:
C:\larceny\tutorial>gsc -:s larcenet.scm
C:\larceny\tutorial>gsc
Gambit v4.4.2
;; Larceny version.
;; This program is part of a pattern recognition
;; system that drives a wheel-chair for quadriplegic
;; people: www.ciaem.org.br/ciaem.qps/Ref/QUIS-7GJP7J
;; A description of the complete system, written in
;; Scheme by Philippos, will be published in a paper
;; by Marcus Vinicius dos Santos, that can be reached
;; at web.mac.com/marcusvsantos/iWeb/Site/About%20Me.html
;; The wheel chair learns how to recognize EMG signals
;; from facial muscles. A neural network recognizes
;; the coeficients of a polynomial approximation of
;; the signal, and drives the chair accordingly.
;; The chair will be available soon, although the
;; pattern recognition version needs a special
;; order, and user training. This Larceny version
;; is not used in the chair prototype.
;; Store in file larcenet.scm
(load "ec.scm") ;; To compile in Gambit, comment this line
;;(include "ec.scm") ;; and uncomment this one
;; In Gambit, the sigmoid function is defined thus:
;; \float sig(float x) {1.0/(1.0+exp(-x));}
(define (sig x)
(/ 1.0 (+ 1.0 (exp (- x)) )))
(define (newn v ws)
(lambda(xs)
(sig (sum-ec (:parallel
(:list i ws)
(:list x (cons 1.0 xs)))
(* (vector-ref v i) x) )) )) ;; Gambit: \v[i]*x;
(define in-1 car)
(define in-2 cadr)
(define (gate vt)
(let [ (n1 (newn vt '(4 5 6)) )
(ns (newn vt '(0 1 2 3)))]
(lambda (i)
(if (null? i) vt
(ns (list (in-1 i)
(n1 (list (in-1 i) (in-2 i)))
(in-2 i) ))) )))
;; Here is how to create a xor neural network:
(define xor (gate (vector -4 -7 14 -7 -3 8 8)))
(define dx 0.01)
(define lc 0.5)
(define *nuweights* (make-vector 90) )
(define *examples* #f)
(define (assertWgt vt I R)
(vector-set! vt I R) R)
(define (egratia eg)
(vector-ref *examples*
(min eg (- (vector-length *examples*) 1)) ))
(define (setWeights vt Qs)
(do-ec (:range i (vector-length vt))
(vector-set! vt i
(vector-ref Qs i)) ) )
(define (errSum prt Exs)
(sum-ec (:list e Exs)
(:let eg (egratia e))
(:let vc (prt (cdr eg) ))
(:let v (car eg) )
(* (- vc v) (- vc v)) ) )
(define (updateWeights prt vt err0 ns Exs)
[do-ec (:range i (+ ns 1))
(:let v (vector-ref vt i))
(:let v1 (assertWgt vt i (+ v dx)))
(:let nerr (errSum prt Exs))
(:let nv (+ v (/ (* lc (- err0 nerr)) dx)) ) ;; Gambit: \v+lc*(err0-nerr)/dx;
(begin (assertWgt vt i v)
(vector-set! *nuweights* i nv) ) ]
(setWeights vt *nuweights*) )
(define (train p exs)
(set! *examples* exs )
(set! *nuweights* (make-vector 90))
(setWeights (p '()) '#(0 1 0 0 2 0 0))
(do ( (vt (p '()))
(exs '(0 1 2 3 3 2 1 0)) )
( (< (errSum p exs) 0.001) )
(updateWeights p vt (errSum p exs)
(- (vector-length vt) 1) exs) ) )
(define *exs*
'#( (0 1 1) (1 0 1) (1 1 0) (0 0 0)) )
;;(training xor '( (0 1 1) (1 1 0) (1 0 1) (0 0 0)) )
__________________________________________________________________
Connect with friends from any web browser - no download required. Try the new Yahoo! Canada Messenger for the Web BETA at http://ca.messenger.yahoo.com/webmessengerpromo.php
(load "larcenet.scm")
(train xor *exs* )
(xor '(1 1))
0.01259132904526414(train xor *exs* )
(xor '(1 1))
(xor '(1 0))
0.9889715928565634(xor '(0 1))
0.9889715928640815(xor '(0 0))
0.009909459444548928To run it in Gambit, comment the line
;;(load "ec.scm")
and uncomment
(include "ec.scm") ;; and uncomment this one
Here is how to compile the program in Gambit:
C:\larceny\tutorial>gsc -:s larcenet.scm
C:\larceny\tutorial>gsc
Gambit v4.4.2
(load "larcenet.o1")
"C:\\larceny\\tutorial\\larcenet.o1"(train xor *exs*)
========== The Program ================;; Larceny version.
;; This program is part of a pattern recognition
;; system that drives a wheel-chair for quadriplegic
;; people: www.ciaem.org.br/ciaem.qps/Ref/QUIS-7GJP7J
;; A description of the complete system, written in
;; Scheme by Philippos, will be published in a paper
;; by Marcus Vinicius dos Santos, that can be reached
;; at web.mac.com/marcusvsantos/iWeb/Site/About%20Me.html
;; The wheel chair learns how to recognize EMG signals
;; from facial muscles. A neural network recognizes
;; the coeficients of a polynomial approximation of
;; the signal, and drives the chair accordingly.
;; The chair will be available soon, although the
;; pattern recognition version needs a special
;; order, and user training. This Larceny version
;; is not used in the chair prototype.
;; Store in file larcenet.scm
(load "ec.scm") ;; To compile in Gambit, comment this line
;;(include "ec.scm") ;; and uncomment this one
;; In Gambit, the sigmoid function is defined thus:
;; \float sig(float x) {1.0/(1.0+exp(-x));}
(define (sig x)
(/ 1.0 (+ 1.0 (exp (- x)) )))
(define (newn v ws)
(lambda(xs)
(sig (sum-ec (:parallel
(:list i ws)
(:list x (cons 1.0 xs)))
(* (vector-ref v i) x) )) )) ;; Gambit: \v[i]*x;
(define in-1 car)
(define in-2 cadr)
(define (gate vt)
(let [ (n1 (newn vt '(4 5 6)) )
(ns (newn vt '(0 1 2 3)))]
(lambda (i)
(if (null? i) vt
(ns (list (in-1 i)
(n1 (list (in-1 i) (in-2 i)))
(in-2 i) ))) )))
;; Here is how to create a xor neural network:
(define xor (gate (vector -4 -7 14 -7 -3 8 8)))
(define dx 0.01)
(define lc 0.5)
(define *nuweights* (make-vector 90) )
(define *examples* #f)
(define (assertWgt vt I R)
(vector-set! vt I R) R)
(define (egratia eg)
(vector-ref *examples*
(min eg (- (vector-length *examples*) 1)) ))
(define (setWeights vt Qs)
(do-ec (:range i (vector-length vt))
(vector-set! vt i
(vector-ref Qs i)) ) )
(define (errSum prt Exs)
(sum-ec (:list e Exs)
(:let eg (egratia e))
(:let vc (prt (cdr eg) ))
(:let v (car eg) )
(* (- vc v) (- vc v)) ) )
(define (updateWeights prt vt err0 ns Exs)
[do-ec (:range i (+ ns 1))
(:let v (vector-ref vt i))
(:let v1 (assertWgt vt i (+ v dx)))
(:let nerr (errSum prt Exs))
(:let nv (+ v (/ (* lc (- err0 nerr)) dx)) ) ;; Gambit: \v+lc*(err0-nerr)/dx;
(begin (assertWgt vt i v)
(vector-set! *nuweights* i nv) ) ]
(setWeights vt *nuweights*) )
(define (train p exs)
(set! *examples* exs )
(set! *nuweights* (make-vector 90))
(setWeights (p '()) '#(0 1 0 0 2 0 0))
(do ( (vt (p '()))
(exs '(0 1 2 3 3 2 1 0)) )
( (< (errSum p exs) 0.001) )
(updateWeights p vt (errSum p exs)
(- (vector-length vt) 1) exs) ) )
(define *exs*
'#( (0 1 1) (1 0 1) (1 1 0) (0 0 0)) )
;;(training xor '( (0 1 1) (1 1 0) (1 0 1) (0 0 0)) )
__________________________________________________________________
Connect with friends from any web browser - no download required. Try the new Yahoo! Canada Messenger for the Web BETA at http://ca.messenger.yahoo.com/webmessengerpromo.php