Huge Matrices Library [Updated]

[TarotRedhand]

This section contains the following public routines -

Code: (Select All)

' _INTEGER64

SUB IdentityHMatrix(A&&(), MatrixSize%)
SUB ZeroHMatrix(A&&())
SUB ConHMatrix(A&&())
SUB HMatrixNegate(A&&())
SUB HMatrixTransPose(A&&(), B&&())
SUB HMatrixCopy(This&&(), ToThis&&())
SUB HMatrixPrint(A&&())
SUB HMatrixFilePrint(A&&(), FileNumber)
SUB HMatrixInput(A&&())
SUB HMatrixFileInput(A&&() , FileNum)
SUB HMatrixAdd(A&&(), B&&(), C&&())
SUB HMatrixScalarAdd(A&&(), B&&, C&&())
SUB HMatrixSubtract(A&&(), B&&(), C&&())
SUB HMatrixScalarSubtract(A&&(), B&&, C&&())
SUB HMatrixMultiply(A&&(), B&&(), C&&())
SUB HMatrixScalarMultiply(A&&(), B&&, C&&())
FUNCTION HMatrixMaximum&&(A&&())
FUNCTION HMatrixMinimum&&(A&&())

Actual SUBs/FUNCTIONs -

Code: (Select All)

REM ******************************************************************
REM * This library deals with 2 dimensional arrays that are treated  *
REM * as though they were mathematical matrices.  I have included    *
REM * all the routines that are associated with matrices that make  *
REM * sense for the various TYPEs that are used.  So for integers    *
REM * and longs there no routines for mean, variance, inverse or    *
REM * determinant.  Also for singles and doubles I have left out    *
REM * routines for inverse and determinant as their use is very      *
REM * limited and specialised.                                      *
REM ******************************************************************

REM ******************************************************************
REM * Private SUB only intended for use by the routines in this      *
REM * library.                                                      *
REM ******************************************************************

SUB MatrixError(Where$, Fault$)
    PRINT "Error in ";Where$;" - ";Fault$
    STOP
END SUB        ' | MatrixError

REM ******************************************************************
REM * _INTEGER64 Matrices                                            *
REM ******************************************************************

REM ******************************************************************
REM * A&&() is REDIM'ed to be a square matrix with MatrixSize&& rows  *
REM * and MatrixSize&& columns.  All the elements of A&&() are set to  *
REM * zero except those where the row and the column are equal which *
REM * are set to one e.g. A&&(1,1) = 1, A&&(1,2) = 0.                  *
REM ******************************************************************

SUB IdentityHMatrix(A&&(), MatrixSize&&)
    MatrixSize&& = ABS(MatrixSize&&)
    REDIM A&&(1 TO MatrixSize&&, 1 TO MatrixSize&&)
    FOR Column& = 1 TO MatrixSize&&
        FOR Row& = 1 TO MatrixSize&&
            IF Row& = Column& THEN
                A&&(Row&,Column&) = 1
            ELSE
                A&&(Row&,Column&) = 0
            END IF
        NEXT Row&
    NEXT Column&
END SUB        ' | IdentityHMatrix

REM ******************************************************************
REM * All the elements of A&&() are set to zero.                      *
REM ******************************************************************

SUB ZeroHMatrix(A&&())
    ARowStart& = LBOUND(A&&)
    ARowEnd& = UBOUND(A&&)
    AColStart& = LBOUND(A&&, 2)
    AColEnd& = UBOUND(A&&, 2)
    FOR Column& = AColStart& To AColEnd&
        FOR Row& = ARowStart& TO ARowEnd&
            A&&(Row&,Column&) = 0
        NEXT Row&
    NEXT Column&
END SUB        ' | ZeroHMatrix

REM ******************************************************************
REM * All the elements of A&&() are set to one.                      *
REM ******************************************************************

SUB ConHMatrix(A&&())
    ARowStart& = LBOUND(A&&)
    ARowEnd& = UBOUND(A&&)
    AColStart& = LBOUND(A&&, 2)
    AColEnd& = UBOUND(A&&, 2)
    FOR Column& = AColStart& To AColEnd&
        FOR Row& = ARowStart& TO ARowEnd&
            A&&(Row&,Column&) = 1
        NEXT Row&
    NEXT Column&
END SUB        ' | ConHMatrix

REM ******************************************************************
REM * LET A&&() = -A&&() e.g if A&&(1,1) = 5 then after this routine    *
REM * A&&(1,1) = -5.                                                  *
REM ******************************************************************

SUB HMatrixNegate(A&&())
    ARowStart& = LBOUND(A&&)
    ARowEnd& = UBOUND(A&&)
    AColStart& = LBOUND(A&&, 2)
    AColEnd& = UBOUND(A&&, 2)
    FOR Column& = AColStart& To AColEnd&
        FOR Row& = ARowStart& TO ARowEnd&
            A&&(Row&,Column&) = -A&&(Row&,Column&)
        NEXT Row&
    NEXT Column&
END SUB        ' | HMatrixNegate

REM ******************************************************************
REM * B&&() is REDIM'ed to have the same number of columns as A&&()    *
REM * has rows and to have the same number of rows as A&&() has      *
REM * columns, and then the rows of A&&() are copied to the columns  *
REM * of B&&().                                                      *
REM ******************************************************************

SUB HMatrixTransPose(A&&(), B&&())
    ARowStart& = LBOUND(A&&)
    AColStart& = LBOUND(A&&, 2)
    ARowEnd& = UBOUND(A&&)
    AColEnd& = UBOUND(A&&, 2)
    REDIM B&&(AColStart& TO AColEnd&, ARowStart& TO ARowEnd&)
    FOR P& = AColStart& TO AColEnd&
        FOR Q& = ARowStart& TO ARowEnd&
            B&&(P&, Q&) = A&&(Q&, P&)
        NEXT Q&
    NEXT P&
END SUB        ' | HMatrixTransPose

REM ******************************************************************
REM * REDIM's ToThis&&() to be the same size as This&&() and then      *
REM * copies the contents of This&&() to ToThis&&().                  *
REM ******************************************************************

SUB HMatrixCopy(This&&(), ToThis&&())
    RowStart& = LBOUND(This&&)
    RowFinish& = UBOUND(This&&)
    ColStart& = LBOUND(This&&, 2)
    ColFinish& = UBOUND(This&&,2)
    REDIM ToThis&&(RowStart& TO RowFinish&, ColStart& TO ColFinish&)
    FOR Column& = ColStart& TO ColFinish&
        FOR Row& = RowStart& To RowFinish&
            ToThis&&(Row&,Column&) = This&&(Row&,Column&)
        NEXT Row&
    NEXT Column&
END SUB        ' | HMatrixCopy

REM ******************************************************************
REM * Display the contents of A&&() on screen, formatted in columns.  *
REM ******************************************************************

SUB HMatrixPrint(A&&())
    ARowStart& = LBOUND(A&&)
    ARowEnd& = UBOUND(A&&)
    AColStart& = LBOUND(A&&, 2)
    AColEnd& = UBOUND(A&&, 2)
    FOR Row& = ARowStart& TO ARowEnd&
        FOR Column& = AColStart& To AColEnd&
            PRINT A&&(Row&,Column&);" ";
        NEXT Column&
        PRINT
    NEXT Row&
END SUB        ' | HMatrixPrint

REM ******************************************************************
REM * Saves the contents of A&&() to the file specified by FileNumber *
REM ******************************************************************

SUB HMatrixFilePrint(A&&(), FileNumber)
    ARowStart& = LBOUND(A&&)
    PRINT #FileNumber, ARowStart&;" ";
    ARowEnd& = UBOUND(A&&)
    PRINT #FileNumber, ARowEnd&;" ";
    AColStart& = LBOUND(A&&, 2)
    PRINT #FileNumber, AColStart&;" ";
    AColEnd& = UBOUND(A&&, 2)
    PRINT #FileNumber, AColEnd&;" ";
    PRINT #FileNumber,
    FOR Row& = ARowStart& TO ARowEnd&
        FOR Column& = AColStart& To AColEnd&
            PRINT #FileNumber, A&&(Row&,Column&);" ";
        NEXT Column&
        PRINT #FileNumber,
    NEXT Row&
END SUB        ' | HMatrixFilePrint

REM ******************************************************************
REM * This routine is for the sadists and masochists among you in    *
REM * that it inputs all the information necessary to create and    *
REM * fill a matrix from the keyboard.                              *
REM ******************************************************************

SUB HMatrixInput(A&&())
    INPUT"Lowest subscript for A&&(1):",A
    INPUT"Highest subscript for A&&(1):",B
    INPUT"Lowest subscript for A&&(2):",C
    INPUT"Lowest subscript for A&&(2):",D
    REDIM A&&(A TO B, C TO D)
    PRINT
    FOR Row& = A TO B
        FOR Column& = C TO D
            PRINT "Enter value for position ";Row&;", ";Column&;":";
            INPUT A
            A&&(Row&,Column&) = FIX(A)
        NEXT Column&
    NEXT Row&
END SUB        ' | HMatrixInput

REM ******************************************************************
REM * This routine reads all the information necessary to create and *
REM * fill a matrix ( A&&() ) from a file specified by filenum.  This *
REM * routine is the complement to IMatrixFilePrint and retrieves    *
REM * the information in the same order as that routine writes it.  *
REM ******************************************************************

SUB HMatrixFileInput(A&&() , FileNum)
    INPUT #FileNum, A
    INPUT #FileNum, B
    INPUT #FileNum, C
    INPUT #FileNum, D
    A = ABS(FIX(A))
    B = ABS(FIX(B))
    C = ABS(FIX(C))
    D = ABS(FIX(D))
    REDIM A&&(A TO B, C TO D)
    FOR Row& = A TO B
        FOR Column& = C TO D
            INPUT #FileNum, A
            A&&(Row&,Column&) = FIX(A)
        NEXT Column&
    NEXT Row&
END SUB        ' | HMatrixFileInput

REM ******************************************************************
REM * Matrix addition e.g. C&&() = A&&() + B&&().  A&&() and B&&() must  *
REM * have identical upper and lower bounds.  C&&() is REDIM'ed to be *
REM * the same size.  Each element of C&&() is assigned the result of *
REM * adding the equivalent elements in A&&() and B&&().              *
REM ******************************************************************

SUB HMatrixAdd(A&&(), B&&(), C&&())
    ID$ = "HMatrixAdd"
    ARowStart& = LBOUND(A&&)
    BRowStart& = LBOUND(B&&)
    IF ARowStart& <> BRowStart& THEN
        MatrixError ID$, "Lower bounds of A(1) and B(1) not identical!"
    END IF
    ARowEnd& = UBOUND(A&&)
    BRowEnd& = UBOUND(B&&)
    IF ARowEnd& <> BRowEnd& THEN
        MatrixError ID$, "Upper bounds of A(1) and B(1) not identical!"
    END IF
    AColStart& = LBOUND(A&&, 2)
    BColStart& = LBOUND(B&&, 2)
    IF AColStart& <> BColStart& THEN
        MatrixError ID$, "Lower bounds of A(2) and B(2) not identical!"
    END IF
    AColEnd& = UBOUND(A&&, 2)
    BColEnd& = UBOUND(B&&, 2)
    IF ARowEnd& <> BRowEnd& THEN
        MatrixError ID$, "Upper bounds of A(1) and B(1) not identical!"
    END IF
    REDIM C&&(ARowStart& TO ARowEnd&, AColStart& TO AColEnd&)
    FOR Column& = AColStart& To AColEnd&
        FOR Row& = ARowStart& TO ARowEnd&
            C&&(Row&,Column&) = A&&(Row&,Column&) + B&&(Row&,Column&)
        NEXT Row&
    NEXT Column&
END SUB        ' | HMatrixAdd

REM ******************************************************************
REM * Matrix scalar addition e.g. C&&() = A&&() + B&&.  C&&() is        *
REM * REDIM'ed to be identical in size to A&&().  Each element of    *
REM * C&&() is assigned the result of adding B&& to the equivalent    *
REM * elements in A&&().                                              *
REM ******************************************************************

SUB HMatrixScalarAdd(A&&(), B&&, C&&())
    ARowStart& = LBOUND(A&&)
    ARowEnd& = UBOUND(A&&)
    AColStart& = LBOUND(A&&, 2)
    AColEnd& = UBOUND(A&&, 2)
    REDIM C&&(ARowStart& TO ARowEnd&, AColStart& TO AColEnd&)
    FOR Column& = AColStart& To AColEnd&
        FOR Row& = ARowStart& TO ARowEnd&
            C&&(Row&,Column&) = A&&(Row&,Column&) + B&&
        NEXT Row&
    NEXT Column&
END SUB        ' | HMatrixScalarAdd

REM ******************************************************************
REM * Matrix subtraction e.g. C&&() = A&&() - B&&().  A&&() and B&&()    *
REM * must have identical upper and lower bounds.  C&&() is REDIM'ed  *
REM * to be the same size.  Each element of C&&() is assigned the    *
REM * result of subtracting the equivalent element of B&&() from the  *
REM * equivalent element of A&&().                                    *
REM ******************************************************************

SUB HMatrixSubtract(A&&(), B&&(), C&&())
    ID$ = "HMatrixSubtract"
    ARowStart& = LBOUND(A&&)
    BRowStart& = LBOUND(B&&)
    IF ARowStart& <> BRowStart& THEN
        MatrixError ID$, "Lower bounds of A(1) and B(1) not identical!"
    END IF
    ARowEnd& = UBOUND(A&&)
    BRowEnd& = UBOUND(B&&)
    IF ARowEnd& <> BRowEnd& THEN
        MatrixError ID$, "Upper bounds of A(1) and B(1) not identical!"
    END IF
    AColStart& = LBOUND(A&&, 2)
    BColStart& = LBOUND(B&&, 2)
    IF AColStart& <> BColStart& THEN
        MatrixError ID$, "Lower bounds of A(2) and B(2) not identical!"
    END IF
    AColEnd& = UBOUND(A&&, 2)
    BColEnd& = UBOUND(B&&, 2)
    IF ARowEnd& <> BRowEnd& THEN
        MatrixError ID$, "Upper bounds of A(1) and B(1) not identical!"
    END IF
    REDIM C&&(ARowStart& TO ARowEnd&, AColStart& TO AColEnd&)
    FOR Column& = AColStart& To AColEnd&
        FOR Row& = ARowStart& TO ARowEnd&
            C&&(Row&,Column&) = A&&(Row&,Column&) - B&&(Row&,Column&)
        NEXT Row&
    NEXT Column&
END SUB        ' | HMatrixSubtract

REM ******************************************************************
REM * Matrix scalar subtraction e.g. C&&() = A&&() - B&&.  C&&() is      *
REM * REDIM'ed to be the same size as A&&().  Each element of C&&() is *
REM * assigned the result of subtracting B&& from the equivalent of  *
REM * A&&().                                                          *
REM ******************************************************************

SUB HMatrixScalarSubtract(A&&(), B&&, C&&())
    ARowStart& = LBOUND(A&&)
    ARowEnd& = UBOUND(A&&)
    AColStart& = LBOUND(A&&, 2)
    AColEnd& = UBOUND(A&&, 2)
    REDIM C&&(ARowStart& TO ARowEnd&, AColStart& TO AColEnd&)
    FOR Column& = AColStart& To AColEnd&
        FOR Row& = ARowStart& TO ARowEnd&
            C&&(Row&,Column&) = A&&(Row&,Column&) - B&&
        NEXT Row&
    NEXT Column&
END SUB        ' | HMatrixScalarSubtract

REM ******************************************************************
REM * Matrix multiplication e.g. C&&() = A&&() * B&&().  As such it is  *
REM * easier to direct you to look at the source code for this      *
REM * routine rather than to try to explain it, other than to say    *
REM * that C&&() is REDIM'ed according to the standard matrix formula *
REM ******************************************************************

SUB HMatrixMultiply(A&&(), B&&(), C&&())
    ID$ = "HMatrixMultiply"
    ARowStart& = LBOUND(A&&)
    BRowStart& = LBOUND(B&&)
    IF ARowStart& <> BRowStart& THEN
        MatrixError ID$, "Lower bounds of A(1) and B(1) not identical!"
    END IF
    AColStart& = LBOUND(A&&, 2)
    BColStart& = LBOUND(B&&, 2)
    IF AColStart& <> BColStart& THEN
        MatrixError ID$, "Lower bounds of A(2) and B(2) not identical!"
    END IF
    BRowEnd& = UBOUND(B&&)
    AColEnd& = UBOUND(A&&, 2)
    IF AColEnd& <> BRowEnd& THEN
        MatrixError ID$, "Upper bounds of A(2) and B(1) not identical!"
    END IF
    ARowEnd& = UBOUND(A&&)
    BColEnd& = UBOUND(B&&, 2)
    REDIM C&&(ARowStart& TO ARowEnd&, BColStart& TO BColEnd&)
    FOR Row& = ARowStart& TO ARowEnd&
        FOR Column& = BColStart& To BColEnd&
            Sum&& = 0
            FOR Z& = AColStart& TO AColEnd&
                Sum&& = Sum&& + (A&&(Row&, Z&) * B&&(Z&, Column&))
            NEXT Z&
            C&&(Row&,Column&) = Sum&&
        NEXT Column&
    NEXT Row&
END SUB        ' | HMatrixMultiply

REM ******************************************************************
REM * Matrix scalar multiplication e.g. C&&() = A&&() * B&&.  C&&() is  *
REM * REDIM'ed to be the same size as A&&().  Each element of C&&() is *
REM * assigned the result of multiplying the equivalent element of  *
REM * A&&() by B&&.                                                    *
REM ******************************************************************

SUB HMatrixScalarMultiply(A&&(), B&&, C&&())
    ARowStart& = LBOUND(A&&)
    AColStart& = LBOUND(A&&, 2)
    ARowEnd& = UBOUND(A&&)
    AColEnd& = UBOUND(A&&, 2)
    REDIM C&&(ARowStart& TO ARowEnd&, AColStart& TO AColEnd&)
    FOR Column& = AColStart& To AColEnd&
        FOR Row& = ARowStart& TO ARowEnd&
            C&&(Row&,Column&) = A&&(Row&,Column&) * B&&
        NEXT Row&
    NEXT Column&
END SUB        ' | HMatrixScalarMultiply

REM ******************************************************************
REM * Returns the maximum element contained in A&&().                *
REM ******************************************************************

FUNCTION HMatrixMaximum&&(A&&())
    MyMax&& = -9223372036854775808
    ARowStart& = LBOUND(A&&)
    ARowEnd& = UBOUND(A&&)
    AColStart& = LBOUND(A&&, 2)
    AColEnd& = UBOUND(A&&, 2)
    FOR Column& = AColStart& To AColEnd&
        FOR Row& = ARowStart& TO ARowEnd&
            IF MyMax&& < A&&(Row&, Column&) THEN
                MyMax&& = A&&(Row&,Column&)
            END IF
        NEXT Row&
    NEXT Column&
    HMatrixMaximum&& = MyMax&&
END FUNCTION    ' | HMatrixMaximum&&

REM ******************************************************************
REM * Returns the minimum element contained in A&&().                *
REM ******************************************************************

FUNCTION HMatrixMinimum&&(A&&())
    MyMin&& = 9223372036854775807
    ARowStart& = LBOUND(A&&)
    ARowEnd& = UBOUND(A&&)
    AColStart& = LBOUND(A&&, 2)
    AColEnd& = UBOUND(A&&, 2)
    FOR Column& = AColStart& To AColEnd&
        FOR Row& = ARowStart& TO ARowEnd&
            IF MyMin&& > A&&(Row&, Column&) THEN
                MyMin&& = A&&(Row&,Column&)
            END IF
        NEXT Row&
    NEXT Column&
    HMatrixMinimum&& = MyMin&&
END FUNCTION    ' | HMatrixMinimum&&

SINGLE precision floating point next post -

TR