Cod sursa(job #599702)

Utilizator Luncasu_VictorVictor Luncasu Luncasu_Victor Data 29 iunie 2011 14:30:48
Problema Infasuratoare convexa Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 3.59 kb
const   fin = 'infasuratoare.in'; fout = 'infasuratoare.out';

type
        punct = record x, y : double; end;
        multime = array[1..120 * 1000] of punct;
var
        s ,ssup ,sinf : multime;
        n ,nsup ,ninf : longword;

function semn( a , b , c : punct ) : double;
begin
        semn := 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
        imin, imax ,i : longword;
begin
        imin := 1; imax := 1;
        for i := 1 to n do
        begin
                if (s[i].x < s[imin].x) then imin := i else
                if (s[i].x > s[imax].x) then imax := i;
        end;
        nsup := 1; ninf := 1;
        ssup[1] := s[imin];
        sinf[1] := s[imin];
        for i := 1 to n do
        if not (i in [imin,imax]) then
        begin
                if semn( s[imin], s[imax], s[i] ) > 0 then
                begin
                        nsup := nsup + 1;
                        ssup[nsup] := s[i];
                end else
                begin
                        ninf := ninf + 1;
                        sinf[ninf] := s[i];
                end;
        end;
        nsup := nsup + 1; ninf := ninf + 1;
        ssup[nsup] := s[imax];
        sinf[ninf] := s[imax];
end;

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

procedure quicksort(var s : multime; st, dr : longword );
var
        i ,j : longword;
        m : double;
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( s , i , dr );
        if (j > st) then quicksort( s , st , j );
end;

procedure convex();
var
        i : longword;
begin
        i := 3;
        n := 3;
        while (i < nsup) do
        begin
                while (n > 2) and (semn( ssup[n - 2], ssup[n - 1], ssup[n]) > 0) do
                begin
                        ssup[n - 1] := ssup[n];
                        n := n - 1;
                end;
                n := n + 1;
                i := i + 1;
                ssup[n] := ssup[i];
        end;
        nsup := n;
        i := 3;
        n := 3;
        while (i < ninf) do
        begin
                while (n > 2) and (semn( sinf[n - 2], sinf[n - 1], sinf[n]) < 0) do
                begin
                        sinf[n - 1] := sinf[n];
                        n := n - 1;
                end;
                n := n + 1;
                i := i + 1;
                sinf[n] := sinf[i];
        end;
        ninf := n;
end;


procedure main();
var
        i : 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 );

        submultimi();

        quicksort( ssup , 2 , nsup - 1 );

        quicksort( sinf , 2 , ninf - 1 );

        convex();

        write( nsup + ninf - 2 , #10 );
        write( ssup[1].x : 0 : 6 ,#32, ssup[1].y : 0 : 6 , #10 );
        for i := 2 to nsup do write( ssup[i].x : 0 : 6 ,#32, ssup[i].y : 0 : 6, #10 );
        for i := ninf - 1 downto 2 do write( sinf[i].x : 0 : 6 ,#32, sinf[i].y : 0 : 6, #10);
end;

begin
        main();
end.