Data update

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

@@ -0,0 +1,127 @@
+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