ac1240.pas

这是在网络上搜集到的在东京大学的ACM上面解决的一些题目的源码

program tju1240;
const
  maxn=100;
  maxm=maxn*2+1;
  dx:array[1..4]of shortint=(-1,1,0,0);
  dy:array[1..4]of shortint=(0,0,-1,1);
  db:array[1..4]of shortint=(1,2,4,8);
type
  list=array[1..maxm]of word;
var
  rect:array[1..maxn]of record x,y,z:word;end;
  map:array[1..maxm,1..maxm]of byte;
  lx,ly:list;
  qx,qy:array[1..sqr(maxm)]of word;
  step:array[1..maxm,1..maxm]of word;
  n,m,i,j,a,b,c,d,f,g,r:word;
procedure qsort(var a:list;s,t:byte);
  var
    p,i,j,tmp:word;
  begin
    if s>=t then exit;
    p:=s+random(t-s+1);
    tmp:=a[p];a[p]:=a[s];
    i:=s;j:=t;
    repeat
      while (i<j) and (a[j]>=tmp) do dec(j);
      if i=j then break;a[i]:=a[j];inc(i);
      while (i<j) and (a[i]<=tmp) do inc(i);
      if i=j then break;a[j]:=a[i];dec(j);
    until i=j;
    a[i]:=tmp;
    qsort(a,s,i-1);
    qsort(a,i+1,t);
  end;
function find(var a:list;x:word):byte;//Find the min p such that a[p]>=x
  var
    l,r,p:byte;
  begin
    l:=1;r:=m;
    repeat
      p:=(l+r) shr 1;
      if a[p]=x then begin find:=p;exit;end;
      if a[p]<x then l:=p+1 else r:=p;
    until l=r;
    find:=l;
  end;
procedure floodfill;forward;
procedure go(p,s:word);
  var
    i,x0,y0,x1,y1:word;
  begin
    x0:=qx[p];y0:=qy[p];
    for i:=1 to 4 do begin
      x1:=x0+dx[i];if (x1=0) or (x1>m) then continue;
      y1:=y0+dy[i];if (y1=0) or (y1>m) then continue;
      if (ord(map[x0,y0] and db[i]>0)=s) and (step[x1,y1]=65535) then begin
        inc(r);qx[r]:=x1;qy[r]:=y1;step[x1,y1]:=step[x0,y0]+s;
        if s=1 then floodfill;
        if step[c,d]<65535 then exit;
      end;
    end;
  end;
procedure floodfill;
  var
    p:word;
  begin
    p:=r-1;
    repeat
      inc(p);
      go(p,0);
    until (p=r) or (step[c,d]<65535);
  end;
begin
  repeat
    read(n);m:=n*2+1;
    for i:=1 to n do
      with rect[i] do begin
        read(x,y,z);
        lx[i*2-1]:=x;lx[i*2]:=x+z;
        ly[i*2-1]:=y;ly[i*2]:=y+z;
      end;
    qsort(lx,1,n*2);
    qsort(ly,1,n*2);
    lx[m]:=maxint;ly[m]:=maxint;

    fillchar(map,sizeof(map),0);
    for i:=1 to n do begin
      with rect[i] do begin
        a:=find(lx,x);b:=find(lx,x+z);
        c:=find(ly,y);d:=find(ly,y+z);
      end;
      for j:=a+1 to b do begin
        inc(map[j,c],db[4]);inc(map[j,c+1],db[3]);
        inc(map[j,d],db[4]);inc(map[j,d+1],db[3]);
      end;
      for j:=c+1 to d do begin
        inc(map[a,j],db[2]);inc(map[a+1,j],db[1]);
        inc(map[b,j],db[2]);inc(map[b+1,j],db[1]);
      end;
    end;

    read(a,b,c,d);
    a:=find(lx,a);b:=find(ly,b);c:=find(lx,c);d:=find(ly,d);
    if (a=c) and (b=d) then begin writeln(0);continue;end;
    fillchar(step,sizeof(step),255);
    f:=0;r:=1;qx[1]:=a;qy[1]:=b;step[a,b]:=0;floodfill;
    while step[c,d]=65535 do begin
      inc(f);
      go(f,1);
    end;
    writeln(step[c,d]);
  until seekeof;
end.