Question

骑士巡游问题 pascal 急！！！

【题目描述】

所谓骑士巡游问题，是指在n×n方格（n<=10）的国际象棋棋盘上，从任意指定的方格（x,y）出发，为马（也称骑士knight，马走“日”字）寻找一条走遍棋盘每一方格并且只经过一次的一条路径。

【输入格式】仅一行包含3个正整数N 、X、Y。

【输出格式】符合总巡游的路径一共有多少条

【样例输入】（fact.in）

5 1 1

【样例输出】(fact.out)

304

Answer 1

楼上的程序太麻烦，效率低

【骑士游历问题】
设有一个m×n的棋盘(2≤m≤50,2≤n≤50)，在棋盘上任一点有一个中国象棋“马”，马走的规则为：马走日字；马只能向右走。当m,n给出后，同时给出马起始的位置和终点的位置，试找出从起点到终点所有路径的数目。
输入：
m,n,x1,y1,x2,y2 (分别表示m,n、起点坐标和终点坐标)
输出：
路径数目（若不存在，则输出0）
【分析】
本题可以使用深度搜索发求解，但是效率很低，当路径很多时，不可能在短时间内出解。可以采用动态规划的设计思想。（专为楼下设计）
从（x1,y1）位置出发，按照由左到右的顺序定义阶段的方向。位于（x2,y2）的左方且可达（x2,y2）的跳马位置集合都是（x2,y2）的子问题，起点至（x2,y2）的路径数实际上等于起点至这些位置集的路径数之和。可以按照阶段的顺序依次计算每一个阶段每个点的路径数目。
阶段i：中国象棋马当前的列位置（x1≤i≤x2）
状态j：中国象棋马在i列的行位置（1≤i≤m）
状态转移方程map[i,j]：起点（x1,y1）至（i,j）的路径数目

附标程：

const
maxm=50;
maxn=50;
var
m,n,x1,y1,x2,y2:integer;
i,j,k,x,y:integer;
map:array[-2..maxm+2,-2..maxn+2] of extended;
begin
fillchar(map,sizeof(map),0);
readln(m,n,x1,y1,x2,y2);
map[x1,y1]:=1;
for i:=x1+1 to x2 do
for j:=1 to m do
map[i,j]:=map[i-1,j-2]+map[i-1,j+2]+map[i-2,j-1]+map[i-2,j+1];
writeln(map[x2,y2]:0:0);
end.

搜索比较慢，有代码如下：
program p7_1;
const dx:array[1..8] of integer=(1,-1,-2,-2,-1,1,2,2);
dy:array[1..8] of integer=(2,2,-1,-1,-2,-2,-1,1);
var board:array[-1..7,-1..7] of integer;
t,i,j,a,b:integer;
procedure search(t,x,y:integer);
var p,m,n:integer;
begin

if t=26 then begin
for m:=1 to 5 do begin
for n:=1 to 5 do write(board[m,n]:3);
writeln;
end;
t:=-1;
halt
end;

if board[x,y]=0 then begin
board[x,y]:=t;inc(t);
for p:=1 to 8 do search(t,x+dx[p],y+dy[p]);
board[x,y]:=0;
end;

end;

begin
t:=1;
for i:=-1 to 7 do
for j:=-1 to 7 do board[i,j]:=-1;
for a:=1 to 5 do
for b:=1 to 5 do board[a,b]:=0;
search(t,1,1);
if t<>-1 then write('Wrong!');
end.

Answer 2

const maxsize=10;
dx:array [1..8] of integer=(1,2,-1,-2,-2,-1,1,2);
dy:array [1..8] of integer=(2,1,2,1,-1,-2,-2,-1);
var i,j,n,x,y:integer;
board:array [-1..maxsize+2,-1..maxsize+2] of integer;
procedure print;
var i,j:integer;
begin
for i:=1 to n do
begin
for j:=1 to n do
if board[i,j]=0 then write(n*n:3) else write(board[i,j]:3);
writeln
end;
close(input);
close(output);
halt
end;
procedure search(dep,x,y:longint);
var i:longint;
begin
if dep=n*n then print
else for i:=1 to 8 do
if board[x+dx[i],y+dy[i]]=0 then
begin
board[x+dx[i],y+dy[i]]:=dep+1;
search(dep+1,x+dx[i],y+dy[i]);
board[x+dx[i],y+dy[i]]:=0
end
end;
begin
assign(input,'fact.in');reset(input);
assign(output,'fact.out');rewrite(output);
readln(n);readln(x,y);
for i:=-1 to n+2 do
for j:=-1 to n+2 do
board[i,j]:=-1;
for i:=1 to n do
for j:=1 to n do
board[i,j]:=0;
board[x,y]:=1;
search(1,x,y) ;
writeln('no solution')
end.