http://acm.pku.edu.cn/JudgeOnline/problem?id=1098
Код:
const ddx:array[0..8] of integer=(-1,-1,-1,0,0,0,1,1,1); ddy:array[0..8] of integer=(-1,0,1,-1,0,1,-1,0,1); type arb=record x,y:integer; dead:boolean; end; ate=record x,y:integer; end; aev=record ex,ey,d:integer; end; var map,mp1,mp2:array[-1..33,-1..33] of integer; rs,brs:array[1..60] of arb; ts:array[1..30] of ate; used:array[1..30] of boolean; event:array[1..50] of aev; i,j,k,maxk,maxd,kn,mi,ti,mx,my,bmx,bmy,rn,tn,esp:integer; {wit,}won,pushed:boolean; mn:longint; procedure drawrobot; var i:integer; begin for i:=1 to rn do with rs[i] do if not dead then map[x,y]:=i; end; procedure drawrobotmove; var i,j,k:integer; begin for i:=1 to rn do with rs[i] do if not dead then for j:=pred(x) to succ(x) do for k:=pred(y) to succ(y) do if map[j,k]=0 then map[j,k]:=123; end; procedure eraserobotmove; var i,j,k:integer; begin for i:=1 to rn do with rs[i] do if not dead then for j:=pred(x) to succ(x) do for k:=pred(y) to succ(y) do if map[j,k]=123 then map[j,k]:=0; end; procedure eraserobot; var i:integer; begin for i:=1 to rn do with rs[i] do if not dead then map[x,y]:=0; end; function sgn(n:integer):integer; begin if n=0 then sgn:=0 else if n>0 then sgn:=1 else sgn:=-1; end; function rmove:integer; var i,cnt:integer; begin esp:=0; cnt:=0; eraserobot; for i:=1 to rn do with rs[i] do if not dead then begin inc(x,sgn(mx-x)); inc(y,sgn(my-y)); if map[x,y]<>0 then begin if map[x,y]>0 then begin rs[map[x,y]].dead:=true; { if wit then if i=37 then x:=x; if wit then writeln(map[x,y],' crashed with ',i); } inc(cnt); map[x,y]:=-1; inc(esp); with event[esp] do begin ex:=x; ey:=y; d:=0; end; end; dead:=true; inc(cnt); { if wit then writeln(i,' crashed on ruins'); } end else map[x,y]:=i; end; if map[mx,my]<>0 then rmove:=-1000 else rmove:=cnt; end; function mmove(d:integer):integer; var xxx,yyy,xx,yy:integer; begin drawrobot; bmx:=mx; bmy:=my; xx:=mx+ddx[d]; yy:=my+ddy[d]; pushed:=false; if map[xx,yy]>0 then mmove:=-1000 else if map[xx,yy]=0 then begin mx:=xx; my:=yy; mmove:=0; end else begin xxx:=xx+ddx[d]; yyy:=yy+ddy[d]; if map[xxx,yyy]<0 then mmove:=-1000 else begin pushed:=true; mx:=xx; my:=yy; map[xx,yy]:=0; if map[xxx,yyy]>0 then begin rs[map[xxx,yyy]].dead:=true; { if wit then writeln(map[xxx,yyy],' is killed by human'); } mmove:=1; end else mmove:=0; map[xxx,yyy]:=-1; end; end; end; procedure unmmove; begin if pushed then begin map[mx,my]:=-1; map[(mx shl 1)-bmx,(my shl 1)-bmy]:=0; end; mx:=bmx; my:=bmy; end; function testmove(d:integer;var md:integer):integer; var i,s,b:integer; begin brs:=rs; s:=mmove(d); esp:=0; if s>=0 then inc(s,rmove); if s<0 then md:=0 else begin md:=1000; for i:=1 to rn do with rs[i] do if not dead then begin b:=abs(x-mx)+abs(y-my); if md>b then md:=b; end; end; eraserobot; for i:=1 to esp do with event[i] do map[ex,ey]:=d; unmmove; rs:=brs; testmove:=s; end; { procedure drawit; begin drawrobot; for i:=1 to 31 do for j:=1 to 31 do begin if map[i,j]=-1 then k:=219 else if map[i,j]=0 then k:=46 else k:=96+map[i,j]; if (i=mx) and (j=my) then k:=2; mem[$b800:(pred(i)*160+(pred(j) shl 1))]:=k; end; asm push ax @1: in al,$60 cmp al,$1 jz @2 test al,$80 jz @1 @2: in al,$60 test al,$80 jnz @2 pop ax end; end; } begin fillchar(mp1,sizeof(mp1),0); for i:=-1 to 33 do begin mp1[-1,i]:=-1; mp1[0,i]:=-1; mp1[32,i]:=-1; mp1[33,i]:=-1; end; for i:=-1 to 33 do begin mp1[i,-1]:=-1; mp1[i,0]:=-1; mp1[i,32]:=-1; mp1[i,33]:=-1; end; ti:=0; { assign(output,'zju1065.out'); rewrite(output); assign(input,'g1.in'); reset(input); } repeat inc(ti); readln(rn,tn); if (rn=0) and (tn=0) then break; fillchar(used,sizeof(used),0); map:=mp1; mx:=15; my:=15; for i:=1 to rn do with rs[i] do begin dead:=false; readln(x,y); end; for i:=1 to tn do with ts[i] do readln(x,y); if ti<>1 then writeln; writeln('Case ',ti,':'); mn:=0; won:=true; kn:=0; while kn<rn do begin { drawit; } inc(mn); { if mn>1000000 then break; } maxk:=-1000; maxd:=1000; mi:=4; { mp2:=map; } for i:=0 to 8 do begin k:=testmove(i,j); if (maxk<k) or ((maxk=k) and (maxd<j)) then begin maxk:=k; maxd:=j; mi:=i; end; end; { map:=mp2; } if maxk<0 then begin eraserobot; drawrobotmove; for i:=1 to tn do if not used[i] then with ts[i] do if map[x,y]=0 then begin mi:=-i; break; end; eraserobotmove; end; if mi<0 then begin used[-mi]:=true; with ts[-mi] do begin mx:=x; my:=y; writeln('Move ',mn,': teleport to (',x,',',y,')'); k:=rmove; if k<0 then begin won:=false; break; end; inc(kn,k); end; end else begin if maxk>0 then inc(kn,maxk); { wit:=true; } mmove(mi); if rmove<0 then begin won:=false; break; end; { wit:=false; k:=0; for i:=1 to rn do if rs[i].dead then begin writeln('***In fact: ',i,' is dead'); inc(k); end; if k<>kn then k:=kn; } end; end; { drawit; asm push ax @1: in al,$60 cmp al,$1 jz @1 pop ax end; } if won then write('Won ') else write('Lost '); writeln('game after making ',mn,' moves.'); writeln('Final position: (',mx,',',my,')'); k:=0; for i:=1 to 31 do for j:=1 to 31 do if map[i,j]=-1 then inc(k); writeln('Number of cells with debris: ',k); if not won then begin k:=rn; for i:=1 to rn do if rs[i].dead then dec(k); writeln('Number of robots remaining: ',k); end; until false; { close(input); close(output); } end.