Нахождение максимального потока функцией VBA
научный журнал «Актуальные исследования» #26 (53), июль '21

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

Приведен программный код пользовательской функции VBA Excel, позволяющей онлайн решать задачу о максимальном потоке сети. Код основан на трех шаговом алгоритме, отличном от алгоритма расстановки меток. Применение функции показано на конкретной задаче.

Аннотация статьи
код
сеть
путь
сток
диалоговое окно
источник
Ключевые слова

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 в активную ячейку.

Текст статьи
  1. Гарнаев А.Ю. MS Excel 2002: разработка приложений. – СПб.: БХВ-Петербург, 2003. 768 с.
  2. Таха Х.А. Введение в исследование операций. М.: «Вильямс», 2005. 912 с.
Список литературы
Ведется прием статей
Прием материалов
c 24 июля по 30 июля
Осталось 2 дня до окончания
Публикация электронной версии статьи происходит сразу после оплаты
Справка о публикации
сразу после оплаты
Размещение электронной версии журнала
03 августа
Загрузка в eLibrary
03 августа
Рассылка печатных экземпляров
11 августа