Cod sursa(job #401803)

Utilizator hungntnktpHungntnktp hungntnktp Data 23 februarie 2010 09:30:55
Problema Gropi Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.13 kb
uses
  math;
const
  tfi = 'gropi.in';
  tfo = 'gropi.out';
  maxn  = 100001;
  maxc  = 2000000000000;
var
  fi,fo : text;
  n,c,m,kq : longint;
  x,y : array[0..maxn] of longint;
  f : array[0..maxn,1..2] of int64;
{-----}
procedure nhap;
var
  i : longint;
begin
  readln(fi,c,n);
  for i := 1 to n do read(fi,x[i],y[i]);
  read(fi,m);
end;
{-----}
procedure Doi(var x,y : longint);
var
  tg  : longint;
begin
  tg := x;
  x := y;
  y := tg;
end;
{-----}
procedure Qsort(l,r : longint);
var
  i,j,k : longint;
begin
  if l >= r then exit;
  i := l; j := r; k := y[(l+r) div 2];
  repeat
    while y[i] < k do inc(i);
    while y[j] > k do dec(j);
    if i <= j then
      begin
        if i < j then
          begin
            Doi(x[i],x[j]);
            Doi(y[i],y[j]);
          end;
        inc(i); dec(j);
      end;
  until i > j;
  Qsort(l,j); Qsort(i,r);
end;
{-----}
procedure ktao;
begin
  Qsort(1,n);
  fillchar(f,sizeof(f),0);
end;
{-----}
procedure xuly;
var
  i : longint;
begin
  if x[1] = 1 then
    begin
      f[1][1] := maxc;
      f[1][2] := 0;
    end
  else
    begin
      f[1][1] := 0;
      f[1][2] := maxc;
    end;

  for i := 2 to n do
    if x[i] = 1 then
      begin
        f[i][1] := maxc;
        f[i][2] := min(f[i-1][1] + 1, f[i-1][2]) + abs(y[i]-y[i-1]);
      end
    else
      begin
        f[i][2] := maxc;
        f[i][1] := min(f[i-1][2] + 1, f[i-1][1]) + abs(y[i]-y[i-1]);
      end;
end;
{-----}
function Tim1(xx : longint) : longint;
var
  l,r,mid : longint;
begin
  l := 1; r := n;
  Tim1 := n + 1;
  while l <= r do
  begin
    mid := ( l + r ) div 2;
    if y[mid] < xx then l := mid + 1
    else
    begin
      r := mid - 1;
      if mid < Tim1 then Tim1 := mid;
    end;
  end;
end;
{-----}
function Tim2(xx : longint) : longint;
var
  l,r,mid : longint;
begin
  l := 1; r := n;
  Tim2 := 0;
  while l <= r do
  begin
    mid := (l + r) div 2;
    if y[mid] > xx then r := mid - 1
    else
    begin
      l := mid + 1;
      if mid > Tim2 then Tim2 := mid;
    end;
  end;
end;
{-----}
procedure inkq;
var
  i,j,u1,v1,u2,v2,vt1,vt2 : longint;
begin
  for i := 1 to m do
    begin
      read(fi,u1,v1,u2,v2);
      if v2 < v1 then
        begin
          Doi(u1,u2);
          Doi(v1,v2);
        end;

      vt1 := tim1(v1);
      vt2 := tim2(v2);

      if vt1 > vt2 then kq := abs(v1-v2) + abs(u1-u2)
      else
        if x[vt1] = 2 then
          begin
            if x[vt2] = 2 then kq := u1 - 1 + y[vt1] - v1 + f[vt2][1] - f[vt1][1] + u2 - 1 - y[vt2] + v2
            else kq := u1 - 1 + y[vt1] - v1 + f[vt2][2] - f[vt1][1] + 2 - u2 - y[vt2] + v2
          end
        else
          begin
            if x[vt2] = 2 then kq := 2 - u1 + y[vt1] - v1 + f[vt2][1] - f[vt1][2] + u2 - 1 - y[vt2] + v2
            else kq := 2 - u1 + y[vt1] - v1 + f[vt2][2] - f[vt1][2] + 2 - u2 - y[vt2] + v2
          end;
      writeln(fo,kq+1);
    end;
end;
{-----}
BEGIN
  assign(fi,tfi); reset(fi);
  assign(fo,tfo); rewrite(fo);
    nhap;
    ktao;
    xuly;
    inkq;
  close(fo);
  close(fi);
END.