1. [圣诞礼物](3+2+2+3+2=12分)
圣诞节到了,圣诞老人打算把一批圣诞礼物装入各种不同颜色的口袋中,然后分发给 小朋友们。现在圣诞老人手中有5个不同礼物和5个不同口袋,圣诞老人的计划是这样的:
(1)先给每个礼物编号,编号分别是1、2、3、4、5;再给5个口袋编号,分别用a[1]、a[2]、a[3]、a[4]、a[5]来表示,其中a[1]的值表示I号口袋中装的礼物的编号。比如,a[3]=5,
表示3号口袋中装的是编号为5的礼物。
(2)任何一个礼物可以装入任何一个口袋中,但每个口袋中有且仅有一个礼物。也就是说,5个礼物刚好装入5个不同的口袋中。
圣诞老人想知道的是这样的礼物装入口袋的方法一?共有多少种,分别怎么装?他想让你编写一个程序来解决这个问题。而且,他怕你不理解他的含义,举了—个例子,假如行 3个不同的礼物和口袋,那么你的程序应该能输出以下结果:
1 2 3
1 3 2
2 1 3
2 3 1
3 1 2
3 2 1
S=6
上述输出结果中,最后一行表示装袋方法的种数(这里是6种),前面6行是各种不同的装袋方法。比如,第一行表示1、2、3号口袋分别装的礼物编号是1、2、3:而第3行表示的是1、2、3号口袋分别装的礼物编号是2、1、3。
请你完成下列程序:
program test5;
var
a:array[1..5] of integer;
i1,i2,i3,i4,i5,j1,j2,j3,j4,j5,s:integer;
function f(x,y:integer):Boolean;
var
k:integer;
begin
f:=true;
for k:=1 to x do if a[k]=y then f:=false;
end;
procedure print;
var
i:integer;
Begin
For i:=1 to 5 do write(a[i]:3);writeln;
End;
Begin
S:= 0 ;
For i1:=1 to 5 do
Begin
j1:=1;
a[j1]:=i1 a[j1]:=i1___;
for i2:=1 to 5 do
if f(j1,i2) then
begin
j2:=2;a[j2]:=i2;
for i3:=1 to 5 do
if f(j2,i3)then
begin
j3:=3;a[j3]:=i3;
for i4:=1 to 5 do
if f(j3,i4) then
begin
j4:=4;a[j4]:=i4;
for i5:=1 to 5 do
if f(j4,i5)then
begin
j5:=5;
a[j5]:=i5;
print;
inc(s) ;
end;
end;
end;
end;
end;
writeln(‘s=’, s );
end.
2. [华容道](3+3+3+3+3+3=18分)
华容道取材于我国三国演义的一种小游戏,小王是一个编程爱好者,他就利用课余时间编写了一个华容道的游戏程序。当然小王的华容道和现实的华容道游戏有一些区别,小王的华容道游戏是这样设计的:
华容道由5*5的底版和24个大小一样的小正方形板组成。在每一个小正方形上印有一个不同的字母(A到X)。24个方块放入底版后,底版上还有一个空位。如果一个小方块紧挨着空位,则可以将其移动至空位。
按照这个游戏设计思想,小王开始编写程序,使得程序能根据输入的初始局面(各个小正方形板在华容道中的位置排列)和移动序列之后,输出华容道的最终局面。
问题是小王编写了程序后发现程序不能正确执行,根据他的经验,他觉得错误肯定发生在其中的6个地方(下面程序中标有数字的空格处),于是小王来向你这个编程高手请教,请你告诉小王这6个空格处正确的内容应该上什么。
程序一开始会让使用者输入华容道的初始局面和移动序列,前面5行5列组成华容道的初始局面,第6行表示移动序列。下面就是某个使用者的输入信息(第3行第2个位置是空位):
TRGSJ
XDOKI
M VLN
WPABE
UQHCF
ARRBBL
上面移动序列中包含了4种不同字母,分别表示了不同的移动方向,这些字母的含义是:A表示将空位上方的块移动到空位,B表示将空位下方的方块移动到空位;L表示将空位左方的方块移动到空位;R表示将空位右方的方块移动到空位。
一个正确的华容道程序应在得到上面的输入数据后,输出如下所示的最终局面(第4行第3个位置是空位);
TRGSJ
XOKLT
MDVBN
WP AE
UQHCF
考虑到有些用户可能会输入非法的移动信号,比如当空位在最下面一行时,移动信号为“B”,此时由于下面没有任何小方块了,所以是非法的移动,此时应让程序能输出“No answer”(此时不必输出华容道的最终局面)。
下列就是小王编写的程序,请帮助小王完善程序,并把答案书写在答案纸上。
Program test6;
Var
i1,j1,i2,j2,I,j,k:integer;
s,x:char;
a:array[1..5,1..5] of char;
b:string;
procedure err;
begin
write(‘ No answer ’);halt;
end;
procedure swp(var i1,j1,i2,j2:integer);
var
t:char;
t1:integer;
begin
t:=a[i1,j1]; a[i1,j1]:=a[i2,j2]; a[i2,j2]:=t;
t1:=i1;i1:=i2;i2:=t1;t1:=j2;j2:=j1;j1:=t1;
end;
begin
for i:=1 to 5 do
begin
for j:=1 to 5 do
begin
read(a[i,j]); if a[i,j]=' ' then begin i1:=i; j1:=j;end;
end;
readln;
end;
readln(b);
k:=length(b);
for i:=1 to k do
begin
if ((i1=1) and(b[i]=’A’)) or ((i1=5) and (b[i]=’B’)) or (j1=1) and (b[i]='L') or
((j1=5) and(b[i]=’R’))
then err;
i2:=i1;j2:=j1;
case b[i] of
‘A’:i2:=i1-1;
‘B’:i2:= i1+1 ;
‘L’: j2:=j1-1;
‘R’:j2:= j1+1 ;
end;
swp(i1,j1,i2,j2);
end;
for i:=1 to 5 do
begin
for j:=1 to 5 do
write(a[i,j]);
writeln;
end;
end.