Cod sursa(job #427992)

Utilizator amaliutzzaGoia Amalia amaliutzza Data 28 martie 2010 17:46:15
Problema Cele mai apropiate puncte din plan Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 2.76 kb
program cele_mai_apropiate_puncte_din_plan;

type punct=record x,y:integer; end;

const max=100010;
      inf=1 shl 30;

var f,g:Text;
    v,w:array[1..max]of punct;
    n:integer;

function cmp (a,b:punct):boolean;
begin
  cmp:=a.x < b.x;
  if a.x = b.x then
    cmp:=a.y < b.y;
end;

function dist(a,b:punct):real;
var difx,dify:integer;
begin
  difx:=a.x-b.x;
  dify:=a.y-b.y;

  dist:=sqrt( sqr(difx) + sqr(dify) );
end;

function divide(st,dr:integer):real;
var i,j,m,k:integer;
    d,dmin,s1,s2,s:real;
begin

   if st=dr then exit;

  if dr-st < 3 then
    begin
      for i:= st to dr-1 do     {caut dist minima dintre punctele }
        for j:= i+1 to dr do
        begin  {din planul din stg dreptei d}
          d:= dist(v[i],v[j]);
          if d < dmin then
            dmin:=d;
        end;
      divide:= dmin;
    end;


  m:= (st+dr) shr 1; {div 2}   {impart din nou planul}
  d:= v[m].x;

  s1:= divide (st,m);
  s2:= divide (m+1,dr);

  s:= s1;
  if s2<s then
    s:=s2;

  k:= 0;
  j:= m+1;

  for i:=st to m do
    if ( abs(v[i].x - d) <= S) then
      break;

  while (i <= m ) and ( j <= dr ) and ( abs(v[j].x-d) <= S ) do
    if v[i].y  < v[j].x then
      begin
        inc(k);
        w[k]:=v[i];
        inc(i);
      end
    else
      begin
        inc(k);
        w[k]:= v[j];
        inc(j);
      end;

  while (i <= m) do
    begin
      inc(k);
      w[k]:= v[i];
      inc(i);
    end;

  while (j <= dr) and ( abs(v[j].x-d) <= S) do
    begin
      inc(k);
      w[k]:=v[j];
      inc(j);
    end;

  D:=30000;
  Dmin:=30000;

  for i:= 1 to k-1 do
    begin
      j:=i+1;
      while ( j<= (i+7) ) and (j <= k) do
        begin
          d:=dist(w[i],w[j]);
          if d<dmin then
            dmin:=d;
          inc(j);
        end;
    end;

  if dmin > s then
    dmin:=s;

  divide:=dmin;
end;

procedure quick(s,d:integer);
var a,b,ai:integer;
    aux:punct;
begin
  a:=s;
  b:=d;
  repeat
    while v[a].y<v[b].y do dec(b);
    aux:=v[a];
    v[a]:=v[b];
    v[b]:=aux;
    ai:=1;
    inc(a);
    if a<b then
      begin
        while v[a].y<v[b].y do inc(A);
        if (v[a].x<>v[b].x) and (v[a].y<>v[b].y) then
          begin
            aux:=v[a];
            v[a]:=v[b];
            v[b]:=aux;
            dec(B);
            ai:=0;
          end;

      end;
  until b<=a;
  if s<a-ai then quick(s,a-ai);
  if a-ai+1<d then quick(a-ai+1,d);
end;

procedure citire;
var i:integer;
begin
  readln(f,n);
  for i:=1 to n do
    readln(f,v[i].x,v[i].y);
  quick(1,n);
end;

begin
  assign(f,'cmapdp.in'); reset(F);
  assign(g,'cmapdp.out'); rewrite(g);
    citire;
    writeln(g,divide(1,n):2:6);
  close(f); close(g);
end.