Задача 2. Змейка : вывести квадрат состоящий из n*n ячеек, заполненных числами от 1 до n2 «змейкой» ( 2<= n<=100, время 1 сек.)
Program serpent;
Uses crt;
Const k1='serpent.in'; k2='serpent.out';
Var input,output: text;
n,i,j,l,m,k,d: integer; a:array[1..200] of integer;
b:array[1..100,1..100] of integer;
begin clrscr;textcolor(10);textbackground(5);
assign(input,k1); reset(input); assign(output,k2); rewrite(output);
m:=1; d:=1; l:=0;
read(input,n); write('n=',n:3);
for k:=2 to 2*n do begin if l=0 then l:=1 else l:=0;
for i:=1 to n do
for j:=1 to n do begin
if l=0 then if i+j=k then begin b[i,j]:=d; d:=d+1; end;
if l=1 then if i+j=k then begin b[j,i]:=d; d:=d+1; end; end; end;
for i:=1 to n do begin writeln(output);
for j:=1 to n do write(output,b[i,j]:5); end;
close(output) end.
Задача 3. Открытка и конверт : Даны размеры прямоугольных открытки и конверта. Требуется определить, поместится ли открытка в конверт. Открытку и конверт можно поворачивать относительно друг друга. Сгибать открытку не допускается.
Program postcard;
Uses crt;
label v1;
Const k1='postcard.in'; k2='postcard.out';
Var input,output: text; a,b,c,m,n: integer; d,l: real;
begin clrscr;textcolor(10);textbackground(5);
assign(input,k1); reset(input); assign(output,k2); rewrite(output);
readln(input,a,b); if a<b then begin c:=a; a:=b; b:=c; end;
read(input,m,n); if m<n then begin c:=m; m:=n; n:=c; end; close(input);
if (a<m)and(b<n) then begin
writeln(output,'possible'); goto v1; end;
if (a>m)and(b>n) then begin
writeln(output,'impossible'); goto v1; end;
d:=sqrt(n*n+m*m);
if d>=a+b then writeln(output,'possible')
else writeln(output,'impossible');
v1: close(output) end.
Задача 1. День рождения : заданы день и месяц рождения, а также текущие день, месяц и год. Определить, сколько дней осталось до дня рождения .
Program birthday;
Uses crt;
Const k1='birthday.in'; k2='birthday.out';
label v1,v2;
Var input,output: text; i,m,l1,l2,l3,d1,d2: integer; a:array[1..12] of integer;
begin clrscr;textcolor(10);textbackground(5);
assign(input,k1); reset(input); assign(output,k2); rewrite(output); m:=0;
a[1]:=31;a[2]:=28;a[3]:=31;a[4]:=30;a[5]:=31;a[6]:=30;
a[7]:=31;a[8]:=31;a[9]:=30;a[10]:=31;a[11]:=30;a[12]:=31;
readln(input,d1,d2); read(input,l1,l2,l3);
if (d1=29)and(d2=02) then begin
v2: if l3 mod 4=0 then begin a[2]:=29;
if d2>l2 then begin
for i:=l2 to d2 do m:=m+a[i]; m:=m-l1; goto v1; end;
if d2=l2 then begin m:=m+d1-l1; goto v1; end;
if d2<l2 then begin
if m=0 then m:=1461-l1 else m:=m-l1;
for i:=d2+1 to l2-1 do m:=m-a[i]; goto v1; end; end
else begin m:=m+365; l3:=l3+1; goto v2; end; end;
if d2>l2 then begin if l3 mod 4=0 then a[2]:=29;
for i:=l2 to d2-1 do m:=m+a[i]; m:=m+d1-l1; goto v1; end;
if d2=l2 then begin
if d1<l1 then m:=365+d1-l1 else m:=d1-l1; goto v1; end;
if d2<l2 then begin if l3 mod 4=0 then a[2]:=29;
for i:=l2 to 12 do m:=m+a[i];
for i:=1 to d2-1 do m:=m+a[i]; m:=m+d1-l1; goto v1; end;
v1: write(output,m:5); close(output) end.
Задача 4. Путь коня : Дана шахматная доска, состоящая из клеток, несколько из них вырезано. Провести ходом коня через невырезанные клетки путь минимальной длины из одной заданной клетки в другую.
Program knightw;
Uses crt;
Const k1='knightw.in'; k2='knightw.out';
label v1,v2,v3,v4;
Var input,output: text;
i,i1,j,j1,k,k3,m,n,l1,l2,l3,l4,x,x1,x2,y,y1,y2: integer;
ain,aout:array[1..50,1..50] of char; b3,b4,b5 :array[1..100] of integer;
begin clrscr;textcolor(10);textbackground(5);
assign(input,k1); reset(input); assign(output,k2); rewrite(output);
readln(input,n); k:=0;
for i:=1 to n do begin
for j:=1 to n do read(input,ain[i,j]); readln(input); end;
for i:=1 to n do for j:=1 to n do aout[i,j]:=ain[i,j];
for i:=1 to n do for j:=1 to n do begin
if ain[i,j]='@' then if k=0 then begin x1:=i; y1:=j; k:=1; end
else begin x2:=i; y2:=j; end; end; l3:=1; i1:=1; k3:=0;
b4[1]:=x1; b4[2]:=y1; m:=2; writeln(x1:3,y1:3,x2:3,y2:3);
v1: for j1:=1 to m do begin
if (b4[j1]>0)and(b4[j1+1]>0) then begin
for i:=1 to n do for j:=1 to n do begin
l1:=sqr(i-b4[j1])+sqr(j-b4[j1+1]); if l1=5 then begin
if (i=x2)and(j=y2) then goto v2;
if (i=x1)and(j=y1) then k3:=1;
if ain[i,j]='#' then k3:=1;
if k3=0 then begin b3[l3]:=i; b3[l3+1]:=j; l3:=l3+2;
b5[i1]:=i; b5[i1+1]:=j; i1:=i1+2; end; end; k3:=0; end;
j1:=j1+1; end; end; if l3=1 then goto v4;
for i:=1 to l3-3 do begin x:=b3[i]; y:=b3[i+1];
for j:=i+2 to l3-1 do begin if (x=b3[j])and(y=b3[j+1]) then
begin b3[j]:=0; b3[j+1]:=0; end; j:=j+1; end; i:=i+1; end;
for j:=1 to l3-1 do b4[j]:=b3[j]; m:=l3-1; l3:=1; goto v1;
v2: for i:=1 to i1-3 do begin x:=b5[i]; y:=b5[i+1];
for j:=i+2 to i1-1 do begin if (x=b5[j])and(y=b5[j+1]) then
begin b5[j]:=0; b5[j+1]:=0; end; j:=j+1; end; i:=i+1; end;
v3: l2:=0; for k:=1 to i1-1 do begin
if (b5[k]>0)and(b5[k+1]>0) then begin
l1:=sqr(x2-b5[k])+sqr(y2-b5[k+1]);
if l1=5 then if l2=0 then begin
l2:=1; x:=b5[k]; y:=b5[k+1]; aout[x,y]:='@';
if sqr(x1-x)+sqr(y1-y)=5 then goto v4; end
else begin b5[k]:=0; b5[k+1]:=0; end;
end; k:=k+1; end; x2:=x; y2:=y; goto v3;
v4: if l3=1 then write(output,'Impossible') else for i:=1 to n do begin
for j:=1 to n do write(output,aout[i,j]:3); writeln(output); end;
close(output) end.