ac1054.pas

同济大学 Online在线题库 AC源代码合集 程序设计竞赛必看资料

program tju1054;
const
  maxl=18;
  rands=9999;
var
  addr:array[0..maxl]of string;
  dist,d:array[0..maxl,0..maxl]of word;
  next:array[0..maxl]of byte;
  v:array[1..maxl]of boolean;
  l,i,j,r,ans:word;
function min(a,b:word):word;
  begin
    if a<b then min:=a else min:=b;
  end;
function caldist(s1,s2:string):word;
  var
    d1,d2:char;
    a1,a2,b1,b2,c1,c2:word;
  procedure decipher(s:string;var d:char;var a,b,c:word);
    var
      p:byte;
    begin
      d:=s[1];p:=pos(' ',s);
      val(copy(s,2,p-2),a,c);
      val(copy(s,p+1,length(s)-p),b,c);
      case d of
        'H':begin c:=(b-1) mod 28 shr 1+1;b:=(b-1) div 28;end;
        'V':begin c:=(b-1) mod 22 shr 1+1;b:=(b-1) div 22;end;
      end;
    end;
  begin
    decipher(s1,d1,a1,b1,c1);decipher(s2,d2,a2,b2,c2);
    if d1<>d2 then
      if d1='H' then
        caldist:=abs((b1*15+c1)-((a2-1)*15))+abs((b2*12+c2)-((a1-1)*12))
      else
        caldist:=abs((b2*15+c2)-((a1-1)*15))+abs((b1*12+c1)-((a2-1)*12))
    else if d1='H' then
      if (a1<>a2) and (b1=b2) then
        caldist:=abs(a1-a2)*12+min(c1+c2,30-c1-c2)
      else
        caldist:=abs(a1-a2)*12+abs((b1*15+c1)-(b2*15+c2))
    else
      if (a1<>a2) and (b1=b2) then
        caldist:=abs(a1-a2)*15+min(c1+c2,24-c1-c2)
      else
        caldist:=abs(a1-a2)*15+abs((b1*12+c1)-(b2*12+c2));
  end;
procedure solve;
  var
    s,d,m,x:word;
  begin
    fillchar(v,sizeof(v),0);v[1]:=true;
    next[0]:=1;next[1]:=255;
    s:=0;
    for i:=2 to l do begin
      j:=0;m:=65535;
      while next[j]<255 do begin
        d:=dist[j,i]+dist[i,next[j]]-dist[j,next[j]];
        if d<m then begin m:=d;x:=j;end;
        j:=next[j];
      end;
      inc(s,m);next[i]:=next[x];next[x]:=i;
    end;
    if s<ans then ans:=s;
  end;
procedure shuttle;
  var
    t:byte;
  begin
    for i:=1 to l do
      next[i]:=i;
    for i:=1 to l do begin
      j:=random(l)+1;
      t:=next[i];next[i]:=next[j];next[j]:=t;
    end;
    next[0]:=next[1];
    d:=dist;
    for i:=0 to l do
      for j:=0 to l do
        dist[i,j]:=d[next[i],next[j]];
  end;
begin
  repeat
    readln(l,l,l);inc(l);
    for i:=1 to l do
      readln(addr[i]);
    for i:=1 to l do
      for j:=1 to l do
        if i>j then dist[i,j]:=dist[j,i] else dist[i,j]:=caldist(addr[i],addr[j]);
    for i:=1 to l do begin
      dist[0,i]:=dist[1,i];dist[i,0]:=dist[i,1];
    end;

    ans:=65535;
    for r:=1 to rands do begin
      solve;
      if r<rands then shuttle;
    end;
    writeln(ans*10);
  until seekeof;
end.