1、ACM1培训第一次ACM竞赛经典算法计算机与信息技术学院 目 录第一课递归 2第二课排列 5第三课经典排列 8组合问题（1） 11第四次课 深度搜索 14第一课递归一、pascal特点：1. 编写程序结构化；2. 支持递归；3. 通过使用指针，实现动态存储。二、函数和过程的作用：1. 相对独立功能的一段程序，一般用一个子程序（函数和过程）来编写；2. 结构清楚，便于调试、修改和扩充；3. 节约程序段和内存；三、递归定义：子程序自己调用自己的程序段叫递归；使用递归的条件1. 可以把一个问题转化为一个类似自己的新问题，且问题的规模发生规律性的变化。2. 可以通过转化使问题得到解决。3. 有一个明确
2、的结束条件。递归实际上是个逆向思维过程，核心是求递归公式。四、习题：1、 用递归求n!.程序如下：program sample1_1;var n:integer;function fac（n:integer）：real;begin if n=1 then begin fac:=1;exit;end; fac:=n*fac(n-1); end;begin readln(n); writeln(fac(n):3:0);end.总结：1、 递归一般用函数或过程来实现，主程序没有办法来实现递归；2、 递归要有空间想象能力；3、 需要保护的变量一定要开成局部变量。像function fac( n:int
3、eger )中的n.就是局部变量。2、斐波那契数列 f(n)=f(n-1)+f(n-2)程序如下：var n:integer;function f(n:integer):integer;begin if (n=1) or(n=0) then begin f:=1;exit;end; f(n):=f(n-1)+f(n-2);end;begin readln(n); write(f(n);end.总结：（1）递归每执行一次，就要开辟一次局部变量，保护上一次的内容。递归是逆向出发，先从全局出发，如何将大规模转化为小规模的问题。（2）fac(4):= fac(3) + fac(2);fac(3):=f
4、ac(2)+fac(1);Fac(2):=fac(1)+fac(0)Fac(2):=fac(1)+fac(0)重复运算多，速度慢。3、输入一串字符，以.结束，倒序输出。程序如下： var c:char; procedure print(n: char); var ch:char; beginif n=. then exit;readln(ch);print(ch);writeln(ch);end; beginreadln( c);print( c) end.4、求两个整数的最大公约数（辗转相除法） 程序如下： varm , n : integer;function fac(I, j:integ
5、er):integer; begin if j=0 then begin fac:=i;exit;end; fac:=fac(j ,i mod j); end;begin readln(n, m); writeln(fac(n,m);end.5、求给出一个多位整数的第K位。 Fac:=fac(x div 10, k-1)(k1)Fac(x, k)= fac:=x mod 10 (k=1) 程序如下： var x , k : integer ; function fac(I , j : integer):integer;begin if j=1 then begin fac:=I mod 10;
6、exit;end; fac:=fac(I div 10,k-1);end;begin readln(x, k); write(fac(x,k);end.6、梵诺塔 Var N:integer; sa, sb, sc:string; Procedure move (n:integer; a, b, c:char; var sa, sb, sc:string;);BeginIf n=1 then begin write( A,:,sa1,-) ,C);Sc:=sa1+sc;Sa:=copy(sa,2,length(sa)-1);exit;end; Move(n-1,a,c,b,sa,sc,sb);
7、 Write(A,:,sa1,-), C); Sc:=sa1+sc; Sa:=copy(sa, 2, length(sa)-1);Move(n-1,b,a,c,sb,sa,sc);End;Begin Readln(n); sa:=12345; sb:=; sc:=;Move(5,A,B,C,sa,sb,sc);End.第二课排列（排列）递归跟多重for循环一样，只不过递归可以随机控制循环的层数，可以实现循环次数的可变性，m叫递归的层数，叫深度。N叫宽度，时间的复杂度为nm次。控制循环的I一定是局部变量。1、 从n个自然数中取出m个数的排列（允许重复）；程序如下：var a:array1.100
8、of integer; n,m,s:integer; procedure print;var I:integer;Begin For I:=1 to m do Write(aI:3);End; procedure play(k:integer)var I:integer;Begin If k=m+1 then begin Inc(s); Print; Exit; End; For I:=1 to n do Begin Ak:=I; Play(k+1); End;End; beginreadln(n,m);s:=0;play(1);writeln(s); end. 2、 n个自然数中取出m个数的
9、排列（不允许重复（n=m）； var a:array1.100of integer; b:array1.100of Boolean; n,m,s:integer; procedure print; varI:integer; BeginFor I:=1 to m do Write(aI:3);End; procedure play(k:integer);var I:integer;beginif k=m+1 then begin inc(s);print;exit;end;for I:=1 to n do if bI then begin ak:=I; bI:=false; play(k+1)
10、; bI:=true; end; end; begin readln(n,m); s:=0; fillchar(b,sizeof(b),false); play(1); writeln(s); end.3. 限定次数，若干限定次数，即每个数都有限定次数，可用标志数组，B数组先录入限定的次数，用一次则该数组中的数减1，至到为0为止。4. 若干个不连续的数的排列引入第3个数组C，将不规律映射到规律下标的数组当中。例：PASCAL字符串取3个字母的排列 本题就是限次，而且不连续数的排列，可以映射到字符串去。程序如下： vara: array1.3of char;b: array1.26of inte
11、ger;p,c:string;I, s:integer; Procedure print; VarI:integer;Begin For I:=1 to 3 do Write(aI); Writeln;End; Procedure play(k: integer);Var I: integer;Begin If k=4 then begin inc(s);print; exit; end; For I:=1 to length( c) do If bI0 then begin Ak:=cI; Dec(bI); Play(k+1); Inc(bI); End;Begin Readln(p); C
12、:=; For I:=1 to length(p) do If pos(pI,c)=0 then begin c:=c+pI; bpos(pi,c):=1;exit; End else inc(bpos(pI,c); S:=0;Play(1);Writeln(s); End.第三课经典排列1、错排： n封信，n个信封，全装错的情况（Ij，且不允许重复的情况） var a:array1.100of integer; b:array1.100of boolean; n,s:integer;procedure print; var i:integer; begin for i:=1 to n do
13、write(ai:3); writeln; end;procedure play(k:integer); var i:integer; begin if k=n+1 then begin print;inc(s);exit;end; for i:=1 to n do if (ik) and bi then begin ak:=i;bi:=false; play(k+1); bi:=true; end; end;begin readln(n); s:=0; fillchar(b,sizeof(b),true); play(1); writeln(s);end.2、8皇后问题（任一皇后不在同一行同
14、一列，同一斜行上）八皇后是一个二维数组，如果用一个一维数组来存放，就可以保证行上不重，在列上再用一个数来判重，就可以保证列上不重。var a,b:array1.8of 0.8; s,n:integer;function can(k:integer):boolean; var i:integer; begin nrep:=false; for i:=1 to k-1 do if abs(i-k)=abs(ai-ak) then exit; nrep:=true; end;procedure print; var i,j:integer; begin for i:=1 to 8 do begin
15、for j:=1 to 8 do if ai=j then write(*:2)else write(0:2); writeln; end; writeln(-); end;procedure try(k:integer); var i:integer; begin if kn then begin inc(s);print;exit;end; for i:=1 to 8 do if bi=0 then begin ak:=i; bi:=1; if can(k) then try(k+1); bi:=0; end; end;begin n:=8; s:=0; try(1); writeln(s
16、);end.3、 由A、B、C三个字母组成长度为n的没有连续3个相同的子串。(只讨论第k个字母加上去后是否影响到产生三个相同的子串) type str=string10;var n,s:integer;function nrep(p:string):boolean; var i:integer; begin nrep:=false; for i:=1 to length(p)div 3 do if (copy(p,length(p)-i+1,i)=copy(p,length(p)-2*i+1,i)and ( copy(p,length(p)-2*i+1,i)=copy(p,length(p)-
17、3*i+1,i) then exit; nrep:=true; end;procedure try(p:str); var i:char; begin if length(p)n then begin inc(s);writeln(p);exit;end; for i:=a to c do begin if nrep(p+i) then try(p+i); end; end;begin readln(n); s:=0; try(); writeln(s);end.4、九连环（九连环的移动规则：1、第1位可以随意变；2、第i位改变时，只要i-1位为0，前面各位都为1，则本位可变。）var a,b
18、:string; i:integer;procedure play(k:integer;c:char); var i:integer; begin if ak=c then exit; if k=1 then ak:=c else begin play(k-1,0); for i:=k-2 downto 1 do play(i,1); ak:=c; end; writeln(a); end;begin readln(a); readln(b); for i:=length(a) downto 1 do play(i,bi);end.组合问题（1）1、从n个自然数中取m个数的组合；var a:a
19、rray0.100of integer; n,m,s:integer;procedure print; var i:integer; begin for i:=1 to m do write(ai:4); writeln; end;procedure try(k:integer); var i:integer; begin if km then begin inc(s);print;exit;end; for i:=ak-1+1 to n do begin ak:=i; try(k+1); end; end;begin readln(n,m); s:=0; a0:=0; try(1); wri
20、teln(s);end.2.输入一个正整数，拆分成正整数的和，求所有的情况。（是组合问题，但允许重复）程序如下：var a:array0.100of integer; n,s:integer;procedure print(k:integer); var i:integer;begin write(n,=,a1); for i:=2 to k do write(+,ai); writeln;end;procedure try(k,p:integer); var i:integer; begin if p=0 then begin print(k-1);inc(s);exit;end; ak:=
21、p; try(k+1,0); for i:=ak-1 to p div 2 do begin ak:=i; try(k+1,p-i);end; end; begin s:=0; readln(n); a0:=1; try(1,n); writeln(s); end.3.分解质因数程序如下：var a:array0.100of integer; n:integer;procedure print(k:integer); var i:integer; begin write(n,=,a1); for i:=2 to k do write(*,ai); writeln; end;function y
22、es(p:integer):boolean; var i:integer; begin yes:=false; for i:=2 to trunc(sqrt(p) do if p mod i=0 then exit; yes:=true; end;procedure play(k,p:integer); var i:integer; begin if p=1 then begin print(k-1);exit;end; if yes(p) then begin ak:=p;play(k+1,1);end; for i:=ak-1 to trunc(sqrt(p) do if(i1)and(p
23、 mod i=0) then begin ak:=i;play(k+1,p div i);end; end;begin readln(n); a0:=2; play(1,n);end.第四次课 深度搜索 在我们遇到的一些问题当中，有些问题我们不能够确切的找出数学模型，即找不出一种直接求解的方法，解决这一类问题，我们一般采用搜索的方法解决。搜索就是用问题的所有可能去试探，按照一定的顺序、规则，不断去试探，直到找到问题的解，试完了也没有找到解，那就是无解，试探时一定要试探完所有的情况（实际上就是穷举）；对于问题的第一个状态，叫初始状态，要求的状态叫目标状态。搜索就是把规则应用于实始状态，在其产生的
24、状态中，直到得到一个目标状态为止。产生新的状态的过程叫扩展（由一个状态，应用规则，产生新状态的过程）搜索的要点：（1）初始状态； （2）重复产生新状态； （3）检查新状态是否为目标，是结束，否转（2）；如果搜索是以接近起始状态的程序依次扩展状态的，叫宽度优先搜索。如果扩展是首先扩展新产生的状态，则叫深度优先搜索。深度优先搜索深度优先搜索用一个数组存放产生的所有状态。（1） 把初始状态放入数组中，设为当前状态；（2） 扩展当前的状态，产生一个新的状态放入数组中，同时把新产生的状态设为当前状态；（3） 判断当前状态是否和前面的重复，如果重复则回到上一个状态，产生它的另一状态；（4） 判断当前状态是
25、否为目标状态，如果是目标，则找到一个解答，结束算法。（5） 如果数组为空，说明无解。（6） 转到（） 对于pascal语言来讲，它支持递归，在递归时可以自动实现回溯（利用局部变量）所以使用递归编写深度优先搜索程序相对简单，当然也有非递归实现的算法。 1、 迷宫程序如下：const d:array1.4,1.4of integer=(1,1,0,0),(0,1,1,1),(1,1,0,1),(0,1,1,1); c:array1.4,1.2of -1.1=(0,1),(0,-1),(1,0),(-1,0);var a:array1.16,1.2of integer; i,j:integer;pr
26、ocedure play(k:integer); var i:integer; begin if (ak,1=4)and(ak,2=4) then begin for i:=1 to k do write(,ai,1,ai,2,); writeln; readln; exit; end; for i:=1 to 4 do if (ak,1+ci,10)and(ak,1+ci,10)and(ak,2+ci,25) then if dak,1,ak,2=1 then begin dak,1,ak,2:=2; ak+1,1:=ak,1+ci,1; ak+1,2:=ak,2+ci,2; play(k+
27、1); dak,1,ak,2:=1; end;end;begin fillchar(a,sizeof(a),0); a1,1:=1;a1,2:=1; play(1);end.2、 8数码程序如下：type node=array1.3,1.3of 0.8;const st:node=(2,8,3),(1,6,4),(7,0,5); gl:node=(1,2,3),(8,0,4),(7,6,5); rl:array1.4,1.2of-1.1=(0,1),(0,-1),(1,0),(-1,0);var a:array1.20of node;function result(k:integer):boo
28、lean; var i,x,y:integer;begin result:=false; for x:=1 to 3 do for y:=1 to 3 do if ak,x,yglx,y then exit; result:=true;end;procedure look(k:integer;var x,y:integer); var i,j:integer; begin for i:=1 to 3 do for j:=1 to 3 do if ak,i,j=0 then begin x:=i;y:=j;end; end;procedure print(k:integer); var i,x,y:integer;begin for i:=1 to k do begin writeln(step:
