Writing Efficient VBA UDFs (Part13): MaxMinFair Resource Allocation – an array UDF example

Last year we got to spend a great day at Microsoft Research in Cambridge (UK). one presentation was about storage strategies and featured (amongst other stuff) an interesting algorithm called MaxMinFair.

The MaxMinFair algorithm

You can read about it here at WikiPedia, but the basic idea is to share a supply resource fairly between a number of demands without allowing the greedy demands to hog too much of the resource.

The algorithm starts by sharing the supply equally between the demands.
Then any excess supply (supply > demand) is re-shared equally between the demands that have not yet been met.
Then the algorithm continues to reallocate the excess supply until either all demands are met or there is no excess supply to reallocate.

Implementing MaxMinFair as a VBA array UDF

MaxMinFair makes a great example of writing an array formula UDF.
It has 2 parameters – Supply (a single number) and Demands (a set of numbers, usually a Range).

To keep things simple Supply has to be a single number >= 0.0, and Demands has to be a single column vertical range or array of numbers.

The parameters for the function are defined as variants so that the user can give a range or an array of constants or a calculation expression that returns an array of numbers.
The function is defined to return a variant. This allows the function to return either an error value, or a single number or an array of numbers.
The function starts by setting up the error handling and coercing the Ranges to values.
The results of the function are put in an array that is dynamically sized to match the number of demands.

The heart of the UDF is a DO loop that

• Calculates allocation by dividing the available supply by the number of unsatisfied demands
• Adds the allocation to each of the unsatisfied demands
• Collects any excess allocation to be the available supply on the next iteration
• Counts unsatisfied demands

The DO loop terminates when either there are no unsatisfied demands or there is no available supply to be allocated.

The function finishes by assigning the result array (dAllocated()) to the variant function.

The VBA Code

Here is the VBA code for the function:

Option Explicit
Option Base 1
Function MaxMinFair(Supply As Variant, Demands As Variant) As Variant
'
' Array function for Max-Min-Fair allocation of supply to demand
'
' Supply must be a scalar number >=0.0
' Demands must be a scalar number or a single column range or array of data
'
Dim nUnsat As Long          ''' number of unsatisfied demands
Dim dAlloc As Double        ''' amount to allocate to each unsatisfied demand
Dim dAllocated() As Double  ''' arrray of amounts allocated to each demand
Dim nRows As Long           ''' number of rows in Demands
Dim nCols As Long           ''' number of columns in Demands
Dim dAvailable As Double    ''' available supply this iteration
Dim j As Long
'
' set up error handling
'
On Error GoTo FuncFail
'
' return #Value if error
'
MaxMinFair = CVErr(xlErrValue)
'
' both parameters must contain data
'
If IsEmpty(Supply) Or IsEmpty(Demands) Then GoTo FuncFail
'
' convert ranges to values
'
If IsObject(Demands) Then Demands = Demands.Value2
If IsObject(Supply) Then Supply = Supply.Value2
'
' Supply must be a scalar number >=0
'
If IsArray(Supply) Then GoTo FuncFail
If Supply < 0# Then GoTo FuncFail
dAvailable = CDbl(Supply)
'
If Not IsArray(Demands) Then
'
' scalar demand: Minimum of supply and demand
'
If Demands < Supply Then
MaxMinFair = Demands
Else
MaxMinFair = Supply
End If
Else
'
' Demands must be a single column array
'
nRows = UBound(Demands, 1)
nCols = UBound(Demands, 2)
If nCols > 1 Then GoTo FuncFail
'
' setup output array
'
ReDim dAllocated(1 To nRows, 1 To nCols)
'
' count unsatisfied demands
'
For j = 1 To nRows
'
' if not number raise error
'
If dAllocated(j, 1) <> CDbl(Demands(j, 1)) Then nUnsat = nUnsat + 1
Next j
If nUnsat = 0 Then GoTo Finish
'
' iterate allocating available supply to unsatisfied demands
'
Do
'
' amount to allocate to each unsatisfied demand
'
dAlloc = CDbl(dAvailable) / nUnsat
nUnsat = 0
dAvailable = 0#
'
' share available supply equally across unsatisfied demands
'
For j = 1 To nRows
If dAllocated(j, 1) < Demands(j, 1) Then
dAllocated(j, 1) = dAllocated(j, 1) + dAlloc
End If
Next j
'
' collect excess supply for next iteration
'
For j = 1 To nRows
If dAllocated(j, 1) >= Demands(j, 1) Then
'
' remove and accumulate excess supply
'
dAvailable = dAvailable + dAllocated(j, 1) - Demands(j, 1)
dAllocated(j, 1) = Demands(j, 1)
Else
'
' count unsatisfied demands
'
nUnsat = nUnsat + 1
End If
Next j
'
' if all supply allocated or all demsnds met then finish
'
If nUnsat = 0 Or dAvailable = 0# Then Exit Do
Loop
Finish:
'
' return array of results
'
MaxMinFair = dAllocated
End If
FuncFail:
End Function

Example

Here is a small example. The UDF is entered into C2:C8 as a multi-cell array formula (select C2:C8, type the formula into the formula bar without the { }, then press Control-Shift-Enter)

You can see that the total demand is 25.9 but the supply is only 18.3. MaxMinFair has satisfied all the demands except for the 2 largest ones, which have both been allocated the same 4.9.

Conclusion

MaxMinFair is a good choice when you want to allocate resources without allowing large resource demands to starve small resource demands.

Implementing the algorithm as an array UDF is a good opportunity to demonstrate a variety of VBA UDF techniques.