Программа 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]