别处看到一个算法问题，想不出来，在此请教各位高手：

[Elminster]

原题如下：

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

　　“独立钻石棋”是起源与法国的一种棋类游戏，具体布局如下：

　　　　　　口口口
　　　　　　口口口
　　　　口口口口口口口
　　　　口口口　口口口
　　　　口口口口口口口
　　　　　　口口口
　　　　　　口口口

　　行棋规则：每个子只能沿着棋盘上的纵横线“隔子跳”（像跳棋一样，跳过一个相邻的棋子），跳到一个空格处，跳后被跳过的棋子将拿掉。
　　这样，棋子跳到最后，无子可再动时，游戏结束。
　　当游戏结束时，只剩一个棋子，并且这个棋子落在棋盘的中央，为最佳结果！
　　有哪位高手，能为我编一个程序，求出最佳行棋方法（最佳结果，最少步骤）。谢谢！　
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

[intfree]

200分！
不错，我有一个多月没拿什么分了，过会给你一个pascal程序。

[intfree]

uses Crt ;

type
TData =array[1..33] of Byte;
TPack =array[0..4] of Byte;
TCheck =array[1..5] of Char;
TLink =^TNode;
TNode =record
p :TPack;
w,h:Byte;
f:ShortInt;
l:TLink;
n:TLink
end ;

const
Way :array[1..33,1..4,1..2] of Byte =
(
(( 2, 3),( 4, 9),( 0, 0),( 0, 0)),
(( 5,10),( 0, 0),( 0, 0),( 0, 0)),
(( 1, 2),( 6,11),( 0, 0),( 0, 0)),
(( 5, 6),( 9,16),( 0, 0),( 0, 0)),
((10,17),( 0, 0),( 0, 0),( 0, 0)),
(( 4, 5),(11,18),( 0, 0),( 0, 0)),
(( 8, 9),(14,21),( 0, 0),( 0, 0)),
(( 9,10),(15,22),( 0, 0),( 0, 0)),
(( 1, 4),( 7, 8),(10,11),(16,23)),
(( 2, 5),( 8, 9),(11,12),(17,24)),
(( 3, 6),( 9,10),(12,13),(18,25)),
((10,11),(19,26),( 0, 0),( 0, 0)),
((11,12),(20,27),( 0, 0),( 0, 0)),
((15,16),( 0, 0),( 0, 0),( 0, 0)),
((16,17),( 0, 0),( 0, 0),( 0, 0)),
(( 4, 9),(14,15),(17,18),(23,28)),
(( 5,10),(15,16),(18,19),(24,29)),
(( 6,11),(16,17),(19,20),(25,30)),
((17,18),( 0, 0),( 0, 0),( 0, 0)),
((18,19),( 0, 0),( 0, 0),( 0, 0)),
(( 7,14),(22,23),( 0, 0),( 0, 0)),
(( 8,15),(23,24),( 0, 0),( 0, 0)),
(( 9,16),(21,22),(24,25),(28,31)),
((10,17),(22,23),(25,26),(29,32)),
((11,18),(23,24),(26,27),(30,33)),
((12,19),(24,25),( 0, 0),( 0, 0)),
((13,20),(25,26),( 0, 0),( 0, 0)),
((16,23),(29,30),( 0, 0),( 0, 0)),
((17,24),( 0, 0),( 0, 0),( 0, 0)),
((18,25),(28,29),( 0, 0),( 0, 0)),
((23,28),(32,33),( 0, 0),( 0, 0)),
((24,29),( 0, 0),( 0, 0),( 0, 0)),
((25,30),(31,32),( 0, 0),( 0, 0))
);
WayNum :array[1..33] of Byte=
(2,1,2,2,1,2,2,2,4,4,4,
2,2,1,1,4,4,4,1,1,2,2,
4,4,4,2,2,2,1,2,2,1,2);
MaxNodeNum =130;
Power :array[1..8] of Byte=(1,2,4,8,16,32,64,128);

var
Depth,Empty :Integer;
Root,
Closed,Open,
LastLink :TLink;
SortLast,
SortRoot :TLink;
Start :TData;

procedure Pack(M:TData;var P:TPack);
var
i,j:Byte;
begin
FillChar(P,SizeOf(P),0);
for i:=0 to 3 do
for j:=1 to 8 do
if M[i*8+j]=1 then
P[i]:=P[i]+Power[j];
P[4]:=M[33]
end;

procedure UnPack(p:TPack;var m:TData);
var
i,j :Integer ;
begin
for i:= 0 to 3 do
for j:= 1 to 8 do
if p[i] and Power[j]<>0
then m[i*8+j]:=1
else m[i*8+j]:=0;
m[33]:=p[4]
end ;

procedure Out;
var
Now :TData;
i,j :Integer;
Result:array[1..32] of TData;
begin
UnPack(Closed^.p,Result[Depth+1]);
Now:=Result[Depth+1];
for i:=Depth downto Empty do begin
Now[Closed^.w]:=0;
Now[Way[Closed^.w,Closed^.h,1]]:=1;
Now[Way[Closed^.w,Closed^.h,2]]:=1;
Closed:=Closed^.l;
Result[i]:=Now
end;
for i:=Empty to Depth+1 do begin
ClrScr;
Writeln('Step ',i-Empty) ;
Write(' ') ;
for j:=1 to 3 do
Write(Result[i,j]);
Writeln;
Write(' ');
for j:=4 to 6 do
Write(Result[i,j]);
Writeln;
for j:=7 to 13 do
Write(Result[i,j]);
Writeln;
for j:=14 to 20 do
Write(Result[i,j]);
Writeln;
for j:=21 to 27 do
Write(Result[i,j]);
Writeln;
Write(' ');
for j:=28 to 30 do
Write(Result[i,j]);
Writeln;
Write(' ');
for j:=31 to 33 do
Write(Result[i,j]);
Writeln;
Writeln('Press Enter to Continue :');
Readln
end
end;

function GetWays(var m:TData):Integer;
var
i,j,Ways:Integer;
begin
Ways:=0;
for i:=1 to 33 do
if M[i]=0 then
for j:=1 to WayNum[i] do
if (M[Way[i,j,1]]=1) and (M[Way[i,j,2]]=1) then Inc(Ways);
GetWays:=Ways
end;

function Expand:Boolean;
var
M :TData;
Num :TPack;
NewNode :TLinK;
PLink :TLink;
LastOpen :TLink;
NodeNum :Integer;
MinWay :Integer;

function Check(var Num:TPack;Ways:Byte):Boolean;
var
P :TLink;
begin
if (NodeNum=MaxNodeNum) and (Ways<MinWay ) then begin
Check:=False;
Exit
end;
P:=LastOpen^.N;PLink:=LastOpen;
while (P^.F>Ways) do begin
PLink:=P;
P:=P^.N;
end;
while (P^.F=Ways) do begin
if TCheck(Num)=TCheck(P^.P) then begin
Check:=False;
Exit
end;
P:=P^.N
end;
Check:=True
end;

procedure Find;
var
i ,j , k, Ways :Integer;
TeLink :TLink;
begin
UnPack(Closed^.P,M);
for i:=1 to 33 do
if M[i]=0 then
for j:=1 to WayNum[i] do
if (M[Way[i,j,1]]=1) and (M[Way[i,j,2]]=1) then begin
M[i]:=1;M[Way[i,j,1]]:=0;M[Way[i,j,2]]:=0;
Pack(M,Num);
Ways:=GetWays(M);
if Check(Num,Ways) then begin
if NodeNum<MaxNodeNum
then begin
Inc(NodeNum);
New(NewNode)
end{if}
else begin
TeLink:=LastOpen;
for k:=1 to NodeNum-1 do
TeLink:=TeLink^.N;
Open:=TeLink;
NewNode:=TeLink^.N;
TeLink^.N:=NewNode^.N
end;{else}
with NewNode^ do begin
P:=Num;
W:=i;
H:=j;
F:=Ways;
L:=Closed;
N:=nil
end;{with}
NewNode^.N:=PLink^.N;
PLink^.N:=NewNode;
MinWay:=Open^.F;
if Open=PLInk then
Open:=NewNode
end;{if}
M[i]:=0;M[Way[i,j,1]]:=1;M[Way[i,j,2]]:=1
end;{if}
Closed:=Closed^.N
end;

begin{Expand}
Expand:=True;
Closed:=Root;
Open:=Root;
Depth:=31;
for Depth:=Empty to 31 do begin
LastOpen:=Open;
MinWay:=0;
NodeNum:=0;
repeat
Find
until (Closed=LastOpen^.N);
if NodeNum=0 then begin
Writeln('Impossible to find a way.');
Expand:=False;
Exit{Halt}
end
end
end;

procedure Init;
var
i :Byte;
F :Text;
begin
{
Assign(F,'C:\Work\Bp\Dat\Data.Dat');ReSet(F);
}
Empty:=0;
for i:=1 to 33 do begin
{
Read(F,Start[i]);
}
if i = 17 then start[i] := 0 else start[i] := 1;
if Start[i]=0 then Inc(Empty)
end;
{
Close(F);
}
New(Root);
with Root^ do begin
Pack(Start,P);
F:=GetWays(Start);
W:=1;
H:=1;
L:=nil
end;
New(Root^.N);
Root^.N^.F:=-1;
LastLink:=Root^.N
end;

begin
Init;
if Expand then
Out
end.

以前编的，自带演示功能，只是最后一步走错了。

[ffans]

佩服，佩服

[Kusk]

楼上的程序没有研究，以前做过的，这题用广度优先就足够了，注意判断边界。

[Elminster]

对不起，能否讲解一下思路？否则的话这么长的程序没头没脑的看起来来实在太累了，特别是在我已经有很多年没用过 pascal 的情况下 …… ^_^

[Elminster]

up

[挺拔的劲松]

关注，是否可以用C描述下？

[IT_worker]

//下面的程序没有写完，而且可能跑的很慢
//只是说明了一下搜索的算法思想

#include <vector>
#include <algorithm>

using namespace std;

struct chess
{
chess *m_father; //从那个盘面走来
vector<int> m_chessman; //表示盘面
int m_hash;//最好加这个变量 比较两个chess是否相同可以加快速度

chess();
chess(const chess&);

int get_all_next(vector<chess>&next);
bool same(chess&);
};

int quality(chess* p); //如果p还没有结束quality为0,否则自己定义

bool have_find(vector<chess*>all,chess&c)
{
for(int i=all.size(); i--; )
if(all[i]->same(c))
return true;
return false;
}

void main()
{
vector<chess*> all;
vector<chess> next;
chess begin;
//init begin
//……
all.push_back(&begin);
for(int i=0; i<all.size(); i++)
{
all[i]->get_all_next(next);
for(int j=next.size();j--;)
{
if(have_find(all,next[j]))
continue;
all.push_back( new chess(next[j]) );
}
}
//到此all已经将begin的所有走法展开

//找到最佳结果
chess *best = *max_element(all.begin(),all.end(),quality);
//根据best和chess的m_father可以得出走法
//……

//不要忘了清理all中的对象
}

[Elminster]

穷举搜索？哪位能够介绍的具体一点？

[Elminster]

大概就是如此吧，结帖

[intfree]

算法在http://www.csdn.net/expert/topic/473/473467.xml有介绍。