Posts: 98
Threads: 24
Joined: Apr 2022
Reputation:
6
05-04-2022, 07:57 AM
(This post was last modified: 05-17-2022, 06:36 PM by 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
Posts: 98
Threads: 24
Joined: Apr 2022
Reputation:
6
05-04-2022, 08:02 AM
(This post was last modified: 05-17-2022, 06:26 PM by 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
Posts: 98
Threads: 24
Joined: Apr 2022
Reputation:
6
05-04-2022, 08:06 AM
(This post was last modified: 05-17-2022, 06:26 PM by 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
Posts: 98
Threads: 24
Joined: Apr 2022
Reputation:
6
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 -
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
Posts: 98
Threads: 24
Joined: Apr 2022
Reputation:
6
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 -
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
Posts: 98
Threads: 24
Joined: Apr 2022
Reputation:
6
05-04-2022, 08:19 AM
(This post was last modified: 05-17-2022, 06:28 PM by 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
Posts: 98
Threads: 24
Joined: Apr 2022
Reputation:
6
05-04-2022, 08:23 AM
(This post was last modified: 05-17-2022, 06:29 PM by 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
Posts: 733
Threads: 103
Joined: Apr 2022
Reputation:
14
(05-04-2022, 07:57 AM)TarotRedhand Wrote: ...
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!
Posts: 98
Threads: 24
Joined: Apr 2022
Reputation:
6
05-17-2022, 11:42 AM
(This post was last modified: 05-17-2022, 06:37 PM by 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
|
