MRECT1 - Điểm trên cạnh hình chữ nhật - HRASTOVI

Tác giả: flashmt

Ngôn ngữ: Pascal

const fi='';
      fo='';
      maxn=300300;
      maxm=200200;
      oo=1000000000;
type ar1=array[1..maxn] of longint;
     ar2=array[1..maxm] of longint;
var num,numy,n,m:longint;
    x,y:ar1;
    a,b,re:ar2;

procedure rf;
var i:longint;
begin
     read(n);
     for i:=1 to n do read(x[i],y[i]);
     read(m);
     for i:=1 to m do read(a[i*2],b[i*2],a[i*2+1],b[i*2+1]);
end;

procedure sort(l,r:longint);
var i,j,p,q,t:longint;
begin
     i:=l; j:=r; p:=x[(i+j) shr 1]; q:=y[(i+j) shr 1];
     repeat
           while (x[i]<p) or ((x[i]=p) and (y[i]<q)) do i:=i+1;
           while (x[j]>p) or ((x[j]=p) and (y[j]>q)) do j:=j-1;
           if i<=j then
           begin
                t:=x[i]; x[i]:=x[j]; x[j]:=t;
                t:=y[i]; y[i]:=y[j]; y[j]:=t;
                i:=i+1; j:=j-1;
           end;
     until i>j;
     if i<r then sort(i,r);
     if l<j then sort(l,j);
end;

procedure sortt(l,r:longint);
var i,j,p,q,t:longint;
begin
     i:=l; j:=r; p:=y[(i+j) shr 1]; q:=x[(i+j) shr 1];
     repeat
           while (y[i]<p) or ((y[i]=p) and (x[i]<q)) do i:=i+1;
           while (y[j]>p) or ((y[j]=p) and (x[j]>q)) do j:=j-1;
           if i<=j then
           begin
                t:=x[i]; x[i]:=x[j]; x[j]:=t;
                t:=y[i]; y[i]:=y[j]; y[j]:=t;
                i:=i+1; j:=j-1;
           end;
     until i>j;
     if i<r then sortt(i,r);
     if l<j then sortt(l,j);
end;

function bs(xx,yy:longint):longint;
var l,r,mid,i:longint;
begin
     bs:=oo;
     l:=1; r:=n;
     while l<=r do
     begin
          mid:=(l+r) div 2;
          if (x[mid]<xx) or ((x[mid]=xx) and (y[mid]<yy)) then l:=mid+1
          else r:=mid-1;
     end;
     for i:=mid-1 to mid+1 do
         if (i>0) and (i<=n) and ((x[i]>xx) or ((x[i]=xx) and (y[i]>=yy))) then exit(i);
end;

function bss(xx,yy:longint):longint;
var l,r,mid,i:longint;
begin
     bss:=-oo;
     l:=1; r:=n;
     while l<=r do
     begin
          mid:=(l+r) div 2;
          if (x[mid]>xx) or ((x[mid]=xx) and (y[mid]>yy)) then r:=mid-1
          else l:=mid+1;
     end;
     for i:=mid+1 downto mid-1 do
         if (i>0) and (i<=n) and ((x[i]<xx) or ((x[i]=xx) and (y[i]<=yy))) then exit(i);
end;

procedure pr;
var i,p,q:longint;
begin
     for i:=1 to m do
     begin
          p:=bs(a[i*2],b[i*2]);
          q:=bss(a[i*2],b[i*2+1]);
          if q>=p then re[i]:=re[i]+q-p+1;
          p:=bs(a[i*2+1],b[i*2]);
          q:=bss(a[i*2+1],b[i*2+1]);
          if q>=p then re[i]:=re[i]+q-p+1;
     end;
end;

function bs1(xx,yy:longint):longint;
var l,r,mid,i:longint;
begin
     bs1:=oo;
     l:=1; r:=n;
     while l<=r do
     begin
          mid:=(l+r) div 2;
          if (y[mid]<yy) or ((y[mid]=yy) and (x[mid]<xx)) then l:=mid+1
          else r:=mid-1;
     end;
     for i:=mid-1 to mid+1 do
         if (i>0) and (i<=n) and ((y[i]>yy) or ((y[i]=yy) and (x[i]>=xx))) then exit(i);
end;

function bss1(xx,yy:longint):longint;
var l,r,mid,i:longint;
begin
     bss1:=-oo;
     l:=1; r:=n;
     while l<=r do
     begin
          mid:=(l+r) div 2;
          if (y[mid]>yy) or ((y[mid]=yy) and (x[mid]>xx)) then r:=mid-1
          else l:=mid+1;
     end;
     for i:=mid+1 downto mid-1 do
         if (i>0) and (i<=n) and ((y[i]<yy) or ((y[i]=yy) and (x[i]<=xx))) then exit(i);
end;

procedure prr;
var i,p,q:longint;
begin
     for i:=1 to m do
     begin
          p:=bs1(a[i*2],b[i*2]);
          q:=bss1(a[i*2+1],b[i*2]);
          if q>=p then re[i]:=re[i]+q-p+1;
          p:=bs1(a[i*2],b[i*2+1]);
          q:=bss1(a[i*2+1],b[i*2+1]);
          if q>=p then re[i]:=re[i]+q-p+1;
     end;
end;

function bsss(xx,yy:longint):boolean;
var l,r,mid:longint;
begin
     bsss:=false;
     l:=1; r:=n;
     while l<=r do
     begin
          mid:=(l+r) div 2;
          if (x[mid]=xx) and (y[mid]=yy) then exit(true);
          if (x[mid]<xx) or ((x[mid]=xx) and (y[mid]<yy)) then l:=mid+1
          else r:=mid-1;
     end;
end;

procedure minus;
var i:longint;
begin
     for i:=1 to m do
     begin
          if bsss(a[i*2],b[i*2]) then re[i]:=re[i]-1;
          if bsss(a[i*2],b[i*2+1]) then re[i]:=re[i]-1;
          if bsss(a[i*2+1],b[i*2]) then re[i]:=re[i]-1;
          if bsss(a[i*2+1],b[i*2+1]) then re[i]:=re[i]-1;
     end;
end;

procedure wf;
var i:longint;
begin
     for i:=1 to m do writeln(re[i]);
end;

begin
     assign(input,fi); reset(input);
     assign(output,fo); rewrite(output);
     rf;
     sort(1,n);
     minus;
     pr;
     sortt(1,n);
     prr;
     wf;
     close(input); close(output);
end.

Download