все о том же

← →
Hirara (2002-11-03 14:11) [0]

задавал вопрос, никто толком не ответил, может текст программы поможет. я это опять про нейронные сети
Текст :
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, Grids;

type
TForm1 = class(TForm)
StringGrid1: TStringGrid;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
BitBtn4: TBitBtn;
Memo1: TMemo;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
BitBtn3: TBitBtn;
Button1: TButton;
Button2: TButton;
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn4Click(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
var CanSelect: Boolean);
procedure BitBtn1Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

Const m=4; //Количество слоев
n=5; //Количество нейронов на слое
nu=0.07;

var
Form1: TForm1;
Obr : Array [1..8,1..8] of 0..1;
W : Array [1..m,1..n,1..n] of Real;
W1 : Array [1..n,1..64] of Real;
Q : Array [1..m,1..n] of Real;
R,R1 : Array [1..n] of Real;
D : Array [1..m,1..n] of Real;
l : Integer;
implementation

{$R *.dfm}

procedure TForm1.BitBtn2Click(Sender: TObject);
var f:TextFile;
i,j:Integer;
Rect : TRect;
begin
if OpenDialog1.Execute Then
Begin
BitBtn1Click(Sender);
AssignFile(f,OpenDialog1.FileName);
Reset(f);
For i:=1 to 8 do
For j:=1 to 8 do
Obr[i,j]:=0;

For i:=1 to 8 do
Begin
For j:=1 to 8 do
Read(f,Obr[i,j]);
ReadLn(f);
End;
CloseFile(f);
End;

for i:=1 to 8 do
Begin
for j:=1 to 8 do
Begin
if obr[i][j]=1 Then
Begin

Rect.Left:=StringGrid1.DefaultColWidth*(j-1)+j;
Rect.Top:=StringGrid1.DefaultRowHeight*(i-1)+i;
Rect.Right:=StringGrid1.DefaultColWidth*(j)+j;
Rect.Bottom:=StringGrid1.DefaultRowHeight*(i)+i;

StringGrid1.Canvas.Brush.Color:=clRed;
StringGrid1.Canvas.FillRect(Rect);

End;
End;
End;

For i:=1 to m do
for j:=1 to n do D[i,j]:=0;
FOr i:=1 to n do R[i]:=0;

end;

procedure TForm1.BitBtn4Click(Sender: TObject);
var f:TextFile;
i,j:Integer;
begin
if SaveDialog1.Execute Then
Begin
AssignFile(f,SaveDialog1.FileName);
ReWrite(f);

For i:=1 to 8 do
Begin
for j:=1 to 8 do Write(f,Obr[i,j]," ");
WriteLn(f);
End;

CloseFile(f);
End;

end;

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
if Key= #27 then Form1.Close;
end;

procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,
ARow: Integer; var CanSelect: Boolean);
var Rect : TRect;
begin
Rect.Left:=StringGrid1.DefaultColWidth*(ACol)+ACol;
Rect.Top:=StringGrid1.DefaultRowHeight*(ARow)+ARow;
Rect.Right:=StringGrid1.DefaultColWidth*(ACol+1)+ACol;
Rect.Bottom:=StringGrid1.DefaultRowHeight*(ARow+1)+ARow;

StringGrid1.Canvas.Brush.Color:=clRed;
StringGrid1.Canvas.FillRect(Rect);

obr[ARow][ACol]:=1;

end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var i,j : integer;
begin
StringGrid1.DefaultDrawing:= True;
StringGrid1.Refresh;
StringGrid1.DefaultDrawing:= False;
for i:=1 to 8 do
begin
for j:=1 to 8 do
begin
obr[i,j]:=0;
end;
end;

for i:=1 to m do
for j:=1 to n do D[i][j]:=0;

For i:=1 to n do R[i]:=0;
end;

procedure TForm1.FormActivate(Sender: TObject);
var i,j,k : Integer;
begin

Randomize;

For i:=1 to n do
for j:=1 to 64 do w1[i][j]:=(1+Random(10))/100;

For k:= 1 to m do
for i:= 1 to n do
for j:= 1 to n do W[k][i][j]:=(1+Random(80))/100;

for j:=1 to n do
Q[1][j]:=(50+Random(550))/100;

For i:=2 to m do
for j:=1 to n do
Q[i][j]:=(1+Random(550))/100;

For i:=1 to n do Begin R[i]:=0;R1[i]:=0;End;

For i:=1 to m do
for j:=1 to n do D[i][j]:=0;

end;

← →
Hirara (2002-11-03 14:12) [1]

Продолжение :

//обучение сети
procedure TForm1.Button2Click(Sender: TObject);
var i,j,k,k1,p,q1 : Integer;
max: Real;
begin
{-------------------------------------------------------}
For i:=1 to n do if R1[i]=0 Then Begin k1:=i;Break;End;
While (R1[k1]=0) do Begin
k:=k1;

for p:=1 to n do
if p<>k1 then
Begin
k:=p;
For i := m downto 1 do
Begin
For j := 1 to n do
Begin
if D[i][j]=1 Then Begin
W[i][k][j]:=W[i][k][j]-nu;
k:=j;
Break;
End;
End;
End;

k:=k1;
For i := m downto 1 do
Begin
For j := 1 to n do
Begin
if D[i][j]=1 Then Begin
W[i][k][j]:=W[i][k][j]+nu;
k:=j;
Break;
End;
End;
End;

End;

for j:=1 to 64 do
Begin
if j mod 8<>0 Then
Begin
if obr[j div 8 +1][j mod 8]=1 then Begin w1[k][j]:=w1[k][j]+nu;End Else w1[k][j]:=w1[k][j]-nu;
End
Else
Begin
if obr[j div 8 ][8]=1 then Begin w1[k][j]:=w1[k][j]+nu;End else w1[k][j]:=w1[k][j]-nu;
End;

End;
q1:=p;
for p:=1 to n do
if p<>q1 Then
Begin
k:=p;
for j:=1 to 64 do
Begin
if j mod 8<>0 Then
Begin
if obr[j div 8 +1][j mod 8]=1 then Begin w1[k][j]:=w1[k][j]+nu;End;
End
Else
Begin
if obr[j div 8 ][8]=1 then Begin w1[k][j]:=w1[k][j]+nu;End;
End;
End;
End;
{-------------------------------------------------------}

For i:=1 to m do
for j:=1 to n do D[i,j]:=0;
For i:=1 to n do R[i]:=0;

For i:=1 to n do
for j:=1 to 64 do
Begin
if j mod 8<>0 Then
D[1][i]:=D[1][i]+w1[i,j]*obr[j div 8 +1][j mod 8]
Else
D[1][i]:=D[1][i]+w1[i,j]*obr[j div 8 ][8];
End;

For i:=1 to n do
if D[1][i]<Q[1][i] Then D[1][i]:=0 Else D[1][i]:=1;

For k:=2 to m do
Begin
For i:=1 to n do
Begin
For j:=1 to n do
Begin
D[k][i]:=D[k][i]+D[k-1][j]*W[k-1][i][j];
End;
if D[k][i]<Q[k][i] Then
D[k][i]:=0
Else
D[k][i]:=1;
End;
End;

For i:=1 to n do
Begin
For j:=1 to n do
R[i]:=R[i]+D[m][j]*W[m][i][j];
Memo1.Lines.Add("R["+IntToStr(i)+"]="+FloatToStr(R[i]));
End;

Memo1.Lines.Add("===============================");
Max:=R[1];l:=1;
For i:=1 to n do if (R[i]>Max) Then
Begin
Max:=R[i];
l:=i;
End;
if (l=k1) {and (R1[k1]=0)} then begin R1[k1]:=Max;Break;end;

End;{WHILE}
end;
end.

← →
BOA_KAA (2002-11-03 14:15) [2]

И что это будет?:-)

← →
Hirara (2002-11-03 14:23) [3]

Боо_Каа ->
это должно работать , но чо то не пашет, суть вопроса на 2 странице

← →
BOA_KAA (2002-11-03 14:30) [4]

> Hirara © (03.11.02 14:23)

Не, я о другом, что это вообще?:-)

← →
Hirara (2002-11-03 14:35) [5]

BOA_KAA
ну это вообщето модель персиптрона

← →
BOA_KAA (2002-11-03 14:43) [6]

> Hirara © (03.11.02 14:35)
> BOA_KAA
> ну это вообщето модель персиптрона

Скромно, но со вкусом:-)

> это должно работать , но чо то не пашет, суть вопроса на
> 2 странице

Почему это ДОЛЖНО работать и где вторая страница?

← →
Hirara (2002-11-03 14:45) [7]

BOA_KAA
ну я просто уже пару недель пытаюсь глюк найти, не найду никак...
А насчет второй страницы, это я про то что на второй странице форума я первый раз задал этот вопрос, он там и висел, щас он уже на первой

← →
TTCustomDelphiMaster (2002-11-03 15:03) [8]

А вы не пробовали писать комментарии в своем коде, чтобы другим было проще разбираться.

← →
BOA_KAA (2002-11-03 15:05) [9]

Пытался разобраться... Пока могу дать только идиотский совет, от которого легче не станет:( Но, на мой взгляд, это пример, как НЕ надо писать. Запутаться просто элементарно. Но, как я и сказал, это идиотский совет, который к делу не относится. Если придет мысль в голову (пока свободное время есть, попробую у себя это прогнать, проблема-то интересная) скину на мыло, если реальное. Ежели нет - не обессудь:-)

← →
Hirara (2002-11-03 15:08) [10]

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

← →
Evgeny V (2002-11-04 12:52) [11]

Если тебе не срочно, то рекомендую почитать книги:
"Анализ и обработка данных" автор Игорь Гладышев, издательство Питер (есть исходники и пояснения, главы вроде как с 8,9), и "Основные концепции нейронных сетей" автор Роберт Каллан (довольно интересно, но блок схемы надо проверять, есть небольшие опечатки, типа что-то=true, а по ходу должно быть=false), я сйчас как раз эту книгу читаю, пробую задания (работает).

← →
Hirara (2002-11-09 01:01) [12]

2 Evgeny
эта книженция есть в электронном виде?

← →
Ketmar (2002-11-09 11:30) [13]

2Hirara:
что-то мне эта штука очень напоминает одну программку распознавания символов, мною виденную. причем ни разу не вашу (хотя могу и ошибаться). я прав? если да, то не мучайтесь, возьмите оригинал - он работает %-)

Satanas Nobiscum! 09-Nov-XXXVII A.S.

все о том же Найти похожие ветки