比赛 20120710 评测结果 AAAAAAAAAA
题目名称 三元限制最短路 最终得分 100
用户昵称 IMSL77 运行时间 1.203 s
代码语言 Pascal 内存使用 124.73 MiB
提交时间 2012-07-10 11:49:27
显示代码纯文本
program patha;
type
  integer=longint;
  tri=record A,B,C:integer; end;
const
  maxn=4000;
  maxm=50000;
  maxk=150000;
var
  n,m,k,tot:integer;
  ver:array[1..maxn] of integer;
  en,next:array[1..maxm] of integer;
  avo:array[1..maxk] of tri;
  d:array[1..maxn,1..maxn] of integer;
  prev:array[1..maxn,1..maxn] of integer;
  Q:array[1..maxm,1..2] of integer;

  procedure Fopen;
  begin
    assign(input,'patha.in'); reset(input);
    assign(output,'patha.out'); rewrite(output);
  end;

  procedure Fclose;
  begin
    close(input); close(output);
  end;

  function equal(p1,p2:tri):boolean;
  begin
    exit((p1.A=p2.A) and (p1.B=p2.B) and (p1.C=p2.C));
  end;

  function less(p1,p2:tri):boolean;
  begin
    if p1.A<p2.A then exit(true); if p1.A>p2.A then exit(false);
    if p1.B<p2.B then exit(true); if p1.B>p2.B then exit(false);
    if p1.C<p2.C then exit(true); if p1.C>p2.C then exit(false);
    exit(false);
  end;

  procedure QSort(l,r:integer);
  var
    i,j:integer;
    t,x:tri;
  begin
    if l>r then exit;
    i:=l; j:=r;
    x:=avo[(l+r) shr 1];
    repeat
      while less(avo[i],x) do inc(i);
      while less(x,avo[j]) do dec(j);
      if i<=j then
      begin
        t:=avo[i]; avo[i]:=avo[j]; avo[j]:=t;
        inc(i); dec(j);
      end;
    until i>j;
    if l<j then QSort(l,j);
    if i<r then QSort(i,r);
  end;

  procedure addedge(u,v:integer);
  begin
    inc(tot);
    en[tot]:=v; next[tot]:=ver[u]; ver[u]:=tot;
  end;

  procedure SetGraph;
  var
    i:integer;
    u,v:integer;
  begin
    readln(n,m,k);
    fillchar(ver,sizeof(ver),0);
    fillchar(next,sizeof(next),0);
    tot:=0;
    for i:=1 to m do
    begin
      readln(u,v);
      addedge(u,v); addedge(v,u);
    end;
    for i:=1 to k do readln(avo[i].A,avo[i].B,avo[i].C);
    QSort(1,k);
  end;

  function inlaw(x,y,z:integer):boolean;
  var
    l,r,mid:integer;
    p:tri;
  begin
    with p do begin A:=x; B:=y; C:=z; end;
    l:=1; r:=k;
    while l<=r do
    begin
      mid:=(l+r) shr 1;
      if equal(avo[mid],p) then exit(false);
      if less(avo[mid],p) then l:=mid+1 else r:=mid-1;
    end;
    exit(true);
  end;

  procedure print(x,y:integer);
  begin
    if x=0 then exit;
    print(prev[x,y],x);
    write(x,' ');
  end;

  procedure BFS;
  var
    head,tail:integer;
    x,y,z,p,min:integer;
  begin
    if n=1 then begin writeln(0); writeln(1); exit; end;
    fillchar(d,sizeof(d),0);
    fillchar(prev,sizeof(prev),0);
    head:=1; tail:=1;
    p:=ver[1];
    while p>0 do
    begin
      x:=en[p];
      if x=n then begin writeln(1); writeln(1,' ',n); exit; end;
      d[1,x]:=1;
      Q[tail,1]:=1; Q[tail,2]:=x;
      inc(tail);
      p:=next[p];
    end;
    while head<tail do
    begin
      x:=Q[head,1]; y:=Q[head,2];
      p:=ver[y];
      while p>0 do
      begin
        z:=en[p];
        if (d[y,z]=0) and inlaw(x,y,z) then
        begin
          d[y,z]:=d[x,y]+1;
          prev[y,z]:=x;
          Q[tail,1]:=y; Q[tail,2]:=z;
          inc(tail);
        end;
        p:=next[p];
      end;
      inc(head);
    end;
    min:=maxlongint;
    for x:=1 to n do if (d[x,n]>0) and (d[x,n]<min) then
    begin min:=d[x,n]; y:=x; end;
    writeln(min);
    print(y,n);  writeln(n);
  end;

begin
  Fopen;
  SetGraph;
  BFS;
  Fclose;
end.