Rq图结构水题～

rq141（二分图匹配，构图+ISAP做的，虽然有点大材小用，就当复习模板吧）：

var nn,n,m,s,t,i,x:longint;
    dis,vh,his,pre,di:array[0..402] of longint;
    map:array[1..402,1..402] of longint;
function flow:longint;
var i,j,j1,min,tmp,aug:longint; flag:boolean;
begin
     for i:=1 to nn do begin dis[i]:=0; di[i]:=1; vh[i]:=0; end; vh[0]:=nn;
     i:=s; aug:=maxlongint; flow:=0;
     while dis[s]<nn do begin
           his[i]:=aug; flag:=false;
           for j:=di[i] to nn do
               if (map[i,j]>0)and(dis[j]+1=dis[i]) then begin
                  flag:=true; if map[i,j]<aug then aug:=map[i,j];
                  pre[j]:=i; i:=j;
                  if i=t then begin
                     inc(flow,aug);
                     while i<>s do begin
                           tmp:=i; i:=pre[i];
                           dec(map[i,tmp],aug);
                           inc(map[tmp,i],aug);
                     end;
                     aug:=maxlongint;
                  end;
                  break;
               end;
           if flag then continue;
           min:=nn-1;
           for j:=1 to nn do
               if (map[i,j]>0)and(dis[j]<min) then begin
                  min:=dis[j]; j1:=j;
               end;
           di[i]:=j1;
           dec(vh[dis[i]]); if vh[dis[i]]=0 then break;
           dis[i]:=min+1; inc(vh[dis[i]]);
           if i<>s then begin i:=pre[i]; aug:=his[i]; end;
     end;
end;
begin
     assign(input,'rq141.in'); reset(input);
     assign(output,'rq141.out'); rewrite(output);
     fillchar(map,sizeof(map),0);
     readln(n,m);
     for i:=1 to n do begin
         while true do begin
               read(x);
               if x=0 then break;
               map[i,n+x]:=1;
         end;
         readln;
     end;
     s:=n+m+1; t:=n+m+2; nn:=n+m+2;
     for i:=1 to n do map[s,i]:=1;
     for i:=1 to m do map[n+i,t]:=1;
     write(flow);
     close(input); close(output);
end.

rq142（这题题意我很费解，他是怎么遍历的呢，但既然作者说是mst水题，那就水过吧～）：

var n,i,j:longint;
    dis:array[1..100,1..100] of longint;
    dist:array[1..100] of longint;
procedure updata(i:longint);
var j:longint;
begin
     dist[i]:=0;
     for j:=1 to n do
     if (dist[j]<>0)and(dis[i,j]<dist[j]) then
        dist[j]:=dis[i,j];
end;
function prim:longint;
var i,j,k,min:longint;
begin
     for i:=1 to n do dist[i]:=maxlongint;
     updata(1); prim:=0;
     for i:=2 to n do begin
         min:=maxlongint;
         for j:=1 to n do
         if (dist[j]<>0)and(dist[j]<min) then begin
            k:=j; min:=dist[j];
         end;
         updata(k); inc(prim,min);
     end;
end;
begin
     assign(input,'rq142.in'); reset(input);
     assign(output,'rq142.out'); rewrite(output);
     readln(n);
     for i:=1 to n do begin
         for j:=1 to n do
             read(dis[i,j]);
         readln;
     end;
     write(prim);
     close(input); close(output);
end.

rq190（图的遍历，不过要注意：有的点一开始就不与p连通）：

var a:array[1..200,1..200] of longint;
    vis:array[1..200] of boolean;
    can:array[0..200,1..200] of boolean;
    n,p,tot,i,j:longint;
procedure dfs(i:longint);
var j:longint;
begin
     vis[i]:=true;
     for j:=1 to n do
         if (a[i,j]=1)and(not vis[j]) then
            dfs(j);
end;
begin
     assign(input,'rq190.in'); reset(input);
     assign(output,'rq190.out'); rewrite(output);

     readln(n,p);
     for i:=1 to n do
     for j:=1 to n do
         read(a[i,j]);

     fillchar(vis,sizeof(vis),false);
     dfs(p);
     can[0]:=vis;

     for i:=1 to n do
     if i<>p then
     begin
         fillchar(vis,sizeof(vis),false);
         vis[i]:=true;
         dfs(p);
         can[i]:=vis;
     end;

     for i:=1 to n do
     if i<>p then begin
        if not can[0,i] then writeln('No')
        else begin
             tot:=0;
             for j:=1 to n do
             if (j<>p)and(j<>i)and(not can[j,i]) then begin
                inc(tot);
                write(j,#32);
             end;
             if tot=0 then writeln('No')
             else writeln;
        end;
     end;
     close(input); close(output);
end.

rq196（这题dfs模拟一下就好了）：

var g:array[0..99,1..100] of record x,dis:longint; end;
    vis:array[0..99] of boolean;
    tot:array[0..99] of longint;
    n,p,i,j,k,s,t,l,time:longint;
procedure swap(var a,b:longint);
var tmp:longint;
begin
     tmp:=a; a:=b; b:=tmp;
end;
procedure dfs(i:longint);
var j:longint;
begin
     vis[i]:=true;
     if i=p then write(time);
     for j:=1 to tot[i] do
     if not vis[g[i,j].x] then begin
        inc(time,g[i,j].dis);
        dfs(g[i,j].x);
        inc(time,g[i,j].dis);
     end;
end;
begin
     assign(input,'rq196.in'); reset(input);
     assign(output,'rq196.out'); rewrite(output);
     readln(n,p);

     for i:=0 to n-1 do tot[i]:=0;

     for i:=1 to n-1 do begin
         readln(s,t,l);
         inc(tot[s]); g[s,tot[s]].x:=t; g[s,tot[s]].dis:=l;
         inc(tot[t]); g[t,tot[t]].x:=s; g[t,tot[t]].dis:=l;
     end;

     for i:=0 to n-1 do
     for j:=1 to tot[i]-1 do
     for k:=j+1 to tot[i] do
     if g[i,j].dis>g[i,k].dis then begin
        swap(g[i,j].x,g[i,k].x);
        swap(g[i,j].dis,g[i,k].dis);
     end;

     fillchar(vis,sizeof(vis),false);
     time:=0;
     dfs(0);
     close(input); close(output);
end.

rq241（topsort，不过要注意他问的只是1所在子图的情况，我的程序里应该加上一个判断，但是数据没有无解情况，水过吧～）：

type link=^node; node=record x:longint; next:link; end;
var n,m,i,t,tot:longint;
    g:array[1..10] of link;
    rd,stack,list:array[1..10] of longint;
procedure conn(i,j:longint);
var p:link;
begin
     new(p);
     p^.x:=j;
     p^.next:=g[i];
     g[i]:=p;
     inc(rd[j]);
end;
procedure topsort;
var top,i,x:longint; p:link;
begin
     top:=0;
     for i:=1 to n do if rd[i]=0 then begin
         inc(top); stack[top]:=i;
     end;
     m:=0;
     while top>0 do begin
           x:=stack[top]; dec(top);
           inc(m); list[m]:=x;
           p:=g[x];
           while p<>nil do begin
                 dec(rd[p^.x]);
                 if rd[p^.x]=0 then begin
                    inc(top);
                    stack[top]:=p^.x;
                 end;
                 p:=p^.next;
           end;
     end;
end;
begin
     assign(input,'rq241.in'); reset(input);
     assign(output,'rq241.out'); rewrite(output);
     readln(n);
     fillchar(rd,sizeof(rd),0);
     for i:=1 to n do begin
         read(tot);
         while tot>0 do begin dec(tot);
               read(t);
               conn(t,i);
         end;
         readln;
     end;
     topsort;
     if m<n then write('What a poor boy!')
     else for i:=1 to n do begin
          write(list[i]);
          if i<n then write(#32);
     end;
     close(input); close(output);
end.

rq263（本来是构图SSSP的题，但是数据太水了，我就floyed水过了～）：

var m,n,tot,i,j,k:longint;
    dis:array[1..500,1..500] of longint;
    a:array[1..500] of longint;
begin
     assign(input,'rq263.in'); reset(input);
     assign(output,'rq263.,out'); rewrite(output);
     readln(m,n);
     for i:=1 to n do begin
         dis[i,i]:=0;
         for j:=i+1 to n do begin
             dis[i,j]:=maxlongint shr 1;
             dis[j,i]:=maxlongint shr 1;
         end;
     end;
     for i:=1 to m do begin
         tot:=0;
         while not eoln do begin
               inc(tot);
               read(a[tot]);
         end;
         readln;
         for j:=1 to tot-1 do
         for k:=j+1 to tot do
             dis[a[j],a[k]]:=1;
     end;
     for k:=1 to n do
     for i:=1 to n do
     if i<>k then
     for j:=1 to n do
     if (j<>k)and(j<>i) then
     if dis[i,j]>dis[i,k]+dis[k,j] then
        dis[i,j]:=dis[i,k]+dis[k,j];
     if dis[1,n]=maxlongint shr 1 then write('NO')
     else write(dis[1,n]-1);
     close(input); close(output);
end.

rq282（floyed在松弛操作时记下tot，不难，但是这个数据溢出很让人闹心，just》》int64，这好象是NOI07的题～）：

const Inf=1e20;
var dis,tot:array[1..100,1..100] of qword;
    n,m,i,j,k,a,b,c:longint;
    ans:double;
begin
     assign(input,'rq282.in'); reset(input);
     assign(output,'rq282.out'); rewrite(output);

     readln(n,m);

     for i:=1 to n do begin
         for j:=1 to n do begin
             dis[i,j]:=maxlongint;
             tot[i,j]:=1;
         end;
         dis[i,i]:=0;
     end;

     for i:=1 to m do begin
         readln(a,b,c);
         dis[a,b]:=c;
         dis[b,a]:=c;
     end;

     for k:=1 to n do
     for i:=1 to n do
     for j:=1 to n do
     if (k<>i)and(k<>j)and(i<>j) then
        if dis[i,k]+dis[k,j]<dis[i,j] then begin
           dis[i,j]:=dis[i,k]+dis[k,j];
           tot[i,j]:=tot[i,k]*tot[k,j];
        end else if dis[i,k]+dis[k,j]=dis[i,j] then
            tot[i,j]:=tot[i,j]+tot[i,k]*tot[k,j];

     for k:=1 to n do begin
         ans:=0;
         for i:=1 to n do
         for j:=1 to n do
         if (k<>i)and(k<>j)and(i<>j)and(dis[i,k]+dis[k,j]=dis[i,j]) then begin
            ans:=ans+tot[i,k]*tot[k,j]/tot[i,j];
         end;
         writeln(ans:0:3);
     end;

     close(input); close(output);
end.

rq333（看完题感觉有点陌生，然后看了看讨论，传说中的克鲁斯卡尔逆推～领教了～）：

type data=record x,y,len:int64; end;
var t,n,i:longint;
    a:array[1..15000] of data;
    num,father:array[1..15000] of longint;
    ans:qword;

procedure sort(l,r:longint);
var i,j:longint;
    tmp,mid:data;
begin
     i:=l; j:=r; mid:=a[(l+r)shr 1];
     repeat
           while a[i].len<mid.len do inc(i);
           while mid.len<a[j].len do dec(j);
           if i<=j then begin
              tmp:=a[i]; a[i]:=a[j]; a[j]:=tmp;
              inc(i); dec(j);
           end;
     until i>j;
     if i<r then sort(i,r);
     if l<j then sort(l,j);
end;
function f(i:longint):longint;
begin
     if father[i]=0 then exit(i);
     father[i]:=f(father[i]);
     exit(father[i]);
end;
begin
     assign(input,'rq333.in'); reset(input);
     assign(output,'rq333.out');rewrite(output);
     readln(t);
     while t>0 do begin
           dec(t);
           readln;
           readln(n);
           for i:=1 to n do begin father[i]:=0; num[i]:=1; end;
           for i:=1 to n-1 do readln(a[i].x,a[i].y,a[i].len);
           sort(1,n-1);
           ans:=0;
           for i:=1 to n-1 do begin
               ans:=ans+a[i].len+(num[f(a[i].x)]*num[f(a[i].y)]-1)*(a[i].len+1);
               inc(num[f(a[i].x)],num[f(a[i].y)]);
               father[f(a[i].y)]:=f(a[i].x);
           end;

           writeln(ans);
     end;
     close(input); close(output);
end.

rq480（这题这数据规模咋做都不带tle的，但还是写floyed简单，代码短～）：

var n,i,j,k,x,tot:longint;
    g:array[1..500,1..500] of boolean;
    vis:array[1..500] of boolean;
begin
     assign(input,'rq480.in'); reset(input);
     assign(output,'rq480.out'); rewrite(output);
     readln(n);
     for i:=1 to n do begin
         for j:=1 to n do begin
             read(x);
             if x=1 then g[i,j]:=true
             else g[i,j]:=false;
         end;
         g[i,i]:=true;
         readln;
     end;
     for k:=1 to n do
     for i:=1 to n do
     for j:=1 to n do
         g[i,j]:=g[i,j]or(g[i,k]and g[k,j]);

     tot:=0;
     fillchar(vis,sizeof(vis),false);
     for i:=1 to n do
     if not vis[i] then begin
        inc(tot);
        for j:=1 to n do
            if g[i,j] then begin
               vis[j]:=true;
            end;
     end;
     writeln(tot);

     fillchar(vis,sizeof(vis),false);
     for i:=1 to n do
     if not vis[i] then begin
        for j:=1 to n do
            if g[i,j] then begin
               write(j,#32);
               vis[j]:=true;
            end;
        writeln;
     end;
     close(input); close(output);
end.

rq492（prim的时候构个图，然后就SSSP，看这数据规模，不用floyed水过都对不起他～）：

const Inf=1e19;
var n,i:longint;
    x,y:array[1..100] of extended;
    dist:array[1..100] of extended;
    pre:array[1..100] of longint;
    g:array[1..100,1..100] of extended;
function dis(i,j:longint):extended;
begin
     dis:=sqrt(sqr(x[i]-x[j])+sqr(y[i]-y[j]));
end;
procedure updata(i:longint);
var j:longint;
begin
     dist[i]:=0;
     for j:=1 to n do
         if (dist[j]<>0)and(dist[j]>dis(i,j)) then begin
            dist[j]:=dis(i,j);
            pre[j]:=i;
         end;
end;
function prim:extended;
var i,j,k:longint;
    min:extended;
begin
     for i:=1 to n do dist[i]:=Inf;
     for i:=1 to n do begin
         g[i,i]:=0;
         for j:=i+1 to n do begin
             g[i,j]:=Inf;
             g[j,i]:=Inf;
         end;
     end;
     updata(1); prim:=0;
     for i:=2 to n do begin
         min:=Inf;
         for j:=1 to n do
             if (dist[j]<>0)and(dist[j]<min) then begin
                k:=j; min:=dist[j];
             end;
         g[pre[k],k]:=dis(pre[k],k);
         g[k,pre[k]]:=g[pre[k],k];
         prim:=prim+min;
         updata(k);
     end;
end;
function floyed:extended;
var i,j,k:longint;
begin
     for k:=1 to n do
     for i:=1 to n do
     for j:=1 to n do
         if g[i,j]>g[i,k]+g[k,j] then
            g[i,j]:=g[i,k]+g[k,j];
     exit(g[1,n]);
end;
begin
     assign(input,'rq492.in'); reset(input);
     assign(output,'rq192.out'); rewrite(output);
     readln(n);
     for i:=1 to n do readln(x[i],y[i]);
     writeln(prim:0:2,#32,floyed:0:2);
     close(input);close(output);

end.

rq564（判断环的存在，方法比较多，我是topsort，然后判断出来的点够不够～水过）：

var g:array[1..5000,1..5000] of longint;
    rd,stack:array[1..5000] of longint;
    n,i,j:longint;
function topsort:longint;
var m,x,top:longint;
begin
     top:=0;
     for i:=1 to n do if rd[i]=0 then begin
         inc(top); stack[top]:=i;
     end;
     m:=0;
     while top>0 do begin
           x:=stack[top]; dec(top); inc(m);
           for i:=1 to n do if g[x,i]=1 then begin
               dec(rd[i]);
               if rd[i]=0 then begin
                  inc(top);
                  stack[top]:=i;
               end;
           end;
     end;
     exit(m);
end;
begin
     assign(input,'rq564.in'); reset(input);
     assign(output,'rq564.out'); rewrite(output);
     readln(n);
     fillchar(rd,sizeof(rd),0);
     for i:=1 to n do begin
         for j:=1 to n do begin
             read(g[i,j]);
             if g[i,j]=1 then inc(rd[j]);
         end;
         readln;
     end;
     if topsort<n then writeln('Y')
     else writeln('N');
     close(input); close(output);
end.