Как найти определитель матрицы паскаль

program opred;
uses crt;
const n=3;
type
   Tmatr=array [1..n,1..n] of real;
var a:Tmatr;
    det:real;//определитель
//процедура перестановки строк, чтобы главный элемент не оказался 
//нолем или близким к нулю значением
procedure Per(k,n:integer;var a:Tmatr; var p:integer);
var i,j:integer;z:real;
begin
   z:=a[k,k];i:=k;p:=0; //после каждого преобразования
   for j:=k+1 to n do   //ищем по оставшимся строкам
     begin
       if abs(a[j,k])>z then //максимальный по модулю элемент
          begin
            z:=abs(a[j,k]);i:=j; //запоминаем номер строки
            p:=p+1;//считаем количество перестановок, т.к. при каждой 
                    //перестановке меняется знак определителя
          end;
     end;
   if i>k then  //если эта строка ниже данной
   for j:=k to n do
     begin
       z:=a[i,j];a[i,j]:=a[k,j];a[k,j]:=z;//перестановка
     end;
end;
function znak(p:integer):integer;//ф-я определения знака определителя
begin
if p mod 2=0 then //если четное количество перестановок, "+" , если нет "-"
znak:=1 else znak:=-1;
end;
procedure opr(n:integer;var a:Tmatr;var det:real);//собственно определитель
var k,i,j,p:integer;
    r:real;
begin
det:=1;
for k:=1 to n do  //считаем по алгоритму, который во всех учебниках 
   begin
     if a[k,k]=0 then per(k,n,a,p);//если главный элемент=0, делаем перестановку
     det:=znak(p)*det*a[k,k]; //меняем знак определителя
     for j:=k+1 to n do  //делаем преобразования
       begin
         r:=a[j,k]/a[k,k];
         for i:=k to n do
           begin
             a[j,i]:=a[j,i]-r*a[k,i];
           end;
       end;
   end;
end;
begin  //основная программа
clrscr;
//здесь напишете ввод как Вам больше нравится
opr(n,a,det);
write('opr=',det:4:0);
readln
end.

Вычисление произведения “сцепленных” матриц.

Например:
(2, 3) Х (3, 3) = (2, 3)
(3, 2) Х (2, 5) = (3, 5)

Type
  TType = Integer;
Const
  nRowFirst  = 3; { Количество строк первой матрицы }
  nCommon    = 2; { Количество столбцов первой и строк второй матрицы }
  nColSecond = 5; { Количество столбцов второй матрицы }
Type
  TFirst = { Тип данных для хранения первой матрицы }
    Array[1 .. nRowFirst, 1 .. nCommon] Of TType; 
  TSecond = { Тип данных для хранения второй матрицы }
    Array[1 .. nCommon, 1 .. nColSecond] Of TType; 
  TResult = { Тип данных для хранения результата }
    Array[1 .. nRowFirst, 1 .. nColSecond] Of TType; 
{ Собственно процедура перемножения матриц: (res) = (a) X (B) }
Procedure matrixMult(Var res: TResult;
          a: TFirst; b: TSecond);
  Var i, j, k: Integer;
  Begin
    For i := 1 To nRowFirst Do
      For j := 1 To nColSecond Do
        Begin
          res[i, j] := 0;
          For k := 1 To nCommon Do
            res[i, j] := res[i, j] + a[i, k] * b[k, j];
        End
  End;
var
  iRow, iCol: Integer;
  m1: TFirst; m2: TSecond;
  mr: TResult;
begin
  WriteLn('Ввод первой матрицы: (', nRowFirst, 'x', nCommon, ')');
  For iRow := 1 To nRowFirst Do
    For iCol := 1 To nCommon Do
      Begin
        Write('m1[', iRow, ',', iCol,'] : ');
        ReadLn(m1[iRow, iCol])
      End;
  WriteLn('Ввод второй матрицы: (', nCommon, 'x', nColSecond, ')');
  For iRow := 1 To nCommon Do
    For iCol := 1 To nColSecond Do
      Begin
        Write('m2[', iRow, ',', iCol,'] : ');
        ReadLn(m2[iRow, iCol])
      End;
  matrixMult(mr, m1, m2); { Вызов процедуры перемножения }
  WriteLn('Результирующая матрица: (', nRowFirst, 'x', nColSecond, ')');
  For iRow := 1 To nRowFirst Do
    Begin
      For iCol := 1 To nColSecond Do
        Write(mr[iRow, iCol]:4);
      WriteLn
    End;
end.

Вычисление детерминанта (определителя) матрицы с помощью рекурсии.

Const
  max_n = 4;
Type
  matrix = Array[1 .. max_n, 1 .. max_n] Of real;
{ Матрица, для которой будет вычисляться определитель }
Const 
 a: matrix =
   ((2, 9, 9, 4),
    (2, -3, 12, 8),
    (4, 8, 3, -5),
    (1, 2, 6, 4));
function minusOne(n: integer): integer;
  begin
    minusOne := (1 - 2*Byte(Odd(n)));
  end;
function get_addr(i, j: integer;
         const n: integer): integer;
  begin
    get_addr := pred(i) * n + j
  end;
{ Рекурсивное определение определителя }
Function det(Var p; Const n: integer): real;
  Type
    matrix = Array[1 .. max_n * max_n] Of real;
  Var
    my_p: matrix Absolute p;
    pp: ^matrix;
    s: real;
    i, j, curr: integer;
  Begin
    s := 0.0;
    If n = 2 Then
      Begin
        det := my_p[1]*my_p[4] - my_p[2]*my_p[3]; exit
      End;
    For i := 1 To n Do
      Begin
        GetMem(pp, Sqr(Pred(n)) * SizeOf(real));
        curr := 1;
        For j := 1 To n Do
          If j <> i Then
            Begin
              move(my_p[get_addr(j, 2, n)], pp^[get_addr(curr, 1, Pred(n))],
                   pred(n) * SizeOf(real));
              inc(curr);
            End;
        s := s + minusOne(Succ(i)) * my_p[get_addr(i, 1, n)] *
                 det(pp^, Pred(n));
        FreeMem(pp, Sqr(Pred(n)) * SizeOf(real))
      End;
    det := s
  End;
begin
  WriteLn( det(a, 4):0:0 );
end.

Скачать:
 REC_DET.PAS ( 1.28 килобайт )
Кол-во скачиваний: 1346