fish.pas

本光盘是《国际大学生程序设计竞赛例题解（一）》的配套光盘

{$A+,B-,D+,E+,F-,G-,I+,L+,N+,O-,P-,Q+,R-,S-,T-,V-,X+,Y+}
{$M 16384,0,655360}

 program fish;

 const
  maxn=30;					{	鱼数的最大值		}
  finame='fish.dat';			{	输入文件名		}
  foname='fish.out';			{	输出文件名		}

 var
  fi,fo:text;							{	输入输出文件					}
  n,m:integer;							{	鱼的数目，资金				}
  a:array[1..maxn,1..maxn] of 0..1;		{	各鱼之间的共处性				}
  v:array[1..maxn] of integer;			{	各鱼的价格					}
  h:array[0..maxn] of integer;			{	估计函数值					}
  p,pbest:array[1..maxn] of 0..1;		{	买鱼的情况，及最佳方案		}
  cone,best:integer;						{	买鱼的数目，及最优值			}
  sumbest,sum:integer;					{	买鱼的花费，及最优值			}

 procedure data_input;					{	数据输入		}
  var
   t1,t2:integer;
   i,j:integer;
  begin
   readln(fi,m,n);

   for i:=1 to n do
    begin
     readln(fi,t1,t2);
     v[t1]:=t2;
    end;

   for i:=1 to n do for j:=1 to n do a[i,j]:=0;
   readln(fi,t1,t2);
   while (t1<>0) or (t2<>0) do
    begin
     a[t1,t2]:=1;
     a[t2,t1]:=1;
     readln(fi,t1,t2);
    end;
  end;

 procedure best_found;					{	最优值初始化		}
  begin
   best:=0;
   sumbest:=0;
  end;

 procedure h_found;						{	计算启发函数		}
  var
   d:array[1..maxn] of integer;
   nbak:integer;
   s,c,t:integer;
   i,j,k:integer;
  begin
   h[0]:=0;
   nbak:=n;
   for n:=1 to nbak do
    begin
     for i:=1 to n do
      begin
       for j:=1 to n do
        begin
         d[j]:=0;
         for k:=1 to n do
          if a[j,k]=1 then d[j]:=d[j]+1;
        end;
      end;

     s:=0;
     for i:=1 to n do s:=s+d[i];

     for i:=1 to n-1 do for j:=i+1 to n do
      if d[i]<d[j] then
       begin
        k:=d[i];
        d[i]:=d[j];
        d[j]:=k;
       end;

     c:=0;
     t:=0;
     while c<s do
      begin
       inc(t);
       c:=c+d[t]+d[t];
      end;

     h[n]:=n-t;
    end;

   n:=nbak;
  end;

 procedure p_found(t:integer);			{	递归搜索		}
  var
   bb:boolean;
   i:integer;
  begin
   p[t]:=-1;
   repeat
    p[t]:=p[t]+1;

    if p[t]=1 then
     begin
      inc(cone);
      sum:=sum+v[t];
     end;

    if sum<=m then bb:=true
     else bb:=false;
    if (bb=true) and (p[t]=1) then
     for i:=n downto t+1 do if bb then
      if (p[i]=1) and (a[i,t]=1) then bb:=false;

    if cone+h[t-1]<best then bb:=false;

    if bb=true then
     if t=1 then
       begin
        if (cone>best) or
           ((cone=best) and (sum>sumbest)) then
         begin
          best:=cone;
          sumbest:=sum;
          pbest:=p;
         end;
       end
      else p_found(t-1);

    if p[t]=1 then
     begin
      dec(cone);
      sum:=sum-v[t];
     end;
   until p[t]=1;
  end;

 procedure p_output;						{	输出解	}
  var
   i:integer;
  begin
   writeln(fo,best,' ',sumbest);
   for i:=1 to n do
    if pbest[i]=1 then writeln(fo,i);
  end;

 procedure main;
  begin
   cone:=0;
   sum:=0;
   p_found(n);
   p_output;
  end;

 begin
  assign(fi,finame);
  assign(fo,foname);

  reset(fi);
  rewrite(fo);

  data_input;
  best_found;
  h_found;
  main;

  close(fo);
  close(fi);
 end.