Cod sursa(job #137481)

Utilizator vunvixvunvulea mariana vunvix Data 17 februarie 2008 12:23:51
Problema Stalpi Scor 0
Compilator fpc Status done
Runda preONI 2008, Runda 4, Clasa a 10-a Marime 2.39 kb
type ref=^inr;
    inr=record
    x:longint;
    next:ref;
    end;
var f,g:text;
x,y,cost,ne:array[1..1000]of longint;
v:array[1..1000]of ref;
fr:array[1..1000]of byte;
n,i,a,b,c,d,max,xmin,ymax,j,fin:longint;
p,u,q,pr:ref;
ok:boolean;

function bun(j,i:longint):boolean;
var ok:boolean;
begin
ok:=true;
q:=v[j];
while (q<>nil)and ok do begin
 if q^.x=i then ok:=false;
 q:=q^.next;
 end;
bun:=ok;
end;

function caut(xx:longint):boolean;
var f2:array[1..1000]of byte;
i,j:longint;
ok:boolean;
begin
ok:=true;
for i:=1 to n do f2[i]:=0;
for i:=1 to n do if (x[i]>=x[xx])and(y[i]<=y[xx]) then
 if bun(xx,i) then begin
 p:=v[xx];
 f2[i]:=1;

 while p^.next<>nil do begin
   f2[p^.x]:=1;
   p:=p^.next;
   end;
 new(q);
 q^.x:=i;
 q^.next:=nil;
 p^.next:=q;
 end;
p:=v[xx];
while p<>nil do begin
 f2[p^.x]:=1;
 p:=p^.next;
 end;
ok:=true;
for i:=1 to n do if f2[i]=0 then ok:=false;
caut:=ok;
end;

procedure cit;
begin
assign(f,'stalpi.in');reset(f);
readln(f,n);
for i:=1 to n do begin
 readln(f,a,b,c,d);
 ne[i]:=a;
 if a-c<0 then x[i]:=0 else x[i]:=a-c;
 y[i]:=a+d;
 cost[i]:=b;
 if b>max then max:=b;
 new(p);
 p^.x:=i;
 p^.next:=nil;
 v[b]:=p;
 end;
close(f);
end;

procedure bla;
begin
cit;
for i:=1 to n-1 do
 for j:=i+1 to n do if ((x[j]>=x[i])and(y[j]<=y[i]))or
   ((ne[j]>=x[i])and (ne[j]<=y[i])) then begin
 new(p);
 p^.x:=j;
 p^.next:=nil;
 if v[cost[i]]^.next=nil then u:=v[cost[i]];
 u^.next:=p;
 u:=p;
 end;

end;

begin
bla;
for i:=1 to max-1 do if not(ok) then
 for j:=i+1 to max do if (v[i+j]=nil)and not(ok) then begin
  xmin:=2000000;ymax:=0;
  p:=v[j];
  while p<>nil do begin
   new(q);
   q^.x:=p^.x;
   if xmin>x[p^.x] then xmin:=x[p^.x];
   if ymax<y[p^.x] then ymax:=y[p^.x];
   q^.next:=nil;
   if v[i+j]=nil then begin
     v[i+j]:=q;
     u:=q;
     end else begin
     u^.next:=q;
     u:=q;
     end;
   p:=p^.next;
   end;

    p:=v[i];
  while p<>nil do begin
  if bun(i+j,p^.x)then begin
   new(q);
   q^.x:=p^.x;
   q^.next:=nil;
   if v[i+j]=nil then begin
     v[i+j]:=q;
     u:=q;
     end else begin
     u^.next:=q;
     u:=q;
     end;
   end;
   p:=p^.next;
   end;
  x[i+j]:=xmin;
  y[i+j]:=ymax;
{  cost[i+j]:=cost[i]+cost[j];}
  if caut(i+j) then begin
    fin:=i+j;
    ok:=true;
    end;
 end;
assign(g,'stalpi.out');rewrite(g);
writeln(g,fin);
close(g);
end.