Cod sursa(job #460958)

Utilizator lianaliana tucar liana Data 4 iunie 2010 20:32:52
Problema Infasuratoare convexa Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 2.23 kb
program infasuratoare_convexa;
type punct=record
  x, y:real;
end;
var f, g:text;
    n, sf:longint;
    minx, miny:real;
    v:array[1..120000] of punct;
    st:array[1..120000] of punct;

procedure citire;
var i:longint;
  begin
    readln(f,n);
    for i:=1 to n do
      begin
        read(f,v[i].x,v[i].y);
        if (v[i].x=minx) and (v[i].y<miny) then
          miny:=v[i].y;
        if v[i].x<minx then
          begin
            minx:=v[i].x;
            miny:=v[i].y;
          end;
      end;
  end;

function panta(p:punct):real;
  begin
    if minx<>p.x then
      panta:=(miny-p.y)/(minx-p.x)
     else
       panta:=maxlongint;
     if (miny=p.y) and (minx=p.x) then
       panta:=-maxlongint;
  end;

function pozitionare(i,j:longint):longint;
var x:real;
    pct:punct;
  begin
    x:=panta(v[i]);
    pct:=v[i];
    while i<j do
      begin
        while (panta(v[j])>=x) and (j>i) do
          j:=j-1;
        v[i]:=v[j];
        while (panta(v[i])<=x) and (i<j) do
          i:=i+1;
        v[j]:=v[i];
      end;
    v[i]:=pct;
    pozitionare:=i;
  end;

procedure Qsort(st, dr:longint);
var m:longint;
  begin
    m:=pozitionare(st,dr);
    if st<m-1 then
      Qsort(st,m-1);
    if m+1<dr then
      Qsort(m+1,dr);
  end;

function unghi_mai_mare_ca_180(a,b,c:punct):boolean;
var la, lb, lc:real;
  begin
{   la:=a.y-b.x;}
   la:=b.y-a.y;
{   lb:=b.x-a.x;}
   lb:=a.x-b.x;
{   lc:=b.x*a.y-b.y*a.x;}
   lc:=b.x*a.y-b.y*a.x;
   if la*c.x+lb*c.y+lc<0{(la*c.x+lb*c.y<0)} then
     unghi_mai_mare_ca_180:=true
    else
      unghi_mai_mare_ca_180:=false;
  end;

procedure rezolvare;
var i:longint;
  begin
    st[1]:=v[1];
    sf:=1;
    for i:=2 to n do
      begin
        while (unghi_mai_mare_ca_180(st[sf],st[sf-1],v[i])) and (sf>=2) do
          sf:=sf-1;
        sf:=sf+1;
        st[sf]:=v[i];
      end;
  end;

procedure afisare;
var i:longint;
  begin
    writeln(g,sf);
    for i:=1 to sf do
      writeln(g,st[i].x:0:6,' ',st[i].y:0:6);
  end;

  begin
    assign(f,'infasuratoare.in'); reset(f);
    assign(g,'infasuratoare.out'); rewrite(g);
    citire;
    Qsort(1,n);
    rezolvare;
    afisare;
    close(f);
    close(g);
  end.