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.
Excel and UDF Performance Stuff 