ac1069.pas

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

program tju1069;
const
  maxn=5000;
  maxk=1000;
var
  v1,v2:array[1..maxn*2-2]of word;
  last,ant,at,by:array[0..maxn]of word;
  pos,chase:array[1..maxk]of word;
  v:array[1..maxn]of boolean;
  gone:array[1..maxk]of boolean;
  n,k,l,root,i:word;
procedure qsort(s,t:word);
  var
    p,i,j,t1,t2:word;
  begin
    if s>=t then exit;
    p:=s+random(t-s+1);
    t1:=v1[p];t2:=v2[p];v1[p]:=v1[s];v2[p]:=v2[s];
    i:=s;j:=t;
    repeat
      while (i<j) and (v1[j]>=t1) do dec(j);
      if i=j then break;v1[i]:=v1[j];v2[i]:=v2[j];inc(i);
      while (i<j) and (v1[i]<=t1) do inc(i);
      if i=j then break;v1[j]:=v1[i];v2[j]:=v2[i];dec(j);
    until i=j;
    v1[i]:=t1;v2[i]:=t2;
    qsort(s,i-1);
    qsort(i+1,t);
  end;
procedure dfs1(x:word);
  var
    p,y:word;
  begin
    v[x]:=true;
    if ant[x]>0 then begin
      at[x]:=0;by[x]:=ant[x];exit;
    end;
    at[x]:=maxint;
    for p:=last[x-1]+1 to last[x] do begin
      y:=v2[p];if v[y] then continue;
      dfs1(y);
      if (at[y]<at[x]) or (at[y]=at[x]) and (by[y]<by[x]) then begin
        at[x]:=at[y];by[x]:=by[y];
      end;
    end;
    inc(at[x]);
  end;
procedure dfs2(x,min:word);
  var
    p,y:word;
  begin
    if at[x]>=maxint then exit;
    v[x]:=true;
    if (at[x]<=min) and not gone[by[x]] then begin
      ant[pos[by[x]]]:=0;ant[x]:=by[x];pos[by[x]]:=x;gone[by[x]]:=true;
    end;
    if at[x]=0 then exit;
    if at[x]<min then min:=at[x];
    for p:=last[x-1]+1 to last[x] do begin
      y:=v2[p];if v[y] then continue;
      dfs2(y,min);
    end;
  end;
begin
  repeat
    read(n);
    for i:=1 to n-1 do begin
      read(v1[i],v2[i]);
      v1[i+n-1]:=v2[i];v2[i+n-1]:=v1[i];
    end;
    qsort(1,n*2-2);
    fillchar(last,sizeof(last),0);
    for i:=1 to n*2-2 do last[v1[i]]:=i;
    for i:=1 to n do if last[i]=0 then last[i]:=last[i-1];

    fillchar(ant,sizeof(ant),0);
    fillchar(pos,sizeof(pos),0);
    read(k);
    for i:=1 to k do begin
      read(pos[i]);
      ant[pos[i]]:=i;
    end;

    fillchar(chase,sizeof(chase),0);
    read(l);
    for i:=1 to l do begin
      read(root);
      fillchar(v,sizeof(v),0);
      dfs1(root);
      fillchar(v,sizeof(v),0);
      fillchar(gone,sizeof(gone),0);
      dfs2(root,maxint);
      inc(chase[ant[root]]);
    end;

    for i:=1 to k do
      writeln(pos[i],' ',chase[i]);
  until seekeof;
end.