end;
function nrep(k:integer):boolean; var
i,x,y:integer; f:boolean; begin
nrep:=false;
for i:=1 to k-1 do begin f:=true;
for x:=1 to 3 do for y:=1 to 3 do
if a[i,x,y]<>a[k,x,y] then begin f:=false;break;break;end; if f then exit; end;
nrep:=true; end;
procedure step(k:integer); var
i,x,y:integer; begin
if k>=20 then exit;
if result(k) then begin print(k);exit;end; look(k,x,y); for i:=1 to 4 do begin
if (x+rl[i,1]>=1)and(x+rl[i,1]<=3)and(y+rl[i,2]<=3)and(y+rl[i,2]>=1)then begin
a[k+1]:=a[k];
a[k+1,x+rl[i,1],y+rl[i,2]]:=a[k,x,y]; a[k+1,x,y]:=a[k,x+rl[i,1],y+rl[i,2]]; if nrep(k+1) then step(k+1); end; end; end;
begin a[1]:=st; step(1); end.
3、 跳马（5*5）
国际象棋8*8棋盘上某个位置的一只马，按马的行走规则，每个方格进入一次.，它是否可能只走63步，正好走过除起点外的其他63个位置各一次？如果有一种这样的走法，则称所走的这条路线为一条马的周游路线。试设计一个算法找出这样一条马的周游路线并输出。本题采用5*5的棋盘。
程序如下： const
d:array[1..8,1..2]of -2..2=((-2,1),(-2,-1),(1,2),(1,-2),(2,-1),(2,1),(-1,-2),(-1,2)); var
a:array[1..5,1..5]of 0..1; procedure print; var
i,j:integer; begin
for i:=1 to 5 do begin
for j:=1 to 5 do write(a[i,j]:3); writeln; end; readln; end;
procedure play(x,y:integer); var
i:integer; begin
if (x=5)and(y=5) then begin print;exit;end; for i:=1 to 8 do if
(x+d[i,1]>0)and(x+d[i,1]<6)and(y+d[i,2]>0)and(y+d[i,2]<6)and(a[x+d[i,1],y+d[i,2]]=0 )then begin
a[x+d[i,1],y+d[i,2]]:=1; play(x+d[i,1],y+d[i,2]); end; end; begin
fillchar(a,sizeof(a),0); a[1,1]:=1; play(1,1); end.
4、倒油
80、50、30三个容器，不带刻度，把80分成两个40. 初始（80,0,0）->目标(40,40.0) 程序如下： const
v:array[1..3]of integer=(80,50,30); var
a:array[1..30,1..3]of integer; procedure print(k:integer); var
i:integer; begin
for i:=1 to k do
writeln('step:',i,a[i,1]:3,a[i,2]:3,a[i,3]:3); readln; end;
function nrep(k:integer):boolean; var
i:integer; begin
nrep:=false;
for i:=1 to k-1 do
if (a[i,1]=a[k,1])and(a[i,2]=a[k,2])then exit; nrep:=true; end;
procedure step(k:integer); var
i,j:integer; begin
if (a[k,1]=40)and(a[k,2]=40) then begin print(k);exit;end; for i:=1 to 3 do for j:=1 to 3 do
if (i<>j)and(a[k,i]>0)and(a[k,j] a[k+1]:=a[k]; if (a[k,i]+a[k,j]>v[j] )then begin a[k+1,i]:=a[k,i]+a[k,j]-v[j]; a[k+1,j]:=v[j];end else begin a[k+1,i]:=0;a[k+1,j]:=a[k,i]+a[k,j];end; if nrep(k+1) then step(k+1); end; end; begin a[1,1]:=80; a[1,2]:=0; a[1,3]:=0; step(1); end. 5、狼、羊、菜过河（农夫过河问题） 规则是：猎人每次只能带一样过河，而狼吃羊，羊吃菜，不能没有猎人在时在一起。算出过河的方案。 程序如下： var a:array[1..30,1..4]of integer; procedure print(k:integer); var i:integer; begin for i:=1 to k do writeln('step:',i,a[i,1]:3,a[i,2]:3,a[i,3]:3,a[i,4]:3); readln; end; function can(k:integer):boolean; var i:integer; begin can:=false; if (a[k,2]=a[k,3])and(a[k,2]<>a[k,1])or(a[k,3]=a[k,4])and(a[k,3]<>a[k,1]) then exit; i:=k-2; while i>0 do begin if (a[i,1]=a[k,1])and(a[i,2]=a[k,2])and(a[i,3]=a[k,3])and(a[i,4]=a[k,4]) then exit; i:=i-2; end; can:=true; end; procedure step(k:integer); var i:integer; begin if a[k,1]+a[k,2]+a[k,3]+a[k,4]=0 then begin print(k);exit;end; for i:=1 to 4 do begin if i>1 then begin a[k+1]:=a[k]; a[k+1,i]:=1-a[k,i]; a[k+1,1]:=1-a[k,1]; end else begin a[k+1]:=a[k]; a[k+1,1]:=1-a[k,1]; end; if can(k+1) then step(k+1); end; end; begin a[1,1]:=1; a[1,2]:=1; a[1,3]:=1; a[1,4]:=1; step(1); end. 6、野人和传教士过河 ?野人和传教士各三人，小船只能载两人，要求野人的人数不能多于传教士。算出过河的方案总数。 程序如下：const c:array[1..5,1..2]of 0..2=((1,0),(0,1),(2,0),(0,2),(1,1)); var a:array[1..30,1..2]of integer; procedure print(k:integer); var i,j:integer; begin for i:=1 to k do begin writeln('step:',i,a[i,1]:3,a[i,2]:3); end; end; function can(k:integer):boolean; var i:integer; begin can:=false; if (a[k,1]>3)or(a[k,1]<0)or(a[k,2]>3)or(a[k,2]<0) then exit; if (a[k,1]>a[k,2])and(a[k,2]>0)or(a[k,1]