Cod sursa(job #296408)

Utilizator mlazariLazari Mihai mlazari Data 4 aprilie 2009 19:02:46
Problema Infasuratoare convexa Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 2.37 kb
Program Infasuratoare;
type Punct=record
       x,y : real;
     end;
     Stiva=^Cel;
     Cel=record
       r : Punct;
       pr : Stiva;
     end;
var P,Q : array[1..120000] of Punct;
    inf : Stiva;
    n,H : longint;

procedure Citeste;
var Intrare : text;
    i : longint;
begin
  assign(Intrare,'infasuratoare.in');
  reset(Intrare);
  readln(Intrare,n);
  for i:=1 to n do readln(Intrare,P[i].x,P[i].y);
  close(Intrare);
end;

procedure MergeSort(i1,i2 : longint);
var m,i,j,k : longint;
begin
  if i1<i2 then begin
    m:=(i1+i2) div 2;
    MergeSort(i1,m);
    MergeSort(m+1,i2);
    i:=i1;
    j:=m+1;
    k:=i1;
    repeat
      if (P[i].x<P[j].x) or (P[i].x=P[j].x) and (P[i].y<P[j].y) then begin
        Q[k]:=P[i];
        i:=i+1;
      end
      else begin
        Q[k]:=P[j];
        j:=j+1;
      end;
      k:=k+1;
    until (i>m) or (j>i2);
    if i>m then
     for i:=j to i2 do Q[k+i-j]:=P[i]
    else
     for j:=i to m do Q[k+j-i]:=P[j];
    for i:=i1 to i2 do P[i]:=Q[i];
  end;
end;

procedure AddCell(var q : Stiva; p : Punct);
var t : Stiva;
begin
  new(t);
  T^.r:=p;
  T^.pr:=q;
  q:=T;
  H:=H+1;
end;

procedure DelCell(var q : Stiva);
var t : Stiva;
begin
  t:=q;
  q:=q^.pr;
  dispose(t);
  H:=H-1;
end;

function ToLeft(var p0,p1,p2 : Punct) : boolean;
begin
  ToLeft:=(p1.x-p0.x)*(p2.y-p0.y)-(p2.x-p0.x)*(p1.y-p0.y)>0;
end;

procedure Calculeaza;
var i : longint;
begin
  MergeSort(1,n);
  H:=0;
  inf:=nil;
  AddCell(inf,P[1]);
  i:=2;
  while i<=n do begin
    if inf^.pr=nil then begin
      AddCell(inf,P[i]);
      i:=i+1;
    end
    else begin
      if ToLeft(inf^.pr^.r,inf^.r,P[i]) then DelCell(inf)
      else begin
        AddCell(inf,P[i]);
        i:=i+1;
      end;
    end;
  end;
  i:=n-1;
  while i>=1 do begin
    if inf^.pr=nil then AddCell(inf,P[i])
    else begin
      if ToLeft(inf^.pr^.r,inf^.r,P[i]) then DelCell(inf)
      else begin
        AddCell(inf,P[i]);
        i:=i-1;
      end;
    end;
  end;
  DelCell(inf);
end;

procedure Scrie;
var Iesire : text;
    i : integer;
begin
  assign(Iesire,'infasuratoare.out');
  rewrite(Iesire);
  writeln(Iesire,H);
  for i:=1 to H do begin
    writeln(Iesire,inf^.r.x:0:6,' ',inf^.r.y:0:6);
    DelCell(inf);
  end;
  close(Iesire);
end;

begin
  Citeste;
  Calculeaza;
  Scrie;
end.