Tampilkan postingan dengan label PASCAL. Tampilkan semua postingan
array
program tugas_2;
uses wincrt;
var
jum,rata,nilai:real;
n,i:byte;
nama:string;
nim:longint;
a:array[1..100] of integer;
max,min:real;
begin
writeln('Mencari Nilai Max,Min,Jumlah
dan Rata-rata');
write('Nama : ');readln(nama);
write('Nim : ');readln(nim);
writeln;
writeln('=======================');
writeln('Masukkan banyak nilai yang akan
diinputkan: ');readln(n);
jum:=0;
for i:=1 to n do
begin
writeln('Masukkan nilai ke' ,i,':
');readln(a[i]);
jum:=Jum+a[i];
rata:=jum/n;
writeln('=============');
end;
writeln('Jumlah = ',jum:4:2);
writeln('rata-rata = ',rata:4:2);
begin
max:=a[1];
min:=a[1];
for i:= 2 to n do
if a[i]>max then max:=a[i]
else if a[i]<min then min:=a[i];
writeln('');
writeln('Nilai Maksimum ',max:0:0);
writeln('Nilai Minimum ',min:0:0);
readln;
end;
end.
hasil running
Tag :
PASCAL,
program matriks di pascal
program operasi_matriks;
uses
wincrt;
type
matrix=array[1..20,1..20] of integer;
var
A,B,hasil:matrix;
v,w,u,ba,ka,bb,kb:integer;
pil:1..9;
procedure
isi(var X:matrix;p,q:byte);
begin
for v:=1 to p do
begin
for w:=1 to q do
begin
writeln('isi elemen ke [',v,',',w,'] ');
readln(X[v,w]);
end;
end;
end;
procedure
tampil(var X:matrix;p,q:byte);
begin
for v:=1 to p do
begin
for w:=1 to q do write(X[v,w]:6);
writeln;
end;
end;
procedure
kali(var X,Y:matrix;p,q:integer);
begin
for v:=1 to p do
for w:=1 to q do
begin
hasil[v,w]:=0;
for u:=1 to p do
begin
hasil[v,w]:=hasil[v,w]+X[v,u]*Y[u,w];
end;
end;
end;
procedure jumlah(var
X,Y:matrix;p,q:byte);
begin
for v:=1 to p do
begin
for w:=1 to q do
hasil[v,w]:=X[v,w]+Y[v,w];
end;
end;
procedure
kurang(var X,Y:matrix;p,q:byte);
begin
for v:=1 to p do
begin
for w:=1 to q do
hasil[v,w]:=X[v,w]-Y[v,w];
end;
end;
procedure
transpos(var X:matrix;p,q:byte);
begin
for v:=1 to p do
begin
for w:=1 to q do write(X[w,v]:6);
writeln;
end;
end;
{program utama}
begin
repeat
begin
clrscr;
writeln('MENU
PILIHAN OPERASI MATRIX');
writeln('-------------------------');
writeln('1. Isi
matrix A');
writeln('2. Isi
matrix B');
writeln('3.
A+B');
writeln('4.
A-B');
writeln('5.
B-A');
writeln('6.
A*B');
writeln('7. A
transpose');
writeln('8. B
transpose');
writeln('9.
selesai');
write('masukkan
pilihan anda <1-8> ==> ');readln(pil);
case pil of
1: begin
writeln('mengisi matrix A');
write('masukkan baris A ==> ');readln(ba);
write('masukan kolom matrix A ==>
');readln(ka);
isi(A,ba,ka);
writeln('Matrix a adalah ');
tampil(A,ba,ka);
end;
2:begin
writeln('mengisi matrix B');
write('masukkan baris B ==> ');readln(bb);
write('masukan kolom matrix B ==>
');readln(kb);
isi(B,bb,kb);
writeln('Matrix B adalah ');
tampil(B,bb,kb);
end;
3: begin
if (ba=bb) and (ka=kb) then
begin
writeln('matrix A = ');
tampil (A,ba,ka);
writeln('matrix B = ');
tampil (B,bb,kb);
writeln('hasil A+B adalah ');
jumlah(A,B,ba,ka);
tampil(hasil,ba,ka);
end
else writeln('operasi A+B tidak bisa
dihitung karena ordo berbeda');
end;
4: begin
if (ba=bb) and (ka=kb) then
begin
writeln('matrix A = ');
tampil (A,ba,ka);
writeln('matrix B = ');
tampil (B,bb,kb);
writeln('hasil A-B adalah ');
kurang(A,B,ba,ka);
tampil(hasil,ba,ka);
end
else writeln('operasi A-B tidak bisa
dihitung karena ordo berbeda');
end;
5: begin
if (ba=bb) and (ka=kb) then
begin
writeln('matrix A = ');
tampil (A,ba,ka);
writeln('matrix B = ');
tampil (B,bb,kb);
writeln('hasil B-A adalah ');
kurang(B,A,ba,ka);
tampil(hasil,ba,ka);
end
else writeln('operasi B-A tidak bisa
dihitung karena ordo berbeda');
end;
6: begin
writeln('matrix A = ');
tampil (A,ba,ka);
writeln('matrix B = ');
tampil (B,bb,kb);
writeln('hasil B*A adalah ');
kali(A,B,ba,ka);
tampil(hasil,ba,ka);
end;
7: begin
writeln('Matrix A');
tampil(A,ba,ka);
writeln('Transpose Matrix A');
transpos(A,ka,ba);
end;
8: begin
writeln('Matrix B');
tampil(B,bb,kb);
writeln('Transpose Matrix B');
transpos(B,kb,bb);
end;
9:writeln('terima
kasih sudah berpartisipasi');
end;
readln;
end
until(pil=9);
end.
Tag :
PASCAL,
contoh program STACK pada pascal
uses wincrt;
const max=10;
type
stack=record
judul:array[1..max] of string;
harga:array[1..max] of longint;
atas:0..max;
end;
type
jualbuku=record
juduljual:string;
hargajual:word;
end;
larik_jual=array[1..20] of jualbuku;
var
buku,sp:stack;
jual:larik_jual;
judulmasuk,judulkeluar:string;
hargamasuk,hargakeluar:longint;
pil:1..8;
lagi,ketemu:boolean;
terjual,i,n,cacah:byte;hasil:real;
function
kosong(s:stack):boolean;
begin
if s.atas=0 then
kosong:=true else kosong:=false;
end;
function
penuh(s:stack):boolean;
begin
if s.atas=max
then penuh:=true else penuh:=false;
end;
procedure
push(var s:stack;j:string;h:longint);
begin
if penuh(s) then
writeln('Maaf stack sudah penuh')
else
begin
inc(s.atas);
s.judul[s.atas]:=j;s.harga[s.atas]:=h;
end;
end;
procedure
pop(var s:stack);
begin
if kosong(s)
then writeln('Buku sudah habis')
else
begin
judulkeluar:=s.judul[s.atas];hargakeluar:=s.harga[s.atas];
writeln('Terjual
buku ',judulkeluar,' seharga Rp ',hargakeluar);
inc(terjual);hasil:=hasil+hargakeluar;
dec(s.atas);
end;
end;
procedure
cetak(var s:stack);
var i:byte;
begin
if kosong(s)
then writeln('tumpukan kosong') else
begin
writeln('DAFTAR
BUKU DITUMPUKAN');
writeln('------------------------------------------');
for i:=s.atas
downto 1 do
writeln('posisi
',i,' dengan judul ',s.judul[i]:10);
writeln('------------------------------------------');
end;end;
procedure
cetakjual(var x:larik_jual);
var hasil:real;
begin
writeln('-----------------------------------------');
writeln('No Judul Harga');
writeln('-----------------------------------------');
for i:=1 to n do
begin
writeln(i:2,' ',x[i].juduljual:15,' Rp ',x[i].hargajual:8);
hasil:=hasil+x[i].hargajual;
end;
writeln('-----------------------------------------');
writeln('-----------------------total--Rp
',hasil:10:2);
end;
procedure
caribuku(var s:stack);
var
ketemu:boolean;
i,posisi:byte;
ulang:char;
cari:string;
begin
if kosong(s)
then writeln('Buku sedang kosong') else
begin
ulang:='y';
while ulang='y'
do
begin
ketemu:=false;
write('Masukkan judul buku yang dicari
==> ');readln(cari);
for i:=1 to s.atas do
begin
if s.judul[i]=cari then
begin ketemu:=true;posisi:=i;end;
end;
if ketemu then
writeln('Judul ',cari,' ada di posisi ke ',posisi) else
writeln('Maaf
judul ',cari,' tidak ditemukan');
writeln;
write('Mau cari
judul lain? <y/t> ');readln(ulang);
end;
end;
end;
procedure
ambilbuku(var s:stack);
var posisi,k:byte;
cari:string;
begin
ketemu:=false;sp.atas:=0;
write('Apa judul
yang ingin diambil ');readln(cari);
for i:=s.atas
downto 1 do
begin
if(s.judul[i]=cari) then
begin ketemu:=true;posisi:=i;end;
end;
if ketemu then
begin
for k:=s.atas downto posisi+1 do
begin
inc(sp.atas);
sp.judul[sp.atas]:=s.judul[k];
sp.harga[sp.atas]:=s.harga[k];
end;
s.atas:=posisi;
judulkeluar:=s.judul[s.atas];
hargakeluar:=s.harga[s.atas];
dec(s.atas);
for k:=sp.atas downto 1 do
begin
inc(s.atas);
s.judul[s.atas]:=sp.judul[k];
s.harga[s.atas]:=sp.harga[k];
end;
end
else
writeln('Buku tidak ditemukan');
end;
{program utama}
begin
lagi:=true;
while lagi do
begin
clrscr;
writeln('1.
Menambah buku ke tumpukan');
writeln('2.
Mengambil buku dari tumpukan dan layani penjualan');
writeln('3.
Mencari buku');
writeln('4.
Mencetak daftar buku di tumpukan');
writeln('5. Cek
buku terjual');
writeln('6.
Mengambil buku tertentu');
writeln('7.
Mencetak buku terjual');
writeln('8.
Tutup toko dan cetak hasil penjualan');
writeln;write('pilihan
anda <1-6> ==> ');readln(pil);
case pil of
1:begin
write('Judul buku baru ==>
');readln(judulmasuk);
write('Harganya ==> ');readln(hargamasuk);
push(buku,judulmasuk,hargamasuk);
end;
2:begin
if not kosong(buku) then
begin
pop(buku);
inc(cacah);
hasil:=hasil+hargakeluar;
inc(n);
jual[n].juduljual:=judulkeluar;
jual[n].hargajual:=hargakeluar;
end
else writeln('Buku dalam tumpukan habis');
end;
3:caribuku(buku);
4:cetak(buku);
5:begin
inc(terjual);
writeln('Sudah terjual sebanyak
',terjual,' buku');
writeln('Pendapatan sekarang Rp
',hasil:8:2);
writeln('Sisa buku ditumpukan
',buku.atas,' buku');
end;
6:begin
if not kosong(buku) then ambilbuku(buku)
else writeln('Buku habis');
if ketemu and not kosong(buku) then
begin
writeln('Buku yang diambil adalah
',judulkeluar);
writeln('Harganya Rp ',hargakeluar);
inc(cacah);
hasil:=hasil+hargakeluar;
inc(n);
jual[n].juduljual:=judulkeluar;
jual[n].hargajual:=hargakeluar;
end;
end;
7:cetakjual(jual);
8:begin
inc(terjual);
writeln('total terjual sebanyak
',terjual,' buku');
writeln('pendapatan total Rp
',hasil:8:2);
writeln('Sisa buku di tumpukan
',buku.atas,' buku');
lagi:=false;
writeln;
writeln('Terimakasih');
end;
end;
readln;
end;
end.
Tag :
PASCAL,