![[Maple Plot]](images/p241.gif)
Программа 24, с. 123 Кирсанов М.Н. Графы в Maple , М.: Физматлит 2007
Поток в сети
| > | restart: with(networks): |
| > | new(G):V:=$1..8: addvertex([V],G): |
| > | v1:=1:# Источник |
| > | v2:=8:# Сток |
| > | E:=[[1,3],[3,5],[5,7],[7,8],[1,2],[2,4],[4,6],[6,8],[3,2],[2,5],[5,4],[4,7],[7,6]]: |
| > | w:=[6,9,7,4,6,4,4,7,5,2,8,2,11]: #Пропускная способность |
| > | addedge(E,weights=w,G): |
| > | draw(Linear([1],[3,2],[5,4],[7,6],[8]),G); |
| > | Поток=flow(G,v1,v2,ed); |
| > | ed; # Насыщенные дуги |
`Поток` = 11
{{1, 2}, {2, 4}, {2, 5}, {4, 6}, {4, 7}, {6, 8}, {7, 8}}
| > | m:=nops(edges(G)): |
| > | H:=duplicate(G): |
| > | potok1:=table([seq(e||i=0,i=1..m)]):# Начальное значение потока |
| > | while (v1 in vertices(G)) do |
| > | s:=[]: d:={v1}: d2:=v1: |
| > | c1:={v1}: ndep1:=v1: |
| > | while d2<>v2 and ndep1<>0 do |
| > | d1:=d[1]: # Начало следующей дуги |
| > | d:=departures(d1,G):# Множество возможных концов |
| > | ndep1:=nops(d); |
| > | if ndep1=0 then delete(d1,G); else |
| > | d:=d minus c1; # Исключаем пройденные вершины |
| > | d2:=d[1]:# Конец дуги |
| > | nd:=op(edges([d1,d2],G)); |
| > | c1:= c1 union {d2}; # Пополняем список пройденных |
| > | s:=[op(s),nd]:# Список пройденных дуг |
| > | fi; |
| > | od:#while |
| > | if v2 in c1 then # Если образовалась цепь |
| > | n1:=nops(s); # Длина цепи |
| > | pt:=[potok1[s[j]]$j=1..n1]; |
| > | sp:=[op(eweight(s,H))]; |
| > | potok2:=map(`+`,pt,min(op(sp-pt))); #новый поток |
| > | for i to n1 do potok1[s[i]]:=potok2[i]; |
| > | if potok1[s[i]]=eweight(s[i],H) then |
| > | delete(s[i],G); end;# Удаляем из графа насыщ дуги |
| > | od: |
| > | fi: |
| > | end:#while |
Перераспределение
| > | H2:=duplicate(H): |
| > | while (v1 in vertices(H2)) do |
| > | c1:={}: # Множество пройденных вершин |
| > | in2:={}: # Множество входящих дуг |
| > | out2:={}: # Множество выходящих дуг |
| > | d1:=v1: # Первая вершина |
| > | notupik1:=true; |
| > | while d1<>v2 and notupik1 do |
| > | out0 :=departures(d1,H2) minus c1; |
| > | out1:={}; |
| > | for i in out0 do |
| > | nd:=op(edges([d1,i],H2)); |
| > | if eweight(nd,H2)<>potok1[nd] then |
| > | d2:=i; out1:=edges([d1,i],H2) end;#Не рассматриваем полные выходящие |
| > | od; |
| > | out2:=out2 union out1;#Множество прямых дуг в цепи |
| > | in0:=arrivals(d1,H2) minus c1; |
| > | in1:={}; |
| > | for i in in0 do |
| > | nd:=op(edges([i,d1],H2)); |
| > | if potok1[nd]<>0 then |
| > | d2:=i; in1:=edges([i,d1],H2); end;#Не рассматриваем пустые входящие |
| > | od; |
| > | in2:=in2 union in1; #Множество обратных дуг в цепи |
| > | if nops(in1 union out1)=0 then |
| > | delete(d1,H2); notupik1:=false; else |
| > | c1:=c1 union {d1}; |
| > | d1:=d2;# Конец(начало) последней дуги - новая вершина для поиска |
| > | end; |
| > | od; |
| > | pr1:=(x)->eweight(x,H)-potok1[x]; |
| > | pr2:=(x)->potok1[x]: |
| > | if notupik1 then# Перераспределяем поток |
| > | m1:=min(op(map(pr1,out2))); |
| > | m2:=min(op(map(pr2,in2))); |
| > | ptk:=min(m1,m2); |
| > | for i in in2 do potok1[i]:=potok1[i]-ptk;od: |
| > | for i in out2 do potok1[i]:=potok1[i]+ptk;od: |
| > | fi; |
| > | od:#while |
| > | edg2:=incident(v2, H, 'In'):# Множество дуг, входящих в сток |
| > | Поток=map(`+`,op(eweight([op(edg2)],H))); |
| > | satur1:=[]: |
| > | for x in edges(H) do |
| > | if pr1(x)=0 then satur1:=[op(satur1),x];end; od; |
| > | satur1; # Насыщенные дуги |
`Поток` = 11
[e10, e12, e4, e5, e6, e7, e8]