2. QUEUE
-
Source
Code
program praktikum_3;
uses crt;
type pointer=^node;
node=record
nama : string;
alamat : string;
next : pointer;
end;
queue=record
front,rear : pointer;
end;
var baru : pointer;
q : queue;
nm,al : string;
procedure AddQ(var q :
queue; baru : pointer);
begin
if q.front = nil then
begin
q.rear :=baru;
end
else
begin
q.rear^.next :=baru;
q.rear :=baru;
end;
end;
procedure deleteQ(var
q : queue);
var hapus : pointer;
begin
if q.front<>nil then
begin
hapus :=q.front;
q.front :=q.front^.next;
{hasil^:=hapus^;}
dispose(hapus);
end;
end;
procedure cetak(q :
queue);
var b : pointer;
begin
if q.front = nil then
writeln('kosong')
else
begin
new(b);
b := q.front;
while b<>q.rear do
begin
writeln(b^.nama,' ',b^.alamat);
b :=b^.next;
end;
writeln(b^.nama,' ',b^.alamat);
end;
writeln;
end;
begin
clrscr;
repeat
write('nama :');readln(nm);
write('alamat :');readln(al);
new(baru);
with baru^ do
begin
nama :=nm;
alamat :=al;
next :=nil;
end;
AddQ(q,baru);
writeln('Enter terus / ESC cukup');
until readkey = #27;
repeat
cetak(q);
deleteQ(Q);
until readkey = #27;
End.
3. Linked-List
- Source
Code
program praktikum_4;
uses crt;
type pointer = ^node;
node =
record
data : string;
next : pointer;
end;
var n,name : string;
i : byte;
p,q,baru :
pointer;
procedure sisip(var p,q : pointer; baru : pointer);
begin
if p =
nil then
begin
p :=baru;
q :=baru;
end
else
begin
q^.next :=baru;
q :=baru;
end;
end;
procedure hapuskan(var p : pointer; name : string);
var bantu,hapus : pointer;
begin
if p
<> nil then
begin
hapus :=p;
while (hapus^.next <> nil) and (hapus^.data <> name) do
hapus := hapus^.next;
if hapus^.data <> name then
writeln('Data tidak ada')
else
begin
bantu := p;
if bantu = hapus then
p := hapus^.next
else
while bantu^.next
<> hapus do
bantu :=
bantu^.next;
bantu^.next := hapus^.next;
dispose(hapus);
end;
end;
end;
procedure cetak(p,q : pointer);
var bantu : pointer;
begin
bantu :=
p;
while
bantu <> nil do
begin
write(bantu^.data,' ');
bantu :=bantu^.next;
end;
end;
begin
clrscr;
repeat
write('Nama :');readln(n);
for
i := 1 to Length (n) do
n[i] := upcase (n[i]);
new
(baru);
with baru^do
begin
data := n;
next := nil;
end;
sisip(p,q,baru);
writeln('Enter terus / ESC cukup');
until
readkey = #27;
cetak(p,q);
repeat
write('Nama yang akan dihapus :');readln(name);
for
i := 1 to length (name) do
name[i] :=upcase (name[i]);
hapuskan(p,name);
cetak(p,q);
if
p = nil then
writeln('Linked-List kosong');
writeln('Enter terus / ESC cukup');
until
readkey = #27;
end.
- Hasil
4. Double Linked List
Melingkar”
- - Source Code
program Praktikum_6;
uses crt;
Type pointer = ^node;
node = record
isi : integer;
kiri,kanan : pointer;
end;
var baru,p : pointer;
n : integer;
procedure Sisip (var p : pointer;
baru : pointer);
var bantu : pointer;
begin
if p^.kanan = nil then
begin
p^.kanan := baru;
baru^.kiri := p;
baru^.kanan := p;
p^.kiri := baru;
end
else
if baru^.isi < p^.kanan^.isi then
begin
baru^.kanan := p^.kanan;
baru^.kanan^.kiri := baru;
baru^.kiri := p;
baru^.kiri^.kanan := baru;
end
else
begin
bantu := p;
while (bantu^.kanan <> p) and
(baru^.isi > bantu^.kanan^.isi) do
bantu := bantu^.kanan;
if bantu^.kanan <> p then
begin
baru^.kanan := bantu^.kanan;
baru^.kiri := bantu;
baru^.kiri^.kanan := baru;
baru^.kanan^.kiri := baru;
end
else
begin
baru^.kiri := bantu;
baru^.kanan := baru^.kiri^.kanan;
baru^.kiri^.kanan := baru;
baru^.kanan^.kiri := baru;
end;
end;
end;
procedure hapuskan (var p :
pointer; n : integer);
var hapus : pointer;
ada : boolean;
begin
hapus := p;
ada := false;
while (hapus^.kanan <> p) and
(not(ada)) do
begin
hapus := hapus^.kanan;
if n = hapus^.isi then
ada := true
end;
if not (ada) then
writeln('Data tidak ada')
else
if hapus^.kanan = p then
begin
hapus^.kiri^.kanan :=
hapus^.kanan;
hapus^.kanan^.kiri :=
hapus^.kiri;
dispose (hapus);
end
else
begin
hapus^.kiri^.kanan :=
hapus^.kanan;
hapus^.kanan^.kiri
:=hapus^.kiri;
dispose (hapus);
end;
end;
procedure cetak (p : pointer);
var b : pointer;
begin
b := p;
while b^.kanan <> p do
begin
b := b^.kanan;
writeln (b^.isi, ' ');
end;
writeln;
if b = p then
writeln('Linked-list kosong');
end;
begin
clrscr;
new (p);
with p^ do
begin
kiri := nil;
kanan := nil;
end;
repeat
write('Isi : '); readln(n);
new (baru);
with baru^ do
begin
isi := n;
kanan := nil;
kiri := nil;
end;
sisip (p, baru);
writeln('Enter terus / ESC cukup');
until readkey = #27;
cetak(p);
repeat
write('Data yang akan dihapus
:');readln(n);
hapuskan(p,n);
cetak(p);
writeln('Enter terus / ESC cukup');
until readkey = #27;
End.
5. Graph
-
Source
Code
program
praktikum_7;
uses
crt, graph;
var
pilihan2,
pilihan : char;
x1,x2,y1,y2,a,b,xa,xb,ya,yb:integer;
grDriver:
integer;
grMode:
integer;
ErrCode:
integer;
skala:integer;
begin
clrscr;
writeln('yang
ingin anda proses');
write('
1 = translasi garis');
write('
2 = refleksi garis');
write('
3 = dilatasi garis');
write('
4 = rotasi garis');
write('Tentukan
Pilihan Anda= ');readln(pilihan);
if
pilihan = '1' then
begin
write('masukkan x1 = ');readln(x1);
write('masukkan y1 = ');readln(y1);
write('masukkan x2 = ');readln(x2);
write('masukkan y2 = ');readln(y2);
writeln('masukkan titik translasi (a,b)');
write('a = ');readln(a);
write('b = ');readln(b);
xa:=x1+a; xb:=x2+a;
ya:=y1+b; y2:=y2+b;
end
else
if
pilihan = '2' then
begin
writeln(' 1 = garis terhadap sumbu y ');
writeln(' 2 = garis terhadap sumbu x ');
readln(pilihan2);
writeln(' titik yang akan di refleksikan ');
write(' x1 = ');readln(x1);
write(' y1 = ');readln(y1);
write(' x2 = ');readln(x2);
write(' y2 = ');readln(y2);
if pilihan2 = '1' then
begin
xa:=(-1*x1);
xb:=(-1*x2);
ya:=y1; yb:=y1;
end
else
if
pilihan2 = '2' then
begin
ya:=(-1*y1); xa:=x1;
yb:=(-1*y2); xb:=x2;
end;
end
else
if
pilihan = '3' then
begin
write('masukkan x1 = ');readln(x1);
write('masukkan y1 = ');readln(y1);
writeln(' 1 = terhadap titik pusat');
write(' 2 = terhadap titik
(a,b)');readln(pilihan2);
write('masukkan faktor skala =
');readln(skala);
if
pilihan2 = '1' then
begin
x2:=skala*x1;
y2:=skala*y1;
end;
if
pilihan2 = '2' then
begin
write('masukkan a = ');readln(xa);
write('masukkan b = ');readln(xb);
x2:=xa+(skala*(x1-xa));
y2:=yb+(skala*(y1-yb));
end;
end;
grDriver
:= Detect;
InitGraph(grDriver,
grMode,' ');
ErrCode
:= GraphResult;
if
ErrCode = grOk then
begin { Do graphics }
Line(320, 0, 320, 640);
Line(0, 230, 640, 230);
if
pilihan = '1' then
begin
line((x1+320), (-y1+230), (x2+320),
(-y2+230));
line((xa+320), (-ya+230), (xb+320),
(-yb+230));
end
else
if
pilihan = '2' then
begin
line((x1+320), (-y1+230), (x2+320),
(-y2+230));
line((xa+320), (-ya+230), (xb+320),
(-yb+230));
end
else
if
pilihan = '3' then
begin
line((x1+320), (-y1+230), (x2+320),
(-y2+230));
end;
readln;
CloseGraph;
end
else
writeln('Graphics
error:', GraphErrorMsg(ErrCode));
readln
end.
6. Binery Tree
. Source Code
program praktikum_tree; {tugas no. 1)
uses crt; {tugas
no. 1)
type btree = ^node;
node = record
isi : char;
a_kiri,a_kanan : btree;
end;
var baru,root : btree; {tugas
no. 2}
pilih,x : char; {tugas
no. 2}
procedure sisip(var root : btree;
baru : btree); {tugas no. 2}
var p : btree; {tugas
no. 2}
begin
baru^.a_kiri := nil;
baru^.a_kanan := nil;
if root = nil then
root := baru
else
begin
p := root;
while p <> nil do
if baru^.isi < p^.isi then
if p^.a_kiri <> nil
then
p := p^.a_kiri
else
begin
p^.a_kiri := baru;
p := nil;
end
else
if p^.a_kanan <> nil
then
p := p^.a_kanan
else
begin
p^.a_kanan := baru;
p := nil;
end;
end;
end;
procedure inorder(root : btree);
begin
if root <> nil then
begin
inorder(root^.a_kiri);
write(root^.isi,' ');
inorder(root^.a_kanan);
end;
writeln;
end;
procedure postorder(root :
btree);
begin
if root <> nil then
begin
postorder(root^.a_kiri); {tugas
lab no. 3}
postorder(root^.a_kanan);
write(root^.isi,' ');
end;
writeln;
end;
procedure preorder(root : btree);
begin
if root <> nil then
begin
write(root^.isi,' ');
preorder(root^.a_kiri);
preorder(root^.a_kanan); {tugas
lab no. 4}
end;
writeln;
end;
begin
clrscr;
repeat
new(baru);
write('Masukkan huruf : ');
readln(x);
baru^.isi := x;
sisip(root,baru);
writeln('Tekan anykey to lanjut / ESC
to stop');
until readkey = #27;
writeln;
writeln;
writeln('Mau cetak secara apa');
writeln;
repeat
writeln('1. INORDER');
writeln('2. POSTORDER');
writeln('3. PREORDER');
writeln('4. Keluar');
write('Masukkan pilihan anda :');
readln(pilih);
writeln;
case pilih of {tugas
no. 5}
'1' : inorder(root);
'2' : postorder(root);
'3' : preorder(root);
end;
until pilih = '4';
end.
Tidak ada komentar:
Posting Komentar