Жила была форма NxM разделённая на квадратики. Высота каждого столбика (квадратика) равнялась циферке в нём. Такую форму опустили в воду. Её достали из воды и вся вода которая была не в углублении стекла. Вопрос: Сколько воды осталось?  :idea:

Сначала мы создаём массив b, это изначальный массив только его опустили в воду и вода ещё не слилась (заполнили максимальным середину этого массива. Середину потому что границы не могут держать воду). Потом мы начинаем "сливать" воду следующим образом. Мы бежим очередью по границам и смотрим на соседей, если сосед выше меня с водой, то делаем его таким как я если это вода, и оставляем свою высоту (в массиве а), если нельзя просто слить воду (и записываем соседа в очередь). Таким образом когда закончится алгоритм очередь у нас останется массив с макс. кол-вом воды посередине. Мы бежим по середине (необязательно, т.к. воды на границах нет, но эти малюсенькие частички времени могут вам помешать на олимпиаде сдать задачу) и складываем кол-во воды в кубиках (кубик с водой отнять настоящую высоту). Как-то так.

var a,b:array[1..100,1..100]of integer;
q:array[1..2,1..100000] of integer;
i,j,n,m,max,un,uk,s:longint;

function maximum(x,y:longint):longint;
begin
if x>y then maximum:=x
       else maximum:=y;
end;

procedure sosed(x,y:longint);
begin
if ((x>0)and(x<=m)and(y>0)and (y<=n)and(p[x,y]=0))and(b[i,j]<b[x,y])and(b[x,y]<>a[x,y]) then begin
                                                              b[x,y]:=maximum(b[i,j],a[x,y]);
                                                              q[1,uk]:=x;
                                                              q[2,uk]:=y;
                                                              uk:=uk+1;
                                                             end;
end;

begin

readln(n,m);
s:=0;

for i:=1 to n do
for j:=1 to m do
begin
  read(a[i,j]);
  b[i,j]:=a[i,j];
end;

if (n<=2)or(m<=2) then begin
                        writeln(0);
                        exit;
                       end;
max:=a[1,1];
for i:=1 to n do
for j:=1 to m do
if a[i,j]>max then max:=a[i,j];

for i:=2 to n-1 do
  for j:=2 to m-1 do
  b[i,j]:=max;

un:=1;
uk:=1; 

for i:=2 to n-1 do
begin
  q[1,uk]:=i;
  q[2,uk]:=1;
  uk:=uk+1;
  q[1,uk]:=i;
  q[2,uk]:=m;
  uk:=uk+1;
end;

for j:=2 to m-1 do
begin
  q[1,uk]:=1;
  q[2,uk]:=j;
  uk:=uk+1;
  q[1,uk]:=n;
  q[2,uk]:=j;
  uk:=uk+1;
end;

while un<>uk do
begin
  i:=q[1,un];
  j:=q[2,un];
  un:=un+1;
  sosed(i+1,j);  sosed(i,j+1);
  sosed(i-1,j);  sosed(i,j-1);                   
end; 

for i:=1 to n do
for j:=1 to m do
s:=s+abs(a[i,j]-b[i,j]);

writeln(s);

end.

Мерси Илье Медяникову за условие и объяснение

Отредактировано Санчоус (2011-10-04 15:44:08)