SOURCE CODE MAKE MATRIK

Program TLMatrik;
uses wincrt;
type matrik = array [1..20,1..20] of integer;
var
   i, j                                                                 : integer;
   barisa, koloma, barisb, kolomb, baris1, kolom1, baris2, kolom2, pil  : integer;
   matrika, matrikb, matrik1, matrik2                                   : matrik;
   pilihan                : char;
Procedure Identitas;
{prosedur untuk menampilkan biodata pembuat program}
begin
writeln(' ========================================= ');
writeln('|                                         |');
writeln('| PROGRAM INI DIBUAT OLEH :               |');
writeln('|                                         |');
writeln('|-----------------------------------------|');
writeln('|                                         |');
writeln('| Nama              : Riky                |');
writeln('| NIM               : M0508117            |');
writeln('| Nama Program      : Program Matrik      |');
writeln('| Tanggal pembuatan : 23 Februari 2008    |');
writeln('|                                         |');
writeln(' ========================================= ');
readln;
end;
Procedure Bacadataa;
{prosedur untuk input data manual matrik pertama}
begin
writeln('Memasukkan input data secara manual');
writeln('Masukkan ordo matrik A');
write('Jumlah baris : '); readln(barisa);
write('Jumlah kolom : '); readln(koloma);
end;
Procedure Bacadatab;
{prosedur untuk input data manual matrik kedua}
begin
writeln('Memasukkan input data secara manual');
writeln('Masukkan ordo matrik B');
write('Jumlah baris : '); readln(barisb);
write('Jumlah kolom : '); readln(kolomb);
end;
Procedure buatdata1;
{prosedur untuk input data random matrik pertama}
begin
writeln('Anda memilih input data random');
writeln('Masukan ordo matrik 1');
write('Jumlah baris : '); readln(baris1);
write('Jumlah kolom : '); readln(kolom1);      
writeln;
end;
Procedure buatdata2;
{prosedur untuk input data random matrik pertama}
begin
writeln('Masukan ordo matrik 2');
write('Jumlah baris : '); readln(baris2);
write('Jumlah kolom : '); readln(kolom2);      
writeln;
end;
Procedure matrikmanuala;
{prosedur unutk membuat matrik A dengan input manual}
begin
for i:= 1 to barisa do
    for j:= 1 to koloma do
    begin
  writeln('Masukan data untuk matrik A : ');
  write('matrik [',i,',',j,'] = ');readln(matrika[i,j]);
    end;
end;
Procedure matrikmanualb;
{prosedur untuk membuat matrik B dengan input manual}
begin
for i:= 1 to barisb do
    for j:= 1 to kolomb do
    begin
  writeln('Masukan data untuk matrik B : ');
  write('matrik [',i,',',j,'] = ');readln(matrikb[i,j]);
    end;
end;
Procedure cetakmatrika;
{prosedur unutk mencetak matrik A input manual}
begin
writeln('tampilan matrik A adalah');readln;
for i:= 1 to barisa do
    begin
        for j:= 1 to koloma do
        write(matrika[i,j],'  ':15);
        writeln;
    end;
end;
Procedure cetakmatrikb;
{prosedur untuk mencetak matrik B input manual}
begin
writeln('tampilan matrik B adalah');readln;
writeln;
for i:= 1 to barisb do
    begin
        for j:= 1 to kolomb do
        write(matrikb[i,j],'  ':15);
        writeln;
    end;
end;
Procedure random1;
{prosedur untuk membuat matrik dengan cara random}
var i,j : integer;
begin
randomize;
    for i:= 1 to baris1 do
  for j:= 1 to kolom1 do
        begin
        matrik1[i,j]:=random(20);
  end;
end;
Procedure random2;
{prosedur unutk membuat matrik dengan cara random}
var i,j : integer;
begin
randomize;
    for i:= 1 to baris2 do
  for j:= 1 to kolom2 do
  begin
        matrik2[i,j]:=random (20);
        end;
end;
Procedure cetakmatrik1;
{prosedur untuk mencetak matrik 1 dengan input random}
begin
writeln;
writeln('tampilan matrik 1 adalah'); readln;
    for i:= 1 to baris1 do
    begin
        for j:= 1 to kolom1 do
        write(matrik1[i,j],'  ':15);
        writeln;
 end;
readln;
end;
Procedure cetakmatrik2;
{prosedur untuk mencetak matrik 2 dengan input manual}
begin
writeln;
writeln('tampilan matrik 2 adalah');readln;
writeln;
    for i:= 1 to baris2 do
  begin
        for j:= 1 to kolom2 do
            write(matrik2[i,j],'  ':15);
            writeln;
        end;
readln;
end;
Procedure jumlahmatrikm(matrika,matrikb:matrik;barisa,koloma,barisb,kolomb :integer);
{prosedur untuk menjumlahkan matrik dengan input manual}
var i,j : integer;
    hsl : matrik;
begin
if (barisa=barisb) and (koloma=kolomb) then {mengecek apakah matrik tersebut bujur sangkar}
 begin
 writeln('Hasil penjumlahan matrik adalah');
 for i:=1 to barisa do
  begin
  for j:=1 to koloma do
   begin
   hsl[i,j]:=matrika[i,j]+matrikb[i,j];        
   end;
  end;
 end;
if (barisa=barisb) and (koloma=kolomb) then {mengecek apakah matrik tersebut bujur sangkar}
 for i:= 1 to barisa do {mencetak hasil penjumlahan}
        begin
        for j:= 1 to koloma do
   write(hsl[i,j],'  ':15);
            writeln;
        end
else writeln('Matrik tidak dapat dijumlahkan karena dimensinya tidak cocok');
end;
Procedure jumlahmatrikr(matrik1,matrik2:matrik;baris1,kolom1,baris2,kolom2 :integer);
{prosedur untuk menjumlahkan matrik dengan input random}
var i,j : integer;
    hsl : matrik;
begin
if (baris1=baris2) and (kolom1=kolom2) then {mengecek apakah matrik tersebut bujur sangkar}
 begin
 writeln('Hasil penjumlahan matrik adalah');
 for i:=1 to baris1 do
  begin
  for j:=1 to kolom1 do
   begin
   hsl[i,j]:=matrik1[i,j]+matrik2[i,j];        
            end;
  end;
   end;
  
if (baris1=baris2) and (kolom1=kolom2) then {mengecek apakah matrik tersebut bujur sangkar}
 for i:= 1 to baris1 do {mencetak hasil penjumlahan}
  begin
        for j:= 1 to kolom1 do
   write(hsl[i,j],'  ');
            writeln;
        end
else writeln('Matrik tidak dapat dijumlahkan karena dimensinya tidak cocok')
end;
Procedure kurangmatrikm(matrika,matrikb:matrik;barisa,koloma,barisb,kolomb :integer);
{prosedur untuk mengurangkan matrik dengan input manual}
var i,j : integer;
    hsl : matrik;
begin
if (barisa=barisb) and (koloma=kolomb) then {mengecek apakah matrik tersebut bujur sangkar}
 begin
 writeln('Hasil pengurangan matrik adalah');
 for i:=1 to barisa do
  begin
  for j:=1 to koloma do
   begin
   hsl[i,j]:=matrika[i,j]-matrikb[i,j];        
   end;
  end;
 end;

if (barisa=barisb) and (koloma=kolomb) then {mengecek apakah matrik tersebut bujur sangkar}
 for i:= 1 to barisa do {mencetak hasil pengurangan}
  begin
        for j:= 1 to koloma do
   write(hsl[i,j],'  ':15);
            writeln;
        end
else writeln('Matrik tidak dapat dikurangkan karena dimensinya tidak cocok');
end;
Procedure kurangmatrikr(matrik1,matrik2:matrik;baris1,kolom1,baris2,kolom2 :integer);
{prosedur untuk mengurangkan matrik dengan input random}
var i,j : integer;
    hsl : matrik;
begin
if (baris1=baris2) and (kolom1=kolom2) then {mengecek apakah matrik tersebut bujur sangkar}
 begin
 writeln('Hasil pengurangan matrik adalah');
 for i:=1 to baris1 do
  begin
  for j:=1 to kolom1 do
   begin
   hsl[i,j]:=matrik1[i,j]-matrik2[i,j];        
   end;
  end;
   end;
  
if (baris1=baris2) and (kolom1=kolom2) then {mengecek apakah matrik tersebut bujur sangkar}
 for i:= 1 to baris1 do {mencetak hasil pengurangan}
        begin
        for j:= 1 to kolom1 do
   write(hsl[i,j],'  ':15);
            writeln;
        end
else writeln('Matrik tidak dapat dikurangkan karena dimensinya tidak cocok')
end;
Procedure perkalianmatrikm;
{prosedur untuk  mengalikan matrik dengan input manual}
var i, j, k : byte;
    hasil : matrik;
begin
writeln('Hasil perkalian matrik adalah');
if (koloma=barisb) then {mengecek apakah kolom matrik pertama sama dengan baris matrik kedua }
 for i := 1 to barisa do
        begin
        for j := 1 to kolomb do
            begin
   hasil[i,j]:=0;
                for k := 1 to barisb do
     begin
     hasil[i,j] := hasil[i,j] + matrika[i,k] * matrikb[k,j];
                    end;
            end;
        end;
if (koloma=barisb) then {mengecek apakah kolom matrik pertama sama dengan baris matrik kedua }
    for i:= 1 to barisa do {mencetak hasil perkalian}
        begin
  for j:= 1 to kolomb do
            write(hasil[i,j],'  ':15);
            writeln;
        end
else writeln('Matrik tidak dapat dikalikan karena dimensinya tidak cocok');
end;
Procedure perkalianmatrikr;
{prosedur untuk mengalikan  matrik dengan input random}
var i, j, k : byte;
    hasil : matrik;
begin
writeln('Hasil perkalian matrik adalah');
if (kolom1=baris2) then {mengecek apakah kolom matrik pertama sama dengan baris matrik kedua }
    for i := 1 to baris1 do
        begin
        for j := 1 to kolom2 do
            begin
            hasil[i,j]:=0;
                for k := 1 to baris2 do
                begin
                hasil[i,j] := hasil[i,j] + matrik1[i,k] * matrik2[k,j];
                end;
            end;
        end;
if (kolom1=baris2) then {mengecek apakah kolom matrik pertama sama dengan baris matrik kedua }
 for i:= 1 to baris1 do {mencetak hasil perkalian}
        begin
  for j:= 1 to kolom2 do
            write(hasil[i,j],'  ':15);
            writeln;
        end
else writeln('Matrik tidak dapat dikalikan karena dimensinya tidak cocok');
end;
Procedure transposem;
{prosedur untuk mentranspose matrik dengan input manual}
var i, j : integer;
    trans : matrik;
begin
for i := 1 to koloma do
    begin
    for j := 1 to barisa do
        begin               
        trans[i,j] := matrika [j,i];
        end;
    writeln;
    end;
{mencetak matrik hasil transpose}       
write('Hasil transpose matrik adalah'); writeln; writeln;
for i := 1 to koloma do
    begin
    writeln;
 for j := 1 to barisa do
 write(trans[i,j]:15);
    writeln;
    end;
end;
Procedure transposer;
{prosedur untuk mentranspose matrik dengan input random}
var i, j : integer;
    trans : matrik;
begin
for i := 1 to kolom1 do
    begin
    for j := 1 to baris1 do
        begin               
        trans[i,j] := matrik1 [j,i];
        end;
    writeln;
    end;
{mencetak matrik hasil transpose} 
clrscr;              
write('Hasil transpose matrik adalah'); writeln; writeln;
for i := 1 to kolom1 do
    begin
    writeln;
 for j := 1 to baris1 do
 write(trans[i,j]:15);
    writeln;
    end;
end;
Function tracem : integer;
{fungsi trace dengan input manual}
var i, j : byte;
    trace : integer;
begin
if (barisa= koloma) then
 begin
    trace := 0;
        for i := 1 to barisa do
        begin
   for j := 1 to koloma do
            if (i = j) then
            trace := trace + matrika[i,j];
        end;
    writeln;
    write('Hasil dari trace matrik adalah : ');
    writeln(trace);
    writeln;
    end
else
 begin
    writeln('Matrik dengan ordo ini tidak dapat dieksekusi');
    writeln('Baris dan kolom yang anda masukan tidak sama');
    end;
end;
Function tracer : integer;
{fungsi trace dengan input random}
var i, j : byte;
    trace : integer;
begin
if (baris1= kolom1) then
 begin
    trace := 0;
  for i := 1 to baris1 do
        begin
   for j := 1 to kolom1 do
                if (i = j) then
                trace := trace + matrik1[i,j];
        end;
    writeln;
    write('Hasil dari trace matrik adalah :');
    writeln(trace);
    writeln;
    end
else
 begin
    writeln('Matrik dengan ordo ini tidak dapat dieksekusi');
    writeln('Baris dan kolom yang anda masukan tidak sama');
    end;
end;
{menu utama}
begin
identitas;
clrscr;
repeat
clrscr;
writeln('Pilihlah operasi yang Anda inginkan terhadap matrik yang akan Anda buat!');
writeln('1.Mencari trace matrik');
writeln('2.Menjumlahkan dua matrik');
writeln('3.Mengurangkan dua matrik');
writeln('4.Mentranspose matrik');
writeln('5.Mengalikan dua matrik');
writeln;
writeln('1 : input manual');
writeln('2 : input random');
writeln;
writeln('contoh pemilihan..');
writeln('21 : Menjumlahkan dua matrik secara manual');
writeln;
write('Masukkan pilihan anda : '); readln(pil);
clrscr;
 case pil of
    11 : begin
    writeln('Anda memilih mencari trace matrik secara manual'); writeln;
          bacadataa; writeln;
          matrikmanuala; clrscr;
          cetakmatrika; writeln;
          tracem; writeln;
          end;
    12 : begin
    writeln('Anda memilih mencari trace matrik secara random'); writeln;
          buatdata1; writeln;
          random1; clrscr;
          cetakmatrik1; writeln;
          tracer; writeln;
          end;
    21 : begin
     writeln('Anda memilih menjumlahkan matrik matrik dengan input manual'); writeln;
          bacadataa; writeln;
          bacadatab; clrscr;
          matrikmanuala; writeln;
          matrikmanualb; clrscr;
          cetakmatrika; writeln;
          cetakmatrikb; writeln;
          jumlahmatrikm(matrika,matrikb,barisa,koloma,barisb,kolomb);
          writeln;
    end;
    22  : begin
      writeln('Anda memilih menjumlahkan matrik matrik dengan input random'); writeln;
     buatdata1; writeln;
          buatdata2; writeln;
          random1; writeln;
          random2; clrscr;
          cetakmatrik1; writeln;
          cetakmatrik2; writeln;
          jumlahmatrikr(matrik1,matrik2,baris1,kolom1,baris2,kolom2);
          writeln;
    end;
    31  : begin
       writeln('Anda memilih mengurangkan matrik matrik dengan input manual'); writeln;
          bacadataa; writeln;
          bacadatab; clrscr;
          matrikmanuala; writeln;
          matrikmanualb; clrscr;
          cetakmatrika; writeln;
          cetakmatrikb; writeln;
          kurangmatrikm(matrika,matrikb,barisa,koloma,barisb,kolomb);
          writeln;
    end;
    32  : begin
       writeln('Anda memilih mengurangkan matrik dengan input random'); writeln;
          buatdata1; writeln;
          buatdata2; writeln;
          random1; writeln;
          random2; clrscr;
          cetakmatrik1; writeln;
          cetakmatrik2; writeln;
          kurangmatrikr(matrik1,matrik2,baris1,kolom1,baris2,kolom2);
          writeln;
    end;
    41  : begin
       writeln('Anda memilih mentranspose matrik dengan input manual'); writeln;
          bacadataa; writeln;
          matrikmanuala; clrscr;
          cetakmatrika; writeln;
          transposem; writeln;
          end;
 42  : begin
          writeln('Anda memilih mentranspose matrik dengan input random'); writeln;
          buatdata1; writeln;
          random1; clrscr;
          cetakmatrik1; writeln;
          transposer; writeln;
          end;
    51  : begin
          writeln('Anda memilih mengalikan matrik dengan input manual'); writeln;
          bacadataa; writeln;
          bacadatab; clrscr;
          matrikmanuala; writeln;
          matrikmanualb; clrscr;
          cetakmatrika; writeln;
          cetakmatrikb; writeln;
          perkalianmatrikm; writeln;
          end;
    52  : begin
          writeln('Anda memilih mengalikan matrik dengan input random'); writeln;
          buatdata1; writeln;
          buatdata2; writeln;
          random1; writeln;
          random2; clrscr;
          cetakmatrik1; writeln;
          cetakmatrik2; writeln;
          perkalianmatrikr; writeln;
          end;
 end;
write('  Kembali ke menu utama [Y/T]? '); readln(pilihan);
until upcase(pilihan) <> 'Y';
readln;
end .