Výpočet determinantu do 10

Delphi & Pascal (česká wiki)
Přejít na: navigace, hledání
Kategória: KMP (Klub mladých programátorov)

Autor: Marián Šagát
Program: Determinant_s.pas
Súbor exe: Determinant_s.exe

Výpočet determinantu do 10. stupňa (vlastne ľubovoľného stupňa, ten určuje len koštanta zadaná vo vzoráku, volil som 10). Výpočet spočíva v upravení štvorcovej matice na horno-trojuholníkový tvar, z ktorého sa determinant ľahko určí.
{ DETERMINANT_S.PAS                                                 }
{ Výpočet determinantu do 10. stupňa (vlastne ľubovoľného stupňa,   }
{ ten určuje len koštanta zadaná vo vzoráku, volil som 10:)).       }
{ Výpočet spočíva v upravení štvorcovej matice na horno-trojuholníkový }
{ tvar, z ktorého sa determinant ľahko určí.                        }
{                                                                   }
{ Author: Unknown                                                   }
{ Datum: 12.10.2009                            http://www.trsek.com }
 
program determinant;
const b=10;
      c=10;
      nenulova_konstanta=1;
var A:array[0..b+1,1..c] of real;
    m,n,i,j,k,l,prz,znamienko:integer;  {prz je pocet riadkovych zamen}
    D,P:real;
begin
repeat writeln('zadaj rozmery stupen matice mensi nez',b,' !');
       readln(n);
        until (n<b) or(n=b);
m:=n;
D:=1;{inicializujem to hned, lebo ak prebehnne if i=n+1 potom D:=0, co je konecny vysledok!}
for i:=1 to n do begin {naplnenie matice}
    writeln('zadaj ',i,'-ty ',n,' prvkovy riadok');
    for j:=1 to m do begin
                      read(A[i,j]);
                     end;
                     readln;
                 end;
for i:=1 to n do begin  {vypis matice}
    for j:=1 to m do begin
                      write((A[i,j]):4:0);
                     end;
    writeln;
                 end;
 writeln;
 
{_____________________________________________}
 
prz:=0;
 
{v n+1-tom riadku su same nuly-potrebujem tam nenulove zarazky na testovnie v i-tom stlpci,lebo ...until <>0 ! :D}
for i:=1 to m do
      A[n+1,i]:=nenulova_konstanta;
for i:=1 to n do  begin
  l:=(i-1);
                             repeat l:=l+1 until A[l,i]<>0;
                           if (i<l)and (l<n+1) then begin
                                            A[0]:=A[i];
                                            A[i]:=A[l];
                                            A[l]:=A[0];
                                            prz:=prz+1;
                                           end;
 
                           if l=n+1 then begin {treba to urobit, aby som nemusel pouzit 'go to',takym
                            inic. indexov na hranicne moznosti hned cyklus skonci!}
                                          i:=n;
                                          j:=1;
                                          k:=n;
                                          D:=0;
                                          l:=0;
                                         end;
{if l:=i tak sa iba matica upravuje na troj bez zameny riadkov!}
 
    for k:=i+1 to n do
    for j:=n downto 1 do begin
 
                           P:=A[i,j]/A[i,i];
                           P:=P*(-1)*A[k,i];
                           P:=P+A[k,j];
                           A[k,j]:=P;
                         end;
 
       end;{ku inicial. l-ka}
 
{_____________________________________________}
writeln('vypis matice upravenej na trojuholnikovy tvar:');
for i:=1 to n do begin  {vypis matice}
    for j:=1 to m do begin
                      write((A[i,j]):4:0);
                     end;
    writeln;
                 end;
writeln;
 
for i:=1 to n do
    D:=D*A[i,i];
if (prz mod 2 <>0) then znamienko:=-1
                   else znamienko:=1;
D:=D*znamienko;
writeln('determinant danej matice je D(A) = ',D:4:2);
readln;
end.