xor-ann.ss

(import (gauche array) (srfi 27))
(define rand (random-source-make-reals default-random-source))
(define (init i j) (tabulate-array (shape 0 i 0 j) (lambda (i j) (- (* 2 (rand)) 1))))
(define (connect in out) (array-map (lambda (z) (/ 1 (+ 1 (exp (- 0 z))))) (array-mul in out)))
(define (learn error output) (array-map (lambda (error out) (* error out (- 1 out))) error output))
(define (update synapse in error) (array-map + synapse (array-mul (array-transpose in) error)))
(define X (array (shape 0 4 0 3) 0 0 1 0 1 1 1 0 1 1 1 1)) (define y (array (shape 0 4 0 1) 0 1 1 0))
(let f ([k 60000] [syn1 (init 4 1)] [syn0 (init 3 4)])
  (let* ([l1 (connect X syn0)] [l2 (connect l1 syn1)] [error2 (learn (array-map - y l2) l2)]
           [error1 (learn (array-mul error2 (array-transpose syn1)) l1)])
    (if (< k 1) (list syn0 syn1) (f (- k 1) (update syn1 l1 error2) (update syn0 X error1))))))