来自"NOCOW"

字符串处理+最短路

program cao;
const
  maxn=100;
var
  count,ans,fa,dis,queue:array[0..maxn] of longint;
  code:array[0..maxn,0..maxn] of dword;
  map:array[0..maxn,0..maxn] of longint;
  flag:array[0..maxn] of boolean;
  a,b,c,d,e,f,g,h,i,j,k,l,n,m,p,q,st,en,open,closed:longint;
  s:string;
 
function ok(a,b:longint):boolean;
var
  i,j:longint;
begin
  for i:=1 to count[a] do
    for j:=1 to count[b] do
      if code[a,i]=code[b,j] then exit(true);
  exit(false);
end;
 
function value(s:string):dword;
var
  i,p,x:longint;
  a:dword;
begin
  s:=s+‘.’;a:=0;p:=0;
  for i:=1 to 4 do begin
    x:=0;
    repeat
      inc(p);
      if s[p]=‘.’ then a:=a shl 8+x else x:=x*10+ord(s[p])-48;
    until s[p]=‘.’;
  end;
  value:=a;
end;
begin
  read(n);
  for i:=1 to n do begin
    readln(count[i]);
    for j:=1 to count[i] do begin
      readln(s);
      p:=pos(‘ ‘,s);
      code[i,j]:=value(copy(s,1,p-1)) and value(copy(s,p+1,length(s)-p));
    end;
  end;
  fillchar(map,sizeof(map),26);
  for i:=1 to n do
    map[i,i]:=0;
  for i:=1 to n do
    for j:=1 to n do
      if i<>j then
        if ok(i,j) then
          map[i,j]:=1;
  fillchar(dis,sizeof(dis),26);
  read(st,en);
  queue[1]:=st;
  flag[st]:=true;
  open:=1;
  closed:=1;
  repeat
    for i:=1 to n do
     if (flag[i]=false)and(map[queue[closed],i]=1) then
     begin
       flag[i]:=true;
       fa[i]:=queue[closed];
       inc(open);
       queue[open]:=i;
     end;
    inc(closed);
  until closed>open;
 
 
  if flag[en]=false then
    writeln(‘No’)
  else
  begin
    i:=en;
    j:=0;
    while i<>0 do
    begin
      inc(j);
      ans[j]:=i;
      i:=fa[i];
    end;
    writeln(‘Yes’);
    for i:=j downto 1 do
      write(ans[i],‘ ‘);
    writeln;
  end;
end.

yuanyuan's solution:

const
  maxn=90+5;
  maxk=5;
var
  n,i,j,g,i1,i2,i3,i4,n1,n2,n3,n4,s,t,head,tail,now:longint;
  k,path,f:array[1..maxn] of longint;
  a:array[1..maxn,1..maxk] of array[1..4] of longint;
  st:string;
  b:array[1..maxn,0..maxn] of longint;
  v:array[1..maxn] of boolean;
  d:array[1..maxn shl 1] of longint;
function match(i,j:longint):boolean;
  var
    ii,jj:longint;
  begin
    for ii:=1 to k[i] do
      for jj:=1 to k[j] do
        if (a[i,ii][1]=a[j,jj][1]) and (a[i,ii][2]=a[j,jj][2]) and (a[i,ii][3]=a[j,jj][3]) and (a[i,ii][4]=a[j,jj][4])
          then exit(true);
    exit(false);
  end;
begin
  readln(n);
  for i:=1 to n do
    begin
      readln(k[i]);
      for j:=1 to k[i] do
        begin
          readln(st);
          g:=pos('.',st);val(copy(st,1,g-1),i1);delete(st,1,g);
          g:=pos('.',st);val(copy(st,1,g-1),i2);delete(st,1,g);
          g:=pos('.',st);val(copy(st,1,g-1),i3);delete(st,1,g);
          g:=pos(' ',st);val(copy(st,1,g-1),i4);delete(st,1,g);
          g:=pos('.',st);val(copy(st,1,g-1),n1);delete(st,1,g);
          g:=pos('.',st);val(copy(st,1,g-1),n2);delete(st,1,g);
          g:=pos('.',st);val(copy(st,1,g-1),n3);delete(st,1,g);
          val(st,n4);
          a[i,j][1]:=i1 and n1;
          a[i,j][2]:=i2 and n2;
          a[i,j][3]:=i3 and n3;
          a[i,j][4]:=i4 and n4;
        end;
    end;
  fillchar(b,sizeof(b),0);
  for i:=1 to n-1 do
    for j:=i+1 to n do
      if match(i,j) then
        begin
          inc(b[i,0]);
          b[i,b[i,0]]:=j;
          inc(b[j,0]);
          b[j,b[j,0]]:=i;
        end;
  readln(s,t);
  fillchar(path,sizeof(path),0);
  fillchar(v,sizeof(v),false);v[s]:=true;
  d[1]:=s;
  filldword(f,sizeof(f) shr 2,maxlongint);
  f[s]:=0;
  head:=1;tail:=1;
  while head<=tail do
    begin
      now:=d[head];
      for i:=1 to b[now,0] do
        if f[b[now,i]]>f[now]+1 then
          begin
            f[b[now,i]]:=f[now]+1;
            path[b[now,i]]:=now;
            if not(v[b[now,i]]) then
              begin
                inc(tail);
                d[tail]:=b[now,i];
                v[b[now,i]]:=true;
              end;
          end;
      v[now]:=false;
      inc(head);
    end;
  if f[t]=maxlongint
    then writeln('No')
    else begin
           writeln('Yes');
           i:=1;
           d[1]:=t;
           j:=t;
           while path[j]>0 do
             begin
               inc(i);
               d[i]:=path[j];
               j:=path[j];
             end;
           for j:=i downto 1 do
             write(d[j],' ');
           writeln; 
         end;
end.

http://www.withflying.com/?p=134

http://www.withflying.com