Cod sursa(job #77879)

Utilizator crawlerPuni Andrei Paul crawler Data 15 august 2007 00:16:05
Problema Adapost Scor 63
Compilator fpc Status done
Runda Arhiva de probleme Marime 5.33 kb
const Inf=1e18;
      MaxN=401;
var cap:array[0..2*MaxN,0..511] of byte;
dist:array[0..MaxN,0..MaxN] of real;
vec:array[0..MaxN,0..127] of integer;
leg2,cd,t,leg,gr,ind,grmax:array[0..2*MaxN] of integer;
mark:array[0..2*MaxN] of boolean;
c,xf,yf,xv,yv:array[0..2*MaxN] of real;
a:array[0..MaxN*MaxN] of real;
mij,p,u,dest,i,j,k,m,n,nr:longint;
rez,MaxD:real;
cuplat,bun,nocost:boolean;

function cost(x,y:longint):real; inline;
begin
if nocost or (y=dest) then exit(0.0);
if y>n then exit(dist[x,y-n])
       else exit(-dist[y,x-n]);
end;

procedure relax2(k,i:longint); inline;
begin
if (cap[k,i]=1) and (c[k]+cost(k,i)<c[i]) then
                        begin
                        t[i]:=k; c[i]:=c[k]+cost(k,i);
                        if not mark[i] and (i<>dest) then
                                       begin
                                       inc(nr); mark[i]:=true; cd[nr]:=i;
                                       end;
                        end;

end;

procedure relax(k,i:longint); inline;
begin
if (cap[k,i]=1) and (c[k]+dist[k,i-n]<c[i]) then
                        begin
                        t[i]:=k;
                        if not nocost then c[i]:=c[k]+dist[k,i-n]
                                      else c[i]:=0;
                        if (cap[i,dest]=1) and (c[i]<c[dest]) then
                                                begin
                                                c[dest]:=c[i]; t[dest]:=i;
                                                end;
                        if not mark[i] then
                                       begin
                                       inc(nr); mark[i]:=true; cd[nr]:=i;
                                       end;
                        end;

end;

procedure expand(k:longint); inline;
var i:longint;
begin
if c[k]<c[dest] then
if k<=n then for i:=1 to gr[k] do relax(k,vec[k,i])
        else
        begin
        relax2(k, leg[k]); //relax2(k, dest);
        end;
end;

procedure drum_minim(st:longint); inline;
var i,j,pmin,pmin2:longint;
min:real;
begin
fillchar(mark,dest,false);
for i:=1 to dest do c[i]:=inf;
t[st]:=0; c[st]:=0;
nr:=1; mark[st]:=true; cd[1]:=st;
repeat
 pmin:=random(nr)+1;
 expand(cd[pmin]); mark[cd[pmin]]:=false;
 cd[pmin]:=cd[nr]; dec(nr);
until (nr=0) or (mark[dest] and nocost);
if c[dest]<inf then rez:=rez+c[dest]
               else bun:=false;
i:=dest;
while i<>0 do
 begin
 j:=t[i]; cap[j][i]:=0; cap[i][j]:=1;
 if (i>n) and (j<=n) then leg[i]:=j
                     else leg[j]:=i;
 i:=j;
 end;
end;

procedure greedy(st:longint); inline;
var i,k:longint;
begin
for i:=gr[st] downto 1 do
 if (leg[vec[st,i]]=0) then
                       begin
                       k:=vec[st,i]; leg[k]:=st;
                       cap[st,k]:=0; cap[k,st]:=1;
                       cap[k,dest]:=0;
                       exit;
                       end;
drum_minim(st);
end;

procedure solve; inline;
var i,j:longint;
begin
rez:=0; dest:=2*n+1;
for i:=1 to n do
 begin
 cap[0,i]:=1; cap[i+n,2*n+1]:=1;
 end;
fillword(gr, n+1, 0);
for i:=1 to n do
 begin
 while (dist[i, vec[i, gr[i]+1]-n]<=MaxD) and (gr[i]<grmax[i]) do
                begin
                inc(gr[i]);
                cap[i, vec[i, gr[i]]]:=1;
                end;
 end;
fillchar(leg, sizeof(leg), 0);
if nocost and cuplat then
  for i:=n+1 to 2*n do
  if (leg2[i]<>0) and (dist[leg2[i], i-n]<=MaxD) then
                           begin
                           leg[i]:=leg2[i];
                           cap[0,leg[i]]:=0; cap[i,dest]:=0;
                           cap[i, leg[i]]:=1; cap[leg[i], i]:=0;
                           end;
i:=1; bun:=true;
while (i<=n) and bun do
 begin
 if cap[0,i]=1 then
 if nocost then greedy(i)
           else drum_minim(i);
 inc(i);
 end;
if nocost then
          begin
          leg2:=leg; cuplat:=true;
          end;
end;

procedure sort(l,r:longint);
var i,j,k:longint;
x,y:real;
begin
i:=l; j:=r;
x:=a[(l+r) div 2];
repeat
 while a[i]<x do inc(i);
 while x<a[j] do dec(j);
 if (i<=j) then
           begin
           y:=a[i]; a[i]:=a[j]; a[j]:=y;
           if nr<n then
                   begin
                   k:=ind[i]; ind[i]:=ind[j]; ind[j]:=k;
                   end;
           inc(i); dec(j);
           end;
until i>j;
if l<j then sort(l,j);
if i<r then sort(i,r);
end;

begin
assign(input,'adapost.in'); reset(input);
assign(output,'adapost.out'); rewrite(output);
read(n);
for i:=1 to n do read(xv[i], yv[i]);
for i:=1 to n do read(xf[i], yf[i]);
MaxD:=400;
for i:=1 to n do
 begin
 for j:=1 to n do
  begin
  dist[i,j]:=sqrt(sqr(xv[i]-xf[j])+sqr(yv[i]-yf[j]));
  if dist[i,j]<MaxD then
                    begin
                    inc(nr); a[nr]:=dist[i,j]; ind[nr]:=j+n;
                    end;
  end;
 sort(1,nr); grmax[i]:=nr;
 for j:=1 to nr do vec[i,j]:=ind[j];  nr:=0;
 end;
for i:=1 to n do
 for j:=1 to n do
 if (dist[i,j]<MaxD) and (dist[i,j]>60) then
                   begin
                   inc(nr); a[nr]:=dist[i,j];
                   end;
sort(1,nr); nocost:=true;
p:=1; u:=nr;
while p<u do
 begin
 mij:=(p+u) div 2;
 MaxD:=a[mij];
 solve;
 if bun then u:=mij
        else p:=mij+1;
 end;
MaxD:=a[u]; nocost:=false;
solve;
writeln(a[u]:6:6,' ',rez:6:6);
close(input); close(output);
end.