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

1. Book Inventory for laboratory by using Linked List:


program inventaris_buku_;
uses wincrt;
type data=^simpul;
simpul=record
kode:string;
judul:string;
jumlah:byte;
prev,next:data;
end;
var
tail,head,baru,help:data;
pil3,pil2,pil,a,b,c:byte;
lagi2,lagi:char;
procedure depan;
begin
repeat
new(baru);
 if baru<>nil then
 begin
 baru^.next:=nil;
 baru^.prev:=nil;
 write('masukkan kode buku = ');readln;read(baru^.kode);
 write('masukkan judul buku = ');readln;read(baru^.judul);
 write('masukkan jumlah buku = ');readln;read(baru^.jumlah);
 baru^.next:=nil;
 if head=nil then
 begin
 head:=baru;
 tail:=baru;
 end
 else
 begin
 baru^.next:=head;
 head^.prev:=baru;
 head:=baru;
 end;
 end
 else
 writeln('MEMORY IS BEING FULL');
 write('TAMBAH DATA LAGI = ');readln;read(lagi);
 until lagi='t';
end;
procedure belakang;
begin
repeat
new(baru);
 if baru<>nil then
 begin
 baru^.next:=nil;
 baru^.prev:=nil;
 write('masukkan kode buku = ');readln;read(baru^.kode);
 write('masukkan judul buku = ');readln;read(baru^.judul);
 write('masukkan jumlah buku = ');readln;read(baru^.jumlah);
 if head=nil then
 begin
 head:=baru;
 tail:=baru;
 end
 else
 begin
 tail^.next:=baru;
 baru^.prev:=tail;
 tail:=baru;
 end;
 end
 else
 writeln('MEMORY IS FULL');
 write('TAMBAH DATA LAGI = ');readln;read(lagi);
 until lagi='t';
end;

procedure FIFO;
begin
 repeat
 if head<>nil then
 begin
 help:=tail;
 while help<>nil do
 begin
 writeln('KODE BUKU   = ',help^.kode);
 writeln('JUDUL BUKU  = ',help^.judul);
 writeln('JUMLAH BUKU = ',help^.jumlah);
 help:=help^.prev;
 end;
 writeln;
 end
 else
 writeln('DATA IS EMPTY');
 write('TAMPIL DATA LAGI = ');readln;read(lagi);
 until lagi='t';
end;

procedure LIFO;
begin
 repeat
 if head<>nil then
 begin
 help:=head;
 while help<>nil do
 begin
 writeln('KODE BUKU   = ',help^.kode);
 writeln('JUDUL BUKU  = ',help^.judul);
 writeln('JUMLAH BUKU = ',help^.jumlah);
 help:=help^.next;
 end;
 writeln;
 end
 else
 writeln('DATA IS EMPTY');
 write('TAMPIL DATA LAGI = ');readln;read(lagi);
 until lagi='t';
end;


begin
repeat
writeln('INPUTAN DATA') ;
writeln('1.  INPUT DEPAN');
writeln('2.  INPUT BELAKANG');
writeln('3   FIFO ');
writeln('4   LIFO ');
writeln('PILIH = ');read(pil);
case pil of
1:depan;
2:belakang;
3:FIFO;
4:LIFO;
else
writeln('ERROR !!!');
end;
write('MAIN MENU = ');readln;read(lagi);
until lagi='t';

end.

2.  Modification of Book Inventory program by increasing formula to erase broken node (book)


program inventaris_buku_2;
uses wincrt;
type data=^simpul;
simpul=record
kode:string;
judul:string;
jumlah:byte;
prev,next:data;
end;
var
tail,head,baru,help:data;
pil3,pil2,pil,a,b,c:byte;
lagi2,lagi:char;
procedure depan;
begin
repeat
new(baru);
 if baru<>nil then
 begin
 baru^.next:=nil;
 baru^.prev:=nil;
 write('masukkan kode buku = ');readln;read(baru^.kode);
 write('masukkan judul buku = ');readln;read(baru^.judul);
 write('masukkan jumlah buku = ');readln;read(baru^.jumlah);
 baru^.next:=nil;
 if head=nil then
 begin
 head:=baru;
 tail:=baru;
 end
 else
 begin
 baru^.next:=head;
 head^.prev:=baru;
 head:=baru;
 end;
 end
 else
 writeln('MEMORY IS BEING FULL');
 write('TAMBAH DATA LAGI = ');readln;read(lagi);
 until lagi='t';
end;
procedure belakang;
begin
repeat
new(baru);
 if baru<>nil then
 begin
 baru^.next:=nil;
 baru^.prev:=nil;
 write('masukkan kode buku = ');readln;read(baru^.kode);
 write('masukkan judul buku = ');readln;read(baru^.judul);
 write('masukkan jumlah buku = ');readln;read(baru^.jumlah);
 if head=nil then
 begin
 head:=baru;
 tail:=baru;
 end
 else
 begin
 tail^.next:=baru;
 baru^.prev:=tail;
 tail:=baru;
 end;
 end
 else
 writeln('MEMORY IS FULL');
 write('TAMBAH DATA LAGI = ');readln;read(lagi);
 until lagi='t';
end;

procedure FIFO;
begin
 repeat
 if head<>nil then
 begin
 help:=tail;
 while help<>nil do
 begin
 writeln('KODE BUKU   = ',help^.kode);
 writeln('JUDUL BUKU  = ',help^.judul);
 writeln('JUMLAH BUKU = ',help^.jumlah);
 help:=help^.prev;
 end;
 writeln;
 end
 else
 writeln('DATA IS EMPTY');
 write('TAMPIL DATA LAGI = ');readln;read(lagi);
 until lagi='t';
end;

procedure LIFO;
begin
 repeat
 if head<>nil then
 begin
 help:=head;
 while help<>nil do
 begin
 writeln('KODE BUKU   = ',help^.kode);
 writeln('JUDUL BUKU  = ',help^.judul);
 writeln('JUMLAH BUKU = ',help^.jumlah);
 help:=help^.next;
 end;
 writeln;
 end
 else
 writeln('DATA IS EMPTY');
 write('TAMPIL DATA LAGI = ');readln;read(lagi);
 until lagi='t';
end;

procedure hdepan;
begin
 repeat
 if head=nil then
 writeln('data kosong !!!');
 if head=tail then
 begin
 dispose(head);
 head:=nil;
 tail:=nil;
 end
 else
 begin
 help:=head;
 head:=help^.next;
 head^.prev:=nil;
 dispose(help);
 end;
 write('HAPUS DATA LAGI = ');readln;read(lagi);
 until lagi='t';
end;

procedure hbelakang;
begin
 repeat
 if tail=nil then
 writeln('data kosong !!!');
 if head=tail then
 begin
 dispose(tail);
 head:=nil;
 tail:=nil;
 end
 else
 begin
 help:=tail;
 tail:=help^.prev;
 tail^.next:=nil;
 dispose(help);
 end;
 write('HAPUS DATA LAGI = ');readln;read(lagi);
 until lagi='t';
end;

begin
repeat
writeln('INPUTAN DATA') ;
writeln('1.  INPUT DEPAN');
writeln('2.  INPUT BELAKANG');
writeln('3   FIFO ');
writeln('4   LIFO ');
writeln('5   HAPUS DEPAN');
writeln('6   HAPUS BELAKANG');
writeln('PILIH = ');read(pil);
case pil of
1:depan;
2:belakang;
3:FIFO;
4:LIFO;
5:hdepan;
6:hbelakang;
else
writeln('ERROR !!!');
end;
write('MAIN MENU = ');readln;read(lagi);
until lagi='t';

end.

3.  Modification of Book Inventory program by increasing formula to search the book by keyword : code / kind/ title


program inventaris_buku_2;
uses wincrt;
type data=^simpul;
simpul=record
kode:string;
judul:string;
jumlah:byte;
prev,next:data;
end;
var
tail,head,baru,help:data;
pil3,pil2,pil,a,b,c:byte;
lagi2,lagi:char;
procedure depan;
begin
repeat
new(baru);
 if baru<>nil then
 begin
 baru^.next:=nil;
 baru^.prev:=nil;
 write('masukkan kode buku = ');readln;read(baru^.kode);
 write('masukkan judul buku = ');readln;read(baru^.judul);
 write('masukkan jumlah buku = ');readln;read(baru^.jumlah);
 baru^.next:=nil;
 if head=nil then
 begin
 head:=baru;
 tail:=baru;
 end
 else
 begin
 baru^.next:=head;
 head^.prev:=baru;
 head:=baru;
 end;
 end
 else
 writeln('MEMORY IS BEING FULL');
 write('TAMBAH DATA LAGI = ');readln;read(lagi);
 until lagi='t';
end;
procedure belakang;
begin
repeat
new(baru);
 if baru<>nil then
 begin
 baru^.next:=nil;
 baru^.prev:=nil;
 write('masukkan kode buku = ');readln;read(baru^.kode);
 write('masukkan judul buku = ');readln;read(baru^.judul);
 write('masukkan jumlah buku = ');readln;read(baru^.jumlah);
 if head=nil then
 begin
 head:=baru;
 tail:=baru;
 end
 else
 begin
 tail^.next:=baru;
 baru^.prev:=tail;
 tail:=baru;
 end;
 end
 else
 writeln('MEMORY IS FULL');
 write('TAMBAH DATA LAGI = ');readln;read(lagi);
 until lagi='t';
end;

procedure FIFO;
begin
 repeat
 if head<>nil then
 begin
 help:=tail;
 while help<>nil do
 begin
 writeln('KODE BUKU   = ',help^.kode);
 writeln('JUDUL BUKU  = ',help^.judul);
 writeln('JUMLAH BUKU = ',help^.jumlah);
 help:=help^.prev;
 end;
 writeln;
 end
 else
 writeln('DATA IS EMPTY');
 write('TAMPIL DATA LAGI = ');readln;read(lagi);
 until lagi='t';
end;

procedure LIFO;
begin
 repeat
 if head<>nil then
 begin
 help:=head;
 while help<>nil do
 begin
 writeln('KODE BUKU   = ',help^.kode);
 writeln('JUDUL BUKU  = ',help^.judul);
 writeln('JUMLAH BUKU = ',help^.jumlah);
 help:=help^.next;
 end;
 writeln;
 end
 else
 writeln('DATA IS EMPTY');
 write('TAMPIL DATA LAGI = ');readln;read(lagi);
 until lagi='t';
end;

procedure kode;
var
kode:string;
find:boolean;
posisi:byte;
begin
posisi:=0;
write('masukkan kode yang akan dicari = ');readln;read(kode);
 if head=nil then
 begin
 writeln('data kosong');
 end
 else
 posisi:=1;
 help:=head;
 while (help^.kode<>kode) and (help<>nil) do
 begin
 posisi:=posisi+1;
 help:=help^.next;
 end;
 if help<>nil then
 begin
 writeln('=========================');
 writeln('data ditemukan');
 writeln('posisi = ',posisi);
 writeln('kode = ',help^.kode);
 writeln('judul = ',help^.judul);
 writeln('jumlah = ',help^.jumlah);
 writeln('=========================');
 end
 else
 begin
 end;
end;


procedure judul;
var
judul:string;
find:boolean;
posisi:byte;
begin
posisi:=0;
write('masukkan judul/jenis yang akan dicari = ');readln;read(judul);
 if head=nil then
 begin
 writeln('data kosong');
 end
 else
 posisi:=1;
 help:=head;
 while (help^.judul<>judul) and (help<>nil) do
 begin
 posisi:=posisi+1;
 help:=help^.next;
 end;
 if help<>nil then
 begin
 writeln('data ditemukan');
 writeln('posisi = ',posisi);
 writeln('=========================');
 writeln('data ditemukan');
 writeln('posisi = ',posisi);
 writeln('kode = ',help^.kode);
 writeln('judul = ',help^.judul);
 writeln('jumlah = ',help^.jumlah);
 writeln('=========================');
 end
 else
 begin
 end;
end;


begin
repeat
writeln('INPUTAN DATA') ;
writeln('1.  INPUT DEPAN');
writeln('2.  INPUT BELAKANG');
writeln('3   FIFO ');
writeln('4   LIFO ');
writeln('5   searching By Kode ');
writeln('6   searching By Jenis/ judul ');
writeln('PILIH = ');read(pil);
case pil of
1:depan;
2:belakang;
3:FIFO;
4:LIFO;
5:kode;
6:judul;
else
writeln('ERROR !!!');
end;
write('MAIN MENU = ');readln;read(lagi);
until lagi='t';

end.

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


program gabung_linked_list;
uses wincrt;
type data=^simpul;
simpul=record
huruf:char;
next:data;
prev:data;
end;
type data2=^node;
node=record
nama:string;
next:data2;
end;
type data3=^x;
x=record
spasi:char;
next:data2;
prev:data;
end;
var
saya,tail,help,head:data;
ayah,lan:data2;
ban,bun:data3;
a,b:byte;
begin

 for a:=1 to 12 do
 begin
 new(saya);
 if saya<>nil then
 begin
 write('masukkan karakter ke-',a,'=');read(saya^.huruf);readln;
 saya^.prev:=nil;
 saya^.next:=nil;
 if head=nil then
 begin
 tail:=saya;
 head:=saya;
 end
 else
 head^.prev:=saya;
 saya^.next:=head;
 head:=saya;
 end
 else
 writeln('memori penuh');
 end;

 if tail<>nil then
 begin
 help:=tail;
 while help<>nil do
 begin
 write(help^.huruf);
 help:=help^.prev;
 end
 end
 else
 writeln('data kosong');

new(ayah);
ayah^.nama:='halid bahanan';
ayah^.next:=nil;

new(bun);
bun^.next:=ayah;
bun^.prev:=saya;


 if ayah<>nil then
 begin
 lan:=ayah;
 while lan<>nil do
 begin
 write(lan^.nama);
 lan:=lan^.next;
 end;
 end
 else
 writeln('data kosong');

end.

7.  Program to input college subject by using linked list and sorting the data by FIFO or LIFO


uses wincrt;
type data=^simpul;
simpul=record
matkul:string;
next:data;
prev:data;
end;
var
help,baru,head,tail:data;
pil:byte;
lagi:char;
procedure tambah;
begin
repeat
new(baru);
 if baru<>nil then
 begin
 write('masukkan mata kuliah = ');readln;read(baru^.matkul);
 baru^.next:=nil;
 baru^.prev:=nil;
 if head=nil then
 begin
 head:=baru;
 tail:=baru;
 end
 else
 baru^.next:=head;
 head^.prev:=baru;
 head:=baru;
 end
 else
 writeln('MEMORY HEAP FULL');
 write('masukkan lagi = ');readln;read(lagi);
until (lagi='t') or (lagi='T');
end;

procedure view;
begin
 if baru<>nil then
 begin
 help:=head;
 while help<>nil do
 begin
 write('mata kuliah = ',help^.matkul);
 writeln;
 help:=help^.next;
 end;
 end
 else
 writeln('data kosong');
end;

procedure view2;
begin
 if baru<>nil then
 begin
 help:=tail;
 while help<>nil do
 begin
 write('mata kuliah = ',help^.matkul);
 writeln;
 help:=help^.prev;
 end;
 end
 else
 writeln('DATA IS EMPTY');
end;

procedure sorting_fifo;
var
help2:data;
swap:string;
lihat:char;
begin
 if baru<>nil then
 begin
 help:=tail;
 while help^.next<>nil do
 begin
 help2:=help^.next;
 while help2^.next<>nil do
 begin
 if help^.matkul>help2^.matkul then
 begin
 swap:=help^.matkul;
 help^.matkul:=help2^.matkul;
 help2^.matkul:=swap;
 end;
 end;
 end;
 end
 else
 writeln('data kosong');
write('LIHAT DATA = ');readln;read(lihat);
 if lihat='y' then
 begin
 view2;
 end
 else if lihat<>'y' then
 begin
 exit;
 end;
end;

procedure sorting_lifo;
var
help2:data;
swap:string;
lihat:char;
begin
 if baru<>nil then
 begin
 help:=head;
 while help^.prev<>nil do
 begin
 help2:=help^.prev;
 while help2^.prev<>nil do
 begin
 if help^.matkul>help2^.matkul then
 begin
 swap:=help^.matkul;
 help^.matkul:=help2^.matkul;
 help2^.matkul:=swap;
 end;
 end;
 end;
 end
 else
 writeln('data kosong');
write('LIHAT DATA = ');readln;read(lihat);
 if lihat='y' then
 begin
 view;
 end
 else if lihat<>'y' then
 begin
 exit;
 end;
end;

begin
repeat;
writeln('PROGRAM DAFTAR MATA KULIAH');
writeln('1.  tambah matakuliah');
writeln('2.  urut FIFO');
writeln('3.  urut LIFO');
write('pilih = ');read(pil);
case pil of
1:tambah;
2:sorting_fifo;
3:sorting_lifo;
else
writeln('ERROR');
end;
writeln('program utama = ');readln;read(lagi);
until (lagi='t') or (lagi='T');
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: