nn

(define (n-mk lst) ;make new neuron

 (list 'n lst))



 (define (l-mk lst) ;make new layer

 (list 'l lst))



 (define (n-inp-lst x) ;return neuron wheights

 (cadr x))



 (define (n? x) ;check if x is neuron

 (if (= (car x) 'n) #t #f))



 (define (l-neuron-lst x) ;returns list of layers neurons

 (cadr x))



 (define (l? x) ;checks if x is a layer

 (if (= (car x) 'l) #t #f))



 (define (l-inp-wh l) ;shows all layer neurns input wheights

 (map (lambda(x)(n-inp-lst x)) (l-neuron-lst l)))



 (define (l-out-wh l) ;returns all layer neuron output wheights

 (transpose (map (lambda(x)(n-inp-lst x)) (l-neuron-lst l)) '() ))



 (define (net-inp-wh net) ;return all network input wheights

 (map (lambda(x)(l-inp-wh x)) net))



 (define (net-out-wh net) ;returns all network output wheights

 (map (lambda(x)(l-out-wh x)) net))



 (define (net-mk-data lst) ;make network from data list

 (map (lambda(x)(l-mk-data x)) lst))



 (define (l-mk-data lst) ;make layer from list

 (l-mk (map (lambda(x)(n-mk x)) lst)))



 (define (lst-push x lst) ;push

 (cons x lst))



 (define (lst-push-b x lst) ;push from the end

 (append lst (list x)))



 (define (randomize n lst) ;randomize returns n random numbers

 (if (= n 0)

 lst

 (randomize (- n 1) (append (list (+ (random 9) 1) ) lst) )))



 (define (empty? lst) ;checks if the list is empty

 (if (= (length lst) 0) #t #f))



 (define (net-make lay) ;makes new network. lay consists of number of neuron for each layer

 (net-mk-new (car lay) (cdr lay) '()))



 (define (net-mk-new input n-lst lst) ;input — ammount of input neurons; n-lsts — list of neuron ammount for each layer

 (let ( (lst1 (lst-push-b (l-mk-new input (car n-lst) '()) lst)) )

 (if (= (length n-lst) 1) lst1 (net-mk-new (car n-lst) (cdr n-lst) lst1))))



 (define (l-mk-new input n lst) ;makes new layer

 (let ( (lst1 (append lst (list (n-mk (lst-rand input))))) ); seit kluda

 (if (= n 1) (l-mk lst1) (l-mk-new input (- n 1) lst1))))



 (define (lst-rand n) ;random returns n random numbers divided by 10

 (map (lambda(x)(/ x 10)) (randomize n '()) ))



 (define (n-akt x param) ;neuron activation function

 (/ x (+ (abs x) param)))



 (define (lst-sum lst);sums list

 (apply + lst))



 (define (n-proc neuron input) ;process single neuron

 (n-akt (lst-sum (lst-mul (n-inp-lst neuron) input )) 4))



 (define (lst-mul a b) ;multiply each element of list a with same element of list b

 (map (lambda(x y)(* x y)) a b))



 (define (lst-if a b) ;if one of the lists consists of only one element it returns true

 (if (or (= (length a) 1) (= (length b) 1)) #t #f))



 (define (l-proc l input) ;proceses a layer

 (map (lambda(x)(n-proc x input)) (n-inp-lst l)))



 (define (net-proc net input) ;proceses a network

 (net-proc2 net (l-check input)))



 (define (net-proc2 net input)

 (let ( (l (l-proc (car net) input)) )

 (if (= 1 (length net)) l

 (net-proc2 (cdr net) l))))



 (define (net-proc-res net input) ;returns a list of results for each layer

 (net-proc-res2 net (l-check input) '() ))



 (define (net-proc-res2 net input res)

 (let ( (l (l-proc (car net) input)) )

 (let ( (res1 (lst-push-b l res)) )

 (if (= 1 (length net)) res1

 (net-proc-res2 (cdr net) l res1)))))



 (define (l-err out err wh) ;counts error for layer

 (lst-mul out (l-err*wh err wh)))



 (define (l-err*wh err wh) ;next l error * output wheights

 (map (lambda(y)(lst-sum y)) (map (lambda(x)(lst-mul err x)) wh)))



 (define (lst-2-mul a b) ;multiply 2 lists

 (map (lambda(x y)(* x y)) a b))



 (define (lst-lst-mul a b); miltiply list a with every list from b

 (map (lambda(x)(lst-mul-x x a)) b))



 (define (net-wh*err wh err) ;miltiply each wheight with error

 (map (lambda(x y)(lst-lst-mul x y)) wh err))



 (define (net-err+wh err wh) ;add error to wheghts

 (map (lambda(x y)(l-err+wh x y)) err wh))



 (define (lst-2-sum a b); adds to lists

 (map (lambda(x y)(+ x y)) a b))



 (define (l-err+wh err wh) ;adds error to wheight for layer

 (map (lambda(x y)(lst-2-sum x y)) err wh))



 (define (lst-put-num lst) ;ads number to each el. of list ex. (1 a)

 (lst-zip (sequence 0 (- (length lst) 1) '() ) lst ))



 (define (sequence from to res) ;creates sequency of numbers from to

 (let ( (nr (append res (list from))))

 (if (= from to) nr (sequence (+ from 1) to nr ) )))



 (define (lst-order-max lst) ;sort el.

 (hsort (lst-put-num lst)))



 (define (lst-zip a b); zip 2 lists

 (map (lambda(x y)(list x y)) a b))



 (define (hsort lst) ;sorts

 (if (empty? lst) '()

 (append

 (hsort (filter (lambda(x) (> (cadr x) (cadr (car lst)))) (cdr lst)))

 (list (car lst))

 (hsort (filter (lambda(x) (<= (cadr x) (cadr (car lst)))) (cdr lst))))))



 (define (ssort lst) ;sort

 (if (empty? lst) '()

 (append

 (ssort (filter (lambda(x) (> x (car lst))) (cdr lst)))

 (list (car lst))

 (ssort (filter (lambda(x) (<= x (car lst))) (cdr lst))))))



 (define (net-study net lst spd) ;studys net for each example from the list smpl ((inp)(out))

 (if (net-check-lst net lst) net

 (net-study (net-study-lst net lst spd) lst spd)))



 (define (net-proc-num net inp) ;process network and returns output number

 (caar (lst-order-max (net-proc net inp))))



 (define (net-check-lst net lst) ;parbauda sarakstu ar paraugiem

 (lst-and (map (lambda(x)(net-check-smpl net x)) lst)))



 (define (lst-and lst) ;accumulates list

 (lst-and2 (car lst) (cdr lst)))



 (define (lst-and2 a lst)

 (if (empty? lst) a (lst-and2 (and a (car lst)) (cdr lst))))



 (define (net-check-smpl net x) ;checks one sample (input output)

 (let ( (inp (car x))

 (out (cadr x)) )

 (if (= (caar (lst-order-max out)) (net-proc-num net inp)) #t #f)))



 (define (net-study-lst net lst spd); studies network for smaples from lst. Smpl (input output)

 (let ( (x (net-study1 net (caar lst) (cadar lst) spd)) )

 (if (= 1 (length lst)) x

 (net-study-lst x (cdr lst) spd))))



 (define (net-study1 net inp need spd)

 (net-study2 net (l-check inp) need spd))



 (define (net-study2 net inp need spd)

 (let ( (x (net-study3 net inp need spd)))

 (if (= (caar (lst-order-max need))(caar (lst-order-max (net-proc x inp))))

 x

 (net-study2 x inp need spd))))



 (define (slice lst from to)

 (let ( (lng (length lst)) )

 (take (drop lst from) (+ (- lng from) to))))



 (define (net-study3 net inp need spd)

 (let ((err (net-spd*err spd (slice (net-err net inp need) 1 0)))

 (wh (net-inp-wh net))

 (out (slice (net-proc-res-out net inp) 0 -1)))

 (net-mk-data (net-err+wh wh (map (lambda(x y)(lst-lst-mul x y)) out err)))))



 (define (net-err2 out-lst err-lst wh-lst)

 (let ( (err-lst1 (lst-push (l-err (car out-lst) (car err-lst) (car wh-lst)) err-lst)) )

 (if (lst-if out-lst wh-lst) err-lst1 (net-err2 (cdr out-lst) err-lst1 (cdr wh-lst)))))



 (define (net-err net inp need) ;networks error list for each neuron

 (let ( (wh-lst (reverse (net-out-wh net)))

 (err-lst (list (net-out-err net inp need)))

 (out-lst (reverse (slice (net-proc-res-out net inp) 0 -1))))

 (net-err2 out-lst err-lst wh-lst)))

 (define (net-spd*err spd err) ;multiply error with speed

 (map (lambda(x)(lst-mul-x spd x)) err))



 (define (lst-mul-x s lst) ;multiply list with x

 (map (lambda(x)(* s x)) lst))



 (define (net-proc-res-out net inp) ;x*(1 — x) for each neuron output

 (lst-push inp (map (lambda(x)(l-proc-res-out x)) (net-proc-res net inp))))



 (define (l-proc-res-out lst)

 (map (lambda(x)(* x (- 1 x))) lst))



 (define (l-out-err need fact) ;error of otput layer

 (map (lambda(x y)(n-out-err x y)) need fact))



 (define (n-out-err need fact) ;error of output neuron

 (* fact (- 1 fact)(- need fact)))



 (define (net-out-err net inp need) ;networks error lists

 (l-out-err need (net-proc net inp)))



 (define (lst-print lst);prints list

 (map (lambda(x)(and (newline)(display x))) lst)(newline))



 (define (lst-print2 lst)

 (map (lambda(x)(lst-print x)) lst)(newline))



 (define (l-check lst)

 lst)



 (define (transpose lst res)

 (if (empty? (car lst)) res

 (transpose (lst-cdr lst) (append res (lst-car lst)))))



 (define (lst-cdr lst) ;cdr of all list elements

 (map (lambda(x)(cdr x)) lst))



 (define (lst-car lst) ;car of all list elements

 (list (map (lambda(x)(car x)) lst)))