Пример решения задачи Максимального потока на MS Access-е

Тут как-то просили опубликовать короткие, но реальные программные тексты... Поскольку исходные тексты обычно принадлежат организациям, в которых работает программист, их мало кто публикует.

Недавно девушка попросила помочь написать диплом - "сроки горят, а еще ничего не сделано". Написал. Сейчас она уже получила диплом, так что вполне могу опубликовать, поскольку денег за работу не брал, ну типа оправдываюсь, что публикую не ворованное.

;~)



В таблице S перечислены узлы исходного графа.

В C - исходные дуги. Поля: CD - пропускная способность дуги; CC - стоимость; CT - время перемещения из узла I в J по этой дуге.

Остальные таблицы заполняются "автоматически", во время работы алгоритма.

Таблица G представляет "расширенные во времени" узлы. Отдельно упомяну лишь несколько полей: GSpe - оценка себестоимости до данного узла по кратчайшему расстоянию (short path expected); GID_Prev - предыдущий узел по оценке кратчайшего расстояния; GBack - признак движения по обратной дуге.

V - потоки. VD - пропускная способность; VC - стоимость; VC_M - модифицированная стоимость; VX - поток.

GV - пары G и V расшифровки поиска кратчайшего пути от СТАРТА до КОНЕЧНОГО узла. (S --> K)

Кстати, несколько удивил уровень сложности дипломного задания, ИМХО его следует делать на лабораторках, поскольку приведенное здесь запрограммировано за несколько часов. Не бог весть что, конечно, но требуемые задачи решает.

Извините, что не стал всё подробно комментировать - жаль на это времени.

Тэкс...

Вместо

"SELECT G_0.GName & ' --> %af_src_str_5 OR (G_0.SID=0) OR (G_1.SID=-1)"

следует читать

"SELECT G_0.GName & ' --> ' & G_1.GName, G_0.GID, G_1.GID, CD, CC, CC, 0 " & _
"FROM (C INNER JOIN G AS G_0 ON C.SID_I = G_0.SID) " & _
"INNER JOIN G AS G_1 ON C.SID_J = G_1.SID " & _
"WHERE ((G_0.TID+CT)=G_1.TID)" ' OR (G_0.SID=0) OR (G_1.SID=-1)"

Заново, без CODE :

' Создаем индексы времени
For i = 0 To TMax
DoCmd.RunSQL "INSERT INTO T ( TID ) SELECT " & i & " AS TID"
Next i
' Создаем растянутый во времени граф. Узлы
DoCmd.RunSQL _
"INSERT INTO G ( GName, SID, TID, GSpe, GX_Max ) " & _
"SELECT IIF (SID=-1, 'K', SID & '[' & TID & ']'), SID, TID, 88888888, 88888888 " & _
"FROM S, T " & _
"WHERE (SID>0) Or (SID=0) And (TID=0) Or (SID=-1) And (TID=" & TMax & ")"
' Создаем растянутый во времени граф. Дуги
DoCmd.RunSQL _
"INSERT INTO V ( VName, GID_Beg, GID_End, VD, VC, VC_M, VX ) " & _
"SELECT G_0.GName & ' --> ' & G_1.GName, G_0.GID, G_1.GID, CD, CC, CC, 0 " & _
"FROM (C INNER JOIN G AS G_0 ON C.SID_I = G_0.SID) " & _
"INNER JOIN G AS G_1 ON C.SID_J = G_1.SID " & _
"WHERE ((G_0.TID+CT)=G_1.TID)" ' OR (G_0.SID=0) OR (G_1.SID=-1)"
DoCmd.RunSQL _
"INSERT INTO V ( VName, GID_Beg, GID_End, VD, VC, VC_M, VX ) " & _
"SELECT G_0.GName & ' --> ' & G_1.GName, G_0.GID, G_1.GID, 88888888, 0, 0, 0 " & _
"FROM G AS G_0, G AS G_1 " & _
"WHERE ((G_0.TID+1)=G_1.TID) AND (G_0.SID=G_1.SID)"
Do
' Ищем кратчайший путь S -> K
DoCmd.RunSQL "UPDATE G SET GID_Prev = Null, GSpe = 888888888, GBack = False"
DoCmd.RunSQL "UPDATE G SET GSpe = 0 WHERE SID=0"
y = -1
Do
x = y
DoCmd.RunSQL _
"UPDATE G INNER JOIN vGSpe_New ON G.GID = vGSpe_New.GID " & _
"SET GSpe = GSpe_New, GID_Prev = GID_Prev_New, " & _
"GBack = False, GX_Max = GX_Max_New " & _
"WHERE GSpe_New<GSpe"
DoCmd.RunSQL _
"UPDATE G INNER JOIN vGSpe_New_Neg ON G.GID = vGSpe_New_Neg.GID " & _
"SET GSpe = GSpe_New, GID_Prev = GID_Prev_New, " & _
"GBack = True, GX_Max = GX_Max_New " & _
"WHERE GSpe_New<GSpe"
y = DSum("GSpe", "G")
Loop While (y <> x)
DoCmd.RunSQL _
"DELETE * FROM GV"
DoCmd.RunSQL _
"INSERT INTO GV ( GID ) " & _
"SELECT G.GID " & _
"FROM G " & _
"WHERE (G.SID=-1) AND (G.TID=" & TMax & ")"
y = -1
Do
x = y
DoCmd.RunSQL _
"INSERT INTO GV ( GID, VID, VBack ) SELECT G.GID_Prev, V.VID, GBack " & _
"FROM ((G INNER JOIN GV AS GV_Curr ON G.GID = GV_Curr.GID) " & _
"LEFT JOIN GV AS GV_Prev ON G.GID_Prev = GV_Prev.GID) " & _
"INNER JOIN V ON (G.GID = V.GID_End) AND (G.GID_Prev = V.GID_Beg) " & _
"WHERE (not GBack) AND (GV_Prev.GID Is Null)"
DoCmd.RunSQL _
"INSERT INTO GV ( GID, VID, VBack ) SELECT G.GID_Prev, V.VID, GBack " & _
"FROM ((G INNER JOIN GV AS GV_Curr ON G.GID = GV_Curr.GID) " & _
"LEFT JOIN GV AS GV_Prev ON G.GID_Prev = GV_Prev.GID) " & _
"INNER JOIN V ON (G.GID = V.GID_Beg) AND (G.GID_Prev = V.GID_End) " & _
"WHERE (GBack) AND (GV_Prev.GID Is Null)"
y = DSum("GID", "GV")
Loop While (y <> x)
x = Nz(DMin("VDVX", "vGV_VD"), 0)
DoCmd.RunSQL _
"UPDATE V INNER JOIN GV ON V.VID = GV.VID " & _
"SET VX = VX+" & x & " " & _
"WHERE not VBack"
DoCmd.RunSQL _
"UPDATE V INNER JOIN GV ON V.VID = GV.VID " & _
"SET VX = VX-" & x & " " & _
"WHERE VBack"
DoCmd.RunSQL "UPDATE V SET VC_M = VC"
DoCmd.RunSQL "UPDATE V SET VC_M = 88888888 WHERE VX>=VD"
Loop While x > 0

...выглядит много хуже, зато без очепяток...