Cod sursa(job #137489)

Utilizator MDanFMI - Dan Moldovan MDan Data 17 februarie 2008 12:26:34
Problema Stalpi Scor 0
Compilator fpc Status done
Runda preONI 2008, Runda 4, Clasa a 10-a Marime 3.73 kb

type vec=array [1..100000] of longint;
var aux,l,ultim,pos,aux2,naux1,n,naux2,naux3,aux3,j,i:longint;
    a,e,b,c,s,d:vec;
    r:array [1..100000] of real;
    f,g:text;
    max:real;
    ok,au:boolean;
    cost:int64;
    ver:array [1..100000] of byte;

function stanga(i:longint):longint;
begin
stanga:=2*i;
end;

function dreapta(i:longint):longint;
begin
dreapta:=2*i+1;
end;

function parinte (i:longint):longint;
begin
parinte:=trunc(i/2);
end;


procedure reconstituieheap(i:longint);
var l,r,maxim:longint;
begin
l:=stanga(i);
r:=dreapta(i);
if (l<=aux2) and (a[l]>a[i])
then
    maxim:=l
else
    maxim:=i;
if (r<=aux2) and (a[r]>a[maxim])
then
    maxim:=r;
if maxim<>i
then
    begin
    aux:=a[i];
    naux1:=c[i];
    naux2:=s[i];
    naux3:=d[i];
    c[i]:=c[maxim];
    s[i]:=s[maxim];
    d[i]:=d[maxim];
    c[maxim]:=naux1;
    s[maxim]:=naux2;
    d[maxim]:=naux3;
    a[i]:=a[maxim];
    a[maxim]:=aux;
    reconstituieheap(maxim);
    end;
end;


procedure construiesteheap;
begin
aux2:=j;
for i:=trunc(j/2) downto 1 do
reconstituieheap(i);
end;


procedure heapsort;
begin
construiesteheap;
for i:=j downto 2 do
    begin
    naux1:=c[1];
    naux2:=s[1];
    naux3:=d[1];
    c[1]:=c[i];
    s[1]:=s[i];
    d[1]:=d[i];
    c[i]:=naux1;
    s[i]:=naux2;
    d[i]:=naux3;
    aux3:=a[1];
    a[1]:=a[i];
    a[i]:=aux3;
    aux2:=aux2-1;
    reconstituieheap(1);
    end;
end;

procedure extract (x:longint);
var i:longint;
begin
cost:=cost+c[x];
r[x]:=0;
ver[x]:=1;
for i:=1 to n do
begin
     if a[i]>0
     then
         if a[i]-s[i]<=a[x]
         then
             if a[i]+d[i]>=a[x]
             then
                  if x<>i
                 then
                 begin
                 e[i]:=e[i]-1;
                 ver[i]:=1;
                 end;

     if a[i]>0
     then
         if a[x]-s[x]<=a[i]
         then
             if a[x]+d[x]>=a[i]
             then
                 b[i]:=b[i]-1;
end;
a[x]:=0;
for i:=1 to n do
begin
     if a[i]<>0
     then
         r[i]:=b[i]/c[i];
end;
end;








begin
assign (f,'stalpi.in');
assign (g,'stalpi.out');
reset(f);
rewrite(g);
readln (f,n);
cost:=0;
for j:=1 to n do
readln (f,a[j],c[j],s[j],d[j]);
heapsort;


for i:=1 to n do
begin
     b[i]:=b[i]+1;
     j:=i-1;
     while j>0 do
     begin
          if a[j]>=a[i]-s[i]
          then
              begin
              b[i]:=b[i]+1;
              e[j]:=e[j]+1;
              j:=j-1;
              end
          else
              break;
     end;
     j:=i+1;
     while j<n+1 do
     begin
          if a[j]<=a[i]+d[i]
          then
              begin
              b[i]:=b[i]+1;
              e[j]:=e[j]+1;
              j:=j+1;
              end
          else
              break;
     end;
end;


for i:=1 to n do
begin
r[i]:=b[i]/c[i];
end;


ok:=true;
while ok do
begin
ok:=false;
for i:=1 to n do
if (e[i]=0) and (a[i]<>0)
then
    begin
    au:=false;
    for l:=1 to n do
    if ver[l]=0
    then
        begin
        au:=true;
        break;
        end;
    if au
    then
    extract(i);
    ok:=true;
    break;
    end;
end;
au:=true;
while au do
begin
    max:=r[1];
    pos:=1;
    for i:=2 to n do
    if max<r[i]
    then
        begin
        max:=r[i];
        pos:=i;
        end;
    au:=false;
    for l:=1 to n do
    if ver[l]=0
    then
        begin
        au:=true;
        break;
        end;
    if au
    then
    extract(pos);
    au:=false;
    for l:=1 to n do
    if ver[l]=0
    then
        begin
        au:=true;
        break;
        end;

end;
writeln (g,cost);
close(g);
close(f);
end.