Cod sursa(job #599743)

Utilizator Luncasu_VictorVictor Luncasu Luncasu_Victor Data 29 iunie 2011 15:32:07
Problema Infasuratoare convexa Scor 90
Compilator fpc Status done
Runda Arhiva educationala Marime 3.2 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;

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 (s[i].x < m) do i := i + 1;
                while (s[j].x > m) 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 (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.