Attribute VB_Name = "MATRIX_LEAST_SQUARE_LIBR"


Option Explicit     'Requires that all variables to be declared explicitly.
Option Base 1       'The "Option Base" statement allows to specify 0 or 1 as the
                    'default first index of arrays.


'************************************************************************************
'************************************************************************************
'© Copyright NicoSystem 2009. All rights reserved by Rafael Nicolas Fermin Cota,
'San Francisco, CA. USA  www.rnfc.org
'nfermincota.hba2005@ivey.ca
'************************************************************************************
'************************************************************************************
'FUNCTION      : MATRIX_SIMPLE_LEAST_SQUARE_FUNC
'DESCRIPTION   : Least-squares Regression Function
'LIBRARY       : MATRIX
'GROUP         : LEAST_SQUARE
'ID            : 001
'AUTHOR        : RAFAEL NICOLAS FERMIN COTA
'************************************************************************************
'************************************************************************************

Function MATRIX_SIMPLE_LEAST_SQUARE_FUNC(ByRef X_DATA_RNG As Variant, _
ByRef Y_DATA_RNG As Variant, _
Optional ByRef Z_DATA_RNG As Variant)
    
Dim SX_VAL As Double
Dim SY_VAL As Double
Dim SXX_VAL As Double
Dim SXY_VAL As Double

Dim TEMP_SUM As Double
Dim TEMP_FACT As Double

Dim TEMP_VECTOR As Variant
Dim XDATA_VECTOR As Variant
Dim YDATA_VECTOR As Variant
Dim ZDATA_VECTOR As Variant

On Error GoTo ERROR_LABEL

XDATA_VECTOR = X_DATA_RNG
If UBound(XDATA_VECTOR, 1) = 1 Then: _
    XDATA_VECTOR = MATRIX_TRANSPOSE_FUNC(XDATA_VECTOR)
YDATA_VECTOR = Y_DATA_RNG
If UBound(YDATA_VECTOR, 1) = 1 Then: _
    YDATA_VECTOR = MATRIX_TRANSPOSE_FUNC(YDATA_VECTOR)

If IsArray(Z_DATA_RNG) = True Then
    ZDATA_VECTOR = Z_DATA_RNG
    If UBound(ZDATA_VECTOR, 1) = 1 Then: _
        ZDATA_VECTOR = MATRIX_TRANSPOSE_FUNC(ZDATA_VECTOR)
    ZDATA_VECTOR = VECTOR_ELEMENTS_MULT_FUNC(ZDATA_VECTOR, ZDATA_VECTOR)
Else
    ZDATA_VECTOR = VECTOR_IDENTITY_FUNC(UBound(YDATA_VECTOR, 1))
End If

ReDim TEMP_VECTOR(1 To 4, 1 To 1)


TEMP_SUM = MATRIX_ELEMENTS_CUMULATIVE_SUM_FUNC(ZDATA_VECTOR)

SX_VAL = _
MATRIX_ELEMENTS_CUMULATIVE_SUM_FUNC(VECTOR_ELEMENTS_MULT_FUNC(XDATA_VECTOR, ZDATA_VECTOR))

SY_VAL = _
MATRIX_ELEMENTS_CUMULATIVE_SUM_FUNC(VECTOR_ELEMENTS_MULT_FUNC(YDATA_VECTOR, ZDATA_VECTOR))

SXX_VAL = _
MATRIX_ELEMENTS_CUMULATIVE_SUM_FUNC(VECTOR_ELEMENTS_MULT_FUNC(VECTOR_ELEMENTS_MULT_FUNC(XDATA_VECTOR, _
XDATA_VECTOR), ZDATA_VECTOR))

SXY_VAL = _
MATRIX_ELEMENTS_CUMULATIVE_SUM_FUNC(VECTOR_ELEMENTS_MULT_FUNC(VECTOR_ELEMENTS_MULT_FUNC(XDATA_VECTOR, _
YDATA_VECTOR), ZDATA_VECTOR))

TEMP_FACT = 1 / (TEMP_SUM * SXX_VAL - SX_VAL * SX_VAL)

TEMP_VECTOR(1, 1) = _
(TEMP_SUM * SXY_VAL - SX_VAL * SY_VAL) * TEMP_FACT 'SLOPE / BETA

TEMP_VECTOR(2, 1) = _
(SXX_VAL * SY_VAL - SX_VAL * SXY_VAL) * TEMP_FACT 'INTERCEPT / ALPHA

TEMP_VECTOR(3, 1) = _
Sqr(TEMP_SUM * TEMP_FACT) 'SIGMA SLOPE

TEMP_VECTOR(4, 1) = _
Sqr(SXX_VAL * TEMP_FACT) 'SIGMA INTERCEPT

MATRIX_SIMPLE_LEAST_SQUARE_FUNC = TEMP_VECTOR
    
Exit Function
ERROR_LABEL:
MATRIX_SIMPLE_LEAST_SQUARE_FUNC = Err.number
End Function


'************************************************************************************
'************************************************************************************
'© Copyright NicoSystem 2009. All rights reserved by Rafael Nicolas Fermin Cota,
'San Francisco, CA. USAwww.rnfc.org
'nfermincota.hba2005@ivey.ca
'************************************************************************************
'************************************************************************************
'FUNCTION      : MATRIX_MULT_LEAST_SQUARE_FUNC

'DESCRIPTION   : Coefficients for a line by using the "least squares" method
'to calculate a straight line that best fits your data, and then returns an array
'that describes the line

'LIBRARY       : MATRIX
'GROUP         : LEAST_SQUARE
'ID            : 002
'AUTHOR        : RAFAEL NICOLAS FERMIN COTA
'LAST UPDATE   : 11/29/2008
'************************************************************************************
'************************************************************************************

Function MATRIX_MULT_LEAST_SQUARE_FUNC(ByRef XDATA_RNG As Variant, _
ByRef YDATA_RNG As Variant, _
Optional ByVal INTERCEPT_FLAG As Boolean = True, _
Optional ByVal MATRIX_INVERSE_TYPE As Integer = 0)

Dim i As Long
Dim j As Long

Dim NROWS As Long
Dim NCOLUMNS As Long

Dim XTEMP_MATRIX As Variant

Dim XDATA_MATRIX As Variant
Dim YDATA_VECTOR As Variant

Dim X_TRANS_MATRIX As Variant
Dim XX_TRANS_MATRIX As Variant
Dim XY_TRANS_MATRIX As Variant

Dim XX_INV_TRANS_MATRIX As Variant
Dim XX_INV_X_TRANS_MATRIX As Variant
Dim COEFFICIENTS_VECTOR As Variant

On Error GoTo ERROR_LABEL

XDATA_MATRIX = XDATA_RNG
YDATA_VECTOR = YDATA_RNG
If UBound(YDATA_VECTOR, 1) = 1 Then
    YDATA_VECTOR = MATRIX_TRANSPOSE_FUNC(YDATA_VECTOR)
End If

NROWS = UBound(XDATA_MATRIX, 1)
NCOLUMNS = UBound(XDATA_MATRIX, 2)

If NROWS <> UBound(YDATA_VECTOR, 1) Then: GoTo ERROR_LABEL

'----------------------------------------------------------------------------------------
Select Case INTERCEPT_FLAG
'----------------------------------------------------------------------------------------
Case True
'----------------------------------------------------------------------------------------
    ReDim XTEMP_MATRIX(1 To NROWS, 1 To NCOLUMNS + 1)
    ReDim X_TRANS_MATRIX(1 To NCOLUMNS + 1, 1 To NROWS)
    
    For i = 1 To NROWS
        For j = 1 To NCOLUMNS + 1
            If j = 1 Then
                XTEMP_MATRIX(i, 1) = 1
                X_TRANS_MATRIX(1, i) = 1
            Else
                XTEMP_MATRIX(i, j) = XDATA_MATRIX(i, j - 1)
                X_TRANS_MATRIX(j, i) = XDATA_MATRIX(i, j - 1)
            End If
        Next j
    Next i
        
    XX_TRANS_MATRIX = MMULT_FUNC(X_TRANS_MATRIX, XTEMP_MATRIX, 70) 'X'X
    XX_INV_TRANS_MATRIX = MATRIX_INVERSE_FUNC(XX_TRANS_MATRIX, MATRIX_INVERSE_TYPE) 'X'X -1
    XX_INV_X_TRANS_MATRIX = MMULT_FUNC(XX_INV_TRANS_MATRIX, X_TRANS_MATRIX, 70) 'ESTIMATES

    COEFFICIENTS_VECTOR = MMULT_FUNC(XX_INV_X_TRANS_MATRIX, YDATA_VECTOR, 70)
'----------------------------------------------------------------------------------------
'ENTRY IN COEFFICIENTS_VECTOR(1,1) --> Intercept = Alpha
Case False
'----------------------------------------------------------------------------------------
    X_TRANS_MATRIX = MATRIX_TRANSPOSE_FUNC(XDATA_MATRIX)
    XX_TRANS_MATRIX = MMULT_FUNC(X_TRANS_MATRIX, XDATA_MATRIX, 70) 'X'X
    XX_INV_TRANS_MATRIX = MATRIX_INVERSE_FUNC(XX_TRANS_MATRIX, MATRIX_INVERSE_TYPE) 'X'X -1
    XY_TRANS_MATRIX = MMULT_FUNC(X_TRANS_MATRIX, YDATA_VECTOR, 70)
    COEFFICIENTS_VECTOR = MMULT_FUNC(XX_INV_TRANS_MATRIX, XY_TRANS_MATRIX, 70)
'----------------------------------------------------------------------------------------
End Select
'----------------------------------------------------------------------------------------

MATRIX_MULT_LEAST_SQUARE_FUNC = COEFFICIENTS_VECTOR

Exit Function
ERROR_LABEL:
MATRIX_MULT_LEAST_SQUARE_FUNC = Err.number
End Function