Авторські розв"язки задач 2-го туру

Задача 1. "Подорож" м'ячика по сходинках.

На вершині драбинки, що складається з N сходинок, знаходиться м'ячик, 
який починає котитися, підскакуючи, донизу. М'ячик під час своєї "подорожі"
може скочити на наступну сходинку,  через одну або через дві сходинки.
(Тобто, якщо м'ячик знаходиться на 10 сходинці, то він може переміститися на 9-у,
8-у і 7-у сходинки).
Визначити число всіх можливих маршрутів "подорожі" м'ячика на землю.

var i,n : integer;
    d    : array [1..30] of longint;
    f     : text;
begin
   	assign(f,'ball.dat); 
   	reset(f); 
   	readln(f,n);
	close(f);   
	d[1]:=1; d[2]:=2; d[3]:=4;
	for i:=4 to n do begin d[i]:=d[i-1]+d[i-2]+d[i-3];end;
	assign(f,'ball.sol');
	rewrite(f);
	writeln(f,d[n]);
	close(f);
end.

Задача 2. Майданчик під стадіон.

Жителі невеликого провінційного містечка Healthcity, що розміщено не вельми
далеко від кінця світу любили дві речі: спорт і природу.
Вирішивши одного разу побудувати стадіон вони були шоковані - навколо містечка 
знаходилося безліч дерев, які вони, по зрозумілих причинах, не могли нищити.
Пошук придатного для будівництва майданчика затягнувся і мер звернувся до 
аерокосмічного агентсва за планом місцевості з відмітками місць, де ростуть дерева. 
План було отримано. Він був розбитий на квадрати розмірності N які могли мати такий вигляд:

 0  0 -1 -1  0 -1 
 0 -1 -1 -1  1  2
-1 -1  0 -1  3  4  
-1  0  4  4 -1 -1
-1 -1  6  4 -1 -1
 0  0 -1  0  0 -1

Від'ємними одиничками позначені місця знаходження дерев, а додатні числа вказують 
вказують на вільні від дерев місця та середню висоту ділянки відносно найнижчої точки 
на  карті. Ваша задача: допомогти жителям міста  Healthcity поліпшити здоров'я і зберегти 
природу, тобто скласти програму вибору найбільшого майданчика для майбутнього стадіону. 
Ділянка повинна мати прямокутну форму (квадрат є частковий випадком прямокутника). З двох 
рівних по площі ділянок слід вибрату ту, затрати праці по підготовці якої будать мінімальними.

Наприклад, для нашого плану рівні площі мають дві ділянки: (2,5) і (4,3). Координати задають 
верхні ліві кути. Площі однакові (4 од), але другий варіант кращий, оскільки зайві тільки 2 
одиниці грунту (координата 5,3), а в першому випадку для виходу на цей рівень ми повинні
перемістити 1 од. з (3,5) в (2,5). І хоча тепер перша рівнина (2,2,2,4) дорівнює по об'єму робіт
другій (4,4,6,4) - друга більш економічно вигідна тому, що тут не здійснювалися попередні 
переміщення.

Приклади порівняння рівнин:
(2,2,2,3) краще, ніж (2,2,2,1) - одиницю грунту краще вивести як завезти;
(1,2,3,4) дорівнює (5,6,7,8) - в такому випадку виводити першу знайдену при обході з верхнього 
лівого кута карти.

{$A+,B-,D+,E+,F-,G-,I+,L+,N+,O-,P-,Q-,R-,S+,T-,V+,X+}
{$M 16384,0,655360}

const MaxN         = 100;
type vector        = array [1..MaxN] of integer;
var Map            : array [1..MaxN] of vector;
    i,j,k,n        : word;
    f              : text;
    IM,JM          : integer;
    SMax           : word;
    KStepOpt,KStep : longint;

Procedure Init;
var i,j            : integer;
begin
   SMax:=0;
   assign(f,'stadion.dat');
   reset(f);
   readln(f,n);
   for i:=1 to n do begin
     for j:=1 to n do
        read(f,Map[i,j]);
     readln(f);
   end;
   close(f);
end;

Procedure Run;
var i,j,i1,i2,k : integer;
    L           : vector;
Function MinL(x,y:integer):integer;
var i,m    : integer;
begin
  m:=MaxInt;;
  for i:=x to y do
      if L[i]<m then m:=L[i];
  MinL:=m;
end;
Function MaxFree(x,y:integer):word;
var l,j    : word;
begin
  l:=0;
  j:=y;
  While (j<=n) and (Map[x,j]>=0) do begin inc(l);inc(j);end;
  MaxFree:=l;
end;
Function MoveStep(x,y,dx,dy:integer):longint;
var     k,i,j     : integer;
    kd,kv,s       : longint;
begin
   s:=0;k:=0;
   for i:=x to x+dx-1 do
     for j:=y to y+dy-1 do begin
       s:=s+Map[i,j];
       inc(k);
     end;
   if k<>0 then s:=round(s/k);
   kd:=0;kv:=0;
   for i:=x to x+dx-1 do
     for j:=y to y+dy-1 do begin
        if Map[i,j]<s then kv:=kv+(s-Map[i,j]);
        if Map[i,j]>s then kd:=kd+(Map[i,j]-s);
     end;
   if kd=kv then MoveStep:=kd
            else if kd>kv then MoveStep:=kd
                          else MoveStep:=-kv

end;

begin
   FillChar(L,SizeOf(L),0);
   for j:=1 to n do begin
     for i:=1 to n do if L[i]=0 then L[i]:=MaxFree(i,j) else dec(L[i]);
     for i1:=1 to n do
       for i2:=i1 to n do begin
         k:=MinL(i1,i2);
         if SMax<k*(i2-i1+1) then begin
                                     SMax:=k*(i2-i1+1);
                                     IM:=i1;JM:=j;
                                     KStepOpt:=MoveStep(IM,JM,i2-i1+1,k);
                                   end
                             else
                              if SMax=k*(i2-i1+1) then begin
                                  KStep:=MoveStep(i1,j,i2-i1+1,k);
                                  if (KStepOpt<0) and (abs(KStepOpt)=KStep)
                                     then begin
                                        KStepOpt:=KStep;
                                        IM:=i1;JM:=j;
                                     end;
                                  if abs(KStep)<abs(KStepOpt)
                                       then begin
                                         KStepOpt:=KStep;
                                         IM:=i1;JM:=j;
                                       end
                              end
       end
   end
end;

begin
  Init;
  Run;
  assign(f,'stadion.sol');
  rewrite(f);
  writeln(f,IM,' ',JM);
  writeln(f,SMax);
  writeln(f,abs(KStepOpt));
  close(f);
end.

Задача 3. НЕП

У деякій фірмі, не обтяженій засобами виробництва, для випуску N видів готової продукції  працює дві 
бригади. Для j-го виробу першій бригаді необхідний час а[j], потім час b[j] потрібен 2-й бригаді для упаковки 
виробу. В якій послідовності необхідно виготовляти вироби, щоб загальний час для виготовлення і упаковки 
всієї продукції був мінімальним. Всі види продукції обробляються бригадами в одній послідовності.

const MaxTime   = MaxInt;
type TTime      = array[1..30] of word;
var Time    : record
               t1,t2 :TTime;
              end;
    Off     : array[1..30] of boolean;
    Res     : array[1..30] of byte;
    n,MinT  : longint;

Procedure Init;
var i       : byte;
begin
  assign(input,'nep.dat');
  reset(input);
  readln(input,n);
  for i:=1 to n do read(input,Time.t1[i]);
  readln(input);
  for i:=1 to n do read(input,Time.t2[i]);
  close(input);
  for i:=1 to n do Off[i]:=False;
  for i:=1 to n do Res[i]:=0;
  MinT:=MaxTime;
end;
Procedure Run;
var i,b,Ni,KOff   : byte;
    Min          : word;
Function NEnd:byte;
var i    : byte;
begin
  i:=n;
  While Res[i]<>0 do dec(i);
  NEnd:=i;
end;
Function NBegin:byte;
var i    : byte;
begin
  i:=1;
  While Res[i]<>0 do inc(i);
  NBegin:=i;
end;
Function TimeAll:longint;
var i,j             : byte;
    TimeOpt,SX      : longint;
    X               : TTime;
Function Suma(a:TTime;NN:byte):longint;
var s    : longint;
    i    : byte;
begin
   s:=0;
   for i:=1 to NN do s:=s+a[Res[i]];
   Suma:=s;
end;
Function MaxEl(a,b:longint):longint;
begin
  if a>=b then MaxEl:=a else MaxEl:=b
end;
begin
   x[1]:=Time.t1[Res[1]];
   SX:=x[1];
   for i:=2 to n do begin
     x[i]:=MaxEl(Suma(Time.t1,i)-Suma(Time.t2,i-1)-SX,0);
     SX:=SX+x[i];
   end;
   TimeAll:=Suma(Time.t2,n)+SX;
end;
begin
   KOff:=0;
   repeat
     MinT:=MaxTime;
     for i:=1 to n do begin
        if not Off[i] and (Time.t1[i]<MinT)
               then begin MinT:=Time.t1[i];b:=1;Ni:=i;end;
        if not Off[i] and (Time.t2[i]<MinT)
               then begin MinT:=Time.t2[i];b:=2;Ni:=i;end;
     end;
     inc(KOff);
     Off[Ni]:=True;
     if b=1 then Res[NBegin]:=Ni else Res[NEnd]:=Ni;
   until KOff=n;
   assign(output,'nep.sol');
   rewrite(output);
   for i:=1 to n do write(output,Res[i],' ');
   writeln(output);
   writeln(output,TimeAll);
   close (output);
end;
begin
  Init;
  Run;
end.