Cod sursa(job #599987)

Utilizator cont_de_testeCont Teste cont_de_teste Data 30 iunie 2011 11:27:09
Problema Infasuratoare convexa Scor 90
Compilator fpc Status done
Runda Arhiva educationala Marime 3.51 kb
const   fin = 'infasuratoare.in'; fout = 'infasuratoare.out'; eps = 1e-12;

type
        punct = record x, y : extended; end;
        multime = array[1..120 * 1000] of punct;
var
        s ,ssus ,sjos : multime;
        n ,nsus ,njos : longword;

function semn( a , b , c : punct ) : extended;
begin
        semn := eps + a.x * b.y + b.x * c.y + c.x * a.y
                - b.y * c.x - c.y * a.x - a.y * b.x;
end;

procedure submultimi();
var
        i : longword;
begin
        nsus := 1; njos := 1;
        ssus[1] := s[1]; sjos[1] := s[1];
        for i := 2 to n - 1 do
        if (semn( s[1], s[n], s[i] ) > 0) then
        begin
                nsus := nsus + 1;
                ssus[nsus] := s[i];
        end else
        begin
                njos := njos + 1;
                sjos[njos] := s[i];
        end;
        nsus := nsus + 1; njos := njos + 1;
        ssus[nsus] := s[n]; sjos[njos] := s[n];
end;

function mic (a, b : extended) : boolean ;

begin
        if (a + EPS < b) then
            mic := true
        else mic := false;
end;

function not_eq (a, b : extended) : boolean ;

begin
        if (a + EPS = b) then
            not_eq := false
        else not_eq := true;
end ;

procedure swap(var a ,b : punct );
var
        c : punct;
begin
        c := a; a := b; b := c;
end;

procedure quicksort( st, dr : longword );
var
        i ,j : longword;
        m : extended;
begin
        i := st; j := dr; m := s[(i + j) div 2].x;
        while (i < j) do
        begin
                while (mic(s[i].x, m)) do i := i + 1;
                while (mic(m, s[j].x)) do j := j - 1;
                if (i <= j) then
                begin
                        swap( s[i] , s[j] );
                        i := i + 1;
                        j := j - 1;
                end;
        end;
        if (i < dr) then quicksort( i , dr );
        if (j > st) then quicksort( st , j );
end;

procedure convex();
var
        n ,i : longword;
begin
        n := 2;
        for i := 3 to nsus do
        begin
                n := n + 1;
                ssus[n] := ssus[i];
                while (n > 2) and (semn( ssus[n - 2], ssus[n - 1], ssus[n] ) >= 0) do
                begin
                        ssus[n - 1] := ssus[n];
                        n := n - 1;
                end;
        end;
        nsus := n;
        n := 2;
        for i := 3 to njos do
        begin
                n := n + 1;
                sjos[n] := sjos[i];
                while (n > 2) and (semn( sjos[n - 2], sjos[n - 1], sjos[n] ) <= 0) do
                begin
                        sjos[n - 1] := sjos[n];
                        n := n - 1;
                end;
        end;
        njos := n;

end;

procedure main();
var
        i ,p : longword;
begin
        assign( input , fin ); reset( input );
        assign( output , fout ); rewrite( output );

        readln( n );
        for i := 1 to n do readln( s[i].x , s[i].y );

        quicksort( 1, n );
        p := 1;
        for i := 2 to n - 1 do
        if (not_eq(s[i].x, s[p].x)) then
        begin
                quicksort( p , i - 1 );
                p := i;
        end;
        quicksort( p , n );

        submultimi();

        convex();

        write( nsus + njos - 2 , #10 );
        for i := 2 to njos - 1 do write( sjos[i].x:0:6, #32 ,sjos[i].y:0:6 ,#10 );
        for i := nsus downto 1 do write( ssus[i].x:0:6, #32 ,ssus[i].y:0:6 ,#10 );

end;

begin
        main();
end.