Регистрация | Вход
uses GraphABC;const Tconst = 10; Pconst = 85; PDivT = 5; niconst = 5000;var f1: file of word; Sensor: array of word; SignN, SignT, SignP, SignNs, SignX, SignM, SignW: Queue<word>; CashN, CashNs, CashX, CashM, CashW: Queue<word>; BufN, BufT, BufP, BufNs, BufX, BufM, BufW: Queue<word>; dynamic: array of boolean; nl, i, j, k: integer; c: Byte; Col: color; N, X, Y, W, T, Ns, P, M: word; Poz, L, res: word; s_X, s_Y, s_XX, s_XY: integer; B0, B1, res_2: real; divisor: integer; st: string; effect: boolean;{N-номер события, T-время на которое активируется событие, Р - порог нейронаNs - номер сенсора с которым связан нейрон N, X- масса или показатель корреляции сенсораNs к событию N, М - минимально необходимое значение сенсора Ns, W - последнее значение сенсора Ns, при котором произошла активация события N }begin SignN := new Queue<word>; SignT := new Queue<word>; SignP := new Queue<word>; SignNs := new Queue<word>; SignX := new Queue<word>; SignM := new Queue<word>; SignW := new Queue<word>; CashN := new Queue<word>; CashNs := new Queue<word>; CashX := new Queue<word>; CashM := new Queue<word>; CashW := new Queue<word>; BufN := new Queue<word>; BufT := new Queue<word>; BufP := new Queue<word>; BufNs := new Queue<word>; BufX := new Queue<word>; BufM := new Queue<word>; BufW := new Queue<word>; if FileExists('Признаки.dat') then // Загрузка begin assign(f1, 'Признаки.dat'); Reset(f1); repeat read(f1, N, Ns, X, M, W); SignN.Enqueue(N); SignNs.Enqueue(Ns); SignX.Enqueue(X); SignM.Enqueue(M); SignW.Enqueue(W); until Eof(f1); close(f1); assign(f1, 'Отрибуты.dat'); Reset(f1); repeat read(f1, T, P); SignT.Enqueue(T); SignP.Enqueue(P); until Eof(f1); close(f1); end; dynamic := new boolean[1]; dynamic[0] := false; nl := niconst; repeat//Главный цикл //ClearWindow; for j := 0 to 12 do //Добавляю сигнал сенсора for i := 0 to 13 do SetPixel( i + 99, j + 82, clWhite); Font.Size := 10; if nl / 10 = nl div 10 then K := Random(32); TextOut(100 + Random(2), 80 + Random(2), char(k + 1040)); {K := Random(9); TextOut(100+Random(2), 80+Random(2), k);} for j := 0 to 50 do SetPixel(Random(13) + 99, Random(12) + 82, clWhite); Font.Size := 20; TextOut(10, 80, nl); nl := nl - 1; //Начало LockDrawing; for j := 0 to 12 do //Добавляю сигнал сенсора for i := 0 to 13 do begin c := trunc((100 / 255) * (255 - GetRed(GetPixel( i + 99, j + 82)))); if (i = 0) and (j = 0) then Sensor := new word[1] else SetLength(Sensor, Length(Sensor) + 1); Sensor[Length(Sensor) - 1 ] := c; c := trunc(c * 2.55); Col := RGB(c, c, c); SetPixel(i * 3 + 120, j * 3 + 83, Col); SetPixel(i * 3 - 1 + 120, j * 3 + 83, Col); SetPixel(i * 3 + 120, j * 3 - 1 + 83, Col); SetPixel(i * 3 - 1 + 120, j * 3 - 1 + 83, Col); SetPixel(i * 3 - 2 + 120, j * 3 + 83, Col); SetPixel(i * 3 + 120, j * 3 - 2 + 83, Col); SetPixel(i * 3 - 2 + 120, j * 3 - 2 + 83, Col); SetPixel(i * 3 - 1 + 120, j * 3 - 2 + 83, Col); SetPixel(i * 3 - 2 + 120, j * 3 - 1 + 83, Col); end; Redraw; //Конец //Начало if SignN.Count > 0 then //Нахождение активных событий begin L := 800; repeat st := ''; T := SignT.Dequeue(); P := SignP.Dequeue(); s_X := 0;s_Y := 0;s_XX := 0;s_XY := 0; repeat// Цикл для каждой связи N := SignN.Dequeue(); Ns := SignNs.Dequeue(); X := SignX.Dequeue(); M := SignM.Dequeue(); W := Sensor[Ns ]; st := st + ' ' + inttostr(Ns) + ' '; if Length(dynamic) - 1 < Ns then SetLength(dynamic, Ns + 1); dynamic[Ns] := true; if W >= M then Y := trunc(100 * (X / 100)) else Y := trunc((100 / M * W) * (X / 100)); if X > Pconst then //Порог поиск нового begin s_X := s_X + X;s_Y := s_Y + Y;s_XX := s_XX + X * X;s_XY := s_XY + X * Y; end; CashN.Enqueue(N); CashNs.Enqueue(Ns); CashX.Enqueue(X); CashM.Enqueue(M); CashW.Enqueue(W); if SignN.Count > 0 then L := SignN.Peek; until (L <> N) or (SignN.Count = 0 ); // Конец цикла для каждой связи divisor := 1000 * s_XX - s_X * s_X; B0 := (s_Y * s_XX - s_XY * s_X) / divisor; B1 := (1000 * s_XY - s_X * s_Y) / divisor; res_2 := B0 + B1 * 100; if not Real.IsNaN(res_2) Then res := Trunc(B0 + B1 * 100) Else res := 0; if res > P then effect := True; if T = 0 then begin if res > Pconst then // Порог узнавнания T := Tconst; end else T := T - 1; if CashN.Count > 0 then // repeat BufN.Enqueue(CashN.Dequeue()); BufNs.Enqueue(CashNs.Dequeue()); BufX.Enqueue(CashX.Dequeue()); BufM.Enqueue(CashM.Dequeue()); BufW.Enqueue(CashW.Dequeue()); until CashN.Count = 0; if BufN.Count > 0 then //Добавляются активные связи if T > 0 then for i := 0 to Length(Sensor) - 1 do if Sensor[i] > 0 then if Pos(' ' + inttostr(i) + ' ', st) = 0 then begin BufN.Enqueue(N); BufNs.Enqueue(i); BufX.Enqueue(1); BufM.Enqueue(Sensor[i]); BufW.Enqueue(Sensor[i]); end; BufT.Enqueue(T); BufP.Enqueue(P); until SignP.Count = 0; SignN.Clear; SignNs.Clear; SignX.Clear; SignM.Clear; SignW.Clear; SignT.Clear; SignP.Clear; repeat SignN.Enqueue(BufN.Dequeue()); SignNs.Enqueue(BufNs.Dequeue()); SignX.Enqueue(BufX.Dequeue()); SignM.Enqueue(BufM.Dequeue()); SignW.Enqueue(BufW.Dequeue()); until BufN.Count = 0; repeat SignT.Enqueue(BufT.Dequeue()); SignP.Enqueue(BufP.Dequeue()); until BufP.Count = 0; BufN.Clear; BufNs.Clear; BufX.Clear; BufM.Clear; BufW.Clear; BufT.Clear; BufP.Clear; end; //Конец уровня активности //Анализ событий //Начало if SignN.Count > 0 then repeat T := SignT.Dequeue(); P := SignP.Dequeue(); effect := false; repeat begin N := SignN.Dequeue(); Ns := SignNs.Dequeue(); X := SignX.Dequeue(); M := SignM.Dequeue(); W := SignW.Dequeue(); if W > 0 then begin if T > 0 then if 100 / M * W >= P then begin if T = Tconst then begin X := X + Tconst; if X > 100 then X := 100; M := W; P := Pconst; end; end Else begin if X > 0 then X := X - 1; if M > Sensor[Ns] then M := Sensor[Ns]; end; if X > 0 then begin effect := True; BufN.Enqueue(N); BufNs.Enqueue(Ns); BufX.Enqueue(X); BufM.Enqueue(M); BufW.Enqueue(Sensor[Ns]); end; end else begin if T = Tconst then if X >= 0 then X := X - 1; if X > 0 then begin effect := True; BufN.Enqueue(N); BufNs.Enqueue(Ns); BufX.Enqueue(X); BufM.Enqueue(M); BufW.Enqueue(W); end; end; end; if SignN.Count > 0 then L := SignN.Peek; until (L <> N) or (SignN.Count = 0 ); if effect then begin BufT.Enqueue(T); BufP.Enqueue(P); end; until(SignP.Count = 0 ); if BufN.Count <> 0 then repeat SignN.Enqueue(BufN.Dequeue()); SignNs.Enqueue(BufNs.Dequeue()); SignX.Enqueue(BufX.Dequeue()); SignM.Enqueue(BufM.Dequeue()); SignW.Enqueue(BufW.Dequeue()); until BufN.Count = 0; if BufP.Count <> 0 then repeat SignT.Enqueue(BufT.Dequeue()); SignP.Enqueue(BufP.Dequeue()); until BufP.Count = 0; //Конец //Добавление событий //Начало if (Length(dynamic) > 1) or (SignN.Count = 0) then begin if Length(Sensor) <> Length(dynamic) then for i := Length( dynamic) - 1 to Length(Sensor) - 1 do begin SignN.Enqueue(SignN.Count); SignT.Enqueue(0); SignP.Enqueue(Pconst); SignNs.Enqueue(i); SignX.Enqueue(100); SignM.Enqueue(100); SignW.Enqueue(0); if i > 0 then SetLength(dynamic, Length(dynamic) + 1); dynamic[i] := true; end; for i := 0 to Length( dynamic) - 1 do if dynamic[i] = False then begin SignN.Enqueue(SignP.Count); SignT.Enqueue(0); SignP.Enqueue(Pconst); SignNs.Enqueue(i); SignX.Enqueue(100); SignM.Enqueue(100); SignW.Enqueue(0); end; end; dynamic := new boolean[1]; dynamic[0] := false; //Конец if nl / 10 = nl div 10 then begin ClearWindow; Font.Size := 20; TextOut(10, 120, 'Время на один цикла '+Format('{0,5:f2}', Milliseconds / (niconst - nl))); TextOut(10, 150, 'Время до завершения '+Format('{0,5:f0}', (((Milliseconds / (niconst - nl)) * nl) / 1000)/60)+' минут '); Redraw; end; until nl < 0; TextOut(10, 180, Format('{0,5}', 'Количество связей в слое: ' + SignN.Count)); TextOut(10, 210, Format('{0,5}', 'Количество нейронов в слое: ' + SignP.Count)); Redraw; if SignN.Count > 0 then //Сохранение begin assign(f1, 'Признаки.dat'); rewrite(f1); repeat write(f1, SignN.Dequeue(), SignNs.Dequeue(), SignX.Dequeue(), SignM.Dequeue(), SignW.Dequeue() ); until SignN.Count = 0; close(f1); assign(f1, 'Отрибуты.dat'); rewrite(f1); repeat write(f1, SignT.Dequeue(), SignP.Dequeue() ); until SignT.Count = 0; close(f1); end;end.
uses GraphABC;var f1: file of word; Xp, Yp: array [0..500] of integer; i, j, L, K, m: integer; Da, Mo, Ya, Ho, Mi: string; N, Ns, X, Mv, W: word; c: color; d1: System.DateTime;begin SetWindowSize(1650, 1350 ); L := 0; K := 0; for j := 0 to 12 do for i := 0 to 13 do begin Xp[L] := i; Yp[L] := j; L := L + 1; end; assign(f1, 'Признаки.dat'); reset(f1); L := 3; K := 0; repeat read(f1, N, Ns, X, Mv, W); // if N = 115 then m := N - (N div 14) * 14; k := N div 14; begin if X <85 then begin c := RGB( trunc(255 / 100 * (X + 30)), 0, 0); SetPixel((Xp[Ns] + L * 15 + 15 * m) * 3, (Yp[Ns] + 10 + K * 30) * 3, c); SetPixel((Xp[Ns] + L * 15 + 15 * m) * 3 - 1, (Yp[Ns] + 10 + K * 30) * 3 - 1, c); SetPixel((Xp[Ns] + L * 15 + 15 * m) * 3 - 1, (Yp[Ns] + 10 + K * 30) * 3, c); SetPixel((Xp[Ns] + L * 15 + 15 * m) * 3, (Yp[Ns] + 10 + K * 30) * 3 - 1, c); SetPixel((Xp[Ns] + L * 15 + 15 * m) * 3 - 2, (Yp[Ns] + 10 + K * 30) * 3 - 2, c); SetPixel((Xp[Ns] + L * 15 + 15 * m) * 3 - 2, (Yp[Ns] + 10 + K * 30) * 3, c); SetPixel((Xp[Ns] + L * 15 + 15 * m) * 3, (Yp[Ns] + 10 + K * 30) * 3 - 2, c); SetPixel((Xp[Ns] + L * 15 + 15 * m) * 3 - 2, (Yp[Ns] + 10 + K * 30) * 3 - 1, c); SetPixel((Xp[Ns] + L * 15 + 15 * m) * 3 - 1, (Yp[Ns] + 10 + K * 30) * 3 - 2, c); end; if X >=85 then begin c := RGB(0, 0, trunc(255 / 100 * (X*5 +180))); SetPixel((Xp[Ns] + L * 15 + 15 * m) * 3, (Yp[Ns] + 10 + K * 30) * 3, c); SetPixel((Xp[Ns] + L * 15 + 15 * m) * 3 - 1, (Yp[Ns] + 10 + K * 30) * 3 - 1, c); SetPixel((Xp[Ns] + L * 15 + 15 * m) * 3 - 1, (Yp[Ns] + 10 + K * 30) * 3, c); SetPixel((Xp[Ns] + L * 15 + 15 * m) * 3, (Yp[Ns] + 10 + K * 30) * 3 - 1, c); SetPixel((Xp[Ns] + L * 15 + 15 * m) * 3 - 2, (Yp[Ns] + 10 + K * 30) * 3 - 2, c); SetPixel((Xp[Ns] + L * 15 + 15 * m) * 3 - 2, (Yp[Ns] + 10 + K * 30) * 3, c); SetPixel((Xp[Ns] + L * 15 + 15 * m) * 3, (Yp[Ns] + 10 + K * 30) * 3 - 2, c); SetPixel((Xp[Ns] + L * 15 + 15 * m) * 3 - 2, (Yp[Ns] + 10 + K * 30) * 3 - 1, c); SetPixel((Xp[Ns] + L * 15 + 15 * m) * 3 - 1, (Yp[Ns] + 10 + K * 30) * 3 - 2, c); end; TextOut(90 + 50 * m, 75 + K * 90, N); // Sleep(100); end; until Eof(f1); close(f1); d1 := System.DateTime.Now; Da := inttostr(d1.Day); if Length(Da) = 1 then Da := '0' + Da; Mo := inttostr(d1.Month); if Length(Mo) = 1 then Mo := '0' + Mo; Ya := inttostr(d1.Year); Ho := inttostr(d1.Hour); if Length(Ho) = 1 then Ho := '0' + Ho; Mi := inttostr(d1.Minute); if Length(Mi) = 1 then Mi := '0' + Mi; Writeln(Da, '.', Mo, '.', Ya, ' ', Ho, ':', Mi); Window.Save('Отрисовка ' + Da+ '_' + Mo+ '_' + Ya + ' ' + Ho + '_' + Mi + '.bmp');end.
uses GraphABC;var f1: file of word; Xp, Yp: array [0..500] of integer; i, j, L, K, m: integer; Da, Mo, Ya, Ho, Mi: string; N, Ns, X, Mv, W: word; c: color; d1: System.DateTime;begin SetWindowSize(600, 700 ); L := 0; K := 0; for j := 0 to 12 do for i := 0 to 13 do begin Xp[L] := i; Yp[L] := j; L := L + 1; end; assign(f1, 'Признаки.dat'); reset(f1); L := 3; K := 0; repeat read(f1, N, Ns, X, Mv, W); // if N = 115 then m := N - (N div 14) * 14; k := N div 14; begin if X < 85 then begin c := RGB( trunc(255 / 100 * (X + 30)), 0, 0); SetPixel((Xp[Ns] + L * 15 + 15 * m) * 2, (Yp[Ns] + 10 + K * 30) * 2, c); SetPixel((Xp[Ns] + L * 15 + 15 * m) * 2 - 1, (Yp[Ns] + 10 + K * 30) * 2 - 1, c); SetPixel((Xp[Ns] + L * 15 + 15 * m) * 2 - 1, (Yp[Ns] + 10 + K * 30) * 2, c); SetPixel((Xp[Ns] + L * 15 + 15 * m) * 2, (Yp[Ns] + 10 + K * 30) * 2 - 1, c); end; if X >= 85 then begin c := RGB(0, 0, trunc(255 / 100 * (X * 5 + 180))); SetPixel((Xp[Ns] + L * 15 + 15 * m) * 2, (Yp[Ns] + 10 + K * 30) * 2, c); SetPixel((Xp[Ns] + L * 15 + 15 * m) * 2 - 1, (Yp[Ns] + 10 + K * 30) * 2 - 1, c); SetPixel((Xp[Ns] + L * 15 + 15 * m) * 2 - 1, (Yp[Ns] + 10 + K * 30) * 2, c); SetPixel((Xp[Ns] + L * 15 + 15 * m) * 2, (Yp[Ns] + 10 + K * 30) * 2 - 1, c); end; TextOut(100 + 30 * m, 50 + K * 60, N); // Sleep(100); end; until Eof(f1); close(f1); d1 := System.DateTime.Now; Da := inttostr(d1.Day); if Length(Da) = 1 then Da := '0' + Da; Mo := inttostr(d1.Month); if Length(Mo) = 1 then Mo := '0' + Mo; Ya := inttostr(d1.Year); Ho := inttostr(d1.Hour); if Length(Ho) = 1 then Ho := '0' + Ho; Mi := inttostr(d1.Minute); if Length(Mi) = 1 then Mi := '0' + Mi; Writeln(Da, '.', Mo, '.', Ya, ' ', Ho, ':', Mi); Window.Save('Отрисовка ' + Da + '_' + Mo + '_' + Ya + ' ' + Ho + '_' + Mi + '.bmp');end.