05-04-2022, 08:19 AM
(This post was last modified: 05-17-2022, 06:28 PM by TarotRedhand.)
Contents are -
Library in this code box -
And finally _FLOAT in next post
TR
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