RosettaCodeData/Task/Vogels-approximation-method/FreeBASIC/vogels-approximation-method...

128 lines
3.2 KiB
Plaintext

Const NROWS = 4, NCOLS = 5
Const MAX_INT = &h7FFFFFFF
Dim Shared As Integer supply(NROWS-1) = {50, 60, 50, 50}
Dim Shared As Integer demand(NCOLS-1) = {30, 20, 70, 30, 60}
Dim Shared As Integer costs(NROWS-1, NCOLS-1), results(NROWS-1, NCOLS-1)
Dim Shared As Boolean rowDone(NROWS-1), colDone(NCOLS-1)
Sub calcDiff(j As Integer, l As Integer, isRow As Boolean, diff() As Integer)
Dim As Integer min1 = MAX_INT, min2 = MAX_INT, minP = -1
For i As Integer = 0 To l-1
Dim As Boolean done = Iif(isRow, colDone(i), rowDone(i))
If done Then Continue For
Dim As Integer c = Iif(isRow, costs(j, i), costs(i, j))
If c < min1 Then
min2 = min1
min1 = c
minP = i
Elseif c < min2 Then
min2 = c
End If
Next
diff(0) = min2 - min1
diff(1) = min1
diff(2) = minP
End Sub
Sub maxPenalty(len1 As Integer, len2 As Integer, isRow As Boolean, result() As Integer)
Dim As Integer md = -MAX_INT
Dim As Integer pc = -1, pm = -1, mc = -1
Dim As Integer diff(2)
For i As Integer = 0 To len1-1
Dim As Boolean done = Iif(isRow, rowDone(i), colDone(i))
If done Then Continue For
calcDiff(i, len2, isRow, diff())
If diff(0) > md Then
md = diff(0)
pm = i
mc = diff(1)
pc = diff(2)
End If
Next
If isRow Then
result(0) = pm : result(1) = pc : result(2) = mc : result(3) = md
Else
result(0) = pc : result(1) = pm : result(2) = mc : result(3) = md
End If
End Sub
Sub nextCell(cell() As Integer)
Dim As Integer i, res1(3), res2(3)
maxPenalty(NROWS, NCOLS, True, res1())
maxPenalty(NCOLS, NROWS, False, res2())
If res1(3) = res2(3) Then
If res1(2) < res2(2) Then
For i = 0 To 3
cell(i) = res1(i)
Next
Else
For i = 0 To 3
cell(i) = res2(i)
Next
End If
Elseif res1(3) > res2(3) Then
For i = 0 To 3
cell(i) = res2(i)
Next
Else
For i = 0 To 3
cell(i) = res1(i)
Next
End If
End Sub
' Main program
costs(0,0)=16 : costs(0,1)=16 : costs(0,2)=13 : costs(0,3)=22 : costs(0,4)=17
costs(1,0)=14 : costs(1,1)=14 : costs(1,2)=13 : costs(1,3)=19 : costs(1,4)=15
costs(2,0)=19 : costs(2,1)=19 : costs(2,2)=20 : costs(2,3)=23 : costs(2,4)=50
costs(3,0)=50 : costs(3,1)=12 : costs(3,2)=50 : costs(3,3)=15 : costs(3,4)=11
Dim As Integer i, j, supplyLeft = 0
For i = 0 To NROWS-1
supplyLeft += supply(i)
Next
Dim As Integer totalCost = 0
Dim As Integer cell(3)
While supplyLeft > 0
nextCell(cell())
Dim As Integer r = cell(0), c = cell(1), q = demand(c)
If q > supply(r) Then q = supply(r)
demand(c) -= q
If demand(c) = 0 Then colDone(c) = True
supply(r) -= q
If supply(r) = 0 Then rowDone(r) = True
results(r, c) = q
supplyLeft -= q
totalCost += q * costs(r, c)
Wend
Print " A B C D E"
For i = 0 To NROWS-1
Print Chr(Asc("W") + i);
For j = 0 To NCOLS-1
Print Using " ##"; results(i, j);
Next
Print
Next
Print !"\nTotal cost = "; totalCost
Sleep