ANN.ss

(import (scheme inexact) (srfi 1) (srfi 27)) (define (transpose x) (apply map list x))
(random-source-randomize! default-random-source)
(define (rand/2) (- (* ((random-source-make-reals default-random-source)) 2) 1))
(define (init-layer x y) (list-tabulate y (lambda (y) (list-tabulate x (lambda (x) (rand/2))))))
(define (matrix-map f . xy) (apply map (lambda xy (apply map f xy)) xy))
(define (sigmoid x) (/ 1 (+ 1 (exp (- 0 x))))) (define (derivative x) (* x (- 1 x)))
(define (connect x y)
  (map (lambda (x) (map (lambda (y) (apply + (map * x y))) (transpose y))) x))
(let ([X '((0 0 1) (0 1 1) (1 0 1) (1 1 1))] [y (transpose '((0 1 1 0)))]
      [syn0 (init-layer 3 4)] [syn1 (init-layer 4 1)])
  (let backpropagate ([j 0])
    (if (> j 60000) (list syn0 syn1)
        (let* ([l1 (matrix-map sigmoid (connect X syn0))] [l2 (matrix-map sigmoid (connect l1 syn1))]
               [l2-delta (matrix-map (lambda (y l2) (* (- y l2) (derivative l2))) y l2)]
               [l1-delta (matrix-map (lambda (delta l1) (* delta (derivative l1)))
                           (connect (transpose syn1) l2-delta) l1)]
               [syn1 (matrix-map + (connect l2-delta (transpose l1)) syn1)]
               [syn0 (matrix-map + (connect l1-delta (transpose X)) syn0)])
          (backpropagate (+ j 1))))))