program neutro;
uses dos, crt, graph;
const
uparrow = #72;
leftarrow = #75;
rightarrow = #77;
downarrow = #80;
type
gr_descriptor = record
x_0,y_0 : word;
X_len,y_len : word;
X_scale, Y_scale : real;
end;
prob_mov = record
max_step : real;
cell_name : string;
step, manual : array[0..10] of real;
cent, cummulate : array[0..10] of word;
end;
scr_mod = (name_edit, arg_edit, fun_edit, diag_edit);
cell_typ = (slow, mean, fast);
par_typ = (g_shift, l_shift, angle);
scr_adr=record
x : integer;
y : integer;
end;
cell_descriptor = record
speed : cell_typ;
x, y, angle : array[1..100] of real;
end;
var
cell : array[1..30] of cell_descriptor;
step_distri : array[g_shift..angle] of prob_mov;
max_shift : array[1..30] of real;
start_x, start_y, counter : integer;
graph_scale : gr_descriptor;
key : char;
N_line, N_pix_inline : integer;
graph_X, graph_Y : array[slow..fast] of integer;
marker_place : array[arg_edit..diag_edit, 1..11] of scr_adr;
name_place, cell_place : scr_adr;
step_len, step_ang, current_x, current_y, current_a : real;
choose_cell : cell_typ;
sign : integer;
procedure draw_axis;
var
i, j : word;
bintext : string;
begin
with graph_scale do
begin
x_0:=round(N_pix_inline/40);
y_0:=round(N_line/40);
X_len:=round(N_pix_InLine-2*x_0);
Y_len:=round(N_line-2*y_0);
setlinestyle(0,0,1);
rectangle(x_0,Y_0,x_0+X_len,Y_0+Y_len);
end;
end;
procedure opengraph;
var
grdriver, grmode : integer;
begin
detectgraph(grdriver,grmode);
initgraph(grdriver,grmode,'');
N_line:=getmaxY;
N_pix_inline:=getmaxX;
start_x:=n_pix_inline div 2;
start_y:=n_line div 2;
SetBkColor(Black);
SetColor(LightRed);
cleardevice;
draw_axis;
end;
procedure readscreen(fname : string; Tcl,Tbg : word);
var
x, y, j, txt_b, txt_c : word;
i : array [arg_edit..diag_edit] of word;
a : char;
d : text;
begin
assign(d,fname);
reset(d);
txt_b:=Black;
TextBackground(txt_b);
clrscr;
y:=0;
i[arg_edit]:=0; i[fun_edit]:=0; i[diag_edit]:=0;
repeat
y:=y+1; x:=0;
repeat
x:=x+1;
read(d,a);
case a of
'.' : begin
if txt_b=Black then txt_b:=Tbg else txt_b:=Black;
txt_c:=Tcl;
textbackground(txt_b);
textcolor(txt_c);
WRITE(' ');
end;
'*' : begin
name_place.x:=x;
name_place.y:=y;
write(' ');
end;
'$' : begin
cell_place.x:=x;
cell_place.y:=y;
write(' ');
end;
'#' : begin
write(' ');
i[arg_edit]:=i[arg_edit]+1;
marker_place[arg_edit,i[arg_edit]].x:=x;
marker_place[arg_edit,i[arg_edit]].y:=y;
end;
'~' : begin
write(' ');
i[fun_edit]:=i[fun_edit]+1;
marker_place[fun_edit,i[fun_edit]].x:=x;
marker_place[fun_edit,i[fun_edit]].y:=y;
end;
'!' : begin
write(' ');
i[diag_edit]:=i[diag_edit]+1;
marker_place[diag_edit,i[diag_edit]].x:=x;
marker_place[diag_edit,i[diag_edit]].y:=y;
end;
else
write(a);
end;
until eoln(d);
readln(d); writeln;
until eof(d);
close(d);
end;
procedure readreal(var value : real; a : char; len : word; ad : scr_adr);
var LI : array[1..10] of char;
x,y,old : integer;
st : string;
begin
write(' ':len);
gotoXY(ad.x,ad.y);
LI[1]:=a; write(a); y:=2;
if a<>#13 then
repeat
a:=readkey;
if a=',' then a:='.';
if ((a='O') or (a='o')) then a:='0';
if ((a>='0') and (a<='9')) or (a='.')
then begin LI[y]:=a; write(a); y:=y+1 end;
if a=#8 then
begin y:=y-1;
gotoXY(ad.x+y-1,ad.y);
write(' ');
gotoXY(ad.x+y-1,ad.y);
end;
until a=#13;
st:=LI[1];
for x:=2 to y-1 do st:=concat(st,LI[x]);
val(st,value,old);
end;
procedure setmarker(m : scr_mod; i : integer);
begin
gotoxy(marker_place[m,i].x,marker_place[m,i].y);
end;
procedure wri_val(x : real; i : integer; old : boolean);
begin
if old
then begin textbackground(Black);
textcolor(LightGray)
end
else begin textbackground(LightGray);
textcolor(Black)
end;
setmarker(fun_edit,i+1);
write(' ':4);
setmarker(fun_edit,i+1);
write(x:4:1);
setmarker(fun_edit,i+1);
end;
procedure edit_prob(index : par_typ);
var
st : real;
j : integer;
a : char;
begin
with step_distri[index] do
begin
readscreen('distrib.scr',LightGray,Red);
gotoXY(name_place.x,name_place.y);
case index of
g_shift : write('Глобальный шаг');
l_shift : write('Локальный шаг');
angle : write('Угол');
end;
st:=max_step/10;
for j:=0 to 10 do
begin
step[j]:=j*st;
gotoXY(marker_place[arg_edit,j+1].x,marker_place[arg_edit,j+1].y);
write(step[j]:4:1);
gotoXY(marker_place[fun_edit,j+1].x,marker_place[fun_edit,j+1].y);
write(manual[j]:4:1);
end;
j:=0;
repeat
setmarker(fun_edit,j+1);
wri_val(manual[j],j,false);
setmarker(fun_edit,j+1);
a:=readkey;
if a=#0 then
begin
a:=readkey;
wri_val(manual[j],j,true);
case a of
rightarrow, downarrow : j:=j+1;
leftarrow, uparrow : j:=j-1;
end;
if j>10 then j:=10;
if j<0 then j:=0;
end;
if ((a>='0') and (a<='9')) or (a='-')
then
begin
readreal(st,a,4,marker_place[fun_edit,j+1]);
manual[j]:=st;
end;
until ((a=chr(27)) or (a=' '));
end;
end;
procedure normalize;
var
j : word;
s : par_typ;
x : real;
begin
for s:=g_shift to angle do
begin
x:=0;
for j:=0 to 10 do x:=x+step_distri[s].manual[j];
for j:=0 to 10 do
begin
step_distri[s].cent[j]:=round(100*step_distri[s].manual[j]/x);
end;
step_distri[s].cummulate[0]:=step_distri[s].cent[0];
for j:=1 to 10 do
begin step_distri[s].cummulate[j]:=
step_distri[s].cummulate[j-1]+
step_distri[s].cent[j];
end;
end;
end;
procedure make_population;
var
i, j, x : word;
begin
clrscr;
for i:=1 to 30 do
begin
x:=random(100);
j:=0;
while x>step_distri[g_shift].cummulate[j] do j:=j+1;
step_len:=step_distri[g_shift].step[j];
max_shift[i]:=step_len;
cell[i].x[1]:=500+random(1000);
cell[i].y[1]:=500+random(1000);
cell[i].angle[1]:=random(180);
if random(100)<50 then cell[i].angle[1]:=-cell[i].angle[1];
if max_shift[i]>=15 then cell[i].speed:=fast;
if (max_shift[i]>=7) and (max_shift[i]<15) then cell[i].speed:=mean;
if max_shift[i]<=7 then cell[i].speed:=slow;
end;
end;
procedure init;
var
j : word;
s : par_typ;
x : real;
c : cell_typ;
begin
step_distri[g_shift].max_step:=30;
step_distri[g_shift].cell_name:='Глобальный';
step_distri[l_shift].max_step:=30;
step_distri[l_shift].cell_name:='Локальный';
step_distri[angle].max_step:=180;
step_distri[angle].cell_name:='Углы';
s:=g_shift;
for j:=0 to 10 do step_distri[s].manual[j]:=100*sin(pi*j/10)*sin(pi*j/10);
s:=l_shift;
for j:=0 to 10 do step_distri[s].manual[j]:=100*sin(pi*j/10)*sin(pi*j/10);
s:=angle;
for j:=0 to 10 do step_distri[s].manual[j]:=100*exp(-j/2);
edit_prob(g_shift);
edit_prob(l_shift);
edit_prob(angle);
clrscr;
normalize;
make_population;
end;
procedure calc_step(i : word);
var
x, j : word;
begin
x:=random(100);
j:=0;
while x>step_distri[l_shift].cummulate[j] do j:=j+1;
step_len:=step_distri[l_shift].step[j]*max_shift[i]/30;
x:=random(100);
j:=0;
while x>step_distri[angle].cummulate[j] do j:=j+1;
step_ang:=step_distri[angle].step[j];
x:=random(100);
if x>50 then sign:=-1 else sign:=1;
end;
procedure make_all_steps;
var i, j : word;
begin
for i:=1 to 30 do
with cell[i] do
for j:=2 to 100 do
begin
calc_step(i);
angle[j]:=angle[j-1]+step_ang*sign;
x[j]:=x[j-1]+step_len*cos(angle[j]*pi/180);
y[j]:=y[j-1]+step_len*sin(angle[j]*pi/180);
end;
end;
procedure print_coord;
var i, j, k : word;
f : text;
begin
for i:=1 to 30 do
with cell[i] do
for j:=1 to 100 do
begin
writeln(i:5,x[j]:9:2,y[j]:9:2);
if j mod 20 = 0 then readln(k);
end;
end;
procedure speed_meas;
var
i,j : word;
z : real;
shift : array[1..30] of real;
begin
clrscr;
for i:=1 to 30 do shift[i]:=0;
for i:=1 to 30 do
with cell[i] do
for j:=2 to 100 do
begin
z:=sqrt((x[j]-x[j-1])*(x[j]-x[j-1])+(y[j]-y[j-1])*(y[j]-y[j-1]));
shift[i]:=shift[i]+z;
end;
for i:=1 to 30 do
begin shift[i]:=shift[i]/100;
end;
end;
procedure write_shift;
var i, j, k : word;
z : real;
shift : array[1..30] of real;
f : text;
begin
assign(f,'treck.txt');
rewrite(f);
for j:=1 to 30 do shift[j]:=0;
j:=2;
repeat
j:=j+1;
write(f,j:3);
for i:=1 to 30 do
with cell[i] do
begin
z:=sqrt((x[j]-x[j-1])*(x[j]-x[j-1])+(y[j]-y[j-1])*(y[j]-y[j-1]));
shift[i]:=shift[i]+z;
write(f,shift[i]:9:2);
end;
writeln(f);
until j=100;
close(f);
end;
procedure write_angle;
var i, j, k : word;
z : real;
shift : array[1..30] of real;
f : text;
begin
assign(f,'angle.txt');
rewrite(f);
with step_distri[angle] do
for j:=0 to 10 do writeln(f,step[j]:10:2,cent[j]:10,cummulate[j]:10);
close(f);
end;
procedure write_disp;
var i, j, k : word;
z : real;
shift, loc_calc : array[1..30] of real;
f : text;
begin
assign(f,'disper.txt');
rewrite(f);
for j:=1 to 30 do begin loc_calc[j]:=0; shift[j]:=0; end;
j:=1;
repeat
j:=j+1;
write(f,ln(j):10:2);
for i:=1 to 30 do
with cell[i] do
begin
loc_calc[i]:=0;
for k:=j+1 to 100 do
begin
z:=(x[k]-x[k-j])*(x[k]-x[k-j])+(y[k]-y[k-j])*(y[k]-y[k-j]);
loc_calc[i]:=loc_calc[i]+z;
end;
shift[i]:=loc_calc[i]/(100-j);
write(f,0.5*ln(shift[i]):10:2);
end;
writeln(f);
until j=98;
close(f);
end;
procedure write_distr;
var i, j, k : word;
z : word;
shift : array[0..35] of word;
f : text;
begin
assign(f,'dist_sp.txt');
rewrite(f);
for j:=0 to 35 do shift[j]:=0;
for i:=1 to 30 do
with cell[i] do
begin
for j:=2 to 100 do
begin
z:=round(sqrt((x[j]-x[j-1])*(x[j]-x[j-1])+(y[j]-y[j-1])*(y[j]-y[j-1])));
shift[z]:=shift[z]+1;
end;
end;
for j:=0 to 30 do writeln(f,j:3,shift[j]:10);
close(f);
end;
procedure draw_cell(c : cell_typ; x, y : real);
var
color, graph_x, graph_y : integer;
begin
case c of
slow : color:=lightcyan;
mean : color:=yellow;
fast : color:=white;
end;
graph_x:=round(x*n_pix_inline/2000);
graph_y:=round(y*n_line/2000);
putpixel(graph_x,graph_y,color);
end;
procedure draw_picture;
var
i,j : word;
begin
for i:=1 to 30 do
with cell[i] do
for j:=1 to 100 do
begin
draw_cell(speed,x[j],y[j]);
end;
end;
begin
randomize;
init;
make_all_steps;
speed_meas;
write_shift;
write_distr;
write_disp;
write_angle;
opengraph;
draw_picture;
key:=readkey;
closegraph;
end.