Pages

Rabu, 05 Maret 2014

Antrian Prioritas (Priority Queue)



PriorityQueue;
uses wincrt;
type queue=^data;
data=record
                                info:char;
                                prior:integer;
                                next:queue
                end;      
var itsqueue:queue;
elemen:char;
prior:integer;
procedure kondisiawal(var PQ:queue);
begin
                new(PQ);
                PQ^.info:=chr(0);
                PQ^.prior:=0;
                PQ^.next:=PQ
end;
{procedur masuk ngantri}
procedure addqueue(var PQ:queue;X:char;P:integer);
var baru,bantu:queue;
begin
                new(baru);
                baru^.info:=X;
                baru^.prior:=P;
                baru^.next:=nil;
                {mengecek kondisi queue}
                if PQ^.next=PQ then {queue kosong}
                                begin
                                                baru^.next:=PQ;
                                                PQ^.next:=baru;
                                end
                                else {sudah ada yang mengantri sebelumnya}
                                begin
                                                bantu:=PQ;
                                                {cari posisi yang tepat}
                while (bantu^.next^.prior <= P) and (bantu^.next <> PQ) do
                                                                bantu:=bantu^.next;
                                                if bantu^.next = PQ then
                                {node baru berprioritas paling rendah = sisip belakang}
                                                begin
                                                                baru^.next:=PQ;
                                                                bantu^.next:=baru;
                                                end
                                                else
                                                {node baru berprior lebih tinggi= sisip tengah}
                                                begin
                                                                baru^.next:=bantu^.next;
                                                                bantu^.next:=baru;
                                                end;      
                                end;
end;
{cetak antrian}
procedure printqueue(PQ:queue);
var bantu:queue;
begin
bantu:=PQ^.next;
                repeat
                                write('Informasi rahasia: ',bantu^.info:3);
                                writeln(' berprioritas ',bantu^.prior:3);
                                bantu:=bantu^.next;
                until bantu=PQ;
end;
BEGIN
clrscr;
kondisiawal(itsqueue);
writeln('Fill Information (fill priority = zero to stop)');             
repeat
                write('Information, priority :');
                readln(elemen,prior);
                if prior <> 0 then
                                addqueue(itsqueue,elemen,prior);        
until prior = 0; writeln;
writeln('Priority List :');
writeln; 
printqueue(itsqueue);
End.

0 komentar:

Posting Komentar