ALAKE - Hồ nhân tạo

Tác giả: flashmt

Ngôn ngữ: Pascal

const maxn=100010;
var n,x,min:longint;
    re:qword;
    l,r:array[0..maxn] of longint;
    w,h,a:array[0..maxn] of qword;

procedure rf;
var i:longint;
begin
     readln(n);
     min:=maxlongint;
     for i:=1 to n do
     begin
          readln(w[i],h[i]);
          if h[i]<min then
          begin
               min:=h[i];
               x:=i;
          end;
          l[i]:=i-1; r[i]:=i+1;
     end;
     h[0]:=maxlongint; h[n+1]:=maxlongint;
end;

procedure pr;
var i,t:longint;
begin
     re:=0;
     repeat
           if h[l[x]]<h[r[x]] then
           begin
                if h[l[x]]<h[x] then
                begin
                     x:=l[x];
                     a[x]:=re+w[x];
                end
                else
                begin
                     a[x]:=re+w[x];
                     re:=re+w[x]*(h[l[x]]-h[x]);
                     inc(w[l[x]],w[x]);
                     r[l[x]]:=r[x]; l[r[x]]:=l[x]; x:=l[x];
                     a[x]:=re+w[x];
                end;
           end
           else
           begin
                if h[r[x]]<h[x] then
                begin
                     x:=r[x];
                     a[x]:=re+w[x];
                end
                else
                begin
                     a[x]:=re+w[x];
                     re:=re+w[x]*(h[r[x]]-h[x]);
                     inc(w[r[x]],w[x]);
                     l[r[x]]:=l[x]; r[l[x]]:=r[x]; x:=r[x];
                end;
           end;
           if (x=0) or (x=n+1) then exit;
     until false;
end;

procedure wf;
var i:longint;
begin
     for i:=1 to n do writeln(a[i]);
end;

begin
     rf;
     pr;
     wf;
end.

Download