Определитель квадратной матрицы n-го порядка.

type mas=array of integer;
     mtr=array[,]of real;
{процедура обмена двух переменных}
procedure swap(var n1, n2: integer);
var
  t: integer;
begin
  t := n1;
  n1 := n2;
  n2 := t
end;
 
{функция генерации следующей перестановки, используется алгоритм Нарайаны}
{возвращает true, если перестановка сгенерирована, и false в противном случае}
{сама перестановка возвращается через формальный параметр q}
function next(var q:mas): boolean;
var
  i, j, m: integer;
begin
  i := high(q);
  repeat dec(i) until (i = -1) or (q[i] < q[i + 1]);
  next := i > -1;
  if i > -1 then
    begin
      j := high(q) + 1;
      repeat dec(j) until q[i] < q[j]; {поиск j}
      swap(q[i], q[j]);
      for m := low(q) to (high(q) - i) div 2 - 1 do swap(q[i + 1 + m], q[high(q) - m])
    end
end;
 
{функция вычисления знака перестановки}
{при нечётном количестве инверсий возвращается -1, в противном случае возвращается 1}
function sign(const q: mas): real;
var
  i, j, k: integer;
begin
  k := 0;
  for i := low(q) to high(q) - 1 do
    for j := i + 1 to high(q) do
      if q[i] > q[j] then inc(k);
  if odd(k) then sign := -1 else sign := 1
end;
 
{основная программа}
var
  a:mtr; {матрица}
  p: mas; {массив для перестановок}
  n: integer; //счётчики, ранг матрицы
  t, z, d: real; //слагаемое, знак перестановки, определитель
 
begin
  //ввод ранга матрицы с проверкой
  repeat
    write('Введите ранг матрицы: ');
    readln(n)
  until n > 0;
  {установка размеров массивов}
  setlength(a, n, n); {установка размера матрицы}
  setlength(p, n); {установка размера массива для перестановок}
  {ввод матрицы}
  writeln('Введите матрицу, ', n, ' строк по ', n, ' чисел (через пробелы):');
  for var i := low(a) to high(a) do
    for var j := low(a) to high(a) do
      read(a[i, j]);
  readln;
  {контрольная печать матрицы}
  writeln('Матрица:');
  for var i := low(a) to high(a) do
    begin
      for var j := low(a) to high(a) do write(a[i, j]:12, ' ');
      writeln
    end;
  {вычисление определителя}
  d := 0; {пока определитель равен 0}
  for var i := low(p) to high(p) do p[i] := i; {начальная перестановка: ряд 0, 1, 2, ..., n-1}
  repeat {цикл по перестановкам}
    z := sign(p); {знак перестановки}
    for var i := low(a) to high(a) do {цикл добавления слагаемого согласно текущей перестановки}
      begin
        t := z; {очередное слагаемое пока равно знаку перестановки}
        for var j := low(p) to high(p) do t *= a[j, p[j]]; {цикл умножения слагаемого на соответствующие элементы}
      end;
    d += t {добавляем слагаемое к определителю}
  until not next(p); {ищем следующую перестановку, в случае неудачи выходим из цикла по перестановкам}
  write('Определитель = ', d);
  readln
end.