Online Judge | Problem Set | Authors | Online Contests | User | ||||||
---|---|---|---|---|---|---|---|---|---|---|
Web Board Home Page F.A.Qs Statistical Charts | Current Contest Past Contests Scheduled Contests Award Contest |
Re:谁能发份标程?In Reply To:谁能发份标程? Posted by:linusc at 2010-04-14 17:31:40 200ms {$inline on} const qsize=1 shl 18; di:array [0..4,0..1] of integer=((0,0),(1,0),(-1,0),(0,-1),(0,1)); type bty=array [1..3,0..1] of word; bta=dword; var map:array [1..16,1..16] of char; dt:array [0..qsize] of bta; dis:array [0..16777215] of integer; i,j,w,h,n,basval:integer; a,b,fr,ti:bty; ans:integer; f,r:longint; procedure encode(var x:dword); begin x:=0; x:=(b[1][0]-1)or((b[1][1]-1) shl 4); x:=x or ((b[2][0]-1)or((b[2][1]-1) shl 4)) shl 8; x:=x or ((b[3][0]-1)or((b[3][1]-1) shl 4)) shl 16; end; procedure decode(x:dword); begin a[1][0]:=x and $f+1; a[1][1]:=(x and $f0) shr 4+1; a[2][0]:=(x and $f00) shr 8+1; a[2][1]:=(x and $f000) shr 12+1; a[3][0]:=(x and $f0000) shr 16+1; a[3][1]:=(x and $f00000) shr 20+1; end; function valid(i:integer):boolean;inline; begin valid:=(b[i][0]>0)and(b[i][0]<=h) and(b[i][1]>0)and(b[i][1]<=w) and(map[b[i][0]][b[i][1]]<>'#'); end; function same(i,j:integer):boolean;inline; begin same:=(b[i][0]=b[j][0])and(b[i][1]=b[j][1]); end; function exchanged(i,j:integer):boolean;inline; begin exchanged:=(a[i][0]=b[j][0])and(a[i][1]=b[j][1]) and(a[j][0]=b[i][0])and(a[j][1]=b[i][1]); end; procedure push(x:bta;d:integer); begin dt[r]:=x; r:=(r+1)and(qsize-1); dis[x]:=d; end; function bfs:integer; var i1,i2,i3,e1,e2,e3:integer; x,y:bta; begin f:=1;r:=1; b:=fr;encode(x); push(x,basval+1); b:=ti;encode(x); push(x,-basval-1); e1:=4;e2:=4;e3:=4; if n<3 then e3:=0; if n<2 then e2:=0; while (f<>r) do begin x:=dt[f];f:=(f+1)and(qsize-1); decode(x); if dis[x]>0 then begin for i1:=0 to e1 do begin b[1][0]:=a[1][0]+di[i1][0]; b[1][1]:=a[1][1]+di[i1][1]; if not valid(1) then continue; for i2:=0 to e2 do begin b[2][0]:=a[2][0]+di[i2][0]; b[2][1]:=a[2][1]+di[i2][1]; if (n>1) and (not valid(2) or same(1,2) or exchanged(1,2)) then continue; for i3:=0 to e3 do begin b[3][0]:=a[3][0]+di[i3][0]; b[3][1]:=a[3][1]+di[i3][1]; if (n>2) and (not valid(3) or same(1,3) or exchanged(1,3) or same(2,3) or exchanged(2,3)) then continue; encode(y); if dis[y]>basval then continue; if dis[y]<-basval then begin bfs:=(dis[x]-dis[y]-1-2*basval); inc(basval,1000); exit; end else push(y,dis[x]+1); end; end; end; end else begin for i1:=0 to e1 do begin b[1][0]:=a[1][0]+di[i1][0]; b[1][1]:=a[1][1]+di[i1][1]; if not valid(1) then continue; for i2:=0 to e2 do begin b[2][0]:=a[2][0]+di[i2][0]; b[2][1]:=a[2][1]+di[i2][1]; if (n>1) and (not valid(2) or same(1,2) or exchanged(1,2)) then continue; for i3:=0 to e3 do begin b[3][0]:=a[3][0]+di[i3][0]; b[3][1]:=a[3][1]+di[i3][1]; if (n>2) and (not valid(3) or same(1,3) or exchanged(1,3) or same(2,3) or exchanged(2,3)) then continue; encode(y); if dis[y]<-basval then continue; if dis[y]>basval then begin bfs:=(dis[y]-dis[x]-1-2*basval); inc(basval,1000); exit; end else push(y,dis[x]-1); end; end; end; end; end; exit(-1); end; begin basval:=0; readln(w,h,n); while (w<>0)and(h<>0)and(n<>0) do begin for i:=1 to h do begin for j:=1 to w do begin read(map[i][j]); case map[i][j] of 'a':begin fr[1][0]:=i;fr[1][1]:=j; end; 'b':begin fr[2][0]:=i;fr[2][1]:=j; end; 'c':begin fr[3][0]:=i;fr[3][1]:=j; end; 'A':begin ti[1][0]:=i;ti[1][1]:=j; end; 'B':begin ti[2][0]:=i;ti[2][1]:=j; end; 'C':begin ti[3][0]:=i;ti[3][1]:=j; end; end; end; readln; end; for i:=n+1 to 3 do begin fr[i][0]:=1;fr[i][1]:=1;ti[i][0]:=1;ti[i][1]:=1; end; ans:=bfs; writeln(ans); readln(w,h,n); end; end. Followed by:
Post your reply here: |
All Rights Reserved 2003-2013 Ying Fuchen,Xu Pengcheng,Xie Di
Any problem, Please Contact Administrator