05-04-2022, 08:11 AM
(This post was last modified: 05-17-2022, 06:27 PM by TarotRedhand.)
This section contains the following public routines -
Actual SUBs/FUNCTIONs -
SINGLE precision floating point next post -
TR
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