如果发现广告等破坏行为,请尽量将条目恢复到较早的版本而不是把相应内容直接删除,谢谢合作。

Code:Camelot solution/Pascal

来自"NOCOW"

跳转到: 导航, 搜索
{
ID: starfor1
PROG: camelot
LANG: PASCAL
}
const
  dx:array[1..8]of shortint=(1,2,2,1,-1,-2,-2,-1);
  dy:array[1..8]of shortint=(2,1,-1,-2,-2,-1,1,2);
var
  ii,jj,i,j,fx,ex,fy,ey:shortint;
  k,n,g,d,re,vx,vy:word;
  r,c,kx,ky:byte;
  x,y:array[1..1040]of byte;
  km:array[1..26,1..40]of byte;
  dis:array[1..26,1..40,1..26,1..40]of byte;
  ch,bk:char;
//
procedure fill (sx,sy:byte);
var
  f,e,mx:word;
  i,st:byte;
  tx,ty:shortint;
  slot:array[1..1040,1..2]of byte;
begin
  f:=1;
  e:=2;
  mx:=1;
  st:=1;
  slot[f,1]:=sx;
  slot[f,2]:=sy;
  dis[sx,sy,sx,sy]:=0;
  repeat
    for i:=1 to 8 do
    begin
      tx:=slot[f,1]+dx[i];
      ty:=slot[f,2]+dy[i];
      if (tx>=1) and (tx<=c) and (ty>=1) and (ty<=r) and (dis[sx,sy,tx,ty]=$FF) then
      begin
        slot[e,1]:=tx;
        slot[e,2]:=ty;
        dis[sx,sy,tx,ty]:=st;
        inc(e);
      end;
    end;
    inc(f);
    if f>mx then
    begin
      inc(st);
      mx:=e-1;
    end;
  until f=e;
end;
//
function min (a,b:word):word;
begin
  if a>b then
    exit(b)
  else
    exit(a);
end;
//
begin
  assign(input,'camelot.in');
  assign(output,'camelot.out');
  reset(input);
  rewrite(output);
  readln(r,c);
  readln(ch,bk,ky);
  kx:=ord(ch)-64;
  km[kx,ky]:=0;
  for i:=1 to c do
    for j:=1 to r do
      if abs(i-kx)>abs(j-ky) then
        km[i,j]:=abs(i-kx)
      else
        km[i,j]:=abs(j-ky);
  n:=0;
  while not eof do
  begin
    inc(n);
    read(ch,bk,y[n]);
    x[n]:=ord(ch)-64;
    if eoln then
      readln
    else
      read(bk);
  end;
  fillchar(dis,sizeof(dis),$FF);
  re:=maxsmallint*2+1;
  vx:=kx;
  vy:=ky;
  for k:=1 to n do
  begin
    inc(vx,x[k]);
    inc(vy,y[k]);
  end;
  vx:=vx div (n+1);
  vy:=vy div (n+1);
  if n>1 then
  begin
    fx:=vx-2;
    ex:=vx+2;
    fy:=vy-2;
    ey:=vy+2;
  end
  else
  begin
    fx:=1;
    ex:=c;
    fy:=1;
    ey:=r;
  end;
  for i:=fx to ex do
    for j:=fy to ey do
      if (i>=1) and (i<=c) and (j>=1) and (j<=r) then
        fill(i,j);
  for ii:=kx-1 to kx+1 do
    for jj:=ky-1 to ky+1 do
      if (ii>=1) and (ii<=c) and (jj>=1) and (jj<=r) then
        fill(ii,jj);
  for i:=fx to ex do
    for j:=fy to ey do
      if (i>=1) and (i<=c) and (j>=1) and (j<=r) then
      begin
        g:=0;
        for k:=1 to n do
          inc(g,dis[i,j,x[k],y[k]]);
        if g>re then
          continue;
        d:=km[i,j];
        for ii:=kx-1 to kx+1 do
          for jj:=ky-1 to ky+1 do
            if (ii>=1) and (ii<=c) and (jj>=1) and (jj<=r) then
              for k:=1 to n do
                d:=min(d,dis[ii,jj,x[k],y[k]]+dis[ii,jj,i,j]+km[ii,jj]-dis[i,j,x[k],y[k]]);
        g:=g+d;
        re:=min(re,g);
      end;
  writeln(re);
  close(output);
end.


奇丑无比的代码,但是仍然要纪念一下,写了这么多行。

{
ID: 31440461
PROG: camelot
LANG: PASCAL
}
 
 
const way:array[1..8,1..2] of integer
         =((2,1),(2,-1),(-2,1),(-2,-1),
           (1,2),(1,-2),(-1,2),(-1,-2));
      way2:array[1..8,1..2] of integer
         =((0,1),(0,-1),(-1,0),(1,0),
           (1,1),(1,-1),(-1,1),(-1,-1));
      way3:array[1..16,1..2] of integer
         =((-2,-2),(-2,-1),(-2,0),(-2,1),
           (-2,2),(-1,2),(-1,-2),(0,-2),
           (0,2),(1,-2),(1,2),(2,-2),
           (2,-1),(2,0),(2,1),(2,2));
 
      maxn=26*30;
      maxdis=99999999;
type re=record
          x,y:integer;
        end;
 
var sum,i,t,r,c,s,n,j,ans,dd:longint;
    man:array[0..26*30,1..2] of longint;
    po:Array[0..26*30] of longint;
    neib:array[0..26*30,0..80] of longint;
    ch:String;
    visit:array[1..maxn] of boolean;
    queue:array[0..maxn] of longint;
    dis:Array[1..maxn,1..maxn] of longint;
    alldis:array[1..maxn] of longint;
 
//
Function OK(X,Y:longint):boolean;
begin
  exit((x<=R)and(X>=1)and(y<=C)and(Y>=1));
end;
//
procedure SPFA(v:longint);
var    i,t,q,now:longint;
begin
  for i:=1 to n do dis[v,i]:=maxdis;
  dis[v,v]:=0;
  fillchar(visit,sizeof(visit),false);
  queue[0]:=v;
  t:=1;
  q:=0;//q is qi
  visit[v]:=true;
  while t>0 do
  begin
   now:=queue[q mod n];
   for i:=1 to neib[now,0] do
     if dis[v,neib[now,i]]>dis[v,now]+1 then
     begin dis[v,neib[now,i]]:=dis[v,now]+1;
           if not visit[neib[now,i]] then
           begin
               queue[(q+t)mod n]:=neib[now,i];
               inc(t);
               visit[neib[now,i]]:=true;
           end;
     end;
   inc(q);
   dec(t);
  end;//while
  for i:=1 to n do dis[i,v]:=dis[v,i];
end;
 
 
begin
  assign(input,'camelot.in');
  reset(input);
  assign(output,'camelot.out');
  rewrite(output);
 
  readln(c,r);
  sum:=-1;
  while not eof do
  begin readln(ch);
        while length(ch)>0 do
        begin
          if ch[1]=' ' then begin delete(ch,1,1);continue;end;
 
          if (ch[1]>='A') and (ch[1]<='Z') then
          begin
           inc(sum);
           man[sum,1]:=ord(ch[1])-ord('A')+1;
           delete(ch,1,2);
           while (ch[1]<>' ')and(ch<>'') do
           begin
             man[sum,2]:=man[sum,2]*10+ord(ch[1])-ord('0');
             delete(ch,1,1);
           end;
           //if there[man[sum,1],man[sum,2]] then dec(sum)
           //else there[man[sum,1],man[sum,2]]:=true;
          end;
        end;
  end;
close(input);
//bt 的读入
 
 
 
if sum=0 then begin 
                writeln(0);
                close(output);
                halt;
              end;
for i:=0 to sum do 
       po[i]:=man[i,1]+(man[i,2]-1)*r;
 
 
//二维棋盘转化为一维
for i:=1 to r do
  for j:=1 to c do
    for s:=1 to 8 do
     if OK(i+way[s,1],j+way[s,2]) then
     begin inc(neib[i+(j-1)*r,0]);
           neib[i+(j-1)*r,neib[i+(j-1)*r,0]]:=
           i+way[s,1]+(j+way[s,2]-1)*r;
     end;
//
n:=R*C;
for i:=0 to sum do SPFA(po[i]);
 
//下面还要求解国王周围的点
for s:=1 to 8 do
     if OK(man[0,1]+way2[s,1],man[0,2]+way2[s,2]) then
     begin t:=man[0,1]+way2[s,1]+(man[0,2]+way2[s,2]-1)*r;
           SPFA(T);
     end;
for s:=1 to 16 do
     if OK(man[0,1]+way3[s,1],man[0,2]+way3[s,2]) then
     begin t:=man[0,1]+way3[s,1]+(man[0,2]+way3[s,2]-1)*r;
           SPFA(T);
     end;
 
//统计任意点的总路程
for i:=1 to n do
  for j:=1 to sum do inc(alldis[i],dis[i,po[j]]);
 
ans:=maxdis;
 
for i:=1 to n do
  for j:=1 to sum do
  begin
    dd:=alldis[i]-dis[po[j],i]+dis[po[j],po[0]]+dis[po[0],i];
    if dd<ans then
        ans:=dd;
    for s:=1 to 8 do
     if OK(man[0,1]+way2[s,1],man[0,2]+way2[s,2]) then
     begin t:=man[0,1]+way2[s,1]+(man[0,2]+way2[s,2]-1)*r;
           dd:=alldis[i]-dis[po[j],i]+dis[po[j],t]+dis[t,i]+1;
           if dd<ans
            then ans:=dd;
     end;
    for s:=1 to 16 do
     if OK(man[0,1]+way3[s,1],man[0,2]+way3[s,2]) then
     begin t:=man[0,1]+way3[s,1]+(man[0,2]+way3[s,2]-1)*r;
           dd:=alldis[i]-dis[po[j],i]+dis[po[j],t]+dis[t,i]+2;
           if dd<ans
            then ans:=dd;
     end;
  end;
 
writeln(ans);
close(output);
end.
个人工具