Attribute VB_Name = "MATRIX_RANK_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      : RANK_VECTOR_FUNC
'DESCRIPTION   : RANK THE ENTRIES IN A VECTOR
'LIBRARY       : MATRIX
'GROUP         : RANK
'ID            : 001
'AUTHOR        : RAFAEL NICOLAS FERMIN COTA
'LAST UPDATE   : 01/19/2009
'************************************************************************************
'************************************************************************************

Function RANK_VECTOR_FUNC(ByRef DATA_RNG As Variant, _
Optional ByVal SORT_TYPE As Integer = 0)

'If SORT_TYPE is 0 (zero) or omitted, the list is sorted in
'descending order.

'If SORT_TYPE is any nonzero value, the list is sorted in
'ascending order.

Dim i As Long
Dim j As Long
Dim NROWS As Long

Dim TEMP_VALUE As Variant
Dim DATA_VECTOR As Variant
Dim SORTED_VECTOR As Variant

On Error GoTo ERROR_LABEL

DATA_VECTOR = DATA_RNG
If UBound(DATA_VECTOR, 1) = 1 Then
    DATA_VECTOR = MATRIX_TRANSPOSE_FUNC(DATA_VECTOR)
End If
NROWS = UBound(DATA_VECTOR, 1)

SORTED_VECTOR = MATRIX_QUICK_SORT_FUNC(DATA_VECTOR, 1, SORT_TYPE)

For j = 1 To NROWS
    TEMP_VALUE = SORTED_VECTOR(j, 1)
    For i = 1 To NROWS
        If TEMP_VALUE = DATA_VECTOR(i, 1) Then
             DATA_VECTOR(i, 1) = j
             Exit For
        End If
    Next i
Next j

RANK_VECTOR_FUNC = DATA_VECTOR

Exit Function
ERROR_LABEL:
RANK_VECTOR_FUNC = Err.number
End Function

'************************************************************************************
'************************************************************************************
'© Copyright NicoSystem 2009. All rights reserved by Rafael Nicolas Fermin Cota,
'San Francisco, CA. USA  www.rnfc.org
'nfermincota.hba2005@ivey.ca
'************************************************************************************
'************************************************************************************
'FUNCTION      : RANK_MATRIX_FUNC
'DESCRIPTION   : Returns the rank of a given matrix. It computes the
'sub-space of  Ax = 0, and counts the null column-vectors of the sub-space.

'LIBRARY       : MATRIX
'GROUP         : RANK
'ID            : 002
'AUTHOR        : RAFAEL NICOLAS FERMIN COTA
'LAST UPDATE   : 01/19/2009
'************************************************************************************
'************************************************************************************

Function RANK_MATRIX_FUNC(ByRef DATA_RNG As Variant, _
Optional ByVal VERSION As Integer = 0, _
Optional ByVal EPSILON As Double = 10 ^ -15)

'VERSION = 0 --> diagonal
'VERSION = 1 --> triangle

Dim i As Long
Dim j As Long
Dim k As Long

Dim NSIZE As Long
Dim NROWS As Long
Dim NCOLUMNS As Long

Dim TEMP_SUM As Double

Dim DATA_MATRIX As Variant

Dim ATEMP_MATRIX As Variant
Dim BTEMP_MATRIX As Variant
Dim CTEMP_MATRIX As Variant

On Error GoTo ERROR_LABEL

DATA_MATRIX = DATA_RNG
NROWS = UBound(DATA_MATRIX, 1)
NCOLUMNS = UBound(DATA_MATRIX, 2) 'get the dimension
'reduce DATA_RNG to DATA_MATRIX square matrix CTEMP_MATRIX with the
'lowest dimension

If NROWS <> NCOLUMNS Then
    ATEMP_MATRIX = MATRIX_TRANSPOSE_FUNC(DATA_RNG)
    If NROWS < NCOLUMNS Then
        BTEMP_MATRIX = MMULT_FUNC(DATA_MATRIX, ATEMP_MATRIX, 70)
        NSIZE = NROWS
    Else
        BTEMP_MATRIX = MMULT_FUNC(ATEMP_MATRIX, DATA_MATRIX, 70)
        NSIZE = NCOLUMNS
    End If
Else
    BTEMP_MATRIX = DATA_MATRIX  'nothing to do
    NSIZE = NROWS
End If

'compute the sub-space of Ax=0
CTEMP_MATRIX = MATRIX_GS_SINGULAR_LINEAR_SYSTEM_FUNC(BTEMP_MATRIX, , VERSION, EPSILON, 0)
'count null column-vectors of sub-space
k = NSIZE
For j = 1 To NSIZE
    TEMP_SUM = 0
    For i = 1 To NSIZE
        TEMP_SUM = TEMP_SUM + Abs(CTEMP_MATRIX(i, j))
    Next i
    If TEMP_SUM > EPSILON Then k = k - 1
Next j

RANK_MATRIX_FUNC = k
  
Exit Function
ERROR_LABEL:
RANK_MATRIX_FUNC = Err.number
End Function