Data Structure Practice 4th Meeting

In this 4th meeting, my class talk about sorting

here is my programs :

1.  Sorting data record by using bubble sort
2. data record by using bubble sort + searching of data
3. Quick sorting by ascending & descending
4. Sorting data record by using Selection sort. Sorted by using 2 keys
5. String word by using Selection sort ascending & descending
6. Displaying graphic of integer data by using insertion sort


1. Sorting data record by using bubble sort


uses wincrt;
type data = record
nrp:integer;
nama:string;
matkul:string;
nilai:real;
end;
var
mhs:array[1..20]of data;
a,b,c,pil:byte;
lagi:char;
procedure input(a:byte);
begin
 for b:=1 to a do
 begin
 writeln('INDEX [',b,'] = ');
 write('masukkan nrp          =');read(mhs[b].nrp);
 write('masukkan nama         =');readln;read(mhs[b].nama);
 write('masukkan mata kuliah  =');readln;read(mhs[b].matkul);
 write('masukkan nilai        =');read(mhs[b].nilai);
 end;
end;

procedure display1st;
begin
clrscr;
write('================================================================================');
writeln('                                     DATA AWAL');
write('================================================================================');
writeln('INDEX':1,'|','nrp':17,'nama':15,'mata kuliah':20,'nilai':20);
 for b:=1 to a do
 begin
 writeln(b:5,'|',mhs[b].nrp:15,mhs[b].nama:16,mhs[b].matkul:15,'':22,mhs[b].nilai:2:2);
 end;
write('================================================================================');
end;

procedure display;
begin
write('================================================================================');
writeln('                               HASIL SORTING ASCENDING');
write('================================================================================');
writeln('INDEX':1,'|','nrp':17,'nama':15,'mata kuliah':20,'nilai':20);
 for b:=1 to a do
 begin
 writeln(b:5,'|',mhs[b].nrp:15,mhs[b].nama:16,mhs[b].matkul:15,'':22,mhs[b].nilai:2:2);
 end;
write('================================================================================');
end;

procedure nrp;
var
c,d:integer;
nama,matkul:string;
nilai:real;
begin
 for b:=1 to a-1 do
 begin
 for d:=1 to a-1 do
 begin
 if mhs[d].nrp>mhs[d+1].nrp then
 begin
 c:=mhs[d+1].nrp;
 nilai:=mhs[d+1].nilai;
 nama:=mhs[d+1].nama;
 matkul:=mhs[d+1].matkul;

 mhs[d+1].nrp:=mhs[d].nrp;
 mhs[d+1].nilai:=mhs[d].nilai;
 mhs[d+1].nama:=mhs[d].nama;
 mhs[d+1].matkul:=mhs[d].matkul;

 mhs[d].nrp:=c;
 mhs[d].nilai:=nilai;
 mhs[d].nama:=nama;
 mhs[d].matkul:=matkul;
 end;
 end;
 end;
 display;
end;

procedure nama;
var
c,d:integer;
nama,matkul:string;
nilai:real;
begin
 for b:=1 to a-1 do
 begin
 for d:=1 to a-1 do
 begin
 if mhs[d].nama>mhs[d+1].nama then
 begin
 c:=mhs[d+1].nrp;
 nilai:=mhs[d+1].nilai;
 nama:=mhs[d+1].nama;
 matkul:=mhs[d+1].matkul;

 mhs[d+1].nrp:=mhs[d].nrp;
 mhs[d+1].nilai:=mhs[d].nilai;
 mhs[d+1].nama:=mhs[d].nama;
 mhs[d+1].matkul:=mhs[d].matkul;

 mhs[d].nrp:=c;
 mhs[d].nilai:=nilai;
 mhs[d].nama:=nama;
 mhs[d].matkul:=matkul;
 end;
 end;
 end;
display;
end;

procedure matkul;
var
c,d:integer;
nama,matkul:string;
nilai:real;
begin
 for b:=1 to a-1 do
 begin
 for d:=1 to a-1 do
 begin
 if mhs[d].matkul>mhs[d+1].matkul then
 begin
 c:=mhs[d+1].nrp;
 nilai:=mhs[d+1].nilai;
 nama:=mhs[d+1].nama;
 matkul:=mhs[d+1].matkul;

 mhs[d+1].nrp:=mhs[d].nrp;
 mhs[d+1].nilai:=mhs[d].nilai;
 mhs[d+1].nama:=mhs[d].nama;
 mhs[d+1].matkul:=mhs[d].matkul;

 mhs[d].nrp:=c;
 mhs[d].nilai:=nilai;
 mhs[d].nama:=nama;
 mhs[d].matkul:=matkul;
 end;
 end;
 end;
display;
end;

procedure nilai;
var
c,d:integer;
nama,matkul:string;
nilai:real;
begin
 for b:=1 to a-1 do
 begin
 for d:=1 to a-1 do
 begin
 if mhs[d].nilai>mhs[d+1].nilai then
 begin
 c:=mhs[d+1].nrp;
 nilai:=mhs[d+1].nilai;
 nama:=mhs[d+1].nama;
 matkul:=mhs[d+1].matkul;

 mhs[d+1].nrp:=mhs[d].nrp;
 mhs[d+1].nilai:=mhs[d].nilai;
 mhs[d+1].nama:=mhs[d].nama;
 mhs[d+1].matkul:=mhs[d].matkul;

 mhs[d].nrp:=c;
 mhs[d].nilai:=nilai;
 mhs[d].nama:=nama;
 mhs[d].matkul:=matkul;
 end;
 end;
 end;
display;
end;

begin
repeat
write('masukkan jumlah total data = ');read(a);
input(a);
display1st;
writeln('OPTION SORTING ASCENDING');
writeln('1.  berdasarkan nrp');
writeln('2.  berdasarkan nama');
writeln('3.  berdasarkan matkul');
writeln('4.  berdasarkan nilai');
write('pilih = ');read(pil);
 case pil of
 1:nrp;
 2:nama;
 3:matkul;
 4:nilai;
 else
 writeln('WRONG CHOICE !!!');
 end;
 write('lagi = ');readln;read(lagi);
until (lagi='T') or (lagi='t')
end.

2.  data record by using bubble sort + searching of data


uses wincrt;
type data = record
nrp:integer;
nama:string;
matkul:string;
nilai:real;
end;
var
mhs:array[1..20]of data;
a,b,c,pil,pil2:byte;
lagi:char;
procedure input(a:byte);
begin
 for b:=1 to a do
 begin
 writeln('INDEX [',b,'] = ');
 write('masukkan nrp          =');read(mhs[b].nrp);
 write('masukkan nama         =');readln;read(mhs[b].nama);
 write('masukkan mata kuliah  =');readln;read(mhs[b].matkul);
 write('masukkan nilai        =');read(mhs[b].nilai);
 end;
end;

procedure display1st;
begin
clrscr;
write('================================================================================');
writeln('                                     DATA AWAL');
write('================================================================================');
writeln('INDEX':1,'|','nrp':17,'nama':15,'mata kuliah':20,'nilai':20);
 for b:=1 to a do
 begin
 writeln(b:5,'|',mhs[b].nrp:15,mhs[b].nama:16,mhs[b].matkul:15,'':22,mhs[b].nilai:2:2);
 end;
write('================================================================================');
end;

procedure display;
begin
write('================================================================================');
writeln('                                  HASIL SORTING ASCENDING');
write('================================================================================');
writeln('INDEX':1,'|','nrp':17,'nama':15,'mata kuliah':20,'nilai':20);
 for b:=1 to a do
 begin
 writeln(b:5,'|',mhs[b].nrp:15,mhs[b].nama:16,mhs[b].matkul:15,'':22,mhs[b].nilai:2:2);
 end;
write('================================================================================');
end;

procedure nrp;
var
c,d:integer;
nama,matkul:string;
nilai:real;
begin
 for b:=1 to a-1 do
 begin
 for d:=1 to a-1 do
 begin
 if mhs[d].nrp>mhs[d+1].nrp then
 begin
 c:=mhs[d+1].nrp;
 nilai:=mhs[d+1].nilai;
 nama:=mhs[d+1].nama;
 matkul:=mhs[d+1].matkul;

 mhs[d+1].nrp:=mhs[d].nrp;
 mhs[d+1].nilai:=mhs[d].nilai;
 mhs[d+1].nama:=mhs[d].nama;
 mhs[d+1].matkul:=mhs[d].matkul;

 mhs[d].nrp:=c;
 mhs[d].nilai:=nilai;
 mhs[d].nama:=nama;
 mhs[d].matkul:=matkul;
 end;
 end;
 end;
display;
end;

procedure nama;
var
c,d:integer;
nama,matkul:string;
nilai:real;
begin
 for b:=1 to a-1 do
 begin
 for d:=1 to a-1 do
 begin
 if mhs[d].nama>mhs[d+1].nama then
 begin
 c:=mhs[d+1].nrp;
 nilai:=mhs[d+1].nilai;
 nama:=mhs[d+1].nama;
 matkul:=mhs[d+1].matkul;

 mhs[d+1].nrp:=mhs[d].nrp;
 mhs[d+1].nilai:=mhs[d].nilai;
 mhs[d+1].nama:=mhs[d].nama;
 mhs[d+1].matkul:=mhs[d].matkul;

 mhs[d].nrp:=c;
 mhs[d].nilai:=nilai;
 mhs[d].nama:=nama;
 mhs[d].matkul:=matkul;
 end;
 end;
 end;
display;
end;

procedure matkul;
var
c,d:integer;
nama,matkul:string;
nilai:real;
begin
 for b:=1 to a-1 do
 begin
 for d:=1 to a-1 do
 begin
 if mhs[d].matkul>mhs[d+1].matkul then
 begin
 c:=mhs[d+1].nrp;
 nilai:=mhs[d+1].nilai;
 nama:=mhs[d+1].nama;
 matkul:=mhs[d+1].matkul;

 mhs[d+1].nrp:=mhs[d].nrp;
 mhs[d+1].nilai:=mhs[d].nilai;
 mhs[d+1].nama:=mhs[d].nama;
 mhs[d+1].matkul:=mhs[d].matkul;

 mhs[d].nrp:=c;
 mhs[d].nilai:=nilai;
 mhs[d].nama:=nama;
 mhs[d].matkul:=matkul;
 end;
 end;
 end;
display;
end;

procedure nilai;
var
c,d:integer;
nama,matkul:string;
nilai:real;
begin
 for b:=1 to a-1 do
 begin
 for d:=1 to a-1 do
 begin
 if mhs[d].nilai>mhs[d+1].nilai then
 begin
 c:=mhs[d+1].nrp;
 nilai:=mhs[d+1].nilai;
 nama:=mhs[d+1].nama;
 matkul:=mhs[d+1].matkul;

 mhs[d+1].nrp:=mhs[d].nrp;
 mhs[d+1].nilai:=mhs[d].nilai;
 mhs[d+1].nama:=mhs[d].nama;
 mhs[d+1].matkul:=mhs[d].matkul;

 mhs[d].nrp:=c;
 mhs[d].nilai:=nilai;
 mhs[d].nama:=nama;
 mhs[d].matkul:=matkul;

 end;
 end;
 end;
display;
end;

procedure snrp(a:integer);
var
mid,hi,lo,cari:integer;
flag:byte;
find:boolean;
begin
find:=false;
flag:=0;
write('masukkan nrp yang akan di cari = ');read(cari);
lo:=1;
hi:=a;
 while (lo<=hi) and (not find) do
 begin
 mid:=(lo+hi)div 2;
 if mhs[mid].nrp=cari then
 begin
 find:=true;
 flag:=1;
 lo:=hi;
 end
 else
 if mhs[mid].nrp<cari then
 lo:=mid+1
 else
 hi:=mid-1;
 end;
 if (find=true) and (flag=1) then
 begin
 writeln('data ditemukan ');
 writeln('data yang dicari adalah ==>');
 writeln('nrp    = ',mhs[mid].nrp);
 writeln('nama   = ',mhs[mid].nama);
 writeln('matkul = ',mhs[mid].matkul);
 writeln('nilai  = ',mhs[mid].nilai:2:2);
 end
 else
 writeln('data tidak ditemukan');
end;

procedure snama;
var
mid,hi,lo:integer;
cari:string;
flag:byte;
find:boolean;
begin
find:=false;
flag:=0;
write('masukkan nama yang akan di cari = ');readln;read(cari);
lo:=1;
hi:=a;
 while (lo<=hi) and (not find) do
 begin
 mid:=(lo+hi)div 2;
 if mhs[mid].nama=cari then
 begin
 find:=true;
 flag:=1;
 end
 else if mhs[mid].nama<cari then
 lo:=mid+1
 else
 hi:=mid-1;
 end;
 if (find=true) and (flag=1) then
 begin
 writeln('data ditemukan ');
 writeln('data yang dicari adalah ==>');
 writeln('nrp    = ',mhs[mid].nrp);
 writeln('nama   = ',mhs[mid].nama);
 writeln('matkul = ',mhs[mid].matkul);
 writeln('nilai  = ',mhs[mid].nilai:2:2);
 end
 else
 writeln('data tidak ditemukan');
end;

procedure smatkul;
var
mid,hi,lo:integer;
cari:string;
flag:byte;
find:boolean;
begin
find:=false;
flag:=0;
write('masukkan mata kuliah yang akan di cari = ');readln;read(cari);
lo:=1;
hi:=a;
 while (lo<=hi) and (not find) do
 begin
 mid:=(lo+hi)div 2;
 if mhs[mid].matkul=cari then
 begin
 find:=true;
 flag:=1;
 end
 else if mhs[mid].matkul<cari then
 lo:=mid+1
 else
 hi:=mid-1;
 end;
 if (find=true) and (flag=1) then
 begin
 writeln('data ditemukan ');
 writeln('data yang dicari adalah ==>');
 writeln('nrp    = ',mhs[mid].nrp);
 writeln('nama   = ',mhs[mid].nama);
 writeln('matkul = ',mhs[mid].matkul);
 writeln('nilai  = ',mhs[mid].nilai:2:2);
 end
 else
 writeln('data tidak ditemukan');
end;

procedure snilai;
var
mid,hi,lo:integer;
flag:byte;
find:boolean;
cari:real;
begin
find:=false;
flag:=0;
write('masukkan nilai yang akan di cari = ');readln;read(cari);
lo:=1;
hi:=a;
 while (lo<=hi) and (not find) do
 begin
 mid:=(lo+hi)div 2;
 if mhs[mid].nilai=cari then
 begin
 find:=true;
 flag:=1;
 end
 else if mhs[mid].nilai<cari then
 lo:=mid+1
 else
 hi:=mid-1;
 end;
 if (find=true) and (flag=1) then
 begin
 writeln('data ditemukan ');
 writeln('data yang dicari adalah ==>');
 writeln('nrp    = ',mhs[mid].nrp);
 writeln('nama   = ',mhs[mid].nama);
 writeln('matkul = ',mhs[mid].matkul);
 writeln('nilai  = ',mhs[mid].nilai:2:2);
 end
 else
 writeln('data tidak ditemukan');
end;

procedure sorting;
begin
writeln('OPTION SORTING ASCENDING');
writeln('1.  berdasarkan nrp');
writeln('2.  berdasarkan nama');
writeln('3.  berdasarkan matkul');
writeln('4.  berdasarkan nilai');
write('pilih = ');read(pil);
 case pil of
 1:nrp;
 2:nama;
 3:matkul;
 4:nilai;
 else
 writeln('WRONG CHOICE !!!');
 end;
end;

procedure searching;
begin
writeln('OPTION SEARCHING BINARY');
writeln('1.  berdasarkan nrp');
writeln('2.  berdasarkan nama');
writeln('3.  berdasarkan matkul');
writeln('4.  berdasarkan nilai');
write('pilih = ');readln;read(pil2);
 case pil2 of
 1:snrp(a);
 2:snama;
 3:smatkul;
 4:snilai;
 else
 writeln('WRONG CHOICE !!!');
 end;
end;

begin
write('masukkan jumlah total data = ');read(a);
input(a);
repeat
display1st;
sorting;
searching;
 write('lagi = ');readln;read(lagi);
until (lagi='T') or (lagi='t')
end.

3.  Quick sorting by ascending & descending

4. Sorting data record by using Selection sort. Sorted by using 2 keys


program selection_sort;
uses wincrt;
const max=10;
type data = record
noind:integer;
nama:string;
alamat:string;
gol:char;
end;
type peg=array[1..max]of data;
var
x:peg;
pil,a,b,c:byte;

{procedure swap(var a,b:integer);
var
c:integer;
begin
c:=a;
a:=b;
b:=c;
end;

procedure swap_gol(var a,b:char);
var
c:char;
begin
c:=b;
b:=a;
a:=c;
end;}

procedure display1st;
begin
write('================================================================================');
writeln('                                     DATA AWAL');
write('================================================================================');
writeln('INDEX':1,'|','noind':17,'nama':15,'alamat':20,'gol':20);
 for a:=1 to b do
 begin
 writeln(a:5,'|',x[a].noind:15,x[a].nama:16,x[a].alamat:15,'':22,x[a].gol);
 end;
write('================================================================================');
end;

procedure display(x:peg; b:integer);
begin
write('================================================================================');
writeln('                                   HASIL SORTING');
write('================================================================================');
writeln('INDEX':1,'|','noind':17,'nama':15,'alamat':20,'gol':20);
 for a:=1 to b do
 begin
 writeln(a:5,'|',x[a].noind:15,x[a].nama:16,x[a].alamat:15,'':22,x[a].gol);
 end;
write('================================================================================');
end;

procedure n_a(var x:peg; b:integer);
var
noind,i,j:integer;
bantu,bantu2,nama,alamat:string;
gol:char;
begin
 for i:=1 to b-1 do
 begin
 for J:=i+1 to b do
 begin
 if (x[i].nama>x[j].nama) then
 begin
 bantu:=x[i].nama;
 x[i].nama:=x[j].nama;
 x[j].nama:=bantu;

 noind:=x[i].noind;
 x[i].noind:=x[j].noind;
 x[j].noind:=noind;

 alamat:=x[i].alamat;
 x[i].alamat:=x[j].alamat;
 x[j].alamat:=alamat;

 gol:=x[i].gol;
 x[i].gol:=x[j].gol;
 x[j].gol:=gol;
 {swap(x[i].noind,x[j].noind);
 swap_gol(x[i].gol,x[j].gol); }
 end;

 if (x[i].alamat>x[j].alamat) then
 begin
 bantu2:=x[i].alamat;
 x[i].alamat:=x[j].alamat;
 x[j].alamat:=bantu2;

 noind:=x[i].noind;
 x[i].noind:=x[j].noind;
 x[j].noind:=noind;

 nama:=x[i].nama;
 x[i].nama:=x[j].nama;
 x[j].nama:=nama;

 gol:=x[i].gol;
 x[i].gol:=x[j].gol;
 x[j].gol:=gol;

 {swap(x[i].noind,x[j].noind);
 swap_gol(x[i].gol,x[j].gol);}
 end;
 end;
 end;
 display(x,b);
end;

procedure g_n(var x:peg; b:integer);
var
noind,i,j:integer;
bantu,nama,alamat:string;
bantu2,gol:char;
begin
 for i:=1 to b-1 do
 begin
 for J:=i+1 to b do
 begin
 if (x[i].gol>x[j].gol) then
 begin
 bantu2:=x[i].gol;
 x[i].gol:=x[j].gol;
 x[j].gol:=bantu2;

 noind:=x[i].noind;
 x[i].noind:=x[j].noind;
 x[j].noind:=noind;

 nama:=x[i].nama;
 x[i].nama:=x[j].nama;
 x[j].nama:=nama;

 alamat:=x[i].alamat;
 x[i].alamat:=x[j].alamat;
 x[j].alamat:=alamat;

 {swap(x[i].noind,x[j].noind);
 swap_gol(x[i].gol,x[j].gol);}
 end;

 if (x[i].nama>x[j].nama) then
 begin
 bantu:=x[i].nama;
 x[i].nama:=x[j].nama;
 x[j].nama:=bantu;

 noind:=x[i].noind;
 x[i].noind:=x[j].noind;
 x[j].noind:=noind;

 alamat:=x[i].alamat;
 x[i].alamat:=x[j].alamat;
 x[j].alamat:=alamat;

 gol:=x[i].gol;
 x[i].gol:=x[j].gol;
 x[j].gol:=gol;
 {swap(x[i].noind,x[j].noind);
 swap_gol(x[i].gol,x[j].gol); }
 end;
 end;
 end;
 display(x,b);
end;


begin
write('masukkan jumlah data total = ');read(b);

 for a:=1 to b do
 begin
 writeln('INDEX[',a,']=');
 write('induk     = ');read(x[a].noind);
 write('nama      = ');readln;read(x[a].nama);
 write('alamat    = ');readln;read(x[a].alamat);
 write('golongan  = ');readln;read(x[a].gol);
 end;
 display1st;
 writeln('OPSI SORTING');
 writeln('1.  Nama + alamat');
 writeln('2.  Golongan + Nama ');
 write('pilihan opsi = ');read(pil);
 case pil of
 1:n_a(x,b);
 2:g_n(x,b);
 else
 writeln('wrong input !!!')
 end;
end.

5.  String word by using Selection sort ascending & descending


program insertion_sort;
uses wincrt;

type data=record
village:string;
end;

type z=array[1..10] of data;
var
x:z;
a,b,c:byte;

procedure input(a:byte);
begin
 for b:=1 to a do
 begin
 write('INDEX[',b,'] = ');readln;read(x[b].village);
 end;
end;

procedure ins_sort(var x:z; a:byte);
var
i,temp:integer;
lock:string;
ok:boolean;
begin
 for b:=1 to a do
 begin
 lock:=x[b].village;
 temp:=b;
 ok:=false;
 while not ok do
 begin
 if temp<=1 then
 ok:=true
 else if lock>=x[temp-1].village then
 ok:=true
 else
 begin
 x[temp]:=x[temp-1];
 temp:=temp-1;
 end
 end;
 x[temp].village:=lock
 end;
end;

procedure output(x:z; a:byte);
begin
writeln;
writeln('HASIL SORTING ASCENDING');
 for b:=1 to a do
 begin
 writeln('INDEX[',b,'] = ',x[b].village);
 end;
 writeln;
writeln('HASIL SORTING DESSCENDING');
 for b:=a downto 1 do
 begin
 writeln('INDEX[',b,'] = ',x[b].village);
 end;
end;

begin
write('masukkan data total = ');read(a);
input(a);
ins_sort(x,a);
output(x,a);
end.

6.  Displaying graphic of integer data by using insertion sort


program sortingke_6;
uses wincrt;
type data=array[1..10]of integer;
var
a,b,c:byte;
x:data;
procedure input(a:byte);
begin
 for b:=1 to a do
 begin
 write('masukkan panjang data index ke - ',b,' = ');read(x[b]);
 end;
end;

procedure sorting(a:byte);
var
temp:integer;
lock:integer;
ok:boolean;
begin
 for b:=2 to a do
 begin
 lock:=x[b];
 temp:=b;
 ok:=false;
 while not ok do
 begin
 if temp<=1 then
 ok:=true
 else if lock>=x[temp-1] then
 ok:=true
 else
 begin
 x[temp]:=x[temp-1];
 temp:=temp-1;
 end;
 end;
 x[temp]:=lock;
 end;
end;

procedure output(a:integer);
begin
writeln;
 for b:=1 to a do
 begin
 for c:=1 to x[b] do
 begin
 write('#');
 end;
 write(c);
 writeln;
 end;
end;

begin
write('masukkan jumlah data total = ');read(a);
input(a);
writeln('SEBELUM DI - SORT');
output(a);
writeln('tekan sembarang tombol');
readkey;
writeln('SUDAH DI - SORT');
sorting(a);
output(a);
end.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

%d bloggers like this: