Cod sursa(job #24150)

Utilizator vladcyb1Vlad Berteanu vladcyb1 Data 1 martie 2007 20:45:36
Problema Pachete Scor 70
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.79 kb

   const
         FIN = 'pachete.in';
         FOUT = 'pachete.out';
         NMAX = 50000;

   type int_array = array[0..NMAX] of longint;
   var
       X, Y : array[ 1..NMAX ] of longint;
       S : int_array;
       V : array[ 0..3 ] of int_array;
       xo, yo, N, k, xc, pivot, ans : longint;
       f, g : text;

 procedure read_data;
  var i, xc, yc : longint;
  begin
   assign( f, FIN ); reset( f );
   readln( f, N );
   readln( f, xo, yo );
   for i := 1 to N do
    begin
      readln( f, xc, yc ); xc := xc - xo; yc := yc - yo;
      X[i] := abs( xc ); Y[i] := abs( yc );
      if ( xc > 0 ) and ( yc > 0 ) then begin inc( V[0][0] ); V[ 0, V[0,0]] := i; end else
      if ( xc > 0 ) and ( yc < 0 ) then begin inc( V[1][0] ); V[ 1, V[1,0]] := i; end else
      if ( xc < 0 ) and ( yc > 0 ) then begin inc( V[2][0] ); V[ 2, V[2,0]] := i; end else
                                      begin inc( V[3][0] ); V[ 3, V[3,0]] := i; end;
    end;
    close( f );
  end;

 procedure poz( var A : int_array;  lo, hi : longint );
  var i, j, di, dj, aux : longint;
   begin
     i := lo; j := hi; di := 0; dj := - 1;
       while i < j do
         begin
          if X[A[i]] > X[A[j]] then
                                   begin
                                     aux := di; di := - dj; dj := - aux;
                                     aux := A[i]; A[i] := A[j]; A[j] := aux;
                                   end;
          i := i + di;
          j := j + dj;
          end;
     pivot := i;
  end;

  procedure quick( var A : int_array; lo, hi : longint );
   begin
     if lo < hi then
      begin
         poz( A, lo, hi );
         quick( A, lo, pivot - 1 );
         quick( A, pivot + 1, hi );
       end;
   end;

  procedure binary( lo, hi : longint );
   var juma  : longint;
    begin
     if lo = hi then
                      begin
                        if ( lo = k ) and ( S[ k ] > Xc ) then begin inc( k ); s[k] := xc; end
                                                         else s[lo] := xc;
                      end
                 else
     begin
       juma := ( lo + hi ) shr 1;
       if xc >= S[juma] then binary( lo, juma )
                       else binary( juma + 1, hi );
     end;
   end;

  procedure solve;
   var i, j : longint;
   begin
    ans := 0;
   for j := 0 to 3 do
     if V[j][0] > 0 then
      begin
       quick( V[j], 1, V[j][0] );
       k := 1; S[1] := Y[v[j][1]];
       for i := 2 to V[j][0] do
        begin
         xc := Y[ V[j][i] ];
         binary( 1, k );
        end;
        ans := ans + k;
       end
  end;

  procedure save;
   begin
    assign( g, FOUT ); rewrite( g );
    writeln( g, ans );
    close( G );
   end;

   begin
    read_data;
    solve;
    save;
   end.