Tugas Struktur Data
Tugas Akhir Mata Kuliah
Struktur Data
1.
Procedure
uses
wincrt;
procedure
jumlah;
var
a,b,c:integer;
begin
write
('input nilai a:');readln(a);
write
('input nilai b:');readln(b);
c:=
a + b;
writeln
('hasil penjumlahan : ' ,a, ' + ' ,b, ' = ' ,c);
end;
procedure
kali;
var
a,b,c:integer;
begin
write
('input nilai a:');readln(a);
write
('input nilai b:');readln(b);
c:=
a * b;
writeln
('hasil perkalian : ' ,a, ' * ' ,b, ' = ',c);
end;
procedure
kurang;
var
a,b,c:integer;
begin
write
('input nilai a:');readln(a);
write
('input nilai b:');readln(b);
c:=
a - b;
writeln
('hasil pengurangan : ' ,a, ' - ' ,b, ' = ',c);
end;
procedure
bagi;
var
a,b,c:real;
begin
write
('input nilai a:');readln(a);
write
('input nilai b:');readln(b);
c:=
a / b;
writeln
('hasil pembagian : ' ,a:0:2, ' / ' ,b:0:2, ' = ',c:0:2);
end;
{program
utama berfungsi sebagai alat pengontrol dari kinerja procedure}
var
ulang:char;
pilihan:integer;
begin
ulang:='y';
while
(ulang='y') or (ulang='Y') do
begin
writeln('menu
pilihan');
writeln('1.procedure
penjumlahan');
writeln('2.procedure
perkalian');
writeln('3.procudure
pengurangan');
writeln('4.procudure
pembagian');
writeln;
write
('input menu pilihan : ');readln(pilihan);
case
pilihan of
1:jumlah;
2:kali;
3:kurang;
4:bagi;
else
writeln('anda
salah input menu pilihan');
end;
write('mau
mengulang lagi tekan y : ');readln(ulang);
end;
readln;
donewincrt;
end.
2.
Function
uses
wincrt;
var
hasil_tambah
: integer;
hasil_kali
: integer;
hasil_bagi
: real;
hasil_kurang
: integer;
hasil_gabungan
: real;
a,b
: integer;
function
tambah(a,b : integer) : integer;
begin
tambah
:= (2+a+b) + (2+a+b);
end;
function
kali(a,b : integer) : integer;
begin
kali
:= (2*a*b) + (2*a*b);
end;
function
bagi(a,b : integer) : real;
begin
bagi
:= (2*a/b) + (2*a/b);
end;
function
kurang(a,b : integer) : integer;
begin
kurang
:= (2*a-b) + (2*a-b);
end;
function
gabungan(a,b : integer) : real;
begin
gabungan
:= (2*a-b) + (2*a/b);
end;
begin
writeln('
PROGRAM ARITMATIKA');
writeln('--------------------');
write('input
nilai a : ');readln(a);
write('input
nilai b : ');readln(b);
writeln;
hasil_tambah
:= tambah(a,b);
hasil_kali
:= kali(a,b);
hasil_bagi
:= bagi(a,b);
hasil_kurang
:= kurang(a,b);
hasil_gabungan
:= gabungan(a,b);
writeln('Rumus
= (2+a+b)+(2+a+b)');
writeln('Hasil
penjumlahan (2+',a,'+',b,') + (2+',a,'+',b,'): ',hasil_tambah);
writeln;
writeln('Rumus
= (2*a*b) + (2*a*b)');
writeln('Hasil
perkalian (2*',a,'*',b,') + (2*',a,'*',b,'): ',hasil_kali);
writeln;
writeln('Rumus
= (2*a/b) + (2*a/b)');
writeln('Hasil
pembagian (2*',a,'/',b,') + (2*',a,'/',b,'): ',hasil_bagi:0:2);
writeln;
writeln('Rumus
= (2*a-b) + (2*a-b)');
writeln('Hasil
pengurangan (2*',a,'-',b,') + (2*',a,'-',b,'): ',hasil_kurang);
writeln;
writeln('Rumus
= (2*a-b) + (2*a/b)');
writeln('Hasil
rumus gabungan (2*',a,'-',b,') + (2*',a,'/',b,'): ',hasil_gabungan:0:2);
writeln;
writeln('-------------------------------------------------');
readln;
donewincrt;
end.
3.
Array
Program
Data_mahasiswa;
uses
crt;
var
nama :array[1..10]of string[20];
NPM:array[1..10]of string[20];
alamat:array[1..20]of string[30];
i,j :integer;
begin
clrscr;
write('Masukkan Jumlah Data Mahasiswa
:'); readln(j);
for i:=1 to j do
begin
writeln('Data ke-',i);
write('Nama Mahasiswa :');
readln(nama[i]);
write('Masukkan NPM :'); readln(NPM[i]);
write('Alamat :'); readln(alamat[i]);
end;
clrscr;
writeln('*******************************************************************************');
writeln('No. | Nama Mahasiswa | NPM | Alamat |');
writeln('*******************************************************************************');
for i:= 1 to j do
begin
writeln(i:1, nama[i]:20, NPM[i]:25,
alamat[i]:25);
end;
writeln('*******************************************************************************');
readln;
end.
4.
Record
program Gaji;
uses wincrt;
var
gp,gb,pjk,js,tis,ta,tjb:real;
nik:string[10];
nk:string[27];
sts:string[9];
jb:string[15];
ja:byte;
begin
clrscr;
write('Nomor
Induk Karyawan=');
readln(nik);
write('Nama
Karyawan=');
readln(nk);
write('Status=');
readln(sts);
write('Jumlah
Anak=');
readln(ja);
write('Jabatan=');
readln(jb);
write('Gaji
Pokok=');
read(gp);
if sts='menikah'
then begin
tis:=0.1*gp;
end
else begin
tis:=0;
end;
if ja<=3 then
begin ta:=0.05*gp*ja; end else if ja>3 then begin
ta:=0.05*gp*3;
end
else begin
ta:=0;
end;
if jb='manager'
then begin
tjb:=2000000;
end
else
if
jb='supervisor' then begin
tjb:=1500000;
end
else
if jb='mandor'
then begin
tjb:=1000000;
end
else begin
tjb:=0;
end;
pjk:=0.025*gp;
js:=0.01*gp;
gb:=(gp+tis+ta+tjb)-(pjk+js);
writeln('Tunjangan
Istri=', tis:3:2);
writeln('Tunjangan
Anak=', ta:3:2);
writeln('Tunjangan
Jabatan=', tjb:3:2);
Writeln('Pajak=',
pjk:3:2);
writeln('Jamsostek=',
js:3:2);
writeln('Gaji
Bersih=', gb:3:2);
readkey;
end.
5.
Antrian
Program
Queueku;
Uses
Crt;
Const
Loket = 55;
Kanan = 75;
UpBound = 11;
LowBound = 1;
Type
Orang = Object
Badan : Array[1..3] Of String[6];
X,Y,Mentok : Byte;
Procedure init;
Procedure gerak;
End;
Antrian = object
Queue : Array[LowBound..UpBound] Of Orang;
Noel : integer;
Procedure Input(Var Out : Char);
Procedure Create;
Procedure insertion;
Procedure deletion;
Procedure doproses;
End;
Procedure
Orang.Init;
Begin
X := 1; Y := 20; Mentok := Loket;
Badan[1] := (' [1] ');
Badan[2] := (' -( )- ');
Badan[3] := ('__/^\__');
End;
Procedure
Orang.Gerak;
Begin
repeat
GotoXY(X,Y); Write(Badan[1]);
GotoXY(X,Y+1); Write(Badan[2]);
GotoXY(X,Y+2); Write(Badan[3]);
Inc(X); GotoXY(16,6); Delay(20);
If X = 75 Then
Begin
GotoXY(X,Y); Clreol;
GotoXY(X,Y+1); Clreol;
GotoXY(X,Y+2); Write('______');
Delay(20);
End;
Until X = Mentok;
End;
Procedure
Antrian.input;
Var
Pil : char;
Begin
GotoXY(1,2); Write('1. Bikin Antrian');
GotoXY(1,3); Write('2. Antrian Masuk');
GotoXY(1,4); Write('3. Antrian Keluar');
GotoXY(1,5); Write('4. Bye..Bye..');
GotoXY(1,6); Write(' PILIHAN [1..4] ? ');
Pil := Readkey; Write(Pil); Out := Pil;
End;
Procedure
Antrian.create;
Var
I : integer;
Begin
For I := 18 To 22 Do
Begin
GotoXY(1,I); Clreol;
end;
For I := 1 To 80 Do Write('_');
GotoXY(58,17); Write(' ANTRIAN KARCIS');
GotoXY(60,18); Write(' _______');
GotoXY(60,19); Write(' /_______\');
GotoXY(60,20); Write(' /-| | | | |-\');
GotoXY(60,21); Write(' | | | | |
');
GotoXY(60,22); Write(' __| LOKET |__');
GotoXY(60,23); Noel := 0;
End;
Procedure
Antrian.Insertion;
Begin
If Noel >= upbound Then
Begin
Textcolor(12+Blink); GotoXY(3,23);
Write('Antrian Penuh');
Textcolor(15);
Noel := UpBound;
End
Else
Begin
Inc(Noel); Queue[Noel].Init;
Queue[Noel].Mentok := (Loket - Noel *
5) + 5;
Queue[Noel].Gerak;
End;
End;
Procedure
Antrian.Deletion;
Var
I : integer;
Front : Orang;
Begin
If Noel < lowbound Then
Begin
Textcolor(12+Blink); GotoXY(59,23);
Write(' Antrian kosong'); Textcolor(15); Noel := 0;
End
Else
Begin
Dec(Noel);
GotoXY(55,20); Write(' ');
GotoXY(55,21); Write(' ');
GotoXY(55,22); Write('_______');
Front := Queue[1];
Front.Mentok := 75;
Front.X := 72;
Front.Gerak;
For I := 1 To Noel Do Queue[I].X :=
Queue[I+1].X;
For I := 1 To Noel Do Queue[I].Gerak;
End;
End;
Procedure
Antrian.DoProses;
Var
Menu : char;
Begin
Noel := 0;
Repeat
Textcolor(15); Input(Menu);
GotoXY(1,23); Clreol;
Case Menu Of
'1' : Create;
'2' : Insertion;
'3' : Deletion;
End;
until Menu = '4';
End;
{* PROGRAM UTAMA *}
Var
Queue : Antrian;
Begin
Clrscr;
queue.doproses;
End.
6.
Tumpukan
Uses
Crt;
Type
Nama
= array [1..5] of String;
Var
Stack
: Nama;
Top
: Byte;
I,J,K
: Integer;
Ch
: Char;
Procedure
Cuwil;
Begin
Top
:= 0;
Repeat
ClrScr;
Top:=Top+1;
If
Top <=5 Then
Begin
For
I:=Top downto 1 Do
Begin
WriteLn(I,'.
',Stack[I]);
End;
GotoXY(1,1);
Write('Nama
ke-',Top,' : ');
ReadLn(Stack[Top]);
For
I:=Top downto 1 Do
Begin
WriteLn(I,'.
',Stack[I]);
End;
J:=Top;
Write('Tambahkan
nama ? (Y/T) : '); ReadLn(Ch);
End
Else
Begin
WriteLn('STOP!!');
ReadLn;
Ch:='T';
End;
Until
UpCase(Ch)='T';
End;
Procedure
Struk;
Begin
Repeat
ClrScr;
For
I:=J downto 1 Do
Begin
GotoXY(10,15-I);
WriteLn(I,'.
',Stack[I]);
End;
K:=0;
For
I:=Top Downto J+1 Do
Begin
K:=K+1;
GotoXY(50,(10+I));
WriteLn(K,'.
',Stack[I]);
End;
GotoXY(1,1);
Write('Ambil
Nama? (Y/T) : ');ReadLn(Ch);
If
UpCase(Ch) = 'Y' Then
J:=J-1;
If J<0 style="font-weight: bold;">2. Pascal Queue (ANTRIAN)
Uses
Crt;
Type
Nama
= array [1..5] of String;
Var
Stack
: Nama;
Top
: Byte;
I,J,K
: Integer;
Ch
: Char;
Procedure
Cuwil;
Begin
Top
:= 0;
Repeat
ClrScr;
Top:=Top+1;
If
Top <=5 Then
Begin
For
I:=Top downto 1 Do
Begin
WriteLn(I,'.
',Stack[I]);
End;
GotoXY(1,1);
Write('Nama
ke-',Top,' : '); ReadLn(Stack[Top]);
For
I:=Top downto 1 Do
Begin
WriteLn(I,'.
',Stack[I]);
End;
J:=Top;
Write('Tambahkan
nama ? (Y/T) : '); ReadLn(Ch);
End
Else
Begin
WriteLn('STOP!!');
ReadLn; Ch:='T';
End;
Until
UpCase(Ch)='T';
End;
Procedure
Struk;
Begin
K:=1;
Repeat
ClrScr;
For
I:=K to J Do
Begin
GotoXY(10,15-I);
WriteLn(I,'. ',Stack[I]);
End;
GotoXY(1,1);
Write('Ambil Nama? (Y/T) : ');ReadLn(Ch);
If
UpCase(Ch) = 'Y' Then K:=K+1; If K>J then
Begin
ClrScr;
WriteLn('Nama
Habis!!');
ReadLn;
Ch:='T';
End;
Until
Upcase(Ch)='T';
End;
Begin
Cuwil;
Struk;
End.
7.
Linked List
Program
Senarai_Berantai;
uses
wincrt;
const
garis ='---------------------------------------';
pesan
='Senarai Berantai Masih Kosong';
type
simpul = ^data;
data
= record
nama
: string;
alamat
: string;
berikut
: simpul;
end;
var
awal,akhir
: simpul;
pilih
: char;
cacah
: integer;
function
MENU : char;
var
P : char;
begin
clrscr;
gotoxy(30,3);
write('DAFTAR MENU PILIHAN');
gotoxy(20,8);
write('A. MENAMBAH SIMPUL DI AWAL SENARAI');
gotoxy(20,9);
write('B. MENAMBAH SIMPUL DI TENGAH SENARAI');
gotoxy(20,10);
write('C. MENAMBAH SIMPUL DI AKHIR SENARAI');
gotoxy(20,11);
write('D. MENGHAPUS SIMPUL PERTAMA');
gotoxy(20,12);
write('E. MENGHAPUS SIMPUL DI TENGAH');
gotoxy(20,13);
write('F. MENGHAPUS SIMPUL TERAKHIR');
gotoxy(20,14);
write('G. MENCETAK ISI SENARAI');
gotoxy(20,15);
write('H. SELESAI');
repeat
gotoxy(48,20);
write('':10);
gotoxy(30,20);
write('Pilih salah satu: ');
P
:= upcase(readkey);
until
P in ['A'..'H'];
MENU
:= P;
end;
function
SIMPUL_BARU : simpul;
var
B : simpul;
begin
new(B);
with
B^ do
begin
write('Nama : '); readln(nama);
write('Alamat:
'); readln(alamat);
berikut
:= nil;
end;
SIMPUL_BARU
:= B;
end;
procedure
TAMBAH_AWAL (N : integer);
var
baru
: simpul;
begin
if
N <> 0 then
begin
writeln('MENAMBAH
SIMPUL BARU DI AWAL SENARAI BERANTAI');
writeln(copy(garis,1,45));
end;
writeln;
baru
:= SIMPUL_BARU;
if
awal=nil then
akhir:=
baru
else
baru^.berikut
:= awal;
awal
:= baru;
end;
procedure
TAMBAH_AKHIR (N : integer);
var
baru
: simpul;
begin
if
N <> 0 then
begin
writeln('MENAMBAH
SIMPUL BARU DI AKHIR SENARAI BERANTAI');
writeln(copy(garis,1,46));
end;
writeln;
baru
:= SIMPUL_BARU;
if
awal=nil then
awal
:= baru
else
akhir^.berikut
:= baru;
akhir
:= baru;
end;
procedure
TAMBAH_TENGAH;
var
baru,bantu : simpul;
posisi,i : integer;
begin
writeln('MENAMBAH
SIMPUL BARU DI TENGAH SENARAI BERANTAI');
writeln(garis);
writeln;
writeln('SENARAI
BERANTAI BERISI:',cacah:2,' SIMPUL');
repeat
gotoxy(52,5);
write(' ');
gotoxy(1,5); write('SIMPUL BARU AKAN DITEMPATKAN SEBAGAI
SIMPUL NOMOR: ');
readln(posisi)
until
posisi in [1..cacah+1];
if
posisi=1 then TAMBAH_AWAL(0)
else
if posisi=cacah+1 then TAMBAH_AKHIR(0)
else
begin
writeln;
baru
:= SIMPUL_BARU;
bantu:=
awal;
for
i:=1 to posisi-2 do
bantu
:= bantu^.berikut;
baru^.berikut
:= bantu^.berikut;
bantu^.berikut
:= baru;
end;
end;
procedure
HAPUS_PERTAMA;
begin
if
awal <> nil then
begin
awal
:= awal^.berikut;
writeln('SIMPUL
PERTAMA TELAH TERHAPUS');
end
else
writeln(pesan);
writeln;
writeln('TEKAN <ENTER> UNTUK KEMBALI KE MENU UTAMA');
repeat
until keypressed
end;
procedure
HAPUS_TERAKHIR;
var
bantu : simpul;
H : integer;
begin
if
awal=nil then
begin
writeln(pesan);
H
:= 0;
end
else
if awal=akhir then
begin
awal
:= nil;
akhir:=
nil;
H
:= 1;
end
else
begin
bantu
:= awal;
while
bantu^.berikut <> akhir do
bantu
:= bantu^.berikut;
akhir
:= bantu;
akhir^.berikut
:= nil;
H
:= 1;
end;
if
H=1 then
writeln('SIMPUL
TERAKHIR TELAH TERHAPUS'); writeln;
writeln('TEKAN
<ENTER> UNTUK KEMBALI KE MENU UTAMA');
repeat
until keypressed
end;
procedure
HAPUS_TENGAH;
var
posisi,i : integer;
bantu,bantu1
: simpul;
begin
if
cacah=0 then
begin
writeln(pesan);
writeln;
writeln('TEKAN
<ENTER> UNTUK KEMBALI KE MENU UTAMA');
repeat
until keypressed
end
else
begin
writeln('MENGHAPUS
SIMPUL YANG ADA DI TENGAH');
writeln(copy(garis,1,35));
writeln;
writeln('SENARAI
BERANTAI SEKARANG BERISI :',cacah:2,' SIMPUL');
repeat
gotoxy(37,5);
write('':5);
gotoxy(1,5);
write('Akan menghapus simpul nomor berapa: ');
readln(posisi);
until
posisi in [1..cacah];
if
posisi=1 then HAPUS_PERTAMA
else
if posisi=cacah then HAPUS_TERAKHIR
else
begin
bantu
:= awal;
for
i:=1 to posisi-2 do
bantu:=
bantu^.berikut;
bantu1
:= bantu^.berikut;
bantu^.berikut
:= bantu1^.berikut;
bantu1^.berikut
:= nil;
dispose(bantu1);
end;
end;
end;
procedure
BACA_SENARAI;
var
bantu : simpul;
i : integer;
begin
i
:= 1;
writeln('MEMBACA
ISI SENARAI BERANTAI');
writeln('TEKAN
<ENTER> UNTUK KEMBALI KE MENU UTAMA');
writeln(copy(garis,1,42));
writeln;
bantu
:= awal;
if
bantu=nil then
writeln(pesan)
else
while
bantu <> nil do
begin
writeln('Simpul:
',i:2,'---> Nama : ',bantu^.nama);
writeln('':15,'Alamat:
',bantu^.alamat);
bantu
:= bantu^.berikut;
inc(i);
end;
repeat
until keypressed
end;
{PROGRAM
UTAMA}
begin
cacah
:= 0;
awal
:= nil;
akhir
:= nil;
repeat
pilih
:= MENU;
clrscr;
case
pilih of
'A'
: TAMBAH_AWAL(1);
'B'
: TAMBAH_TENGAH;
'C'
: TAMBAH_AKHIR(1);
'D'
: HAPUS_PERTAMA;
'E'
: HAPUS_TENGAH;
'F'
: HAPUS_TERAKHIR;
'G'
: BACA_SENARAI;
end;
if
pilih in ['A','B','C'] then inc(cacah)
else
if (pilih in ['D','E','F']) and (cacah <> 0) then
dec(cacah)
until
pilih='H'
end.
8.
Pengurutan
uses
wincrt;
type
datamhs = record
NIM
: integer;
Nama
: string;
Nilai
: integer;
end;
var
i,j,temp,jumlah : integer;
mahasiswa
: array [1..100] of datamhs;
begin
write('Masukan
jumlah mahasiswa : ');
readln(jumlah);
for
I:=1 to jumlah do
begin
writeln('Mahasiswa
ke-',i);
write('Masukkan
NIM : '); readln(mahasiswa[i].NIM);
write('Masukkan
Nama : '); readln(mahasiswa[i].Nama);
write('Masukkan
Nilai : '); readln(mahasiswa[i].Nilai);
writeln;
writeln;
end;
writeln('Daftar
Mahasiswa yang belum terurut ');
writeln('| NO | NIM | NAMA
| NILAI |');
for
I:=1 to jumlah do
begin
writeln(
i : 4,' ',mahasiswa[i].NIM:8,' ',mahasiswa[i].NAMA:11,'
',mahasiswa[i].NILAI:11);
end;
writeln;
writeln;
for
i :=1 to jumlah do
begin
temp:=mahasiswa[i].Nilai;
j:=i-1;
while(j>=0)
and (temp<mahasiswa[j].Nilai)do
begin
mahasiswa[j+1].Nilai:=mahasiswa[j].Nilai;
j:=j-1;
end;
mahasiswa[j+1].Nilai:=temp;
end;
writeln;
writeln('Daftar
Mahasiswa yang sudah terurut ');
writeln('| NO
| NIM |
NAMA | NILAI
');
for
I:=1 to jumlah do
begin
writeln
( i : 4,' ',mahasiswa[i].NIM:8,' ',mahasiswa[i].NAMA:11,'
',mahasiswa[i].NILAI:11);
end;
end.
9.
Pencarian
program
searching;
uses
wincrt;
label
awal;
var
pil:char;
lg :char;
{procedure
Sequintial_search/pencarian secara berurutan}
procedure
seq_search1;
const
nmin = 1;
nmax = 100;
type
arrint = array [nmin..nmax] of integer;
var
x
: integer;
tabint : arrint;
n,i
: integer;
indeks : 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
clrscr;
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);
indeks:=seqsearch1(x);
if indeks <> 0 then
write(x,' ditemukan pada indeks
ke-',indeks)
else
write(x,' tidak ditemukan');
writeln;
end;
{procedure
sequintial search 2}
procedure
seq_search2;
const
nmin = 1;
nmax = 100;
type
arrint = array[nmin..nmax] of integer;
var
x
: integer;
tabint : arrint;
n,i
: integer;
indeks : integer;
function seqsearch2(xx : integer): integer;
var i : integer;
ditemukan : boolean;
begin
ditemukan:=false;
i:=1;
while ((i<n) and (not ditemukan)) do
if tabint[i]=xx then
ditemukan:=true
else i:=i+1;
if ditemukan = true then
seqsearch2:=i
else
seqsearch2:=0;
end;
begin
clrscr;
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);
indeks:=seqsearch2(x);
if indeks <> 0 then
write(x,' ditemukan pada indeks
ke-',indeks)
else
write(x,' tidak ditemukan');
writeln;
end;
{procedure
sequintial search 3}
procedure
seq_search3;
var
L: array[1..5] of integer;
bil,i : integer;
begin
clrscr;
write('Angka yang dicari= '); readln(bil);
L[1]:=1;
L[2]:=3;
L[3]:=5;
L[4]:=7;
L[5]:=9;
i:=i+1;
while (i<5) and (L[i] <> bil) do
begin
i:=i+1;
end;
if (L[i]=bil) then
writeln('Ditemukan pada elemen larik ke-',i)
else
writeln('Tidak ditemukan!');
writeln;
end;
{procedure
Binary Search}
procedure
binarysearch;
const
nmin = 1;
nmax = 100;
type
arrint = array [nmin..nmax] of integer;
var
x
: integer;
tabint : arrint;
n,i
: integer;
indeks : integer;
function binarysearch(xx : integer): integer;
var
i : integer;
atas, bawah, tengah : integer;
ditemukan : boolean;
indeksxx : integer;
begin
atas
:= 1;
bawah := n;
ditemukan:=false;
indeksxx:=0;
while ((atas <= bawah) and (not
ditemukan)) do
begin
tengah:= (atas+bawah) div 2;
if xx = tabint[tengah] then
begin
ditemukan:= true;
indeksxx := tengah;
end
else
begin
if xx = tabint[tengah] then
bawah:= tengah - 1
else
atas:= tengah + 1;
end;
end;
binarysearch:=indeks;
end;
begin
clrscr;
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);
indeks:=binarysearch(x);
if indeks <> 0 then
write(x,' ditemukan pada indeks
ke-',indeks)
else
write(x,' tidak ditemukan');
end;
{procedure
mencari nilai maksimum}
procedure
cari_maks;
type
arrint = array [1..100] of integer;
var
maks
: integer;
tabint : arrint;
nn, i
: integer;
function maksimum(tabint : arrint; n :
integer) : integer;
var
i :
integer;
max : integer;
begin
for i:=2 to n do
if max< tabint[i] then
max:= tabint[i];
maksimum:=max;
end;
begin
clrscr;
write('jumlah elemen = '); readln(nn);
for i:= 1 to nn do
begin
write('elemen ke-',i,' = ');
readln(tabint[i]);
end;
maks:= maksimum(tabint, nn);
writeln('nilai Maksimum = ',maks);
end;
{program
utama}
begin
awal:
clrscr;
gotoxy(24,5); write('MENU UTAMA PROGRAM PENCARIAN');
gotoxy(20,7);
write('[1] Procedure Sequintial Search 1');
gotoxy(20,9);
write('[2] Procedure Sequintial Search 2');
gotoxy(20,11); write('[3] Procedure
Sequintial Search 3');
gotoxy(20,13); write('[4] Procedure Binary
Search');
gotoxy(20,15); write('[5] Procedure Mencari
Nilai Maksimum');
gotoxy(20,17); write('[X] Keluar');
gotoxy(18,20); write('Silahkan Masukkan
Pilihan : ');
repeat
pil:=readkey;
until pil in ['1'..'5','X','x'];
case pil of
'1': seq_search1;
'2': seq_search2;
'3': seq_search3;
'4': binarysearch;
'5': cari_maks;
'X','x': exit;
end;
gotoxy(1,22); write('Kembali ke Menu Utama?
(Y/N)');
repeat
lg:=readkey;
until lg in ['Y','y','N','n'];
if lg in ['Y','y'] then goto awal;
end.
Langganan:
Postingan
(Atom)
0 komentar:
Posting Komentar