band.pas

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

program program_of_band;
var fin,fout:text;
    name:array[1..26] of char;	{顶点的名称如A、B}
    sequence:array [1..26] of integer;	{顶点顺序}
    perior,side:array [1..26,1..26] of integer;	{优先级、邻接矩阵}
    n,max,bandmax,count:integer;
    best,now,mark,connect:array [1..26] of integer;

procedure init;	{数据初始化}
  begin
    fillchar(name,sizeof(name),0);
    n:=0;
    fillchar(sequence,sizeof(sequence),0);
    fillchar(perior,sizeof(perior),0);
    fillchar(side,sizeof(side),0);
  end;

  function order(c:char):integer;
{按指定的顶点名（c）查找对应的顶点编号，若该顶点不存在，则加入顶点集中}
  var i:integer;
  begin
    for i:=1 to n do if c=name[I] then
      begin
        order:=i;
        exit;
      end;
    inc(n);name[n]:=c;
    order:=n;
  end;

procedure convert_into_graph;
{从输入文件中读入图，并按邻接矩阵的方式保存起来}
  var k,m:integer;
      c:char;
  begin
    repeat
      read(fin,c);
      m:=order(c);
      read(fin,c);
      repeat
        read(fin,c);
        if c<>';' then
        begin
          k:=order(c);
          side[m,k]:=1;
        end;
      until eoln(fin) or (c=';') or eof(fin);
    until eoln(fin) or eof(fin);
  end;

procedure make_sequence;{构造顶点的优化搜索序列}
  var i,j,k,max:integer;
      flag:array [1..26] of integer;
  begin
    sequence[1]:=1;
    for i:=2 to n do
      begin
        fillchar(flag,sizeof(flag),0);
        for j:=1 to i-1 do flag[sequence[j]]:=-1;
        for j:=1 to n do if flag[j]>=0 then
          begin
            for k:=1 to n do
            if (flag[k]=-1) and (side[j,k]=1) then inc(flag[j]);
          end;
        max:=-1;
        for j:=1 to n do if flag[j]>max then
        begin
          max:=flag[j];
          k:=j;
        end;
        sequence[i]:=k;
      end;
  end;

procedure print;{打印结果}
  var i,j:integer;
  begin
    writeln(max);
    rewrite(fout);
    for i:=1 to n do
      begin
        for j:=1 to n do if now[j]=i then
        if i<n then write(fout,name[sequence[j]],' ')
               else writeln(fout,name[sequence[j]]);
      end;
    writeln(fout,max);
    close(fout);
  end;

procedure search(m:integer);{搜索最小带宽}
  var i,j,pickout,pickoutband,backupmax:integer;
  begin
    {计算本层搜索的优先级}
    for i:=1 to n do perior[m,i]:=0;
    if m=1 then
      begin
{在给第一个顶点标号时(设标号为i)，可令 i<=n-i,因为n-i与i 对称，这样避免了重复}
        for i:=1 to n do if i<=n+1-i then perior[m,i]:=1;
      end
    else
      begin
        for i:=1 to n do if mark[i]=0 then
          begin
            for j:=1 to m-1 do
            	if side[sequence[j],sequence[m]]=1 then
            if abs(now[j]-i)>perior[m,i] then perior[m,i]:=abs(now[j]-i);
          end;
      end;

{按优先级的高低顺序，依次扩展结点}
    backupmax:=bandmax;
    repeat
      pickout:=0;
      pickoutband:=max;
      bandmax:=backupmax;
      for i:=1 to n do
      if (pickoutband>perior[m,i]) and (perior[m,i]>0) then
        begin
          pickout:=i;
          pickoutband:=perior[m,i];
        end;
      if pickout=0 then
        begin
          bandmax:=backupmax;
          exit;
        end;

      if bandmax<perior[m,pickout] then bandmax:=perior[m,pickout];
      perior[m,pickout]:=0;
      now[m]:=pickout;
      mark[pickout]:=1;
      count:=0;
      for i:=1 to n do if mark[i]=0 then
      if abs(i-pickout)<max then inc(count);

      if count>=connect[m] then
      if bandmax<max then
      if m<n then search(m+1)
      else
        begin
          max:=bandmax;
          best:=now;
          print;
        end;
      mark[pickout]:=0;
    until false;
  end;

procedure make_connect;
  var i,j:integer;
  begin
    fillchar(connect,sizeof(connect),0);
    for i:=1 to n do
    for j:=i+1 to n do
    if side[sequence[i],sequence[j]]=1 then
    inc(connect[i]);
  end;

{主程序}
begin
  init;
  assign(fout,'band.out');
  assign(fin,'band.dat');
  reset(fin);
  convert_into_graph;
  close(fin);
  make_sequence;
  max:=n+1;
  bandmax:=0;
  fillchar(mark,sizeof(mark),0);
  make_connect;
  search(1);
end.