广度搜索定界

广度搜索定界

例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.