http://www.konsultasivb.com
http://www.belajarvb.com
http://www.pemrogramanvb.com
http://www.tugasakhirvb.com
http://www.meriwardana.blogspot.com
http://contohcontohprogramvb.blogspot.com/
http://www.codeguru.com/
http://www.codeguru.com/csharp/.net/net_data/datagrid/article.php/c13041
http://diazscript.wordpress.com/2010/12/29/mengoneksikan-database-be-k-access-menggunakan-source-app-path/
http://prodisi.wordpress.com/
http://ekakom.blogspot.com/
http://xbasicpro.com/
http://www.i-bego.com/
Program Mencari Nilai Terkecil
program max_min;
uses wincrt;
var
bil:array[1..100] of integer;
terbesar :integer;
terkecil :integer;
i,n :integer;
begin
clrscr;
writeln;write(' Ada berapa bilangan =');readln(n);
for i:= 1 to n do
begin
write(' Bilangan ke ',i,' = ');readln(bil[i]);
end;
terbesar:=bil[1];
terkecil:=bil[1];
for i:= 2 to n do
if bil[i] > terbesar then
terbesar:=bil[i]
else
if bil[i] < terkecil then
terkecil:=bil[i];
writeln(' -----------------');
writeln(' Bilangan terkecil =',terkecil);
readln;
end.
uses wincrt;
var
bil:array[1..100] of integer;
terbesar :integer;
terkecil :integer;
i,n :integer;
begin
clrscr;
writeln;write(' Ada berapa bilangan =');readln(n);
for i:= 1 to n do
begin
write(' Bilangan ke ',i,' = ');readln(bil[i]);
end;
terbesar:=bil[1];
terkecil:=bil[1];
for i:= 2 to n do
if bil[i] > terbesar then
terbesar:=bil[i]
else
if bil[i] < terkecil then
terkecil:=bil[i];
writeln(' -----------------');
writeln(' Bilangan terkecil =',terkecil);
readln;
end.
Contoh Procedure Input dan Edit
program cb;
uses wincrt;
type
data_mahasiswa = record
Nim : string[6];
Nama : string[25];
jurusan : string[15];
fakultas : string[15] ;
alamat : string[50];
hoby :string[10];
end;
dtmahasiswa = array [1..10] of data_mahasiswa;
{var
mhs : dtmahasiswa ; }
procedure masukkan_data;
var
i,x : integer;
dtmhs : data_mahasiswa ;
jawab : char;
Begin
repeat
clrscr;
with dtmhs do
begin
Write('---< masukkan data dari mahasiswa >--- ') ;
writeln;
writeln;
Write('masukkan nim :'); readln(nim);
Write('masukkan nama :'); readln(nama);
Write('masukkan jurussan :'); readln(jurusan);
Write('masukkan fakultas:'); readln(fakultas);
Write('masukkan alamat:'); readln(alamat);
Write('masukkan hoby :'); readln(hoby);
Writeln;
end;
write('menambah data lagi [y/t]?');
repeat
jawab := readkey
until jawab in ['Y','y','T','t'];
readln(jawab)
until upcase(jawab)='T'
end;
procedure menggantidata;
var
i,x : integer;
dtmhs : data_mahasiswa ;
jawab : char;
nim_cari : string[6];
ketemu : boolean;
begin
with dtmhs do
repeat
clrscr;
write('Nim dari data yang akan diganti :');
readln(nim_cari);
begin
ketemu := false;
{while (not eof (file_pegawai) and (not ketemu) do
begin
read(file_pegawai, data_pegawai);}
if dtmhs.nim = nim_cari then
ketemu := true
end;
if ketemu then
begin
writeln('--< data edit mahsiswa >-- ');
writeln(' [1]. nama :',nama);read(nama);
writeln(' [2]. alamat : ',alamat);read(alamat);
writeln(' [3]. jurusan :',jurusan);read(jurusan);
writeln(' [4]. fakultas : ', fakultas);read(fakultas);
writeln(' [5]. hoby :',hoby);read(hoby);
end
else
begin
write('data tersebut tidak ditemukan');
end;
write('Mau mengubah data lagi (y/t)?');
repeat
jawab := readkey
until jawab in ['Y','y','T','t'];
write(jawab);
until upcase(jawab)='T'
end;
begin
masukkan_data;
menggantidata;
end.
uses wincrt;
type
data_mahasiswa = record
Nim : string[6];
Nama : string[25];
jurusan : string[15];
fakultas : string[15] ;
alamat : string[50];
hoby :string[10];
end;
dtmahasiswa = array [1..10] of data_mahasiswa;
{var
mhs : dtmahasiswa ; }
procedure masukkan_data;
var
i,x : integer;
dtmhs : data_mahasiswa ;
jawab : char;
Begin
repeat
clrscr;
with dtmhs do
begin
Write('---< masukkan data dari mahasiswa >--- ') ;
writeln;
writeln;
Write('masukkan nim :'); readln(nim);
Write('masukkan nama :'); readln(nama);
Write('masukkan jurussan :'); readln(jurusan);
Write('masukkan fakultas:'); readln(fakultas);
Write('masukkan alamat:'); readln(alamat);
Write('masukkan hoby :'); readln(hoby);
Writeln;
end;
write('menambah data lagi [y/t]?');
repeat
jawab := readkey
until jawab in ['Y','y','T','t'];
readln(jawab)
until upcase(jawab)='T'
end;
procedure menggantidata;
var
i,x : integer;
dtmhs : data_mahasiswa ;
jawab : char;
nim_cari : string[6];
ketemu : boolean;
begin
with dtmhs do
repeat
clrscr;
write('Nim dari data yang akan diganti :');
readln(nim_cari);
begin
ketemu := false;
{while (not eof (file_pegawai) and (not ketemu) do
begin
read(file_pegawai, data_pegawai);}
if dtmhs.nim = nim_cari then
ketemu := true
end;
if ketemu then
begin
writeln('--< data edit mahsiswa >-- ');
writeln(' [1]. nama :',nama);read(nama);
writeln(' [2]. alamat : ',alamat);read(alamat);
writeln(' [3]. jurusan :',jurusan);read(jurusan);
writeln(' [4]. fakultas : ', fakultas);read(fakultas);
writeln(' [5]. hoby :',hoby);read(hoby);
end
else
begin
write('data tersebut tidak ditemukan');
end;
write('Mau mengubah data lagi (y/t)?');
repeat
jawab := readkey
until jawab in ['Y','y','T','t'];
write(jawab);
until upcase(jawab)='T'
end;
begin
masukkan_data;
menggantidata;
end.
Contoh Procedure Input
program penjualan_tape;
uses wincrt;
type
jualTape = record
jumlah : integer;
jenis : string;
harga,bagus,total : integer;
end;
procedure input;
var
i,n,jumlah : integer ;
kelas : string ;
harga : integer ;
penjual : string ;
bagus,total: integer;
tape : array [1..5] of jualTape;
bagus_ganteng: jualTape;
begin
with bagus_ganteng do
begin
write('masukkan jumlah data yang akan di masukkan = ');readln(n);
for i:=1 to n do
begin
bagus:=0;
total:=0;
writeln('Data penjualan tape 2011-2012');
writeln;
write('masukkan nama penjual = ');readln(penjual);
write('masukkan jumlah tape yang terjual = ');readln(jumlah);
write('masukkan jenis tape = ');readln(jenis);
write('masukkan kelas tape = ');readln(kelas);
write('masukkan harga per-bungkus = ');readln(harga);
writeln('----------------------------------------------------');
end;
bagus:=bagus+(jumlah[i]);
total:=total+harga;
writeln('total pemasukan hari ini = ',total);
writeln('jumlah tape yang terjual hari ini = ',bagus);
end;
end;
begin
input;
end.
uses wincrt;
type
jualTape = record
jumlah : integer;
jenis : string;
harga,bagus,total : integer;
end;
procedure input;
var
i,n,jumlah : integer ;
kelas : string ;
harga : integer ;
penjual : string ;
bagus,total: integer;
tape : array [1..5] of jualTape;
bagus_ganteng: jualTape;
begin
with bagus_ganteng do
begin
write('masukkan jumlah data yang akan di masukkan = ');readln(n);
for i:=1 to n do
begin
bagus:=0;
total:=0;
writeln('Data penjualan tape 2011-2012');
writeln;
write('masukkan nama penjual = ');readln(penjual);
write('masukkan jumlah tape yang terjual = ');readln(jumlah);
write('masukkan jenis tape = ');readln(jenis);
write('masukkan kelas tape = ');readln(kelas);
write('masukkan harga per-bungkus = ');readln(harga);
writeln('----------------------------------------------------');
end;
bagus:=bagus+(jumlah[i]);
total:=total+harga;
writeln('total pemasukan hari ini = ',total);
writeln('jumlah tape yang terjual hari ini = ',bagus);
end;
end;
begin
input;
end.
Penjumlahan Tiga Array Dan Mencari Nilai Rata-rata
program coba ;
uses wincrt ;
var
bil1:array[1..100] of integer;
bil2:array[1..100] of integer;
bil3:array[1..100] of integer;
rata :real;
jumlah1 :integer;
jumlah2 :integer;
jumlah3, total :integer;
i,n :integer;
begin
clrscr;
writeln;
write(' jumlah N pertama =');readln(n);
for i:= 1 to n do
begin
write(' Bilangan ke ',i,' = ');readln(bil1[i]);
end;
jumlah1 := n+n;
writeln;
write(' jumlah N kedua =');readln(n);
for i:= 1 to n do
begin
write(' Bilangan ke ',i,' = ');readln(bil2[i]);
end;
jumlah2 := n+n;
writeln;
write(' jumlah N ketiga =');readln(n);
for i:= 1 to n do
begin
write(' Bilangan ke ',i,' = ');readln(bil3[i]);
end;
jumlah3 := n+n;
total := jumlah1+jumlah2+jumlah3;
rata := total div n;
writeln;
write(' jumlah ke 1 ',jumlah1);
writeln;
write(' jumlah ke 2 ',jumlah2);
writeln;
write(' jumlah ke 3 ', jumlah3);
writeln;
write(' total ', total);
writeln;
write(' rata ',rata:2:2) ;
end.
uses wincrt ;
var
bil1:array[1..100] of integer;
bil2:array[1..100] of integer;
bil3:array[1..100] of integer;
rata :real;
jumlah1 :integer;
jumlah2 :integer;
jumlah3, total :integer;
i,n :integer;
begin
clrscr;
writeln;
write(' jumlah N pertama =');readln(n);
for i:= 1 to n do
begin
write(' Bilangan ke ',i,' = ');readln(bil1[i]);
end;
jumlah1 := n+n;
writeln;
write(' jumlah N kedua =');readln(n);
for i:= 1 to n do
begin
write(' Bilangan ke ',i,' = ');readln(bil2[i]);
end;
jumlah2 := n+n;
writeln;
write(' jumlah N ketiga =');readln(n);
for i:= 1 to n do
begin
write(' Bilangan ke ',i,' = ');readln(bil3[i]);
end;
jumlah3 := n+n;
total := jumlah1+jumlah2+jumlah3;
rata := total div n;
writeln;
write(' jumlah ke 1 ',jumlah1);
writeln;
write(' jumlah ke 2 ',jumlah2);
writeln;
write(' jumlah ke 3 ', jumlah3);
writeln;
write(' total ', total);
writeln;
write(' rata ',rata:2:2) ;
end.
Pengurutan Data Menggunakan Bubble Sort 2
program sort;
uses Wincrt;
var
angka: array[1..5] of integer;
i,a, temp: integer;
begin
{Mengisi array}
angka[1] := 3;
angka[2] := 5;
angka[3] := 4;
angka[4] := 2;
angka[5] := 1;
{Tampilkan data sebelum diurutkan}
writeln('Sebelum diurutkan : ');
for i:=1 to 5 do
begin
writeln('angka ke-', i, ' : ', angka[i]);
end;
{Lakukan pengurutan/sorting}
for i:=1 to 4 do
begin
for a:=i+1 to 5 do
begin
if(angka[a] < angka[i]) then
begin
temp := angka[a];
angka[a] := angka[i];
angka[i] := temp;
end;
end;
end;
{Tampilkan data setelah diurutkan}
writeln('Setelah diurutkan : ');
for i:=1 to 5 do
begin
writeln('angka ke-', i, ' : ', angka[i]);
end;
end.
uses Wincrt;
var
angka: array[1..5] of integer;
i,a, temp: integer;
begin
{Mengisi array}
angka[1] := 3;
angka[2] := 5;
angka[3] := 4;
angka[4] := 2;
angka[5] := 1;
{Tampilkan data sebelum diurutkan}
writeln('Sebelum diurutkan : ');
for i:=1 to 5 do
begin
writeln('angka ke-', i, ' : ', angka[i]);
end;
{Lakukan pengurutan/sorting}
for i:=1 to 4 do
begin
for a:=i+1 to 5 do
begin
if(angka[a] < angka[i]) then
begin
temp := angka[a];
angka[a] := angka[i];
angka[i] := temp;
end;
end;
end;
{Tampilkan data setelah diurutkan}
writeln('Setelah diurutkan : ');
for i:=1 to 5 do
begin
writeln('angka ke-', i, ' : ', angka[i]);
end;
end.
Program Sequential Sort
program sequential_searh_boolean;
uses wincrt;
const max=100;
type tabinteger=array[1..max] of integer;
var
tabint:tabinteger;
jml_data,data,indeks:integer;
found:boolean;
cari:char;
procedure input(n:integer; var t:tabinteger);
var
i:integer;
begin
for i:=1 to n do
begin
write ('nilai ke - ',i,' : ');
readln(t[i]);
end;
end;
procedure search(t :tabinteger; n,x :integer;var idx:integer);
var i:integer;
begin
i:=1;
found :=false;
while (i<=n) and (not found) do
begin
if t[i]=x then
found:=true
else
i:=i+1;
end;
if found then
idx:=i
else
idx:=0;
end;
begin
clrscr;
write('Banyaknya Data : ');readln(jml_data);
writeln;
input(jml_data,tabint);
repeat
writeln;
write('Masukkan data yang akan dicari : ');readln(data);
search(tabint, jml_data,data,indeks);
if indeks=0 then
writeln('Ngapunten Data Yang Anda Masukkan Tidak ada')
else
writeln('Data ditemukan pada posisi ke-',indeks);
writeln;
write('cari data lagi (y/t) ? ');readln(cari);
until(cari='t')or (cari='T');
readln;
end.
uses wincrt;
const max=100;
type tabinteger=array[1..max] of integer;
var
tabint:tabinteger;
jml_data,data,indeks:integer;
found:boolean;
cari:char;
procedure input(n:integer; var t:tabinteger);
var
i:integer;
begin
for i:=1 to n do
begin
write ('nilai ke - ',i,' : ');
readln(t[i]);
end;
end;
procedure search(t :tabinteger; n,x :integer;var idx:integer);
var i:integer;
begin
i:=1;
found :=false;
while (i<=n) and (not found) do
begin
if t[i]=x then
found:=true
else
i:=i+1;
end;
if found then
idx:=i
else
idx:=0;
end;
begin
clrscr;
write('Banyaknya Data : ');readln(jml_data);
writeln;
input(jml_data,tabint);
repeat
writeln;
write('Masukkan data yang akan dicari : ');readln(data);
search(tabint, jml_data,data,indeks);
if indeks=0 then
writeln('Ngapunten Data Yang Anda Masukkan Tidak ada')
else
writeln('Data ditemukan pada posisi ke-',indeks);
writeln;
write('cari data lagi (y/t) ? ');readln(cari);
until(cari='t')or (cari='T');
readln;
end.
Program Input, Edit, Cetak Library Book
Program Data_Buku_Perpustakaan;
uses wincrt;
type Buku=Record
Kodebuku :integer;
Judul :string;
Pengarang :String;
Tahun :Integer;
Harga :Integer;
end;
var
Filebuku:file of buku;
Data:buku;
Pil,Ul:Char;
procedure Menu;
begin
clrscr;
writeln('..:::Menu Pilihan:::...');
writeln('=======================');
writeln('1. Input Data Library Book');
writeln('2. Edit Data Library Book');
writeln('3. Cetak Data Library Book');
writeln('4. Keluar');
writeln;
write('Pilih Angka [1-4] : ');Pil:=Readkey;
end;
procedure BukaFile;
begin
Assign(Filebuku,'buku.dat');
{$I-};
Reset(Filebuku);
{$I+};
End;
procedure Input;
var
Lagi:Char;
Ada:boolean;
i:integer;
Nocr:integer;
begin
Ul:='Y';
Lagi:='Y';
Clrscr;
bukaFile;
if IOResult<>0 then
Rewrite(Filebuku);
Repeat
Clrscr;
ada:=False;
I:=0;
Writeln('..:::Input Data Buku:::...');
writeln('===============================');
writeln;
write('Kode Buku : ');Readln(Nocr);
while (Ada=False) And (i<>Filesize(Filebuku)) do
begin
Seek(Filebuku,i);
read(filebuku,Data);
if Data.Kodebuku=Nocr then
Ada:=true
else
inc(i);
End;
if (Ada=True) then
begin
writeln('Kode Buku"',Nocr,'"Kode Ini Sudah Ada');
end
else
begin
seek(Filebuku,Filesize(Filebuku));
Data.Kodebuku:=Nocr;
write('Judul Buku : ');readln(Data.Judul);
write('Nama Pengarang : ');readln(Data.Pengarang);
write('Tahun Buku : ');readln(Data.Tahun);
write('Harga Buku : ');readln(Data.Harga);
write(Filebuku,Data);
end;
write('Mau Tambah Data Lagi [Y/T]: ');Lagi:=Upcase(readkey);
Until Lagi<>'Y';
Close(Filebuku);
end;
procedure Edit;
var
Lagi:Char;
Ada:boolean;
i:integer;
Nocr:integer;
begin
Ul:='Y';
Lagi:='Y';
Clrscr;
BukaFile;
if IOResult<>0 then
write('Data masih Kosong..!')
else
begin
Repeat
Clrscr;
ada:=False;
i:=0;
Writeln('...:::Edit Data Buku:::...');
writeln('===============================');
writeln;
Write('Kode Buku : ');readln(Nocr);
while (Ada=False) And (i<>Filesize(Filebuku)) do
begin
seek(Filebuku,i);
Read(Filebuku,data);
if Data.Kodebuku=Nocr then
begin
ada:=true;
Writeln('Judul Buku : ',Data.Judul);
writeln('Pengarang : ',Data.Pengarang);
Writeln('Tahun BUku : ',Data.Tahun);
writeln('Harga Buku : ',Data.Harga);
end
else
Inc(i);
End;
if (Ada=True) then
begin
data.Kodebuku:=Nocr;
Write('Judul Buku : ');readln(Data.Judul);
write('Pengarang : ');readln(Data.Pengarang);
Write('Tahun Buku : ');readln(Data.Tahun);
write('Harga Buku : ');readln(Data.Harga);
Seek(Filebuku,i);
Write(Filebuku,Data);
end
else
begin
write('Kode Buku',Nocr,'Ini Tidak Ada..!');
end;
write('Mau Edit Data Lagi [Y/T]:'); Lagi:=Upcase(readkey);
Until Lagi<>'Y';
End;
close(Filebuku);
end;
procedure Cetak;
var
I:integer;
TIPK:Real;
begin
Ul:='Y';
TIPK:=0;
BukaFile;
if IOResult<>0 then
write('Maaf Data Masih Kosong...!')
else
begin
Clrscr;
Writeln(' Data Library Book ');
writeln(' The Largest Acewell Community ');
writeln;
writeln('===============================================');
writeln(' NO JUDUL PENGARANG TAHUN HARGA (Rp) ');
writeln('===============================================');
i:=0;
while Not EOF(filebuku) do
begin
inc(i);
Read(Filebuku,Data);
writeln(i:3,Data.Judul:6,Data.Pengarang:10,data.Tahun:13,data.harga:8);
end;
Close(Filebuku);
end;
writeln;
write('Prees Any Key to Continue...');readkey;
end;
begin
Repeat
menu;
Case Pil Of
'1':Input;
'2':Edit;
'3':Cetak;
end;
Until(Ul<>'Y') or (Pil='4');
end.
uses wincrt;
type Buku=Record
Kodebuku :integer;
Judul :string;
Pengarang :String;
Tahun :Integer;
Harga :Integer;
end;
var
Filebuku:file of buku;
Data:buku;
Pil,Ul:Char;
procedure Menu;
begin
clrscr;
writeln('..:::Menu Pilihan:::...');
writeln('=======================');
writeln('1. Input Data Library Book');
writeln('2. Edit Data Library Book');
writeln('3. Cetak Data Library Book');
writeln('4. Keluar');
writeln;
write('Pilih Angka [1-4] : ');Pil:=Readkey;
end;
procedure BukaFile;
begin
Assign(Filebuku,'buku.dat');
{$I-};
Reset(Filebuku);
{$I+};
End;
procedure Input;
var
Lagi:Char;
Ada:boolean;
i:integer;
Nocr:integer;
begin
Ul:='Y';
Lagi:='Y';
Clrscr;
bukaFile;
if IOResult<>0 then
Rewrite(Filebuku);
Repeat
Clrscr;
ada:=False;
I:=0;
Writeln('..:::Input Data Buku:::...');
writeln('===============================');
writeln;
write('Kode Buku : ');Readln(Nocr);
while (Ada=False) And (i<>Filesize(Filebuku)) do
begin
Seek(Filebuku,i);
read(filebuku,Data);
if Data.Kodebuku=Nocr then
Ada:=true
else
inc(i);
End;
if (Ada=True) then
begin
writeln('Kode Buku"',Nocr,'"Kode Ini Sudah Ada');
end
else
begin
seek(Filebuku,Filesize(Filebuku));
Data.Kodebuku:=Nocr;
write('Judul Buku : ');readln(Data.Judul);
write('Nama Pengarang : ');readln(Data.Pengarang);
write('Tahun Buku : ');readln(Data.Tahun);
write('Harga Buku : ');readln(Data.Harga);
write(Filebuku,Data);
end;
write('Mau Tambah Data Lagi [Y/T]: ');Lagi:=Upcase(readkey);
Until Lagi<>'Y';
Close(Filebuku);
end;
procedure Edit;
var
Lagi:Char;
Ada:boolean;
i:integer;
Nocr:integer;
begin
Ul:='Y';
Lagi:='Y';
Clrscr;
BukaFile;
if IOResult<>0 then
write('Data masih Kosong..!')
else
begin
Repeat
Clrscr;
ada:=False;
i:=0;
Writeln('...:::Edit Data Buku:::...');
writeln('===============================');
writeln;
Write('Kode Buku : ');readln(Nocr);
while (Ada=False) And (i<>Filesize(Filebuku)) do
begin
seek(Filebuku,i);
Read(Filebuku,data);
if Data.Kodebuku=Nocr then
begin
ada:=true;
Writeln('Judul Buku : ',Data.Judul);
writeln('Pengarang : ',Data.Pengarang);
Writeln('Tahun BUku : ',Data.Tahun);
writeln('Harga Buku : ',Data.Harga);
end
else
Inc(i);
End;
if (Ada=True) then
begin
data.Kodebuku:=Nocr;
Write('Judul Buku : ');readln(Data.Judul);
write('Pengarang : ');readln(Data.Pengarang);
Write('Tahun Buku : ');readln(Data.Tahun);
write('Harga Buku : ');readln(Data.Harga);
Seek(Filebuku,i);
Write(Filebuku,Data);
end
else
begin
write('Kode Buku',Nocr,'Ini Tidak Ada..!');
end;
write('Mau Edit Data Lagi [Y/T]:'); Lagi:=Upcase(readkey);
Until Lagi<>'Y';
End;
close(Filebuku);
end;
procedure Cetak;
var
I:integer;
TIPK:Real;
begin
Ul:='Y';
TIPK:=0;
BukaFile;
if IOResult<>0 then
write('Maaf Data Masih Kosong...!')
else
begin
Clrscr;
Writeln(' Data Library Book ');
writeln(' The Largest Acewell Community ');
writeln;
writeln('===============================================');
writeln(' NO JUDUL PENGARANG TAHUN HARGA (Rp) ');
writeln('===============================================');
i:=0;
while Not EOF(filebuku) do
begin
inc(i);
Read(Filebuku,Data);
writeln(i:3,Data.Judul:6,Data.Pengarang:10,data.Tahun:13,data.harga:8);
end;
Close(Filebuku);
end;
writeln;
write('Prees Any Key to Continue...');readkey;
end;
begin
Repeat
menu;
Case Pil Of
'1':Input;
'2':Edit;
'3':Cetak;
end;
Until(Ul<>'Y') or (Pil='4');
end.
Menghitung Nilai Rata-rata
var a, siswa : integer;
nilai, total, tinggi, rendah, rata : real;
begin
total := 0;
write ('jumlah siswa : '); readln (siswa);
writeln;
for a := 1 to siswa do
begin
write ('nilai siswa ke ',a,' : '); readln (nilai);
total := total + nilai;
if a = 1 then begin
tinggi := nilai;
rendah := nilai;
end
else begin
if nilai > tinggi then tinggi := nilai
else begin
if nilai < rendah then rendah := nilai;
end;
end;
end;
rata := total / siswa;
writeln;
writeln ('nilai terendah : ', rendah :1:2);
writeln ('nilai tertinggi : ', tinggi :1:2);
writeln ('rata-rata : ',rata :1:2);
end.
nilai, total, tinggi, rendah, rata : real;
begin
total := 0;
write ('jumlah siswa : '); readln (siswa);
writeln;
for a := 1 to siswa do
begin
write ('nilai siswa ke ',a,' : '); readln (nilai);
total := total + nilai;
if a = 1 then begin
tinggi := nilai;
rendah := nilai;
end
else begin
if nilai > tinggi then tinggi := nilai
else begin
if nilai < rendah then rendah := nilai;
end;
end;
end;
rata := total / siswa;
writeln;
writeln ('nilai terendah : ', rendah :1:2);
writeln ('nilai tertinggi : ', tinggi :1:2);
writeln ('rata-rata : ',rata :1:2);
end.
Program Pengurutan data dengan Larik
program pengurutan_data;
uses wincrt;
const NilaiMaksimum = 1000;
type Larik = array[1..NilaiMaksimum] of integer;
var
L : Larik;
batas : integer;
procedure masukan (var L : Larik; n : integer);
var
a : integer;
begin
for a := 1 to n do
begin
write('Masukkan Nilai Ke-' ,a,' : '); readln(L[a]);
end;
end;
procedure pengurutan (var L : Larik; n : integer);
var
i : integer;
k : integer;
temp : integer;
begin
for i := 1 to (n-1) do
for k := n downto i+1 do
if L[k] < L[k-1] then
begin
temp := L[k];
L[k] := L[k-1];
L[k-1] := temp;
end;
end;
procedure keluaran(var L : Larik; n : integer);
var
i : integer;
begin
for i := 1 to n do
write(L[i]:5);
end;
begin
writeln ('*******************************************') ;
write('Masukkan Jumlah Elemen yang diinginkan : '); readln(batas);
writeln ('*******************************************') ;
writeln;
masukan(L,batas) ; writeln;
pengurutan (L,batas); writeln;
writeln ('************************') ;
writeln('Hasil Pengurutan Larik : ');
writeln ('************************') ;
keluaran(L,batas);
end.
uses wincrt;
const NilaiMaksimum = 1000;
type Larik = array[1..NilaiMaksimum] of integer;
var
L : Larik;
batas : integer;
procedure masukan (var L : Larik; n : integer);
var
a : integer;
begin
for a := 1 to n do
begin
write('Masukkan Nilai Ke-' ,a,' : '); readln(L[a]);
end;
end;
procedure pengurutan (var L : Larik; n : integer);
var
i : integer;
k : integer;
temp : integer;
begin
for i := 1 to (n-1) do
for k := n downto i+1 do
if L[k] < L[k-1] then
begin
temp := L[k];
L[k] := L[k-1];
L[k-1] := temp;
end;
end;
procedure keluaran(var L : Larik; n : integer);
var
i : integer;
begin
for i := 1 to n do
write(L[i]:5);
end;
begin
writeln ('*******************************************') ;
write('Masukkan Jumlah Elemen yang diinginkan : '); readln(batas);
writeln ('*******************************************') ;
writeln;
masukan(L,batas) ; writeln;
pengurutan (L,batas); writeln;
writeln ('************************') ;
writeln('Hasil Pengurutan Larik : ');
writeln ('************************') ;
keluaran(L,batas);
end.
Pengurutan Data Menggunakan Bubble Sort
program inputdtmhs;
uses wincrt;
type
dtmhs=record
nomor : integer;
nama : string [20];
IP : real;
end;
_dtmhs = array[1..10] of dtmhs;
procedure input;
var
jumlahmhs,
I,J : byte;
Mahasiswa : array[1..10] of dtMhs;
Dummy : dtmhs;
Begin
(*memasukkan data mahasiswa*)
write('jumlah mahasiswa?'); readln(jumlahmhs);
for I:=1 to jumlahmhs do
begin
writeln;
with mahasiswa [I] do
begin
writeln;
write('nomor mahasiswa ke',I:2,'?'); readln(nomor);
write('nama mahasiswa ke',I:2,'?'); readln(nama);
write('IP mahasiswa ke',I:2,'?'); readln(IP);
end;
end;
(* mengurutkan data berdasarkan nomor mahasiswa metode Bubble sort *)
{
For I:=1 to JumlahMhs-1 Do
For J:= 1 to JumlahMhs-1 Do
If Mahasiswa[J] .Nomor > Mahasiswa[J+1].Nomor Then
Begin
Dummy := Mahasiswa [J];
Mahasiswa[J] := Mahasiswa [J+1];
Mahasiswa[J+1]:= Dummy;
End;
}
(*menampilkan hasil *)
Writeln;
Writeln('............................');
Writeln('Nomor Indeks');
Writeln('Mhs Nama mahasiswa Prestasi');
Writeln('............................');
begin
For i:=1 to JumlahMhs Do
Begin
With Mahasiswa [i] Do
Writeln(Nomor:5,Nama:20, IP:11:2);
End;
Writeln('............................');
end;
end;
begin
input;
end.
uses wincrt;
type
dtmhs=record
nomor : integer;
nama : string [20];
IP : real;
end;
_dtmhs = array[1..10] of dtmhs;
procedure input;
var
jumlahmhs,
I,J : byte;
Mahasiswa : array[1..10] of dtMhs;
Dummy : dtmhs;
Begin
(*memasukkan data mahasiswa*)
write('jumlah mahasiswa?'); readln(jumlahmhs);
for I:=1 to jumlahmhs do
begin
writeln;
with mahasiswa [I] do
begin
writeln;
write('nomor mahasiswa ke',I:2,'?'); readln(nomor);
write('nama mahasiswa ke',I:2,'?'); readln(nama);
write('IP mahasiswa ke',I:2,'?'); readln(IP);
end;
end;
(* mengurutkan data berdasarkan nomor mahasiswa metode Bubble sort *)
{
For I:=1 to JumlahMhs-1 Do
For J:= 1 to JumlahMhs-1 Do
If Mahasiswa[J] .Nomor > Mahasiswa[J+1].Nomor Then
Begin
Dummy := Mahasiswa [J];
Mahasiswa[J] := Mahasiswa [J+1];
Mahasiswa[J+1]:= Dummy;
End;
}
(*menampilkan hasil *)
Writeln;
Writeln('............................');
Writeln('Nomor Indeks');
Writeln('Mhs Nama mahasiswa Prestasi');
Writeln('............................');
begin
For i:=1 to JumlahMhs Do
Begin
With Mahasiswa [i] Do
Writeln(Nomor:5,Nama:20, IP:11:2);
End;
Writeln('............................');
end;
end;
begin
input;
end.
Algoritma Pengurutan Data (Selection Sort)
Pengurutan Dengan menggunakan Selection Sort
var
i,j,n,maks,temp:integer;
L:Array [1..100] of integer;
begin
for <- n downto 2 do
maks<-1;
for j<-2 to i do
if L[j]>L[maks] then
maks <-j;
end if
end for
temp<-L[i];
L[i]<-L[maks];
L[maks]<-temp;
end for
end.
var
i,j,n,maks,temp:integer;
L:Array [1..100] of integer;
begin
for <- n downto 2 do
maks<-1;
for j<-2 to i do
if L[j]>L[maks] then
maks <-j;
end if
end for
temp<-L[i];
L[i]<-L[maks];
L[maks]<-temp;
end for
end.
Algoritma Pengurutan Data (Bubble Sort)
Pengurutan Dengan menggunakan Bubble Sort
Var
i,k,n,temp:integer;
L:array [1..100] of integer;
Begin
for i <- 1 to n-1 do
for k <- n downto i+1 do
if L[k] < L[k-1] then
Temp<-L[k];
L[k]<-L[k-1];
L[k-1]<-temp;
end if
End for
end for
end.
Untuk Pengurutan Seperti ini ganti Operator [<] menjadi [>]
Var
i,k,n,temp:integer;
L:array [1..100] of integer;
Begin
for i <- 1 to n-1 do
for k <- n downto i+1 do
if L[k] < L[k-1] then
Temp<-L[k];
L[k]<-L[k-1];
L[k-1]<-temp;
end if
End for
end for
end.
Untuk Pengurutan Seperti ini ganti Operator [<] menjadi [>]
Struktur Data – Algoritma & Implementasi Buble Sort dalam Bahasa C/C++
Pada materi matakuliah struktur data ini, akan dibahasa salah satu metode pengurutan yang paling sederhana yaitu Buble sort (metode gelembung). Pada sesi ini akan dijelaskan tentang:
- Pengertian/konsep buble sort
- Kelebihan metode bubble sort
- Kelemahan metode bubble sort
- Algoritma buble sort
- Analisis Algoritma buble sort
- Implementai bubble sort dalam bahasa C atau C++
Pengertian/Konsep Buble Sort
Metode pengurutan gelembung (Bubble Sort) diinspirasikan oleh gelembung sabun yang berada dipermukaan air. Karena berat jenis gelembung sabun lebih ringan daripada berat jenis air, maka gelembung sabun selalu terapung ke atas permukaan. Prinsip di atas dipakai pada pengurutan gelembung.
Bubble sort (metode gelembung) adalah metode/algoritma pengurutan dengan dengan cara melakukan penukaran data dengan tepat disebelahnya secara terus menerus sampai bisa dipastikan dalam satu iterasi tertentu tidak ada lagi perubahan. Jika tidak ada perubahan berarti data sudah terurut. Disebut pengurutan gelembung karena masing-masing kunci akan dengan lambat menggelembung ke posisinya yang tepat.
Kelebihan Bubble Sort
- Metode Buble Sort merupakan metode yang paling simpel
- Metode Buble Sort mudah dipahami algoritmanya
Kelemahan Bubble Sort
Meskipun simpel metode Bubble sort merupakan metode pengurutanyang paling tidak efisien. Kelemahan buble sort adalah pada saat mengurutkan data yang sangat besar akan mengalami kelambatan luar biasa, atau dengan kata lain kinerja memburuk cukup signifikan ketika data yang diolah jika data cukup banyak. Kelemahan lain adalah jumlah pengulangan akan tetap sama jumlahnya walaupun data sesungguhnya sudah cukup terurut. Hal ini disebabkan setiap data dibandingkan dengan setiap data yang lain untuk menentukan posisinya.
Algoritma Bubble Sort
- Membandingkan data ke-i dengan data ke-(i+1) (tepat bersebelahan). Jika tidak sesuai maka tukar (data ke-i = data ke-(i+1) dan data ke-(i+1) = data ke-i). Apa maksudnya tidak sesuai? Jika kita menginginkan algoritme menghasilkan data dengan urutan ascending (A-Z) kondisi tidak sesuai adalah data ke-i > data ke-i+1, dan sebaliknya untuk urutan descending (A-Z).
- Membandingkan data ke-(i+1) dengan data ke-(i+2). Kita melakukan pembandingan ini sampai data terakhir. Contoh: 1 dgn 2; 2 dgn 3; 3 dgn 4; 4 dgn 5 … ; n-1 dgn n.
- Selesai satu iterasi, adalah jika kita sudah selesai membandingkan antara (n-1) dgn n. Setelah selesai satu iterasi kita lanjutkan lagi iterasi berikutnya sesuai dengan aturan ke-1. mulai dari data ke-1 dgn data ke-2, dst.
- Proses akan berhenti jika tidak ada pertukaran dalam satu iterasi.
Contoh Kasus Bubble Sort
Misalkan kita punya data seperti ini: 6, 4, 3, 2 dan kita ingin mengurutkan data ini (ascending) dengan menggunakan bubble sort. Berikut ini adalah proses yang terjadi:
Iterasi ke-1: 4, 6, 3, 2 :: 4, 3, 6, 2 :: 4, 3, 2, 6 (ada 3 pertukaran)
Iterasi ke-2: 3, 4, 2, 6 :: 3, 2, 4, 6 :: 3, 2, 4, 6 (ada 2 pertukaran)
Iterasi ke-3: 2, 3, 4, 6 :: 2, 3, 4, 6 :: 2, 3, 4, 6 (ada 1 pertukaran)
Iterasi ke-4: 2, 3, 4, 6 :: 2, 3, 4, 6 :: 2, 3, 4, 6 (ada 0 pertukaran) -> proses selesai
Analisis Algoritma Bubble Sort
Tujuan dari analisis algoritma adalah untuk mengetahui efisiensi dari algoritma. Dalam hal ini dilakukan pembandingan antara dua atau lebih algoritma pengurutan.Tahap analisis adalah melakukan pengecekan program untuk memastikan bahwa program telah benar secara logika maupun sintak (tahap tracing atau debugging). Tahap selanjutnya yaitu menjalankan program untuk mengetahui running time atau waktu komputasi dalam hal ini
termasuk jumlah langkah. Data uji yang digunakan adalah data yang tidak terurut atau data random, terurut membesar/, dan terurut mengecil.
termasuk jumlah langkah. Data uji yang digunakan adalah data yang tidak terurut atau data random, terurut membesar/, dan terurut mengecil.
Salah satu cara untuk menganalisa kecepatan algoritma sorting saat running time adalah dengan menggunakan notasi Big O. Algoritma sorting mempunyai kompleksitas waktu terbaik, terburuk, dan rata-rata. Dengan notasi Big O, kita dapat mengoptimalkan penggunaan algoritma sorting. Sebagai contoh, untuk kasus dimana jumlah masukan untuk suatu pengurutan banyak, lebih baik digunakan algoritma sorting seperti quick sort, merge sort, atau heap sortkarena kompleksitas waktu untuk kasuk terburuk adalah O(n log n). Hal ini tentu akan sangatberbeda jika kita menggunakan algoritma sorting insertion sort atau bubble sort dimana waktu yang dibutuhkan untuk melakukan pencarian akan sangat lama. Hal ini disebabkan kompleksitas waktu terburuk untuk algoritma sorting tersebut dengan jumlah masukan yang banyak adalah O(n2).
Dari grafik dibawah dapat diketahui buble sort adalah metode yang paling lambat dari yang lambat-lambat..heheheh..
Implementasi Bubble Sort dalam Bahasa C/C++
Berikut ini listing program atau kode program metode bubble sort dalam bahasa C/C++
#include<stdio.h> void bubbleSort(int data[], int n){ int i, j=0, temp, flag = 1; while(flag){ flag = 0; for(i=0; i<n; i++){ if(data[i]>data[i+1]){ temp = data[i]; data[i] = data[i+1]; data[i+1] = temp; flag++; } } } } main(){ int data[1000]; int n, i; printf("________.:: BUBBLE SORT :.________\n"); printf("Enter numbers of data(maks 1000): "); scanf("%d", &n); printf("Data (separate by space): "); for(i=0; i<n; i++) scanf("%d", &data[i]); bubbleSort(data, n); printf("\nOutput after sort:\n"); for(i=0; i<n; i++) printf("%d ", data[i]); getch(); return 0;}
Pengertian Binary Search / Pencarian Biner
Sebuah algoritma pencarian biner (atau pemilahan biner) adalah sebuah teknik untuk menemukan nilai tertentu dalam sebuah larik (array) linear, dengan menghilangkan setengah data pada setiap langkah, dipakai secara luas tetapi tidak secara ekslusif dalam ilmu komputer. Sebuah pencarian biner mencari nilai tengah (median), melakukan sebuah pembandingan untuk menentukan apakah nilai yang dicari ada sebelum atau sesudahnya, kemudian mencari setengah sisanya dengan cara yang sama. Sebuah pencarian biner adalah salah satu contoh dari algoritma divide and conquer (atau lebih khusus algoritma decrease and conquer) dan sebuah pencarian dikotomi (lebih rinci di Algoritma pencarian).
Algoritma
Penerapan terbanyak dari pencarian biner adalah untuk mencari sebuah nilai tertentu dalam sebuah list terurut. Jika dibayangkan, pencarian biner dapat dilihat sebagai sebuah permainan tebak-tebakan, kita menebak sebuah bilangan, atau nomor tempat, dari daftar (list) nilai.
Pencarian diawali dengan memeriksa nilai yang ada pada posisi tengah list; oleh karena nilai-nilainya terurut, kita mengetahui apakah nilai terletak sebelum atau sesudah nilai yang di tengah tersebut, dan pencarian selanjutnya dilakukan terhadap setengah bagian dengan cara yang sama. Berikut ini adalahpseudocode sederhana yang menentukan indeks (posisi) dari nilai yang diberikan dalam sebuah list berurut, a berada antara left dan right :
Karena pemanggilan fungsi di samping adalah rekursif ekor, fungsi tersebut dapat dituliskan sebagai sebuah pengulangan (loop), hasilnya adalah algoritma in-place:
Pada kedua kasus, algoritma akan berakhir karena paa setiap pemanggilan rekursif atau pengulangan, jangkauan indeks rightdikurang left akan selalu mengecil, dan akhirnya pasti akan menjadi negatif.
Pencarian biner adalah sebuah algoritma logaritmik dan bekerja dalam waktu O(log n). Secara khusus, 1 + log2N pengulangan yang diperlukan untuk menghasilkan jawaban. Hal ini dianggap lebih cepat dibandingkan sebuah pencarian linear. Pencarian biner dapat diimplementasikan dengan rekursi atau iterasi, seperti yang terlihat di atas, walaupun pada kebanyakan bahasa pemrograman akan lebih elegan bila dinyatakan secara rekursif.
Algoritma
Penerapan terbanyak dari pencarian biner adalah untuk mencari sebuah nilai tertentu dalam sebuah list terurut. Jika dibayangkan, pencarian biner dapat dilihat sebagai sebuah permainan tebak-tebakan, kita menebak sebuah bilangan, atau nomor tempat, dari daftar (list) nilai.
Pencarian diawali dengan memeriksa nilai yang ada pada posisi tengah list; oleh karena nilai-nilainya terurut, kita mengetahui apakah nilai terletak sebelum atau sesudah nilai yang di tengah tersebut, dan pencarian selanjutnya dilakukan terhadap setengah bagian dengan cara yang sama. Berikut ini adalahpseudocode sederhana yang menentukan indeks (posisi) dari nilai yang diberikan dalam sebuah list berurut, a berada antara left dan right :
Karena pemanggilan fungsi di samping adalah rekursif ekor, fungsi tersebut dapat dituliskan sebagai sebuah pengulangan (loop), hasilnya adalah algoritma in-place:
Pada kedua kasus, algoritma akan berakhir karena paa setiap pemanggilan rekursif atau pengulangan, jangkauan indeks rightdikurang left akan selalu mengecil, dan akhirnya pasti akan menjadi negatif.
Pencarian biner adalah sebuah algoritma logaritmik dan bekerja dalam waktu O(log n). Secara khusus, 1 + log2N pengulangan yang diperlukan untuk menghasilkan jawaban. Hal ini dianggap lebih cepat dibandingkan sebuah pencarian linear. Pencarian biner dapat diimplementasikan dengan rekursi atau iterasi, seperti yang terlihat di atas, walaupun pada kebanyakan bahasa pemrograman akan lebih elegan bila dinyatakan secara rekursif.
Langganan:
Postingan (Atom)