Kamis, 05 Januari 2012

Pr0gRam dEteRminaN MaTriks

program determinan;
uses wincrt;
var n,i,j,x,y,z,k,l,q,e: integer;
    o,m,p,d:real;
    a:array[1..20,1..20] of real;
    b,c:array[1..20]of real;
    ulang:char;
begin
repeat
clrscr;
writeln ('********************************************');
writeln ('WeLc0me tO The maRtix dEterMinanT');
writeln ('********************************************');
writeln;
write ('Ordo Matriks yang ingin di input (n x n) : ');
readln (n);
writeln ('Matriks yang akan di input :  Matriks (',n,' x ',n,')');
writeln;
writeln ('--------------------------------------------');
writeln ('Mulai Untuk Input Elemen Matriks Anda') ;
for i:=1 to n do
    begin
    for j:=1 to n do
        begin
        write ('Elemen A(',i,',',j,') : ');
        readln (a[i,j]);
        end;
    end;
clrscr;
writeln ('Bentuk Matriks Anda :');
for i:=1 to n do
    begin
    for j:=1 to n do
        write ('   ',a[i,j]:0:0);
    writeln;
    end;
writeln;

if (n=2) then 
writeln ('Determinan Matriks Anda = ',(a[1,1])*(a[2,2])-(a[1,2])*(a[2,1]):0:0)
else

begin
   for i:=1 to n do
       begin
       for j:=n+1 to n+(n-1) do
           begin
           a[i,j]:=a[i,j-n];
           end;
       end;
   for j:=1 to n do
       begin
       o:=1;
       q:=j-1;
       for z:=1 to n do
           begin
           q:=q+1;
           o:=o*a[z,q];
           end;
           b[j]:=o;
       end;
   for i:=n+(n-1) downto n-1 do
       begin
       o:=1;
       q:=i+1;
       for z:=1 to n do
           begin
           q:=q-1;
           o:=o*a[z,q];
           end;
       c[i]:=o;
       end;
   m:=0;
   p:=0;
   for j:=1 to n do
       m:=m+b[j];
   for i:=n+(n-1) downto n-1 do
       p:=p+c[i];
   d:=m-p; 
   writeln ('Determinan Matriks Anda = ',d:0:0);
end;
writeln;
write('Ingin mencari determinan dari matriks lain [y/t] : ' );
readln(ulang);
until (ulang='t') or (ulang='T');
clrscr;
writeln ('******************************************');
writeln ('tHank yOu for Using oUr prOgraM');
writeln ('                 @_@                      ');
writeln ('          STATISTIKA ITS 2011             ');
writeln ('******************************************');
end.

Tidak ada komentar:

Posting Komentar