GAECHKA
Твоя помощница в решении задач

По схеме Гаусса вычислить определитель

По схеме Гаусса с выбором главного элемента вычислить определитель. Ответ записать с точностью до 10^-4
Матрица:
0.42 1.00 0.32 0.44
1.00 0.42 0.54 0.66
0.66 0.44 0.22 1.00
0.54 0.32 1.00 0.22
0
вопрос задан

Источник


2 ответа
Решение
Вроде так.
uses crt;
const n=4;
type TMatrix=array[1..n,1..n] of real;
procedure Per(k,n:integer;var a:Tmatrix; var p:integer);
//перестановка строк, если главный элемент=0
//k-номер проверяемой строки, n-размер, а-матрица, р-количество перестановок
var z:real;
    j,i:integer;
begin
z:=abs(a[k,k]);//модуль элемента главной диагонали в строке k
i:=k;//строка k
p:=0; //перестановок пока 0
for j:=k+1 to n-1 do//проверяем все строки ниже строки k
 begin
  if abs(a[j,k])>z then//если модуль элемента главной диагонали >z
   begin
    z:=abs(a[j,k]);//новое значение z
    i:=j; //номер строки для перестановки
   end;
 end;
if i>k then//если строка ниже k
 begin
  p:=p+1;//считаем перестановку
  for j:=k to n-1 do //меняем строки местами
   begin
    z:=a[i,j]; //здесь z уже другой смысл, это буфер для обмена
    a[i,j]:=a[k,j];
    a[k,j]:=z;
   end;
 end;
end;
function Znak(p:integer):integer;
//при перестановке меняется знак определителя, надо его отследить
begin
if p mod 2=0 then result:=1 //если четное число перестановок знак=1
else result:=-1;  //иначе знак=-1
end;
//вычисление определителя
procedure Opr(n:integer;var a:tmatrix;var det:real);
//n-размер, а-матрица, det-определитель
var k,i,j,p:integer;
    r:real;
begin
det:=1.0;
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-1 do
    a[j,i]:=a[j,i]-r*a[k,i];//вычитаем из каждого элемента строки j
   end;                      //произведение r на i элемент строки k
                                 //приводим матрицу к треугольному виду
  end;
end;
var i,j:integer;
    a:Tmatrix;
    det:real;
begin
clrscr;
a[1,1]:=0.42;a[1,2]:=1.00;a[1,3]:=0.32;a[1,4]:=0.44;
a[2,1]:=1.00;a[2,2]:=0.42;a[2,3]:=0.54;a[2,4]:=0.66;
a[3,1]:=0.66;a[3,2]:=0.44;a[3,3]:=0.22;a[3,4]:=1.00;
a[4,1]:=0.54;a[4,2]:=0.32;a[4,3]:=1.00;a[4,4]:=0.22;
writeln('Матрица');
for i:=1 to n do
 begin
  for j:=1 to n do
  write(a[i,j]:5:2);
  writeln;
 end;
Opr(n,a,det);//определитель системы
write('det=',det:0:4);
readln
end.
Все так и есть. Огромное спасибо<3