05-04-2022, 08:15 AM
(This post was last modified: 05-17-2022, 06:28 PM by TarotRedhand.)
This section contains the following public routines -
Actual library -
Next part DOUBLE precision floating point -
TR
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