Нахождение максимального потока функцией VBA

1. Код пользовательской функции ПОТОК

Пусть задана ориентированная двухполюсная сеть с вершинами 1, 2, …, n, в которой вершина 1 – источник, вершина n – сток, весовые коэффициенты дуг – их пропускные способности.

В листинге 1 на языке VBA Excel [1] запрограммирован алгоритм нахождения максимальной пропускной способности сети [2] следующими шагами.

Шаг 1. Считая весовые коэффициенты дуг их длинами, находится кратчайший путь из вершины 1 в вершину n, применяя алгоритм Дейкстры или какой-либо другой метод.

Шаг 2. Наименьший из весовых коэффициентов дуг полученного пути, а это максимальная пропускная способность пути, вычитается из длин всех дуг этого пути и дуги с весом 0 из рассмотрения исключаются.

Шаг 3. Если нет пути из вершины 1 в вершину n, то останов, максимальная пропускная способность сети равна сумме максимальных пропускных способностей полученных путей, иначе на шаг 1.

Листинг 1. Код функции ПОТОК и ее описания

Function ПОТОК(Длины As Variant) As Variant

Dim d() As Integer, m() As Integer, h As Integer, _

s As Integer, k As Integer, z As Integer, L As Integer, g As Integer

Dim v() As Integer:n = UBound(Длины) + 1

ReDim d(1 To n, 1 To n): ReDim m(1 To n): ReDim v(1 To n)

h = Application.WorksheetFunction.Sum(Длины): z = 0: L = 0

For i = 1 To n: For j = 1 To n

If i < n Then

If Длины(i, j) > 0 Then

d(i, j) = Длины(i, j)

Else

d(i, j) = h

End If

Else

d(i, j) = h

End If

Next: Next

For i = 1 To n: For j = 1 To n

If d(i, j) = 0 Then d(i, j) = h

Next: Next

Line1:

'Начальные метки

m(1) = 0

For i = 2 To n: m(i) = h: v(i) = 0: Next: k = 1: p = h: s = 1: v(1) = 1

Line2:

'Пересчет меток

For j = 2 To n

If d(k, j) < h And m(k) + d(k, j) < m(j) Then

m(j) = m(k) + d(k, j)

End If

Next

'Нахождение наименьшей метки

q = 0

For i = 2 To n

For u = 2 To n

If i = v(u) Then

q = 1

Exit For

End If

Next

If q = 0 And m(i) >= m(k) And i <> k And m(i) < p Then

p = m(i): r = i

End If

q = 0

Next

m(r) = p: v(s + 1) = r

If s < n - 1 Then

k = r

p = h

s = s + 1

GoTo Line2

End If

If m(n) = h Then GoTo Line5

'Нахождение g - минимум веса звена кратчайшего пути

k = n: g = h

Line3:

For i = 1 To n - 1

If i <> k And m(k) - m(i) = d(i, k) Then

If d(i, k) < g Then

g = d(i, k)

End If

k = i

Exit For

End If

Next

If k > 1 Then

GoTo Line3

End If

k = n

Line4:

For i = 1 To n - 1

If i <> k And m(k) - m(i) = d(i, k) Then

d(i, k) = d(i, k) - g

If d(i, k) = 0 Then d(i, k) = h

k = i

Exit For

End If

Next

If k > 1 Then GoTo Line4

If k = 1 Then

z = z + g

GoTo Line1

End If

Line5:

ПОТОК = z

End Function

Sub InstallFunc1()

Application.MacroOptions Macro:="ПОТОК", Description:= _

"Возвращает по (n-1)xn матрице весовых коэффициентов дуг, " & _

"для несмежных вершин ставится 0, максимальную " & _

"пропускную способность сети"

End Sub

2. Применение функции ПОТОК

По листингу 1 стандартным образом создается функция ПОТОК. Как она применяется показано на задаче.

Задача 1. Применяя функцию ПОТОК, найти максимальную пропускную способность сети, показанной на рисунке 1.

Рис. 1. Сеть задачи 1

1. По весовым коэффициентам дуг сети составляется матрица:

        (1)

2. Вызывается функция ПОТОК и вводится матрица (1) (рис. 2).

Рис. 2. Применение функции ПОТОК в задаче 1

3. Команда ОК вставляет результат 14 в активную ячейку.