const
  max=1000000;
var
  t,n,k,tot:longint;
  a:array[1..15,1..15] of longint;
  vx,vy:array[1..15] of boolean;
  l,lx,ly:array[1..15] of longint;
procedure init;
  var
    i,j,x:longint;
  begin
    fillchar(a,sizeof(a),0);
    readln(n);
    for i:=1 to n do
      for j:=1 to n do
        begin
          read(x);
          inc(a[x,i],j-1);
        end;
    for i:=1 to n do
      for j:=1 to n do
        begin
          read(x);
          inc(a[i,x],j-1);
        end;
    for i:=1 to n do
      for j:=1 to n do
        a[i,j]:=max-a[i,j];
  end;
function find(x:longint):boolean;
  var
    i:longint;
  begin
    if x=0 then exit(true);
    vx[x]:=true;
    for i:=1 to n do
      if (not vy[i]) and (lx[x]+ly[i]=a[x,i]) then
        begin
          vy[i]:=true;
          if find(l[i]) then
            begin
              l[i]:=x;
              exit(true)
            end
        end;
    exit(false);
  end;
procedure print;
  var
    i:longint;
  begin
    inc(tot);
    writeln('Best Pairing ',tot);
    for i:=1 to n do
      writeln('Supervisor ',i,' with Employee ',l[i]);
  end;
procedure dfs(x,s,t:longint);
  var
    i:longint;
  begin
    if (s=t) and (x>n) then
      begin
        print;
        exit;
      end;
    if s>t then exit;
    for i:=1 to n do
      if (l[i]=0) and (max-a[x,i]+s<=t) then
        begin
          l[i]:=x;
          dfs(x+1,s+max-a[x,i],t);
          l[i]:=0;
        end;
  end;
procedure main;
  var
    i,j,t,min,ans:longint;
  begin
    fillchar(lx,sizeof(lx),0); fillchar(ly,sizeof(ly),0);
    for i:=1 to n do
      for j:=1 to n do
        if lx[i]<a[i,j] then lx[i]:=a[i,j];
    for t:=1 to n do
      repeat
        fillchar(vx,sizeof(vx),false);
        fillchar(vy,sizeof(vy),false);
        if find(t) then break;
        min:=maxlongint;
        for i:=1 to n do if vx[i] then
          for j:=1 to n do if not vy[j] then
            if lx[i]+ly[j]-a[i,j]<min then min:=lx[i]+ly[j]-a[i,j];
        for i:=1 to n do if vx[i] then dec(lx[i],min);
        for i:=1 to n do if vy[i] then inc(ly[i],min);
      until false;
   ans:=0;
   for i:=1 to n do
     ans:=ans+max-a[l[i],i];
   writeln('Data Set ',k,' Best average difference: ',ans/n/2:0:6);
   fillchar(l,sizeof(l),0);
   tot:=0;
   dfs(1,0,ans);
   writeln;
  end;
begin
  readln(t);
  for k:=1 to t do
    begin
      init;
      main;
    end;
end.

• Try this data test ^_^.... (333) qrmajia 2009-09-23 13:29:40
  • 晕 这组数据是反着给的 把2个矩阵交换 就可以得到他给的数据了 题目的数据和描述不一样 (375) midnight123 2010-04-15 19:48:36