Cod sursa(job #401934)

Utilizator hungntnktpHungntnktp hungntnktp Data 23 februarie 2010 10:43:30
Problema Gropi Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.22 kb
{$M 64000000,0}
{$H-,I-,Q-,R-,S-}
{La Hoang
Ngay 23-2-2010}
const
   TFI  = 'gropi.in';
   TFO  = 'gropi.out';
   MaxN = 100000;
type
   tt = record
            x, y: longint;
        end;
var
   fi, fo: text;
   S, F: tt;
   C, n, m, Res: longint;
   T: array[1..MaxN] of tt;
   TS: array[1..MaxN] of longint;
   (*-----------------------------------*)
   procedure Input;
   var
      i: longint;
   begin
      Readln(fi, C, n);
      for i := 1 to n do
         With T[i] do
            begin
               Readln(fi, x, y);
               if x = 1 then x := 2 else x := 1;
            end;
   end;
   (*-----------------------------------*)
   procedure Swap(var i, j: tt);
   var
      tg: tt;
   begin
      tg := i; i := j; j := tg;
   end;
   (*-----------------------------------*)
   procedure Qsort(l, r: longint);
   var
      i, j, m: longint;
   begin
      i := l; j := r;
      m := T[l + random(r - l + 1)].y;
      repeat
         while T[i].y < m do inc(i);
         While T[j].y > m do dec(j);
         if i <= j then
            begin
               if i < j then Swap(T[i], T[j]);
               inc(i); dec(j);
            end;
      until i > j;
      if i < r then Qsort(i, r);
      if l < j then Qsort(l, j);
   end;
   (*-----------------------------------*)
   function Kc(u, v: tt): longint;
   begin
      exit(abs(u.y - v.y) + abs(u.x - v.x));
   end;
   (*-----------------------------------*)
   function Find1(u: tt): longint;
   var
      l, r, m: longint;
   begin
      Find1 := 0;
      l := 1; r := n;
      while l <= r do
         begin
            m := (l + r) div 2;
            if T[m].y >= u.y then
               begin
                  r := m - 1;
                  Find1 := m;
               end else l := m + 1;
         end;
   end;
   (*-----------------------------------*)
   function Find2(u: tt): longint;
   var
      l, r, m: longint;
   begin
      l := 1; r := n;
      Find2 := 0;
      while l <= r do
         begin
            m := (l + r) div 2;
            if T[m].y <= u.y then
               begin
                  l := m + 1;
                  Find2 := m;
               end else r := m - 1;
         end;
   end;
   (*-----------------------------------*)
   procedure Init;
   var
      i: longint;
   begin
      Qsort(1, n);
      TS[1] := 0;
      for i := 2 to n do
         TS[i] := TS[i - 1] + Kc(T[i], T[i - 1]);
   end;
   (*-----------------------------------*)
   procedure Process;
   var
      u, v: longint;
   begin
      if S.y > F.y then Swap(S, F);
      u := Find1(S);
      v := Find2(F);
      if (u = 0) or (T[u].y >= F.y) then Res := Kc(S, F) + 1 else
         Res := Kc(S, T[u]) + TS[v] - TS[u] + Kc(T[v], F) + 1;
   end;
   (*-----------------------------------*)
   procedure Output;
   begin
      Writeln(fo, Res);
   end;
   (*-----------------------------------*)
begin
   Assign(fi, TFI); Reset(fi);
   Assign(fo, TFO); Rewrite(fo);
   Randomize;
   Input;
   Init;
   Readln(fi, m);
   while m > 0 do
      begin
         dec(m);
         Readln(fi, S.x, S.y, F.x, F.y);
         Process;
         Output;
      end;
   Close(fo);
   Close(fi);
end.