Problem 4 上白泽慧音(classroom.cpp/c/pas)

 

Problem 4  上白泽慧音(classroom.cpp/c/pas)
题目描述  在幻想乡，上白泽慧音是以知识渊博闻名的老师。春雪异变导致人间之里的很多道路都被大
雪堵塞，使有的学生不能顺利地到达慧音所在的村庄。因此慧音决定换一个能够聚集最多人
数的村庄作为新的教学地点。人间之里由 N 个村庄（编号为 1..N）和 M 条道路组成，道路分
为两种一种为单向通行的，一种为双向通行的，分别用 1 和 2 来标记。如果存在由村庄 A 到
达村庄 B 的通路，那么我们认为可以从村庄A 到达村庄B，记为(A,B)。当(A,B)和(B,A)同时满足
时，我们认为 A,B 是绝对连通的，记为<A,B>。绝对连通区域是指一个村庄的集合，在这个集
合中任意两个村庄 X,Y 都满足<X,Y>。现在你的任务是，找出最大的绝对连通区域，并将这个绝
对连通区域的村庄按编号依次输出。若存在两个最大的，输出字典序最小的，比如当存在 1,3,4
和 2,5,6 这两个最大连通区域时，输出的是 1,3,4。
输入格式  第 1 行：两个正整数 N,M
第 2..M+1 行：每行三个正整数 a,b,t, t = 1 表示存在从村庄a 到 b 的单向道路，t = 2 表示村庄
a,b 之间存在双向通行的道路。保证每条道路只出现一次。
输出格式  第 1 行：  1 个整数，表示最大的绝对连通区域包含的村庄个数。
第 2 行：若干个整数，依次输出最大的绝对连通区域所包含的村庄编号。
  第3页  /  共4页
 

2010-9-11  Touhou Contest Stage 1  By Nettle
输入样例  5 5
1 2 1
1 3 2
2 4 2
5 1 2
3 5 1
输出样例  3
1 3 5
数据范围  对于 60%的数据：N <= 200 且 M <= 10,000
对于 100%的数据：N <= 5,000 且 M <= 50,000
 

60分算法：

弗洛伊德+并查集

 

var a:array[0..1000,0..1000] of boolean;
fa:array[0..1000] of longint;
ans:array[0..1000,0..1000] of longint;
v:array[0..1000] of boolean;
n,m,i,j,k,x,y,t,now,max,sum:longint;
function find(x:longint):longint;
begin
 if fa[x]<>x then fa[x]:=find(fa[x]);
 exit(fa[x]);
end;
begin
 assign(input,'classroom.in'); assign(output,'classroom.out');
 reset(input); rewrite(output);
 readln(n,m);
 for i:=1 to m do
  begin
   readln(x,y,t);
   a[x,y]:=true;
   if t=2 then a[y,x]:=true;
  end;
 for k:=1 to n do
  for i:=1 to n do
   for j:=1 to n do
    a[i,j]:=a[i,j] or (a[i,k] and a[k,j]);
 for i:=1 to n do
  fa[i]:=i;
 fillchar(v,sizeof(v),0);
 max:=0;
 for i:=1 to n do
  for j:=i+1 to n do
   if a[i,j] and a[j,i] then
   if find(i)<>find(j) then
    fa[find(i)]:=find(j);
 fillchar(ans,sizeof(ans),0);
 for i:=1 to n do
  if not v[i] then
  begin
   v[i]:=true;
   ans[i,0]:=1; ans[i,1]:=i;
   for j:=i+1 to n do
    if not v[j] then
     if find(i)=find(j) then
      begin
       inc(ans[i,0]); ans[i,ans[i,0]]:=j;
       v[j]:=true;
      end;
   if ans[i,0]>max then
    begin
     max:=ans[i,0]; k:=i;
    end;
  end;
 writeln(max);
 for i:=1 to ans[k,0] do
  write(ans[k,i],' ');
 close(input); close(output);
end.

 

ac程序：

var
  n,m,i,a,b,c,max,maxl,z,mark,j,color:longint;
  vis:array [-1..5001] of boolean;
  ans,col,time:array [-1..5001] of longint;
  g,gg:array [-1..5001,0..5001] of integer;

procedure init;
begin
  assign(input,'classroom.in'); reset(input);
  readln(n,m);
  for i:= 1 to n do begin g[i,0]:=0; gg[i,0]:=0; end;
  for i:= 1 to m do begin
    readln(a,b,c);
    if c=1 then begin
      inc(g[a,0]); g[a,g[a,0]]:=b;
      inc(gg[b,0]); gg[b,gg[b,0]]:=a;
    end
    else begin
      inc(g[a,0]); g[a,g[a,0]]:=b; inc(g[b,0]); g[b,g[b,0]]:=a;
      inc(gg[b,0]); gg[b,gg[b,0]]:=a; inc(gg[a,0]); gg[a,gg[a,0]]:=b;
    end;
  end;
  close(input);
end;

procedure kosa1(x:longint);
var i:longint;
begin
  vis[x]:=false;
  for i:= 1 to g[x,0] do
    if vis[g[x,i]] then
      kosa1(g[x,i]);
  inc(z);
  time[z]:=x;
end;

procedure kosa2(x:longint);
var i:longint;
begin
  col[x]:=color; inc(mark);
  for i:= 1 to gg[x,0] do
    if col[gg[x,i]]=0 then
      kosa2(gg[x,i]);
end;

procedure main;
begin
  fillchar(vis,sizeof(vis),true); z:=0;
  for i:= 1 to n do
    if vis[i] then
      kosa1(i);
  color:=0; fillchar(col,sizeof(col),0);
  max:=-maxlongint;
  for i:= z downto 1 do
    if col[time[i]]=0 then begin
      inc(color); mark:=0;
      kosa2(time[i]);
      if mark>max then begin
        max:=mark; maxl:=color;
      end;
    end;
end;

procedure print;
begin
  assign(output,'classroom.out'); rewrite(output);
  writeln(max);
  z:=0;
  for i:= 1 to n do
    if col[i]=maxl then begin
      inc(z); ans[z]:=i;
    end;
  for i:= 1 to z-1 do
    write(ans[i],' ');
  writeln(ans[z]);
  close(output);
end;

begin
  init;
  main;
  print;
end.