neuroproject.ru

[Эльвиз]

Извините мой рысский очень плохой.
спасите меня я учус в Баку и здес очень мало знают по нейронным сетям и мая работа оже нейронные сети распознавание изображени. Может у кого нибуд ест готовая программа в делфи или в с ну любом языке програмирывание. Мне не важен там какой модел проста нужен программа чтобы я анализирывал.
Зарание спасибо.
Жду ответа

[DmitryShm]

Есть программа. Правда на Mathematica 5.0. Для Delphi переписать раз плюнуть... Задавать можно многослойный перцептрон. Аппроксимировать любую функцию. Если сможешь настроить параметры --- буду рад, если поделишься ими. Я вот сам пытаюсь ешить эту задачу. Пока тщетно. Синаптические веса уходят из под контроля, и стремятся к бесконечности. Сижу вот, и настраиваю. Вот программа.

(*Многослойный перцептрон: универсальный аппроксиматор.*)

(* определение полносвязного перцептрона *)

(*
[in]fun -- символ активизационной функции
[in]neu -- символ для нейронов
[in]wei -- символ для весов
[in]step -- инициализация
[in]listInts -- списов целых, задающих перцептрон
*)
Perceptron[fun_,neu_,wei_,step_,listInts_]:=
Module[{iLen,j,k},
iLen=Length[listInts];
If[iLen\[Equal]0,
Null,
If[iLen\[Equal]1,
Array[neu[1],listInts[[1]]],
If[iLen\[Equal]2,
Table[neu[2][j]=Sum[
fun[neu[1][k]]*wei[1][j,k],{k,1,listInts[[1]]}]+step,{j,1,listInts[[2]]}],
Perceptron[
fun,neu,wei,step,Delete[listInts,iLen]];Table[neu[
iLen][j]=Sum[fun[neu[iLen-1][k]]*wei[iLen-1][j,k],{k,1,listInts[[
iLen-1]]}],{j,1,listInts[[iLen]]}]
]
]
]
];
(* определение опдстановки выборки в перцептрон *)

(*
[in]listVals -- обучающая выборка
[in]fun -- символ активизационной функции
[in]n -- символ для нейронов
[in]w -- символ для синаптических весов
[in]step -- символ для шага инициализации
[in]listInts -- списов целых, задающих перцептрон
*)
TestPerceptron[listVals_,fun_,n_,w_,step_,listInts_]:=
Module[{iLen,j},
If[Length[listInts]\[Equal]0,
Null,
iLen=Length[listVals];
If[iLen==listInts[[1]],
Table[n[1][j]=listVals[[j]],{j,1,iLen}];
Perceptron[fun,n,w,step,listInts],
Null
]
]
];

(* определение алгоритма последовательного обучения (1 эпоха \[Equal] 1
выборка) *)

(*
[in]funTarget -- символ приближаемой функции
[in]fun -- символ акцивизационной функции
[in]neu -- символ для нейронов
[in]wei -- символ для весов
[in]speedEta -- параметр, определяющий скорость обучения
[in]step -- инийиализирующая величина
[in]listInts -- списов целых, задающих перцептрон
[in]listSequence -- последовательность обучающих выборок (эпох)
*)
LearnBackPropSequential[funTarget_,fun_,neu_,wei_,speedEta_,step_,listInts_,\
listSequence_]:=
Module[{k,q,p,iSeqLen,iLen,listTest,lmsE,deltaGrad,DifActFun,\
vField,neuTemp,stepAbs, dCurError},
iLen=Length[listInts];
If[iLen<3,
Null,
DifActFun[x_]=D[fun[x],x];
iSeqLen=Length[listSequence];
dCurError=0;
Table[ lmsE[iLen][j]=0,{j,1,listInts[[iLen]]}];
For[k=1,k?iSeqLen,k++,
(* подставляем обучающую выборку в перцептрон (wei уже
известны) *)
listTest=TestPerceptron[listSequence[[k]],fun,neuTemp,
wei,step,listInts];
(* а здесь делаем обратный проход ошибок,
сначала вычислив ошибки для выходного слоя *)
(* вычисляем ошибку сети на выходном слое *)
Table[ lmsE[iLen][j]+=funTarget[listSequence[[
k]]][[j]]-listTest[[j]],{j,1,listInts[[iLen]]}];
];
dCurError+=1/2*Sum[lmsE[iLen][j]^2,{j,1,listInts[[iLen]]}];
(* считаем индуцированное поле для нейронов выходного слоя *)
Table[vField[iLen][p]=Sum[wei[iLen-1][p,q]*
neuTemp[iLen-1][
q],{q,1,listInts[[iLen-1]]}]+step,{p,1,listInts[[iLen]]}\
];
(* высчитываем локальный градиент выходного слоя *)
Table[
deltaGrad[iLen][j]=lmsE[iLen][j]*DifActFun[vField[iLen][j]],{j,1,
listInts[[iLen]]}];
(* корректируем синаптические веса *)
Table[Table[wei[iLen-1][p,q]+=speedEta*
deltaGrad[iLen][p]*neuTemp[iLen-1][q],{q,1,listInts[[iLen-1]]}],{p,1,\
listInts[[iLen]]}];

(* теперь проходим по всем скрытым слоям вниз... *)
For[j=iLen-2,j>0,j--,
Table[
vField[j+1][p]=Sum[wei[j][p,q]*neuTemp[j][q],{q,listInts[[j]]}]+\
step,{p,1,listInts[[j+1]]}];
Table[deltaGrad[j+1][p]=DifActFun[vField[j+1][
p]]*Sum[deltaGrad[j+2][q]*wei[j+1][q,p],{q,1,listInts[[
j+2]]}],{p,1,listInts[[j+1]]}];
Table[
Table[wei[j][p,q]+=speedEta*deltaGrad[j+1][p]*neuTemp[j][q],{q,\
1,listInts[[j]]}],{p,1,listInts[[j+1]]}];
];
dCurError
]
];

In[75]:=
Off[General::spell1];
(* определение активизационной функции *)
ActFun[x_]:=Tanh[x];

(* исследуемая функция *)
f[x_]:=Sin[x];

(* степень однослойного перцептрона *)
iPower = 20;

(* мощность обучающей выборки *)
iLearnCnt = 20;

(* интервал, на котором будут лежать числа из выборки *)
dRangeA=0;
dRangeB=1;

(* точность обучения *)
eps=0.001;

(* пераметр скорости обучения *)
eta = 1;

(* ступенька *)
step=eps/10;

(* обучаемый перцептрон *)
perceptron={1,iPower,1};
dError=1;
stepAbs=Abs[step];
(* инициализируем синаптические веса *)
iLen=Length[perceptron];
Table[Table[Table[wei[j][p,q]=
0,{q,1,perceptron[[j]]}],{p,1,perceptron[[j+1]]}],{j,1,iLen-1}];

(* обучение сети приближать данную функцию *)
While[dError>eps,
tableLearn=Table[{Random[Real,{dRangeA,dRangeB}]},{iLearnCnt}];

dError=LearnBackPropSequential[f,ActFun,neu,wei,eta,step,perceptron,\
tableLearn];
If[dError<eps,
(* график функции и ее приближения *)
Print["текущая ошибка сети: ", dError];
g[x_]=Module[{neu},Perceptron[ActFun,
neu,wei,step,perceptron]/.neu[1][1]\[Rule]x][[1]];
Plot[{f[x],g[x]},{x, dRangeA,
dRangeB},PlotStyle\[Rule]{Hue[0.5],Hue[0.7]}];
Break[];
];
];

Print["текущая ошибка сети: ", dError];
g[x_]=Module[{neu},Perceptron[ActFun, neu,wei,step,perceptron]/.neu[1][1]\
\[Rule]x][[1]];
Plot[{f[x],g[x]},{x, dRangeA,dRangeB},PlotStyle\[Rule]{Hue[0.5],Hue[0.7]}]
Print[Table[Flatten[Table[Table[wei[j][p,q],{q,1,perceptron[[j]]}],{p,
1,perceptron[[j+1]]}]],{j,1,Length[perceptron]-1}]];
_________________
знаю, что не знаю