93 lines
2.3 KiB
Plaintext
93 lines
2.3 KiB
Plaintext
! MATRIX ARITHMETIC ;
|
|
BEGIN
|
|
|
|
INTEGER PROCEDURE LENGTH(A); ARRAY A;
|
|
LENGTH := UPPERBOUND(A, 1) - LOWERBOUND(A, 1) + 1;
|
|
|
|
! Set MAT to the first minor of A dropping row X and column Y ;
|
|
PROCEDURE MINOR(A, X, Y, MAT); ARRAY A, MAT; INTEGER X, Y;
|
|
BEGIN
|
|
INTEGER I, J, rowA, M; M := LENGTH(A) - 1; ! not a constant;
|
|
FOR I := 1 STEP 1 UNTIL M DO BEGIN
|
|
rowA := IF I < X THEN I ELSE I + 1;
|
|
FOR J := 1 STEP 1 UNTIL M DO
|
|
MAT(I, J) := A(rowA, IF J < Y THEN J else J + 1);
|
|
END
|
|
END MINOR;
|
|
|
|
REAL PROCEDURE DET(A); REAL ARRAY A;
|
|
BEGIN
|
|
INTEGER N; N := LENGTH(A);
|
|
IF N = 1 THEN
|
|
DET := A(1, 1)
|
|
ELSE
|
|
BEGIN
|
|
INTEGER I, SIGN;
|
|
REAL SUM;
|
|
SIGN := 1;
|
|
FOR I := 1 STEP 1 UNTIL N DO
|
|
BEGIN
|
|
REAL ARRAY MAT(1:N-1, 1:N-1);
|
|
MINOR(A, 1, I, MAT);
|
|
SUM := SUM + SIGN * A(1, I) * DET(MAT);
|
|
SIGN := SIGN * -1
|
|
END;
|
|
DET := SUM
|
|
END
|
|
END DET;
|
|
|
|
REAL PROCEDURE PERM(A); REAL ARRAY A;
|
|
BEGIN
|
|
INTEGER N; N := LENGTH(A);
|
|
IF N = 1 THEN
|
|
PERM := A(1, 1)
|
|
ELSE
|
|
BEGIN
|
|
REAL SUM;
|
|
INTEGER I;
|
|
|
|
FOR I := 1 STEP 1 UNTIL N DO
|
|
BEGIN
|
|
REAL ARRAY MAT(1:N-1, 1:N-1);
|
|
MINOR(A, 1, I, MAT);
|
|
SUM := SUM + A(1, I) * PERM(MAT)
|
|
END;
|
|
PERM := SUM
|
|
END
|
|
END PERM;
|
|
|
|
INTEGER SIZE;
|
|
SIZE := ININT;
|
|
BEGIN
|
|
REAL ARRAY A(1:SIZE, 1:SIZE);
|
|
INTEGER I, J;
|
|
|
|
FOR I := 1 STEP 1 UNTIL SIZE DO BEGIN
|
|
! may be need here: INIMAGE;
|
|
FOR J := 1 STEP 1 UNTIL SIZE DO
|
|
A(I, J) := INREAL
|
|
END;
|
|
OUTTEXT("DETERMINANT ... : "); OUTREAL(DET (A), 10, 20); OUTIMAGE;
|
|
OUTTEXT("PERMANENT ..... : "); OUTREAL(PERM(A), 10, 20); OUTIMAGE;
|
|
END
|
|
|
|
COMMENT THE FIRST INPUT IS THE SIZE OF THE MATRIX, FOR EXAMPLE:
|
|
|
|
! 2
|
|
! 1 2
|
|
! 3 4
|
|
! DETERMINANT: -2.0
|
|
! PERMANENT: 10.0 ;
|
|
|
|
COMMENT
|
|
! 5
|
|
! 0 1 2 3 4
|
|
! 5 6 7 8 9
|
|
! 10 11 12 13 14
|
|
! 15 16 17 18 19
|
|
! 20 21 22 23 24
|
|
! DETERMINANT: 0.0
|
|
! PERMANENT: 6778800.0 ;
|
|
|
|
END
|