发信人: Lerry (想不开·撞树), 信区: Algorithm
标 题: [合集]求国际象棋骑士遍历方案的程序(zz)
发信站: 哈工大紫丁香 (2002年08月28日17:26:59 星期三), 站内信件
────────────────────────────────────────
sino (茶水) 于 2002年08月25日20:01:26 星期天 说道:
{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q-,R-,S+,T-,V+,X+,Y+}
{$M 65520,0,655360}
const l6:array[1..36,1..2] of integer
=((1,1),(2,3),(3,5),(1,6),(2,4),(3,6),(1,5),(3,4),
(4,6),(6,5),(4,4),(5,6),(6,4),(5,2),(3,1),(1,2),
(3,3),(2,5),(1,3),(2,1),(4,2),(6,1),(5,3),(4,1),
(2,2),(1,4),(2,6),(4,5),(6,6),(5,4),(6,2),(4,3),
(5,5),(6,3),(5,1),(3,2));
l8:array[1..64,1..2] of integer
=((1,1),(2,3),(3,5),(4,7),(6,6),(7,8),(8,6),(6,7),
(8,8),(7,6),(8,4),(6,5),(7,7),(8,5),(6,4),(8,3),
(7,5),(8,7),(6,8),(5,6),(4,8),(2,7),(4,6),(5,8),
(3,7),(1,8),(2,6),(4,5),(5,7),(3,8),(1,7),(2,5),
(4,4),(6,3),(7,1),(5,2),(3,3),(1,4),(2,2),(4,1),
(6,2),(8,1),(7,3),(5,4),(4,2),(2,1),(1,3),(3,4),
(1,5),(3,6),(2,8),(1,6),(2,4),(1,2),(3,1),(4,3),
(5,5),(7,4),(8,2),(6,1),(5,3),(7,2),(5,1),(3,2));
yd:array[1..2,0..3,1..2,1..2] of shortint
=((((2,-1),(2,1)),((1,2),(-1,2)),((-2,1),(-2,-1)),((-1,-2),(1,
-2))),
(((2,1),(2,-1)),((1,-2),(-1,-2)),((-2,-1),(-2,1)),((-1,2),
(1,2))));
var e:array[1..100,1..100] of integer;
n,i,j,a,b,xx,yy,step:integer;
f1,f2:text;
procedure init;
begin
assign(f1,'input.txt');
reset(f1);
assign(f2,'output.txt');
rewrite(f2);
readln(f1,n);
end;
procedure main;
procedure find(a,b,x,y,p,h:integer);
var u,v:integer;
begin
u:=x;v:=y;
repeat
inc(step);
e[u,v]:=step;
if a>1 then
case n mod 4 of
2:begin
if (u=a)and(v=a) then find(a-2,b+2,a-2,a-1,0,1);
if (u=b)and(v=a) then find(a-2,b+2,b+2,a-1,2,2);
if (u=b)and(v=b) then find(a-2,b+2,b+2,b+1,2,1);
if (u=a)and(v=b) then find(a-2,b+2,a-2,b+1,0,2);
end;
0:begin
if (u=a)and(v=a) then find(a-2,b+2,a-2,a+1,3,1);
if (u=b)and(v=a) then find(a-2,b+2,b+2,a-1,2,2);
if (u=b)and(v=b) then find(a-2,b+2,b+2,b+1,2,1);
if (u=a)and(v=b) then find(a-2,b+2,a-2,b-1,3,2);
end;
end;
xx:=u+yd[h,p,1,1];
yy:=v+yd[h,p,1,2];
if (xx>=a)and(xx<=b)and(yy>=a)and(yy<=b) then
begin u:=xx;v:=yy;end else
begin
u:=u+yd[h,p,2,1];
v:=v+yd[h,p,2,2];
end;
if ((u<a+2)or(u>b-2))and((v<a+2)or(v>b-2)) then
p:=(p+1) mod 4;
until (u=x)and(v=y);
end;
begin
if (n<5) or odd(n) then
begin
writeln(f2,-1);
close(f2);
halt;
end;
step:=0;
if n mod 4=2 then
begin
a:=(n-6) div 2+1;b:=a+5;
for i:=1 to 36 do
begin
inc(step);
e[l6[i,1]+a-1,l6[i,2]+a-1]:=step;
if a>1 then
case (l6[i,1]-1)*6+l6[i,2] of
1: find(a-2,b+2,a-2,a-1,0,1);
31: find(a-2,b+2,b+2,a-1,2,2);
36: find(a-2,b+2,b+2,b+1,2,1);
6: find(a-2,b+2,a-2,b+1,0,2);
end;
end;
end;
if n mod 4=0 then
begin
a:=(n-8) div 2+1;b:=a+7;
for i:=1 to 64 do
begin
inc(step);
e[l8[i,1]+a-1,l8[i,2]+a-1]:=step;
if a>1 then
case (l8[i,1]-1)*8+l8[i,2] of
1: find(a-2,b+2,a-2,a+1,3,1);
57: find(a-2,b+2,b+2,a-1,2,2);
64: find(a-2,b+2,b+2,b+1,2,1);
8: find(a-2,b+2,a-2,b-1,3,2);
end;
end;
end;
for i:=1 to n do
begin
for j:=1 to n do
write(f2,e[i,j]:6);
writeln(f2);
end;
close(f2);
end;
begin
init;
main;
end.
────────────────────────────────────────
Lucubrator (彻夜孤灯) 于 2002年08月25日20:09:01 星期天 说道:
大概看懂了
多谢，多谢
不过这题确实出在分治法的练习中
我也很诧异
ft!
^_^
────────────────────────────────────────
sino (茶水) 于 2002年08月25日20:20:11 星期天 说道:
呵呵
ftp://sy.hit.edu.cn/pub/AcmGroup/Papers 有一些相关论文，挺不错的 ~
────────────────────────────────────────
Lucubrator (彻夜孤灯) 于 2002年08月25日21:03:25 星期天 说道:
good
3x
────────────────────────────────────────
Lucubrator (彻夜孤灯) 于 2002年08月25日21:04:41 星期天 说道:
不过试验学院的服务器怎么总关着呀
一般什么时候开呀
────────────────────────────────────────
sino (茶水) 于 2002年08月25日21:09:31 星期天 说道:
白天，楼道里有电的时候。
阿，宿舍可能访问不了...
────────────────────────────────────────
--
※ 修改:·Lerry 於 08月28日17:31:27 修改本文·[FROM: 218.7.33.123]