Quick Short

ni salah satu contoh Quick Short dalam Pemrograman PASCAL

-------------------------------------------------------------------------

uses crt;

type rek=record

     nim:integer;

     nama,asal_pt:string;

     ipk:real;

end;

larik=array[1..10] of rek;

var data:larik;

n,i:word;

lagi:char;

 

procedure quickshort(var x:larik;bawah,atas:word);

var i,j:word;

sementara:rek;

begin

     while atas > bawah do

     begin

          i:=bawah;

          j:=atas;

          sementara := x[bawah];

          {memecah array}

          while i<j do

          begin

               while x[j].nama > sementara.nama do

               dec(j);

               x[i]:=x[j];

               while(i<j) and (x[i].nama <=sementara.nama) do

               inc(i);

               x[j]:=x[i];

          end;

          x[i]:=sementara;

          {urutkan secara rekursif}

          quickshort(x,bawah,i-1);

          bawah:=i+1;

     end;

end;

procedure qk2(var x:larik;bawah,atas:word);

var i,j:word;

sementara:rek;

begin

     while atas > bawah do

     begin

          i:=bawah;

          j:=atas;

          sementara := x[bawah];

          {memecah array}

          while i<j do

          begin

               while x[j].ipk < sementara.ipk do

               dec(j);

               x[i]:=x[j];

               while(i<j) and (x[i].ipk >=sementara.ipk) do

               inc(i);

               x[j]:=x[i];

          end;

          x[i]:=sementara;

          {urutkan secara rekursif}

          qk2(x,bawah,i-1);

          bawah:=i+1;

     end;

end;

procedure cetak(var x:larik);

begin

     writeln('|=====================================================|');

     writeln('| no      nim     nama       pt asal         ipk      |');

     writeln('|=====================================================|');

     for i := 1 to n do

         writeln(i:3,x[i].nim:10,x[i].nama:15,x[i].asal_pt:10,x[i].ipk:6:2);

     writeln('|-----------------------------------------------------|');

end;

procedure isi (var x:larik);

begin

     n:=0;

     repeat

           inc(n);

           writeln('mengisi data mahasiswa ke-',n);

           with x[n] do

           begin

                write('masukkan nim     : ');readln(nim);

                write('masukkan nama    : ');readln(nama);

                write('masukkan PT Asal : ');readln(asal_pt);

                write('masukkan IP S1   : ');readln(ipk);

           end;

           write('isi lagi ?<y/t> ');readln(lagi);

     until (lagi <> 'y');

end;
//blog program utama

begin

clrscr;

isi(data);

cetak(data);

writeln('----- URUTAN BERDASARKAN NAMA ----- ');

quickshort(data,1,n);

cetak(data);

writeln('----- URUTAN BERDASARKAN IP ----- ');

qk2(data,1,n);

cetak(data);

readln;

end.