fbpx

Algoritma dan Pemrogaman : Contoh Program Bahasa Pascal dengan Array

๐Ÿ“‹ Daftar Isi

Program Matriks Lengkap

Program untuk perhitungan perkalian, determinan, transpose, dan invers matriks.

Kode Program

Program matrikslengkap;
uses crt; 
var matrik1,matrik2,hasil:array [1..10,1..10] of integer;
    x,y,z,m,n,o : integer;
    procedure perkalianmatriks;
    begin
        clrscr;
        writeln('PERKALIAN MATRIKS');
        writeln('-----------------');
        writeln('Matriks pertama');
        write ('Masukan jumlah baris : ');readln(m);
        write ('Masukan jumlah kolom : ');readln(n);
        writeln;
        writeln('Matriks kedua');
        writeln('Masukan jumlah baris : ',n);
        write('Masukan jumlah kolom : '); readln (o);
        writeln;
        writeln ('Elemen matriks pertama');
        for x:= 1 to m do
        begin
                for y:= 1 to n do
                begin
                        write ('Masukan elemen matriks [',x,',',y,'] : '); readln (matrik1[x,y]);
                end;
        end;
        writeln;
        writeln ('Elemen matriks kedua');
        for y:= 1 to n do
        begin
                for z:= 1 to o do
                begin
                        write ('Masukan elemen matriks [',y,',',z,'] : '); readln (matrik2[y,z]);
                end;
        end;
        for x:=1 to m do
                for y:=1 to o do
                        for z:=1 to n do
                                hasil[x,y] := hasil[x,y] + matrik1[x,z]*matrik2[z,y];
        writeln;
        clrscr;
        writeln('Hasil perkalian matriks 1 = ');
        for x:= 1 to m do
        begin
                for y:= 1 to n do
                        write(matrik1[x,y],' ');
                writeln;

        end;
        writeln('dengan matriks 2 = ');
        for y:= 1 to n do
        begin
                for z:= 1 to o do
                        write(matrik2[y,z],' ');
                writeln;
        end;
        writeln('Adalah');
        for x:=1 to m do
        begin
            for y:=1 to o do
                write(hasil[x,y],' ');
            writeln;
        end;
        writeln;
    readln;
    end;

    procedure Determinanmatriks;
    var matriks,determinan: array [1..10,1..10] of integer;
        x,y,ordo:integer;
    begin
        clrscr;
        writeln('DETERMINAN MATRIKS');
        writeln('------------------');
        write ('Masukan jumlah kolom dan baris matriks persegi (cukup 1) = ');readln (ordo);
        writeln;
        for x:= 1 to ordo do
        begin
                for y:= 1 to ordo do
                begin
                        write ('Masukan elemen matriks [',x,',',y,'] : '); readln (matriks[x,y]);
                end;
        end;
        clrscr;
        writeln('Matriks yang terbentuk');
        for x:= 1 to ordo do
        begin
                for y:= 1 to ordo do
                begin
                        write(matriks[x,y],' ');
                        if y=ordo then writeln;
                end;
        end;
        writeln;
        if (ordo=2) then
        begin
                determinan[x,y]:=matriks[x-1,y-1]*matriks[x,y]-matriks[x,y-1]*matriks[x-1,y];
                writeln('Determinan matriks tersebut adalah = ',determinan[x,y]);
        end
        else if (ordo=3) then
        begin
            determinan[x,y]:=(matriks[x-2,y-2]*matriks[x-1,y-1]*matriks[x,y]+matriks[x-2,y-1]*matriks[x-1,y]
                                *matriks[x,y-2]+matriks[x-2,y]*matriks[x-1,y-2]*matriks[x,y-1])-(matriks[x,y-2]
                                *matriks[x-1,y-1]*matriks[x-2,y]+matriks[x,y-1]*matriks[x-1,y]*matriks[x-2,y-2]
                                +matriks[x,y]*matriks[x-1,y-2]*matriks[x-2,y-1]);
            writeln('Determinan matriks tersebut adalah = ',determinan[x,y]);
        end
        else writeln('Ordo nya lebih dari 3x3 sehingga determinannya tidak dapat ditemukan');
        writeln;
    end;

    Procedure transposematriks;
    var matriks: array [1..10,1..10] of integer;
        x,y,baris,kolom : integer;
    begin
        clrscr;
        writeln('TRANSPOSE MATRIKS');
        writeln('-----------------');
        write('Masukkan jumlah baris = ');readln(baris);
        write ('Masukan jumlah kolom = ');readln(kolom);
        writeln;
        for x:= 1 to baris do
        begin
                for y:= 1 to kolom do
                begin
                        write ('Masukan elemen matriks [',x,',',y,'] : '); readln (matriks[x,y]);
                end;
        end;
        clrscr;
        Writeln('Matriks berordo ',baris,' x ',kolom,' tersebut adalah');
        for x:=1 to baris do
        begin
                for y:=1 to kolom do
                begin
                        write(matriks[x,y],' ');
                        if y=kolom then writeln;
                end;
        end;
        writeln;
        writeln('Hasil dari transpose matriks tersebut adalah');
        for y:=1 to kolom  do
        begin
                for x:=1 to baris do
                        write(matriks[x,y],' ');
        writeln;
        end;
    end;

    procedure inversmatriks;
    var matriks,determinan: array [1..10,1..10] of integer;
        x,y,ordo : integer;
    begin
        clrscr;
        writeln('INVERS MATRIKS');
        writeln('--------------');
        write('Masukan jumlah kolom dan baris matriks persegi (cukup 1) = '); readln(ordo);
        writeln;
        if (ordo=2) then
        begin
                for x:= 1 to ordo do
                begin
                    for y:= 1 to ordo do
                    begin
                        write ('Masukan elemen matriks [',x,',',y,'] : '); readln (matriks[x,y]);
                    end;
                end;
                writeln('Invers dari matriks |',matriks[x-1,y-1],' ',matriks[x-1,y],'| adalah');
                writeln('                    |',matriks[x,y-1],' ',matriks[x,y],'|');
                determinan[x,y]:=matriks[x-1,y-1]*matriks[x,y]-matriks[x,y-1]*matriks[x-1,y];
                writeln(' 1  x |',matriks[x,y],'   ',-matriks[x-1,y],'|');
                writeln(determinan[x,y]:3,'   |',-matriks[x,y-1],'   ',matriks[x-1,y-1],'|');
        end
        else writeln('Hanya dapat mencari invers ordo 2x2!');
end;

var
    pilih:integer;
    lagi:char;
label ulangi;
begin
    ulangi :
    clrscr;
    writeln('1. Melakukan perkalian matriks');
    writeln('2. Menghitung determinan matriks');
    writeln('3. Melakukan transpose matriks');
    writeln('4. Melakukan invers matriks');
    writeln('5. Keluar');
    write('   Pilih menu : ');
    readln(pilih);
    
    case pilih of
    1:  begin
            perkalianmatriks;
            write('Apakah Anda ingin melakukan perhitungan matriks lain ? (Y/T) = ');readln(lagi);
            if (lagi='Y') or (lagi='y') then
                goto ulangi;
            if (lagi='T') or (lagi='t') then
                writeln('Terima kasih :)')
            else write('Input salah, masukkan karakter Y atau T ! = ');readln(lagi);
            if (lagi='Y') or (lagi='y') then
                goto ulangi;
            if (lagi='T') or (lagi='t') then
                writeln('Terima kasih :)');
        end;
    2:  begin 
            determinanmatriks;
            write('Apakah Anda ingin melakukan perhitungan matriks lain ? (Y/T) = ');readln(lagi);
            if (lagi='Y') or (lagi='y') then
                goto ulangi;
            if (lagi='T') or (lagi='t') then
                writeln('Terima kasih :)')
            else write('Input salah, masukkan karakter Y atau T ! = ');readln(lagi);
            if (lagi='Y') or (lagi='y') then
                goto ulangi;
            if (lagi='T') or (lagi='t') then
                writeln('Terima kasih :)');    
        end;
    3:  begin 
            transposematriks;
            write('Apakah Anda ingin melakukan perhitungan matriks lain ? (Y/T) = ');readln(lagi);
            if (lagi='Y') or (lagi='y') then
                goto ulangi;
            if (lagi='T') or (lagi='t') then
                writeln('Terima kasih :)')
            else write('Input salah, masukkan karakter Y atau T ! = ');readln(lagi);
            if (lagi='Y') or (lagi='y') then
                goto ulangi;
            if (lagi='T') or (lagi='t') then
                writeln('Terima kasih :)');
        end;
    4:  begin 
            inversmatriks;
            write('Apakah Anda ingin melakukan perhitungan matriks lain ? (Y/T) = ');readln(lagi);
            if (lagi='Y') or (lagi='y') then
                goto ulangi;
            if (lagi='T') or (lagi='t') then
                writeln('Terima kasih :)')
            else write('Input salah, masukkan karakter Y atau T ! = ');readln(lagi);
            if (lagi='Y') or (lagi='y') then
                goto ulangi;
            if (lagi='T') or (lagi='t') then
                writeln('Terima kasih :)');    
        end;
    5:  writeln('Terima kasih');
    end;
readln;
end.

Contoh Output

Program Cetak n Bilangan Prima

Program untuk mencetak n bilangan prima dengan n merupakan input dari user.

Kode Program

program cetaknprima;
uses crt;
var
    i,k,jumlah,total:integer;
    angka_prima:array[1..100] of integer;

    procedure input_jumlah;
    begin
        write('Masukkan jumlah bilangan prima (n) : ');
        readln(jumlah);
    end;

    procedure uji_prima(n:integer);
    var j       :integer;
        prima   :boolean;
    begin
        prima:=true;
        for j:=2 to n-1 do
            if (n mod j = 0) then prima:=false
            else;
            if (prima=true) then
            begin
                angka_prima[i]:=n;
                i:=i+1;
                total:=total+1;
            end
            else;
    end;

    procedure output;
    begin
        for i:=1 to total-1 do
        writeln('Angka Prima ke-',i:3,' : ',angka_prima[i]); 
    end;

begin
    clrscr;
    writeln('Mencetak n Buah Bilangan Prima Prima Pertama');
    writeln('--------------------------------------------');
    input_jumlah;
    total:=0;
    k:=1;
    while (total<=jumlah) do
    begin
        uji_prima(k);
        k:=k+1;
    end;
    output;
end.

Contoh Output


Materi Lengkap

Silakan baca juga beberapa artikel menarik kami tentang Array dan Record, daftar lengkapnya adalah sebagai berikut.


Tonton juga video pilihan dari kami berikut ini

Bagikan ke teman-teman Anda

Contact Us

How to whitelist website on AdBlocker?

How to whitelist website on AdBlocker?

  1. 1 Click on the AdBlock Plus icon on the top right corner of your browser
  2. 2 Click on "Enabled on this site" from the AdBlock Plus option
  3. 3 Refresh the page and start browsing the site
error: Content is protected !!