Прошу прощения, 100x100 я, наверное, не [до]считал
Однако, всё равно, даже если реализовывать прямой расчёт, то не нужно передавать рекурсивно в подпрограмму матрицы меньшего размера. Достаточно запоминать номера уже использованных строк/столбцов.
А вот моя программа (прямой расчёт):
Код:
const n = 10;
type matrix = array [1..n, 1..n] of real;
type tSP = ^tST;
tST = record
str, col, cnt, sign: integer;
arg: real;
prev: tSP;
end;
var SP: tSP;
procedure push (elem: tST);
var t: tSP;
begin
t := SP;
new (SP);
SP^ := elem;
SP^.prev := t;
end;
procedure pop (var elem: tST);
var t: tSP;
begin
elem := SP^;
t := SP;
SP := SP^.prev;
dispose (t);
end;
function stEmpty: boolean;
begin
stEmpty := (SP = nil);
end;
function InStackStr (str: integer): boolean;
var t: tSP;
begin
t := SP;
while t <> nil do begin
if t^.str = str then begin
InStackStr := true;
exit;
end;
t := t^.prev;
end;
InStackStr := false;
end;
function InStackCol (col: integer): boolean;
var t: tSP;
begin
t := SP;
while t <> nil do begin
if t^.col = col then begin
InStackCol := true;
exit;
end;
t := t^.prev;
end;
InStackCol := false;
end;
var matr: matrix;
str0: integer;
{ const matr0: matrix = ((1,2,4,6),(8,5,4,9),(3,1,7,2),(4,7,9,2)); }
function definitor: real;
var level: integer;
s: tST;
res: real;
procedure findCol;
var i, j: integer;
begin
i := s.cnt;
j := 1;
repeat
if not (InStackCol (j)) then
Dec (i);
if i = 0 then
break;
Inc (j);
until false;
s.col := j;
end;
procedure findStr;
var i: integer;
begin
i := 1;
while InStackStr (i) do
Inc (i);
s.str := i;
findCol;
end;
begin
level := n;
res := 0.0;
with s do begin
str := str0;
col := 1;
cnt := 1;
sign := 1;
arg := 1.0;
repeat
if level = n then
arg := matr [str, col] * sign
else
arg := arg * matr [str, col] * sign;
if level = 1 then begin
res := res + arg;
while not (stEmpty) and (cnt = level) do begin
pop (s);
Inc (level);
end;
if cnt <> level then begin
Inc (cnt);
sign := -sign;
findCol;
if level <> n then
arg := prev^.arg;
end else
if cnt = n then
break;
end else begin
push (s);
cnt := 1;
sign := 1;
Dec (level);
findStr;
end;
until false;
end;
definitor := res;
end;
var i, j: integer;
begin
randomize;
str0 := 1;
for i := 1 to n do
for j := 1 to n do
matr [i, j] := round (random (10));
{ matr := matr0; }
writeln ('Start !!!');
writeln (definitor: 12: 0);
for i := 1 to n do begin
for j := 1 to n do
write (matr [i, j]: 2: 0);
writeln;
end;
end.
. Может я иду не тем путём? 
