求经典的搜索题pascal

Question

一定要有源代码{pascal}..可以只有题目没有地址..当要经典的..地址好找点

Answer 1

经典题集：
http://blog.csdn.net/lyflower/archive/2008/03/01/2138221.aspx
深度优先搜索：
1.全排列
http://baike.baidu.com/view/1710135.htm
2.八皇后
http://baike.baidu.com/view/622604.htm
3.骑士游历
http://zhidao.baidu.com/question/22844916.html
广度优先搜索：
1.八数码
题目描述

有一个3*3的方阵，其中有8个数，一个方格为空，可以通过移动方格将初始的方阵移动成
123
456
780

输入

输入一个3*3的方阵，即为初始状态，0代表空的方格
如
134
705
682

输出

每一个步骤,若无解输出“No Solution!”

我的代码：
program ex;
const
jc:array[1..9] of longint=(1,2,6,24,120,720,5040,40320,362880);
var
k:array[1..362880] of boolean;
a,r:array[1..181450] of longint;
b,c,d,e,f,top,bot:longint;
code:integer;
z:string;
s:char;
function hash(i:string):longint;｛将数码状态转换成唯一一个与之对应的数｝
var
u,v,w:longint;
t:array[1..9] of longint;
begin
t[9]:=0;
for u:=1 to 8 do
begin
w:=0;
for v:=u+1 to 9 do
if i[v]<i[u] then inc(w);
t[u]:=w;
end;
w:=1;
for u:=1 to 8 do
w:=w+t[u]*jc[9-u];
hash:=w;
end;
procedure print;｛输出步骤｝
var
l:array[1..100] of longint;
i,j,g:longint;
t:string;
begin
i:=top-1;j:=1;
repeat
l[j]:=i;
j:=j+1;
i:=r[i];
until i=0;
g:=0;
for i:=j-1 downto 1 do
begin
if i<>j-1 then
begin
writeln('|');
writeln('V');
end;
str(a[l[i]],t);
if length(t)=8 then t:='0'+t;
writeln(t[1],t[2],t[3]);
writeln(t[4],t[5],t[6]);
write(t[7],t[8],t[9]);
if (g mod 4=0) and (g<>0) then readln
else writeln;
g:=g+1;
end;
writeln('Total=',j-2);
readln;
halt;
end;
begin
fillchar(k,sizeof(k),false);
for b:=1 to 3 do
begin
readln(z);
val(z,c,code);
a[1]:=a[1]*1000+c;｛用长整型表示数据，节省空间｝
end;
if a[1]=123456780 then begin writeln('You are a pig!');readln;halt;end;｛若初始状态即为目标状态，则直接输出｝
writeln;
r[1]:=0;top:=2;bot:=1;
str(a[1],z);
if length(z)=8 then z:='0'+z;
f:=hash(z);
k[f]:=true;
repeat{广搜过程}
for b:=1 to 4 do｛产生式系统，把“0”移向周围四个方向｝
begin
str(a[bot],z);
if length(z)=8 then z:='0'+z;
c:=pos('0',z);
if (b=1) and (c>3) or (b=2) and (c mod 3<>1)
or (b=3) and (c mod 3<>0) or (b=4) and (c<7) then
begin
s:=z[c];
z[c]:=z[c+b*2-5];
z[c+b*2-5]:=s;
e:=hash(z);
if k[e]=false then｛判断该状态是否已经产生过｝
begin
k[e]:=true;
val(z,a[top],code);
r[top]:=bot;
top:=top+1;
end;
if z='123456780' then print;｛找到目标，输出｝
end;
end;
bot:=bot+1;
str(a[bot],z);
f:=hash(z);
until top=bot;
writeln('No Solution!');
readln;
end.

Answer 2

凌乱的齿轮

Description

Farmer John最近买了台新机器，来帮他做往牛棚里塞干草的体力活。但是，由于设计的不合理，机器中有很多冗余的齿轮。整个机器由一个连在电动机上的大齿轮驱动，这个齿轮被安装在位置(0,0)。FJ希望知道，在这个机器启动后，最后转动起来的齿轮是哪一个。

FJ详尽地记录了所有N (2 <= N <= 1080)个齿轮的位置x_i,y_i (-5,000 <= x_i <= 5,000; -5,000 <= y_i <= 5,000)和半径r_i (3 <= r_i <= 1024)。你的任务是，找出整个传动系统末端的齿轮（一个被其他齿轮带动，但没有带动其他任何装置的齿轮）的位置。除了驱动整个机器的大齿轮，其他齿轮都只会被另一个齿轮带动。

Input

* 第1行: 1个整数N
* 第2..N+1行: 第i+1行给出了齿轮i的参数：x_i，y_i，以及r_i

Output

第1行: 输出2个用空格隔开的整数x，y，表示传动系统末端齿轮的位置

Sample Input

3
0 0 30
30 40 20
-15 100 55

输入说明:
机器中一共有3个齿轮。第一个齿轮被放在原点，半径为30。它带动了位于(30,40)的半径为20的齿轮，于是位置为(-15,100)的半径为55的齿轮最终被第二个齿轮带动。

Sample Output

-15 100

Var
a,x,y,r,num:Array[1..1100] of Longint;
f:Array[1..1100,1..1100] of ShortInt;
v:Array[1..1100] of Boolean;
n,st:Longint;

Function Length(x1,y1,x2,y2:Longint):Extended;
begin
Length:=Sqrt(Sqr(x1-x2)+Sqr(y1-y2));
end;

Procedure Init;
Var
i,j:Longint;
begin
Readln(n);
Fillchar(v,Sizeof(v),False);
for i := 1 to n do
begin
Readln(x[i],y[i],r[i]);
num[i]:=i;
if (x[i]=0) and (y[i]=0) then st:=i;
end;
a[st]:=1;
for i := 1 to n do
for j := 1 to n do
if Length(x[i],y[i],x[j],y[j])=r[i]+r[j] then f[i,j]:=1;
end;

Procedure DFS(x:Longint);
Var
i:Longint;
begin
v[x]:=True;
for i := 1 to n do
if (f[x,i]=1) and (Not v[i]) then
a[i]:=a[x]+1;
for i := 1 to n do
if (f[x,i]=1) and (Not v[i]) then DFS(i);
end;

Procedure Main;
Var
i,mx,max:Longint;
begin
max:=-10;
mx:=-10;
v[st]:=True;
DFS(st);
for i := 1 to n do
if a[i]>max then
begin
max:=a[i];
mx:=i;
end;
Writeln(x[mx],' ',y[mx]);
end;

begin
Init;
Main;
end.