Отримання знань

дистанційна підтримка освіти школярів

• Відгуки

Тут ви можете виконати завдання чи задати питання по змiсту цього уроку.

Магденко Андрій (magduch) 2012-11-15 12:56:17
program graph;
var
n,a,b,s: integer;
sh,kr,pr:array [0..100]of integer;
flag:boolean;
procedure inp;
var
i,j: integer;
begin
assign (input, '7.dat');
reset (input);
read(a,b,n);
close (input);
end;
procedure put;
var i,k:integer;
begin
k:=0;
sh[0]:=0;
i:=1;
repeat
k:=pr[k];
sh[i]:=k;
i:=i+1;
until k=n;
end;

procedure main;
var
i,w:integer;

begin
for w:=0 to n do
begin
kr[w]:=-1;
pr[w]:=-1;
end;
s:=0;
kr[n]:=0;
repeat
flag:=false;
for i:=0 to n do
begin
if kr[i]=s
then begin
if ((i+a)in[0..n])and (kr[i+a]=-1)
then begin
kr[i+a]:=s+1;
pr[i+a]:=i;
flag:=true;
end;
if ((i-a)in[0..n])and (kr[i-a]=-1)
then begin
kr[i-a]:=s+1;
pr[i-a]:=i;
flag:=true;
end;
if ((i+b)in[0..n])and (kr[i+b]=-1)
then begin
kr[i+b]:=s+1;
pr[i+b]:=i;
flag:=true;
end;
if ((i-b)in[0..n])and (kr[i-b]=-1)
then begin
kr[i-b]:=s+1;
pr[i-b]:=i;
flag:=true;
end;
end;
end;
s:=s+1;
until (kr[0]<>-1) or (flag=false);
if kr[0]=-1
then s:=-1
else begin
s:=kr[0];
put;
end;
end;
procedure out;
var
i:integer;
begin
assign (output, '7.sol');
rewrite (output);
if s=-1
then write(s)
else begin
for i:=0 to s do
write(sh[i],' ');
close(output);
end;
end;
Begin
Inp;
Main;
Out;
end.

Коменчук Ірина Євгенівна (sunn) 2012-11-29 12:40:21

program graph;
var
m,p,xk,yk,xf,yf,rez: integer;
pp:array [1..100,1..2] of integer;
a:array [1..10,1..10] of integer;
flag:boolean;
procedure inp;
var
i,j: integer;
begin
assign (input, '8.dat');
reset (input);
read(m,p);
for i:=1 to p do
begin
for j:=1 to 2 do
begin
read(pp[i,j]);
end;
end;

read(xk,yk,xf,yf);

close (input);
end;
procedure farba;
var i,rd,st:integer;
begin
for i:=1 to p do
begin
rd:=pp[i,1];
st:=pp[i,2];
a[rd,st]:=-2;
if (rd>1)and (st>1)
then a[rd-1,st-1]:=-2;
if (rd>1)and (stthen a[rd-1,st+1]:=-2;
end;
end;
procedure main;
var
i,s,j:integer;
begin
for i:=1 to m do
begin
for j:=1 to m do
begin
a[i,j]:=-1;
end;
end;
farba;
a[xk,yk]:=0;
s:=0;
repeat
flag:=false;
for i:=1 to m do
begin
for j:=1 to m do
begin
if a[i,j]=s
then begin
if (i>1)and(j>1)and (a[i-1,j-1]=-1)
then begin
a[i-1,j-1]:=s+1;
flag:=true;
end;
if (i>1)and (a[i-1,j]=-1)
then begin
a[i-1,j]:=s+1;
flag:=true;
end;
if (i>1)and(jthen begin
a[i-1,j+1]:=s+1;
flag:=true;
end;
if (j>1)and (a[i,j-1]=-1)
then begin
a[i,j-1]:=s+1;
flag:=true;
end;
if (jthen begin
a[i,j+1]:=s+1;
flag:=true;
end;
if (i1)and (a[i+1,j-1]=-1)
then begin
a[i+1,j-1]:=s+1;
flag:=true;
end;
if (ithen begin
a[i+1,j]:=s+1;
flag:=true;
end;
if (ithen begin
a[i+1,j+1]:=s+1;
flag:=true;
end;
end;
end;
end;
s:=s+1;
until (a[xf,yf]>0) or (flag=false);
rez:=a[xf,yf];
end;

procedure out;
var
i:integer;
begin
assign (output, '8.sol');
rewrite (output);
write(rez);
close(output);
end;
Begin
Inp;
Main;
Out;
end.

Повернутися до уроку

Повернутися до перелiку уроків курсу

В системі: гості - (1); користувачі - (0)