Online JudgeProblem SetAuthorsOnline ContestsUser
Web Board
Home Page
F.A.Qs
Statistical Charts
Problems
Submit Problem
Online Status
Prob.ID:
Register
Update your info
Authors ranklist
Current Contest
Past Contests
Scheduled Contests
Award Contest
User ID:
Password:
  Register

贴个pascal的

Posted by jinzhihan at 2014-07-20 22:04:30 on Problem 3694
type
  arr=record
    di,front:longint;
  end;

var
  a,b:array[0..500000] of arr;
  head,head1,dfn,low,vis,col,c,fa,father,de:array[0..200000] of longint;
  f:array[0..200000,0..20] of longint;
  n,m,mm,i,j,x,y,ans,color,time,top,q,po,cases,ques,xx,yy:longint;

procedure addedge(x,y:longint);
begin
  inc(m); a[m].di:=y; a[m].front:=head[x]; head[x]:=m;
  inc(m); a[m].di:=x; a[m].front:=head[y]; head[y]:=m;
end;

procedure addedge1(x,y:longint);
begin
  inc(mm); b[mm].di:=y; b[mm].front:=head1[x]; head1[x]:=mm;
end;

function min(x,y:longint):longint;
begin
  if x<y then min:=x else min:=y;
end;

procedure tarjan(k,fa:longint);
var
  q,po:longint;
begin
  inc(time); dfn[k]:=time; low[k]:=time; vis[k]:=1;
  inc(top); c[top]:=k;  q:=head[k];
  while q>-1 do
    begin
      po:=a[q].di;
      if q xor 1<>fa
        then
          if vis[po]=0
            then
              begin
                tarjan(po,q);
                low[k]:=min(low[k],low[po]);
              end
            else
              if vis[po]=1
                then low[k]:=min(low[k],dfn[po]);
      q:=a[q].front;
    end;
  if dfn[k]=low[k]
    then
      begin
        inc(color);
        while c[top]<>k do
          begin
            col[c[top]]:=color;
            vis[c[top]]:=2;
            dec(top);
          end;
        col[c[top]]:=color;
        vis[c[top]]:=2;
        dec(top);
      end;
end;

procedure dfs(k,fa:longint);
var
  q,po:longint;
begin
  vis[k]:=1; father[k]:=fa;  de[k]:=de[fa]+1;
  q:=head1[k];
  while q>-1 do
    begin
      po:=b[q].di;
      if vis[po]=0 then dfs(po,k);
      q:=b[q].front;
    end;
end;

procedure make;
var
  i,j:longint;
begin
  for i:=1 to color do f[i,0]:=father[i];
  for i:=0 to 20 do f[0,i]:=0;
  for j:=1 to 20 do
    for i:=1 to color do
      f[i,j]:=f[f[i,j-1],j-1];
end;

function find(k:longint):longint;
begin
  if fa[k]=k then exit(k);
  fa[k]:=find(fa[k]);
  find:=fa[k];
end;

function lca(u,v:longint):longint;
var
  t,i:longint;
begin
  t:=de[u]-de[v];
  for i:=0 to 20 do
    if t and (1 shl i)>0 then u:=f[u,i];
  if u=v then exit(u);
  for i:=20 downto 0 do
    if (1 shl i<=de[x]-1) and (f[u,i]<>f[v,i])
      then begin u:=f[u,i]; v:=f[v,i]; end;
  lca:=f[u,0];
end;

procedure work(u,v,lca:longint);
var
  t1,t2:longint;
begin
  while u<>lca do
    begin
      t1:=find(u); t2:=father[t1];
      if de[t2]<de[lca] then break;
      if t1=1 then break;
      dec(ans);
      fa[t1]:=find(t2);
      u:=t2;
    end;
  while v<>lca do
    begin
      t1:=find(v); t2:=father[t1];
      if de[t2]<de[lca] then break;
      if t1=1 then break;
      dec(ans);
      fa[t1]:=find(t2);
      v:=t2;
    end;
end;

begin
  cases:=0;
  while true do
    begin
      readln(n,mm);
      if (n=0) and (mm=0) then halt;
      inc(cases);
      m:=-1; time:=0; top:=0; color:=0;
      for i:=1 to n do
        begin
          vis[i]:=0; head[i]:=-1; col[i]:=0;
        end;
      for i:=1 to mm do
        begin
          read(x,y);
          addedge(x,y);
        end;

      tarjan(1,-1);
      for i:=1 to color do
        begin
          head1[i]:=-1; vis[i]:=0;
        end;
      mm:=-1;
      for i:=1 to n do
        begin
          q:=head[i];
          while q>-1 do
            begin
              po:=a[q].di;
              if col[i]<>col[po] then addedge1(col[i],col[po]);
              q:=a[q].front;
            end;
        end;

      if cases>1 then writeln;
      writeln('Case ',cases,':');
      ans:=color-1;

      for i:=1 to color do fa[i]:=i;
      de[0]:=0; fa[0]:=0;
      dfs(1,0);
      make;
      readln(ques);
      while ques>0 do
        begin
          dec(ques);
          readln(xx,yy);
          if de[col[xx]]>de[col[yy]]
            then begin x:=col[xx]; y:=col[yy]; end
            else begin y:=col[xx]; x:=col[yy]; end;
          work(x,y,lca(x,y));
          writeln(ans);
        end;
    end;
end.

Followed by:

Post your reply here:
User ID:
Password:
Title:

Content:

Home Page   Go Back  To top


All Rights Reserved 2003-2013 Ying Fuchen,Xu Pengcheng,Xie Di
Any problem, Please Contact Administrator