Как стать автором
Обновить

Neural network in scheme

Уровень сложности Средний
Время на прочтение 12 мин
Количество просмотров 16K
По скольку недавно опять поднималась тема нейронных сетей, решил показать небольшую реализацию НС, обучаемую методом обратного распространения ошибки, написанную на scheme. Заодно подробно расскажу, как это все работает, для новичков жанра. Будет рассмотрен только самый простой вид сетей, без зацикливаний и пропуска слоев.



Начнем с описания биологической составляющей. Если опустить подробности, нейрон представляет из себя сложную клетку с несколькими входами – дендритами и одним выходом – аксоном. На входы нейрона периодически поступают электрические сигналы от органов чувств или других нейронов. Входные сигналы суммируются, и при их достаточной силе, нейрон выдает свой электрический сигнал на аксон, где его принимает дендрит другого нейрона, либо внутренний орган. Если уровень сигнала слишком низкий — нейрон молчит. Имея структуру из достаточного количества таких нейронов есть возможность решать достаточно сложные задачи.


Искусственная нейронная сеть представляет из себя граф, вершинами которого являются эквиваленты нейронов, а ребрами – аксоны / дендриты, связь которых называют синапсами. Каждый искусственный нейрон состоит из нескольких синапсов, со своим коэффициентом усиления или ослабления сигнала, функции активации, проходного значения и выходного аксона. Сигнал на входе каждого синапса умножается на свой коэффициент (вес связи), после чего сигналы суммируются и передаются, в виде аргумента, функции активации, которая передает его на аксон, где его принимают другие нейроны.



Нейроны сгруппированы слоями. Каждый нейрон одного слоя, связан со всеми нейронами следующего слоя, как и со всеми нейронами предыдущего слоя, но не связан с другими нейронами своего слоя. Сама нейронная сеть состоит как минимум из двух слоев нейронов – входного слоя и выходного слоя, между которыми может находиться произвольное количество, так называемых, скрытых слоев. Сигнал распространяться только в одном направлении – от входного слоя к выходному. Тут стоит заметить, что есть и другие виды сетей, в которых распространение сигнала происходит иначе.

У кого-то возможно возникнет вопрос – для чего все это? На самом деле нейронная сеть дает возможность решать проблемы, которые сложно описывать стандартными алгоритмами. Одно из типичных назначений – распознавание образа. «Показывая» нейронной сети определенную картинку и указывая какой выходной патерн должен быть в случае данной картинки, мы обучаем НС. Если продемонстрировать сети достаточное количество разнообразных вариантов входа, сеть обучиться искать что-то общее между патернами и использовать это для распознавания образов, которые она до этого никогда не видела. Следует заметить, что способность распознавать образы зависит от структуры сети, как и от выборки образов, которые использовались для обучения.

Теперь перейдем непосредственно к реализации. Был использован язык Scheme, который IMHO является самым красивым и лаконичным диалектом LISP. Реализация была написана на MIT-Scheme, но должна без проблем работать и на других интерпретаторах.

В реализации используются следующие виды списков:
(n lst) – neuron. нейрон, вместо lst содержится список с коэффициентами усиления сигналов синапсов. Например: (n (1 2 4)).
(l lst) – layer. слой состоящий из нейронов. Вместо lst содержится список нейронов. Пример слоя из 2 нейронов (l ( (n (0.1 0.6 0.2)) (n (0.8 0.4 0.4)) ))
(lst) – обычный список, без какого либо символа в начале списка – обычная нейронная сеть. Вместо lst содержится список слоев. Например:
( (l ((n (0.1 0.6 0.2)) (n (0.5 0.1 0.7)) (n (0.8 0.4 0.4)))) 
  (l ((n (0.3 0.8 0.9)) (n (0.4 0.9 0.1)) (n (0.9 0.9 0.9)))) )


В коде используются некоторые сокращения:
; out – neuron output – выход нейрона
; wh – weight – вес связи
; res – result – результат вычисления всего слоя нейронов
; akt – activation – результат активации нейрона
; n – neuron
; l – layer
; net – network
; mk – make
; proc — process

Начнем с создания нейрона, что скучно и не интересно:
(define (n-mk lst) ;make new neuron
  (list 'n lst))

Перейдем к созданию слоя:

(define (l-mk-new input n lst) ;makes new layer
  (let ( (lst1 (append lst (list (n-mk (lst-rand input))))) ) 
  (if (= n 1) (l-mk lst1) (l-mk-new input (- n 1) lst1))))

input – количество входов у нейронов этого слоя
n – количество нейронов в слое.
lst – список уже готовых нейронов.

Зная количество входов, заказываем столько случайных чисел у lst-rand, пакуем их с помощью n-mk и кладем в lst1. Проверяем нужны ли еще нейроны, если это был не последний нейрон, то уменьшаем счетчик и повторяем операцию. Если это последний нейрон – пакуем их с помощью l-mk.

Дальше будем создавать саму сеть. Делается это с помощью функции net-make. Lay – список с количеством нейронов для каждого слоя. Первое число – список входов для первого слоя.

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

Функция является синтаксическим сахаром и сделана для упрощения вызова. На самом деле будет вызвана net-make-new, которая просто имеет отдельный параметр для количества входов на первый слой. Рекурсивно происходит вызов функции l-mk-new для создания слоев и добавления их в lst1.

(define (net-mk-new input n-lst lst) 
  (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 (n-akt x param) ;neuron activation function
  (/ x (+ (abs x) param)))

Для тех, кто не привык к синтаксису лиспа, это всего x/(|x|+p), где p параметр делающий график функции более резким или плавным.

(define (n-proc neuron input) ;process single neuron
  (n-akt (lst-sum (lst-mul (n-inp-lst neuron) input )) 4))

neuron – содержит активируемый нейрон,
input – значения входов синапсов.
В ответ получаем выход аксона нейрона. 4 – параметр для функции активации, был выбран путем экспериментов. Можно смело менять на любой другой. Теперь займемся активацией целого слоя.

(define (l-proc l input) ;proceses a layer
  (map (lambda(x)(n-proc x input)) (n-inp-lst l)))

input – выходы нейронов предыдущего слоя,
l – сам слой
n-inp-lst — возвращает список нейронов данного слоя.

Поднимемся еще на уровень выше и сделаем функцию активации всей сети.

(define (net-proc net input) 
	(let ( (l (l-proc (car net) input)) )
	  (if (= 1 (length net)) l
		(net-proc (cdr net) l))))

net – сама сеть,
input – данные поданные на входы первого слоя.
Input используется для обработки первого слоя, в дальнейшем мы используем выход предыдущего слоя, как вход следующего. Если слой последний – его результат выводиться как результат работы всей сети.

С созданием и обработкой сети вроде разобрались. Теперь перейдем к более интересной части – обучению. Здесь пойдем сверху вниз. Т.е. от уровня сети, до более низких уровней. Функция обучения сети — net-study.

(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))) 

где net — сама сеть,
lst — список примеров,
spd — скорость обучения.
net-check-lst — проверяет правильность ответов сети примерам из lst
net-study-lst — производит обучение сети

Скорость обучения является шагом изменения весов каждого нейрона. Очень сложный параметр, т.к. при маленьком шаге можно очень долго ждать результатов обучения, а при большом – можно постоянно проскакивать нужный интервал. net-study выполняется пока не будет пройден net-check-lst.

(define (net-study-lst net lst spd) 
(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))


Тут добавлен l-check. На данный момент они ничего не делает, но на стадии тестирования отлавливал с помощью него передаваемые значения.

(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))))


Net-study2 сравнивает номер максимального выхода в патерне с номером максимального выхода по факту. Если они совпадают, возвращаем обученную сеть, если нет – продолжаем обучение.

(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)))))


wh — список входящих весов всех нейронов сети
out — содержит список выходов всех нейронов сети
err — список с ошибками для каждого нейрона
Net-spd*err — перемножает скорость со списком ошибок на веса нейрона.
Net-err+wh — добавляет к списку весов подсчитанную ошибку.
Net-make-data делает новую сеть из полученных данных.

Ну и теперь самое интересное – подсчет ошибки. Для изменения весов будет использоваться функция:
image
где
Wij — вес от нейрона i к нейрону j,
Xi — выход нейрона i,
R — шаг обучения,
Gj — значение ошибки для нейрона j.

При подсчете ошибки для выходного слоя используется функция:
image
где
Dj — желаемый выход нейрона j,
Yj — текущий выход нейрона j.

Для всех предшествующих слоев используется функция:
image
где k пробегает все нейроны слоя с номером на единицу больше, чем у того, которому принадлежит нейрон j.

(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-err2 out-lst err-lst wh-lst) 
   (let ( (err-lst1 (lst-push (l-err (car out-lst) (car err-lst) (first wh-lst)) err-lst)) )
   (if (lst-if out-lst wh-lst) err-lst1 (net-err2 (cdr out-lst) err-lst1 (cdr wh-lst)))))


Теперь немного о происходящем:
Wh-lst – содержит значения связей каждого нейрона, со следующим слоем,
Err-lst — содержит ошибку для выходного слоя сети, в дальнейшем пополняем его ошибками других слоев,
Out-lst — значение выхода каждого нейрона
Рекурсивно обрабатываем эти три списка, согласно функции.

Теперь собственно говоря, как это все работает. Пример будет простенький, но при желании можно распознавать и более сложные вещи. У нас будет всего четыре простеньких патерна для букв T,O,I,U. Декларируем их отображение:

(define t '(
 1 1 1
 0 1 0
 0 1 0))

(define o '(
 1 1 1
 1 0 1
 1 1 1))

(define i '(
 0 1 0
 0 1 0
 0 1 0))

(define u '(
 1 0 1
 1 0 1
 1 1 1))


Теперь сформируем форму для обучения. Каждой букве соответствует один из 4 выходов.

(define letters (list 
	(list o '(1 0 0 0))
	(list t '(0 1 0 0))
	(list i '(0 0 1 0))
	(list u '(0 0 0 1))))


Теперь создадим новую сеть, которая имеет 9 входов, 3 слоя и 4 выхода.

(define test (net-make '(9 8 4)))


Обучим сеть с помощью нашего примера. Letters — список примеров. 0.5 — шаг обучения.

(define test1 (net-study test letters 0.5))


В итоге мы имеем сеть test1, которая узнает наши патерны. Протестируем ее:

(net-proc test1 o)

> (.3635487227069449 .32468771459315143 .20836372502023912 .3635026264793502)


Чтобы было несколько понятнее можно сделать так:

(net-proc-num test1 o)

> 0


Т.е. самое большое выходное значение было на нулевом выходе. Тоже самое для других патернов:

(net-proc-num test1 i)

> 2


Можем немного повредить образ и проверить будет ли он распознан:

(net-proc-num test1 
'(
 0 1 0
 1 0 1
 0 1 0))

> 0

(net-proc-num test1 
'(
  0 0 1
  0 1 0
  0 1 0))

> 1


Даже поврежденный образ вполне отличим. Правда можно сделать спорную ситуацию, например, в таком случае, сеть будет путать патерн T с патерном I. Выходы будут очень близкими.

(net-proc test1 
'(
  0 1 1
  0 1 0
  0 0 0))

> (.17387815810580473 .2731127800467817 .31253464734295566 -6.323399331678244e-3)


Как видим сеть предлагает 1 и 2 выходы. Т.е. патерны достаточно похожи и сеть считает более вероятным 2 патерн.

PS Я предполагаю, что все это все слишком сумбурно, но возможно кому то покажется интересным.

PSS Отдельная просьба к LISP-ерам. Это первый раз, когда я публично выкладываю свой scheme код, поэтому буду благодарен критике.

Источники:
1. oasis.peterlink.ru/~dap/nneng/nnlinks/nbdoc/bp_task.htm#learn — для функций и вдохновения
2. ru.wikipedia.org/wiki/Искусственная_нейронная_сеть — отсюда спёрта картинка и некоторая информация
3. alife.narod.ru/lectures/neural/Neu_ch03.htm — отсюда взял картинку
4. ииклуб.рф/neur-1.html

Полный код:

(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)))


Полный исходник на pastbin:
pastebin.com/erer2BnQ
Теги:
Хабы:
+11
Комментарии 15
Комментарии Комментарии 15

Публикации

Истории

Ближайшие события

Московский туристический хакатон
Дата 23 марта – 7 апреля
Место
Москва Онлайн