[Larceny-users] Request for implementation

[Philippos Apolinarius]

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.

 I believe that Larceny with its interpreter-like compilation is better than Gambit for implementing neural networks, genetic algorithms and other trainable systems. However, final users likes so much the Gambit Matlab-like notation that they pratically force me to write the programs in Gambit.  Therefore, I would like to suggest a Gambit-like infix notation for Larceny. It would be great if Larceny team could provide complete compatibility with Gambit. By the way, I am sending a simplified version of my Larceny neural network so people can compare Larceny with Gambit. To run it in Larceny, type:

> (load "larcenet.scm")

> (train xor *exs* )

> (xor '(1 1))
0.01259132904526414

> (xor '(1 0))
0.9889715928565634

> (xor '(0 1))
0.9889715928640815

> (xor '(0 0))
0.009909459444548928

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

> (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
-------------- next part --------------
HTML attachment scrubbed and removed