Category Archives: Data Structure Using Pascal

Data Structure Practice 6th Meeting

In 6th Meeting we have Linked List . Here is My program :
1. Book Inventory for laboratory by using Linked List:
2. Modification of Book Inventory program by increasing formula to erase broken node (book)
3. Modification of Book Inventory program by increasing formula to search the book by keyword : code /
4. Program to detect a apassword by using linked list
5. Program to increase or delete a char inside a linked list
6. Program to join 2 separated linked list which has different type
Continue reading

Advertisements

Data Structure Practice 5th Meeting

In 5 th meeting We studied about pointer . Here is My program :

1.  Reverse word by using pointer :
2. Sorting data by Pointer
3. Change Upper Case into Lower Case by Pointer
4. Counting FPB(faktor persekutuan terbesar)
Continue reading

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

Continue reading

Data Structure Practice 3rd Meeting

In this 3rd meeting, my class talk about searching . Weather searching by using sorted data or unsorted data.

here is my programs :

1.  Sequensial search By using unsorted data


uses wincrt;
var
data:array[1..10]of char;
a,b,flag:byte;
c:integer;
cari,z,s:string;
temu:boolean;
d:char;
begin
flag:=0;
temu:=true;
write('data  =');read(z);
b:=length(z);

 for a:= 1 to b do
 begin
 data[a]:=z[a];
 end;
 write('cari = ');readln;read(cari);

 d:=cari[1];
a:=0;
while  a<=b do
 begin
 a:=a+1;
 if d=data[a] then
 begin
 flag:=1;
 temu:=true;
 z:='ditemukan';
 c:=a-1;
 a:=b;
 end
 else
 temu:=false;

end;

if (temu<>true) and (flag<>1) then
begin
c:=-1;
writeln('DATA YANG ANDA CARI = tidak ada,index = ',c);
exit;
end
else
begin
writeln('DATA YANG ANDA CARI = ada ','index = ',c);
exit;
end;
end.

2.  Binary search By using sorted data


uses wincrt;
var
data:array[1..10]of char;
flag,a,hi,lo,mid:byte;
cari,z:string;
temu:boolean;
d:char;
c:integer;
begin
lo:=1;
temu:=false;
flag:=0;
write('data  =');read(z);
hi:=length(z);
 for a:= 1 to hi do
 begin
 data[a]:=z[a];
 end;
 write('cari = ');readln;read(cari);

d:=cari[1];

while  (lo<=hi) and (not temu) do
 begin
 mid:=(lo+hi) div 2;
 if data[mid]=d then
 begin
 flag:=1;
 temu:=true;
 c:=mid-1;
 lo:=hi;
 end
 else
 if data[mid]<d then
 lo:=mid+1
 else
 hi:=mid-1
end;

if (temu<>true) and (flag<>1) then
begin
c:=-1;
writeln('data tidak ditemukan = (',z,' ,',cari,')');
writeln('index = ', c);
end
else
begin
writeln('data ditemukan = (',z,' ,',cari,')');
write('index = ',c);
end;
end.

3.   Find out a word within some data and show them all


program budi;
uses wincrt;
var
data:array [1..10,1..100]of char;
panjang:array[1..10]of byte;
lo,flag,a,b,c:byte;
kata:string;
cari:string;
car:char;
temu:boolean;
temp:array[1..10,1..100]of char;
tamp:array[1..10]of string;
begin
flag:=0;
temu:=false;
write('masukkan data total = ');read(b);
 for a:=1 to b do
 begin
 write('masukkan panjang kata ke-',a,'=');read(c);
 panjang[a]:=c;
 writeln('INDEX[',a,']');
 for lo:=1 to panjang[a] do
 begin
 write('huruf[',lo,']=');readln;read(data[a,lo]);
 end;
 end;

write('masukkan data yang akan dicari = ');readln;read(cari);
car:=cari[1];

for a:=1 to b do
begin
 for lo:=1 to panjang[a] do
 begin
 if car=data[a,lo] then
 begin
 temu:=true;
 flag:=1;
 temp[a,lo]:=data[a,lo];
 tamp[a]:=data[a]
 end
 else
 end;
 end;

 if (temu=true) and (flag=1) then
 begin
 writeln('ketemu');
 for a:=1 to b do
 begin
 write(tamp[a]);
 writeln;
 end;
 end
 else
 writeln('no temu');
end.

4.  Sequensial search By using unsorted data to find out the highest average


program mahasiswa;
uses wincrt;
type data=record
nrp:string;
nama:string;
matkul:string;
ntugas:real;
nquiz:real;
nuts:real;
nuas:real;
rata:real;
end;
var
mhs:array[1..10] of data;
a,b:byte;
tinggi:real;
lagi:char;
begin
repeat
clrscr;
write('masukkan jumlah mahasiswa = ');read(a);
 for b:=1 to a do
 begin
 writeln;
 writeln('DATA MAHASISWA KE-',b);
 write('masukkan nrp mahasiswa         = ');readln;read(mhs[b].nrp);
 write('masukkan nama mahasiswa        = ');readln;read(mhs[b].nama);
 write('masukkan mata kuliah mahasiswa = ');readln;read(mhs[b].matkul);
 write('masukkan nilai tugas mahasiswa = ');readln;read(mhs[b].ntugas);
 write('masukkan nilai quiz mahasiswa  = ');readln;read(mhs[b].nquiz);
 write('masukkan nilai UTS mahasiswa   = ');readln;read(mhs[b].nuts);
 write('masukkan nilai UAS mahasiswa   = ');readln;read(mhs[b].nuas);
 end;

 for b:=1 to a do
 begin
 mhs[b].rata:=(10/100*mhs[b].ntugas)+(10/100*mhs[b].nquiz)+(30/100*mhs[b].nuts)+(50/100*mhs[b].nuas)/a;
 end;

 clrscr;
 writeln('================================================================================');
 gotoxy(3,2);write('NRP');
 gotoxy(12,2);write('NAMA');
 gotoxy(29,2);write('MATA KULIAH');
 gotoxy(49,2);write('TUGAS');
 gotoxy(57,2);write('QUIZ');
 gotoxy(64,2);write('UTS');
 gotoxy(69,2);write('UAS');
 gotoxy(75,2);write('RATA');
 writeln;
 writeln('================================================================================');
 for b:=1 to a do
 begin
 gotoxy(1,b+3);write(mhs[b].nrp);
 gotoxy(12,b+3);write(mhs[b].NAMA);
 gotoxy(32,b+3);write(mhs[b].MATKUL);
 gotoxy(50,b+3);write(mhs[b].NTUGAS:0:0);
 gotoxy(58,b+3);write(mhs[b].NQUIZ:0:0);
 gotoxy(64,b+3);write(mhs[b].NUTS:0:0);
 gotoxy(70,b+3);write(mhs[b].NUAS:0:0);
 gotoxy(75,b+3);write(mhs[b].RATA:0:0);
 writeln;
 end;
 writeln('================================================================================');

 writeln('tekan enter untuk melihat hasil pencarian nilai rata- rata tertinggi');
 readln;
 readln;
 {proses pencarian data rata - rata yang tertinggi}
 clrscr;
 tinggi:=mhs[1].rata;
 writeln('MAHASISWA YANG MEMILIKI NILAI RATA - RATA TERTINGGI ADALAH');
 for b:=1 to a do
 begin
 if tinggi>mhs[b].rata then
 begin
 writeln('nrp mahasiswa            = ',mhs[1].nrp);
 writeln('nama mahasiswa           = ',mhs[1].nama);
 writeln('mata kuliah mahasiswa    = ',mhs[1].matkul);
 writeln('nilai tugas mahasiswa    = ',mhs[1].ntugas:0:0);
 writeln('nilai quiz mahasiswa     = ',mhs[1].nquiz:0:0);
 writeln('nilai UTS mahasiswa      = ',mhs[1].nuts:0:0);
 writeln('nilai UAS mahasiswa      = ',mhs[1].nuas:0:0);
 writeln('nilai RATA 2 mahasiswa   = ',mhs[1].rata:2:2);
 end
 else if tinggi<mhs[b].rata then
 begin
 tinggi:=mhs[b].rata;
 writeln('nrp mahasiswa            = ',mhs[b].nrp);
 writeln('nama mahasiswa           = ',mhs[b].nama);
 writeln('mata kuliah mahasiswa    = ',mhs[b].matkul);
 writeln('nilai tugas mahasiswa    = ',mhs[b].ntugas:0:0);
 writeln('nilai quiz mahasiswa     = ',mhs[b].nquiz:0:0);
 writeln('nilai UTS mahasiswa      = ',mhs[b].nuts:0:0);
 writeln('nilai UAS mahasiswa      = ',mhs[b].nuas:0:0);
 writeln('nilai RATA 2 mahasiswa   = ',mhs[b].rata:2:2);
 end;
 end;
write('lagi =');read(lagi);
until (lagi='t') or (lagi='T');
end.

5.  Sentinel search


program sentinel_searching;
uses wincrt;
var
data:array[1..10]of integer;
c,e:integer;
a,b,d:byte;
ketemu:boolean;
begin
ketemu:=false;
write('masukkan jumlah data total = ');read(a);

 for b:=1 to a-1 do
 begin
 write('INDEX [',b,']=');read(data[b]);
 end;

write('masukkan data yang akan dicari = ');read(c);
data[a]:=c;
b:=0;

 while (data[b]<>c) do
 begin
 if (b<a) then
 begin
 b:=b+1;
 e:=b;
 end
 else
 begin
 e:=b;
 end;
 end;


 if (e<>0) and (e<>a)  then
 writeln('data ditemukan di index = ',e)
 else if (e=a) or (e=0) then
 begin
 e:=-1;
 writeln('data tidak ditemukan. INDEX = ',e);
 end;
end.

Data Structure practice 2nd Meeting

This 2nd meeting is really confused for me, because i can’t finish one of my task no 4. Here is the list of the task :

1.  Stack by certain input


program stack;
uses wincrt;
var
a,b,c,top:byte;
data:array[1..20] of integer;
x:integer;
lagi:char;
procedure push;
begin
 if top>=20 then
 writeln('Stack Penyh')
 else if top<20 then
 begin
 write('data = ');read(x);

 if x=999 then
 begin
 exit;
 end;

 if x>=60 then
 begin
 if top>=20 then
 begin
 writeln('penuh');
 end
 else if top<=20 then
 begin
 top:=top+1;
 data[top]:=x;
 end;
 end;

 if x<60 then
 begin
 if top>=0 then
 begin
 x:=data[top];
 top:=top-1;
 end
 else if top<=0 then
 writeln('stack kosong');

 end;
 end
 else
 writeln('error');

end;

procedure pop;
begin
 if top<=0 then
 writeln('stack kosong')
 else if top >=0 then
 begin
 x:=data[top];
 top:=top-1;
 end;

end;

procedure show;
begin
 for b:=1 to top do
 writeln('INDEX[',b,']=',data[b]);
end;

begin
top:=0;
repeat

writeln('LIST');
writeln('1.  PUSH');
writeln('2.  POP');
writeln('3.  SHOW');
write('pilih = ');read(a);
case a of
1:push;
2:pop;
3:show;
else
writeln('salah ');
end;

write('lagi = ');read(lagi);read(lagi);read(lagi);
until (lagi='y') or (lagi='Y')

end.

2.  Checking arithmatic expression

1st Version


program matching_parenthesis;
uses wincrt;
var
data,stack:array[1..20]of char;
a,b,top:byte;
lagi,c:char;
eks:string;
buka,tutup:byte;
begin
top:=0;
buka:=0;
tutup:=0;
write('masukkan ekspresi = ');read(eks);
 a:=length(eks);
 for b:=1 to a do
 begin
 data[b]:=eks[b];
 end;

 for b:=1 to a do
 begin
 if data[b]='(' then
 begin
 buka:=buka+1;
 top:=top+1;
 stack[top]:=data[b];
 end
 else if data[b]=')' then
 begin
 tutup:=tutup+1;
 if top=0 then
 begin
 writeln('terjadi kesalahan');
 writeln('berarti ada simbol ) tetapi tidak ada simbol ( yang seharusnya mendahului');
 end
 else if top<>0 then
 begin
 if buka=tutup then
 begin
 writeln('benar');
 writeln('ada pasangannya');
 c:=data[b];
 top:=top-1;
 end
 else if buka>tutup then
 writeln('salah');
 end;
 end
 end;

end.

or 2nd version


program parenthesis;
uses wincrt;
var
data:array[1..20]of char;
a,b,c,buk,tup:byte;
e:string;
begin
buk:=0;
tup:=0;
write('data = ');read(e);
a:=length(e);
for b:=1 to a do
begin
 data[b]:=e[b];
end;

for b:=1 to a do
begin
 if data[b]='(' then
 buk:=buk+1
 else if data[b]=')' then
 tup:=tup+1;
end;

 if buk=tup then
 write('benar')
 else
 write('salah');

end.

3.  infix to postfix

4.  Box as stack function


program gudang;
uses wincrt;
var
data:array[1..10]of byte;
bantu,i,top,pil,nilai:byte;
nama:string;
utama:char;

procedure ambil;
var
lagi:byte;
begin
repeat
 if top=0 then
 begin
 writeln('kosong');
 exit;
 end
 else
 writeln('                        =====================');
 for i:=top downto 1 do
 begin
 case data[i] of
 1:nama:='permen';
 2:nama:='kue';
 3:nama:='biskuit';
 4:nama:='mie';
 5:nama:='beras';
 end;
 writeln('|':24,i,'=',nama:10,'|':10);
 end;
 writeln('                        =====================');
 write('data yang ke berapat yang akan diambil = ');read(nilai);
 for i:=nilai to top-1 do
 begin
 data[i]:=data[i+1];
 end;
 top:=top-1;
 writeln('                        =====================');
 for i:=top downto 1 do
 begin
 case data[i] of
 1:nama:='permen';
 2:nama:='kue';
 3:nama:='biskuit';
 4:nama:='mie';
 5:nama:='beras';
 end;
 writeln('|':25,nama:10,'|':10);
 end;
 writeln('                        =====================');
writeln('1 untuk berhenti');
writeln('2 untuk ulang');
write('ulang (1 / 2)= ');readln(lagi);
until lagi=1;

end;

procedure isi;
var
ulang:byte;
begin
repeat
writeln(' pilih barang ');
writeln('1.  permen');
writeln('2.  kue');
writeln('3.  biskuit');
writeln('4.  mie');
writeln('5.  beras');
write('pilih = ');read(pil);

 case pil of
 1:nilai:=1;
 2:nilai:=2;
 3:nilai:=3;
 4:nilai:=4;
 5:nilai:=5;
 else
 writeln('salah pilihan');
 end;

 if top=0 then
 begin
 top:=top+1;
 data[top]:=nilai;
 end
 else if top=10 then
 writeln('penuh')
 else
 begin
 top:=top+1;
 for i:=(top-1) downto 1 do
 begin
 if nilai>=data[i] then
 begin
 bantu:=data[i];
 data[i]:=nilai;
 data[i+1]:=bantu;
 end;
 end;
 end;
 writeln('                        =====================');
 for i:=top downto 1 do
 begin
 case data[i] of
 1:nama:='permen';
 2:nama:='kue';
 3:nama:='biskuit';
 4:nama:='mie';
 5:nama:='beras';
 end;
 writeln('|':25,nama:10,'|':10);
 end;
 writeln('                        =====================');
writeln('1 untuk berhenti');
writeln('2 untuk ulang');
write('ulang (1 / 2)= ');readln(ulang);
until (ulang=1);

end;

begin

top:=0;

repeat
writeln('pilih operasi');
writeln('1.  isi');
writeln('2.  ambil');
write('pilih = ');read(pil);
case pil of
1:isi ;
2 :ambil;
else
writeln('salah');
end;
write('menu utama (y / t)= ');readln(utama);
until (utama='t') or (utama='T');

end.

For the other source code i’m gonna finish it later

Data Structure Practice

A week ago i’ve started data structure practice in trunojoyo laboratory. Exactly, it is in programming laboratory. When the lecture assistant started it, i asked him about what kind of programming language that will be used by us. He said to me that in this data structure practice, we’ll use PASCAL programming language. Actually, I’ m so dissapointed for this. But, He explain to me that it is the decision of the main Coordinator of Data structure practice, so that we can’t change it. I’ve learned about C programming language for a long time. but now it is not used again. Huch….But, i’m not gonna be breaking down only because of this. i’ll try to do the as best as i can do.
Any way, The 1st modul is about ARRAY .so , i don’t worry about that. Here is the program that must be submitted
1. Average of array


program rata_rata;
uses wincrt;
var
a,b,c:integer;
d:real;
data:array[1..100]of integer;
begin
write('Masukkan jumlah data total = ');read(a);

for b:=1 to a do
begin
write('INDEX[',b,']=');read(data[b]);
c:=c+data[b];
end;

d:=c/b;
writeln('hasil total = ',c);
writeln('hasil rata- rata =',d:2:2);
end.

2. Palindrom
3. Statistic


PROGRAM SERIBU;
USES WINCRT;
TYPE DATA=ARRAY[1..100,1..100] OF INTEGER;
VAR
PRIA,WANITA:DATA;
A,B,C,D,E,F,h,maxa,maxb,i,j,k,l:integer;
hari:array[1..7]of string;
bulan:array[1..12]of string;

PROCEDURE INPUT(A,B:BYTE);
BEGIN
d:=0;
h:=0;
hari[1]:='Sen';
hari[2]:='Sel';
hari[3]:='Rab';
hari[4]:='Kam';
hari[5]:='Jum';
hari[6]:='Sab';
hari[7]:='Min';
bulan[1]:='jan';
bulan[2]:='feb';
bulan[3]:='mar';
bulan[4]:='apr';
bulan[5]:='mei';
bulan[6]:='jun';
bulan[7]:='jul';
bulan[8]:='agu';
bulan[9]:='sep';
bulan[10]:='okt';
bulan[11]:='nov';
bulan[12]:='des';
write('     ');
for e:=1 to 12 do
begin
write(bulan[e]:6);
end;
writeln;
FOR E:=1 TO b DO
BEGIN
write(hari[e]);
FOR F:=1 TO a DO
BEGIN
c:=random(15);
write(c:6);
pria[e,f]:=c;
d:=d+pria[e,f];
END;
writeln;
END;
write('Jumlah Laki - Laki = ',d);

writeln;
writeln;
write('     ');
for e:=1 to 12 do
begin
write(bulan[e]:6);
end;
writeln;
FOR E:=1 TO b DO
BEGIN
write(hari[e]);
FOR F:=1 TO a DO
BEGIN
c:=random(14);
write(c:6);
wanita[e,f]:=c;
h:=h+wanita[e,f];
END;
writeln;
END;
writeln;
writeln('Jumlah perempuan = ',h);

{proses}

maxa:=pria[1,1];
FOR E:=1 TO b DO
BEGIN
FOR F:=1 TO a DO
BEGIN
if pria[e,f]>maxa then
begin
maxa:=pria[e,f];
i:=e;
j:=f;
end;
END;
END;

maxb:=wanita[1,1];
FOR E:=1 TO b DO
BEGIN
FOR F:=1 TO a DO
BEGIN
if wanita[e,f]>maxb then
begin
maxb:=wanita[e,f];
k:=e;
l:=f;
end;
END;
END;

writeln;
if maxa>maxb then
writeln('Terbanyak adalah Laki- Laki di bulan ',bulan[j],' hari ',hari[i],' ',maxa,' orang')
else if maxb>maxa then
writeln('Terbanyak adalah Laki- Laki di bulan ',bulan[l],' hari ',hari[k],' ',maxb,' orang')
else
writeln('SAMA');

END;

BEGIN
a:=12;
b:=7;
randomize;
input(a,b);
END.

4. set

Fortunately i got task number 1 and 3. So, i did’n need to work harder to finish it all.
I really hope in the next practice which is related to programming can use C. Amin…