Cod sursa(job #559548)

Utilizator potytzuPotinteu Minail potytzu Data 17 martie 2011 21:35:37
Problema Infasuratoare convexa Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 3.6 kb
program infasuratoare;
const fi='infasuratoare.in';
      fo='infasuratoare.out';
type punct=record
x,y:real;
end;
var s:ansistring;
f,g:text;
ok:boolean;
n,i,nrw,nrz,j,k,u,m,nr1,nrf,pmin,pmax:longint;
min,max:punct;
   p:array[1..100000] of punct;
   viz:array[1..100010] of word;
   t,w,z:array[1..100010] of punct;



function sarrus(p1,p2,p3:punct): integer;
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;


  procedure detmultimi;
  var i:longint;
  begin
      nrw:=0;
      nrz:=0;
      writeln(min.x,' ',min.y);
      writeln(max.x,' ',max.y);
      write(nrf);
      for i:=1 to nrf do
        begin
            if sarrus(min,max,t[i])=-1 then
               begin
                  inc(nrw);
                  w[nrw]:=t[i];
                  writeln(t[i].x,' ',t[i].y);
               end
            else
               begin
                  inc(nrz);
                  z[nrz]:=t[i];
                  writeln('*',t[i].x,' ',t[i].y);
               end
          end;
  end;

procedure sortare1;
var t1:longint;
    aux:punct;
begin
   t1:=nrw-1;
   ok:=true;
   while ok=true do
      begin
         ok:=false;
         for i:=1 to t1 do
            begin
               if w[i].y>w[i+1].y then
                  begin
                     aux:=w[i];
                     w[i]:=w[i+1];
                     w[i+1]:=aux;
                     ok:=false;
                  end;
            end;
      end;
end;

procedure sortare2;
var t1:longint;
aux:punct;
begin
t1:=nrz-1;
ok:=true;
while ok=true do
begin
ok:=false;
for i:=1 to t1 do
   begin
   if z[i].y<z[i+1].y then
   begin
   aux:=z[i];
   z[i]:=z[i+1];
   z[i+1]:=aux;
   ok:=false;
   end;
   end;
end;
end;
begin
assign(f,fi);
reset(f);
assign(g,fo);
rewrite(g);
read(f,n);
for i:=1 to n do
readln(f,p[i].x,p[i].y);
nr1:=0;
nrf:=0;  //nr de pct din t
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
                          begin



                              viz[u]:=1;

                          end;
   end;
   for i:=1 to n do
     if viz[i]=0 then
     inc(nr1);
   writeln(g,nr1);
   min.x:=maxlongint;
   min.y:=maxlongint;
   max.x:=-maxlongint;
   max.y:=-maxlongint;
for i:=n downto 1 do
   if viz[i]=0 then
      begin
         inc(nrf);
         t[nrf]:=p[i];
         if t[nrf].y<min.y then
            begin
               min:=t[nrf];
               pmin:=nrf;
            end
         else
            if (t[nrf].y=min.y)and(t[nrf].x<min.x) then
               begin
                  min:=t[nrf];
                  pmin:=nrf;
               end;
         if t[nrf].y>max.y then
            begin
               max:=t[nrf];
               pmax:=nrf;
            end
         else
            if (t[nrf].y=max.y)and(t[nrf].x>max.x) then
               begin
                  max:=t[nrf];
                  pmax:=nrf;
               end;

      end;
   detmultimi;
   sortare1;
   sortare2;
   writeln(g,min.x:0:6,' ',min.y:0:6);
   for i:=1 to nrw do
   writeln(g,w[i].x:0:6,' ',w[i].y:0:6);
   for i:=1 to nrz-1 do
   writeln(g,z[i].x:0:6,' ',z[i].y:0:6);
   {sort1(1,nrw);
   sort2(1,nrz);   }
   close(f);
   close(g);
end.