当前位置:首页 >> 学科竞赛 >>

Noip图论整理


图论程序整理 Edmonds-Karp var ans,i,j,k,s,t,tot,m,n,a,b,c:longint; u,v,w,next,other:array[0..200] of longint; point,d,q,pre:array[0..200] of longint; function min(a,b:longint):longint; begin if a&g

t;b then exit(b) else exit(a); end; procedure add_edge(a,b,c:longint); begin inc(k);u[k]:=a;v[k]:=b;w[k]:=c; next[k]:=point[a];point[a]:=k;other[k]:=k+1; inc(k);u[k]:=b;v[k]:=a;w[k]:=0; next[k]:=point[b];point[b]:=k;other[k]:=k-1; end; function found:boolean; var j,head,tail:longint; begin head:=0;tail:=1;q[1]:=s; fillchar(d,sizeof(d),127); d[s]:=0; while head<tail do begin inc(head); j:=point[q[head]]; while j<>0 do begin if (w[j]>0) and (d[u[j]]+1<d[v[j]]) then begin d[v[j]]:=d[u[j]]+1; pre[v[j]]:=j; inc(tail);q[tail]:=v[j]; if v[j]=t then exit(true); end; j:=next[j]; end; end; exit(false); end; procedure augment; var

p,flow:longint; begin p:=t; flow:=maxlongint; while p<>s do begin flow:=min(flow,w[pre[p]]); p:=u[pre[p]]; end; ans:=ans+flow; p:=t; while p<>s do begin dec(w[pre[p]],flow); inc(w[other[pre[p]]],flow); p:=u[pre[p]]; end; end; begin readln(m,n); s:=1;t:=n;tot:=n; fillchar(point,sizeof(point),0); k:=0; for i:=1 to m do begin read(a,b,c); add_edge(a,b,c); end; ans:=0; while found do augment; writeln(ans); end.

Dinic var map:array[0..201,0..201]of longint; dis,q:array[0..201]of longint; visit:array[0..201]of boolean; n,m,ans:longint; procedure init; var u,v,s,i:longint; begin readln(m,n);

for i:=1 to m do begin readln(u,v,s); inc(map[u,v],s); end; end; function can_build:boolean; var sum,i,len,head,u,v:longint; begin can_build:=false; fillchar(visit,sizeof(visit),false); q[0]:=n; visit[n]:=true; dis[n]:=0; len:=0; head:=0; while head<=len do begin u:=q[head]; for v:=1 to n do if (not visit[v])and(map[v][u]>0) then begin inc(len); q[len]:=v; visit[v]:=true; dis[v]:=dis[u]+1; if v=1 then can_build:=true; end; inc(head); end; end; function min(a,b:longint):longint; begin if a<b then exit(a) else exit(b); end; function bfs(u,flow:longint):longint; var v:longint; begin if u=n then exit(flow); for v:=1 to n do if (map[u][v]>0)and(dis[u]=dis[v]+1) then begin flow:=min(flow,map[u][v]); bfs:=bfs(v,flow); if bfs>0 then begin

dec(map[u][v],bfs); inc(map[v][u],bfs); exit; end; end; exit(0); end; procedure dinic; var i,j,flow:longint; begin while can_build do begin while true do begin flow:=bfs(1,maxlongint); if flow=0 then break; ans:=ans+flow; end; end; end; procedure print; begin writeln(ans); end; begin init; dinic; print; end. kosaraju; const maxn=100; var //map[x,i] 记录与点 x 邻接的第 i 个点的编号 map[x,0]记录和 x 邻接的点的个数 map,map1:array[1..maxn,0..maxn]of integer; visit:array[1..maxn]of boolean; //记录该点是否被遍历过 list:array[1..maxn]of integer; //记录 n 个点的遍历次序 n,m,pos,scc:integer; //pos 记录进入 list 数组的点的个数 scc 记录强连通分量的个数 procedure init; var i,x,y:integer; begin readln(n,m);

for i:=1 to m do begin readln(x,y); inc(map[x,0]); map[x,map[x,0]]:=y; //存储原图 inc(map1[y,0]); map1[y,map1[y,0]]:=x; //存储反向的图 end; end; procedure dfs(p:integer); var i,j,k:integer; begin visit[p]:=true; k:=map[p,0]; for i:=1 to k do begin j:=map[p,i]; if not visit[j] then dfs(j); end; inc(pos); list[pos]:=p; end; procedure dfs1(p:integer); var i,j,k:integer; begin visit[p]:=true; k:=map1[p,0]; for i:=1 to k do begin j:=map1[p,i]; if not visit[j] then dfs1(j); end; end; procedure kosaraju; var i,j,k:integer; begin //dfs 正向深搜 fillchar(visit,sizeof(visit),false); for i:=1 to n do if not visit[i] then dfs(i);

//dfs1 反向深搜 fillchar(visit,sizeof(visit),false); scc:=0; for i:=pos downto 1 do //每深搜完一次,表示找完一个强连通图,增加 scc if not visit[list[i]] then begin dfs1(list[i]); inc(scc); end; end; begin init; pos:=0; kosaraju; writeln(scc); End.

hungry var a:array[1..1000,1..1000] of boolean; b:array[1..1000] of longint; c:array[1..1000] of boolean; n,k,i,x,y,ans,m:longint; function path(x:longint):boolean; var i:longint; begin for i:=1 to n do if a[x][i] and not c[i] then begin c[i]:=true; if (b[i]=0) or (path(b[i])) then begin b[i]:=x; exit(true); end; end; exit(false); end; procedure hungary; var i:longint; begin fillchar(b,sizeof(b),0); for i:=1 to m do begin fillchar(c,sizeof(c),0);

if path(i) then inc(ans); end; end; begin fillchar(a,sizeof(a),0); readln(m,n); for i:=1 to k do begin readln(x,y); a[x][y]:=true; end; ans:=0; hungary; writeln(ans); end. Edmonds-karp var t,g:array[0..500,0..500]of longint; tot,d,min,r:array[0..500]of longint; v:array[0..500]of boolean; q:array[0..500]of longint; head,tail,i,x,y,m,n,s,e,c,max,j:longint; procedure sssp; begin fillchar(v,sizeof(v),false);v[1]:=true; fillchar(d,sizeof(d),0); fillchar(min,sizeof(min),127); q[1]:=1;tail:=1;head:=0; repeat inc(head); x:=q[head]; for i:=1 to tot[x] do begin y:=t[x,i]; if (g[x,y]>0)and(not v[y]) then begin inc(tail); q[tail]:=y; v[y]:=true; d[y]:=d[x]+1; r[y]:=x; if g[x,y]<min[x] then min[y]:=g[x,y] else min[y]:=min[x]; if y=m then exit; end; end;

until head>=tail; end; begin assign(input,'in.in'); reset(input); readln(n,m); for i:=1 to n do begin readln(s,e,c); inc(tot[s]);t[s,tot[s]]:=e; inc(tot[e]);t[e,tot[e]]:=s; inc(g[s,e],c); end; while true do begin sssp; if d[m]=0 then break else begin y:=m; for i:=1 to d[m] do begin x:=r[y]; g[x,y]:=g[x,y]-min[m]; g[y,x]:=g[y,x]+min[m]; y:=x; end; inc(max,min[m]); end; end; writeln(max); close(input); end. Spfa var p,c,s,t:longint; a,b:array[1..1000,1..1000] of longint; d:array[1..1000,0..1000] of longint; v:array[1..1000] of boolean; dist:array[1..1000] of longint; head,tail:longint; procedure init; var i,x,y,z:longint;

begin read(p,c); for i:=1 to c do begin readln(x,y,z); inc(b[x,0]); b[x,b[x][0]]:=y; a[x][y]:=z; inc(b[y][0]); b[y,b[y][0]]:=x; a[y][x]:=z; end; readln(s,t); end; procedure spfa(s:longint); var i,j,now,sum:longint; begin fillchar(d,sizeof(d),0); fillchar(v,sizeof(v),false); for j:=1 to p do dist[j]:=maxlongint; dis[s]:=0;v[s]:=true;d[1]:=s; head:=1;tail:=1; while head<=tail do begin now:=d[head]; for i:=1 to b[now][0] do if dist[b[now][i]]>dist[now]+a[now,b[now][i]] then begin dist[b[now][i]]:=dist[now]+a[now,b[now][i]]; if not v[b[now][i]] then begin inc[tail); d[tail]:=b[now][j]; v[b[now][i]]:=true; end; end; v[now]:=false; inc(head); end; end; procedure print; begin

writeln(dist[t]); end; begin init; spfa(s); print; end. Prim var g:array[1..100,1..100] of longint; min:array[0..100] of longint; u:array[0..100] of boolean; n,i,j,k,total:longint; begin readln(n); for i:=1 to n do begin for j:=1 to n do read(g[i][j]); end; fillchar(min,sizeof(min),$7f); min[1]:=0; fillchar(u,sizeof(u),1); for i:=1 to n do begin k:=0; for j:=1 to n do if u[j] and (min[j]<min[k]) then k:=j; u[k]:=false; for j:=1 to n do if u[j] and (g[k][j]<min[j]) then min[j]:=g[k][j]; end; total:=0; for i:=1 to n do inc(total,min[i]); writeln(total); End. Ballman-Ford var f:array[1..1000,1..2] of longint; ff,c:array[1..1000] of real; a:array[1..1000,1..2] of longint;

n,m,s,t,x,y,i,j:longint; begin assign(input,'in.in'); reset(input); readln(n); for i:=1 to n do readln(a[i][1],a[i][2]); readln(m); fillchar(c,sizeof(c),$7f); fillchar(f,sizeof(f),$7f); for i:=1 to m do begin readln(x,y); f[i][1]:=x; f[i][2]:=y; ff[i]:=sqrt(sqr(a[x][1]-a[y][1])+sqr(a[x][2]-a[y][2])); end; readln(s,t); for i:=1 to m do begin if f[i][1]=s then c[f[i][2]]:=ff[i]; if f[i][2]=s then c[f[i][1]]:=ff[i]; end; for i:=1 to n do for j:=1 to m do begin if c[f[j][1]]+ff[j]<c[f[j][2]] then c[f[j][2]]:=c[f[j][1]]+ff[j]; if c[f[j][2]]+ff[j]<c[f[j][1]] then c[f[j][1]]:=c[f[j][2]]+ff[j]; end; writeln(c[t]:0:2); close(input); end. Dijistra var a:array[1..100,1..2] of longint; c:array[1..100] of real; b:array[1..100] of boolean; f:array[1..100,1..100] of real; n,i,j,k,x,y,m,s,e:longint; min:real; begin assign(input,'in.in'); reset(input);

readln(n); for i:=1 to n do readln(a[i][1],a[i][2]); readln(m); fillchar(f,sizeof(f),$5f); for i:=1 to m do begin readln(x,y); f[x][y]:=sqrt(sqr(a[x][1]-a[y][1])+sqr(a[x][2]-a[y][2])); f[y][x]:=f[x][y]; end; readln(s,e); for i:=1 to n do c[i]:=f[s][i]; for i:=1 to n-1 do begin min:=maxlongint; k:=0; for j:=1 to n do if (not b[j]) and (c[j]<min) then begin min:=c[j]; k:=j; end; if k=0 then break; b[k]:=true; for j:=1 to n do if c[k]+f[k][j]<c[j] then c[j]:=c[k]+f[k][j]; end; writeln(c[e]:0:2); close(input); end. Floyed var a:array[1..100,1..2] of longint; f:array[1..100,1..100] of real; n,i,j,k,x,y,m,s,e:longint; function max(a,b:real):real; begin if a>b then exit(b) else exit(a); end; begin readln(n); for i:=1 to n do

readln(a[i][1],a[i][2]); readln(m); for i:=1 to n do for j:=1 to n do f[i][j]:=maxlongint div 3; for i:=1 to m do begin readln(x,y); f[x][y]:=sqrt(sqr(a[x][1]-a[y][1])+sqr(a[x][2]-a[y][2])); f[y][x]:=f[x][y]; end; readln(s,e); for k:=1 to n do for i:=1 to n do for j:=1 to n do f[i][j]:=max(f[i][j],f[i][k]+f[k][j]); writeln(f[s,e]:0:2); end.

Tarjan tarjan(u) { DFN[u]=Low[u]=++Index // 为节点 u 设定次序编号和 Low 初值 Stack.push(u) // 将节点 u 压入栈中 for each (u, v) in E // 枚举每一条边 if (v is not visted) // 如果节点 v 未被访问过 tarjan(v) // 继续向下找 Low[u] = min(Low[u], Low[v]) else if (v in S) // 如果节点 v 还在栈内 Low[u] = min(Low[u], DFN[v]) if (DFN[u] == Low[u]) // 如果节点 u 是强连通分量的根 repeat v = S.pop//将 v 退栈,为该强连通分量中一个顶点 print v until (u== v) } Var a:array[0..5000,0..5000] of boolean; stack,dfn,low,gpoint:array[0..5000] of longint; v:array[0..5000] of boolean; top,root,ans,all,i,p,q,n,m:longint; function min(a,b:longint):longint; begin

if a<b then exit(a) else exit(b); end; procedure tarjan(p:longint); var i:longint; begin inc(all); low[p]:=all; dfn[p]:=all; inc(top); stack[top]:=p; v[p]:=true; for i:=1 to n do if a[p,i] then begin if dfn[i]=0 then begin tarjan(i); low[p]:=min(low[p],low[i]); end; if v[i] then low[p]:=min(low[p],dfn[i]); {if (low[i]>=dfn[p]) and (p<>1) then gpoint[p]:=gpoint[p]+1 else if p=1 then root:=root+1 else low[p]:=min(low[p],dfn[i]);} //求割点 end; {else if v[i] then low[p]:=min(low[p],dfn[i]); if low[p]=dfn[p] then begin repeat v[stack[top]]:=false; write(stack[top],' '); dec(top); until stack[top+1]=p; writeln; end;} // 求强连通分量 end; {procedure print; var i:longint;

begin if root>1 then ans:=ans+1; for i:=2 to n do begin if gpoint[i]>0 then begin ans:=ans+1; writeln(i); end; end; writeln(ans); end;} begin assign(input,'in.in'); assign(output,'out.out'); reset(input); rewrite(output); readln(n,m); fillchar(a,sizeof(a),false); fillchar(v,sizeof(v),false); all:=0;top:=0; for i:=1 to m do begin readln(p,q); a[p,q]:=true; end; for i:=1 to n do if dfn[i]=0 then tarjan(i); // print; close(input); close(output); end. 拓扑排序 O(V+E) 数据结构:indgr[i]:顶点 i 的入度 stack[]:栈 初始化 top:=0(栈顶指针置零) 将初始化状态所有入度为 0 的顶点压栈 I=0(计数器) while 栈非空(top>0) do begin 栈顶的顶点 v 出栈;top:=top-1; 输出 v;I:=I+1;

// 求割点

for v 的每一个后继顶点 u do dec(indgr[u]);u 的入度减一; if u 的入度变为 0 then 顶点 u 入栈 end; kruskal; const MXN=1000; type rqmap=record s,t,v:longint; end; var map:array[1..MXN*MXN] of rqmap; father:array[1..MXN] of longint; n,m,i,ingraph,ans:longint; procedure qsort(b,e:longint);//排序 var i,j,x:longint; t:rqmap; begin i:=b;j:=e;x:=map[(i+j)>>1].v; while (i<=j) do begin while (map[i].v<x) do inc(i); while (map[j].v>x) do dec(j); if (i<=j) then begin t:=map[i]; map[i]:=map[j]; map[j]:=t; inc(i); dec(j); end; end; if i<e then qsort(i,e); if j>b then qsort(b,j); end; function find(x:longint):longint; begin if (father[x]=x) then exit(x); father[x]:=find(father[x]); exit(father[x]); end; procedure union(a,b:longint); //并查集

begin father[find(a)]:=find(father[b]); end; begin assign(input,‘kruskal.in'); reset(input); assign(output,‘kruskal.out'); rewrite(output); readln(n,m); for i:=1 to n do father[i]:=i; for i:=1 to m do readln(map[i].s,map[i].t,map[i].v); qsort(1,m); ans:=0; ingraph:=1; i:=0; while (ingraph<n) do begin inc(i); if find(map[i].s)<>find(map[i].t) then begin inc(ingraph); inc(ans,map[i].v); union(map[i].s,map[i].t); end; end; writeln(ans); close(input); close(output); End. 并查集 初始化 for i:=1 to n do father[i]:=i; end; 判断是否在同一集合: function find(x:longint):longint; var i,j,root:longint; begin if father[x]<>x then father[x]:=find(father[x]); find:=father[x]; end; 合并集合: procedure union(r1,r2:longint); begin father[r2]:=r1; end;

procedure solve2; var i,j,r1,r2:longint; begin for i:=1 to n do for j:=1 to n do begin if w[i][j] then begin r1:=find(i); r2:=find(j); if r1<>r2 then union(r1,r2); end; end; end; 输出: procedure print; var i:longint; begin for i:=1 to n do if father[i]=i then inc(ans); writeln(ans); End;


相关文章:
Noip图论算法整理
N​o​i​p​图​论​算​法​整​理 暂无评价|0人阅读|0次下载|举报文档Edmonds-Karp var ans,i,j,k,s,t,tot,m,n,a,b,c:longint;...
Noip图论整理
图论程序整理 Edmonds-Karp var ans,i,j,k,s,t,tot,m,n,a,b,c:longint; u,v,w,next,other:array[0..200] of longint; point,d,q,pre:array[0...
图论经典
2011备战noip2011备战noip隐藏>> 图论经典基本概念 二元组(V, E) 称为图(graph)。V 为结点(node)或顶点(vertex)集。E为 V 中结点之间 的边的集合。 点对...
Noip整理
2下载券 Noip图论整理 暂无评价 18页 2下载券N​o​i​p​整​理 ...[NOIP2010]乌龟棋 From NOIP2010提高组复赛第二题 描述 Description 小明过生日...
noip 每日整理
暂无评价 19页 2下载券 Noip图论整理 暂无评价 18页 2下载券 noip必备模板 gc整理版 暂无评价 1页 免费n​o​i​p​ ​每​日​整​理 ...
NOIP中的图论试题
NOIP中的图论试题_工学_高等教育_教育专区。NOIP 中的图论试题陈思禹 一、NOIP2005 普及组初赛。 5. 平面上有五个点 A(5, 3), B(3, 5), C(2, 1),...
NOIP 图论代码总结
图论总结_by_Amber 14页 免费如要投诉违规内容,请到百度文库投诉中心;如要提出功能问题或意见建议,请点击此处进行反馈。 NOIP 图论代码总结 图论的一些代码总结图论...
图论
3.4 简单图论 网络流(选学) 引言 如果你的父母逼着你关电脑或者机房马上就要...其实也只有名 字像啦╮(╯▽╰)╭本章作者可是两年 NOIP 都只得到一个 3=的...
NOIP算法整理
前言离 NOIP 还有一个星期,匆忙的把寒假整理的算法补充完善,看 着当时的整理...1163,1380 图论算法 回路问题 概念补充:奇点就是从这个点出发的线有奇数条的点...
POJ图论分类【转】
poj图论总结 24页 8财富值 北大poj图论总结 24页 2财富值 NOIP 好题推荐(DP...图论分类【 POJ 图论分类【转】一个很不错的图论分类,非常感谢原版的作者!!!...
更多相关标签:
noip 图论 | 图论算法 | 图论导引 | 图论及其算法 | 图论及其应用 | 图论教程 | 图论书籍推荐 | 集合论与图论 |