主题：悬赏50分
tyflovewsl
[专家分：230] 发布于 2008-11-05 17:33:00
很多世纪以前，阿瑟王和他的圆桌武士常在每年元旦聚会庆祝他们的友谊。我们用一个单人玩的棋盘游戏去纪念这个史实：一个国王和多个武士被随机放在8X8的正方形棋盘的不同方格上。只要不越出棋盘，国王可以移至与之相邻的方格内，只要不越出棋盘，武士可以跳日字，在棋局当中，选手可以在同一方格内摆放多个棋子，选手的目标是在尽可能少的步数内把所有的棋子集中到同一方格。为此，他必须按前述方法去移动棋子。此外，当国王和一个或多个武士位于同一方格内时，选手可以选择此后让国王跟随其中一个武士一同向聚会终点移动，就象移动单个武士一样。任务：写出一个程序去计算选手要实现聚会所需最少的移动次数。
输入数据：文件camelot.in包括了以字符串表示的棋盘初始状态。该字符串包含了一串最多有64个不同的棋子位置：首先是国王的位置，而随后是武士们的位置。每个位置由一对字母-数字表示：字母表示棋盘水平坐标，而数字表示棋盘垂直坐标。
输入实例：
D4A3A8H1H8
输出数据：
文件camelot.out必须包含单一的一行，以一个正整数表示选手要实现聚会所需最少的移动次数。
输出实例：
10
回复列表 （共3个回复）
沙发
tyflovewsl [专家分：230] 发布于 2008-11-05 17:38:00
我是初学者，各位大侠帮个忙啊
板凳
@左思@ [专家分：110] 发布于 2008-11-10 18:37:00
const
go:array[1..8,1..2]of -2..2=((1,-2),(-2,1),(-1,2),(2,-1),(-1,-2),(-2,-1),(1,2),(2,1));
type
ts=record
x,y:byte;
end;
var
pair:array[1..8,1..8]of byte;
dis:array[1..8,1..8,1..8,1..8]of byte;
all:array[1..8,1..8]of integer;
s:array[1..64]of ts;
king:ts;
k_num,i:integer;
best:integer;
procedure init;
var
ss:string;
ch:char;
no:byte;
begin
assign(input,'input.txt');
reset(input);
{ read(ch);
king.y:=ord(ch)-64;
read(ch);
king.x:=ord(ch)-48;
k_num:=0;
while not eof do begin
inc(k_num);
read(ch);
s[k_num].y:=ord(ch)-64;
read(ch);
s[k_num].x:=ord(ch)-48;
end; }
readln(ss);
king.x:=ord(ss[1])-64;
king.y:=ord(ss[2])-48;
//for i:=3 to length(ss) do
i:=2;
while i<length(ss) do
begin
inc(k_num);
inc(i);
s[k_num].x:=ord(ss[i])-64;
inc(i);
s[k_num].y:=ord(ss[i])-48;
end;
close(input);
end;
//
procedure bfs(s1,s2:byte);
var
stack:array[1..70,1..2]of byte;
s,t,i:byte;
x,y:integer;
begin
fillchar(stack,sizeof(stack),0);
s:=0;
t:=1;
stack[1,1]:=s1;
stack[1,2]:=s2;
repeat
inc(s);
for i:=1 to 8 do
begin
x:=stack[s,1]+go[i,1];
y:=stack[s,2]+go[i,2];
if (x>=1)and(x<=8)and(y>=1)and(y<=8) and(not((x=s1)and(y=s2)))and(dis[s1,s2,x,y]=0)
then begin
dis[s1,s2,x,y]:=dis[s1,s2,stack[s,1],stack[s,2]]+1;
inc(t);
stack[t,1]:=x;
stack[t,2]:=y;
end;
end;
until s=t;
end;
// end;
procedure get_dis;
var
i,j,k:byte;
begin
for i:=1 to 8 do
for j:=1 to 8 do
begin
bfs(i,j);
for k:=1 to k_num do inc(all[i,j],dis[i,j,s[k].x,s[k].y]);
end;
end;
{procedure get_dis;
var
i,j,ii,jj,k1,k2,min:integer;
begin
for i:=1 to 8 do
for j:=1 to 8 do
begin
for ii:=1 to 8 do
for jj:=1 to 8 do
begin
for k1:=1 to 8 do
for k2:=1 to 8 do
begin
min:=
end;
end;}
//
procedure get_ans;
var
i,j,k:byte;
ii,jj:byte;
min,now:integer;
begin
best:=maxint;
for i:=1to 8 do
for j:=1 to 8 do
begin
min:=all[i,j]+abs(king.x-i)+abs(king.y-j);
for ii:=1 to 8 do
for jj:=1 to 8 do
begin
for k:=1 to k_num do
begin
now:=all[i,j]-dis[s[k].x,s[k].y,i,j]+dis[s[k].x,s[k].y,ii,jj]
+abs(king.x-ii)+abs(king.y-jj)+dis[ii,jj,i,j];
if now<min then min:=now;
end;
end;
if min<best then best:=min;
end;
end;
procedure outs;
begin
assign(output,'output.txt');
rewrite(output);
writeln(best);
close(output);
end;
begin
init;
get_dis;
get_ans;
outs;
{i:=3;
while i<8 do
begin
inc(i);
writeln(i);
end;}
{i:=3;
repeat
inc(i);
writeln(i);
until i>8; }
end.
3 楼
kuailedale [专家分：210] 发布于 2008-11-10 18:38:00
const
go:array[1..8,1..2]of -2..2=((1,-2),(-2,1),(-1,2),(2,-1),(-1,-2),(-2,-1),(1,2),(2,1));
type
ts=record
x,y:byte;
end;
var
pair:array[1..8,1..8]of byte;
dis:array[1..8,1..8,1..8,1..8]of byte;
all:array[1..8,1..8]of integer;
s:array[1..64]of ts;
king:ts;
k_num,i:integer;
best:integer;
procedure init;
var
ss:string;
ch:char;
no:byte;
begin
assign(input,'input.txt');
reset(input);
{ read(ch);
king.y:=ord(ch)-64;
read(ch);
king.x:=ord(ch)-48;
k_num:=0;
while not eof do begin
inc(k_num);
read(ch);
s[k_num].y:=ord(ch)-64;
read(ch);
s[k_num].x:=ord(ch)-48;
end; }
readln(ss);
king.x:=ord(ss[1])-64;
king.y:=ord(ss[2])-48;
//for i:=3 to length(ss) do
i:=2;
while i<length(ss) do
begin
inc(k_num);
inc(i);
s[k_num].x:=ord(ss[i])-64;
inc(i);
s[k_num].y:=ord(ss[i])-48;
end;
close(input);
end;
//
procedure bfs(s1,s2:byte);
var
stack:array[1..70,1..2]of byte;
s,t,i:byte;
x,y:integer;
begin
fillchar(stack,sizeof(stack),0);
s:=0;
t:=1;
stack[1,1]:=s1;
stack[1,2]:=s2;
repeat
inc(s);
for i:=1 to 8 do
begin
x:=stack[s,1]+go[i,1];
y:=stack[s,2]+go[i,2];
if (x>=1)and(x<=8)and(y>=1)and(y<=8) and(not((x=s1)and(y=s2)))and(dis[s1,s2,x,y]=0)
then begin
dis[s1,s2,x,y]:=dis[s1,s2,stack[s,1],stack[s,2]]+1;
inc(t);
stack[t,1]:=x;
stack[t,2]:=y;
end;
end;
until s=t;
end;
// end;
procedure get_dis;
var
i,j,k:byte;
begin
for i:=1 to 8 do
for j:=1 to 8 do
begin
bfs(i,j);
for k:=1 to k_num do inc(all[i,j],dis[i,j,s[k].x,s[k].y]);
end;
end;
{procedure get_dis;
var
i,j,ii,jj,k1,k2,min:integer;
begin
for i:=1 to 8 do
for j:=1 to 8 do
begin
for ii:=1 to 8 do
for jj:=1 to 8 do
begin
for k1:=1 to 8 do
for k2:=1 to 8 do
begin
min:=
end;
end;}
//
procedure get_ans;
var
i,j,k:byte;
ii,jj:byte;
min,now:integer;
begin
best:=maxint;
for i:=1to 8 do
for j:=1 to 8 do
begin
min:=all[i,j]+abs(king.x-i)+abs(king.y-j);
for ii:=1 to 8 do
for jj:=1 to 8 do
begin
for k:=1 to k_num do
begin
now:=all[i,j]-dis[s[k].x,s[k].y,i,j]+dis[s[k].x,s[k].y,ii,jj]
+abs(king.x-ii)+abs(king.y-jj)+dis[ii,jj,i,j];
if now<min then min:=now;
end;
end;
if min<best then best:=min;
end;
end;
procedure outs;
begin
assign(output,'output.txt');
rewrite(output);
writeln(best);
close(output);
end;
begin
init;
get_dis;
get_ans;
outs;
{i:=3;
while i<8 do
begin
inc(i);
writeln(i);
end;}
{i:=3;
repeat
inc(i);
writeln(i);
until i>8; }
end.
我来回复
您所在位置：