搜索算法及解题

end;

procedure find(dep,nowpoint:integer); {dep:画第几条边;nowpoint:现在所处的顶点} var i,next,j:integer; begin

for i:=1 to bianshu[nowpoint] do {与当前顶点有多少条相接,则有多少种走法} if ok(nowpoint,i,next) then begin {与当前顶点相接的第I条边可行吗?}

begin

init; {初始化,求边数等}

for first:=1 to max do {分别从各个顶点出发,尝试一笔画} fillchar(path,sizeof(path),0);

path[0]:=first; {记录其起始的顶点} writeln('from point ',first,':');readln;

find(1,first); {从起始点first,一条边一条边地画下去} end.

【题目】城市遍历问题.

给出六个城市的道路连接图,找出从某一城市出发,遍历每个城市一次且仅一次的最短路径 及其路程长度.(图见高级本P147} 【参考程序】 const

a:array[1..6,1..6]of 0..10 {城市间连接图.数字表示两城市间的路程} =((0,4,8,0,0,0), (4,0,3,4,6,0), (8,3,0,2,2,0), (0,4,2,0,4,9), (0,6,2,4,0,4), (0,0,0,9,4,0)); var

had:array[1..6]of boolean; {某个城市是否已到过} pathmin,path:array[1..6]of integer; {记录遍历顺序} ii,first,i,summin,total:integer;

{如果可行,其求出另一端点是NEXT}

a[nowpoint,next]:=2; a[next,nowpoint]:=2; {置成已走过标志} path[dep]:=next; {记录顶点,方便输出} if dep < zongbianshu then find(dep+1,next) {未搜索完每一条边} else output(dep); path[dep]:=0;

{回溯}

a[nowpoint,next]:=1; a[next,nowpoint]:=1; end;

procedure output(dep:integer); sum,i,j:integer; sum:=0; i:=2 6 {求这条路的路程总长} if sum><6 then find(dep+1)

else output(dep); had[i]:=false; {回溯} path[dep]:=0; end; end;

begin

for first:=1 to 6 do begin {轮流从每一个城市出发,寻找各自的最短路} fillchar(had,sizeof(had),false); fillchar(path,sizeof(path),0);

total:=0;

SumMin:=maxint; {最短路程}

path[1]:=first;had[first]:=true;{处理出发点的城市信息,记录在册并置到过标志} find(2); {到下一城市}

writeln('from city ',first,' start,total is:',total,' the min sum:',summin); for i:=1 to 6 do write(PathMin[i]);writeln; {输出某个城市出发的最短方案} end;

end.

【题目】棋子移动问题 [参考程序] const

n=3; {n<5} type

ss=string[2*n+1]; ar=array[1..630]of ss; var

a:ar;

f,z:array[1..630] of integer; i,j,k,m,h,t,k1:integer; s,d:ss; q:boolean;

procedure print (x:integer); var t:array[1..100] of integer; y:integer; begin

y:=0; repeat y:=y+1; t[y]:=x; x:=f[x];

until x=0;

writeln(a[t[y]]:2*n+4);

writeln(copy('-------------------------',1,2*n+5)); for x:=2 to y do writeln(x-1:2,':',a[t[y+1-x]]); end;

begin

s:='_';d:='_';

for i:=1 to n do begin s:='o'+s+'*'; d:='*'+d+'o'; end;

a[1]:=s;f[1]:=0;z[1]:=n+1; q:=false; i:=1;j:=2; t:=0;

repeat

for h:=1 to 4 do begin

k:=z[i];k1:=k;s:=a[i]; case h of

1:if k>1 then k1:=k-1;

2:if k<(2*n+1) then k1:=k+1;

3:if (k>2) and (s[k-1]<>s[k-2]) then k1:=k-2; 4:if (k<(2*n)) and(s[k+1]<>s[k+2]) then k1:=k+2; end;

if k<>k1 then begin

s[k]:=s[k1];s[k1]:='_'; m:=1;

while (a[m]<>s) and (m< j-1) do m:=m+1; if a[m] >>s then begin

a[j]:=s;f[j]:=i;z[j]:=k1; if s=d then begin print(j); q:=true; end; j:=j+1; end;

end;

end; {end for} i:=i+1; until q or (i=j); readln; end.

【题目】求集合元素问题（1,2x+1,3X+1类) 某集合Ａ中的元素有以下特征： (1)数1是A中的元素

(2)如果X是A中的元素,则2x+1,3x+1也是A中的元素 (3)除了条件(1),(2)以外的所有元素均不是A中的元素 [参考程序1]

uses crt,dos;

var a:array[1..10000]of longint; b:array[1..10000]of boolean; times,n,m,long,i:longint;

hour1,minute1,second1,sec1001:word; hour2,minute2,second2,sec1002:word;

begin

write('N=');readln(n);

{ gettime(hour1,minute1,second1,sec1001); times:=minute1*60+second1;

writeln(minute1,':',second1);}

fillchar(b,sizeof(b),0); a[1]:=1;m:=2;long:=1; while long<=n do begin for i:=1 to long do

if (a[i]*2=m-1) or (a[i]*3=m-1) then if not b[m] then begin

inc(long);a[long]:=m;b[m]:=true;break; end; inc(m);

end;

{ gettime(hour2,minute2,second2,sec1002); times:=minute2*60+second2-times; writeln(minute2,':',second2);

writeln('Ok! Uses Time: ',times);}