'************************************************************* '* This program calculates the determinant of a real square * '* matrix using subroutines based on Kramer's formula. * '* --------------------------------------------------------- * '* Method: * '* * '* Let us take the example: * '* n=5 * '* Input matrix is: ( 3 2 1 6 3 ) * '* ( 6 4 4 0 3 ) * '* ( 4 0 1 0 2 ) * '* ( 3 4 2 4 2 ) * '* ( 4 6 1 5 2 ) * '* * '* According to Kramer's rule, the determinant det(A) is * '* calculated by the following: * '* * '* (4 4 0 3) (6 4 0 3) (6 4 0 3) * '* det = 3 * det(0 1 0 2) -2 * det(4 1 0 2) + 1 * (4 0 0 2) * '* (4 2 4 2) (3 2 4 2) (3 4 4 2) * '* (6 1 5 2) (4 1 5 2) (4 6 5 2) * '* * '* (6 4 4 3) (6 4 4 0) * '* -6 * det(4 0 1 2) +3 * det(4 0 1 0) * '* (3 4 2 2) (3 4 2 4) * '* (4 6 1 2) (4 6 1 5) * '* * '* As can be seen, 3, -2, 1, -6 and 3 are the elements of * '* the 1st row alternatively multiplied by 1 or -1 and the * '* the submatrices are obtained by successively eliminating * '* row=1 and column=1, then row=1 and col=2, etc. Then you * '* can calculate the determinants of these submatrices by * '* using the subroutine corresponding to the appropriate * '* size of n, and so forth... * '* When n=2, the result is immediate by the formula: * '* A(1,1)*A(2,2)-A(2,1)*A(1,2). * '* * '* Program organization: * '* After input of given square matrix A, here of size n=9, * '* we call the appropriate subroutine (here 900) which * '* returns det9 the value of determinant for n=9. * '* An auxiliary subroutine is (here 850) that extracts sub- * '* matrix B8 from B9 by eliminating row 1 and column col. * '* The subroutine 900 calls subroutine 800 which calls 700, * '* etc. until subroutine 200 (for n=2). * '* Note: in C++, pascal or Fortran 90, the function Deter * '* calls itself recursively with decreasing values for n, * '* this is not feasible in BASIC. * '* * '* SAMPLE RUN: * '* * '* n = 9 * '* Det = -1008796 * '* * '* --------------------------------------------------------- * '* * '* BASIC release by Jean-Pierre Moreau, Paris. * '* (www.jpmoreau.fr) * '************************************************************* 'Note: do not use for n > 9 'Program Deter DEFINT I-N isize = 9 DIM A(isize, isize) DIM B2(2, 2), B3(3, 3), B4(4, 4), B5(5, 5), B6(6, 6), B7(7, 7), B8(8, 8) DIM B9(9, 9) A(1, 1) = 0: A(1, 2) = 0: A(1, 3) = 6: A(1, 4) = 1: A(1, 5) = 1: A(1, 6) = 4 A(1, 7) = 2: A(1, 8) = 1: A(1, 9) = 2 A(2, 1) = 6: A(2, 2) = 2: A(2, 3) = 5: A(2, 4) = 2: A(2, 5) = 4: A(2, 6) = 5 A(2, 7) = 5: A(2, 8) = 2: A(2, 9) = 1 A(3, 1) = 6: A(3, 2) = 2: A(3, 3) = 5: A(3, 4) = 6: A(3, 5) = 3: A(3, 6) = 6 A(3, 7) = 5: A(3, 8) = 0: A(3, 9) = 0 A(4, 1) = 5: A(4, 2) = 4: A(4, 3) = 3: A(4, 4) = 1: A(4, 5) = 4: A(4, 6) = 4 A(4, 7) = 6: A(4, 8) = 4: A(4, 9) = 6 A(5, 1) = 3: A(5, 2) = 4: A(5, 3) = 6: A(5, 4) = 4: A(5, 5) = 2: A(5, 6) = 0 A(5, 7) = 4: A(5, 8) = 6: A(5, 9) = 5 A(6, 1) = 4: A(6, 2) = 2: A(6, 3) = 0: A(6, 4) = 4: A(6, 5) = 1: A(6, 6) = 6 A(6, 7) = 1: A(6, 8) = 1: A(6, 9) = 3 A(7, 1) = 1: A(7, 2) = 1: A(7, 3) = 4: A(7, 4) = 5: A(7, 5) = 5: A(7, 6) = 0 A(7, 7) = 0: A(7, 8) = 0: A(7, 9) = 0 A(8, 1) = 2: A(8, 2) = 5: A(8, 3) = 5: A(8, 4) = 0: A(8, 5) = 0: A(8, 6) = 0 A(8, 7) = 0: A(8, 8) = 1: A(8, 9) = 4 A(9, 1) = 4: A(9, 2) = 4: A(9, 3) = 6: A(9, 4) = 2: A(9, 5) = 3: A(9, 6) = 2 A(9, 7) = 5: A(9, 8) = 5: A(9, 9) = 3 n = 9 CLS PRINT PRINT " n = "; n IF n < 3 OR n > 9 THEN PRINT PRINT " size must be > 2 and < 10" PRINT " no action." END ELSE PRINT PRINT " Computing determinant..." END IF FOR i = 1 TO n FOR j = 1 TO n IF n = 3 THEN B3(i, j) = A(i, j) ELSEIF n = 4 THEN B4(i, j) = A(i, j) ELSEIF n = 5 THEN B5(i, j) = A(i, j) ELSEIF n = 6 THEN B6(i, j) = A(i, j) ELSEIF n = 7 THEN B7(i, j) = A(i, j) ELSEIF n = 8 THEN B8(i, j) = A(i, j) ELSEIF n = 9 THEN B9(i, j) = A(i, j) END IF NEXT j NEXT i IF n = 3 THEN GOSUB 300: det = det3 'call deter (n=3) ELSEIF n = 4 THEN GOSUB 400: det = det4 'call deter (n=4) ELSEIF n = 5 THEN GOSUB 500: det = det5 'call deter (n=5) ELSEIF n = 6 THEN GOSUB 600: det = det6 'call deter (n=6) ELSEIF n = 7 THEN GOSUB 700: det = det7 'call deter (n=7) ELSEIF n = 8 THEN GOSUB 800: det = det8 'call deter (n=8) ELSEIF n = 9 THEN GOSUB 900: det = det9 'call deter (n=9) END IF PRINT PRINT " Det = "; det END 200 'calculate determinant for n=2 det2 = B2(1, 1) * B2(2, 2) - B2(2, 1) * B2(1, 2) RETURN 300 'calculate determinant for n=3 B2(1, 1) = B3(2, 2): B2(1, 2) = B3(2, 3) B2(2, 1) = B3(3, 2): B2(2, 2) = B3(3, 3) GOSUB 200: det3 = B3(1, 1) * det2 B2(1, 1) = B3(2, 1): B2(1, 2) = B3(2, 3) B2(2, 1) = B3(3, 1): B2(2, 2) = B3(3, 3) GOSUB 200: det3 = det3 - B3(1, 2) * det2 B2(1, 1) = B3(2, 1): B2(1, 2) = B3(2, 2) B2(2, 1) = B3(3, 1): B2(2, 2) = B3(3, 2) GOSUB 200: det3 = det3 + B3(1, 3) * det2 RETURN 400 'calculate determinant for n=4 B3(1, 1) = B4(2, 2): B3(1, 2) = B4(2, 3): B3(1, 3) = B4(2, 4) B3(2, 1) = B4(3, 2): B3(2, 2) = B4(3, 3): B3(2, 3) = B4(3, 4) B3(3, 1) = B4(4, 2): B3(3, 2) = B4(4, 3): B3(3, 3) = B4(4, 4) GOSUB 300: det4 = B4(1, 1) * det3 B3(1, 1) = B4(2, 1): B3(1, 2) = B4(2, 3): B3(1, 3) = B4(2, 4) B3(2, 1) = B4(3, 1): B3(2, 2) = B4(3, 3): B3(2, 3) = B4(3, 4) B3(3, 1) = B4(4, 1): B3(3, 2) = B4(4, 3): B3(3, 3) = B4(4, 4) GOSUB 300: det4 = det4 - B4(1, 2) * det3 B3(1, 1) = B4(2, 1): B3(1, 2) = B4(2, 2): B3(1, 3) = B4(2, 4) B3(2, 1) = B4(3, 1): B3(2, 2) = B4(3, 2): B3(2, 3) = B4(3, 4) B3(3, 1) = B4(4, 1): B3(3, 2) = B4(4, 2): B3(3, 3) = B4(4, 4) GOSUB 300: det4 = det4 + B4(1, 3) * det3 B3(1, 1) = B4(2, 1): B3(1, 2) = B4(2, 2): B3(1, 3) = B4(2, 3) B3(2, 1) = B4(3, 1): B3(2, 2) = B4(3, 2): B3(2, 3) = B4(3, 3) B3(3, 1) = B4(4, 1): B3(3, 2) = B4(4, 2): B3(3, 3) = B4(4, 3) GOSUB 300: det4 = det4 - B4(1, 4) * det3 RETURN 450 'return icolth submatrix of B5 in B4 FOR ii = 1 TO 4 iflag = 0 FOR jj = 1 TO 4 IF jj <> icol THEN IF iflag = 0 THEN B4(ii, jj) = B5(ii + 1, jj) ELSE B4(ii, jj) = B5(ii + 1, jj + 1) END IF ELSE iflag = 1 B4(ii, jj) = B5(ii + 1, jj + 1) END IF NEXT jj NEXT ii RETURN 500 'calculate determinant for n=5 icol = 1: GOSUB 450: GOSUB 400: det5 = B5(1, 1) * det4 icol = 2: GOSUB 450: GOSUB 400: det5 = det5 - B5(1, 2) * det4 icol = 3: GOSUB 450: GOSUB 400: det5 = det5 + B5(1, 3) * det4 icol = 4: GOSUB 450: GOSUB 400: det5 = det5 - B5(1, 4) * det4 icol = 5: GOSUB 450: GOSUB 400: det5 = det5 + B5(1, 5) * det4 RETURN 550 'return icolth submatrix of B6 in B5 FOR ii = 1 TO 5 iflag = 0 FOR jj = 1 TO 5 IF jj <> icol THEN IF iflag = 0 THEN B5(ii, jj) = B6(ii + 1, jj) ELSE B5(ii, jj) = B6(ii + 1, jj + 1) END IF ELSE iflag = 1 B5(ii, jj) = B6(ii + 1, jj + 1) END IF NEXT jj NEXT ii RETURN 600 'calculate determinant for n=6 icol = 1: GOSUB 550: GOSUB 500: det6 = B6(1, 1) * det5 icol = 2: GOSUB 550: GOSUB 500: det6 = det6 - B6(1, 2) * det5 icol = 3: GOSUB 550: GOSUB 500: det6 = det6 + B6(1, 3) * det5 icol = 4: GOSUB 550: GOSUB 500: det6 = det6 - B6(1, 4) * det5 icol = 5: GOSUB 550: GOSUB 500: det6 = det6 + B6(1, 5) * det5 icol = 6: GOSUB 550: GOSUB 500: det6 = det6 - B6(1, 6) * det5 RETURN 650 'return icolth submatrix of B7 in B6 FOR ii = 1 TO 6 iflag = 0 FOR jj = 1 TO 6 IF jj <> icol THEN IF iflag = 0 THEN B6(ii, jj) = B7(ii + 1, jj) ELSE B6(ii, jj) = B7(ii + 1, jj + 1) END IF ELSE iflag = 1 B6(ii, jj) = B7(ii + 1, jj + 1) END IF NEXT jj NEXT ii RETURN 700 'calculate determinant for n=7 icol = 1: GOSUB 650: GOSUB 600: det7 = B7(1, 1) * det6 icol = 2: GOSUB 650: GOSUB 600: det7 = det7 - B7(1, 2) * det6 icol = 3: GOSUB 650: GOSUB 600: det7 = det7 + B7(1, 3) * det6 icol = 4: GOSUB 650: GOSUB 600: det7 = det7 - B7(1, 4) * det6 icol = 5: GOSUB 650: GOSUB 600: det7 = det7 + B7(1, 5) * det6 icol = 6: GOSUB 650: GOSUB 600: det7 = det7 - B7(1, 6) * det6 icol = 7: GOSUB 650: GOSUB 600: det7 = det7 + B7(1, 7) * det6 RETURN 750 'return icolth submatrix of B8 in B7 FOR ii = 1 TO 7 iflag = 0 FOR jj = 1 TO 7 IF jj <> icol THEN IF iflag = 0 THEN B7(ii, jj) = B8(ii + 1, jj) ELSE B7(ii, jj) = B8(ii + 1, jj + 1) END IF ELSE iflag = 1 B7(ii, jj) = B8(ii + 1, jj + 1) END IF NEXT jj NEXT ii RETURN 800 'calculate determinant for n=8 icol = 1: GOSUB 750: GOSUB 700: det8 = B8(1, 1) * det7 icol = 2: GOSUB 750: GOSUB 700: det8 = det8 - B8(1, 2) * det7 icol = 3: GOSUB 750: GOSUB 700: det8 = det8 + B8(1, 3) * det7 icol = 4: GOSUB 750: GOSUB 700: det8 = det8 - B8(1, 4) * det7 icol = 5: GOSUB 750: GOSUB 700: det8 = det8 + B8(1, 5) * det7 icol = 6: GOSUB 750: GOSUB 700: det8 = det8 - B8(1, 6) * det7 icol = 7: GOSUB 750: GOSUB 700: det8 = det8 + B8(1, 7) * det7 icol = 8: GOSUB 750: GOSUB 700: det8 = det8 - B8(1, 8) * det7 RETURN 850 'return icolth submatrix of B9 in B8 FOR ii = 1 TO 8 iflag = 0 FOR jj = 1 TO 8 IF jj <> icol THEN IF iflag = 0 THEN B8(ii, jj) = B9(ii + 1, jj) ELSE B8(ii, jj) = B9(ii + 1, jj + 1) END IF ELSE iflag = 1 B8(ii, jj) = B9(ii + 1, jj + 1) END IF NEXT jj NEXT ii RETURN 900 'calculate determinant for n=9 icol = 1: GOSUB 850: GOSUB 800: det9 = B9(1, 1) * det8 icol = 2: GOSUB 850: GOSUB 800: det9 = det9 - B9(1, 2) * det8 icol = 3: GOSUB 850: GOSUB 800: det9 = det9 + B9(1, 3) * det8 icol = 4: GOSUB 850: GOSUB 800: det9 = det9 - B9(1, 4) * det8 icol = 5: GOSUB 850: GOSUB 800: det9 = det9 + B9(1, 5) * det8 icol = 6: GOSUB 850: GOSUB 800: det9 = det9 - B9(1, 6) * det8 icol = 7: GOSUB 850: GOSUB 800: det9 = det9 + B9(1, 7) * det8 icol = 8: GOSUB 850: GOSUB 800: det9 = det9 - B9(1, 8) * det8 icol = 9: GOSUB 850: GOSUB 800: det9 = det9 + B9(1, 9) * det8 RETURN 'end of file deter2.bas