Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Huge Matrices Library [Updated]
#5
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
Reply


Messages In This Thread
Huge Matrices Library [Updated] - by TarotRedhand - 05-04-2022, 07:57 AM
RE: Huge Matrices Library - by TarotRedhand - 05-04-2022, 08:02 AM
RE: Huge Matrices Library - by TarotRedhand - 05-04-2022, 08:06 AM
RE: Huge Matrices Library - by TarotRedhand - 05-04-2022, 08:11 AM
RE: Huge Matrices Library - by TarotRedhand - 05-04-2022, 08:15 AM
RE: Huge Matrices Library - by TarotRedhand - 05-04-2022, 08:19 AM
RE: Huge Matrices Library - by TarotRedhand - 05-04-2022, 08:23 AM
RE: Huge Matrices Library - by madscijr - 05-10-2022, 02:37 PM
RE: Huge Matrices Library - by TarotRedhand - 05-17-2022, 11:42 AM



Users browsing this thread: 1 Guest(s)