network.pas

用模拟退火的方法

program network;
const
     mmax=1<<11;
type list=array[0..mmax] of longint;
var
   n,m:longint;
   inx,c:list;
   x,tmp:array[0..5] of list;
   a:array[0..mmax,0..mmax] of longint;
procedure fon;
begin
     assign(input,'network.in');
     assign(output,'network.out');
     reset(input); rewrite(output);
end;
procedure foff;
begin
     close(input);
     close(output);
end;
procedure init;
var
   i,j:longint;
begin
     read(n);
     m:=1<<n;
     for i:=1 to m do read(inx[i]);
     for i:=1 to m do read(c[i]);
     for i:=1 to m-1 do
         for j:=i+1 to m do
             read(a[i,j]);
end;
function sum(x:list):longint;
var
   i,j,k:longint;
   s:longint;
   slr:longint;
   f:array[0..mmax] of longint;
   na,nb,l,r:array[0..mmax] of longint;
begin
     s:=0;
     for i:=1 to m do
     if inx[i]<>x[i] then
     begin
          inc(s,c[i]);
     end;
     fillchar(f,sizeof(f),0);
     fillchar(l,sizeof(l),0);
     fillchar(r,sizeof(r),0);
     fillchar(na,sizeof(na),0);
     fillchar(nb,sizeof(nb),0);
     slr:=1<<n-1;
     for i:=1 to m do
     begin
          l[i+slr]:=i;
          r[i+slr]:=i;
          f[i+slr]:=x[i];
          if x[i]=0 then na[i+slr]:=1 else nb[i+slr]:=1;
     end;
     for i:=1<<n-1 downto 1 do
     begin
          l[i]:=l[i<<1];
          r[i]:=r[(i<<1)+1];
          na[i]:=na[i<<1]+na[(i<<1)+1];
          nb[i]:=nb[i<<1]+nb[(i<<1)+1];
          if na[i]<nb[i] then
          begin
               for j:=l[i] to ((l[i]+r[i])>>1) do
                   for k:=(((l[i]+r[i])>>1)+1) to r[i] do
                   begin
                        if ((x[j] or x[k])=0) then
                        begin
                             inc(s,2*a[j,k]);
                        end
                        else
                        if ((x[j] and x[k])=1) then
                        begin
                        end
                        else
                        begin
                             inc(s,a[j,k]);
                        end;
                   end;
          end
          else
          begin
               for j:=l[i] to ((l[i]+r[i])>>1) do
                   for k:=(((l[i]+r[i])>>1)+1) to r[i] do
                   begin
                        if ((x[j] or x[k])=0) then
                        begin
                        end
                        else
                        if ((x[j] and x[k])=1) then
                        begin
                             inc(s,2*a[j,k]);
                        end
                        else
                        begin
                             inc(s,a[j,k]);
                        end;
                   end;
          end;
     end;
     sum:=s;
end;
procedure main;
var
   i,j,delta:longint;
   now:longint;
   best:array[0..5] of longint;
   T:double;
   d:longint;
   L:longint;
   ans:longint;
begin
     T:=200;
     L:=50;
     randomize;
     for i:=1 to 3 do
         for j:=1 to m do
             x[i][j]:=random(2);
     for i:=1 to m do best[i]:=sum(x[i]);
     while T>=1e-5 do
     begin
       for j:=1 to 3 do
       begin
          for i:=1 to L do
          begin
               tmp[j]:=x[j];
               delta:=random(m)+1;
               tmp[j][delta]:=tmp[j][delta] xor 1;
               now:=sum(tmp[j]);
               d:=now-best[j];
               if (now<best[j]) then
               begin
                    best[j]:=now;
                    x[j]:=tmp[j];
               end
               else
               if (exp(-d/T)>random(1)) then
               begin
                    best[j]:=now;
                    x[j]:=tmp[j];
               end;
          end;
       end;
       T:=T*0.8;
     end;
     ans:=maxlongint;
     for i:=1 to 3 do
         if ans>best[i] then ans:=best[i];
     writeln(ans);
end;
begin
     fon;
     init;
     main;
     foff;
end.