Data update

This commit is contained in:
Ingy döt Net 2026-04-30 12:34:36 -04:00
parent 4bb20c9b71
commit cbaf4c4b64
12390 changed files with 318560 additions and 27248 deletions

View file

@ -0,0 +1,367 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. StrassenAlgorithm.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 MAT-A. 05 A-DIM PIC 9(4) COMP VALUE 2. 05 A-D OCCURS 16 USAGE COMP-2.
01 MAT-B. 05 B-DIM PIC 9(4) COMP VALUE 2. 05 B-D OCCURS 16 USAGE COMP-2.
01 MAT-C. 05 C-DIM PIC 9(4) COMP VALUE 4. 05 C-D OCCURS 16 USAGE COMP-2.
01 MAT-D. 05 D-DIM PIC 9(4) COMP VALUE 4. 05 D-D OCCURS 16 USAGE COMP-2.
01 MAT-E. 05 E-DIM PIC 9(4) COMP VALUE 4. 05 E-D OCCURS 16 USAGE COMP-2.
01 MAT-F. 05 F-DIM PIC 9(4) COMP VALUE 4. 05 F-D OCCURS 16 USAGE COMP-2.
01 MAT-RES. 05 R-DIM PIC 9(4) COMP. 05 R-D OCCURS 16 USAGE COMP-2.
01 FMT-NORMAL PIC 9 VALUE 1.
01 FMT-PREC6 PIC 9 VALUE 6.
PROCEDURE DIVISION.
MOVE 1.0 TO A-D(1). MOVE 2.0 TO A-D(2).
MOVE 3.0 TO A-D(3). MOVE 4.0 TO A-D(4).
MOVE 5.0 TO B-D(1). MOVE 6.0 TO B-D(2).
MOVE 7.0 TO B-D(3). MOVE 8.0 TO B-D(4).
MOVE 1.0 TO C-D(1). MOVE 1.0 TO C-D(2). MOVE 1.0 TO C-D(3). MOVE 1.0 TO C-D(4).
MOVE 2.0 TO C-D(5). MOVE 4.0 TO C-D(6). MOVE 8.0 TO C-D(7). MOVE 16.0 TO C-D(8).
MOVE 3.0 TO C-D(9). MOVE 9.0 TO C-D(10). MOVE 27.0 TO C-D(11). MOVE 81.0 TO C-D(12).
MOVE 4.0 TO C-D(13). MOVE 16.0 TO C-D(14). MOVE 64.0 TO C-D(15). MOVE 256.0 TO C-D(16).
COMPUTE D-D(1) = 4.0. COMPUTE D-D(2) = -3.0. COMPUTE D-D(3) = 4.0 / 3.0. COMPUTE D-D(4) = -1.0 / 4.0.
COMPUTE D-D(5) = -13.0 / 3.0. COMPUTE D-D(6) = 19.0 / 4.0. COMPUTE D-D(7) = -7.0 / 3.0. COMPUTE D-D(8) = 11.0 / 24.0.
COMPUTE D-D(9) = 3.0 / 2.0. COMPUTE D-D(10) = -2.0. COMPUTE D-D(11) = 7.0 / 6.0. COMPUTE D-D(12) = -1.0 / 4.0.
COMPUTE D-D(13) = -1.0 / 6.0. COMPUTE D-D(14) = 1.0 / 4.0. COMPUTE D-D(15) = -1.0 / 6.0. COMPUTE D-D(16) = 1.0 / 24.0.
MOVE 1.0 TO E-D(1). MOVE 2.0 TO E-D(2). MOVE 3.0 TO E-D(3). MOVE 4.0 TO E-D(4).
MOVE 5.0 TO E-D(5). MOVE 6.0 TO E-D(6). MOVE 7.0 TO E-D(7). MOVE 8.0 TO E-D(8).
MOVE 9.0 TO E-D(9). MOVE 10.0 TO E-D(10). MOVE 11.0 TO E-D(11). MOVE 12.0 TO E-D(12).
MOVE 13.0 TO E-D(13). MOVE 14.0 TO E-D(14). MOVE 15.0 TO E-D(15). MOVE 16.0 TO E-D(16).
MOVE 1.0 TO F-D(1). MOVE 0.0 TO F-D(2). MOVE 0.0 TO F-D(3). MOVE 0.0 TO F-D(4).
MOVE 0.0 TO F-D(5). MOVE 1.0 TO F-D(6). MOVE 0.0 TO F-D(7). MOVE 0.0 TO F-D(8).
MOVE 0.0 TO F-D(9). MOVE 0.0 TO F-D(10). MOVE 1.0 TO F-D(11). MOVE 0.0 TO F-D(12).
MOVE 0.0 TO F-D(13). MOVE 0.0 TO F-D(14). MOVE 0.0 TO F-D(15). MOVE 1.0 TO F-D(16).
DISPLAY "Using 'normal' matrix multiplication:".
DISPLAY " a * b = " WITH NO ADVANCING.
CALL "NORMAL-MULT" USING MAT-A, MAT-B, MAT-RES.
CALL "PRINT-MATRIX" USING MAT-RES, FMT-NORMAL.
DISPLAY " c * d = " WITH NO ADVANCING.
CALL "NORMAL-MULT" USING MAT-C, MAT-D, MAT-RES.
CALL "PRINT-MATRIX" USING MAT-RES, FMT-PREC6.
DISPLAY " e * f = " WITH NO ADVANCING.
CALL "NORMAL-MULT" USING MAT-E, MAT-F, MAT-RES.
CALL "PRINT-MATRIX" USING MAT-RES, FMT-NORMAL.
DISPLAY "Using 'Strassen' matrix multiplication:".
DISPLAY " a * b = " WITH NO ADVANCING.
CALL "STRASSEN-MULT" USING MAT-A, MAT-B, MAT-RES.
CALL "PRINT-MATRIX" USING MAT-RES, FMT-NORMAL.
DISPLAY " c * d = " WITH NO ADVANCING.
CALL "STRASSEN-MULT" USING MAT-C, MAT-D, MAT-RES.
CALL "PRINT-MATRIX" USING MAT-RES, FMT-PREC6.
DISPLAY " e * f = " WITH NO ADVANCING.
CALL "STRASSEN-MULT" USING MAT-E, MAT-F, MAT-RES.
CALL "PRINT-MATRIX" USING MAT-RES, FMT-NORMAL.
STOP RUN.
END PROGRAM StrassenAlgorithm.
IDENTIFICATION DIVISION.
PROGRAM-ID. MATRIX-ADD.
DATA DIVISION.
LOCAL-STORAGE SECTION.
01 I PIC 9(4) COMP.
01 TOTAL-CELLS PIC 9(4) COMP.
LINKAGE SECTION.
01 L-A.
05 A-DIM PIC 9(4) COMP.
05 A-DATA OCCURS 16 TIMES USAGE COMP-2.
01 L-B.
05 B-DIM PIC 9(4) COMP.
05 B-DATA OCCURS 16 TIMES USAGE COMP-2.
01 L-C.
05 C-DIM PIC 9(4) COMP.
05 C-DATA OCCURS 16 TIMES USAGE COMP-2.
PROCEDURE DIVISION USING L-A, L-B, L-C.
MOVE A-DIM TO C-DIM
COMPUTE TOTAL-CELLS = A-DIM * A-DIM
PERFORM VARYING I FROM 1 BY 1 UNTIL I > TOTAL-CELLS
COMPUTE C-DATA(I) = A-DATA(I) + B-DATA(I)
END-PERFORM
GOBACK.
END PROGRAM MATRIX-ADD.
IDENTIFICATION DIVISION.
PROGRAM-ID. MATRIX-SUB.
DATA DIVISION.
LOCAL-STORAGE SECTION.
01 I PIC 9(4) COMP.
01 TOTAL-CELLS PIC 9(4) COMP.
LINKAGE SECTION.
01 L-A.
05 A-DIM PIC 9(4) COMP.
05 A-DATA OCCURS 16 TIMES USAGE COMP-2.
01 L-B.
05 B-DIM PIC 9(4) COMP.
05 B-DATA OCCURS 16 TIMES USAGE COMP-2.
01 L-C.
05 C-DIM PIC 9(4) COMP.
05 C-DATA OCCURS 16 TIMES USAGE COMP-2.
PROCEDURE DIVISION USING L-A, L-B, L-C.
MOVE A-DIM TO C-DIM
COMPUTE TOTAL-CELLS = A-DIM * A-DIM
PERFORM VARYING I FROM 1 BY 1 UNTIL I > TOTAL-CELLS
COMPUTE C-DATA(I) = A-DATA(I) - B-DATA(I)
END-PERFORM
GOBACK.
END PROGRAM MATRIX-SUB.
IDENTIFICATION DIVISION.
PROGRAM-ID. NORMAL-MULT.
DATA DIVISION.
LOCAL-STORAGE SECTION.
01 I PIC 9(4) COMP.
01 J PIC 9(4) COMP.
01 K PIC 9(4) COMP.
01 SUM-VAL USAGE COMP-2.
01 A-IDX PIC 9(4) COMP.
01 B-IDX PIC 9(4) COMP.
01 C-IDX PIC 9(4) COMP.
LINKAGE SECTION.
01 L-A.
05 A-DIM PIC 9(4) COMP.
05 A-DATA OCCURS 16 TIMES USAGE COMP-2.
01 L-B.
05 B-DIM PIC 9(4) COMP.
05 B-DATA OCCURS 16 TIMES USAGE COMP-2.
01 L-C.
05 C-DIM PIC 9(4) COMP.
05 C-DATA OCCURS 16 TIMES USAGE COMP-2.
PROCEDURE DIVISION USING L-A, L-B, L-C.
MOVE A-DIM TO C-DIM
PERFORM VARYING I FROM 1 BY 1 UNTIL I > A-DIM
PERFORM VARYING J FROM 1 BY 1 UNTIL J > A-DIM
COMPUTE C-IDX = (I - 1) * A-DIM + J
MOVE 0 TO SUM-VAL
PERFORM VARYING K FROM 1 BY 1 UNTIL K > A-DIM
COMPUTE A-IDX = (I - 1) * A-DIM + K
COMPUTE B-IDX = (K - 1) * A-DIM + J
COMPUTE SUM-VAL = SUM-VAL +
A-DATA(A-IDX) * B-DATA(B-IDX)
END-PERFORM
MOVE SUM-VAL TO C-DATA(C-IDX)
END-PERFORM
END-PERFORM
GOBACK.
END PROGRAM NORMAL-MULT.
IDENTIFICATION DIVISION.
PROGRAM-ID. PRINT-MATRIX.
DATA DIVISION.
LOCAL-STORAGE SECTION.
01 I PIC 9(4) COMP.
01 J PIC 9(4) COMP.
01 IDX PIC 9(4) COMP.
01 FMT-VAL-1 PIC -(4)9.9.
01 ZERO-VAL-1 PIC -(4)9.9 VALUE 0.0.
01 FMT-VAL-6 PIC -(4)9.9(6).
01 ZERO-VAL-6 PIC -(4)9.9(6) VALUE 0.000000.
01 OUT-STR PIC X(80).
01 PTR PIC 9(4) COMP.
01 STR-VAL PIC X(20).
LINKAGE SECTION.
01 L-M.
05 M-DIM PIC 9(4) COMP.
05 M-DATA OCCURS 16 USAGE COMP-2.
01 L-FMT PIC 9.
PROCEDURE DIVISION USING L-M, L-FMT.
PERFORM VARYING I FROM 1 BY 1 UNTIL I > M-DIM
MOVE SPACES TO OUT-STR
MOVE "[" TO OUT-STR(1:1)
MOVE 2 TO PTR
PERFORM VARYING J FROM 1 BY 1 UNTIL J > M-DIM
COMPUTE IDX = (I - 1) * M-DIM + J
IF L-FMT = 1
IF M-DATA(IDX) > -0.05 AND M-DATA(IDX) < 0.05
MOVE ZERO-VAL-1 TO FMT-VAL-1
ELSE
IF M-DATA(IDX) > 0
COMPUTE FMT-VAL-1 = M-DATA(IDX) + 0.05
ELSE
COMPUTE FMT-VAL-1 = M-DATA(IDX) - 0.05
END-IF
END-IF
MOVE FUNCTION TRIM(FMT-VAL-1) TO STR-VAL
ELSE
IF M-DATA(IDX) > -0.0000005 AND M-DATA(IDX) < 0.0000005
MOVE ZERO-VAL-6 TO FMT-VAL-6
ELSE
IF M-DATA(IDX) > 0
COMPUTE FMT-VAL-6 = M-DATA(IDX) + 0.0000005
ELSE
COMPUTE FMT-VAL-6 = M-DATA(IDX) - 0.0000005
END-IF
END-IF
MOVE FUNCTION TRIM(FMT-VAL-6) TO STR-VAL
END-IF
STRING FUNCTION TRIM(STR-VAL) DELIMITED BY SIZE
INTO OUT-STR WITH POINTER PTR
IF J < M-DIM
STRING ", " DELIMITED BY SIZE
INTO OUT-STR WITH POINTER PTR
END-IF
END-PERFORM
STRING "]" DELIMITED BY SIZE
INTO OUT-STR WITH POINTER PTR
DISPLAY FUNCTION TRIM(OUT-STR)
END-PERFORM
DISPLAY "".
GOBACK.
END PROGRAM PRINT-MATRIX.
IDENTIFICATION DIVISION.
PROGRAM-ID. STRASSEN-MULT RECURSIVE.
DATA DIVISION.
LOCAL-STORAGE SECTION.
01 HALF PIC 9(4) COMP.
01 I PIC 9(4) COMP.
01 J PIC 9(4) COMP.
01 SRC-IDX PIC 9(4) COMP.
01 DST-IDX PIC 9(4) COMP.
01 QA0. 05 DIM0 PIC 9(4) COMP. 05 D0 OCCURS 16 USAGE COMP-2.
01 QA1. 05 DIM1 PIC 9(4) COMP. 05 D1 OCCURS 16 USAGE COMP-2.
01 QA2. 05 DIM2 PIC 9(4) COMP. 05 D2 OCCURS 16 USAGE COMP-2.
01 QA3. 05 DIM3 PIC 9(4) COMP. 05 D3 OCCURS 16 USAGE COMP-2.
01 QB0. 05 BDIM0 PIC 9(4) COMP. 05 BD0 OCCURS 16 USAGE COMP-2.
01 QB1. 05 BDIM1 PIC 9(4) COMP. 05 BD1 OCCURS 16 USAGE COMP-2.
01 QB2. 05 BDIM2 PIC 9(4) COMP. 05 BD2 OCCURS 16 USAGE COMP-2.
01 QB3. 05 BDIM3 PIC 9(4) COMP. 05 BD3 OCCURS 16 USAGE COMP-2.
01 P1. 05 P1-DIM PIC 9(4) COMP. 05 P1-D OCCURS 16 USAGE COMP-2.
01 P2. 05 P2-DIM PIC 9(4) COMP. 05 P2-D OCCURS 16 USAGE COMP-2.
01 P3. 05 P3-DIM PIC 9(4) COMP. 05 P3-D OCCURS 16 USAGE COMP-2.
01 P4. 05 P4-DIM PIC 9(4) COMP. 05 P4-D OCCURS 16 USAGE COMP-2.
01 P5. 05 P5-DIM PIC 9(4) COMP. 05 P5-D OCCURS 16 USAGE COMP-2.
01 P6. 05 P6-DIM PIC 9(4) COMP. 05 P6-D OCCURS 16 USAGE COMP-2.
01 P7. 05 P7-DIM PIC 9(4) COMP. 05 P7-D OCCURS 16 USAGE COMP-2.
01 T1. 05 T1-DIM PIC 9(4) COMP. 05 T1-D OCCURS 16 USAGE COMP-2.
01 T2. 05 T2-DIM PIC 9(4) COMP. 05 T2-D OCCURS 16 USAGE COMP-2.
01 Q0. 05 Q0-DIM PIC 9(4) COMP. 05 Q0-D OCCURS 16 USAGE COMP-2.
01 Q1. 05 Q1-DIM PIC 9(4) COMP. 05 Q1-D OCCURS 16 USAGE COMP-2.
01 Q2. 05 Q2-DIM PIC 9(4) COMP. 05 Q2-D OCCURS 16 USAGE COMP-2.
01 Q3. 05 Q3-DIM PIC 9(4) COMP. 05 Q3-D OCCURS 16 USAGE COMP-2.
LINKAGE SECTION.
01 L-A. 05 L-A-DIM PIC 9(4) COMP. 05 L-A-D OCCURS 16 USAGE COMP-2.
01 L-B. 05 L-B-DIM PIC 9(4) COMP. 05 L-B-D OCCURS 16 USAGE COMP-2.
01 L-C. 05 L-C-DIM PIC 9(4) COMP. 05 L-C-D OCCURS 16 USAGE COMP-2.
PROCEDURE DIVISION USING L-A, L-B, L-C.
IF L-A-DIM = 1
MOVE 1 TO L-C-DIM
COMPUTE L-C-D(1) = L-A-D(1) * L-B-D(1)
GOBACK
END-IF.
COMPUTE HALF = L-A-DIM / 2.
MOVE HALF TO DIM0, DIM1, DIM2, DIM3.
MOVE HALF TO BDIM0, BDIM1, BDIM2, BDIM3.
PERFORM VARYING I FROM 1 BY 1 UNTIL I > HALF
PERFORM VARYING J FROM 1 BY 1 UNTIL J > HALF
COMPUTE DST-IDX = (I - 1) * HALF + J
COMPUTE SRC-IDX = (I - 1) * L-A-DIM + J
MOVE L-A-D(SRC-IDX) TO D0(DST-IDX)
COMPUTE SRC-IDX = (I - 1) * L-A-DIM + (J + HALF)
MOVE L-A-D(SRC-IDX) TO D1(DST-IDX)
COMPUTE SRC-IDX = (I + HALF - 1) * L-A-DIM + J
MOVE L-A-D(SRC-IDX) TO D2(DST-IDX)
COMPUTE SRC-IDX = (I + HALF - 1) * L-A-DIM + (J + HALF)
MOVE L-A-D(SRC-IDX) TO D3(DST-IDX)
COMPUTE SRC-IDX = (I - 1) * L-B-DIM + J
MOVE L-B-D(SRC-IDX) TO BD0(DST-IDX)
COMPUTE SRC-IDX = (I - 1) * L-B-DIM + (J + HALF)
MOVE L-B-D(SRC-IDX) TO BD1(DST-IDX)
COMPUTE SRC-IDX = (I + HALF - 1) * L-B-DIM + J
MOVE L-B-D(SRC-IDX) TO BD2(DST-IDX)
COMPUTE SRC-IDX = (I + HALF - 1) * L-B-DIM + (J + HALF)
MOVE L-B-D(SRC-IDX) TO BD3(DST-IDX)
END-PERFORM
END-PERFORM.
CALL "MATRIX-SUB" USING QA1, QA3, T1
CALL "MATRIX-ADD" USING QB2, QB3, T2
CALL "STRASSEN-MULT" USING T1, T2, P1
CALL "MATRIX-ADD" USING QA0, QA3, T1
CALL "MATRIX-ADD" USING QB0, QB3, T2
CALL "STRASSEN-MULT" USING T1, T2, P2
CALL "MATRIX-SUB" USING QA0, QA2, T1
CALL "MATRIX-ADD" USING QB0, QB1, T2
CALL "STRASSEN-MULT" USING T1, T2, P3
CALL "MATRIX-ADD" USING QA0, QA1, T1
CALL "STRASSEN-MULT" USING T1, QB3, P4
CALL "MATRIX-SUB" USING QB1, QB3, T2
CALL "STRASSEN-MULT" USING QA0, T2, P5
CALL "MATRIX-SUB" USING QB2, QB0, T2
CALL "STRASSEN-MULT" USING QA3, T2, P6
CALL "MATRIX-ADD" USING QA2, QA3, T1
CALL "STRASSEN-MULT" USING T1, QB0, P7
CALL "MATRIX-ADD" USING P1, P2, T1
CALL "MATRIX-SUB" USING T1, P4, T2
CALL "MATRIX-ADD" USING T2, P6, Q0
CALL "MATRIX-ADD" USING P4, P5, Q1
CALL "MATRIX-ADD" USING P6, P7, Q2
CALL "MATRIX-SUB" USING P2, P3, T1
CALL "MATRIX-ADD" USING T1, P5, T2
CALL "MATRIX-SUB" USING T2, P7, Q3
MOVE L-A-DIM TO L-C-DIM
PERFORM VARYING I FROM 1 BY 1 UNTIL I > HALF
PERFORM VARYING J FROM 1 BY 1 UNTIL J > HALF
COMPUTE SRC-IDX = (I - 1) * HALF + J
COMPUTE DST-IDX = (I - 1) * L-A-DIM + J
MOVE Q0-D(SRC-IDX) TO L-C-D(DST-IDX)
COMPUTE DST-IDX = (I - 1) * L-A-DIM + (J + HALF)
MOVE Q1-D(SRC-IDX) TO L-C-D(DST-IDX)
COMPUTE DST-IDX = (I + HALF - 1) * L-A-DIM + J
MOVE Q2-D(SRC-IDX) TO L-C-D(DST-IDX)
COMPUTE DST-IDX = (I + HALF - 1) * L-A-DIM + (J + HALF)
MOVE Q3-D(SRC-IDX) TO L-C-D(DST-IDX)
END-PERFORM
END-PERFORM.
GOBACK.
END PROGRAM STRASSEN-MULT.

View file

@ -0,0 +1,282 @@
// -----------------------------------------------------------------------------
// matrix.dart
// Dart translation of the C++ Matrix/Strassen example
// -----------------------------------------------------------------------------
import 'dart:math' as math;
/// Simple matrix class that supports normal multiplication, Strassen
/// multiplication and pretty printing with a given precision.
class Matrix {
final List<List<double>> data;
final int rows;
final int cols;
// ---------------------------------------------------------------------------
// Construction & basic getters
// ---------------------------------------------------------------------------
Matrix(this.data)
: rows = data.length,
cols = data.isNotEmpty ? data[0].length : 0 {
// Ensure rectangular shape
for (final row in data) {
if (row.length != cols) {
throw ArgumentError('All rows must have the same number of columns.');
}
}
}
// ---------------------------------------------------------------------------
// Validation helpers (private)
// ---------------------------------------------------------------------------
void _validateDimensions(Matrix other) {
if (rows != other.rows || cols != other.cols) {
throw StateError('Matrices must have the same dimensions.');
}
}
void _validateMultiplication(Matrix other) {
if (cols != other.rows) {
throw StateError('Cannot multiply these matrices (inner dimensions differ).');
}
}
void _validateSquarePowerOfTwo() {
if (rows != cols) {
throw StateError('Matrix must be square.');
}
if (rows == 0 || (rows & (rows - 1)) != 0) {
throw StateError('Size of matrix must be a power of two.');
}
}
// ---------------------------------------------------------------------------
// Basic arithmetic operators
// ---------------------------------------------------------------------------
Matrix operator +(Matrix other) {
_validateDimensions(other);
final result = List<List<double>>.generate(
rows,
(i) => List<double>.generate(
cols, (j) => data[i][j] + other.data[i][j],
growable: false),
growable: false);
return Matrix(result);
}
Matrix operator -(Matrix other) {
_validateDimensions(other);
final result = List<List<double>>.generate(
rows,
(i) => List<double>.generate(
cols, (j) => data[i][j] - other.data[i][j],
growable: false),
growable: false);
return Matrix(result);
}
Matrix operator *(Matrix other) {
_validateMultiplication(other);
final result = List<List<double>>.generate(
rows,
(i) => List<double>.filled(other.cols, 0.0, growable: false),
growable: false);
for (var i = 0; i < rows; ++i) {
for (var j = 0; j < other.cols; ++j) {
double sum = 0.0;
for (var k = 0; k < cols; ++k) {
sum += data[i][k] * other.data[k][j];
}
result[i][j] = sum;
}
}
return Matrix(result);
}
// ---------------------------------------------------------------------------
// Pretty printing
// ---------------------------------------------------------------------------
@override
String toString() {
final sb = StringBuffer();
for (final row in data) {
sb.writeln('[${row.join(', ')}]');
}
return sb.toString();
}
/// Returns a string where each element is rounded to **[prec]** decimal
/// places (like the C++ `toStringWithPrecision`). The handling of 0
/// 0 mirrors the original implementation.
String toStringWithPrecision(int prec) {
final pow = math.pow(10.0, prec);
final sb = StringBuffer();
for (final row in data) {
sb.write('[');
for (var i = 0; i < row.length; ++i) {
// Round to the requested precision
var r = (row[i] * pow).round() / pow;
// Remove the negative zero representation
if (r == -0.0) r = 0.0;
final formatted = r.toStringAsFixed(prec);
sb.write(formatted);
if (i < row.length - 1) sb.write(', ');
}
sb.writeln(']');
}
return sb.toString();
}
// ---------------------------------------------------------------------------
// Strassenspecific helpers (private)
// ---------------------------------------------------------------------------
/// Returns the 4parameter table that tells where each quarter starts
/// and how many rows/columns it occupies.
static List<List<int>> _params(int r, int c) => [
// r0, r1, c0, c1, dr, dc (dr/dc are offsets used while copying)
[0, r, 0, c, 0, 0],
[0, r, c, 2 * c, 0, c],
[r, 2 * r, 0, c, r, 0],
[r, 2 * r, c, 2 * c, r, c],
];
/// Splits a square matrix (size = 2·r × 2·c) into its four quarters.
List<Matrix> _toQuarters() {
final r = rows ~/ 2;
final c = cols ~/ 2;
final p = _params(r, c);
final List<Matrix> quarters = List<Matrix>.filled(4, Matrix([]));
for (var k = 0; k < 4; ++k) {
final qData = List<List<double>>.generate(
r, (_) => List<double>.filled(c, 0.0, growable: false),
growable: false);
for (var i = p[k][0]; i < p[k][1]; ++i) {
for (var j = p[k][2]; j < p[k][3]; ++j) {
qData[i - p[k][4]][j - p[k][5]] = data[i][j];
}
}
quarters[k] = Matrix(qData);
}
return quarters;
}
/// Reassembles a full matrix from four quarters.
static Matrix _fromQuarters(List<Matrix> q) {
final r = q[0].rows;
final c = q[0].cols;
final p = _params(r, c);
final rows = r * 2;
final cols = c * 2;
final mData = List<List<double>>.generate(
rows, (_) => List<double>.filled(cols, 0.0, growable: false),
growable: false);
for (var k = 0; k < 4; ++k) {
for (var i = p[k][0]; i < p[k][1]; ++i) {
for (var j = p[k][2]; j < p[k][3]; ++j) {
mData[i][j] = q[k].data[i - p[k][4]][j - p[k][5]];
}
}
}
return Matrix(mData);
}
// ---------------------------------------------------------------------------
// Strassen multiplication (public)
// ---------------------------------------------------------------------------
Matrix strassen(Matrix other) {
_validateSquarePowerOfTwo();
other._validateSquarePowerOfTwo();
if (rows != other.rows || cols != other.cols) {
throw StateError(
'Matrices must be square and of equal size for Strassen multiplication.');
}
// Base case 1×1 matrices are multiplied normally
if (rows == 1) {
return this * other;
}
// Split both matrices into quarters
final a = _toQuarters();
final b = other._toQuarters();
// Compute the seven products (recursively)
final p1 = (a[1] - a[3]).strassen(b[2] + b[3]);
final p2 = (a[0] + a[3]).strassen(b[0] + b[3]);
final p3 = (a[0] - a[2]).strassen(b[0] + b[1]);
final p4 = (a[0] + a[1]).strassen(b[3]);
final p5 = a[0].strassen(b[1] - b[3]);
final p6 = a[3].strassen(b[2] - b[0]);
final p7 = (a[2] + a[3]).strassen(b[0]);
// Combine the products into the four result quadrants
final List<Matrix> q = List<Matrix>.filled(
4,
Matrix(
List<List<double>>.filled(0, [])), // placeholder will be overwritten
growable: false);
q[0] = p1 + p2 - p4 + p6;
q[1] = p4 + p5;
q[2] = p6 + p7;
q[3] = p2 - p3 + p5 - p7;
// Reassemble the final matrix
return Matrix._fromQuarters(q);
}
}
// -----------------------------------------------------------------------------
// Demo (mirrors the original C++ main)
// -----------------------------------------------------------------------------
void main() {
final a = Matrix([
[1.0, 2.0],
[3.0, 4.0]
]);
final b = Matrix([
[5.0, 6.0],
[7.0, 8.0]
]);
final c = Matrix([
[1.0, 1.0, 1.0, 1.0],
[2.0, 4.0, 8.0, 16.0],
[3.0, 9.0, 27.0, 81.0],
[4.0, 16.0, 64.0, 256.0],
]);
final d = Matrix([
[4.0, -3.0, 4.0 / 3.0, -1.0 / 4.0],
[-13.0 / 3.0, 19.0 / 4.0, -7.0 / 3.0, 11.0 / 24.0],
[3.0 / 2.0, -2.0, 7.0 / 6.0, -1.0 / 4.0],
[-1.0 / 6.0, 1.0 / 4.0, -1.0 / 6.0, 1.0 / 24.0],
]);
final e = Matrix([
[1.0, 2.0, 3.0, 4.0],
[5.0, 6.0, 7.0, 8.0],
[9.0, 10.0, 11.0, 12.0],
[13.0, 14.0, 15.0, 16.0],
]);
final f = Matrix([
[1.0, 0.0, 0.0, 0.0],
[0.0, 1.0, 0.0, 0.0],
[0.0, 0.0, 1.0, 0.0],
[0.0, 0.0, 0.0, 1.0],
]);
print("Using 'normal' matrix multiplication:");
print(' a * b = ${a * b}');
print(' c * d = ${ (c * d).toStringWithPrecision(6)}');
print(' e * f = ${e * f}');
print('\nUsing \'Strassen\' matrix multiplication:');
print(' a * b = ${a.strassen(b)}');
print(' c * d = ${c.strassen(d).toStringWithPrecision(6)}');
print(' e * f = ${e.strassen(f)}');
}

View file

@ -0,0 +1,293 @@
defmodule Matrix do
@moduledoc """
A matrix implementation with basic operations and Strassen multiplication.
"""
use Bitwise
defstruct [:data, :rows, :cols]
@doc """
Creates a new matrix from the given data.
"""
def new(data) do
rows = length(data)
cols = case rows do
0 -> 0
_ -> length(hd(data))
end
%Matrix{data: data, rows: rows, cols: cols}
end
@doc """
Gets the number of rows in the matrix.
"""
def get_rows(%Matrix{rows: rows}), do: rows
@doc """
Gets the number of columns in the matrix.
"""
def get_cols(%Matrix{cols: cols}), do: cols
# Validation functions
defp validate_dimensions(m1, m2) do
unless get_rows(m1) == get_rows(m2) and get_cols(m1) == get_cols(m2) do
raise ArgumentError, "Matrices must have the same dimensions."
end
end
defp validate_multiplication(m1, m2) do
unless get_cols(m1) == get_rows(m2) do
raise ArgumentError, "Cannot multiply these matrices."
end
end
defp validate_square_power_of_two(m) do
rows = get_rows(m)
cols = get_cols(m)
unless rows == cols do
raise ArgumentError, "Matrix must be square."
end
unless rows > 0 and (rows &&& (rows - 1)) == 0 do
raise ArgumentError, "Size of matrix must be a power of two."
end
end
@doc """
Adds two matrices element-wise.
"""
def add(m1, m2) do
validate_dimensions(m1, m2)
data1 = m1.data
data2 = m2.data
result_data = add_rows(data1, data2)
new(result_data)
end
defp add_rows([], []), do: []
defp add_rows([row1 | rest1], [row2 | rest2]) do
[add_elements(row1, row2) | add_rows(rest1, rest2)]
end
defp add_elements([], []), do: []
defp add_elements([e1 | rest1], [e2 | rest2]) do
[e1 + e2 | add_elements(rest1, rest2)]
end
@doc """
Subtracts the second matrix from the first element-wise.
"""
def subtract(m1, m2) do
validate_dimensions(m1, m2)
data1 = m1.data
data2 = m2.data
result_data = subtract_rows(data1, data2)
new(result_data)
end
defp subtract_rows([], []), do: []
defp subtract_rows([row1 | rest1], [row2 | rest2]) do
[subtract_elements(row1, row2) | subtract_rows(rest1, rest2)]
end
defp subtract_elements([], []), do: []
defp subtract_elements([e1 | rest1], [e2 | rest2]) do
[e1 - e2 | subtract_elements(rest1, rest2)]
end
@doc """
Multiplies two matrices using standard algorithm.
"""
def multiply(m1, m2) do
validate_multiplication(m1, m2)
data1 = m1.data
data2 = m2.data
cols2 = get_cols(m2)
result_data = multiply_rows(data1, data2, cols2)
new(result_data)
end
defp multiply_rows([], _data2, _cols2), do: []
defp multiply_rows([row | rest], data2, cols2) do
result_row = multiply_row_with_matrix(row, data2, cols2)
[result_row | multiply_rows(rest, data2, cols2)]
end
defp multiply_row_with_matrix(row, data2, cols2) do
for j <- 1..cols2 do
dot_product(row, get_column(data2, j))
end
end
defp get_column(data, col_index) do
for row <- data, do: Enum.at(row, col_index - 1)
end
defp dot_product(list1, list2) do
Enum.zip(list1, list2)
|> Enum.map(fn {e1, e2} -> e1 * e2 end)
|> Enum.sum()
end
@doc """
Converts matrix to string representation.
"""
def to_matrix_string(m) do
data = m.data
rows_str = for row <- data, do: format_row(row)
Enum.join(rows_str, "\n") <> "\n"
end
defp format_row(row) do
elements = for e <- row, do: format_element(e)
"[" <> Enum.join(elements, ", ") <> "]"
end
defp format_element(e) do
"#{e}"
end
@doc """
Converts matrix to string with specified precision.
"""
def to_matrix_string_with_precision(m, precision) do
data = m.data
pow = :math.pow(10.0, precision)
rows_str = for row <- data, do: format_row_with_precision(row, pow, precision)
Enum.join(rows_str, "\n") <> "\n"
end
defp format_row_with_precision(row, pow, precision) do
elements = for e <- row, do: format_element_with_precision(e, pow, precision)
"[" <> Enum.join(elements, ", ") <> "]"
end
defp format_element_with_precision(e, pow, precision) do
rounded = round(e * pow) / pow
formatted = :io_lib.format("~.*f", [precision, rounded]) |> List.to_string()
# Handle negative zero
zero_check = case precision do
0 -> "0"
_ -> "0." <> String.duplicate("0", precision)
end
case formatted do
"-" <> rest when rest == zero_check -> zero_check
_ -> formatted
end
end
# Strassen multiplication helper functions
defp to_quarters(m) do
rows = get_rows(m)
r = div(rows, 2)
data = m.data
# Extract quarters directly
top_half = Enum.take(data, r)
bottom_half = Enum.drop(data, r)
# Q0: top-left, Q1: top-right, Q2: bottom-left, Q3: bottom-right
q0_data = for row <- top_half, do: Enum.take(row, r)
q1_data = for row <- top_half, do: Enum.drop(row, r)
q2_data = for row <- bottom_half, do: Enum.take(row, r)
q3_data = for row <- bottom_half, do: Enum.drop(row, r)
[new(q0_data), new(q1_data), new(q2_data), new(q3_data)]
end
defp from_quarters([q0, q1, q2, q3]) do
q0_data = q0.data
q1_data = q1.data
q2_data = q2.data
q3_data = q3.data
# Combine quarters back into full matrix
top_half = Enum.zip(q0_data, q1_data) |> Enum.map(fn {row0, row1} -> row0 ++ row1 end)
bottom_half = Enum.zip(q2_data, q3_data) |> Enum.map(fn {row2, row3} -> row2 ++ row3 end)
new(top_half ++ bottom_half)
end
@doc """
Multiplies two matrices using Strassen's algorithm.
Matrices must be square and have size that is a power of two.
"""
def strassen(m1, m2) do
validate_square_power_of_two(m1)
validate_square_power_of_two(m2)
unless get_rows(m1) == get_rows(m2) and get_cols(m1) == get_cols(m2) do
raise ArgumentError, "Matrices must be square and of equal size for Strassen multiplication."
end
strassen_impl(m1, m2)
end
defp strassen_impl(m1, m2) do
case get_rows(m1) do
1 -> multiply(m1, m2)
_ ->
[a11, a12, a21, a22] = to_quarters(m1)
[b11, b12, b21, b22] = to_quarters(m2)
# Calculate the 7 products according to Strassen's algorithm
p1 = strassen_impl(a11, subtract(b12, b22))
p2 = strassen_impl(add(a11, a12), b22)
p3 = strassen_impl(add(a21, a22), b11)
p4 = strassen_impl(a22, subtract(b21, b11))
p5 = strassen_impl(add(a11, a22), add(b11, b22))
p6 = strassen_impl(subtract(a12, a22), add(b21, b22))
p7 = strassen_impl(subtract(a11, a21), add(b11, b12))
# Calculate result quarters
c11 = add(subtract(add(p5, p4), p2), p6)
c12 = add(p1, p2)
c21 = add(p3, p4)
c22 = subtract(subtract(add(p5, p1), p3), p7)
from_quarters([c11, c12, c21, c22])
end
end
@doc """
Main function for testing the matrix operations.
"""
def main(_args \\ []) do
a_data = [[1.0, 2.0], [3.0, 4.0]]
a = new(a_data)
b_data = [[5.0, 6.0], [7.0, 8.0]]
b = new(b_data)
c_data = [[1.0, 1.0, 1.0, 1.0], [2.0, 4.0, 8.0, 16.0], [3.0, 9.0, 27.0, 81.0], [4.0, 16.0, 64.0, 256.0]]
c = new(c_data)
d_data = [[4.0, -3.0, 4.0/3.0, -1.0/4.0],
[-13.0/3.0, 19.0/4.0, -7.0/3.0, 11.0/24.0],
[3.0/2.0, -2.0, 7.0/6.0, -1.0/4.0],
[-1.0/6.0, 1.0/4.0, -1.0/6.0, 1.0/24.0]]
d = new(d_data)
e_data = [[1.0, 2.0, 3.0, 4.0], [5.0, 6.0, 7.0, 8.0], [9.0, 10.0, 11.0, 12.0], [13.0, 14.0, 15.0, 16.0]]
e = new(e_data)
f_data = [[1.0, 0.0, 0.0, 0.0], [0.0, 1.0, 0.0, 0.0], [0.0, 0.0, 1.0, 0.0], [0.0, 0.0, 0.0, 1.0]]
f = new(f_data)
IO.puts("Using 'normal' matrix multiplication:")
IO.puts(" a * b = #{to_matrix_string(multiply(a, b))}")
IO.puts(" c * d = #{to_matrix_string_with_precision(multiply(c, d), 6)}")
IO.puts(" e * f = #{to_matrix_string(multiply(e, f))}")
IO.puts("\nUsing 'Strassen' matrix multiplication:")
IO.puts(" a * b = #{to_matrix_string(strassen(a, b))}")
IO.puts(" c * d = #{to_matrix_string_with_precision(strassen(c, d), 6)}")
IO.puts(" e * f = #{to_matrix_string(strassen(e, f))}")
end
end
Matrix.main()

View file

@ -0,0 +1,229 @@
-module(matrix).
-export([new/1, get_rows/1, get_cols/1, add/2, subtract/2, multiply/2,
strassen/2, to_string/1, to_string_with_precision/2, main/1]).
-record(matrix, {data, rows, cols}).
% Constructor
new(Data) ->
Rows = length(Data),
Cols = case Rows of
0 -> 0;
_ -> length(hd(Data))
end,
#matrix{data = Data, rows = Rows, cols = Cols}.
% Getters
get_rows(#matrix{rows = Rows}) -> Rows.
get_cols(#matrix{cols = Cols}) -> Cols.
% Validation functions
validate_dimensions(M1, M2) ->
case get_rows(M1) =:= get_rows(M2) andalso get_cols(M1) =:= get_cols(M2) of
true -> ok;
false -> error("Matrices must have the same dimensions.")
end.
validate_multiplication(M1, M2) ->
case get_cols(M1) =:= get_rows(M2) of
true -> ok;
false -> error("Cannot multiply these matrices.")
end.
validate_square_power_of_two(M) ->
Rows = get_rows(M),
Cols = get_cols(M),
case Rows =:= Cols of
false -> error("Matrix must be square.");
true ->
case Rows =:= 0 orelse (Rows band (Rows - 1)) =/= 0 of
true -> error("Size of matrix must be a power of two.");
false -> ok
end
end.
% Matrix operations
add(M1, M2) ->
validate_dimensions(M1, M2),
Data1 = M1#matrix.data,
Data2 = M2#matrix.data,
ResultData = add_rows(Data1, Data2),
new(ResultData).
add_rows([], []) -> [];
add_rows([Row1|Rest1], [Row2|Rest2]) ->
[add_elements(Row1, Row2) | add_rows(Rest1, Rest2)].
add_elements([], []) -> [];
add_elements([E1|Rest1], [E2|Rest2]) ->
[E1 + E2 | add_elements(Rest1, Rest2)].
subtract(M1, M2) ->
validate_dimensions(M1, M2),
Data1 = M1#matrix.data,
Data2 = M2#matrix.data,
ResultData = subtract_rows(Data1, Data2),
new(ResultData).
subtract_rows([], []) -> [];
subtract_rows([Row1|Rest1], [Row2|Rest2]) ->
[subtract_elements(Row1, Row2) | subtract_rows(Rest1, Rest2)].
subtract_elements([], []) -> [];
subtract_elements([E1|Rest1], [E2|Rest2]) ->
[E1 - E2 | subtract_elements(Rest1, Rest2)].
multiply(M1, M2) ->
validate_multiplication(M1, M2),
Data1 = M1#matrix.data,
Data2 = M2#matrix.data,
Cols2 = get_cols(M2),
ResultData = multiply_rows(Data1, Data2, Cols2),
new(ResultData).
multiply_rows([], _Data2, _Cols2) -> [];
multiply_rows([Row|Rest], Data2, Cols2) ->
ResultRow = multiply_row_with_matrix(Row, Data2, Cols2),
[ResultRow | multiply_rows(Rest, Data2, Cols2)].
multiply_row_with_matrix(Row, Data2, Cols2) ->
[dot_product(Row, get_column(Data2, J)) || J <- lists:seq(1, Cols2)].
get_column(Data, ColIndex) ->
[lists:nth(ColIndex, Row) || Row <- Data].
dot_product(List1, List2) ->
lists:sum([E1 * E2 || {E1, E2} <- lists:zip(List1, List2)]).
% String representation
to_string(M) ->
Data = M#matrix.data,
RowsStr = [format_row(Row) || Row <- Data],
string:join(RowsStr, "\n") ++ "\n".
format_row(Row) ->
Elements = [format_element(E) || E <- Row],
"[" ++ string:join(Elements, ", ") ++ "]".
format_element(E) ->
io_lib:format("~w", [E]).
to_string_with_precision(M, P) ->
Data = M#matrix.data,
Pow = math:pow(10.0, P),
RowsStr = [format_row_with_precision(Row, Pow, P) || Row <- Data],
string:join(RowsStr, "\n") ++ "\n".
format_row_with_precision(Row, Pow, P) ->
Elements = [format_element_with_precision(E, Pow, P) || E <- Row],
"[" ++ string:join(Elements, ", ") ++ "]".
format_element_with_precision(E, Pow, P) ->
Rounded = round(E * Pow) / Pow,
Formatted = io_lib:format("~." ++ integer_to_list(P) ++ "f", [Rounded]),
FormattedStr = lists:flatten(Formatted),
% Handle negative zero
ZeroCheck = case P of
0 -> "0";
_ -> "0." ++ lists:duplicate(P, $0)
end,
case FormattedStr of
"-" ++ Rest when Rest =:= ZeroCheck -> ZeroCheck;
_ -> FormattedStr
end.
% Strassen multiplication helper functions
to_quarters(M) ->
Rows = get_rows(M),
R = Rows div 2,
Data = M#matrix.data,
% Extract quarters directly
TopHalf = lists:sublist(Data, R),
BottomHalf = lists:nthtail(R, Data),
% Q0: top-left, Q1: top-right, Q2: bottom-left, Q3: bottom-right
Q0_Data = [lists:sublist(Row, R) || Row <- TopHalf],
Q1_Data = [lists:nthtail(R, Row) || Row <- TopHalf],
Q2_Data = [lists:sublist(Row, R) || Row <- BottomHalf],
Q3_Data = [lists:nthtail(R, Row) || Row <- BottomHalf],
[new(Q0_Data), new(Q1_Data), new(Q2_Data), new(Q3_Data)].
from_quarters([Q0, Q1, Q2, Q3]) ->
Q0_Data = Q0#matrix.data,
Q1_Data = Q1#matrix.data,
Q2_Data = Q2#matrix.data,
Q3_Data = Q3#matrix.data,
% Combine quarters back into full matrix
TopHalf = [Row0 ++ Row1 || {Row0, Row1} <- lists:zip(Q0_Data, Q1_Data)],
BottomHalf = [Row2 ++ Row3 || {Row2, Row3} <- lists:zip(Q2_Data, Q3_Data)],
new(TopHalf ++ BottomHalf).
strassen(M1, M2) ->
validate_square_power_of_two(M1),
validate_square_power_of_two(M2),
case get_rows(M1) =:= get_rows(M2) andalso get_cols(M1) =:= get_cols(M2) of
false -> error("Matrices must be square and of equal size for Strassen multiplication.");
true -> strassen_impl(M1, M2)
end.
strassen_impl(M1, M2) ->
case get_rows(M1) of
1 -> multiply(M1, M2);
_ ->
[A11, A12, A21, A22] = to_quarters(M1),
[B11, B12, B21, B22] = to_quarters(M2),
% Calculate the 7 products according to Strassen's algorithm
P1 = strassen_impl(A11, subtract(B12, B22)),
P2 = strassen_impl(add(A11, A12), B22),
P3 = strassen_impl(add(A21, A22), B11),
P4 = strassen_impl(A22, subtract(B21, B11)),
P5 = strassen_impl(add(A11, A22), add(B11, B22)),
P6 = strassen_impl(subtract(A12, A22), add(B21, B22)),
P7 = strassen_impl(subtract(A11, A21), add(B11, B12)),
% Calculate result quarters
C11 = add(subtract(add(P5, P4), P2), P6),
C12 = add(P1, P2),
C21 = add(P3, P4),
C22 = subtract(subtract(add(P5, P1), P3), P7),
from_quarters([C11, C12, C21, C22])
end.
% Main function for testing
main(_) ->
AData = [[1.0, 2.0], [3.0, 4.0]],
A = new(AData),
BData = [[5.0, 6.0], [7.0, 8.0]],
B = new(BData),
CData = [[1.0, 1.0, 1.0, 1.0], [2.0, 4.0, 8.0, 16.0], [3.0, 9.0, 27.0, 81.0], [4.0, 16.0, 64.0, 256.0]],
C = new(CData),
DData = [[4.0, -3.0, 4.0/3.0, -1.0/4.0],
[-13.0/3.0, 19.0/4.0, -7.0/3.0, 11.0/24.0],
[3.0/2.0, -2.0, 7.0/6.0, -1.0/4.0],
[-1.0/6.0, 1.0/4.0, -1.0/6.0, 1.0/24.0]],
D = new(DData),
EData = [[1.0, 2.0, 3.0, 4.0], [5.0, 6.0, 7.0, 8.0], [9.0, 10.0, 11.0, 12.0], [13.0, 14.0, 15.0, 16.0]],
E = new(EData),
FData = [[1.0, 0.0, 0.0, 0.0], [0.0, 1.0, 0.0, 0.0], [0.0, 0.0, 1.0, 0.0], [0.0, 0.0, 0.0, 1.0]],
F = new(FData),
io:format("Using 'normal' matrix multiplication:~n"),
io:format(" a * b = ~s~n", [to_string(multiply(A, B))]),
io:format(" c * d = ~s~n", [to_string_with_precision(multiply(C, D), 6)]),
io:format(" e * f = ~s~n", [to_string(multiply(E, F))]),
io:format("~nUsing 'Strassen' matrix multiplication:~n"),
io:format(" a * b = ~s~n", [to_string(strassen(A, B))]),
io:format(" c * d = ~s~n", [to_string_with_precision(strassen(C, D), 6)]),
io:format(" e * f = ~s~n", [to_string(strassen(E, F))]).

View file

@ -0,0 +1,350 @@
module matrix_operations
use, intrinsic :: iso_fortran_env, only: real64, int64
implicit none
type :: Matrix
real(real64), allocatable :: data(:, :)
integer :: rows = 0
integer :: cols = 0
contains
procedure :: getRows
procedure :: getCols
procedure :: validateDimensions
procedure :: validateMultiplication
procedure :: validateSquarePowerOfTwo
procedure :: add_matrices
procedure :: subtract_matrices
procedure :: multiply_matrices
procedure :: strassen
procedure :: toQuarters
procedure :: toStringWithPrecision
generic :: operator(+) => add_matrices
generic :: operator(-) => subtract_matrices
generic :: operator(*) => multiply_matrices
end type Matrix
interface Matrix
procedure :: create_matrix
end interface Matrix
type :: MatrixArray4
type(Matrix) :: matrices(4)
end type MatrixArray4
contains
function create_matrix(input_data) result(mat)
real(real64), intent(in) :: input_data(:, :)
type(Matrix) :: mat
mat%rows = size(input_data, 1)
mat%cols = size(input_data, 2)
allocate(mat%data(mat%rows, mat%cols))
mat%data = input_data
end function create_matrix
function getRows(this) result(rows)
class(Matrix), intent(in) :: this
integer :: rows
rows = this%rows
end function getRows
function getCols(this) result(cols)
class(Matrix), intent(in) :: this
integer :: cols
cols = this%cols
end function getCols
subroutine validateDimensions(this, other)
class(Matrix), intent(in) :: this, other
if (this%getRows() /= other%getRows() .or. this%getCols() /= other%getCols()) then
error stop "Matrices must have the same dimensions."
end if
end subroutine validateDimensions
subroutine validateMultiplication(this, other)
class(Matrix), intent(in) :: this, other
if (this%getCols() /= other%getRows()) then
error stop "Cannot multiply these matrices."
end if
end subroutine validateMultiplication
subroutine validateSquarePowerOfTwo(this)
class(Matrix), intent(in) :: this
integer :: n
if (this%getRows() /= this%getCols()) then
error stop "Matrix must be square."
end if
n = this%getRows()
if (n == 0 .or. iand(n, n-1) /= 0) then
error stop "Size of matrix must be a power of two."
end if
end subroutine validateSquarePowerOfTwo
function add_matrices(this, other) result(result_mat)
class(Matrix), intent(in) :: this, other
type(Matrix) :: result_mat
integer :: i, j
call this%validateDimensions(other)
result_mat%rows = this%rows
result_mat%cols = this%cols
allocate(result_mat%data(result_mat%rows, result_mat%cols))
do j = 1, result_mat%cols
do i = 1, result_mat%rows
result_mat%data(i, j) = this%data(i, j) + other%data(i, j)
end do
end do
end function add_matrices
function subtract_matrices(this, other) result(result_mat)
class(Matrix), intent(in) :: this, other
type(Matrix) :: result_mat
integer :: i, j
call this%validateDimensions(other)
result_mat%rows = this%rows
result_mat%cols = this%cols
allocate(result_mat%data(result_mat%rows, result_mat%cols))
do j = 1, result_mat%cols
do i = 1, result_mat%rows
result_mat%data(i, j) = this%data(i, j) - other%data(i, j)
end do
end do
end function subtract_matrices
function multiply_matrices(this, other) result(result_mat)
class(Matrix), intent(in) :: this, other
type(Matrix) :: result_mat
integer :: i, j, k
real(real64) :: sum_val
call this%validateMultiplication(other)
result_mat%rows = this%rows
result_mat%cols = other%cols
allocate(result_mat%data(result_mat%rows, result_mat%cols))
do i = 1, result_mat%rows
do j = 1, result_mat%cols
sum_val = 0.0_real64
do k = 1, this%cols
sum_val = sum_val + this%data(i, k) * other%data(k, j)
end do
result_mat%data(i, j) = sum_val
end do
end do
end function multiply_matrices
function params(r, c) result(p)
integer, intent(in) :: r, c
integer :: p(4, 6)
p(1, :) = [1, r, 1, c, 1, 1]
p(2, :) = [1, r, c+1, 2*c, 1, c+1]
p(3, :) = [r+1, 2*r, 1, c, r+1, 1]
p(4, :) = [r+1, 2*r, c+1, 2*c, r+1, c+1]
end function params
function toQuarters(this) result(quarters)
class(Matrix), intent(in) :: this
type(MatrixArray4) :: quarters
integer :: r, c, k, i, j
integer :: p(4, 6)
real(real64), allocatable :: q_data(:, :)
r = this%getRows() / 2
c = this%getCols() / 2
p = params(r, c)
do k = 1, 4
allocate(q_data(r, c))
do j = p(k, 3), p(k, 4)
do i = p(k, 1), p(k, 2)
q_data(i - p(k, 5) + 1, j - p(k, 6) + 1) = this%data(i, j)
end do
end do
quarters%matrices(k) = Matrix(q_data)
deallocate(q_data)
end do
end function toQuarters
function fromQuarters(q) result(mat)
type(MatrixArray4), intent(in) :: q
type(Matrix) :: mat
integer :: r, c, k, i, j
integer :: p(4, 6)
real(real64), allocatable :: m_data(:, :)
r = q%matrices(1)%getRows()
c = q%matrices(1)%getCols()
p = params(r, c)
allocate(m_data(2*r, 2*c))
m_data = 0.0_real64
do k = 1, 4
do j = p(k, 3), p(k, 4)
do i = p(k, 1), p(k, 2)
m_data(i, j) = q%matrices(k)%data(i - p(k, 5) + 1, j - p(k, 6) + 1)
end do
end do
end do
mat = Matrix(m_data)
deallocate(m_data)
end function fromQuarters
function strassen(this, other) result(result_mat)
class(Matrix), intent(in) :: this, other
type(Matrix) :: result_mat
type(MatrixArray4) :: qa, qb, q
type(Matrix) :: p1, p2, p3, p4, p5, p6, p7
integer :: r, i
call this%validateSquarePowerOfTwo()
call other%validateSquarePowerOfTwo()
if (this%getRows() /= other%getRows() .or. this%getCols() /= other%getCols()) then
error stop "Matrices must be square and of equal size for Strassen multiplication."
end if
if (this%getRows() == 1) then
result_mat = this * other
return
end if
qa = this%toQuarters()
qb = other%toQuarters()
p1 = (qa%matrices(2) - qa%matrices(4)) * (qb%matrices(3) + qb%matrices(4))
p2 = (qa%matrices(1) + qa%matrices(4)) * (qb%matrices(1) + qb%matrices(4))
p3 = (qa%matrices(1) - qa%matrices(3)) * (qb%matrices(1) + qb%matrices(2))
p4 = (qa%matrices(1) + qa%matrices(2)) * qb%matrices(4)
p5 = qa%matrices(1) * (qb%matrices(2) - qb%matrices(4))
p6 = qa%matrices(4) * (qb%matrices(3) - qb%matrices(1))
p7 = (qa%matrices(3) + qa%matrices(4)) * qb%matrices(1)
q%matrices(1) = p1 + p2 - p4 + p6
q%matrices(2) = p4 + p5
q%matrices(3) = p6 + p7
q%matrices(4) = p2 - p3 + p5 - p7
result_mat = fromQuarters(q)
end function strassen
function toStringWithPrecision(this, p) result(str)
class(Matrix), intent(in) :: this
integer, intent(in) :: p
character(:), allocatable :: str
character(100) :: buffer
integer :: i, j
real(real64) :: rounded_val
str = ''
do i = 1, this%rows
str = str // '['
do j = 1, this%cols
write(buffer, '(F0.' // trim(adjustl(int2str(p))) // ')') this%data(i, j)
str = str // trim(adjustl(buffer))
if (j < this%cols) then
str = str // ', '
end if
end do
str = str // ']' // new_line('a')
end do
end function toStringWithPrecision
function int2str(i) result(str)
integer, intent(in) :: i
character(20) :: str
write(str, *) i
str = adjustl(str)
end function int2str
end module matrix_operations
program main
use matrix_operations
implicit none
type(Matrix) :: a, b, c, d, e, f, result
! Initialize matrices (Fortran is column-major, so we need to transpose)
a = Matrix(reshape([1.0_real64, 2.0_real64, 3.0_real64, 4.0_real64], [2, 2]))
b = Matrix(reshape([5.0_real64, 6.0_real64, 7.0_real64, 8.0_real64], [2, 2]))
c = Matrix(reshape([1.0_real64, 1.0_real64, 1.0_real64, 1.0_real64, &
1.0_real64, 4.0_real64, 9.0_real64, 16.0_real64, &
1.0_real64, 8.0_real64, 27.0_real64, 64.0_real64, &
1.0_real64, 16.0_real64, 81.0_real64, 256.0_real64], [4, 4]))
d = Matrix(reshape([4.0_real64, -3.0_real64, 4.0_real64/3.0_real64, -1.0_real64/4.0_real64, &
-13.0_real64/3.0_real64, 19.0_real64/4.0_real64, -7.0_real64/3.0_real64, 11.0_real64/24.0_real64, &
3.0_real64/2.0_real64, -2.0_real64, 7.0_real64/6.0_real64, -1.0_real64/4.0_real64, &
-1.0_real64/6.0_real64, 1.0_real64/4.0_real64, -1.0_real64/6.0_real64, 1.0_real64/24.0_real64], [4, 4]))
e = Matrix(reshape([1.0_real64, 2.0_real64, 3.0_real64, 4.0_real64, &
5.0_real64, 6.0_real64, 7.0_real64, 8.0_real64, &
9.0_real64, 10.0_real64, 11.0_real64, 12.0_real64, &
13.0_real64, 14.0_real64, 15.0_real64, 16.0_real64], [4, 4]))
f = Matrix(reshape([1.0_real64, 0.0_real64, 0.0_real64, 0.0_real64, &
0.0_real64, 1.0_real64, 0.0_real64, 0.0_real64, &
0.0_real64, 0.0_real64, 1.0_real64, 0.0_real64, &
0.0_real64, 0.0_real64, 0.0_real64, 1.0_real64], [4, 4]))
print *, "Using 'normal' matrix multiplication:"
result = a * b
print *, " a * b = "
call print_matrix(result)
print *
result = c * d
print *, " c * d = "
print *, trim(result%toStringWithPrecision(6))
print *
result = e * f
print *, " e * f = "
call print_matrix(result)
print *
print *, "Using 'Strassen' matrix multiplication:"
result = a%strassen(b)
print *, " a * b = "
call print_matrix(result)
print *
result = c%strassen(d)
print *, " c * d = "
print *, trim(result%toStringWithPrecision(6))
print *
result = e%strassen(f)
print *, " e * f = "
call print_matrix(result)
contains
subroutine print_matrix(mat)
type(Matrix), intent(in) :: mat
integer :: i, j
do i = 1, mat%rows
write(*, '(A)', advance='no') '['
do j = 1, mat%cols
write(*, '(G0.6)', advance='no') mat%data(i, j)
if (j < mat%cols) then
write(*, '(A)', advance='no') ', '
end if
end do
write(*, '(A)') ']'
end do
end subroutine print_matrix
end program main

View file

@ -0,0 +1,210 @@
module Main where
import Data.List (intercalate, transpose)
import Text.Printf (printf, PrintfArg)
-- Matrix data type
data Matrix a = Matrix { matrixData :: [[a]]
, rows :: Int
, cols :: Int
} deriving (Eq)
-- Constructor
new :: [[a]] -> Matrix a
new [] = Matrix [] 0 0
new dat = Matrix dat (length dat) (length $ head dat)
-- Getters
getRows :: Matrix a -> Int
getRows = rows
getCols :: Matrix a -> Int
getCols = cols
-- Validation functions
validateDimensions :: Matrix a -> Matrix a -> Either String ()
validateDimensions m1 m2
| getRows m1 == getRows m2 && getCols m1 == getCols m2 = Right ()
| otherwise = Left "Matrices must have the same dimensions."
validateMultiplication :: Matrix a -> Matrix a -> Either String ()
validateMultiplication m1 m2
| getCols m1 == getRows m2 = Right ()
| otherwise = Left "Cannot multiply these matrices."
validateSquarePowerOfTwo :: Matrix a -> Either String ()
validateSquarePowerOfTwo m
| r /= c = Left "Matrix must be square."
| r == 0 || not (isPowerOfTwo r) = Left "Size of matrix must be a power of two."
| otherwise = Right ()
where
r = getRows m
c = getCols m
isPowerOfTwo n = n > 0 && n == 2^(floor (logBase 2 (fromIntegral n)))
-- Matrix operations
matrixAdd :: Num a => Matrix a -> Matrix a -> Either String (Matrix a)
matrixAdd m1 m2 = do
validateDimensions m1 m2
let result = zipWith (zipWith (+)) (matrixData m1) (matrixData m2)
return $ new result
matrixSubtract :: Num a => Matrix a -> Matrix a -> Either String (Matrix a)
matrixSubtract m1 m2 = do
validateDimensions m1 m2
let result = zipWith (zipWith (-)) (matrixData m1) (matrixData m2)
return $ new result
matrixMultiply :: Num a => Matrix a -> Matrix a -> Either String (Matrix a)
matrixMultiply m1 m2 = do
validateMultiplication m1 m2
let data1 = matrixData m1
data2 = matrixData m2
cols2 = transpose data2
result = [[sum $ zipWith (*) row col | col <- cols2] | row <- data1]
return $ new result
-- String representation
matrixToString :: Show a => Matrix a -> String
matrixToString m = unlines $ map formatRow (matrixData m)
where
formatRow row = "[" ++ intercalate ", " (map show row) ++ "]"
matrixToStringWithPrecision :: (RealFloat a, PrintfArg a) => Matrix a -> Int -> String
matrixToStringWithPrecision m p = unlines $ map (formatRowWithPrecision p) (matrixData m)
where
formatRowWithPrecision precision row =
"[" ++ intercalate ", " (map (formatElementWithPrecision precision) row) ++ "]"
formatElementWithPrecision precision e =
let pow = 10.0 ^ precision
rounded = fromIntegral (round (e * pow)) / pow
formatted = printf ("%." ++ show precision ++ "f") rounded
zeroCheck = if precision == 0 then "0" else "0." ++ replicate precision '0'
in if formatted == ("-" ++ zeroCheck) then zeroCheck else formatted
-- Strassen multiplication helper functions
toQuarters :: Matrix a -> [Matrix a]
toQuarters m = [new q0Data, new q1Data, new q2Data, new q3Data]
where
r = getRows m `div` 2
dat = matrixData m
(topHalf, bottomHalf) = splitAt r dat
q0Data = map (take r) topHalf
q1Data = map (drop r) topHalf
q2Data = map (take r) bottomHalf
q3Data = map (drop r) bottomHalf
fromQuarters :: [Matrix a] -> Matrix a
fromQuarters [q0, q1, q2, q3] = new (topHalf ++ bottomHalf)
where
q0Data = matrixData q0
q1Data = matrixData q1
q2Data = matrixData q2
q3Data = matrixData q3
topHalf = zipWith (++) q0Data q1Data
bottomHalf = zipWith (++) q2Data q3Data
fromQuarters _ = error "fromQuarters expects exactly 4 matrices"
-- Safe matrix operations for Strassen (using Either for error handling)
safeAdd :: Num a => Matrix a -> Matrix a -> Matrix a
safeAdd m1 m2 = case matrixAdd m1 m2 of
Right result -> result
Left err -> error err
safeSubtract :: Num a => Matrix a -> Matrix a -> Matrix a
safeSubtract m1 m2 = case matrixSubtract m1 m2 of
Right result -> result
Left err -> error err
safeMultiply :: Num a => Matrix a -> Matrix a -> Matrix a
safeMultiply m1 m2 = case matrixMultiply m1 m2 of
Right result -> result
Left err -> error err
-- Strassen multiplication
strassen :: Num a => Matrix a -> Matrix a -> Either String (Matrix a)
strassen m1 m2 = do
validateSquarePowerOfTwo m1
validateSquarePowerOfTwo m2
if getRows m1 /= getRows m2 || getCols m1 /= getCols m2
then Left "Matrices must be square and of equal size for Strassen multiplication."
else Right $ strassenImpl m1 m2
strassenImpl :: Num a => Matrix a -> Matrix a -> Matrix a
strassenImpl m1 m2
| getRows m1 == 1 = safeMultiply m1 m2
| otherwise = fromQuarters [c11, c12, c21, c22]
where
[a11, a12, a21, a22] = toQuarters m1
[b11, b12, b21, b22] = toQuarters m2
-- Calculate the 7 products according to Strassen's algorithm
p1 = strassenImpl a11 (safeSubtract b12 b22)
p2 = strassenImpl (safeAdd a11 a12) b22
p3 = strassenImpl (safeAdd a21 a22) b11
p4 = strassenImpl a22 (safeSubtract b21 b11)
p5 = strassenImpl (safeAdd a11 a22) (safeAdd b11 b22)
p6 = strassenImpl (safeSubtract a12 a22) (safeAdd b21 b22)
p7 = strassenImpl (safeSubtract a11 a21) (safeAdd b11 b12)
-- Calculate result quarters
c11 = safeAdd (safeSubtract (safeAdd p5 p4) p2) p6
c12 = safeAdd p1 p2
c21 = safeAdd p3 p4
c22 = safeSubtract (safeSubtract (safeAdd p5 p1) p3) p7
-- Main function for testing
main :: IO ()
main = do
let aData = [[1.0, 2.0], [3.0, 4.0]] :: [[Double]]
a = new aData
bData = [[5.0, 6.0], [7.0, 8.0]] :: [[Double]]
b = new bData
cData = [[1.0, 1.0, 1.0, 1.0], [2.0, 4.0, 8.0, 16.0],
[3.0, 9.0, 27.0, 81.0], [4.0, 16.0, 64.0, 256.0]] :: [[Double]]
c = new cData
dData = [[4.0, -3.0, 4.0/3.0, -1.0/4.0],
[-13.0/3.0, 19.0/4.0, -7.0/3.0, 11.0/24.0],
[3.0/2.0, -2.0, 7.0/6.0, -1.0/4.0],
[-1.0/6.0, 1.0/4.0, -1.0/6.0, 1.0/24.0]] :: [[Double]]
d = new dData
eData = [[1.0, 2.0, 3.0, 4.0], [5.0, 6.0, 7.0, 8.0],
[9.0, 10.0, 11.0, 12.0], [13.0, 14.0, 15.0, 16.0]] :: [[Double]]
e = new eData
fData = [[1.0, 0.0, 0.0, 0.0], [0.0, 1.0, 0.0, 0.0],
[0.0, 0.0, 1.0, 0.0], [0.0, 0.0, 0.0, 1.0]] :: [[Double]]
f = new fData
putStrLn "Using 'normal' matrix multiplication:"
case matrixMultiply a b of
Right result -> putStrLn $ " a * b = \n" ++ matrixToString result
Left err -> putStrLn $ "Error: " ++ err
case matrixMultiply c d of
Right result -> putStrLn $ " c * d = \n" ++ matrixToStringWithPrecision result 6
Left err -> putStrLn $ "Error: " ++ err
case matrixMultiply e f of
Right result -> putStrLn $ " e * f = \n" ++ matrixToString result
Left err -> putStrLn $ "Error: " ++ err
putStrLn "\nUsing 'Strassen' matrix multiplication:"
case strassen a b of
Right result -> putStrLn $ " a * b = \n" ++ matrixToString result
Left err -> putStrLn $ "Error: " ++ err
case strassen c d of
Right result -> putStrLn $ " c * d = \n" ++ matrixToStringWithPrecision result 6
Left err -> putStrLn $ "Error: " ++ err
case strassen e f of
Right result -> putStrLn $ " e * f = \n" ++ matrixToString result
Left err -> putStrLn $ "Error: " ++ err

View file

@ -0,0 +1,281 @@
class Matrix(val data: List<List<Double>>) {
val rows: Int = data.size
val cols: Int = if (rows > 0) data[0].size else 0
// Remove the explicit getter methods since Kotlin generates them automatically
// fun getRows(): Int = rows // Remove this
// fun getCols(): Int = cols // Remove this
fun validateDimensions(other: Matrix) {
if (rows != other.rows || cols != other.cols) {
throw RuntimeException("Matrices must have the same dimensions.")
}
}
fun validateMultiplication(other: Matrix) {
if (cols != other.rows) {
throw RuntimeException("Cannot multiply these matrices.")
}
}
fun validateSquarePowerOfTwo() {
if (rows != cols) {
throw RuntimeException("Matrix must be square.")
}
if (rows == 0 || (rows and (rows - 1)) != 0) {
throw RuntimeException("Size of matrix must be a power of two.")
}
}
fun add(other: Matrix): Matrix {
validateDimensions(other)
val resultData = mutableListOf<MutableList<Double>>()
for (i in 0 until rows) {
val row = mutableListOf<Double>()
for (j in 0 until cols) {
row.add(data[i][j] + other.data[i][j])
}
resultData.add(row)
}
return Matrix(resultData)
}
fun subtract(other: Matrix): Matrix {
validateDimensions(other)
val resultData = mutableListOf<MutableList<Double>>()
for (i in 0 until rows) {
val row = mutableListOf<Double>()
for (j in 0 until cols) {
row.add(data[i][j] - other.data[i][j])
}
resultData.add(row)
}
return Matrix(resultData)
}
fun multiply(other: Matrix): Matrix {
validateMultiplication(other)
val resultData = mutableListOf<MutableList<Double>>()
for (i in 0 until rows) {
val row = mutableListOf<Double>()
for (j in 0 until other.cols) {
var sum = 0.0
for (k in 0 until cols) { // Changed from other.rows to cols
sum += data[i][k] * other.data[k][j]
}
row.add(sum)
}
resultData.add(row)
}
return Matrix(resultData)
}
override fun toString(): String {
val sb = StringBuilder()
for (row in data) {
sb.append("[")
for (i in row.indices) {
sb.append(row[i])
if (i < row.size - 1) {
sb.append(", ")
}
}
sb.append("]\n")
}
return sb.toString()
}
fun toStringWithPrecision(p: Int): String {
val sb = StringBuilder()
val pow = Math.pow(10.0, p.toDouble())
for (row in data) {
sb.append("[")
for (i in row.indices) {
val r = Math.round(row[i] * pow) / pow
var formatted = String.format("%.${p}f", r)
if (formatted == "-0${if (p > 0) "." + "0".repeat(p) else ""}") {
formatted = "0${if (p > 0) "." + "0".repeat(p) else ""}"
}
sb.append(formatted)
if (i < row.size - 1) {
sb.append(", ")
}
}
sb.append("]\n")
}
return sb.toString()
}
companion object {
private fun getParams(r: Int, c: Int): Array<IntArray> {
return arrayOf(
intArrayOf(0, r, 0, c, 0, 0),
intArrayOf(0, r, c, 2 * c, 0, c),
intArrayOf(r, 2 * r, 0, c, r, 0),
intArrayOf(r, 2 * r, c, 2 * c, r, c)
)
}
fun fromQuarters(q: Array<Matrix>): Matrix {
val r = q[0].rows
val c = q[0].cols
val p = getParams(r, c)
val rows = r * 2
val cols = c * 2
val mData = mutableListOf<MutableList<Double>>()
for (i in 0 until rows) {
val row = mutableListOf<Double>()
for (j in 0 until cols) {
row.add(0.0)
}
mData.add(row)
}
for (k in 0 until 4) {
for (i in p[k][0] until p[k][1]) {
for (j in p[k][2] until p[k][3]) {
mData[i][j] = q[k].data[i - p[k][4]][j - p[k][5]]
}
}
}
return Matrix(mData)
}
}
fun toQuarters(): Array<Matrix> {
val r = rows / 2
val c = cols / 2
val p = Companion.getParams(r, c)
val quarters = arrayOfNulls<Matrix>(4)
for (k in 0 until 4) {
val qData = mutableListOf<MutableList<Double>>()
for (i in 0 until r) {
val row = mutableListOf<Double>()
for (j in 0 until c) {
row.add(0.0)
}
qData.add(row)
}
for (i in p[k][0] until p[k][1]) {
for (j in p[k][2] until p[k][3]) {
qData[i - p[k][4]][j - p[k][5]] = data[i][j]
}
}
quarters[k] = Matrix(qData)
}
@Suppress("UNCHECKED_CAST")
return quarters as Array<Matrix>
}
fun strassen(other: Matrix): Matrix {
validateSquarePowerOfTwo()
other.validateSquarePowerOfTwo()
if (rows != other.rows || cols != other.cols) {
throw RuntimeException("Matrices must be square and of equal size for Strassen multiplication.")
}
if (rows == 1) {
return this.multiply(other)
}
val qa = toQuarters()
val qb = other.toQuarters()
val p1 = qa[1].subtract(qa[3]).strassen(qb[2].add(qb[3]))
val p2 = qa[0].add(qa[3]).strassen(qb[0].add(qb[3]))
val p3 = qa[0].subtract(qa[2]).strassen(qb[0].add(qb[1]))
val p4 = qa[0].add(qa[1]).strassen(qb[3])
val p5 = qa[0].strassen(qb[1].subtract(qb[3]))
val p6 = qa[3].strassen(qb[2].subtract(qb[0]))
val p7 = qa[2].add(qa[3]).strassen(qb[0])
val q = arrayOfNulls<Matrix>(4)
q[0] = p1.add(p2).subtract(p4).add(p6)
q[1] = p4.add(p5)
q[2] = p6.add(p7)
q[3] = p2.subtract(p3).add(p5).subtract(p7)
@Suppress("UNCHECKED_CAST")
return Companion.fromQuarters(q as Array<Matrix>)
}
}
fun main() {
val aData = listOf(
listOf(1.0, 2.0),
listOf(3.0, 4.0)
)
val a = Matrix(aData)
val bData = listOf(
listOf(5.0, 6.0),
listOf(7.0, 8.0)
)
val b = Matrix(bData)
val cData = listOf(
listOf(1.0, 1.0, 1.0, 1.0),
listOf(2.0, 4.0, 8.0, 16.0),
listOf(3.0, 9.0, 27.0, 81.0),
listOf(4.0, 16.0, 64.0, 256.0)
)
val c = Matrix(cData)
val dData = listOf(
listOf(4.0, -3.0, 4.0 / 3.0, -1.0 / 4.0),
listOf(-13.0 / 3.0, 19.0 / 4.0, -7.0 / 3.0, 11.0 / 24.0),
listOf(3.0 / 2.0, -2.0, 7.0 / 6.0, -1.0 / 4.0),
listOf(-1.0 / 6.0, 1.0 / 4.0, -1.0 / 6.0, 1.0 / 24.0)
)
val d = Matrix(dData)
val eData = listOf(
listOf(1.0, 2.0, 3.0, 4.0),
listOf(5.0, 6.0, 7.0, 8.0),
listOf(9.0, 10.0, 11.0, 12.0),
listOf(13.0, 14.0, 15.0, 16.0)
)
val e = Matrix(eData)
val fData = listOf(
listOf(1.0, 0.0, 0.0, 0.0),
listOf(0.0, 1.0, 0.0, 0.0),
listOf(0.0, 0.0, 1.0, 0.0),
listOf(0.0, 0.0, 0.0, 1.0)
)
val f = Matrix(fData)
println("Using 'normal' matrix multiplication:")
println(" a * b = ${a.multiply(b)}")
println("\nUsing 'Strassen' matrix multiplication:")
println(" a * b = ${a.strassen(b)}")
println("Using 'normal' matrix multiplication:")
println(" c * d = ${c.multiply(d).toStringWithPrecision(6)}")
println("\nUsing 'Strassen' matrix multiplication:")
println(" c * d = ${c.strassen(d).toStringWithPrecision(6)}")
println("Using 'normal' matrix multiplication:")
println(" e * f = ${e.multiply(f)}")
println("\nUsing 'Strassen' matrix multiplication:")
println(" e * f = ${e.strassen(f)}")
}

View file

@ -0,0 +1,241 @@
-- Helper function to create a matrix from nested blocks
local function block_matrix(blocks)
local m = {}
local num_hblocks = #blocks
local num_vblocks = #blocks[1]
-- Determine dimensions
local block_height = #blocks[1][1]
local block_widths = {}
for j = 1, num_vblocks do
block_widths[j] = #blocks[1][j][1]
end
-- Build the resulting matrix
for i = 1, block_height * num_hblocks do
m[i] = {}
end
for h = 1, num_hblocks do
local row_offset = (h - 1) * block_height
for i = 1, block_height do
local col_offset = 0
for v = 1, num_vblocks do
local block = blocks[h][v]
for j = 1, block_widths[v] do
m[row_offset + i][col_offset + j] = block[i][j]
end
col_offset = col_offset + block_widths[v]
end
end
end
return m
end
-- Matrix multiplication (naive)
local function matrix_multiply(a, b)
local rows_a, cols_a = #a, #a[1]
local rows_b, cols_b = #b, #b[1]
assert(cols_a == rows_b, "Incompatible matrix dimensions for multiplication")
local result = {}
for i = 1, rows_a do
result[i] = {}
for j = 1, cols_b do
local sum = 0
for k = 1, cols_a do
sum = sum + a[i][k] * b[k][j]
end
result[i][j] = sum
end
end
return result
end
-- Matrix addition
local function matrix_add(a, b)
local rows, cols = #a, #a[1]
assert(rows == #b and cols == #b[1], "Matrices must have the same dimensions")
local result = {}
for i = 1, rows do
result[i] = {}
for j = 1, cols do
result[i][j] = a[i][j] + b[i][j]
end
end
return result
end
-- Matrix subtraction
local function matrix_subtract(a, b)
local rows, cols = #a, #a[1]
assert(rows == #b and cols == #b[1], "Matrices must have the same dimensions")
local result = {}
for i = 1, rows do
result[i] = {}
for j = 1, cols do
result[i][j] = a[i][j] - b[i][j]
end
end
return result
end
-- Get submatrix
local function get_submatrix(m, start_row, end_row, start_col, end_col)
local result = {}
for i = start_row, end_row do
local row = {}
for j = start_col, end_col do
table.insert(row, m[i][j])
end
table.insert(result, row)
end
return result
end
-- Strassen's algorithm
local function strassen_multiply(a, b)
local n = #a
local m = #a[1]
assert(n == m, "Matrix must be square")
assert(n == #b and n == #b[1], "Matrices must have the same dimensions")
-- Check if size is a power of 2
local temp = n
while temp > 1 do
assert(temp % 2 == 0, "Matrix dimension must be a power of 2")
temp = temp / 2
end
if n == 1 then
return {{a[1][1] * b[1][1]}}
end
local half = n // 2
-- Partition matrices into quadrants
local a11 = get_submatrix(a, 1, half, 1, half)
local a12 = get_submatrix(a, 1, half, half+1, n)
local a21 = get_submatrix(a, half+1, n, 1, half)
local a22 = get_submatrix(a, half+1, n, half+1, n)
local b11 = get_submatrix(b, 1, half, 1, half)
local b12 = get_submatrix(b, 1, half, half+1, n)
local b21 = get_submatrix(b, half+1, n, 1, half)
local b22 = get_submatrix(b, half+1, n, half+1, n)
-- Calculate the seven products
local m1 = strassen_multiply(matrix_add(a11, a22), matrix_add(b11, b22))
local m2 = strassen_multiply(matrix_add(a21, a22), b11)
local m3 = strassen_multiply(a11, matrix_subtract(b12, b22))
local m4 = strassen_multiply(a22, matrix_subtract(b21, b11))
local m5 = strassen_multiply(matrix_add(a11, a12), b22)
local m6 = strassen_multiply(matrix_subtract(a21, a11), matrix_add(b11, b12))
local m7 = strassen_multiply(matrix_subtract(a12, a22), matrix_add(b21, b22))
-- Calculate the four quadrants of the result
local c11 = matrix_add(matrix_subtract(matrix_add(m1, m4), m5), m7)
local c12 = matrix_add(m3, m5)
local c21 = matrix_add(m2, m4)
local c22 = matrix_add(matrix_subtract(matrix_add(m1, m3), m2), m6)
-- Combine quadrants into a single matrix
return block_matrix({{c11, c12}, {c21, c22}})
end
-- Round matrix values
local function matrix_round(m, digits)
local result = {}
local mult = 10^digits
for i = 1, #m do
result[i] = {}
for j = 1, #m[1] do
if digits then
result[i][j] = math.floor(m[i][j] * mult + 0.5) / mult
else
result[i][j] = math.floor(m[i][j] + 0.5)
end
end
end
return result
end
-- Print matrix
local function print_matrix(name, m)
print(name .. " = {")
for i = 1, #m do
io.write(" {")
for j = 1, #m[1] do
io.write(m[i][j])
if j < #m[1] then
io.write(", ")
end
end
print("}")
end
print("}")
end
-- Examples
local function run_examples()
local a = {
{1, 2},
{3, 4}
}
local b = {
{5, 6},
{7, 8}
}
local c = {
{1, 1, 1, 1},
{2, 4, 8, 16},
{3, 9, 27, 81},
{4, 16, 64, 256}
}
local d = {
{4, -3, 4/3, -1/4},
{-13/3, 19/4, -7/3, 11/24},
{3/2, -2, 7/6, -1/4},
{-1/6, 1/4, -1/6, 1/24}
}
local e = {
{1, 2, 3, 4},
{5, 6, 7, 8},
{9, 10, 11, 12},
{13, 14, 15, 16}
}
local f = {
{1, 0, 0, 0},
{0, 1, 0, 0},
{0, 0, 1, 0},
{0, 0, 0, 1}
}
print("Naive matrix multiplication:")
print_matrix(" a * b", matrix_multiply(a, b))
print_matrix(" c * d", matrix_round(matrix_multiply(c, d), 0))
print_matrix(" e * f", matrix_multiply(e, f))
print("\nStrassen's matrix multiplication:")
print_matrix(" a * b", strassen_multiply(a, b))
print_matrix(" c * d", matrix_round(strassen_multiply(c, d), 0))
print_matrix(" e * f", strassen_multiply(e, f))
end
-- Run examples
run_examples()

View file

@ -0,0 +1,116 @@
(* ::Package:: *)
(* --------------------------------------------------------------- *)
(* Strassen matrix multiplication Mathematica version *)
(* --------------------------------------------------------------- *)
ClearAll[Strassen]
Strassen[A_?MatrixQ, B_?MatrixQ] :=
Module[{n = Length[A],
a11, a12, a21, a22,
b11, b12, b21, b22,
p1, p2, p3, p4, p5, p6, p7,
c11, c12, c21, c22},
(* Base case 1×1 matrix (scalar) *)
If[n == 1,
Return[{{A[[1, 1]]*B[[1, 1]]}}];
];
(* ---------------------------------------------------------------- *)
(* 2level blockview of the matrices (same as Julia's @views slicing) *)
(* ---------------------------------------------------------------- *)
a11 = A[[;; n/2, ;; n/2]];
a12 = A[[;; n/2, n/2 + 1 ;;]];
a21 = A[[n/2 + 1 ;;, ;; n/2]];
a22 = A[[n/2 + 1 ;;, n/2 + 1 ;;]];
b11 = B[[;; n/2, ;; n/2]];
b12 = B[[;; n/2, n/2 + 1 ;;]];
b21 = B[[n/2 + 1 ;;, ;; n/2]];
b22 = B[[n/2 + 1 ;;, n/2 + 1 ;;]];
(* --------------------------------------------------------------- *)
(* 7 recursive Strassen products *)
(* --------------------------------------------------------------- *)
p1 = Strassen[a12 - a22, b21 + b22];
p2 = Strassen[a11 + a22, b11 + b22];
p3 = Strassen[a11 - a21, b11 + b12];
p4 = Strassen[a11 + a12, b22];
p5 = Strassen[a11, b12 - b22];
p6 = Strassen[a22, b21 - b11];
p7 = Strassen[a21 + a22, b11];
(* --------------------------------------------------------------- *)
(* Assemble the four quadrants of the result *)
(* --------------------------------------------------------------- *)
c11 = p1 + p2 - p4 + p6;
c12 = p4 + p5;
c21 = p6 + p7;
c22 = p2 - p3 + p5 - p7;
(* Join the four blocks back together *)
Join[
Join[c11, c12, 2],
Join[c21, c22, 2],
1
]
];
(* --------------------------------------------------------------- *)
(* Helper that mimics the Julia `intprint` *)
(* --------------------------------------------------------------- *)
ClearAll[intPrint]
intPrint[title_String, mat_?MatrixQ] :=
Module[{rounded},
(* round each entry to 8 decimal digits, then coerce to an integer
when the rounded value is (numerically) an integer *)
rounded = Round[mat, 10^-8];
Print[title, " ", rounded ];
]
(* --------------------------------------------------------------- *)
(* Test data *)
(* --------------------------------------------------------------- *)
varA = {{1, 2}, {3, 4}};
varB = {{5, 6}, {7, 8}};
varC = {{1, 1, 1, 1},
{2, 4, 8, 16},
{3, 9, 27, 81},
{4, 16, 64, 256}};
varD = {{4, -3, 4/3, -1/4},
{-13/3, 19/4, -7/3, 11/24},
{3/2, -2, 7/6, -1/4},
{-1/6, 1/4, -1/6, 1/24}};
varE = {{1, 2, 3, 4},
{5, 6, 7, 8},
{9, 10, 11, 12},
{13, 14, 15, 16}};
varF = IdentityMatrix[4];
r = Sqrt[2]/2;
R = {{r, r}, {-r, r}};
(* --------------------------------------------------------------- *)
(* Run the examples compare ordinary (`.`) and Strassen results *)
(* --------------------------------------------------------------- *)
intPrint["Regular multiply: ", Transpose[varA].Transpose[varB]];
intPrint["Strassen multiply: ", Strassen[Transpose[varA], Transpose[varB]]];
intPrint["Regular multiply: ", varC . varD];
intPrint["Strassen multiply: ", Strassen[varC, varD]];
intPrint["Regular multiply: ", varE . varF];
intPrint["Strassen multiply: ", Strassen[varE, varF]];
intPrint["Regular multiply: ", R . R];
intPrint["Strassen multiply: ", Strassen[R, R]];

View file

@ -0,0 +1,214 @@
(* Matrix multiplication using Strassen's algorithm in OCaml *)
type matrix = float array array
type shape = {
rows : int;
cols : int;
}
(* Get the shape of a matrix *)
let shape m =
let rows = Array.length m in
let cols = if rows = 0 then 0 else Array.length m.(0) in
{ rows; cols }
(* Create a matrix from a list of lists *)
let matrix_of_lists lists =
Array.of_list (List.map Array.of_list lists)
(* Convert matrix to list of lists for printing *)
let lists_of_matrix m =
Array.to_list (Array.map Array.to_list m)
(* Matrix addition *)
let add_matrix a b =
let { rows; cols } = shape a in
let { rows = b_rows; cols = b_cols } = shape b in
assert (rows = b_rows && cols = b_cols);
Array.init rows (fun i ->
Array.init cols (fun j -> a.(i).(j) +. b.(i).(j)))
(* Matrix subtraction *)
let sub_matrix a b =
let { rows; cols } = shape a in
let { rows = b_rows; cols = b_cols } = shape b in
assert (rows = b_rows && cols = b_cols);
Array.init rows (fun i ->
Array.init cols (fun j -> a.(i).(j) -. b.(i).(j)))
(* Naive matrix multiplication *)
let dot_product a b =
let a_shape = shape a in
let b_shape = shape b in
assert (a_shape.cols = b_shape.rows);
Array.init a_shape.rows (fun i ->
Array.init b_shape.cols (fun j ->
let sum = ref 0.0 in
for k = 0 to a_shape.cols - 1 do
sum := !sum +. (a.(i).(k) *. b.(k).(j))
done;
!sum))
(* Extract a submatrix *)
let submatrix m start_row end_row start_col end_col =
Array.init (end_row - start_row) (fun i ->
Array.init (end_col - start_col) (fun j ->
m.(start_row + i).(start_col + j)))
(* Combine four submatrices into a single matrix *)
let block_matrix c11 c12 c21 c22 =
let p = Array.length c11 in
let result = Array.make_matrix (2 * p) (2 * p) 0.0 in
(* Copy c11 to top-left *)
for i = 0 to p - 1 do
for j = 0 to p - 1 do
result.(i).(j) <- c11.(i).(j)
done
done;
(* Copy c12 to top-right *)
for i = 0 to p - 1 do
for j = 0 to p - 1 do
result.(i).(p + j) <- c12.(i).(j)
done
done;
(* Copy c21 to bottom-left *)
for i = 0 to p - 1 do
for j = 0 to p - 1 do
result.(p + i).(j) <- c21.(i).(j)
done
done;
(* Copy c22 to bottom-right *)
for i = 0 to p - 1 do
for j = 0 to p - 1 do
result.(p + i).(p + j) <- c22.(i).(j)
done
done;
result
(* Check if a number is a power of 2 *)
let is_power_of_2 n =
n > 0 && (n land (n - 1)) = 0
(* Strassen's matrix multiplication *)
let rec strassen a b =
let a_shape = shape a in
let b_shape = shape b in
let rows = a_shape.rows in
let cols = a_shape.cols in
assert (rows = cols); (* matrices must be square *)
assert (a_shape.rows = b_shape.rows && a_shape.cols = b_shape.cols); (* same shape *)
assert (is_power_of_2 rows); (* size must be power of 2 *)
if rows = 1 then
dot_product a b
else
let p = rows / 2 in
(* Partition matrix a *)
let a11 = submatrix a 0 p 0 p in
let a12 = submatrix a 0 p p rows in
let a21 = submatrix a p rows 0 p in
let a22 = submatrix a p rows p rows in
(* Partition matrix b *)
let b11 = submatrix b 0 p 0 p in
let b12 = submatrix b 0 p p rows in
let b21 = submatrix b p rows 0 p in
let b22 = submatrix b p rows p rows in
(* Compute the 7 products *)
let m1 = strassen (add_matrix a11 a22) (add_matrix b11 b22) in
let m2 = strassen (add_matrix a21 a22) b11 in
let m3 = strassen a11 (sub_matrix b12 b22) in
let m4 = strassen a22 (sub_matrix b21 b11) in
let m5 = strassen (add_matrix a11 a12) b22 in
let m6 = strassen (sub_matrix a21 a11) (add_matrix b11 b12) in
let m7 = strassen (sub_matrix a12 a22) (add_matrix b21 b22) in
(* Compute the result submatrices *)
let c11 = add_matrix (sub_matrix (add_matrix m1 m4) m5) m7 in
let c12 = add_matrix m3 m5 in
let c21 = add_matrix m2 m4 in
let c22 = add_matrix (sub_matrix (add_matrix m1 m3) m2) m6 in
block_matrix c11 c12 c21 c22
(* Round matrix elements to specified decimal places *)
let round_matrix ?(ndigits=0) m =
let factor = 10.0 ** (float_of_int ndigits) in
Array.map (Array.map (fun x ->
Float.round (x *. factor) /. factor)) m
(* Pretty print a matrix *)
let print_matrix m =
let lists = lists_of_matrix m in
print_string "[";
List.iteri (fun i row ->
if i > 0 then print_string "; ";
print_string "[";
List.iteri (fun j x ->
if j > 0 then print_string "; ";
Printf.printf "%.6g" x) row;
print_string "]") lists;
print_endline "]"
(* Example usage *)
let examples () =
let a = matrix_of_lists [
[1.0; 2.0];
[3.0; 4.0]
] in
let b = matrix_of_lists [
[5.0; 6.0];
[7.0; 8.0]
] in
let c = matrix_of_lists [
[1.0; 1.0; 1.0; 1.0];
[2.0; 4.0; 8.0; 16.0];
[3.0; 9.0; 27.0; 81.0];
[4.0; 16.0; 64.0; 256.0]
] in
let d = matrix_of_lists [
[4.0; -3.0; 4.0/.3.0; -1.0/.4.0];
[-13.0/.3.0; 19.0/.4.0; -7.0/.3.0; 11.0/.24.0];
[3.0/.2.0; -2.0; 7.0/.6.0; -1.0/.4.0];
[-1.0/.6.0; 1.0/.4.0; -1.0/.6.0; 1.0/.24.0]
] in
let e = matrix_of_lists [
[1.0; 2.0; 3.0; 4.0];
[5.0; 6.0; 7.0; 8.0];
[9.0; 10.0; 11.0; 12.0];
[13.0; 14.0; 15.0; 16.0]
] in
let f = matrix_of_lists [
[1.0; 0.0; 0.0; 0.0];
[0.0; 1.0; 0.0; 0.0];
[0.0; 0.0; 1.0; 0.0];
[0.0; 0.0; 0.0; 1.0]
] in
print_endline "Naive matrix multiplication:";
print_string " a * b = "; print_matrix (dot_product a b);
print_string " c * d = "; print_matrix (round_matrix (dot_product c d));
print_string " e * f = "; print_matrix (dot_product e f);
print_endline "\nStrassen's matrix multiplication:";
print_string " a * b = "; print_matrix (strassen a b);
print_string " c * d = "; print_matrix (round_matrix (strassen c d));
print_string " e * f = "; print_matrix (strassen e f)
(* Run examples when executed *)
let () = examples ()

View file

@ -0,0 +1,256 @@
#!/usr/bin/perl
use strict;
use warnings;
use List::Util qw(sum);
# Matrix class implemented as array reference
package Matrix;
# Constructor
sub new {
my ($class, $data) = @_;
my $self = defined $data ? $data : [];
bless $self, $class;
return $self;
}
# Create matrix from nested blocks
sub block {
my ($class, $blocks) = @_;
my @result;
# Get dimensions
my $num_rows = 0;
for my $hblock (@$blocks) {
$num_rows += @{$hblock->[0]};
}
# Process each horizontal block
my $row_offset = 0;
for my $hblock (@$blocks) {
my $block_height = @{$hblock->[0]};
# Zip and concatenate rows
for my $i (0..$block_height-1) {
my @new_row;
for my $matrix (@$hblock) {
push @new_row, @{$matrix->[$i]};
}
$result[$row_offset + $i] = \@new_row;
}
$row_offset += $block_height;
}
return Matrix->new(\@result);
}
# Matrix multiplication (naive)
sub dot {
my ($self, $b) = @_;
my ($rows_a, $cols_a) = $self->shape();
my ($rows_b, $cols_b) = $b->shape();
die "Matrix dimensions don't match for multiplication" unless $cols_a == $rows_b;
my @result;
for my $i (0..$rows_a-1) {
my @row;
for my $j (0..$cols_b-1) {
my $sum = 0;
for my $k (0..$cols_a-1) {
$sum += $self->[$i][$k] * $b->[$k][$j];
}
push @row, $sum;
}
push @result, \@row;
}
return Matrix->new(\@result);
}
# Overload multiplication operator
use overload '*' => \&dot;
# Matrix addition
sub add {
my ($self, $b) = @_;
my ($rows, $cols) = $self->shape();
my ($b_rows, $b_cols) = $b->shape();
die "Matrix dimensions don't match for addition" unless $rows == $b_rows && $cols == $b_cols;
my @result;
for my $i (0..$rows-1) {
my @row;
for my $j (0..$cols-1) {
push @row, $self->[$i][$j] + $b->[$i][$j];
}
push @result, \@row;
}
return Matrix->new(\@result);
}
# Matrix subtraction
sub subtract {
my ($self, $b) = @_;
my ($rows, $cols) = $self->shape();
my ($b_rows, $b_cols) = $b->shape();
die "Matrix dimensions don't match for subtraction" unless $rows == $b_rows && $cols == $b_cols;
my @result;
for my $i (0..$rows-1) {
my @row;
for my $j (0..$cols-1) {
push @row, $self->[$i][$j] - $b->[$i][$j];
}
push @result, \@row;
}
return Matrix->new(\@result);
}
# Overload operators
use overload '+' => \&add;
use overload '-' => \&subtract;
# Strassen's algorithm
sub strassen {
my ($self, $b) = @_;
my ($rows, $cols) = $self->shape();
my ($b_rows, $b_cols) = $b->shape();
die "Matrices must be square" unless $rows == $cols && $b_rows == $b_cols;
die "Matrices must be the same shape" unless $rows == $b_rows;
die "Shape must be a power of 2" unless $rows > 0 && ($rows & ($rows - 1)) == 0;
if ($rows == 1) {
return $self->dot($b);
}
my $p = $rows / 2;
# Partition matrices
my $a11 = Matrix->new([map { [ @{$self->[$_]}[0..$p-1] ] } 0..$p-1]);
my $a12 = Matrix->new([map { [ @{$self->[$_]}[$p..$rows-1] ] } 0..$p-1]);
my $a21 = Matrix->new([map { [ @{$self->[$_]}[0..$p-1] ] } $p..$rows-1]);
my $a22 = Matrix->new([map { [ @{$self->[$_]}[$p..$rows-1] ] } $p..$rows-1]);
my $b11 = Matrix->new([map { [ @{$b->[$_]}[0..$p-1] ] } 0..$p-1]);
my $b12 = Matrix->new([map { [ @{$b->[$_]}[$p..$b_cols-1] ] } 0..$p-1]);
my $b21 = Matrix->new([map { [ @{$b->[$_]}[0..$p-1] ] } $p..$b_rows-1]);
my $b22 = Matrix->new([map { [ @{$b->[$_]}[$p..$b_cols-1] ] } $p..$b_rows-1]);
# Calculate M1..M7
my $m1 = ($a11 + $a22)->strassen($b11 + $b22);
my $m2 = ($a21 + $a22)->strassen($b11);
my $m3 = $a11->strassen($b12 - $b22);
my $m4 = $a22->strassen($b21 - $b11);
my $m5 = ($a11 + $a12)->strassen($b22);
my $m6 = ($a21 - $a11)->strassen($b11 + $b12);
my $m7 = ($a12 - $a22)->strassen($b21 + $b22);
# Calculate C11..C22
my $c11 = $m1 + $m4 - $m5 + $m7;
my $c12 = $m3 + $m5;
my $c21 = $m2 + $m4;
my $c22 = $m1 - $m2 + $m3 + $m6;
return Matrix->block([[$c11, $c12], [$c21, $c22]]);
}
# Round elements
sub round_matrix {
my ($self, $ndigits) = @_;
$ndigits = undef unless defined $ndigits;
my @result;
for my $i (0..$#{$self}) {
my @row;
for my $j (0..$#{$self->[$i]}) {
my $val = $self->[$i][$j];
if (defined $ndigits) {
push @row, sprintf("%.${ndigits}f", $val);
} else {
push @row, int($val + ($val >= 0 ? 0.5 : -0.5));
}
}
push @result, \@row;
}
return Matrix->new(\@result);
}
# Get matrix shape
sub shape {
my ($self) = @_;
return (0, 0) unless @$self;
return (scalar @$self, scalar @{$self->[0]});
}
# String representation
sub stringify {
my ($self) = @_;
my @rows;
for my $row (@$self) {
push @rows, '[' . join(', ', @$row) . ']';
}
return '[' . join(', ', @rows) . ']';
}
use overload '""' => \&stringify;
# Examples
package main;
sub examples {
my $a = Matrix->new([
[1, 2],
[3, 4]
]);
my $b = Matrix->new([
[5, 6],
[7, 8]
]);
my $c = Matrix->new([
[1, 1, 1, 1],
[2, 4, 8, 16],
[3, 9, 27, 81],
[4, 16, 64, 256]
]);
my $d = Matrix->new([
[4, -3, 4/3, -1/4],
[-13/3, 19/4, -7/3, 11/24],
[3/2, -2, 7/6, -1/4],
[-1/6, 1/4, -1/6, 1/24]
]);
my $e = Matrix->new([
[1, 2, 3, 4],
[5, 6, 7, 8],
[9, 10, 11, 12],
[13, 14, 15, 16]
]);
my $f = Matrix->new([
[1, 0, 0, 0],
[0, 1, 0, 0],
[0, 0, 1, 0],
[0, 0, 0, 1]
]);
print "Naive matrix multiplication:\n";
print " a * b = " . ($a * $b) . "\n";
print " c * d = " . $c->round_matrix(0) . "\n";
print " e * f = " . ($e * $f) . "\n";
print "Strassen's matrix multiplication:\n";
print " a * b = " . $a->strassen($b) . "\n";
print " c * d = " . $c->strassen($d)->round_matrix(0) . "\n";
print " e * f = " . $e->strassen($f) . "\n";
}
examples() if __FILE__ eq $0;

View file

@ -0,0 +1,70 @@
require "matrix"
require "table2"
local fmt = require "fmt"
local function strassen(a, b)
assert(a:issquare() and a:samesize(b), "matrices must be square and of equal size")
local n = a:numrows()
assert(n & (n - 1) == 0, "size of matrices must be a power of two")
if n == 1 then return a:matmul(b) end
local h = n // 2
local a11 = a:submatrix(1, h, 1, h)
local a12 = a:submatrix(1, h, h + 1, n)
local a21 = a:submatrix(h + 1, n, 1, h)
local a22 = a:submatrix(h + 1, n, h + 1, n)
local b11 = b:submatrix(1, h, 1, h)
local b12 = b:submatrix(1, h, h + 1, n)
local b21 = b:submatrix(h + 1, n, 1, h)
local b22 = b:submatrix(h + 1, n, h + 1, n)
local m1 = strassen(a11 + a22, b11 + b22)
local m2 = strassen(a21 + a22, b11 )
local m3 = strassen(a11, b12 - b22)
local m4 = strassen(a22, b21 - b11)
local m5 = strassen(a11 + a12, b22 )
local m6 = strassen(a21 - a11, b11 + b12)
local m7 = strassen(a12 - a22, b21 + b22)
local c11 = m1 + m4 - m5 + m7
local c12 = m3 + m5
local c21 = m2 + m4
local c22 = m1 - m2 + m3 + m6
local c = {}
for i = 1, n do c[i] = table.rep(n, 0) end
for i = 1, h do
for j = 1, h do
c[i][j] = c11:get(i, j)
c[i][j + h] = c12:get(i, j)
c[i + h][j] = c21:get(i, j)
c[i + h][j + h] = c22:get(i, j)
end
end
return matrix.from(c)
end
-- Round numbers which differ from an integer by less than 'tol' to that integer.
local function round(n, tol = 1e-12)
if math.abs(n - math.round(n)) < tol then return math.round(n) end
return n
end
local a = matrix.from({ {1, 2}, {3, 4} })
local b = matrix.from({ {5, 6}, {7, 8} })
local c = matrix.from({ {1, 1, 1, 1}, {2, 4, 8, 16}, {3, 9, 27, 81}, {4, 16, 64, 256} })
local d = matrix.from({ {4, -3, 4/3, -1/4}, {-13/3, 19/4, -7/3, 11/24},
{3/2, -2, 7/6, -1/4}, {-1/6, 1/4, -1/6, 1/24} })
local e = matrix.from({ {1, 2, 3, 4}, {5, 6, 7, 8}, {9, 10, 11, 12}, {13, 14, 15, 16} })
local f = matrix.from({ {1, 0, 0, 0}, {0, 1, 0, 0}, {0, 0, 1, 0}, {0, 0, 0, 1} })
print("Using 'normal' matrix multiplication:")
fmt.print(" a x b = %s", fmt.swrite(a:matmul(b):toarray()))
fmt.print(" c x d = %s", fmt.swrite(c:matmul(d):map(round):toarray()))
fmt.print(" e x f = %s", fmt.swrite(e:matmul(f):toarray()))
print("\nUsing 'Strassen' matrix multiplication:")
fmt.print(" a x b = %s", fmt.swrite(strassen(a, b):toarray()))
fmt.print(" c x d = %s", fmt.swrite(strassen(c, d):map(round):toarray()))
fmt.print(" e x f = %s", fmt.swrite(strassen(e, f):toarray()))

View file

@ -0,0 +1,288 @@
# Matrix class implemented as array reference
class Matrix {
[object[]]$data
# Constructor
Matrix([object[]]$data) {
$this.data = $data
}
# Create matrix from nested blocks
static [Matrix] Block([Matrix[][]]$blocks) {
$result = @()
# Get dimensions
$num_rows = 0
foreach ($hblock in $blocks) {
$num_rows += $hblock[0].data.Count
}
# Process each horizontal block
$row_offset = 0
foreach ($hblock in $blocks) {
$block_height = $hblock[0].data.Count
# Zip and concatenate rows
for ($i = 0; $i -lt $block_height; $i++) {
$new_row = @()
foreach ($matrix in $hblock) {
$new_row += $matrix.data[$i]
}
if ($row_offset + $i -ge $result.Count) {
$result += , @()
}
$result[$row_offset + $i] = $new_row
}
$row_offset += $block_height
}
return [Matrix]::new($result)
}
# Matrix multiplication (naive)
[Matrix] Dot([Matrix]$b) {
$rows_a = $this.data.Count
$cols_a = if ($rows_a -gt 0) { $this.data[0].Count } else { 0 }
$rows_b = $b.data.Count
$cols_b = if ($rows_b -gt 0) { $b.data[0].Count } else { 0 }
if ($cols_a -ne $rows_b) {
throw "Matrix dimensions don't match for multiplication"
}
$result = @()
for ($i = 0; $i -lt $rows_a; $i++) {
$row = @()
for ($j = 0; $j -lt $cols_b; $j++) {
$sum = 0
for ($k = 0; $k -lt $cols_a; $k++) {
$sum += $this.data[$i][$k] * $b.data[$k][$j]
}
$row += $sum
}
$result += , $row
}
return [Matrix]::new($result)
}
# Matrix addition
[Matrix] Add([Matrix]$b) {
$rows = $this.data.Count
$cols = if ($rows -gt 0) { $this.data[0].Count } else { 0 }
$b_rows = $b.data.Count
$b_cols = if ($b_rows -gt 0) { $b.data[0].Count } else { 0 }
if ($rows -ne $b_rows -or $cols -ne $b_cols) {
throw "Matrix dimensions don't match for addition"
}
$result = @()
for ($i = 0; $i -lt $rows; $i++) {
$row = @()
for ($j = 0; $j -lt $cols; $j++) {
$row += $this.data[$i][$j] + $b.data[$i][$j]
}
$result += , $row
}
return [Matrix]::new($result)
}
# Matrix subtraction
[Matrix] Subtract([Matrix]$b) {
$rows = $this.data.Count
$cols = if ($rows -gt 0) { $this.data[0].Count } else { 0 }
$b_rows = $b.data.Count
$b_cols = if ($b_rows -gt 0) { $b.data[0].Count } else { 0 }
if ($rows -ne $b_rows -or $cols -ne $b_cols) {
throw "Matrix dimensions don't match for subtraction"
}
$result = @()
for ($i = 0; $i -lt $rows; $i++) {
$row = @()
for ($j = 0; $j -lt $cols; $j++) {
$row += $this.data[$i][$j] - $b.data[$i][$j]
}
$result += , $row
}
return [Matrix]::new($result)
}
# Strassen's algorithm
[Matrix] Strassen([Matrix]$b) {
$rows = $this.data.Count
$cols = if ($rows -gt 0) { $this.data[0].Count } else { 0 }
$b_rows = $b.data.Count
$b_cols = if ($b_rows -gt 0) { $b.data[0].Count } else { 0 }
if ($rows -ne $cols -or $b_rows -ne $b_cols) {
throw "Matrices must be square"
}
if ($rows -ne $b_rows) {
throw "Matrices must be the same shape"
}
if ($rows -le 0 -or ($rows -band ($rows - 1)) -ne 0) {
throw "Shape must be a power of 2"
}
if ($rows -eq 1) {
return $this.Dot($b)
}
$p = [Math]::Floor($rows / 2)
# Partition matrices
$a11_data = @()
$a12_data = @()
$a21_data = @()
$a22_data = @()
for ($i = 0; $i -lt $p; $i++) {
$a11_data += , @($this.data[$i][0..($p-1)])
$a12_data += , @($this.data[$i][$p..($rows-1)])
}
for ($i = $p; $i -lt $rows; $i++) {
$a21_data += , @($this.data[$i][0..($p-1)])
$a22_data += , @($this.data[$i][$p..($rows-1)])
}
$b11_data = @()
$b12_data = @()
$b21_data = @()
$b22_data = @()
for ($i = 0; $i -lt $p; $i++) {
$b11_data += , @($b.data[$i][0..($p-1)])
$b12_data += , @($b.data[$i][$p..($b_cols-1)])
}
for ($i = $p; $i -lt $b_rows; $i++) {
$b21_data += , @($b.data[$i][0..($p-1)])
$b22_data += , @($b.data[$i][$p..($b_rows-1)])
}
$a11 = [Matrix]::new($a11_data)
$a12 = [Matrix]::new($a12_data)
$a21 = [Matrix]::new($a21_data)
$a22 = [Matrix]::new($a22_data)
$b11 = [Matrix]::new($b11_data)
$b12 = [Matrix]::new($b12_data)
$b21 = [Matrix]::new($b21_data)
$b22 = [Matrix]::new($b22_data)
# Calculate M1..M7
$m1 = ($a11.Add($a22)).Strassen($b11.Add($b22))
$m2 = ($a21.Add($a22)).Strassen($b11)
$m3 = $a11.Strassen($b12.Subtract($b22))
$m4 = $a22.Strassen($b21.Subtract($b11))
$m5 = ($a11.Add($a12)).Strassen($b22)
$m6 = ($a21.Subtract($a11)).Strassen($b11.Add($b12))
$m7 = ($a12.Subtract($a22)).Strassen($b21.Add($b22))
# Calculate C11..C22
$c11 = $m1.Add($m4).Subtract($m5).Add($m7)
$c12 = $m3.Add($m5)
$c21 = $m2.Add($m4)
$c22 = $m1.Subtract($m2).Add($m3).Add($m6)
return [Matrix]::Block(@(@($c11, $c12), @($c21, $c22)))
}
# Round elements
[Matrix] RoundMatrix([int]$ndigits) {
$result = @()
for ($i = 0; $i -lt $this.data.Count; $i++) {
$row = @()
for ($j = 0; $j -lt $this.data[$i].Count; $j++) {
$val = $this.data[$i][$j]
if ($ndigits -ne $null) {
$rounded = [Math]::Round($val, $ndigits)
$row += $rounded
} else {
$rounded = [Math]::Round($val)
$row += $rounded
}
}
$result += , $row
}
return [Matrix]::new($result)
}
[Matrix] RoundMatrix() {
return $this.RoundMatrix($null)
}
# Get matrix shape
[object[]] Shape() {
if ($this.data.Count -eq 0) {
return @(0, 0)
}
return @($this.data.Count, $this.data[0].Count)
}
# String representation
[string] ToString() {
$rows = @()
foreach ($row in $this.data) {
$rows += "[" + ($row -join ", ") + "]"
}
return "[" + ($rows -join ", ") + "]"
}
}
# Operator overloading for PowerShell (using methods instead)
function Multiply-Matrix([Matrix]$a, [Matrix]$b) {
return $a.Dot($b)
}
function Add-Matrix([Matrix]$a, [Matrix]$b) {
return $a.Add($b)
}
function Subtract-Matrix([Matrix]$a, [Matrix]$b) {
return $a.Subtract($b)
}
# Examples
function Examples() {
$a = [Matrix]::new(@(@(1, 2), @(3, 4)))
$b = [Matrix]::new(@(@(5, 6), @(7, 8)))
$c = [Matrix]::new(@(
@(1, 1, 1, 1),
@(2, 4, 8, 16),
@(3, 9, 27, 81),
@(4, 16, 64, 256)
))
$d = [Matrix]::new(@(
@(4, -3, (4/3), (-1/4)),
@((-13/3), (19/4), (-7/3), (11/24)),
@((3/2), -2, (7/6), (-1/4)),
@((-1/6), (1/4), (-1/6), (1/24))
))
$e = [Matrix]::new(@(
@(1, 2, 3, 4),
@(5, 6, 7, 8),
@(9, 10, 11, 12),
@(13, 14, 15, 16)
))
$f = [Matrix]::new(@(
@(1, 0, 0, 0),
@(0, 1, 0, 0),
@(0, 0, 1, 0),
@(0, 0, 0, 1)
))
Write-Host "Naive matrix multiplication:"
Write-Host " a * b = $($a.Dot($b))"
Write-Host " c * d = $($c.Dot($d).RoundMatrix(0))"
Write-Host " e * f = $($e.Dot($f))"
Write-Host "Strassen's matrix multiplication:"
Write-Host " a * b = $($a.Strassen($b))"
Write-Host " c * d = $($c.Strassen($d).RoundMatrix(0))"
Write-Host " e * f = $($e.Strassen($f))"
}
# Run examples if script is executed directly
Examples

View file

@ -0,0 +1,179 @@
# ---------------------------------------------------------------
# Strassen matrix multiplication R version (Corrected)
# ---------------------------------------------------------------
# Helper function to pad matrix to next power of 2
pad_to_power_of_2 <- function(mat) {
n <- nrow(mat)
m <- ncol(mat)
max_dim <- max(n, m)
new_dim <- 2^ceiling(log2(max_dim))
if (new_dim == n && new_dim == m) {
return(mat)
}
padded <- matrix(0, nrow = new_dim, ncol = new_dim)
padded[1:n, 1:m] <- mat
return(padded)
}
# Helper to split a matrix into quadrants
split_matrix <- function(X) {
n <- nrow(X)
mid <- n %/% 2
list(
X11 = X[1:mid, 1:mid, drop = FALSE],
X12 = X[1:mid, (mid + 1):n, drop = FALSE],
X21 = X[(mid + 1):n, 1:mid, drop = FALSE],
X22 = X[(mid + 1):n, (mid + 1):n, drop = FALSE]
)
}
# Join four submatrices into one matrix
join_matrices <- function(C11, C12, C21, C22) {
top <- cbind(C11, C12)
bottom <- cbind(C21, C22)
rbind(top, bottom)
}
# Strassen Matrix Multiplication
strassen <- function(A, B) {
# Check if matrices are conformable for multiplication
if (ncol(A) != nrow(B)) {
stop("Matrices cannot be multiplied: incompatible dimensions")
}
# Pad matrices to make them square and powers of 2
orig_rows <- nrow(A)
orig_cols <- ncol(B)
max_dim <- max(nrow(A), ncol(A), nrow(B), ncol(B))
padded_dim <- 2^ceiling(log2(max_dim))
if (nrow(A) != padded_dim || ncol(A) != padded_dim) {
A_padded <- matrix(0, nrow = padded_dim, ncol = padded_dim)
A_padded[1:nrow(A), 1:ncol(A)] <- A
A <- A_padded
}
if (nrow(B) != padded_dim || ncol(B) != padded_dim) {
B_padded <- matrix(0, nrow = padded_dim, ncol = padded_dim)
B_padded[1:nrow(B), 1:ncol(B)] <- B
B <- B_padded
}
# Recursive helper function
strassen_recursive <- function(X, Y) {
n <- nrow(X)
# Base case: 1x1 matrix
if (n == 1) {
return(matrix(X[1, 1] * Y[1, 1], nrow = 1, ncol = 1))
}
# Split matrices into quadrants
X_parts <- split_matrix(X)
Y_parts <- split_matrix(Y)
x11 <- X_parts$X11
x12 <- X_parts$X12
x21 <- X_parts$X21
x22 <- X_parts$X22
y11 <- Y_parts$X11
y12 <- Y_parts$X12
y21 <- Y_parts$X21
y22 <- Y_parts$X22
# Compute the seven products recursively
p1 <- strassen_recursive(x12 - x22, y21 + y22)
p2 <- strassen_recursive(x11 + x22, y11 + y22)
p3 <- strassen_recursive(x11 - x21, y11 + y12)
p4 <- strassen_recursive(x11 + x12, y22)
p5 <- strassen_recursive(x11, y12 - y22)
p6 <- strassen_recursive(x22, y21 - y11)
p7 <- strassen_recursive(x21 + x22, y11)
# Combine results into quadrants
c11 <- p1 + p2 - p4 + p6
c12 <- p4 + p5
c21 <- p6 + p7
c22 <- p2 - p3 + p5 - p7
# Join and return final matrix
join_matrices(c11, c12, c21, c22)
}
# Perform Strassen multiplication
result_padded <- strassen_recursive(A, B)
# Extract the relevant portion
result <- result_padded[1:orig_rows, 1:orig_cols, drop = FALSE]
return(result)
}
# ---------------------------------------------------------------
# Helper that mimics the Julia `intprint`
# ---------------------------------------------------------------
int_print <- function(title, mat) {
# Round to 8 decimal places and convert near-integers to integers
rounded_mat <- round(mat, digits = 8)
cat(title, "\n")
print(rounded_mat)
cat("\n")
}
# ---------------------------------------------------------------
# Test data
# ---------------------------------------------------------------
varA <- matrix(c(1, 2, 3, 4), nrow = 2, byrow = TRUE)
varB <- matrix(c(5, 6, 7, 8), nrow = 2, byrow = TRUE)
varC <- matrix(c(
1, 1, 1, 1,
2, 4, 8, 16,
3, 9, 27, 81,
4, 16, 64, 256
), nrow = 4, byrow = TRUE)
varD <- matrix(c(
4, -3, 4/3, -1/4,
-13/3, 19/4, -7/3, 11/24,
3/2, -2, 7/6, -1/4,
-1/6, 1/4, -1/6, 1/24
), nrow = 4, byrow = TRUE)
varE <- matrix(c(
1, 2, 3, 4,
5, 6, 7, 8,
9, 10, 11, 12,
13, 14, 15, 16
), nrow = 4, byrow = TRUE)
varF <- diag(4)
r <- sqrt(2)/2
R <- matrix(c(r, r, -r, r), nrow = 2, byrow = TRUE)
# ---------------------------------------------------------------
# Run the examples compare ordinary (%*%) and Strassen results
# ---------------------------------------------------------------
# Example 1
int_print("Regular multiply:", t(varA) %*% t(varB))
int_print("Strassen multiply:", strassen(t(varA), t(varB)))
# Example 2
int_print("Regular multiply:", varC %*% varD)
int_print("Strassen multiply:", strassen(varC, varD))
# Example 3
int_print("Regular multiply:", varE %*% varF)
int_print("Strassen multiply:", strassen(varE, varF))
# Example 4
int_print("Regular multiply:", R %*% R)
int_print("Strassen multiply:", strassen(R, R))

View file

@ -0,0 +1,220 @@
#lang racket
(require racket/format)
; Matrix structure
(struct matrix (data rows cols) #:transparent)
; Constructor
(define (new-matrix data)
(let ([rows (length data)]
[cols (if (null? data) 0 (length (car data)))])
(matrix data rows cols)))
; Getters
(define (get-rows m) (matrix-rows m))
(define (get-cols m) (matrix-cols m))
; Validation functions
(define (validate-dimensions m1 m2)
(unless (and (= (get-rows m1) (get-rows m2))
(= (get-cols m1) (get-cols m2)))
(error "Matrices must have the same dimensions.")))
(define (validate-multiplication m1 m2)
(unless (= (get-cols m1) (get-rows m2))
(error "Cannot multiply these matrices.")))
(define (validate-square-power-of-two m)
(let ([rows (get-rows m)]
[cols (get-cols m)])
(unless (= rows cols)
(error "Matrix must be square."))
(when (or (= rows 0) (not (= (bitwise-and rows (- rows 1)) 0)))
(error "Size of matrix must be a power of two."))))
; Helper functions for matrix operations
(define (add-elements row1 row2)
(map + row1 row2))
(define (subtract-elements row1 row2)
(map - row1 row2))
(define (add-rows data1 data2)
(map add-elements data1 data2))
(define (subtract-rows data1 data2)
(map subtract-elements data1 data2))
; Matrix operations
(define (matrix-add m1 m2)
(validate-dimensions m1 m2)
(let ([data1 (matrix-data m1)]
[data2 (matrix-data m2)])
(new-matrix (add-rows data1 data2))))
(define (matrix-subtract m1 m2)
(validate-dimensions m1 m2)
(let ([data1 (matrix-data m1)]
[data2 (matrix-data m2)])
(new-matrix (subtract-rows data1 data2))))
; Get column from matrix data
(define (get-column data col-index)
(map (lambda (row) (list-ref row col-index)) data))
; Dot product of two lists
(define (dot-product list1 list2)
(apply + (map * list1 list2)))
; Multiply a row with entire matrix
(define (multiply-row-with-matrix row data2 cols2)
(map (lambda (j) (dot-product row (get-column data2 j)))
(range cols2)))
; Multiply rows
(define (multiply-rows data1 data2 cols2)
(map (lambda (row) (multiply-row-with-matrix row data2 cols2))
data1))
(define (matrix-multiply m1 m2)
(validate-multiplication m1 m2)
(let ([data1 (matrix-data m1)]
[data2 (matrix-data m2)]
[cols2 (get-cols m2)])
(new-matrix (multiply-rows data1 data2 cols2))))
; String formatting functions
(define (format-element e)
(~a e))
(define (format-row row)
(string-append "[" (string-join (map format-element row) ", ") "]"))
(define (matrix-to-string m)
(let ([data (matrix-data m)])
(string-append (string-join (map format-row data) "\n") "\n")))
(define (format-element-with-precision e precision)
(let* ([pow (expt 10.0 precision)]
[rounded (/ (round (* e pow)) pow)]
[formatted (~r rounded #:precision precision)]
[zero-check (if (= precision 0)
"0"
(string-append "0." (make-string precision #\0)))])
; Handle negative zero
(if (and (string-prefix? formatted "-")
(string=? (substring formatted 1) zero-check))
zero-check
formatted)))
(define (format-row-with-precision row precision)
(string-append "["
(string-join (map (lambda (e) (format-element-with-precision e precision)) row) ", ")
"]"))
(define (matrix-to-string-with-precision m precision)
(let ([data (matrix-data m)])
(string-append (string-join (map (lambda (row) (format-row-with-precision row precision)) data) "\n") "\n")))
; Strassen multiplication helper functions
(define (to-quarters m)
(let* ([rows (get-rows m)]
[r (quotient rows 2)]
[data (matrix-data m)]
[top-half (take data r)]
[bottom-half (drop data r)])
(list
; Q0: top-left
(new-matrix (map (lambda (row) (take row r)) top-half))
; Q1: top-right
(new-matrix (map (lambda (row) (drop row r)) top-half))
; Q2: bottom-left
(new-matrix (map (lambda (row) (take row r)) bottom-half))
; Q3: bottom-right
(new-matrix (map (lambda (row) (drop row r)) bottom-half)))))
(define (from-quarters quarters)
(let ([q0 (first quarters)]
[q1 (second quarters)]
[q2 (third quarters)]
[q3 (fourth quarters)])
(let ([q0-data (matrix-data q0)]
[q1-data (matrix-data q1)]
[q2-data (matrix-data q2)]
[q3-data (matrix-data q3)])
(let ([top-half (map append q0-data q1-data)]
[bottom-half (map append q2-data q3-data)])
(new-matrix (append top-half bottom-half))))))
(define (strassen-impl m1 m2)
(if (= (get-rows m1) 1)
(matrix-multiply m1 m2)
(let ([quarters-a (to-quarters m1)]
[quarters-b (to-quarters m2)])
(let ([a11 (first quarters-a)]
[a12 (second quarters-a)]
[a21 (third quarters-a)]
[a22 (fourth quarters-a)]
[b11 (first quarters-b)]
[b12 (second quarters-b)]
[b21 (third quarters-b)]
[b22 (fourth quarters-b)])
; Calculate the 7 products according to Strassen's algorithm
(let ([p1 (strassen-impl a11 (matrix-subtract b12 b22))]
[p2 (strassen-impl (matrix-add a11 a12) b22)]
[p3 (strassen-impl (matrix-add a21 a22) b11)]
[p4 (strassen-impl a22 (matrix-subtract b21 b11))]
[p5 (strassen-impl (matrix-add a11 a22) (matrix-add b11 b22))]
[p6 (strassen-impl (matrix-subtract a12 a22) (matrix-add b21 b22))]
[p7 (strassen-impl (matrix-subtract a11 a21) (matrix-add b11 b12))])
; Calculate result quarters
(let ([c11 (matrix-add (matrix-subtract (matrix-add p5 p4) p2) p6)]
[c12 (matrix-add p1 p2)]
[c21 (matrix-add p3 p4)]
[c22 (matrix-subtract (matrix-subtract (matrix-add p5 p1) p3) p7)])
(from-quarters (list c11 c12 c21 c22))))))))
(define (matrix-strassen m1 m2)
(validate-square-power-of-two m1)
(validate-square-power-of-two m2)
(unless (and (= (get-rows m1) (get-rows m2))
(= (get-cols m1) (get-cols m2)))
(error "Matrices must be square and of equal size for Strassen multiplication."))
(strassen-impl m1 m2))
; Main function for testing
(define (main)
(let* ([a-data '((1.0 2.0) (3.0 4.0))]
[a (new-matrix a-data)]
[b-data '((5.0 6.0) (7.0 8.0))]
[b (new-matrix b-data)]
[c-data '((1.0 1.0 1.0 1.0) (2.0 4.0 8.0 16.0) (3.0 9.0 27.0 81.0) (4.0 16.0 64.0 256.0))]
[c (new-matrix c-data)]
[d-data `((4.0 -3.0 ,(/ 4.0 3.0) ,(/ -1.0 4.0))
(,(/ -13.0 3.0) ,(/ 19.0 4.0) ,(/ -7.0 3.0) ,(/ 11.0 24.0))
(1.5 -2.0 ,(/ 7.0 6.0) -0.25)
(,(/ -1.0 6.0) 0.25 ,(/ -1.0 6.0) ,(/ 1.0 24.0)))]
[d (new-matrix d-data)]
[e-data '((1.0 2.0 3.0 4.0) (5.0 6.0 7.0 8.0) (9.0 10.0 11.0 12.0) (13.0 14.0 15.0 16.0))]
[e (new-matrix e-data)]
[f-data '((1.0 0.0 0.0 0.0) (0.0 1.0 0.0 0.0) (0.0 0.0 1.0 0.0) (0.0 0.0 0.0 1.0))]
[f (new-matrix f-data)])
(displayln "Using 'normal' matrix multiplication:")
(printf " a * b = ~a" (matrix-to-string (matrix-multiply a b)))
(printf " c * d = ~a" (matrix-to-string-with-precision (matrix-multiply c d) 6))
(printf " e * f = ~a" (matrix-to-string (matrix-multiply e f)))
(displayln "\nUsing 'Strassen' matrix multiplication:")
(printf " a * b = ~a" (matrix-to-string (matrix-strassen a b)))
(printf " c * d = ~a" (matrix-to-string-with-precision (matrix-strassen c d) 6))
(printf " e * f = ~a" (matrix-to-string (matrix-strassen e f)))))
; Export functions for use as a module
(provide new-matrix matrix? get-rows get-cols
matrix-add matrix-subtract matrix-multiply matrix-strassen
matrix-to-string matrix-to-string-with-precision main)
; Run the main function if this file is executed directly
(main)

View file

@ -0,0 +1,214 @@
class Shape < Struct.new(:rows, :cols)
end
class Matrix
attr_reader :data
def initialize(data = [])
@data = data
end
def self.block(blocks)
m = []
# blocks is an array of arrays of Matrix objects
# Process horizontal blocks row by row
top_blocks = blocks[0] # [c11, c12]
bottom_blocks = blocks[1] # [c21, c22]
# Combine top blocks horizontally
top_rows = []
(0...top_blocks[0].rows).each do |i|
row = []
top_blocks.each { |block| row.concat(block.data[i]) }
top_rows << row
end
# Combine bottom blocks horizontally
bottom_rows = []
(0...bottom_blocks[0].rows).each do |i|
row = []
bottom_blocks.each { |block| row.concat(block.data[i]) }
bottom_rows << row
end
# Combine all rows vertically
m = top_rows + bottom_rows
Matrix.new(m)
end
def dot(b)
raise "Matrix dimensions don't match" unless self.cols == b.rows
result = []
@data.each do |row|
new_row = []
b.cols.times do |c|
col = b.data.map { |r| r[c] }
new_row << row.zip(col).map { |x, y| x * y }.sum
end
result << new_row
end
Matrix.new(result)
end
def *(b)
dot(b)
end
def +(b)
raise "Matrix dimensions don't match" unless self.shape == b.shape
rows, cols = self.rows, self.cols
result = []
rows.times do |i|
new_row = []
cols.times do |j|
new_row << @data[i][j] + b.data[i][j]
end
result << new_row
end
Matrix.new(result)
end
def -(b)
raise "Matrix dimensions don't match" unless self.shape == b.shape
rows, cols = self.rows, self.cols
result = []
rows.times do |i|
new_row = []
cols.times do |j|
new_row << @data[i][j] - b.data[i][j]
end
result << new_row
end
Matrix.new(result)
end
def strassen(b)
rows, cols = self.rows, self.cols
raise "Matrices must be square" unless rows == cols
raise "Matrices must be the same shape" unless self.shape == b.shape
raise "Shape must be a power of 2" unless rows > 0 && (rows & (rows - 1)) == 0
if rows == 1
return self.dot(b)
end
p = rows / 2
a11 = Matrix.new(@data[0...p].map { |row| row[0...p] })
a12 = Matrix.new(@data[0...p].map { |row| row[p..-1] })
a21 = Matrix.new(@data[p..-1].map { |row| row[0...p] })
a22 = Matrix.new(@data[p..-1].map { |row| row[p..-1] })
b11 = Matrix.new(b.data[0...p].map { |row| row[0...p] })
b12 = Matrix.new(b.data[0...p].map { |row| row[p..-1] })
b21 = Matrix.new(b.data[p..-1].map { |row| row[0...p] })
b22 = Matrix.new(b.data[p..-1].map { |row| row[p..-1] })
m1 = (a11 + a22).strassen(b11 + b22)
m2 = (a21 + a22).strassen(b11)
m3 = a11.strassen(b12 - b22)
m4 = a22.strassen(b21 - b11)
m5 = (a11 + a12).strassen(b22)
m6 = (a21 - a11).strassen(b11 + b12)
m7 = (a12 - a22).strassen(b21 + b22)
c11 = m1 + m4 - m5 + m7
c12 = m3 + m5
c21 = m2 + m4
c22 = m1 - m2 + m3 + m6
Matrix.block([[c11, c12], [c21, c22]])
end
def round(ndigits = nil)
rounded_data = @data.map do |row|
row.map do |element|
if ndigits
(element * (10 ** ndigits)).round / (10.0 ** ndigits)
else
element.round
end
end
end
Matrix.new(rounded_data)
end
def shape
cols = @data.empty? ? 0 : @data[0].length
Shape.new(@data.length, cols)
end
def rows
@data.length
end
def cols
@data.empty? ? 0 : @data[0].length
end
def to_s
@data.inspect
end
def inspect
@data.inspect
end
end
def examples
a = Matrix.new([
[1, 2],
[3, 4]
])
b = Matrix.new([
[5, 6],
[7, 8]
])
c = Matrix.new([
[1, 1, 1, 1],
[2, 4, 8, 16],
[3, 9, 27, 81],
[4, 16, 64, 256]
])
d = Matrix.new([
[4, -3, 4.0/3, -1.0/4],
[-13.0/3, 19.0/4, -7.0/3, 11.0/24],
[3.0/2, -2, 7.0/6, -1.0/4],
[-1.0/6, 1.0/4, -1.0/6, 1.0/24]
])
e = Matrix.new([
[1, 2, 3, 4],
[5, 6, 7, 8],
[9, 10, 11, 12],
[13, 14, 15, 16]
])
f = Matrix.new([
[1, 0, 0, 0],
[0, 1, 0, 0],
[0, 0, 1, 0],
[0, 0, 0, 1]
])
puts "Naive matrix multiplication:"
puts " a * b = #{a * b}"
puts " c * d = #{(c * d).round}"
puts " e * f = #{e * f}"
puts "Strassen's matrix multiplication:"
puts " a * b = #{a.strassen(b)}"
puts " c * d = #{c.strassen(d).round}"
puts " e * f = #{e.strassen(f)}"
end
if __FILE__ == $0
examples
end

View file

@ -0,0 +1,267 @@
# Helper function to create a matrix from nested blocks
proc block_matrix {blocks} {
set m {}
set num_hblocks [llength $blocks]
set num_vblocks [llength [lindex $blocks 0]]
# Determine dimensions
set block_height [llength [lindex [lindex $blocks 0] 0]]
set block_widths {}
for {set j 0} {$j < $num_vblocks} {incr j} {
lappend block_widths [llength [lindex [lindex [lindex $blocks 0] $j] 0]]
}
# Build the resulting matrix
for {set i 0} {$i < [expr {$block_height * $num_hblocks}]} {incr i} {
lappend m {}
}
for {set h 0} {$h < $num_hblocks} {incr h} {
set row_offset [expr {$h * $block_height}]
for {set i 0} {$i < $block_height} {incr i} {
set col_offset 0
for {set v 0} {$v < $num_vblocks} {incr v} {
set block [lindex [lindex $blocks $h] $v]
set block_width [lindex $block_widths $v]
for {set j 0} {$j < $block_width} {incr j} {
set row_idx [expr {$row_offset + $i}]
set col_idx [expr {$col_offset + $j}]
set value [lindex [lindex $block $i] $j]
# Extend row if needed
set current_row [lindex $m $row_idx]
while {[llength $current_row] <= $col_idx} {
lappend current_row 0
}
set current_row [lreplace $current_row $col_idx $col_idx $value]
set m [lreplace $m $row_idx $row_idx $current_row]
}
incr col_offset $block_width
}
}
}
return $m
}
# Matrix multiplication (naive)
proc matrix_multiply {a b} {
set rows_a [llength $a]
set cols_a [llength [lindex $a 0]]
set rows_b [llength $b]
set cols_b [llength [lindex $b 0]]
if {$cols_a != $rows_b} {
error "Incompatible matrix dimensions for multiplication"
}
set result {}
for {set i 0} {$i < $rows_a} {incr i} {
set row {}
for {set j 0} {$j < $cols_b} {incr j} {
set sum 0
for {set k 0} {$k < $cols_a} {incr k} {
set a_val [lindex [lindex $a $i] $k]
set b_val [lindex [lindex $b $k] $j]
set sum [expr {$sum + $a_val * $b_val}]
}
lappend row $sum
}
lappend result $row
}
return $result
}
# Matrix addition
proc matrix_add {a b} {
set rows [llength $a]
set cols [llength [lindex $a 0]]
if {$rows != [llength $b] || $cols != [llength [lindex $b 0]]} {
error "Matrices must have the same dimensions"
}
set result {}
for {set i 0} {$i < $rows} {incr i} {
set row {}
for {set j 0} {$j < $cols} {incr j} {
set a_val [lindex [lindex $a $i] $j]
set b_val [lindex [lindex $b $i] $j]
lappend row [expr {$a_val + $b_val}]
}
lappend result $row
}
return $result
}
# Matrix subtraction
proc matrix_subtract {a b} {
set rows [llength $a]
set cols [llength [lindex $a 0]]
if {$rows != [llength $b] || $cols != [llength [lindex $b 0]]} {
error "Matrices must have the same dimensions"
}
set result {}
for {set i 0} {$i < $rows} {incr i} {
set row {}
for {set j 0} {$j < $cols} {incr j} {
set a_val [lindex [lindex $a $i] $j]
set b_val [lindex [lindex $b $i] $j]
lappend row [expr {$a_val - $b_val}]
}
lappend result $row
}
return $result
}
# Get submatrix (using 0-based indexing internally, but interface expects 1-based)
proc get_submatrix {m start_row end_row start_col end_col} {
# Convert to 0-based indexing
incr start_row -1
incr end_row -1
incr start_col -1
incr end_col -1
set result {}
for {set i $start_row} {$i <= $end_row} {incr i} {
set row {}
for {set j $start_col} {$j <= $end_col} {incr j} {
lappend row [lindex [lindex $m $i] $j]
}
lappend result $row
}
return $result
}
# Check if number is power of 2
proc is_power_of_2 {n} {
if {$n <= 0} {return 0}
return [expr {($n & ($n - 1)) == 0}]
}
# Strassen's algorithm
proc strassen_multiply {a b} {
set n [llength $a]
set m [llength [lindex $a 0]]
if {$n != $m} {
error "Matrix must be square"
}
if {$n != [llength $b] || $n != [llength [lindex $b 0]]} {
error "Matrices must have the same dimensions"
}
# Check if size is a power of 2
if {![is_power_of_2 $n]} {
error "Matrix dimension must be a power of 2"
}
if {$n == 1} {
set val [expr {[lindex [lindex $a 0] 0] * [lindex [lindex $b 0] 0]}]
return [list [list $val]]
}
set half [expr {$n / 2}]
# Partition matrices into quadrants
set a11 [get_submatrix $a 1 $half 1 $half]
set a12 [get_submatrix $a 1 $half [expr {$half+1}] $n]
set a21 [get_submatrix $a [expr {$half+1}] $n 1 $half]
set a22 [get_submatrix $a [expr {$half+1}] $n [expr {$half+1}] $n]
set b11 [get_submatrix $b 1 $half 1 $half]
set b12 [get_submatrix $b 1 $half [expr {$half+1}] $n]
set b21 [get_submatrix $b [expr {$half+1}] $n 1 $half]
set b22 [get_submatrix $b [expr {$half+1}] $n [expr {$half+1}] $n]
# Calculate the seven products
set m1 [strassen_multiply [matrix_add $a11 $a22] [matrix_add $b11 $b22]]
set m2 [strassen_multiply [matrix_add $a21 $a22] $b11]
set m3 [strassen_multiply $a11 [matrix_subtract $b12 $b22]]
set m4 [strassen_multiply $a22 [matrix_subtract $b21 $b11]]
set m5 [strassen_multiply [matrix_add $a11 $a12] $b22]
set m6 [strassen_multiply [matrix_subtract $a21 $a11] [matrix_add $b11 $b12]]
set m7 [strassen_multiply [matrix_subtract $a12 $a22] [matrix_add $b21 $b22]]
# Calculate the four quadrants of the result
set c11 [matrix_add [matrix_subtract [matrix_add $m1 $m4] $m5] $m7]
set c12 [matrix_add $m3 $m5]
set c21 [matrix_add $m2 $m4]
set c22 [matrix_add [matrix_subtract [matrix_add $m1 $m3] $m2] $m6]
# Combine quadrants into a single matrix
return [block_matrix [list [list $c11 $c12] [list $c21 $c22]]]
}
# Round matrix values
proc matrix_round {m {digits {}}} {
set result {}
if {$digits ne ""} {
set mult [expr {pow(10, $digits)}]
}
for {set i 0} {$i < [llength $m]} {incr i} {
set row {}
for {set j 0} {$j < [llength [lindex $m 0]]} {incr j} {
set val [lindex [lindex $m $i] $j]
if {$digits ne ""} {
set rounded [expr {floor($val * $mult + 0.5) / $mult}]
} else {
set rounded [expr {floor($val + 0.5)}]
}
lappend row $rounded
}
lappend result $row
}
return $result
}
# Print matrix
proc print_matrix {name m} {
puts "$name = \{"
for {set i 0} {$i < [llength $m]} {incr i} {
puts -nonewline " \{"
set row [lindex $m $i]
for {set j 0} {$j < [llength $row]} {incr j} {
puts -nonewline [lindex $row $j]
if {$j < [expr {[llength $row] - 1}]} {
puts -nonewline ", "
}
}
puts "\}"
}
puts "\}"
}
# Examples
proc run_examples {} {
set a {{1 2} {3 4}}
set b {{5 6} {7 8}}
set c {{1 1 1 1} {2 4 8 16} {3 9 27 81} {4 16 64 256}}
set d {{4 -3 1.333333 -0.25} {-4.333333 4.75 -2.333333 0.458333} {1.5 -2 1.166667 -0.25} {-0.166667 0.25 -0.166667 0.041667}}
set e {{1 2 3 4} {5 6 7 8} {9 10 11 12} {13 14 15 16}}
set f {{1 0 0 0} {0 1 0 0} {0 0 1 0} {0 0 0 1}}
puts "Naive matrix multiplication:"
print_matrix " a * b" [matrix_multiply $a $b]
print_matrix " c * d" [matrix_round [matrix_multiply $c $d] 0]
print_matrix " e * f" [matrix_multiply $e $f]
puts "\nStrassen's matrix multiplication:"
print_matrix " a * b" [strassen_multiply $a $b]
print_matrix " c * d" [matrix_round [strassen_multiply $c $d] 0]
print_matrix " e * f" [strassen_multiply $e $f]
}
# Run examples
run_examples