广度搜索定界 例1:设有A,B,C,D,E 5人从事j1,j2,j3,j4,j5 5项工作每人只能从事一项,它们的 效益表如下: | j1 | j2 | j3 | j4 | j5 | A | 13 | 11 | 10 | 4 | 7 | B | 13 | 10 | 10 | 8 | 5 | C | 5 | 9 | 7 | 7 | 4 | D | 15 | 12 | 10 | 11 | 5 | E | 10 | 11 | 8 | 8 | 4 |
求最佳安排,使效益最高? 本题可用回溯或其它方法解,但当人数稍多是,运行超时?用分支定界法,搜索中减掉不必要的分支? 程序如下: program plan_job;
const maxn=20;
type arr=array[1..maxn] of integer;
pnt=^node;
node=record
job,flag:arr;
up,dep:integer;
nxt:pnt;
end;
var tp,p:pnt;
n,min,row,depth:integer;
goal:arr;
a:array[1..maxn,1..maxn] of integer;
f:text;
function cost(p:pnt):integer;
var i,j,max,y:integer;
begin
y:=0;
with p^ do
begin
for j:=1 to n do
if j<dep+1 then y:=y+a[job[j],j]
else
begin
max:=0;
for i:=1 to n do
if (max<a[i,j]) and (flag=0) then max:=a[i,j];
y:=y+max;
end;
end;
cost:=y;
end;
procedure init;
var i,j:integer;
begin
assign(f,'inpb.txt');
reset(f);
readln(f,n);
for i:=1 to n do
for j:=1 to n do
read(f,a[i,j]);
new(tp);
with tp^ do
begin
for i:=1 to n do
begin flag:=0; job:=0 end;
dep:=0;
up:=cost(tp);
nxt:=nil;
end;
min:=0;
end;
procedure process(p:pnt);
var i,j:integer;
begin
with p^ do
begin
dep:=depth;
flag[row]:=dep;
job[dep]:=row;
up:=cost(p);
end;
end;
procedure sort(p:pnt);
var x,y:pnt;
begin
y:=tp;
repeat
x:=y;
y:=x^.nxt;
until(y=nil) or (p^.up>=y^.up);
x^.nxt:=p;
p^.nxt:=y;
end;
procedure goals(p:pnt);
begin
if p^.up>min then
begin
goal:=p^.job;min:=p^.up
end;
end;
procedure print;
var i,k:word;
begin
for i:=1 to n do write('j',i,':',chr(goal+64),' ');
writeln;
writeln('maxcost=',min);
readln;
end;
begin
init;
repeat
if tp^.up>min then
begin
depth:=tp^.dep+1;
for row:=1 to 5 do
if tp^.flag[row]=0 then
begin
new(p);
p^:=tp^;
process(p);
if p^.up<min then dispose(p) elsesort(p);
if depth=n then goals(p);
end;
end;
tp:=tp^.nxt;
until tp=nil;
print;
end.
|