VDV-1467 (677545), страница 5

Просмтор этого файла доступен только зарегистрированным пользователям. Но у нас супер быстрая регистрация: достаточно только электронной почты!

Текст из файла (страница 5)

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.

73

Характеристики

Список файлов реферата