1. ANTRIAN
uses wincrt;
const
max=3;
type
A= array[1..max]of string;
var
antrian :A;
no_antri :0..max;
tanya :char;
begin
clrscr;
writeln(' PROGRAM ANTRIAN SEDERHANA ');
writeln('=========================================');
tanya:='Y';
while tanya in['Y','y'] do
begin
write('Elemen ke-1 =');readln(antrian[1]);
no_antri:=no_antri+1;
write('Elemen ke-2 =');readln(antrian[2]);
no_antri:=no_antri+1;
write('Elemen ke-3 =');readln(antrian[3]);
no_antri:=no_antri+1;
writeln;
writeln('Tampilan = ',antrian[1],' ',antrian[2],' ',antrian[3]);
writeln('Jumlah antrian =',no_antri);
writeln('--------------------------------------------');
readln;
write('Akan tambah data?[Y/T]');readln(tanya);
end;
writeln('Jumlah elemen dalam antrian =',no_antri);
readln;
donewincrt;
end.
2. ARRAY
uses wincrt;
var
x:array [1..10,1..10] of integer;
i,j,m,n:integer;
begin
writeln ('Program ini akan membuat matriks');
writeln ('Jumlah baris=');readln(m);
writeln ('jumlah kolom=');readln(n);
for i:=1 to m do
begin
for j:=1 to n do
begin
write ('Elemen ke',i,',',j,'=');
read (x[i,j]);
end;
end;
writeln ('Matriks yang dihasilakan:');
writeln ('Matriks',m,n);
for i:=1 to m do
begin
for j:=1 to n do
write(x[i,j]:5);
writeln;
end;
readln(i);
end.
3. FUNCTION
uses wincrt;
function luassegitiga(alas: integer; tinggi:integer) : real;
var luas:real;
begin
luas:= alas*tinggi/2;
luassegitiga:= luas;
end;
var a,t:integer;
luas : real;
begin
writeln('-======Program Fungsi Luas segitiga======-');
writeln;
write('masukkan nilai alas : '); readln(a);
write('masukkan nilai tinggi : '); readln(t);
write('luas segitiga adalah : ', luassegitiga(a,t):0:2);
end.
4. LINKED LIST
uses wincrt;
type simpul = ^data;
data = record
nama : string[25];
kait : simpul;
end;
var awal,akhir,bantu : simpul;
ya : char;
begin
clrscr;
awal := nil;
ya := 'y';
while ya in ['y','Y'] do
begin
new (bantu);
write ('Masukkan Nama : ');
readln (bantu^.nama);
write ('Tambah data lagi [Y/N]: ?');
readln (ya);
writeln;
if awal = nil then
begin
bantu^.kait := nil;
awal := bantu;
akhir := bantu;
end
else
begin
akhir^.kait := bantu;
bantu^.kait := nil;
akhir := bantu;
end;
end;
bantu := awal;
writeln (bantu^.nama);
while bantu^.kait <> nil do
begin
bantu := bantu^.kait;
writeln (bantu^.nama);
end;
readln;
end.
5. PROCEDURE
uses wincrt;
var c,d:integer; j:real;
procedure jumlah(a,b:integer; jum:real);
begin
jum:=a+b;
writeln('Jumlah A+B =',jum:6:2);
end;
procedure pembagi(a,b:integer; bagi:real);
begin
bagi:=a/b;
writeln('Bagi A/B =',bagi:6:2);
end;
procedure pengurang(a,b:integer; kurang:real);
begin
kurang:=a-b;
writeln('Kurang A-B =',kurang:6:2);
end;
procedure perkalian(a,b:integer; kali:real);
begin
kali:=a*b;
writeln('Kali A*B =',kali:6:2);
end;
begin
write('Masukan Nilai A : ');readln(c);
write('Masukan Nilai B : ');readln(d);
jumlah(c,d,j);
pembagi(c,d,j);
pengurang(c,d,j);
perkalian(c,d,j);
end.
6. RECORD
uses wincrt;
type mahasiswa=record
nama: string;
jen_kelamin: string;
alamat : string;
end;
var mhs: mahasiswa;
begin
clrscr;
write('Masukkan Nama: '); readln(mhs.nama);
write('Masukkan Jenis Kelamin: '); readln(mhs.jen_kelamin);
write('Masukkan Alamat: '); readln(mhs.alamat);
{untuk memasukkan data mahasiswa}
writeln(mhs.nama);
writeln(mhs.jen_kelamin);
writeln(mhs.alamat);
{untuk menampilkan data mahasiswa}
end.
7. SEARCHING
uses wincrt;
label awal;
var pil:char;
lg:char;
const
nmin =1;
nmax =100;
type
arrint =array [nmin..nmax] of integer;
var
x:integer;
tabint:arrint;
n,i:integer;
indexs:integer;
function seqsearch1 (xx:integer) :integer;
var i :integer;
begin
i:=1;
while ((i<n) and (tabint[i] <> xx)) do
i:=i+1;
if tabint[i] = xx then
seqsearch1:=i
else
seqsearch1:=0;
end;
begin
write('input nilai n='); readln(n);
for i:=1 to n do
begin
write ('tabint [',i,'] ='); readln(tabint[i]);
end;
write ('Nilai yang dicari ='); readln (x);
indexs:=seqsearch1(x);
if indexs <>0 then
write (x,'ditemukan pada indexs ke-' ,indexs)
else
write (x, 'tidak ditemukan');
writeln;
readln;
end.
8. SORTING
uses wincrt;
var i,j,indexmin,n,temp:integer;
data:array [0..100] of integer;
begin
write ('Berapa data yang akan diurutkan?');
readln (n);
for i:=0 to n-1 do
begin
write ('Masukan data ke-', i+1,' =');
readln (data [i]);
end;
for i:= 0 to n-1 do
begin
Indexmin:=1;
for j:= i to n-1 do
begin
if (data [j] < data [indexmin]) then
indexmin :=j;
end;
if ((data [i]) <> (data [indexmin])) then
begin
temp:= data [i];
data [i]:= data [indexmin];
data [indexmin]:=temp;
end;
end;
writeln ('setelah pengurutan:');
for i:= 0 to n-1 do
writeln ('elemen ke- ',i+1,'=',data [i]);
end.
9. TUMPUKAN
Uses wincrt;
Const Elemen = 12;
Type S12 = String[Elemen];
stack = record
S : s12;
top : 0..elemen
end;
Var
A : stack;
I : Integer;
Kalimat : S12;
lanjut:boolean;
temp:char;
Procedure inisialisasi(Var A : stack);
Begin
A.top := 0
End;
function penuh(A:stack):boolean;
begin
penuh:=(A.top=elemen)
end;
function kosong(A:stack):boolean;
begin
kosong:=(A.top=0)
end;
function size(S:stack):integer;
begin
size:=s.top
end;
Procedure PUSH (Var A : stack; X : char);
Begin
A.top := A.top + 1;
A.S[A.top] := X
End;
Function POP (Var A : stack) : char;
Begin
POP := A.S[A.top];
A.top := A.top - 1;
End;
{Program Utama}
Begin
clrscr;
inisialisasi(A);
writeln('Menyusun sebuah kalimat dengan terbalik');
writeln('Masukan beberapa kalimat : ');
write('--- -_- --- --->:');
ReadLn (Kalimat);
writeln;
{ mempush kalimat ke dalam tumpukan}
For I := 1 to length(Kalimat) do
PUSH(A, Kalimat[I]);
{mempop isi tumpukan sehingga diperoleh kalimat yang dibaca terbalik}
For I := 1 to length(Kalimat) do
write(POP(A));
WriteLn;
end.
Tidak ada komentar:
Posting Komentar