image
 
image
M015_Math.bas


' ========================================================================================================================
'                                 ____,__,  __,  ____,_,  _,  ____ ____,__, ,____,____,
'                                (-/_|(-|  (-|  (-|_,(-|\ |  (-|__|-/_|( |_/(-|_,(-|__)
'                                _/  |,_|__,_|__,_|__,_| \|,  _|__)/  |,_| \,_|__,_|  \,
'
'                                             Copyright � 2008 Allen Baker
'
' ------------------------------------------------------------------------------------------------------------------------
' File:          M015_Math
' Originator:    Allen Baker (2008.11.23 13:12)
' ------------------------------------------------------------------------------------------------------------------------
' $RCSfile$
' $Revision$
' $Date$
' ========================================================================================================================
'
Option Explicit



' ========================================================================================================================
' Description
'    This module provides miscellaneous mathematical routines and functions.
' ========================================================================================================================
Public Const cRoundToNearest As Long = 0
Public Const cRoundUp        As Long = 1
Public Const cRoundDown      As Long = 2

Private Const cDefaultRelativeEpsilon As Double = 0.000000000001    ' 99.9999999999%
Private Const cDefaultEpsilon         As Double = 0.00000000000001
'                                                   12345678901234567890



' =====================================================================================================================
' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<[  Miscellaneous  ]>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
' =====================================================================================================================



Private mOnBitsSet       As Boolean
Private mOnBits(0 To 31) As Long



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This subroutine creates an array of bitwise masks for use by the shiftBits functions.
' -----------------------------------------------------------------------------------------------------------
Private Sub makeOnBits()
   If (Not mOnBitsSet) Then
      Dim idx   As Long
      Dim value As Long
      For idx = 0 To 30
         value = value + (2 ^ idx)
         mOnBits(idx) = value
      Next idx
      mOnBits(idx) = value + &H80000000
      mOnBitsSet = True
   End If
End Sub



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function shifts a Long value to the left by a specified number of bytes.
'
' return
'    a number equal to pValue that has been shifted pNumberOfBytes bytes
'
' param
'    pValue is the value that will be shifted
' param
'    pNumberOfBytes is the number of byte places pValue will be shifted
' -----------------------------------------------------------------------------------------------------------
Function shiftBytesLeft(pValue As Long, pNumberOfBytes As Long) As Long
   shiftBytesLeft = shiftBitsLeft(pValue, pNumberOfBytes * 8)
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function shifts a Long value to the right by a specified number of bytes.
'
' return
'    a number equal to pValue that has been shifted pNumberOfByte bytes
'
' param
'    pValue is the value that will be shifted
' param
'    pNumberOfByte is the number of byte places pValue will be shifted
' -----------------------------------------------------------------------------------------------------------
Function shiftBytesRight(pValue As Long, pNumberOfBytes As Long) As Long
   shiftBytesRight = shiftBitsRight(pValue, pNumberOfBytes * 8)
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function shifts a Long value to the left by a specified number of bits.
'
' return
'    a number equal to pValue that has been shifted pNumberOfBits bits
'
' param
'    pValue is the value that will be shifted
' param
'    pNumberOfBits is the number of bit places pValue will be shifted
' -----------------------------------------------------------------------------------------------------------
Public Function shiftBitsLeft(ByVal pValue As Long, ByVal pNumberOfBits As Long) As Long
   shiftBitsLeft = pValue
   If pNumberOfBits > 0 Then
      makeOnBits
      If (shiftBitsLeft And (2 ^ (31 - pNumberOfBits))) Then
         shiftBitsLeft = ((shiftBitsLeft And mOnBits(31 - (pNumberOfBits + 1))) * (2 ^ (pNumberOfBits))) Or &H80000000
      Else
         shiftBitsLeft = ((shiftBitsLeft And mOnBits(31 - pNumberOfBits)) * (2 ^ pNumberOfBits))
      End If
   End If
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function shifts a Long value to the right by a specified number of bits.
'
' return
'    a number equal to pValue that has been shifted pNumberOfBits bits
'
' param
'    pValue is the value that will be shifted
' param
'    pNumberOfBits is the number of bit places pValue will be shifted
' -----------------------------------------------------------------------------------------------------------
Public Function shiftBitsRight(ByVal pValue As Long, ByVal pNumberOfBits As Long) As Long
   Dim i As Byte
   shiftBitsRight = pValue
   If pNumberOfBits > 0 Then
      shiftBitsRight = Int(shiftBitsRight / (2 ^ pNumberOfBits))
   End If
End Function


' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function computes a linear function using the slope intercept form of a line.  y = mx + b
'
' return
'    this function returns a function value for x
'
' param
'    x is the independent variable the the function is computed for
' param
'    m is the slope
' param
'    b is the y intercept
' -----------------------------------------------------------------------------------------------------------
Public Function linear(x As Double, m As Double, B As Double) As Double
   linear = (m * x) + B
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function computes a quadratic function of the form y = ax^2 + bx + c
'
' return
'    this function returns a function value for x
'
' param
'    x is the independent variable the the function is computed for
' param
'    a, b, and c are the coefficients of the terms
' -----------------------------------------------------------------------------------------------------------
Public Function quadratic(x As Double, a As Double, B As Double, C As Double) As Double
   quadratic = (a * (x ^ 2)) + (B * x) + C
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function computes a cubic function of the form y = ax^3 + bx^2 + cx + d
'
' return
'    this function returns a function value for x
'
' param
'    x is the independent variable the the function is computed for
' param
'    a, b, c, and d are the coefficients of the terms
' -----------------------------------------------------------------------------------------------------------
Public Function cubic(x As Double, a As Double, B As Double, C As Double, d As Double) As Double
   cubic = (a * (x ^ 3)) + (B * (x ^ 2)) + (C * x) + d
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function computes a polynomial function of the form y = [Cn]X^n-1 + ... + [C3]X^2 + [C2]X^1 + [C1]
'
' return
'    this function returns a function value for x
'
' param
'    x is the independent variable that the function is computed for
' param
'    pCoeffs are the coefficients of the terms
' -----------------------------------------------------------------------------------------------------------
Public Function polynomial(pX As Double, pCoeffs As Range) As Double
   '
   ' ==============================================================================================
   ' default result
   ' ----------------------------------------------------------------------------------------------
   Dim result As Double
   result = 0#
   '
   ' ==============================================================================================
   ' coeff recasts each coefficient as a double.  term is recomputed for each coefficient with its
   ' corresponding power of X.
   ' ----------------------------------------------------------------------------------------------
   Dim coeff  As Double
   Dim term   As Double
   Dim degree As Double
   Dim colIdx As Long
   Dim rowIdx As Long
   '
   ' ==============================================================================================
   ' if the coefficients are passed in as a column of numbers ...
   ' ----------------------------------------------------------------------------------------------
   If (pCoeffs.Columns.count >= pCoeffs.Rows.count) Then
      For colIdx = pCoeffs.Columns.count To 1
         coeff = pCoeffs(1, colIdx)
         degree = colIdx - 1#
         term = coeff * (pX ^ degree)
         result = result + term
      Next colIdx
   '
   ' ==============================================================================================
   ' else the coefficients are passed in as a row of numbers ...
   ' ----------------------------------------------------------------------------------------------
   Else
      For rowIdx = pCoeffs.Rows.count To 1
         coeff = pCoeffs(rowIdx, 1)
         degree = rowIdx - 1#
         term = coeff * (pX ^ degree)
         result = result + term
      Next rowIdx
   End If
   '
   ' ==============================================================================================
   ' return the result
   ' ----------------------------------------------------------------------------------------------
   polynomial = result
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function performs a "NORMAL" rounding of real numbers to a specified number of decimal points.
'
' The built-in VBA Round function is NOT NORMAL.  It performs "banker's rounding".  It rounds to the
' nearest integer, and if there are two nearest integers then it goes to the even one. 1.5 rounds to 2,
' 0.5 rounds to 0.
'
' Why's that?  Why not just arbitrarily say that we always round down in this situation?  Why round down
' sometimes and up some other times?  There actually is a good reason!
'
' This algorithm is called the Bankers' Rounding algorithm because, unsurprisingly, it's used by bankers.
' Suppose a data source provides data which is often in exactly split quantities -- half dollars, half
' cents, half shares, whatever -- but they wish to provide rounded-off quantities.  Suppose further that a
' data consumer is going to derive summary statistics from the rounded data -- an average, say.
'
' Ideally when you are taking an average you want to take an average of the raw data with as much
' precision as you can get.  But in the real world we often have to take averages of data which has lost
' some precision.  In such a situation the Banker's Rounding algorithm produces better results because it
' does not bias half-quantities consistently down or consistently up.  It assumes that on average, an
' equal number of half-quantities will be rounded up as down, and the errors will cancel out.
'
' If you don't believe me, try it.  Generate a random list of numbers that end in 0.5, round them off, and
' average them. You'll find that Bankers' Rounding gives you closer results to the real average than
' "always round down" averaging.
'
' The Round, CInt and CLng functions in VBScript all use the Banker's Rounding algorithm.
'
' There are two other VBA functions which turn floats into integers.  The Int function gives you the
' first integer less than or equal to its input, and the Fix function gives you the first integer closer
' to zero or equal to its input.  These functions do not round to the nearest integer at all, they simply
' truncate the fractional part.
'
' return
'    this function returns a rounded form of pNum
'
' param
'    pNum is the number to round
' param (optional)
'    pNumberOfDecimalPlaces is an optional  number indicating how many places to the right of the decimal
'    are included in the rounding.  If not specified as a call argument, the default is 0 and whole integers
'    are returned.
' param (optional)
'    pRoundingOption is an optional  control parameter that specifies the type of rounding to perform.  The
'    types are one of these three: UP, DOWN, or NEAREST.  If not specified as a call argument, the default
'    is NEAREST.
' -----------------------------------------------------------------------------------------------------------
Public Function normalRound _
   ( _
            pNum As Double, _
   Optional pNumberOfDecimalPlaces As Long = 0, _
   Optional pRoundingOption As Long = cRoundToNearest _
   ) _
As Double

   Dim placesFactor As Double
   Dim roundFactor  As Double
   '
   ' ==============================================================================================
   ' this factor is used to left shift the real number until the digit in the position of the
   ' number of decimal places that we are rounding to is in the 1's position (whole number)
   ' ----------------------------------------------------------------------------------------------
   placesFactor = 10 ^ pNumberOfDecimalPlaces
   '
   ' ==============================================================================================
   ' based on the rounding option, compute a factor to add to the number being rounded
   ' ----------------------------------------------------------------------------------------------
   Select Case pRoundingOption
   '
   ' ==============================================================================================
   ' round UP
   ' ----------------------------------------------------------------------------------------------
      Case cRoundUp
         roundFactor = 1#
   '
   ' ==============================================================================================
   ' round DOWN
   ' ----------------------------------------------------------------------------------------------
      Case cRoundDown
         roundFactor = 0#
   '
   ' ==============================================================================================
   ' round to NEAREST
   ' ----------------------------------------------------------------------------------------------
      Case cRoundToNearest
         roundFactor = 0.5
   '
   ' ==============================================================================================
   ' round to NEAREST
   ' ----------------------------------------------------------------------------------------------
      Case Else
         roundFactor = 0.5
   End Select
   '
   ' ==============================================================================================
   ' left shift the value, add the rounding factor, truncate, then right shift back to correct
   ' magnitude
   ' ----------------------------------------------------------------------------------------------
   normalRound = Int((pNum * placesFactor) + roundFactor) / placesFactor
End Function


Public Function normalRoundInt _
   ( _
            pNum As Double, _
   Optional pNumberOfDecimalPlaces As Long = 0, _
   Optional pRoundingOption As Long = cRoundToNearest _
   ) _
As Integer

   normalRoundInt = CInt(normalRound(pNum, pNumberOfDecimalPlaces, pRoundingOption) + 0.01)
End Function


Public Function normalRoundLng _
   ( _
            pNum As Double, _
   Optional pNumberOfDecimalPlaces As Long = 0, _
   Optional pRoundingOption As Long = cRoundToNearest _
   ) _
As Long

   normalRoundLng = CLng(normalRound(pNum, pNumberOfDecimalPlaces, pRoundingOption) + 0.01)
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function performs a "NORMAL" rounding of real numbers to the nearest multiple of a specified number
'
' return
'    this function returns a rounded form of pNum
'
' param
'    pNum is the number to round
' param
'    pRoundToNearest is the number to which pNum is rounded to the nearest multiple
' param
'    pRoundingOption is an optional  control parameter that specifies the type of rounding to perform.  The
'    types are one of these three: UP, DOWN, or NEAREST.  If not specified as a call argument, the defaule
'    is NEAREST.
' -----------------------------------------------------------------------------------------------------------
Public Function normalRoundTo(pNum As Double, pRoundToNearest As Double, Optional pRoundingOption As Long = cRoundToNearest) As Double
   Dim roundedMutliple As Double
   Dim valueDiv        As Double
   Dim valueNew        As Double
   '
   ' ==============================================================================================
   ' if they want to round to the nearest multiple of zero, it makes no sense so just return the
   ' unchanged number
   ' ----------------------------------------------------------------------------------------------
   If pRoundToNearest = 0 Then
      normalRoundTo = pNum
      Exit Function
   End If
   '
   ' ==============================================================================================
   ' if the pNum is already a multiple of pRoundToNearest, then we're done.
   ' ----------------------------------------------------------------------------------------------
   If (fmod(pNum, pRoundToNearest) < (pRoundToNearest / 10#)) Then
      normalRoundTo = pNum
      Exit Function
   End If
   '
   ' ==============================================================================================
   ' We're basically going to use this approach:
   ' roundPValueToNearestPRoundTo = normalRound(pNum/pRoundToNearest)*pRoundToNearest.
   ' ----------------------------------------------------------------------------------------------
   valueDiv = pNum / pRoundToNearest
   '
   ' ==============================================================================================
   ' based on the rounding option ...
   '  NOTE: we do NOT use the VBA Round Function because it does BankersRounding.
   ' ----------------------------------------------------------------------------------------------
   roundedMutliple = normalRound(valueDiv, 0, pRoundingOption)
   '
   ' ==============================================================================================
   ' Calculate new "rounded-to" value
   ' ----------------------------------------------------------------------------------------------
   normalRoundTo = roundedMutliple * pRoundToNearest
End Function


Public Function normalRoundToInt(pNum As Double, pRoundToNearest As Double, Optional pRoundingOption As Long = cRoundToNearest) As Integer
   normalRoundToInt = CInt(normalRoundTo(pNum, pRoundToNearest, pRoundingOption) + 0.01)
End Function


Public Function normalRoundToLng(pNum As Double, pRoundToNearest As Double, Optional pRoundingOption As Long = cRoundToNearest) As Long
   normalRoundToLng = CLng(normalRoundTo(pNum, pRoundToNearest, pRoundingOption) + 0.01)
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns a rounding of pNum.  It rounds pNum up to the next integer if pNum's fractional part
' is greater than or equal to pFrom's fractional part.  If pNum's fractional part is less than pFrom's
' fractional part, pNum is rounded down.  The absolute value of pFrom's fractional part is used.
'
' Examples:
'    if pNum is 5.4 and pFrom is .5, pNum will be rounded DOWN to 5
'    if pNum is 5.4 and pFrom is .4, pNum will be rounded UP to 6
'    if pNum is 5.4 and pFrom is .3, pNum will be rounded UP to 6
'
' Simply put, any value of pFrom's fractional part that is less than or equal to the fractional part of pNum
' will cause pNum to be rounded UP.  Any value greater will cause pNum to be rounded DOWN.
'
' return
'    this function returns a rounded up form of pNum
'
' param
'    pNum is the number to round up
' param
'    pFrom is the fraction that marks the point at which pNum is rounded up to the next integral number.
' -----------------------------------------------------------------------------------------------------------
Public Function roundUpFrom(pNum As Double, pFrom As Double) As Integer
   '
   ' ==============================================================================================
   ' only gonna use the fractional part of the absolute value of pFrom
   ' ----------------------------------------------------------------------------------------------
   pFrom = Abs(pFrom)
   pFrom = pFrom - Int(pFrom)
'   roundUpFrom = Application.Round(0.5 - pFrom + pNum, 0)
   roundUpFrom = normalRound(0.5 - pFrom + pNum, 0)
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns the floating-point remainder of numerator/denominator.
'
' The remainder of a division operation is the result of subtracting the integral quotient multiplied by the
' denominator from the numerator:
'    remainder = numerator - quotient * denominator
'
' return
'    this function returns the floating-point remainder of numerator/denominator.
'
' param
'    pNumerator is the numerator
' param
'    pDenominator is the denominator
' -----------------------------------------------------------------------------------------------------------
Public Function fmod(pNumerator As Double, pDenominator As Double) As Double
    Dim quotient As Double
    quotient = pNumerator / pDenominator
    fmod = pNumerator - (Fix(quotient) * pDenominator)
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns the Minimum value from a parameter Array. (Amazingly, VBA does not provide its own
' Max or Min function.)
'
' Note: I copied this code from a source on the web that I can no longer identify.  If you know the original
' source of this code please reference the site so that I can give the author credit for the code.
'
' Examples:
'    min(1,2,empty,-1)               Returns -1
'    min(Array(1,2,-1),-4,-9.9)      Returns -9.9
'    min(1/Jan/99,2/Jan/99)          Returns 1/Jan/99
'
' return
'    this function returns the Min Value contained within the input (excluding empty values)
'
' param
'    pValues is the paramater array
' -----------------------------------------------------------------------------------------------------------
Public Function min(ParamArray pValues() As Variant) As Variant
   Dim thisItem    As Variant
   Dim thisElement As Variant

   On Error Resume Next
   For Each thisItem In pValues
      If IsArray(thisItem) Then
         For Each thisElement In thisItem
            min = min(thisElement, min)
         Next
      Else
         If IsEmpty(min) Then
            If Not IsEmpty(thisItem) Then
               min = thisItem
            End If
         ElseIf Not IsEmpty(thisItem) Then
            If thisItem < min Then
               min = thisItem
            End If
         End If
      End If
   Next
   On Error GoTo 0
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns the Maximum value from a parameter Array. (Amazingly, VBA does not provide its own
' Max or Min function.)
'
' Note: I copied this code from a source on the web that I can no longer identify.  If you know the original
' source of this code please reference the site so that I can give the author credit for the code.
'
' Examples:
'    max(1,2,empty,-1)               Returns 2
'    max(Array(1,2,-1),-4,-9.9)      Returns 2
'    max(1/Jan/99,2/Jan/99)          Returns 2/Jan/99
'
' return
'    this function returns the Max Value contained within the input (excluding empty values)
'
' param
'    pValues is the paramater array
' -----------------------------------------------------------------------------------------------------------
Public Function max(ParamArray pValues() As Variant) As Variant
   Dim thisItem    As Variant
   Dim thisElement As Variant

   On Error Resume Next
   For Each thisItem In pValues
      If IsArray(thisItem) Then
         For Each thisElement In thisItem
            max = max(thisElement, max)
         Next
      Else
         If IsEmpty(max) Then
            If Not IsEmpty(thisItem) Then
               max = thisItem
            End If
         ElseIf Not IsEmpty(thisItem) Then
            If thisItem > max Then
               max = thisItem
            End If
         End If
      End If
   Next
   On Error GoTo 0
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns TRUE or FALSE depending if the value is odd
'
' return
'    this function returns TRUE if the argument passed to it is odd, otherwise, it returns FALSE
'
' param
'    pValue is the value to test.  This should be an integer or a long.
' -----------------------------------------------------------------------------------------------------------
Public Function isOdd(pValue As Variant) As Boolean
   isOdd = Not isEven(pValue)
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns TRUE or FALSE depending if the value is even
'
' return
'    this function returns TRUE if the argument passed to it is even, otherwise, it returns FALSE
'
' param
'    pValue is the value to test.  This should be an integer or a long.
' -----------------------------------------------------------------------------------------------------------
Public Function isEven(pValue As Variant) As Boolean
   Dim value As Long
   value = CLng(pValue)
   isEven = value Mod 2 = 0
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns determines if a given value is within the range of two other values - inclusive.
'
' return
'    TRUE if pMinValue <= pValue <= pMaxValue, otherwise FALSE
'
' param
'    pValue is the value that is tested
' param
'    pMinValue is the value that is the low end of the range
' param
'    pMaxValue is the value that is the high end of the range
' -----------------------------------------------------------------------------------------------------------
Public Function isInRange(pValue As Variant, pMinValue As Variant, pMaxValue As Variant) As Boolean
   isInRange = ((pMinValue <= pValue) And (pValue <= pMaxValue))
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This subroutine returns pVal unless pVal is less than pMin or greater than pMax.  If pVal is less than
' pMin, this method returns pMin.  If pVal is greater than pMax, This subroutine returns pMax.
'
' return
'    pVal forced into the range pMin..pMax inclusive.
'
' param
'    pVal is the value to force in range
' param
'    pMin is the low end of the range
' param
'    pMax is the high end of the range
' -----------------------------------------------------------------------------------------------------------
Public Function forceIntoRange(pVal As Variant, pMin As Variant, pMax As Variant) As Variant
   pVal = max(pVal, pMin)
   pVal = min(pVal, pMax)
   forceIntoRange = pVal
End Function


' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This subroutine returns a rolling average.
'
' If the period is 7, a value (call it X) is 1/7th of the rolling average when it is passed in as the latest
' measurement (incr 1).  On the next call, X becomes 6/49ths of the rolling average or 12.244898% of the
' rolling average. On the 3rd call (incr 3), X becomes 36/343rds of the rolling average or 10.4956268% of
' the rolling average. Etc.
'
' Incr:   1            2           3            4            5            6
'
' Mltpl
' of prv
' ratio:  1/7          6/7         6/7          6/7         6/7         6/7
'
' Ratio:  1/7          6/49        36/343       216/2401    1296/16807  7776/117649
'
' Pct:    14.2857143%  12.244898%  10.4956268%  8.9962516%  7.7110728%  6.6094909%
' -----------------------------------------------------------------------------------------------------------
Public Function rollingAvg(latestMeasurement, prevAvg, period)
   rollingAvg = (latestMeasurement + (prevAvg * (period - 1))) / period
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This subroutine returns a rolling average when there is a gap in the sequence of numbers being averaged.
'
' If the period is 7, a value (call it X) is 1/7th of the rolling average when it is passed in as the latest
' measurement (incr 1).  On the next call, X becomes 6/49ths of the rolling average or 12.244898% of the
' rolling average. On the 3rd call (incr 3), X becomes 36/343rds of the rolling average or 10.4956268% of
' the rolling average. Etc.
'
' Incr:   1            2           3            4            5            6
'
' Mltpl
' of prv
' ratio:  1/7          6/7         6/7          6/7         6/7         6/7
'
' Ratio:  1/7          6/49        36/343       216/2401    1296/16807  7776/117649
'
' Pct:    14.2857143%  12.244898%  10.4956268%  8.9962516%  7.7110728%  6.6094909%
' -----------------------------------------------------------------------------------------------------------
Public Function rollingAvgWithGap(latestMeasurement As Variant, prevAvg As Variant, period As Variant, gap As Variant) As Variant
   Dim pa As Variant
   Dim i  As Long
   pa = prevAvg
   If (gap > 0) Then
      For i = 1 To gap
         pa = rollingAvg(0, pa, period)
      Next i
   End If
   rollingAvgWithGap = rollingAvg(latestMeasurement, pa, period)
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' -----------------------------------------------------------------------------------------------------------
Public Function wgtdAvg(pValues As Range, pWeights As Range) As Double
   Dim rowIdx As Long
   Dim colIdx As Long
   Dim sum    As Double
   Dim count  As Double
   Dim value  As Double
   Dim weight As Double

   sum = 0#
   count = 0#
   For rowIdx = 1 To pValues.Rows.count
      For colIdx = 1 To pValues.Columns.count
         value = pValues(rowIdx, colIdx)
         weight = pWeights(rowIdx, colIdx)
         sum = sum + (value * weight)
         If (value > 0#) Then count = count + weight
      Next colIdx
   Next rowIdx

   If (count > 0#) Then
      wgtdAvg = sum / count
   Else
      wgtdAvg = 0#
   End If

End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns a random integer in the range [pLowerBound..pUpperBound] inclusive
'
' return
'    a random integer in the range [pLowerBound..pUpperBound] inclusive
'
' param
'    pLowerBound is the smallest integer that can be returned by this function
' param
'    pUpperBound is the largest integer that can be returned by this function
' -----------------------------------------------------------------------------------------------------------
Public Function randomIntegerInRange(pLowerBound As Integer, pUpperBound As Integer) As Integer
   randomIntegerInRange = Int((pUpperBound - pLowerBound + 1) * Rnd() + pLowerBound)
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function finds the biggest difference between corresponding values in two ranges.  The first range is
' imagined to be a list of demands.  The second range is imagined to be a corresponding list of supplies.
' This function finds the maximum of all the differences of demand over supply ((pDemandRange[n] -
' pSupplyRange[n]) / pSupplyRange[n]).  As such, the pair in which the demand exceeds supply by the largest
' percentage.
'
' return
'    this function returns the maximum of all instances of ((pDemandRange[n] - pSupplyRange[n]) /
'    pSupplyRange[n])
'
' param
'    pDemandRange is a range of values each of which is interpreted to represent the demand
' param
'    pSupplyRange is a range of values each of which is interpreted to represent the supply
' -----------------------------------------------------------------------------------------------------------
Public Function maxExcessDemandPct(pDemandRange As Range, pSupplyRange As Range) As Double
   Dim rowIdx    As Long
   Dim colIdx    As Long
   Dim supply    As Double
   Dim demand    As Double
   Dim excessPct As Double
   Dim maximum   As Double

   maximum = -1000000#
   For rowIdx = 1 To pSupplyRange.Rows.count
      For colIdx = 1 To pSupplyRange.Columns.count
         supply = pSupplyRange(rowIdx, colIdx)
         demand = pDemandRange(rowIdx, colIdx)
         If (supply = 0#) Then
            excessPct = demand
         Else
            excessPct = (demand - supply) / supply
         End If
         maximum = max(maximum, excessPct)
      Next colIdx
   Next rowIdx
   maxExcessDemandPct = maximum
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function finds the sum of all the instances where demand outstrips supply.
'
' return
'    this function returns the sum of all the instances where demand outstrips supply.
'
' param
'    pDemandRange is a range of values each of which is interpreted to represent the demand
' param
'    pSupplyRange is a range of values each of which is interpreted to represent the supply
' -----------------------------------------------------------------------------------------------------------
Public Function totalExcessDemand(pDemandRange As Range, pSupplyRange As Range) As Double
   Dim rowIdx As Long
   Dim colIdx As Long
   Dim supply As Double
   Dim demand As Double
   Dim total  As Double

   total = 0#
   For rowIdx = 1 To pSupplyRange.Rows.count
      For colIdx = 1 To pSupplyRange.Columns.count
         supply = pSupplyRange(rowIdx, colIdx)
         demand = pDemandRange(rowIdx, colIdx)
         If (demand > supply) Then
            total = total + (demand - supply)
         End If
      Next colIdx
   Next rowIdx
   totalExcessDemand = total
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function performs an unsophisticated comparison for equality between two Double values.
' See here for an explanation of this:
'    http://www.cygnus-software.com/papers/comparingfloats/comparingfloats.htm
'
' return
'    This function returns True if the difference between the two values is within a specified tolerance,
'    otherwise, it returns False
'
' param
'    pDbl1 is the value to compare with pDbl2 for equality within the specified tolerance of pEpsilon
' param
'    pDbl2 is the value to compare with pDbl1 for equality within the specified tolerance of pEpsilon
' param (optional)
'    pRelativeEpsilon is the relative tolerance or maximum relative difference allowed between pDbl1 and
'    pDbl2 to call them equal. If no argument value is passed to this procedure through this optional
'    parameter, its value defaults to cDefaultRelativeEpsilon.
' param (optional)
'    pEpsilon is the absolute tolerance or maximum absolute difference allowed between pDbl1 and pDbl2 to
'    call them equal. If no argument value is passed to this procedure through this optional parameter, its
'    value defaults to cDefaultRelativeEpsilon.
' -----------------------------------------------------------------------------------------------------------
Public Function doublesAreEqual _
   ( _
            pDbl1 As Double, _
            pDbl2 As Double, _
   Optional pRelativeEpsilon As Double = cDefaultRelativeEpsilon, _
   Optional pEpsilon As Double = cDefaultEpsilon _
   ) _
   As Boolean

   If (Abs(pDbl1 - pDbl2) < pEpsilon) Then
      doublesAreEqual = True
      Exit Function
   End If

   Dim relativeError As Double
   If (Abs(pDbl2) > Abs(pDbl1)) Then
      relativeError = Abs((pDbl1 - pDbl2) / pDbl2)
   Else
      relativeError = Abs((pDbl1 - pDbl2) / pDbl1)
   End If

   If (relativeError <= pRelativeEpsilon) Then
      doublesAreEqual = True
      Exit Function
   End If
   doublesAreEqual = False
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function converts a fraction's numerator to its equivalent value over a new denominator.
'
' For Example, to convert 3/7ths to 14ths, this is the algebraic process:
'    3/7      = x/14
'    3/7 * 14 = x
'    3 * 14/7 = x
'    3 * 2    = x
'    6        = x
' 3/7ths is the same as 6/14ths
'
' So calling this function like this: equivalentNumerator(3,7,14) will return 6
'
' return
'    This function returns the numerator x in the fraction x/pNewDenominator such that x/pNewDenominator
'    is equivalent to the fraction pNumerator/pOldDenominator
'
' param
'    pNumerator is the numerator in the fraction pNumerator/pOldDenominator
' param
'    pOldDenominator is the denominator in the fraction pNumerator/pOldDenominator
' param
'    pNewDenominator is the denominator in the fraction x/pNewDenominator, where x is the value returned
'    by this function
' -----------------------------------------------------------------------------------------------------------
Public Function equivalentNumerator(pNumerator As Double, pOldDenominator As Double, pNewDenominator As Double) As Double
   If (doublesAreEqual(pOldDenominator, pNewDenominator)) Then
      equivalentNumerator = pNumerator
   Else
      equivalentNumerator = pNumerator * (pNewDenominator / pOldDenominator)
   End If
End Function



' ===========================================================================================================
' ===========================================================================================================
' ===========================================================================================================
' This function returns the log of a number to a specified base. In other words, it returns LOG (pNumber)
'                                                                                              pBase
' which of course, tells you what power pBase has to be raised to to get pNumber.
'   for example, LOG (200) is the number that 100 would have to be raised to to get 200.
'                   100
'
' to use this function to find the number that 100 would have to be raised to to get 200, you would call it
'   logBaseN(200,100)
'      This ordering of parameters is to keep it consistent with Excel's LOG(number, base) function.
'
' return
'    This function returns LOG (pNumber)
'                             pBase
'
' param
'    pNumber is the is thenumber tofind the log base pBase of
' param
'    pBase is the base of the Logarithm.
' -----------------------------------------------------------------------------------------------------------
Public Function logBaseN(pNumber As Double, pBase As Double) As Double
   logBaseN = log(pNumber) / log(pBase)
End Function



Public Function logisticFunction(pXValue As Double, pMidpointXValue As Integer, pMaxYValue As Double, pSteepness As Double) As Double
   logisticFunction = pMaxYValue / (1 + (cE ^ -(pSteepness * (pXValue - pMidpointXValue))))
End Function


Public Function logisticFunctionSteepness(pXValue As Double, pMidpointXValue As Integer, pMaxYValue As Double, pSteepness As Double) As Double
   logisticFunctionSteepness = pMaxYValue / (1 + (cE ^ -(pSteepness * (pXValue - pMidpointXValue))))
End Function