Cod sursa(job #363282)

Utilizator FllorynMitu Florin Danut Flloryn Data 12 noiembrie 2009 17:28:18
Problema Infasuratoare convexa Scor 50
Compilator fpc Status done
Runda Arhiva educationala Marime 1.86 kb
program pascal;
type pct=record
     x,y:real;
     end;
var p:array[1..120000] of pct; n,k,m,pas,i:longint;
    s:array[1..120000] of longint;
    x:real;  f,g:text;  v:array[1..120000] of boolean;

    procedure quick(s,d:longint);
    var aux:pct; a,b,ia:longint;
    begin
    a:=s; b:=d;
    repeat
      while (p[a].y<p[b].y) or ((p[a].y=p[b].y) and (p[a].x<p[a].x)) do b:=b-1;
      aux:=p[a]; p[a]:=p[b]; p[b]:=aux; ia:=1; a:=a+1;
      if a<b then
          begin
          while (p[a].y<p[b].y) or ((p[a].y=p[b].y) and (p[a].x<p[a].x)) do a:=a+1;
          if a<>b then
              begin
              aux:=p[a]; p[a]:=p[b]; p[b]:=aux; ia:=0; b:=b-1;
              end;
          end;
    until a>=b;
    if s<a-ia then quick(s,a-ia);
    if a-ia+1<d then quick(a-ia+1,d);
    end;

    function semn(a,b,c:pct):integer;
    begin
    if (a.y-b.y)*c.x+(b.x-a.x)*c.y+a.x*b.y-a.y*b.x<=0 then semn:=-1
    else semn:=1;
    end;

    procedure modifica;
    begin
    if pas=1 then
           begin
           i:=i+1;
           if i=n then pas:=-1;
           end else i:=i-1;
    end;

    procedure convex;
    begin
    fillchar(v,sizeof(v),false);
    pas:=1; s[1]:=1; s[2]:=2; v[2]:=true; k:=2; i:=2;
    while i>1 do
        begin
        while v[i] do modifica;
        if i=0 then break;
        while (k>1) and (semn(p[s[k-1]], p[s[k]], p[i])<0) do
                begin
                v[s[k]]:=false;
                dec(k);
                end;
        inc(k);
        s[k]:=i;
        v[i]:=true;
        end;
    end;
begin
assign(f,'infasuratoare.in'); reset(f);
assign(g,'infasuratoare.out'); rewrite(g);
readln(f,n);
for k:=1 to n do readln(f,p[k].x, p[k].y);
quick(1,n);
convex;
if s[1]=s[k] then k:=k-1;
writeln(g,k);
for i:=1 to k do writeln(g,p[s[i]].x:16:16,' ',p[s[i]].y:16:16);
close(f);
close(g);
end.