Pagini recente » Cod sursa (job #2900158) | Cod sursa (job #1675696) | Cod sursa (job #320955) | Cod sursa (job #630352) | Cod sursa (job #137489)
Cod sursa(job #137489)
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.