Huge Matrices Library [Updated]

[TarotRedhand]

I initially created this library in the late 1990s. Having found QB64, I have now updated and expanded this library to work with it. At 2622 lines (including comments) it is obviously too large to post in a single code box. So the actual code is split into the six posts after this one. Also the sheer size and number of edits I made means that you should really treat this being a beta/release candidate version.

This library is all to do with matrices. There are six sections to it. Each section deals with matrix operations for arrays that contain a particular TYPE of data - Integer, Long Integer, _INTEGER64, Single precision floating point, Double precision floating point and _FLOAT. Overall this gives us 1 private routine and 114 public routines.

Having split it into 6 parts, I have made it so that each part should be able to be used independently of any other. The consequence of this is that if you want to use two (or more) parts you may well need to do minor editing on one (or more) parts.

Bug reports - either in here or pm me.

[Edit]

Now with a ridiculously small BI file that works all varieties of the library. '$INCLUDE: 'MATRIX.BI' at the top of the program that uses any of the library parts.

MATRIX.BI

Code: (Select All)

'$DYNAMIC

Option Base 1

Note all parts of this library have been updated to reflect this.

Next post Integer Matrices -

TR

[TarotRedhand]

This section contains the following public routines -

Code: (Select All)

' Integer

SUB IdentityIMatrix(A%(), MatrixSize%)
SUB ZeroIMatrix(A%())
SUB ConIMatrix(A%())
SUB IMatrixNegate(A%())
SUB IMatrixTransPose(A%(), B%())
SUB IMatrixCopy(This%(), ToThis%())
SUB IMatrixPrint(A%())
SUB IMatrixFilePrint(A%(), FileNumber)
SUB IMatrixInput(A%())
SUB IMatrixFileInput(A%() , FileNum)
SUB IMatrixAdd(A%(), B%(), C%())
SUB IMatrixScalarAdd(A%(), B%, C%())
SUB IMatrixSubtract(A%(), B%(), C%())
SUB IMatrixScalarSubtract(A%(), B%, C%())
SUB IMatrixMultiply(A%(), B%(), C%())
SUB IMatrixScalarMultiply(A%(), B%, C%())
FUNCTION IMatrixMaximum%(A%())
FUNCTION IMatrixMinimum%(A%())

And here is the library -

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 * Integer 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 IdentityIMatrix(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        ' | IdentityIMatrix

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

SUB ZeroIMatrix(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        ' | ZeroIMatrix

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

SUB ConIMatrix(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        ' | ConIMatrix

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

SUB IMatrixNegate(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        ' | IMatrixNegate

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 IMatrixTransPose(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        ' | IMatrixTransPose

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

SUB IMatrixCopy(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        ' | IMatrixCopy

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

SUB IMatrixPrint(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        ' | IMatrixPrint

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

SUB IMatrixFilePrint(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        ' | IMatrixFilePrint

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 fromthe keyboard.                                *
REM ******************************************************************

SUB IMatrixInput(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        ' | IMatrixInput

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 IMatrixFileInput(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        ' | IMatrixFileInput

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 IMatrixAdd(A%(), B%(), C%())
    ID$ = "IMatrixAdd"
    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        ' | IMatrixAdd

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 IMatrixScalarAdd(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        ' | IMatrixScalarAdd

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 IMatrixSubtract(A%(), B%(), C%())
    ID$ = "IMatrixSubtract"
    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        ' | IMatrixSubtract

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 IMatrixScalarSubtract(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        ' | IMatrixScalarSubtract

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 IMatrixMultiply(A%(), B%(), C%())
    ID$ = "IMatrixMultiply"
    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        ' | IMatrixMultiply

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 IMatrixScalarMultiply(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        ' | IMatrixScalarMultiply

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

FUNCTION IMatrixMaximum%(A%())
    MyMax% = -32768
    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&
    IMatrixMaximum% = MyMax%
END FUNCTION    ' | IMatrixMaximum%

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

FUNCTION IMatrixMinimum%(A%())
    MyMin% = 32767
    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&
    IMatrixMinimum% = MyMin%
END FUNCTION    ' | IMatrixMinimum%

Next up is LONG Integer -

TR

[TarotRedhand]

This section contains the following public routines -

Code: (Select All)

' Long Integer

SUB IdentityLMatrix(A&(), MatrixSize&)
SUB ZeroLMatrix(A&())
SUB ConLMatrix(A&())
SUB LMatrixNegate(A&())
SUB LMatrixTransPose(A&(), B&())
SUB LMatrixCopy(This&(), ToThis&())
SUB LMatrixPrint(A&())
SUB LMatrixFilePrint(A&(), FileNumber)
SUB LMatrixInput(A&())
SUB LMatrixFileInput(A&() , FileNum)
SUB LMatrixAdd(A&(), B&(), C&())
SUB LMatrixScalarAdd(A&(), B&, C&())
SUB LMatrixSubtract(A&(), B&(), C&())
SUB LMatrixScalarSubtract(A&(), B&, C&())
SUB LMatrixMultiply(A&(), B&(), C&())
SUB LMatrixScalarMultiply(A&(), B&, C&())
FUNCTION LMatrixMaximum&(A&())
FUNCTION LMatrixMinimum&(A&())

Actual code -

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 * Long Integer 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 IdentityLMatrix(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        ' | IdentityLMatrix

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

SUB ZeroLMatrix(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        ' | ZeroLMatrix

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

SUB ConLMatrix(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        ' | ConLMatrix

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

SUB LMatrixNegate(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        ' | LMatrixNegate

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 LMatrixTransPose(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        ' | LMatrixTransPose

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

SUB LMatrixCopy(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        ' | LMatrixCopy

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

SUB LMatrixPrint(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        ' | LMatrixPrint

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

SUB LMatrixFilePrint(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        ' | LMatrixFilePrint

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 LMatrixInput(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        ' | LMatrixInput

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 LMatrixFileInput(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        ' | LMatrixFileInput

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 LMatrixAdd(A&(), B&(), C&())
    ID$ = "LMatrixAdd"
    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        ' | LMatrixAdd

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 LMatrixScalarAdd(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        ' | LMatrixScalarAdd

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 LMatrixSubtract(A&(), B&(), C&())
    ID$ = "LMatrixSubtract"
    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        ' | LMatrixSubtract

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 LMatrixScalarSubtract(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        ' | LMatrixScalarSubtract

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 LMatrixMultiply(A&(), B&(), C&())
    ID$ = "LMatrixMultiply"
    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        ' | LMatrixMultiply

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 LMatrixScalarMultiply(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        ' | LMatrixScalarMultiply

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

FUNCTION LMatrixMaximum&(A&())
    MyMax& = -2147483648
    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&
    LMatrixMaximum& = MyMax&
END FUNCTION    ' | LMatrixMaximum&

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

FUNCTION LMatrixMinimum&(A&())
    MyMin& = 2147483647
    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&
    LMatrixMinimum& = MyMin&
END FUNCTION    ' | LMatrixMinimum&

Next up _INTEGER64 -

TR

[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

[TarotRedhand]

This section contains the following public routines -

Code: (Select All)

' Single precision floating point

SUB IdentitySMatrix(A!(), MatrixSize%)
SUB ZeroSMatrix(A!())
SUB ConSMatrix(A!())
SUB SMatrixNegate(A!())
SUB SMatrixTransPose(A!(), B!())
SUB SMatrixCopy(This!(), ToThis!())
SUB SMatrixPrint(A!())
SUB SMatrixFilePrint(A!(), FileNumber)
SUB SMatrixInput(A!())
SUB SMatrixFileInput(A!() , FileNum)
SUB SMatrixAdd(A!(), B!(), C!())
SUB SMatrixScalarAdd(A!(), B!, C!())
SUB SMatrixSubtract(A!(), B!(), C!())
SUB SMatrixScalarSubtract(A!(), B!, C!())
SUB SMatrixMultiply(A!(), B!(), C!())
SUB SMatrixScalarMultiply(A!(), B!, C!())
FUNCTION SMatrixMaximum!(A!())
FUNCTION SMatrixMinimum!(A!())
FUNCTION SMatrixMean!(A!())
FUNCTION SMatrixVariance!(A!())

Actual library -

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 * Single precision floating point 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 IdentitySMatrix(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.0
            ELSE
                A!(Row&,Column&) = 0.0
            END IF
        NEXT Row&
    NEXT Column&
END SUB        ' | IdentitySMatrix

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

SUB ZeroSMatrix(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.0
        NEXT Row&
    NEXT Column&
END SUB        ' | ZeroSMatrix

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

SUB ConSMatrix(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.0
        NEXT Row&
    NEXT Column&
END SUB        ' | ConSMatrix

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

SUB SMatrixNegate(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        ' | SMatrixNegate

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 SMatrixTransPose(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        ' | SMatrixTransPose

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

SUB SMatrixCopy(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        ' | SMatrixCopy

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

SUB SMatrixPrint(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        ' | SMatrixPrint

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

SUB SMatrixFilePrint(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        ' | SMatrixFilePrint

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 fromthe keyboard.                                *
REM ******************************************************************

SUB SMatrixInput(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        ' | SMatrixInput

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 SMatrixFileInput(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!(Row&,Column&)
        NEXT Column&
    NEXT Row&
END SUB        ' | SMatrixFileInput

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 SMatrixAdd(A!(), B!(), C!())
    ID$ = "SMatrixAdd"
    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        ' | SMatrixAdd

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 SMatrixScalarAdd(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        ' | SMatrixScalarAdd

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 SMatrixSubtract(A!(), B!(), C!())
    ID$ = "SMatrixSubtract"
    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        ' | SMatrixSubtract

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 SMatrixScalarSubtract(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        ' | SMatrixScalarSubtract

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 SMatrixMultiply(A!(), B!(), C!())
    ID$ = "SMatrixMultiply"
    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.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        ' | SMatrixMultiply

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 SMatrixScalarMultiply(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        ' | SMatrixScalarMultiply

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

FUNCTION SMatrixMaximum!(A!())
    MyMax! = -2.802597E-45
    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&
    SMatrixMaximum! = MyMax!
END FUNCTION    ' | SMatrixMaximum!

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

FUNCTION SMatrixMinimum!(A!())
    MyMin! = 3.402823E+38
    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&
    SMatrixMinimum! = MyMin!
END FUNCTION    ' | SMatrixMinimum!

REM ******************************************************************
REM * Returns the Average of all the values contained in A!().      *
REM ******************************************************************

FUNCTION SMatrixMean!(A!())
    Sum! = 0.0
    ARowStart& = LBOUND(A!)
    AColStart& = LBOUND(A!, 2)
    ARowEnd& = UBOUND(A!)
    AColEnd& = UBOUND(A!, 2)
    FOR Column& = AColStart& TO AColEnd&
        FOR Row& = ARowStart& TO ARowEnd&
            Sum! = Sum! + A!(Row&,Column&)
        NEXT Row&
    NEXT Column&
    MatrixSize! = (1.0 + ARowEnd& - ARowStart&) * (1.0 + AColEnd& - AColStart&)
    SMatrixMean! = Sum! / MatrixSize!
END FUNCTION    ' | SMatrixMean!

REM ******************************************************************
REM * Returns the variance of all the values contained in A!().      *
REM ******************************************************************

FUNCTION SMatrixVariance!(A!())
    SumSquared! = 0.0
    MyMean! = SMatrixMean!(A!())
    ARowStart& = LBOUND(A!)
    AColStart& = LBOUND(A!, 2)
    ARowEnd& = UBOUND(A!)
    AColEnd& = UBOUND(A!, 2)
    FOR Column& = AColStart& TO AColEnd&
        FOR Row& = ARowStart& TO ARowEnd&
            Temp! = A!(Row&,Column&) - MyMean!
            Temp! = Temp! * Temp!
            SumSquared! = SumSquared! + Temp!
        NEXT Row&
    NEXT Column&
    MatrixSize! = (1.0 + ARowEnd& - ARowStart&) * (1.0 + AColEnd& - AColStart&)
    SMatrixVariance! = SumSquared! / (MatrixSize! - 1.0)
END FUNCTION    ' | SMatrixVariance!

Next part DOUBLE precision floating point -

TR

[TarotRedhand]

Contents are -

Code: (Select All)

' Double precision floating point

SUB IdentityDMatrix(A#(), MatrixSize%)
SUB ZeroDMatrix(A#())
SUB ConDMatrix(A#())
SUB DMatrixNegate(A#())
SUB DMatrixTransPose(A#(), B#())
SUB DMatrixCopy(This#(), ToThis#())
SUB DMatrixPrint(A#())
SUB DMatrixFilePrint(A#(), FileNumber)
SUB DMatrixInput(A#())
SUB DMatrixFileInput(A#() , FileNum)
SUB DMatrixAdd(A#(), B#(), C#())
SUB DMatrixScalarAdd(A#(), B#, C#())
SUB DMatrixSubtract(A#(), B#(), C#())
SUB DMatrixScalarSubtract(A#(), B#, C#())
SUB DMatrixMultiply(A#(), B#(), C#())
SUB DMatrixScalarMultiply(A#(), B#, C#())
FUNCTION DMatrixMaximum#(A#())
FUNCTION DMatrixMinimum#(A#())
FUNCTION DMatrixMean#(A#())
FUNCTION DMatrixVariance#(A#())

Library in this code box -

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 * Double precision floating point 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 IdentityDMatrix(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.0
            ELSE
                A#(Row&,Column&) = 0.0
            END IF
        NEXT Row&
    NEXT Column&
END SUB        ' | IdentityDMatrix

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

SUB ZeroDMatrix(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.0
        NEXT Row&
    NEXT Column&
END SUB        ' | ZeroDMatrix

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

SUB ConDMatrix(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.0
        NEXT Row&
    NEXT Column&
END SUB        ' | ConDMatrix

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

SUB DMatrixNegate(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        ' | DMatrixNegate

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 DMatrixTransPose(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        ' | DMatrixTransPose

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

SUB DMatrixCopy(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        ' | DMatrixCopy

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

SUB DMatrixPrint(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        ' | DMatrixPrint

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

SUB DMatrixFilePrint(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        ' | DMatrixFilePrint

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 fromthe keyboard.                                *
REM ******************************************************************

SUB DMatrixInput(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        ' | DMatrixInput

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 DMatrixFileInput(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#(Row&,Column&)
        NEXT Column&
    NEXT Row&
END SUB        ' | DMatrixFileInput

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 DMatrixAdd(A#(), B#(), C#())
    ID$ = "DMatrixAdd"
    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        ' | DMatrixAdd

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 DMatrixScalarAdd(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        ' | DMatrixScalarAdd

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 DMatrixSubtract(A#(), B#(), C#())
    ID$ = "DMatrixSubtract"
    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        ' | DMatrixSubtract

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 DMatrixScalarSubtract(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        ' | DMatrixScalarSubtract

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 DMatrixMultiply(A#(), B#(), C#())
    ID$ = "DMatrixMultiply"
    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.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        ' | DMatrixMultiply

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 DMatrixScalarMultiply(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        ' | DMatrixScalarMultiply

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

FUNCTION DMatrixMaximum#(A#())
    MyMax# = -4.490656458412465E-324
    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&
    DMatrixMaximum# = MyMax#
END FUNCTION    ' | DMatrixMaximum#

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

FUNCTION DMatrixMinimum#(A#())
    MyMin# = 1.797693134862310E+308
    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&
    DMatrixMinimum# = MyMin#
END FUNCTION    ' | DMatrixMinimum#

REM ******************************************************************
REM * Returns the Average of all the values contained in A#().      *
REM ******************************************************************

FUNCTION DMatrixMean#(A#())
    Sum# = 0.0
    ARowStart& = LBOUND(A#)
    AColStart& = LBOUND(A#, 2)
    ARowEnd& = UBOUND(A#)
    AColEnd& = UBOUND(A#, 2)
    FOR Column& = AColStart& TO AColEnd&
        FOR Row& = ARowStart& TO ARowEnd&
            Sum# = Sum# + A#(Row&,Column&)
        NEXT Row&
    NEXT Column&
    MatrixSize# = (1.0 + ARowEnd& - ARowStart&) * (1.0 + AColEnd& - AColStart&)
    DMatrixMean# = Sum# / MatrixSize#
END FUNCTION    ' | DMatrixMean#

REM ******************************************************************
REM * Returns the variance of all the values contained in A#().      *
REM ******************************************************************

FUNCTION DMatrixVariance#(A#())
    SumSquared# = 0.0
    MyMean# = DMatrixMean#(A#())
    ARowStart& = LBOUND(A#)
    AColStart& = LBOUND(A#, 2)
    ARowEnd& = UBOUND(A#)
    AColEnd& = UBOUND(A#, 2)
    FOR Column& = AColStart& TO AColEnd&
        FOR Row& = ARowStart& TO ARowEnd&
            Temp# = A#(Row&,Column&) - MyMean#
            Temp# = Temp# * Temp#
            SumSquared# = SumSquared# + Temp#
        NEXT Row&
    NEXT Column&
    MatrixSize# = (1.0 + ARowEnd& - ARowStart&) * (1.0 + AColEnd& - AColStart&)
    DMatrixVariance# = SumSquared# / (MatrixSize# - 1.0)
END FUNCTION    ' | DMatrixVariance#

And finally _FLOAT in next post

TR

[TarotRedhand]

The contents of this part are -

Code: (Select All)

' _FLOAT

SUB IdentityFMatrix(A##(), MatrixSize%)
SUB ZeroFMatrix(A##())
SUB ConFMatrix(A##())
SUB FMatrixNegate(A##())
SUB FMatrixTransPose(A##(), B##())
SUB FMatrixCopy(This##(), ToThis##())
SUB FMatrixPrint(A##())
SUB FMatrixFilePrint(A##(), FileNumber)
SUB FMatrixInput(A##())
SUB FMatrixFileInput(A##() , FileNum)
SUB FMatrixAdd(A##(), B##(), C##())
SUB FMatrixScalarAdd(A##(), B##, C##())
SUB FMatrixSubtract(A##(), B##(), C##())
SUB FMatrixScalarSubtract(A##(), B##, C##())
SUB FMatrixMultiply(A##(), B##(), C##())
SUB FMatrixScalarMultiply(A##(), B##, C##())
FUNCTION FMatrixMaximum##(A##())
FUNCTION FMatrixMinimum##(A##())
FUNCTION FMatrixMean##(A##())
FUNCTION FMatrixVariance##(A##())

The code for which is -

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 * _FLOAT floating point 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 IdentityFMatrix(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.0
            ELSE
                A##(Row&,Column&) = 0.0
            END IF
        NEXT Row&
    NEXT Column&
END SUB        ' | IdentityFMatrix

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

SUB ZeroFMatrix(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.0
        NEXT Row&
    NEXT Column&
END SUB        ' | ZeroFMatrix

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

SUB ConFMatrix(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.0
        NEXT Row&
    NEXT Column&
END SUB        ' | ConFMatrix

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

SUB FMatrixNegate(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        ' | FMatrixNegate

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 FMatrixTransPose(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        ' | FMatrixTransPose

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

SUB FMatrixCopy(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        ' | FMatrixCopy

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

SUB FMatrixPrint(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        ' | FMatrixPrint

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

SUB FMatrixFilePrint(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        ' | FMatrixFilePrint

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 fromthe keyboard.                                *
REM ******************************************************************

SUB FMatrixInput(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        ' | FMatrixInput

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 FMatrixFileInput(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##(Row&,Column&)
        NEXT Column&
    NEXT Row&
END SUB        ' | FMatrixFileInput

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 FMatrixAdd(A##(), B##(), C##())
    ID$ = "FMatrixAdd"
    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        ' | FMatrixAdd

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 FMatrixScalarAdd(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        ' | FMatrixScalarAdd

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 FMatrixSubtract(A##(), B##(), C##())
    ID$ = "FMatrixSubtract"
    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        ' | FMatrixSubtract

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 FMatrixScalarSubtract(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        ' | FMatrixScalarSubtract

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 FMatrixMultiply(A##(), B##(), C##())
    ID$ = "FMatrixMultiply"
    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.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        ' | FMatrixMultiply

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 FMatrixScalarMultiply(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        ' | FMatrixScalarMultiply

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

FUNCTION FMatrixMaximum##(A##())
    MyMax## = -1.18E-4932
    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&
    FMatrixMaximum## = MyMax##
END FUNCTION    ' | FMatrixMaximum##

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

FUNCTION FMatrixMinimum##(A##())
    MyMin## = 1.18E+4932
    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&
    FMatrixMinimum## = MyMin##
END FUNCTION    ' | FMatrixMinimum##

REM ******************************************************************
REM * Returns the Average of all the values contained in A##().      *
REM ******************************************************************

FUNCTION FMatrixMean##(A##())
    Sum## = 0.0
    ARowStart& = LBOUND(A##)
    AColStart& = LBOUND(A##, 2)
    ARowEnd& = UBOUND(A##)
    AColEnd& = UBOUND(A##, 2)
    FOR Column& = AColStart& TO AColEnd&
        FOR Row& = ARowStart& TO ARowEnd&
            Sum## = Sum## + A##(Row&,Column&)
        NEXT Row&
    NEXT Column&
    MatrixSize## = (1.0 + ARowEnd& - ARowStart&) * (1.0 + AColEnd& - AColStart&)
    FMatrixMean## = Sum## / MatrixSize##
END FUNCTION    ' | FMatrixMean##

REM ******************************************************************
REM * Returns the variance of all the values contained in A##().      *
REM ******************************************************************

FUNCTION FMatrixVariance##(A##())
    SumSquared## = 0.0
    MyMean## = FMatrixMean##(A##())
    ARowStart& = LBOUND(A##)
    AColStart& = LBOUND(A##, 2)
    ARowEnd& = UBOUND(A##)
    AColEnd& = UBOUND(A##, 2)
    FOR Column& = AColStart& TO AColEnd&
        FOR Row& = ARowStart& TO ARowEnd&
            Temp## = A##(Row&,Column&) - MyMean##
            Temp## = Temp## * Temp##
            SumSquared## = SumSquared## + Temp##
        NEXT Row&
    NEXT Column&
    MatrixSize## = (1.0 + ARowEnd& - ARowStart&) * (1.0 + AColEnd& - AColStart&)
    FMatrixVariance## = SumSquared## / (MatrixSize## - 1.0)
END FUNCTION    ' | FMatrixVariance##

And that's it.

TR

[madscijr]

...
This library is all to do with matrices. There are six sections to it. Each section deals with matrix operations for arrays that contain a particular TYPE of data
... thanks

Thanks for sharing. I have two suggestions
1. Maybe put in the description a short list of what these operations are? Maybe even a couple of simple examples that show what this library can be used for. That will make it easier for someone who is curious to quickly decide if this is something they can use, rather than having to go through the work of copying and reading through all those posts of code, to know what it is for.

2. Can you just attach the code in a single 7z or zip file? That would be easier than putting togther 6 code boxes.

That's all I have for now - thanks!

[TarotRedhand]

BASIC as a programming language was devised in 1964 at Dartmouth College in the USA as a teaching language. This very first version of BASIC had support for matrix operations in the form of the MAT keyword. Subsequent versions dropped that keyword from the language, hence my library. Dropping that keyword and support may have proved short-sighted to an extent as their use in computer graphics has only grown. Your graphics card performs loads of calculations, per second, involving matrices. But you ask, are there any real world problems that they are good for? Examine this from the ancient (in computing terms) book "Illustrating BASIC" (1977) -

Problem -

There are 3 salespersons who sell a range of 4 products. Here are last weeks sales figures -

Code: (Select All)

                        Product       
Salesperson Maglets Scropers Gimples Nuckers
Mr. Hogg       5        2       0      10
Ms. Burnbra    3        5       2       5
M.  Chauvin   20        0       0       0

Each of those products has a sale price per item and earns the salesperson a set commission on each item sold -

Code: (Select All)

              Price List     
Product    Price  Commission
Maglets     1.50     0.20
Scropers    2.80     0.40
Gimples     5.00     1.00
Nuckers     2.00     0.50

The question is who made the most money for the company and how much commission was paid to each salesperson?

This can be solved in two different ways. Either a bespoke routine can be written to do it or you can use my matrix library -

Common to both approaches

Code: (Select All)

OPTION BASE 1

DIM Sales!(3, 4), Prices!(4, 2), Result!(3, 2)
REM skipping the code for reading in the data

Bespoke

Code: (Select All)

FOR Index1% = 1 to 2 'Columns of Prices!()
    FOR Index2% = 1 to 3 'Rows of Sales!()
        FOR Index3% = 1 to 4 'Columns of Sales!() and Rows of Prices!()
            Result!(Index2%, Index1%) = Result!(Index2%, Index1%) + Sales!(Index2%, Index3%) * Prices!(Index3%, Index1%)
        NEXT Index3%
    NEXT Index2%
NEXT Index1%

Or using my matrices library we just need (using the SINGLE precision library - accurate enough for our needs) -

SMatrixMultiply(Sales!(), Prices!(), Result!())

to achieve the same result. To prove this copy and paste the SINGLE precision version into a new BM file calling it "Mat_Single.BM". Then copy this code into a new BAS file

SALES.BAS

Code: (Select All)

'$INCLUDE: 'MATRIX.BI'

Dim Sales!(3, 4), Prices!(4, 2), Result!(3, 2)

For Index1% = 1 To 3
    For Index2% = 1 To 4
        Read Sales!(Index1%, Index2%)
    Next Index2%
Next Index1%
For Index1% = 1 To 4
    For Index2% = 1 To 2
        Read Prices!(Index1%, Index2%)
    Next Index2%
Next Index1%

SMatrixMultiply Sales!(), Prices!(), Result!()

Print "Results"
Print
Print "Seller        Sold  Earned"
Print "Mr. Hogg  "; "  "; Result!(1, 1); "  "; Result!(1, 2)
Print "Ms. Burnbra"; "  "; Result!(2, 1); "  "; Result!(2, 2)
Print "M.  Chauvin"; "  "; Str$(Result!(3, 1)); ".0"; "    "; Str$(Result!(3, 2)); ".0";
End

Data 5,2,0,10
Data 3,5,2,5
Data 20,0,0,0
Data 1.50,0.20
Data 2.80,0.40
Data 5.00,1.00
Data 2.00,0.50

'$INCLUDE: 'Mat_Single.BM'

and run it. 

TR