Cod sursa(job #558375)

Utilizator promix2012petruta andrei promix2012 Data 17 martie 2011 11:21:49
Problema Infasuratoare convexa Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.57 kb
program infasuratoare;
const fi='infasuratoare.in';
      fo='infasuratoare.out';
type punct=record
x,y:real;
end;
var s:ansistring;
f,g:text;
n,i,j,k,u,m:longint;
   p:array[1..10000] of punct;
   viz:array[1..10001] of word;

procedure pivot(s,d:longint);
    var pi,pj,i,j,a:longint;
        aux:punct;
    begin
     i:=s; j:=d; pi:=0; pj:=1;
     while i<j do
       begin
         if (p[i].y>p[j].y)or((p[i].y=p[j].y)and(p[i].x>p[j].x)) then
             begin
               aux:=p[i]; p[i]:=p[j]; p[j]:=aux;
               a:=pi; pi:=pj; pj:=a;
            end;
         i:=i+pi; j:=j-pj;
       end;
     m:=i;
   end;
procedure qsort(s,d:longint);
  begin
    if s<d then
      begin
        pivot(s,d);
        qsort(s,m-1); qsort(m+1,d);
      end;
  end;


function sarrus(p1,p2,p3:punct): byte;
var nr:real;
begin
nr:= p1.x*p2.y+p2.x*p3.y+p1.y*p3.x-p3.x*p2.y-p3.y*p1.x-p1.y*p2.x;
if nr>=0 then sarrus:=1
else
sarrus:=-1;
end;
begin
assign(f,fi);
reset(f);
assign(g,fo);
rewrite(g);
read(f,n);
qsort(1,n);
for i:=1 to n do
readln(f,p[i].x,p[i].y);
for u:=1 to n do
for i:=1 to n do
   begin
   if i<>u then
     for j:=1 to n do
       if (i<>j)and(j<>u) then
          for k:=1 to n do
             if (k<>i)and(k<>j)and(k<>u) then
             if (sarrus(p[i],p[j],p[u])=sarrus(p[j],p[k],p[u]))and
             (sarrus(p[i],p[j],p[u])=sarrus(p[k],p[i],p[u])) then
                viz[u]:=1;
   end;
for i:=n downto 1 do
 if viz[i]=0 then
    writeln(g,p[i].x:10:6,' ',p[i].y:10:6);
    close(f);
    close(g);
    end.